Author: mcummings
Date: 2005-05-11 20:09:08 +0200 (Wed, 11 May 2005)
New Revision: 15

Modified:
   code/g-cpan.pl
Log:
fixes packages like Bundle-W3C-Validator/Bundle-W3C-Validator-0.6.5

Modified: code/g-cpan.pl
===================================================================
--- code/g-cpan.pl	2005-05-11 14:44:08 UTC (rev 14)
+++ code/g-cpan.pl	2005-05-11 18:09:08 UTC (rev 15)
@@ -250,8 +250,17 @@
 
     # see if an ebuild for $dir exists already. If so, return its name.
     my $found = '';
+    # FIXME mcummings
+    # Still not nice, but here's the deal. The way it was before, when this was being invoked multiple times,
+    # it was passing through smaller and smaller sets of dirs each pass until it wasn't checking anything
+    # Broken for some reason - foreach my $sdir (@PORTAGE_DEV_PERL, @OVERLAY_PERLS, @TMP_DEV_PERL_DIRS, $perldev_overlay) {
+    my @dir_list;
+    push @dir_list, @PORTAGE_DEV_PERL;
+    push @dir_list, @OVERLAY_PERLS;
+    push @dir_list, @TMP_DEV_PERL_DIRS;
+    push @dir_list, $perldev_overlay;
   SOURCE_FOLDER:
-    foreach my $sdir (@PORTAGE_DEV_PERL, @OVERLAY_PERLS, $perldev_overlay, @TMP_DEV_PERL_DIRS) {
+    foreach my $sdir (@dir_list) {
         next if not -d $sdir;
         opendir PDIR, $sdir or fatal(ERR_FOLDER_OPEN, $sdir, $!);
         while(my $file = readdir PDIR) {
@@ -304,20 +313,32 @@
 
     # FIXME Sniper
     # not nice construct, put grep inside
-    foreach my $sdir (@PORTAGE_DEV_PERL, @OVERLAY_PERLS, $perldev_overlay,  @TMP_DEV_PERL_DIRS) {
+
+    # FIXME mcummings
+    # Still not nice, but here's the deal. The way it was before, when this was being invoked multiple times,
+    # it was passing through smaller and smaller sets of dirs each pass until it wasn't checking anything
+    # Broken for some reason - foreach my $sdir (@PORTAGE_DEV_PERL, @OVERLAY_PERLS, @TMP_DEV_PERL_DIRS, $perldev_overlay) {
+    my @dir_list;
+    push @dir_list, @PORTAGE_DEV_PERL;
+    push @dir_list, @OVERLAY_PERLS;
+    push @dir_list, @TMP_DEV_PERL_DIRS;
+    push @dir_list, $perldev_overlay;
+    foreach my $sdir (@dir_list) {
         next if not -d $sdir;
         # FIXME Sniper
         # 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) {
+	    next if $file eq ".";
+	    next if $file eq "..";
+            if(lc $file eq $dir ) {
                 $sdir =~ s/.*\///;
-                $found = "$sdir/$found";
-                close PDIR;
-                return $found;
+                $found = "$sdir/$file";
+                closedir(PDIR);
+    		return($found);
             }
         }
-        closedir PDIR;
+        closedir(PDIR);
     }
     # TODO Sniper
     # if we are here, $found if undef, what to do ?
@@ -372,12 +393,21 @@
 
     # What to call this ebuild?
     # CGI::Builder's '1.26+' version breaks portage
-    unless ( $file =~ m/(.*)\/(.*?)(-?)([0-9\.]+).*\.(?:tar|tgz|zip|bz2|gz)/ ) {
+    #unless ( $file =~ m/(.*)\/(.*?)(-?)([0-9\.]+).*\.(?:tar|tgz|zip|bz2|gz)/ ) { MPC
+    unless ( $file =~ m/.*\/.*?-?[0-9\.]+.*\.?:tar|tgz|zip|bz2|gz/ ) {
         warn("Couldn't turn '$file' into an ebuild name\n");
         return;
     }
 
-    my ( $modpath, $filename, $filenamever ) = ( $1, $2, $4 );
+    my $re_path = '(?:.*)?';
+    my $re_pkg = '(?:.*)?';
+    my $re_ver = '(?:[\d\.]+[a-z]?)?';
+    my $re_suf = '(?:_(?:alpha|beta|pre|rc|p)(?:\d+)?)?';
+    my $re_rev = '(?:\-r\d+)?';
+    my $re_ext = '(?:(?:tar|tgz|zip|bz2|gz|tar\.gz))?';
+    my $re_file = qr/($re_path)\/($re_pkg)-($re_ver)($re_suf)($re_rev)\.($re_ext)/;
+    my ( $modpath, $filename, $filenamever, $filesuf, $filerev, $fileext ) = $file =~ /^$re_file/;
+    #my ( $modpath, $filename, $filenamever ) = ( $1, $2, $4 ); MPC
 
     # remove underscores
     $filename =~ tr/A-Za-z0-9\./-/c;
@@ -434,7 +464,9 @@
 
                 # remove trailing .pm to fix emerge breakage.
                 $dir =~ s/.pm$//;
+		print "Testing $dir\n";
                 $dir = build_catdep($dir);
+		print "Adding $dir unless $first\n";
                 print EBUILD "\n\t" unless $first;
                 print EBUILD "$dir";
             }


-- 
gentoo-perl@g.o mailing list