Author: mcummings
Date: 2005-05-20 15:06:19 +0200 (Fri, 20 May 2005)
New Revision: 35
Modified:
trunk/bin/g-cpan.pl
trunk/extra-docs/Changes
Log:
Read changes file - lots of tweaks galore. I think this is ready - tested with every scenario I could think of over here.
Modified: trunk/bin/g-cpan.pl
===================================================================
--- trunk/bin/g-cpan.pl 2005-05-17 16:28:47 UTC (rev 34)
+++ trunk/bin/g-cpan.pl 2005-05-20 13:06:19 UTC (rev 35)
@@ -1,5 +1,5 @@
#!/usr/bin/perl -w
-# Copyright 1999-2004 Gentoo Foundation
+# Copyright 1999-2005 Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2
# $Header: $
#
@@ -15,7 +15,7 @@
use Digest::MD5;
use constant MAKE_CONF => '/etc/make.conf';
-use constant PATH_PKG_DEV_PERL => '/var/db/pkg/dev-perl';
+use constant PATH_PKG_VAR => '/var/db/pkg/';
##### CPAN CONFIG #####
use constant CPAN_CFG_DIR => '.cpan/CPAN';
use constant CPAN_CFG_NAME => 'MyConfig.pm';
@@ -35,8 +35,8 @@
##### ERRORS constants (easy internationalisation ;-) #####
use constant ERR_FILE_NOTFOUND => "Couldn't find file '%s'"; # filename
use constant ERR_FOLDER_NOTFOUND => "Couldn't find folder '%s'"; # foldername
-use constant ERR_OPEN_READ => "Couldn't open (read) file'%s' : %s"; # filename, $!
-use constant ERR_OPEN_WRITE => "Couldn't open (write) file'%s' : %s"; # filename, $!
+use constant ERR_OPEN_READ => "Couldn't open (read) file '%s' : %s"; # filename, $!
+use constant ERR_OPEN_WRITE => "Couldn't open (write) file '%s' : %s"; # filename, $!
use constant ERR_FOLDER_OPEN => "Couldn't open folder '%s', %s"; # foldername, $!
use constant ERR_FOLDER_CREATE => "Couldn't create folder '%s' : %s"; # foldername, $!
@@ -73,18 +73,31 @@
)
or exit_usage();
+# Set colors here so we can use them at will anywhere :)
+my $green = color("bold green");
+my $white = color ("bold white");
+my $cyan = color("bold cyan");
+my $reset = color("reset");
+
# Output error if more than one switch is activated
-if ( $search + $list + $install + $generate + $upgrade > 1 ) {
+if ( $search + $list + $install + $generate + $upgrade + $pretend + $ask > 1 ) {
print_err(
-"You can't combine search, list, install or upgrade with each other. Please choose only one\n");
- exit_usage();
+"You can't combine actions with each other.\n");
+ print "${white}Please consult ${cyan}$prog ${green}--help${reset} or ${cyan}man $prog${reset} for more information\n\n";
+ exit();
}
+if ( $search + $list + $install + $generate + $upgrade + $pretend + $ask == 0 ) {
+ print_err("You haven't told $prog what to do. Exiting.\n");
+ exit();
+ }
+
# Output error if no arguments
-if ( !( defined( $ARGV[0] ) ) and !( defined($upgrade) or defined($list) ) ) {
+if ( (scalar(@ARGV) == 0 ) or !(defined($upgrade) or defined($list)) ) {
print_err ("Not even one module name or expression given !\n");
- exit_usage();
-}
+ print "${white}Please consult ${cyan}$prog ${green}--help${reset} for more information\n\n";
+ exit();
+}
######################
# CPAN Special Stuff #
@@ -139,34 +152,28 @@
# directory and allow portage to build a package outside of its
# normal tree.
my $tmp_overlay_dir;
-if ( $ENV{TMPDIR} ) { $tmp_overlay_dir = "$ENV{TMPDIR}/perl-modules_$$" }
-else { $tmp_overlay_dir = "/tmp/perl-modules_$$" }
my @ebuild_list; #this array needs to be seriously observed.
# Set up global paths
# my $TMP_DEV_PERL_DIR = '/var/db/pkg/dev-perl';
-my $MAKECONF = '/etc/make.conf';
my ( $PORTAGE_DISTDIR, $PORTAGE_DIR, @OVERLAYS ) = get_globals();
-my @OVERLAY_PERLS;
-my @PORTAGE_DEV_PERL;
-my @TMP_DEV_PERL_DIRS;
+unless (scalar(@OVERLAYS) > 0) {
+ if ( $generate or $pretend )
+ { print_err("The option you have chosen isn't supported without a configured overlay.\n");
+ exit();
+ }
+ unless($ENV{TMPDIR}) { $ENV{TMPDIR} = '/tmp' }
+ $tmp_overlay_dir = "$ENV{TMPDIR}/perl-modules_$$";
-foreach my $pdir (@perl_dirs) {
- my $tmp_dir = File::Spec->catdir( $PORTAGE_DIR, $pdir );
- push @PORTAGE_DEV_PERL, $tmp_dir;
- foreach my $odir (@OVERLAYS) {
- my $otmp = File::Spec->catdir( $odir, $pdir );
- push @OVERLAY_PERLS, $otmp;
- }
- my $vtmp_dir = File::Spec->catdir(PATH_PKG_DEV_PERL, $pdir );
- push @TMP_DEV_PERL_DIRS, $vtmp_dir;
+ # Create the tmp_overlay_dir in the even that it is a 'real' temp dir
+ if(not -d $tmp_overlay_dir) {
+ mkpath($tmp_overlay_dir, 1, 0755) or fatal(ERR_FOLDER_CREATE, $tmp_overlay_dir, $!);
+ }
+ push @OVERLAYS, $tmp_overlay_dir;
}
-# Create the ebuild in PORTDIR_OVERLAY, if it is defined and exists
-# Part of this is to find an overlay the user running this session can actually write to
-
# o_reset will be used to catch if went through all of the overlay dirs successfully -
# open to better ways :) mcummings
my $o_reset = 1;
@@ -183,11 +190,30 @@
}
}
if ($o_reset > 0) {
- print_err("You don't have permission to work in any of the list overlays.");
- print_err("Please run $prog as a user with sufficient permissions.");
+ print_err("You don't have permission to work in any of the portage overlays.");
+ print_err("Please run $prog as a user with sufficient permissions.\n");
exit();
}
+
+my @OVERLAY_PERLS;
+my @PORTAGE_DEV_PERL;
+my @TMP_DEV_PERL_DIRS;
+
+foreach my $pdir (@perl_dirs) {
+ my $tmp_dir = File::Spec->catdir( $PORTAGE_DIR, $pdir );
+ push @PORTAGE_DEV_PERL, $tmp_dir;
+ foreach my $odir (@OVERLAYS) {
+ my $otmp = File::Spec->catdir( $odir, $pdir );
+ push @OVERLAY_PERLS, $otmp;
+ }
+ my $vtmp_dir = File::Spec->catdir(PATH_PKG_VAR, $pdir );
+ push @TMP_DEV_PERL_DIRS, $vtmp_dir;
+}
+
+# Create the ebuild in PORTDIR_OVERLAY, if it is defined and exists
+# Part of this is to find an overlay the user running this session can actually write to
+
# Grab the whole available arches list, to include them later in ebuilds
print_info ("Grabbing arch list") if $verbose;
my $arches = do {
@@ -196,16 +222,10 @@
join " ", map { chomp; $_ } <$tmp>;
};
-#this should never find the dir, but just to be safe
-if(not -d $tmp_overlay_dir) {
- mkpath($tmp_overlay_dir, 1, 0755) or fatal(ERR_FOLDER_CREATE, $tmp_overlay_dir, $!);
-}
-
# Now we cat our dev-perl directory onto our overlay directory.
# This is done so that portage records the appropriate path
#i.e. dev-perl/package
my $perldev_overlay = File::Spec->catfile( $tmp_overlay_dir, 'perl-gcpan' );
-
if(not -d $perldev_overlay) {
# create perldev overlay dir if not present
mkpath($perldev_overlay, 1, 0755) or fatal(ERR_FOLDER_CREATE, $perldev_overlay, $!);
@@ -214,10 +234,12 @@
# Now we export our overlay directory into the session's env vars
$ENV{PORTDIR_OVERLAY} = $tmp_overlay_dir;
+
# Take care of List requests. This should return all the ebuilds managed by g-cpan
if ($list) {
print_ok ("Generating list of modules managed by g-cpan");
my @managed = get_gcpans();
+ exit();
}
if ($generate) {
@@ -240,9 +262,7 @@
}
}
-if($install or $upgrade) {
- clean_up();
-}
+clean_up();
exit;
@@ -385,9 +405,9 @@
print_ok ("Writing to $ebuild") if ($verbose);
open EBUILD, ">$ebuild" or fatal(ERR_OPEN_WRITE, $ebuild, $!);
print EBUILD <<"HERE";
-
-# Copyright 1999-2004 Gentoo Foundation
+# Copyright 1999-2005 Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2
+# This ebuild generated by $prog $VERSION
inherit perl-module
@@ -465,6 +485,8 @@
if ( my $exists = ebuild_exists($dir) ) {
+ # Print simple found message unless verbose -verbose already got a long version
+ print_info("Existing ebuild found for $exists\n") unless $verbose;
# Just because an ebuild exists, doesn't mean we don't want to pass it on ;)
push @ebuild_list, "$exists";
return;
@@ -519,7 +541,7 @@
unless ( -f "$PORTAGE_DISTDIR/$localfile" ) {
move("$localfile", "$PORTAGE_DISTDIR");
}
- print_info("perl-gcpan/$dir created");
+ print_info("perl-gcpan/$dir created in $ENV{PORTDIR_OVERLAY}");
push @ebuild_list, "perl-gcpan/$dir";
}
@@ -620,8 +642,9 @@
# FIXME Sniper
# check return values
if (@ebuild_list) {
- system( "emerge", @flags, "--oneshot", "--digest", @ebuild_list )
- or die "Emerge failed: $!";
+ system( "emerge", @flags, "--oneshot", "--digest", @ebuild_list );
+ # Portage apparently 'returns' with a status that is being interpreted as a failure even on success :(
+ #or die "Emerge failed: $!";
} else {
print_err ("No ebuilds generated for emerge.");
}
@@ -638,7 +661,7 @@
my @OVERLAYS = ();
# Opening make.conf to find real user settings
- open CONF, "<$MAKECONF" or fatal(ERR_OPEN_READ, $MAKECONF, $!);
+ open CONF, MAKE_CONF or fatal(ERR_OPEN_READ, MAKE_CONF, $!);
# And parsing it :)
while ( defined( my $line = <CONF> ) ) {
@@ -689,6 +712,7 @@
my $count_o = @OVERLAYS;
for ( my $i = 0 ; $i < $count_o ; $i++ ) {
$OVERLAYS[$i] = clean_vars( $OVERLAYS[$i], %conf );
+ print_info("Adding $OVERLAYS[$i] to overlay list\n") if $verbose;
}
return ( $conf{DISTDIR}, $conf{PORTDIR}, @OVERLAYS );
@@ -778,16 +802,16 @@
# anyway, they expect a string and add a colored star at the beginning and the CR/LF
# at the end of the line. oh, shiny world ;)
sub print_ok {
- print color("bold green"), "* ", color("reset"), @_, "\n";
+ print " ", color("bold green"), "* ", color("reset"), "$prog: ", @_, "\n";
}
sub print_info {
- print color("bold cyan"), "* ", color("reset"), @_, "\n";
+ print " ", color("bold cyan"), "* ", color("reset"), "$prog: ", @_, "\n";
}
sub print_warn {
- print color("bold yellow"), "* ", color("reset"), @_, "\n";
+ print " ", color("bold yellow"), "* ", color("reset"), "$prog: ", @_, "\n";
}
sub print_err{
- print color("bold red"), "* ", color("reset"), @_, "\n";
+ print " ", color("bold red"), "* ", color("reset"), "$prog: ", @_, "\n";
}
#################################################
@@ -835,6 +859,7 @@
# This allows us to assure that if a module has been manually installed, we know about it.
sub module_check {
my $check = shift;
+ print_info("Checking to see if $check is installed already\n") if $verbose;
eval "use $check;";
return $@ ? 0 : 1;
}
@@ -852,17 +877,18 @@
#Clean out the /tmp tree we were using
#I know this looks weird, but since clean_up is invoked on a search, where OVERLAYS isn't ever defined,
# we first need to see if it exists, then need to remove only if it has content (the old exists vs. defined)
- if (@OVERLAYS) { rmtree( ["$tmp_overlay_dir"] ) if ( scalar(@OVERLAYS) > 0 ) }
+
+ if ( (defined($ENV{TMPDIR}) ) and ( defined($tmp_overlay_dir) && ($tmp_overlay_dir =~ m/^$ENV{TMPDIR}/) ) ) {
+ print_info("Cleaning temporary overlay\n") if $verbose;
+ rmtree( ["$tmp_overlay_dir"] );
+ }
+ #if ($tmp_overlay_dir =~ m/^$ENV{TMPDIR}/) { rmtree( ["$tmp_overlay_dir"] ) }
+ print_info("Removing cpan build dir") if $verbose;
rmtree( ["$ENV{HOME}/.cpan/build"]) if ( -d "$ENV{HOME}/.cpan/build" );
}
# cab - nice help message ! ;)
sub exit_usage {
- my $green = color("bold green");
- my $white = color ("bold white");
- my $cyan = color("bold cyan");
- my $reset = color("reset");
-
print <<"USAGE";
${white}Usage : ${cyan}$prog ${green}<Switch(es)> ${cyan}Module Name(s)${reset}
Modified: trunk/extra-docs/Changes
===================================================================
--- trunk/extra-docs/Changes 2005-05-17 16:28:47 UTC (rev 34)
+++ trunk/extra-docs/Changes 2005-05-20 13:06:19 UTC (rev 35)
@@ -1,3 +1,31 @@
+20/05/2005 - mcummings
+
+- Moved color block so I could invoke it outside the usage function
+- Added options to the "don't combine" block. Cleaned up text since the block was getting too long to handle/read
+- Added catch for when no options were passed :)
+- Modified check and output for arguments without a module pass
+- Reorganized the checking of PORTDIR_OVERLAY and tmp_dir creation.
+ - Check to make sure we aren't attempting a non-emerge and creating a temp dir
+ - Add tmp_dir to overlay list earlier
+ - set ENV{TMPDIR} explicitly if there are no overlays
+ - Bundle the creation of tmp_dir into the block of "if there are no overlays"
+- Invoke clean up no matter what -if we are far enough to reach it, we ran something that needs it
+- Modified clean up to only remove the tmpdir if it is from our ENV{TMPDIR} - that way we don't wipe overlays by accident
+- Updated copyright info for generated ebuild :) Also added a line to indicate that the ebuild was generated by g-cpan and which version
+- Added output for existing ebuilds found. This helps in the event of invoking g-cpan for an ebuild that already exists. Without this, we return to the prompt without knowing why g-cpan didn't do anything
+- Removed die from call to emerge. Seems the way portage runs it returns an exit code that perl is interpeting as a die
+- Removed $MAKECONF - we have a constant for this.
+- Added verbose message for overlays during discovery phase
+- Inform user which overlay dir is being used
+- Corrected cat'ing of /var/db/pkg dirs to pdirs
+- Tweaked and tested invocations. g-cpan returns proper messages now under the following conditions:
+ * User with overlays attempts to emerge and can't
+ * No overlays defined and user attempts generate
+ * Confirmed multiple overlays work - g-cpan will select the first overlay that it has write access to
+ * Emerging without any overlays
+ * I think that's all that can be tested :)
+
+
17/05/2005 - mcummings
- Changed searching to use i() instead of m() (catch more flies with i than m ;) )
--
gentoo-perl@g.o mailing list
|
