Debbugs/Versions/Dpkg.pm

   1 package Debbugs::Versions::Dpkg;
   2
   3 use strict;
   4
   5 =head1 NAME
   6
   7 Debbugs::Versions::Dpkg - pure-Perl dpkg-style version comparison
   8
   9 =head1 DESCRIPTION
  10
  11 The Debbugs::Versions::Dpkg module provides pure-Perl routines to compare
  12 dpkg-style version numbers, as used in Debian packages. If you have the
  13 libapt-pkg Perl bindings available (Debian package libapt-pkg-perl), they
  14 may offer better performance.
  15
  16 =head1 METHODS
  17
  18 =over 8
  19
  20 =cut
  21
  22 sub parseversion ($)
  23 {
  24     my $ver = shift;
  25     my %verhash;
  26     if ($ver =~ /:/)
  27     {
  28         $ver =~ /^(\d+):(.+)/ or die "bad version number '$ver'";
  29         $verhash{epoch} = $1;
  30         $ver = $2;
  31     }
  32     else
  33     {
  34         $verhash{epoch} = 0;
  35     }
  36     if ($ver =~ /(.+)-(.+)$/)
  37     {
  38         $verhash{version} = $1;
  39         $verhash{revision} = $2;
  40     }
  41     else
  42     {
  43         $verhash{version} = $ver;
  44         $verhash{revision} = 0;
  45     }
  46     return %verhash;
  47 }
  48
  49 sub verrevcmp ($$)
  50 {
  51     my ($val, $ref) = @_;
  52     for (;;)
  53     {
  54         $val =~ s/^(\D*)//;
  55         my $alphaval = $1;
  56         $ref =~ s/^(\D*)//;
  57         my $alpharef = $1;
  58         if (length $alphaval or length $alpharef)
  59         {
  60             my @avsplit = split //, $alphaval;
  61             my @arsplit = split //, $alpharef;
  62             my ($av, $ar) = (0, 0);
  63             while ($av < @avsplit and $ar < @arsplit)
  64             {
  65                 my ($v, $r) = (ord $avsplit[$av], ord $arsplit[$ar]);
  66                 $v += 256 unless chr($v) =~ /[A-Za-z]/;
  67                 $r += 256 unless chr($r) =~ /[A-Za-z]/;
  68                 return $v <=> $r if $v != $r;
  69                 $av++;
  70                 $ar++;
  71             }
  72             return 1 if $av < @avsplit;
  73             return -1 if $ar < @arsplit;
  74         }
  75
  76         return 0 unless length $val and length $ref;
  77
  78         $val =~ s/^(\d*)//;
  79         my $numval = $1;
  80         $ref =~ s/^(\d*)//;
  81         my $numref = $1;
  82         return $numval <=> $numref if $numval != $numref;
  83     }
  84 }
  85
  86 =item vercmp
  87
  88 Compare the two arguments as dpkg-style version numbers. Returns -1 if the
  89 first argument represents a lower version number than the second, 1 if the
  90 first argument represents a higher version number than the second, and 0 if
  91 the two arguments represent equal version numbers.
  92
  93 =cut
  94
  95 sub vercmp ($$)
  96 {
  97     my %version = parseversion $_[0];
  98     my %refversion = parseversion $_[1];
  99     return 1 if $version{epoch} > $refversion{epoch};
 100     return -1 if $version{epoch} < $refversion{epoch};
 101     my $r = verrevcmp $version{version}, $refversion{version};
 102     return $r if $r;
 103     return verrevcmp $version{revision}, $refversion{revision};
 104 }
 105
 106 =back
 107
 108 =head1 BUGS
 109
 110 Version numbers containing the C<~> character, used for pre-releases of
 111 packages, are not yet supported.
 112
 113 =head1 AUTHOR
 114
 115 Colin Watson E<lt>cjwatson@debian.orgE<gt>, based on the implementation in
 116 C<dpkg/lib/vercmp.c> by Ian Jackson and others.
 117
 118 =cut
 119
 120 1;