* Merge changes to add message links and fix dpkg versioning comparsion

diff --git a/Debbugs/Versions/Dpkg.pm b/Debbugs/Versions/Dpkg.pm
index 064618f04f49e03fb2777083cbd5460b7f4d070b..e061b345504d38592eab87b1dbe9c90e0c14eac9 100644 (file)
--- a/Debbugs/Versions/Dpkg.pm
+++ b/Debbugs/Versions/Dpkg.pm
@@ -46,41 +46,77 @@ sub parseversion ($)
     return %verhash;
 }
 
-sub verrevcmp ($$)
+# verrevcmp
+
+# This function is almost exactly equivalent
+# to dpkg's verrevcmp function, including the
+# order subroutine which it uses.
+
+sub verrevcmp($$)
 {
-    my ($val, $ref) = @_;
-    for (;;)
-    {
-       $val =~ s/^(\D*)//;
-       my $alphaval = $1;
-       $ref =~ s/^(\D*)//;
-       my $alpharef = $1;
-       if (length $alphaval or length $alpharef)
-       {
-           my @avsplit = split //, $alphaval;
-           my @arsplit = split //, $alpharef;
-           my ($av, $ar) = (0, 0);
-           while ($av < @avsplit and $ar < @arsplit)
-           {
-               my ($v, $r) = (ord $avsplit[$av], ord $arsplit[$ar]);
-               $v += 256 unless chr($v) =~ /[A-Za-z]/;
-               $r += 256 unless chr($r) =~ /[A-Za-z]/;
-               return $v <=> $r if $v != $r;
-               $av++;
-               $ar++;
-           }
-           return 1 if $av < @avsplit;
-           return -1 if $ar < @arsplit;
-       }
-
-       return 0 unless length $val and length $ref;
-
-       $val =~ s/^(\d*)//;
-       my $numval = $1;
-       $ref =~ s/^(\d*)//;
-       my $numref = $1;
-       return $numval <=> $numref if $numval != $numref;
-    }
+
+     sub order{
+         my ($x) = @_;
+         ##define order(x) ((x) == '~' ? -1 \
+         #           : cisdigit((x)) ? 0 \
+         #           : !(x) ? 0 \
+         #           : cisalpha((x)) ? (x) \
+         #           : (x) + 256)
+         # This comparison is out of dpkg's order to avoid
+         # comparing things to undef and triggering warnings.
+         if (not defined $x) {
+              return 0;
+         }
+         elsif ($x eq '~') {
+              return -1;
+         }
+         elsif ($x =~ /^\d$/) {
+              return 0;
+         }
+         elsif ($x =~ /^[A-Z]$/i) {
+              return ord($x);
+         }
+         else {
+              return ord($x) + 256;
+         }
+     }
+
+     sub next_elem(\@){
+         my $a = shift;
+         return @{$a} ? shift @{$a} : undef;
+     }
+     my ($val, $ref) = @_;
+     $val = "" if not defined $val;
+     $ref = "" if not defined $ref;
+     my @val = split //,$val;
+     my @ref = split //,$ref;
+     my $vc = next_elem @val;
+     my $rc = next_elem @ref;
+     while (defined $vc or defined $rc) {
+         my $first_diff = 0;
+         while ((defined $vc and $vc !~ /^\d$/) or
+                (defined $rc and $rc !~ /^\d$/)) {
+              my $vo = order($vc); my $ro = order($rc);
+              # Unlike dpkg's verrevcmp, we only return 1 or -1 here.
+              return (($vo - $ro > 0) ? 1 : -1) if $vo != $ro;
+              $vc = next_elem @val; $rc = next_elem @ref;
+         }
+         while (defined $vc and $vc eq '0') {
+              $vc = next_elem @val;
+         }
+         while (defined $rc and $rc eq '0') {
+              $rc = next_elem @ref;
+         }
+         while (defined $vc and $vc =~ /^\d$/ and
+                defined $rc and $rc =~ /^\d$/) {
+              $first_diff = ord($vc) - ord($rc) if !$first_diff;
+              $vc = next_elem @val; $rc = next_elem @ref;
+         }
+         return 1 if defined $vc and $vc =~ /^\d$/;
+         return -1 if defined $rc and $rc =~ /^\d$/;
+         return $first_diff if $first_diff;
+     }
+     return 0;
 }
 
 =item vercmp
@@ -98,21 +134,17 @@ sub vercmp ($$)
     my %refversion = parseversion $_[1];
     return 1 if $version{epoch} > $refversion{epoch};
     return -1 if $version{epoch} < $refversion{epoch};
