[gentoo-perl] r11 - code

Author: sniper
Date: 2005-05-11 06:39:30 +0200 (Wed, 11 May 2005)
New Revision: 11

Modified:
   code/g-cpan.pl
Log:
Cleaning code

New construction with while() for readdir = improve memory usage and get rid of List::Util prereq



Modified: code/g-cpan.pl
===================================================================
--- code/g-cpan.pl	2005-05-11 03:54:31 UTC (rev 10)
+++ code/g-cpan.pl	2005-05-11 04:39:30 UTC (rev 11)
@@ -10,7 +10,6 @@
 use diagnostics;
 use File::Spec;
 use File::Path;
-use List::Util qw(first);
 
 use constant MAKE_CONF         => '/etc/make.conf';
 use constant PATH_PKG_DEV_PERL => '/var/db/pkg/dev-perl';
@@ -35,7 +34,7 @@
 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_FOLDER     => "Couldn't open folder '%s', %s";        # foldername, $!
+use constant ERR_FOLDER_OPEN     => "Couldn't open folder '%s', %s";        # foldername, $!
 use constant ERR_FOLDER_CREATE   => "Couldn't create folder '%s' : %s";     # foldername, $!
 
 
@@ -242,32 +241,34 @@
 }
 
 sub ebuild_exists {
-    my ($dir) = @_;
+    my ($dir) = lc $_[0];
 
     # need to try harder here - see &portage_dir comments.
     # should return an ebuild name from this, as case matters.
 
     # see if an ebuild for $dir exists already. If so, return its name.
     my $found = '';
-
+  SOURCE_FOLDER:
     foreach my $sdir (@PORTAGE_DEV_PERL, @OVERLAY_PERLS, $perldev_overlay, @TMP_DEV_PERL_DIRS) {
         next if not -d $sdir;
-
-        opendir PDIR, $sdir or fatal(ERR_OPEN_FOLDER, $sdir, $!);
-        # FIXME Sniper
-        # we have to use while() construction otherwise we full memory and we read ALL THE folder
-        # even if we found the ebiuld on the 'first place', btw we can get rid of List::Util
-        my @dirs = readdir(PDIR);
-        closedir PDIR;
-        $found ||= first { lc($_) eq lc($dir) }(@dirs);
-        if ( ($found) && ($verbose) ) {
-            print "$0: Looking for ebuilds in $sdir, found $found so far.\n";
+        opendir PDIR, $sdir or fatal(ERR_FOLDER_OPEN, $sdir, $!);
+        while(my $file = readdir PDIR) {
+            if(lc $file eq $dir) {
+                $found = $dir;
+                print "$0: Looking for ebuilds in $sdir, found $found so far.\n" if $verbose;
+                close PDIR;
+                last SOURCE_FOLDER;
+            }
         }
+        closedir PDIR;
     }
 
     # check for ebuilds that have been created by g-cpan.pl
     for my $ebuild (@ebuild_list) {
-        $found = $ebuild if ( $ebuild eq $dir );
+        if($ebuild eq $dir) {
+            $found = $ebuild;
+            last;
+        }
     }
 
     return $found;
@@ -279,51 +280,45 @@
         # FIXME Sniper
         # Do we really need regexp here ?
         if ( $sdir =~ m/perl-gcpan/ ) {
-            opendir PDIR, $sdir;
             # FIXME Sniper
-            # use while() here
-            my @dirs = readdir(PDIR);
-            closedir PDIR;
-            foreach my $dir (@dirs) {
-                push @g_list, $dir
-                  unless ( ( $dir eq "." ) or ( $dir eq ".." ) );
+            # 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 '..';
+                push @g_list, $file;
             }
-
+            closedir PDIR;
         }
     }
     return @g_list;
 }
 
 sub build_catdep {
-
 # Needed a way to add category to the dependancy instead of hardcoding dev-perl :/
 # On the upside, at this point we know the ebuild exists *somewhere* so we just need to locate it
-    my ($dir) = @_;
-
+    my ($dir) = lc $_[0];
     my $found = '';
 
     # FIXME Sniper
     # not nice construct, put grep inside
-    foreach my $sdir (
-        grep { -d $_ } (
-            @PORTAGE_DEV_PERL, @OVERLAY_PERLS,
-            $perldev_overlay,  @TMP_DEV_PERL_DIRS
-        )
-      )
-    {
-        opendir PDIR, $sdir;
+    foreach my $sdir (@PORTAGE_DEV_PERL, @OVERLAY_PERLS, $perldev_overlay,  @TMP_DEV_PERL_DIRS) {
+        next if not -d $sdir;
         # FIXME Sniper
-        # use while() here
-        my @dirs = readdir(PDIR);
-        closedir PDIR;
-        $found ||= first { lc($_) eq lc($dir) }(@dirs);
-        if ($found) {
-            $sdir =~ s/.*\///;
-            $found = "$sdir/$found";
-            return $found;
+        # maybee replace fatal by "warn and next folder" ?
+        opendir PDIR, $sdir or fatal(ERR_FOLDER_OPEN, $sdir, $!);
+        while(my $file = readdir PDIR) {
+            if(lc $file eq $dir) {
+                $sdir =~ s/.*\///;
+                $found = "$sdir/$found";
+                close PDIR;
+                return $found;
+            }
         }
+        closedir PDIR;
     }
-
+    # TODO Sniper
+    # if we are here, $found if undef, what to do ?
 }
 
 sub module_check {
@@ -364,16 +359,14 @@
     my $fulldir  = File::Spec->catdir( $perldev_overlay, $dir );
     my $filesdir = File::Spec->catdir( $fulldir,         'files' );
     unless ( -d $fulldir ) {
+        print "Create folder '$fulldir'\n" if $verbose;
         mkdir($fulldir, 0755) or fatal(ERR_FOLDER_CREATE, $fulldir, $!);
     }
     unless ( -d $filesdir ) {
+        print "Create folder '$filesdir'\n" if $verbose;
         mkdir($filesdir, 0755) or fatal(ERR_FOLDER_CREATE, $filesdir, $!);
     }
 
-    # FIXME Sniper
-    # these tests are useles since done during mkdir()
-    unless ( -d $fulldir )  { die "$fulldir not created!!\n" }
-    unless ( -d $filesdir ) { die "$fulldir not created!!\n" }
 
     # What to call this ebuild?
     # CGI::Builder's '1.26+' version breaks portage
@@ -391,10 +384,8 @@
     # Remove double .'s - happens on occasion with odd packages
     $filenamever =~ s/\.$//;
 
-    my $ebuild =
-      File::Spec->catdir( $fulldir, "$filename-$filenamever.ebuild" );
-    my $digest =
-      File::Spec->catdir( $filesdir, "digest-$filename-$filenamever" );
+    my $ebuild = File::Spec->catdir( $fulldir, "$filename-$filenamever.ebuild" );
+    my $digest = File::Spec->catdir( $filesdir, "digest-$filename-$filenamever" );
 
     my $desc = $module->description || 'No description available.';
 


-- 
gentoo-perl@g.o mailing list