[gentoo-perl] r19 - / code

Author: mcummings
Date: 2005-05-12 01:24:06 +0200 (Thu, 12 May 2005)
New Revision: 19

Modified:
   Changes
   code/g-cpan.pl
Log:
Need sleep at this point, read Changes for the highlights, mostly working on fixing bugs with emerging multiple packages, and cleaner call to emerge in general, plus actually cutting out some of my horrid regex's for already used modules



Modified: Changes
===================================================================
--- Changes	2005-05-11 18:58:05 UTC (rev 18)
+++ Changes	2005-05-11 23:24:06 UTC (rev 19)
@@ -1,5 +1,8 @@
 11/05/2005 - mcummings makes weird changes
 
+- cleaned up calls to merge, added -p,-a,-n,-u flags to respective portions
+- Removed the "for (@ARGV) to the call for emerge*module subs - all this was doing was forcing us to call emerge multiple times; the actual subs weren't using @ARGV, but using @ebuild_list, which was already populated elsewhere with all of the modules we wanted plus their generated deps.
+- moved list function so that it was called *after* we define the list of dirs to check
 - added basename so program name was pretty (beu)
 - To explain my changes for that dir read -noticed when traversing for multiple files that the directory list checked was decreasing in size each pass until it was only checking one directory chain in the end. Pushing it all into a single array that's built temporarily, while ugly, seems to work. This was all due to a bug in modules like Bundle-W3C-Validator (go ahead and try with the old code). Sorry for the kludges, thanks snip for the regex help
 

Modified: code/g-cpan.pl
===================================================================
--- code/g-cpan.pl	2005-05-11 18:58:05 UTC (rev 18)
+++ code/g-cpan.pl	2005-05-11 23:24:06 UTC (rev 19)
@@ -82,7 +82,7 @@
 ###############################
 
 # Init all options
-my ( $verbose, $search, $install, $upgrade, $list ) = ( 0, 0, 0, 0, 0 );
+my ( $verbose, $search, $install, $upgrade, $list, $pretend, $ask, $noclean ) = ( 0, 0, 0, 0, 0, 0, 0, 0 );
 
 #Get & Parse them
 GetOptions(
@@ -91,6 +91,9 @@
     'install|i' => \$install,
     'upgrade|u' => \$upgrade,
     'list|l'    => \$list,
+    'pretend|p' => \$pretend,
+    'ask|a'     => \$ask,
+    'noclean|n' => \$noclean,
     'help|h'    => sub { exit_usage(); }
   )
   or exit_usage();
@@ -103,7 +106,7 @@
 }
 
 # Output error if no arguments
-if ( !( defined( $ARGV[0] ) ) and ( !($upgrade) or !($list) ) ) {
+if ( !( defined( $ARGV[0] ) ) and !( defined($upgrade) or defined($list) ) ) {
     print "Not even one module name or expression given !\n\n";
     exit_usage();
 }
@@ -126,16 +129,10 @@
         CPAN::Shell->m("/$expr/");
     }
 
-    clean_the_mess();
+    clean_the_mess() unless $noclean;
     exit;
 }
 
-# Take care of List requests. This should return all the ebuilds managed by g-cpan
-if ($list) {
-    print "List function not implemented yet.\n";
-    exit_usage();
-}
-
 # Set our temporary overlay directory for the scope of this run.
 # By setting an overlay directory, we bypass the predefined portage
 # directory and allow portage to build a package outside of its
@@ -202,25 +199,34 @@
 $ENV{PORTDIR_OVERLAY} = $tmp_overlay_dir;
 
 # sub main.. well, sort of ;p
+# Take care of List requests. This should return all the ebuilds managed by g-cpan
+if ($list) {
+    printbig "Generating list of modules managed by g-cpan";
+    my @managed = get_gcpans();
+#    print "@managed \n" for @managed;
+#    print "List function not implemented yet.\n";
+#    exit_usage();
+}
+
 if ($install) {
     install_module($_) for (@ARGV);
-    emerge_module($_)  for (@ARGV);
+    emerge_module();
 }
 
 if ($upgrade) {
     if (@ARGV) {
         upgrade_module($_)   for (@ARGV);
-        emerge_up_module($_) for (@ARGV);
+        emerge_module($_);
     }
     else {
         my @GLIST = get_gcpans();
         upgrade_module($_) for (@GLIST);
-        emerge_up_module(@GLIST);
+        emerge_module(@GLIST);
     }
 }
 
 if($install or $upgrade) {
-    clean_up();
+    clean_up() unless $noclean;
 }
 
 exit;