-    my $r = verrevcmp $version{version}, $refversion{version};
+    my $r = verrevcmp($version{version}, $refversion{version});
     return $r if $r;
-    return verrevcmp $version{revision}, $refversion{revision};
+    return verrevcmp($version{revision}, $refversion{revision});
 }
 
 =back
 
-=head1 BUGS
-
-Version numbers containing the C<~> character, used for pre-releases of
-packages, are not yet supported.
-
 =head1 AUTHOR
 
-Colin Watson E<lt>cjwatson@debian.orgE<gt>, based on the implementation in
+Don Armstrong <don@donarmstrong.com> and Colin Watson
+E<lt>cjwatson@debian.orgE<gt>, based on the implementation in
 C<dpkg/lib/vercmp.c> by Ian Jackson and others.
 
 =cut

diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi
index 16d6ecc22d777b1f1207574891fffd4b647b89ab..64e367a5f0f25a482e999337618f2857110a9172 100755 (executable)
--- a/cgi/bugreport.cgi
+++ b/cgi/bugreport.cgi
@@ -410,7 +410,7 @@ sub handle_record{
          $output .= '<a href="' . bugurl($ref, 'msg='.($msg_number+1)) . '">Full text</a> and <a href="' .
               bugurl($ref, 'msg='.($msg_number+1), 'mbox') . '">rfc822 format</a> available.';
 
-         $output = "<div class=\"msgreceived\">\n" . $output . "</div>\n";
+         $output = qq(<div class="msgreceived">\n<a name="$msg_number">\n) . $output . "</div>\n";
      }
      elsif (/recips/) {
          my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
@@ -420,6 +420,7 @@ sub handle_record{
          elsif (defined $msg_id) {
               $$seen_msg_ids{$msg_id} = 1;
          }
+         $output .= qq(<a name="$msg_number">\n);
          $output .= 'View this message in <a href="' . bugurl($ref, "msg=$msg_number", "mbox") . '">rfc822 format</a>';
          $output .= handle_email_message($record->{text},
                                    ref        => $bug_number,
@@ -439,7 +440,7 @@ sub handle_record{
          }
          # Incomming Mail Message
          my ($received,$hostname) = $record->{text} =~ m/Received: \(at (\S+)\) by (\S+)\;/;
-         $output .= qq|<p class="msgreceived"><a name="msg$msg_number">Message received</a> at |.
+         $output .= qq|<p class="msgreceived"><a name="$msg_number"><a name="msg$msg_number">Message received</a> at |.
               htmlsanit("$received\@$hostname") . q| (<a href="| . bugurl($ref, "msg=$msg_number") . '">full text</a>'.q|, <a href="| . bugurl($ref, "msg=$msg_number") . ';mbox=yes">mbox</a>)'.":</p>\n";
          $output .= handle_email_message($record->{text},
                                    ref        => $bug_number,

diff --git a/t/02_version_dpkg.t b/t/02_version_dpkg.t
new file mode 100644 (file)
index 0000000..9e8e0b0
--- /dev/null
+++ b/t/02_version_dpkg.t
@@ -0,0 +1,51 @@
+# -*- mode: cperl;-*-
+
+use Test::More;
+
+use warnings;
+use strict;
+
+use utf8;
+use Encode;
+
+# Default cmp '>'
+my @versions = ({a      => '1.0-1',
+                b      => '2.0-2',
+                result => -1,
+                relation => 'lt',
+               },
+               {a      => '2.2~rc-4',
+                b      => '2.2-1',
+                result => -1,
+                relation => 'lt',
+               },
+               {a      => '2.2-1',
+                b      => '2.2~rc-4',
+                result => 1,
+                relation => 'gt',
+               },
+               {a      => '1.0000-1',
+                b      => '1.0-1',
+                result => 0,
+                relation => 'eq',
+               },
+              );
+
+plan tests => @versions * 2 + 1;
+
+sub dpkg_vercmp{
+     my ($a,$b,$cmp) = @_;
+     $cmp = 'gt' if not defined $cmp;
+     return system('dpkg','--compare-versions',$a,$cmp,$b) == 0;
+}
+
+
+use_ok('Debbugs::Versions::Dpkg');
+
+for my $version_cmp (@versions) {
+     ok(Debbugs::Versions::Dpkg::vercmp($$version_cmp{a},$$version_cmp{b}) == $$version_cmp{result},
+       "Version $$version_cmp{a} $$version_cmp{relation} $$version_cmp{b} ok");
+     ok(dpkg_vercmp($$version_cmp{a},$$version_cmp{b},$$version_cmp{relation}),
+       "Dpkg concures: Version $$version_cmp{a} $$version_cmp{relation} $$version_cmp{b}");
+}
+