r6423 - /scripts/qa/versioncheck.pl

[dmn at users.alioth.debian.org]

Author: dmn
Date: Fri Aug 10 10:57:32 2007
New Revision: 6423

URL: http://svn.debian.org/wsvn/?sc=1&rev=6423
Log:
Get uversionmangle support in separate sub(). Use it in cpan_versions and also in latest_upstream_from_watch

Modified:
    scripts/qa/versioncheck.pl

Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=6423&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Fri Aug 10 10:57:32 2007
@@ -266,6 +266,24 @@
     return 1 if $a;
     return -1 if $b;
     return 0;
+}
+
+sub unmangle( $ $ )
+{
+    my( $ver, $mangles ) = @_;
+
+    return $ver unless $mangles;
+
+    my @vms = map( split(/;/, $_), @$mangles );
+
+    foreach my $vm( @vms )
+    {
+        eval "\$ver =~ $vm";
+        die "<<\$_ =~ $vm>> $@" if $@;
+        debugmsg("     mangled: $ver\n");
+    }
+
+    return $ver;
 }
 
 # RETURNS undef if all watch files point to CPAN
@@ -310,15 +328,20 @@
                     while( s/<a [^>]*href="([^"]+)"[^>]*>// )
                     {
                         my $href = $1;
-                        warn $href;
-                        push @vers, [$1,$url] if $href =~ $filter;
+                        push @vers, [
+                            unmangle( $1, $opts->{uversionmangle} ),
+                            $url,
+                        ] if $href =~ $filter;
                     }
                 }
                 else
                 {
                     while( s/(?:^|\s+)$filter(?:\s+|$)// )
                     {
-                        push @vers, [$1,$url];
+                        push @vers, [
+                            unmangle( $1, $opts->{uversionmangle} ),
+                            $url,
+                        ];
                     }
                 }
             }
@@ -367,18 +390,7 @@
         if( $_ =~ $filter )
         {
             debugmsg("     looking at $_\n") if 1;
-            my $ver = $1;
-            if( my $uvms = $opts->{uversionmangle} )
-            {
-                my @uvms = map( split(/;/, $_), @$uvms );
-
-                foreach my $uvm( @uvms )
-                {
-                    eval "\$ver =~ $uvm";
-                    die "<<\$_ =~ $uvm>> $@" if $@;
-                    debugmsg("     mangled: $ver\n");
-                }
-            }
+            my $ver = unmangle( $1, $opts->{uversionmangle} );
             push @vers, [$ver, $key];
         }
     }