r8560 - /scripts/qa/versioncheck2.pl

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Wed Oct 24 19:32:31 UTC 2007


Author: dmn
Date: Wed Oct 24 19:32:31 2007
New Revision: 8560

URL: http://svn.debian.org/wsvn/?sc=1&rev=8560
Log:
Also support /dist/-based watch files via direct CPAN ls-lR.gz matching; Saves uscan-s

Modified:
    scripts/qa/versioncheck2.pl

Modified: scripts/qa/versioncheck2.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck2.pl?rev=8560&op=diff
==============================================================================
--- scripts/qa/versioncheck2.pl (original)
+++ scripts/qa/versioncheck2.pl Wed Oct 24 19:32:31 2007
@@ -201,15 +201,18 @@
         or from_cache(\%new, 'new', 999) or die;
 }
 
-my( %cpan_authors, %cpan_modules, $cpan_updated );
-unless(not $force_cpan and from_cache(\%cpan_authors, 'cpan_authors', 12)
-        and from_cache(\%cpan_modules, 'cpan_modules', 12))
-{
-    if(scan_cpan(\%cpan_authors, \%cpan_modules)) {
+my( %cpan_authors, %cpan_modules, %cpan_dists, $cpan_updated );
+unless(not $force_cpan
+        and from_cache(\%cpan_authors, 'cpan_authors', 12)
+        and from_cache(\%cpan_modules, 'cpan_modules', 12)
+        and from_cache(\%cpan_dists,   'cpan_dists',   12))
+{
+    if(scan_cpan(\%cpan_authors, \%cpan_modules, \%cpan_dists)) {
         $cpan_updated = 1;
     } else {
         from_cache(\%cpan_authors, 'cpan_authors', 999) or die;
         from_cache(\%cpan_modules, 'cpan_modules', 999) or die;
+        from_cache(\%cpan_dists,   'cpan_dists',   999) or die;
     }
 }
 
@@ -257,7 +260,7 @@
 }
 
 sub scan_cpan {
-    my( $cpauth, $cpmod ) = @_;
+    my( $cpauth, $cpmod, $cpdist ) = @_;
     open(TMP, '+>', undef) or die "Unable to open anonymous temporary file";
     my $old = select(TMP);
     my $lslr = LWP::Simple::getprint("$CPAN_MIRROR/ls-lR.gz");
@@ -276,6 +279,29 @@
         chomp;
         next unless $_;
 
+        # catch dist
+        if( m{
+                \s              # blank
+                (               # $1 will capture the whole file name
+                    (\S+?)      # dist name - in $2
+                    -           # separator - dash
+                    v?          # optional 'v' before the version
+                    (?:             # version
+                        \d          # starts with a digit
+                        [\d._]+     # followed by digits, periods and underscores
+                    )
+                    (?:             # file extension
+                        \.tar       # .tar
+                        (?:\.gz)?   # most probably followed with .gz
+                        | \.zip     # yeah, that ugly OS is not wiped yet
+                    )
+                )$}x            # and this finishes the line
+        )
+        {
+            $cpdist->{$2} ||= [];
+            push @{ $cpdist->{$2} }, $1;
+        }
+
         if( m{^\./authors/id/(.+):} )
         {
             $storage = $cpauth->{$1} ||= [];
@@ -303,7 +329,8 @@
     }
     close(TMP);
     to_cache($cpauth, 'cpan_authors');
-    to_cache($cpmod, 'cpan_modules');
+    to_cache($cpmod,  'cpan_modules');
+    to_cache($cpdist, 'cpan_dists'  );
     1;
 }
 
@@ -450,14 +477,46 @@
 {
     my($where, $wline, $opts) = @_;
 
-    $wline =~ m{
-                ^(\S*?)                 # some/path - captured
-                                        #  non-greedy to not eat up the pattern
-                (?:/\s*|\s+)            # delimiter - '/' for ver3 or space for ver2
-                ([^\s/]+)               # the search pattern - no spaces, no slashes - captured
-                (?!.*\()                # not followed by search pattern
-            }ix;
-    my( $key, $filter) = ($1, $2);
+    my( $key, $filter );
+    # watch line is either:
+    #   path/pattern
+    # or
+    #   path pattern
+    my @elements = split(/\s+/, $wline);
+    # ignore version and script for version=2 watchlines
+    # (consider the first element only unless the second contains a capture)
+    @elements = $elements[0] if $elements[1] and $elements[1] !~ m{\(};
+    if( @elements == 1 )
+    {   # "path/pattern"
+        $wline =~ m{
+                    ^(\S*?)                 # some/path - captured
+                                            #  non-greedy to not eat up the pattern
+                    /                       # delimiter - '/'
+                    ([^\s/]+)               # the search pattern - no spaces, no slashes - captured
+                    (?!.*\()                # not followed by search pattern
+                }ix
+        and
+            ( $key, $filter ) = ($1, $2)
+        or
+            die "Strange one-element watchline '$wline'";
+    }
+    else
+    {   # "path" "pattern" "other things" (ignored)
+        ( $key, $filter ) = @elements[0..1];
+
+        # could this be a dist search?
+        if ( $key =~ m{^http://search.cpan.org/dist/([^/]+)/$} )
+        {
+            $key = $1;
+            $filter =~ s{^.*/}{};  # remove prepended paths
+        }
+        else
+        {
+            # remove trailing slash (if present)
+            $key =~ s{/$}{};
+        }
+    }
+
     debugmsg( sprintf( "   module search %s %s\n", $key, $filter ) );
 
     my $list = $where->{$key};
@@ -482,9 +541,9 @@
 }
 
 # returns (version, URL)
-sub latest_upstream_from_cpan($$$)
-{
-    my ($watch, $cpauth, $cpmod) = @_;
+sub latest_upstream_from_cpan($$$$)
+{
+    my ($watch, $cpauth, $cpmod, $cpdist) = @_;
 
     my @cpan = grep( $_->[0] =~ m{(?:^|\s)(?:http|ftp)://\S*cpan}i, @$watch );
 
@@ -512,6 +571,15 @@
             push @vers, map(
                 [ $_->[0], "http://www.cpan.org/authors/id/".$_->[1] ],
                 cpan_versions($cpauth, $wline, $opts),
+            );
+        }
+        elsif( $wline =~ m{(?:http|ftp)://search.cpan.org/dist/([^/]+)/?\s} )
+        {
+            # lookup by dist
+            my $dist = $1;
+            push @vers, map(
+                [ $_->[0], "http://search.cpan.org/dist/$dist/" ],
+                cpan_versions($cpdist, $wline, $opts),
             );
         }
         else
@@ -837,7 +905,7 @@
     $pkg->{watch} = \@data;
 
     my($upstream_ver, $upstream_url) = latest_upstream_from_cpan(\@data,
-        \%cpan_authors, \%cpan_modules);
+        \%cpan_authors, \%cpan_modules, \%cpan_dists);
     if( $upstream_ver ) {
         $pkg->{watch_cpan} = 1;
     } else {
@@ -882,9 +950,9 @@
 {
     $total++;
 
-    debugmsg("Examining $_\n" );
     my $pkgd = $maindata{$_};
-    my $spkg = $maindata{$_}{chl_pkg};
+    my $spkg = $maindata{$_}{chl_pkg} or die "No source package for $_?";
+    debugmsg("Examining $_ (src:$spkg)\n" );
 
     debugmsg(sprintf(" - Archive has %s\n", $packages{$spkg} || 'none'));
     debugmsg(sprintf(" - experimental has %s\n",




More information about the Pkg-perl-cvs-commits mailing list