[gentoo-perl] r35 - in trunk: bin extra-docs

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