@@ -243,7 +249,7 @@
 }
 
 sub ebuild_exists {
-    my ($dir) = lc $_[0];
+    my ($dir) = $_[0];
 
     # need to try harder here - see &portage_dir comments.
     # should return an ebuild name from this, as case matters.
@@ -264,8 +270,9 @@
         next if not -d $sdir;
         opendir PDIR, $sdir or fatal(ERR_FOLDER_OPEN, $sdir, $!);
         while(my $file = readdir PDIR) {
-            if(lc $file eq $dir) {
-                $found = $dir;
+            if(lc $file eq lc $dir) {
+	    	my $cat = basename($sdir);
+                $found = "$cat/$file";
                 print "$prog: Looking for ebuilds in $sdir, found $found so far.\n" if $verbose;
                 close PDIR;
                 last SOURCE_FOLDER;
@@ -274,7 +281,7 @@
         closedir PDIR;
     }
 
-    # check for ebuilds that have been created by g-cpan.pl
+    # check for ebuilds that have been created by g-cpan.pl - in THIS session
     for my $ebuild (@ebuild_list) {
         if($ebuild eq $dir) {
             $found = $ebuild;
@@ -290,13 +297,17 @@
     foreach my $sdir ( grep { -d $_ } ( @PORTAGE_DEV_PERL, @OVERLAY_PERLS ) ) {
         # FIXME Sniper
         # Do we really need regexp here ?
-        if ( $sdir =~ m/perl-gcpan/ ) {
+	# Yes - this is potentially a large list of dirs, and we only want the ones containing the tail perl-gcpan
+	# - mcummings
+        if ( basename($sdir) eq "perl-gcpan" ) {
+    	    print "OVERLAY: $sdir\n" if $list;
             # FIXME Sniper
             # maybee replace fatal by "warn and next folder" ?
             opendir PDIR, $sdir or fatal(ERR_FOLDER_OPEN, $sdir, $!);
             while(my $file = readdir PDIR) {
                 next if $file eq '.'
                      or $file eq '..';
+		print "perl-gcpan/$file\n" if $list;
                 push @g_list, $file;
             }
             closedir PDIR;
@@ -464,9 +475,8 @@
 
                 # remove trailing .pm to fix emerge breakage.
                 $dir =~ s/.pm$//;
-		print "Testing $dir\n";
-                $dir = build_catdep($dir);
-		print "Adding $dir unless $first\n";
+                #$dir = build_catdep($dir);
+                $dir = ebuild_exists($dir);
                 print EBUILD "\n\t" unless $first;
                 print EBUILD "$dir";
             }
@@ -504,9 +514,15 @@
         return;
     }
 
-    if ( ebuild_exists($dir) ) {
-        printbig "Ebuild already exists for '$module_name': "
-          . &ebuild_exists($dir) . "\n";
+    if ( my $exists = ebuild_exists($dir) ) {
+    	# Instead of exiting, we should just add the ebuild to the list of ebuilds to install
+	# That way, if they want to install something we already have an ebuild for from g-cpan, it doesn't
+	# die as well.
+        #printbig "Ebuild already exists for '$module_name': "
+        #  . &ebuild_exists($dir) . "\n";
+    	
+	# Just because an ebuild exists, doesn't mean we don't want to pass it on ;)
+	push @ebuild_list, "$exists";
         return;
     }
     elsif ( !defined $recursive && module_check($module_name) ) {
@@ -558,7 +574,9 @@
 
     # FIXME Sniper
     # OH MY GOD !
-    system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
+    unless ( -f "$PORTAGE_DISTDIR/$localfile" ) {
+       system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
+    }
 
     push @ebuild_list, "perl-gcpan/$dir";
 }
@@ -602,7 +620,9 @@
     }
 
     printbig "Checking ebuild for '$module_name': $dir\n";
+    my $fullname = ebuild_exists($dir);
 
+    if (dirname($fullname) eq "perl-gcpan") {
     # check depends ... with CPAN have to make the module
     # before it can tell us what the depends are, this stinks
 
@@ -641,8 +661,10 @@
     create_ebuild( $obj, $dir, $file, $build_dir, $prereq_pm, $md5string );
     unless ( -f "$PORTAGE_DISTDIR/$localfile" ) {
         system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
+    }
         push @ebuild_list, "perl-gcpan/$dir";
-    }
+    } else { push @ebuild_list, "$fullname" }
+
 }
 
 # TODO Sniper
@@ -659,37 +681,16 @@
 }
 
 sub emerge_module {
-    foreach my $ebuild_name (@ebuild_list) {
-        $ebuild_name =~ m/.*\/(.*)-[^-]+\./;
-        print "$prog: emerging $ebuild_name\n";
+	my @flags;
+	push @flags, "-p" if $pretend > 0;
+	push @flags, "-u" if $upgrade > 0;
+	push @flags,  "--ask" if $ask > 0;
+	print "Calling: emerge --oneshot --digest @ebuild_list\n" if ($verbose);
         # FIXME Sniper
         # check return values
-        system( "emerge", "--oneshot", "--digest", $ebuild_name );
-    }
+        system( "emerge",@flags, "--oneshot", "--digest", @ebuild_list );
 }
 
-sub emerge_up_module {
-
-    #my @e_list = @_;
-    print "\n\n";
-    foreach my $ebuild_name (@ebuild_list) {
-        $ebuild_name =~ m/.*\/(.*)-[^-]+\./;
-        print "* Upgrade available for $ebuild_name\n";
-    }
-    print "\nContinue with upgrade? (Y|N) ";
-    my $answer = <STDIN>;
-    chomp($answer);
-    if ( $answer =~ m|y|i ) {
-        foreach my $ebuild_name (@ebuild_list) {
-            # FIXME Sniper
-            # check return values
-            system( "emerge", "--oneshot", "--digest", $ebuild_name );
-        }
-    }
-    return;
-
-}
-
 sub get_globals {
 
     # Setting default configs
@@ -777,10 +778,10 @@
         mkpath($cpan_cfg_dir, 1, 0755 ) or fatal(ERR_FOLDER_CREATE, $cpan_cfg_dir, $!);
     }
 
-    my $tmp_dir       = -d $ENV{TMPDIR}      ? $ENV{TMPDIR}      : $ENV{HOME};
-    my $ftp_proxy     =    $ENV{ftp_proxy}   ? $ENV{ftp_proxy}   : '';
-    my $http_proxy    =    $ENV{http_proxy}  ? $ENV{http_proxy}  : '';
-    my $user_shell    = -x $ENV{SHELL}       ? $ENV{SHELL}       : DEF_BASH_PROG;
+    my $tmp_dir       = -d $ENV{TMPDIR}      ? defined($ENV{TMPDIR})      : $ENV{HOME};
+    my $ftp_proxy     =    $ENV{ftp_proxy}   ? defined($ENV{ftp_proxy})   : '';
+    my $http_proxy    =    $ENV{http_proxy}  ? defined($ENV{http_proxy})  : '';
+    my $user_shell    = -x $ENV{SHELL}       ? defined($ENV{SHELL})       : DEF_BASH_PROG;
     my $ftp_prog      = -x DEF_FTP_PROG      ? DEF_FTP_PROG      : '';
     my $gpg_prog      = -x DEF_GPG_PROG      ? DEF_GPG_PROG      : '';
     my $gzip_prog     = -x DEF_GZIP_PROG     ? DEF_GZIP_PROG     : '';
@@ -886,6 +887,8 @@
     print <<"USAGE";
 Usage : $prog <Switch(es)> Module Name(s)
 
+--ask,-a       Ask before installing
+
 --install,-i    Try to generate ebuild for the given module name
                 and, if successful, emerge it. Important : installation
                 requires exact CPAN Module Name.
@@ -893,6 +896,11 @@
 --list,-l       This command generates a list of the Perl modules and ebuilds
                 handled by $prog.
 
+--noclean,-n   Don't clean up temporary areas after running install or upgrade.
+
+--pretend,-u    Pretend (show actions, but don't emerge). This still generates
+		new ebuilds.
+
 --search,-s     Search CPAN for the given expression (similar to
                 the "m /EXPR/" from the CPAN Shell). Searches are
                 case insensitive.


-- 
gentoo-perl@g.o mailing list