lib/CPAN/Version.pm

   1 =head1 NAME
   2
   3 CPAN::Version - utility functions to compare CPAN versions
   4
   5 =head1 SYNOPSIS
   6
   7   use CPAN::Version;
   8
   9   CPAN::Version->vgt("1.1","1.1.1");    # 1 bc. 1.1 > 1.001001
  10
  11   CPAN::Version->vlt("1.1","1.1");      # 0 bc. 1.1 not < 1.1
  12
  13   CPAN::Version->vcmp("1.1","1.1.1");   # 1 bc. first is larger
  14
  15   CPAN::Version->vcmp("1.1.1","1.1");   # -1 bc. first is smaller
  16
  17   CPAN::Version->readable(v1.2.3);      # "v1.2.3"
  18
  19   CPAN::Version->vstring("v1.2.3");     # v1.2.3
  20
  21   CPAN::Version->float2vv(1.002003);    # "v1.2.3"
  22
  23 =head1 DESCRIPTION
  24
  25 This module mediates between some version that perl sees in a package
  26 and the version that is published by the CPAN indexer.
  27
  28 It's only written as a helper module for both CPAN.pm and CPANPLUS.pm.
  29
  30 As it stands it predates version.pm but has the same goal: make
  31 version strings visible and comparable.
  32
  33 =cut
  34
  35 package CPAN::Version;
  36
  37 use strict;
  38 use vars qw($VERSION);
  39 $VERSION = sprintf "%.6f", substr(q$Rev: 561 $,4)/1000000 + 5.4;
  40
  41 # CPAN::Version::vcmp courtesy Jost Krieger
  42 sub vcmp {
  43   my($self,$l,$r) = @_;
  44   local($^W) = 0;
  45   CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
  46
  47   return 0 if $l eq $r; # short circuit for quicker success
  48
  49   for ($l,$r) {
  50       next unless tr/.// > 1;
  51       s/^v?/v/;
  52       1 while s/\.0+(\d)/.$1/;
  53   }
  54   if ($l=~/^v/ <=> $r=~/^v/) {
  55       for ($l,$r) {
  56           next if /^v/;
  57           $_ = $self->float2vv($_);
  58       }
  59   }
  60
  61   return (
  62           ($l ne "undef") <=> ($r ne "undef") ||
  63           (
  64            $] >= 5.006 &&
  65            $l =~ /^v/ &&
  66            $r =~ /^v/ &&
  67            $self->vstring($l) cmp $self->vstring($r)
  68           ) ||
  69           $l <=> $r ||
  70           $l cmp $r
  71          );
  72 }
  73
  74 sub vgt {
  75   my($self,$l,$r) = @_;
  76   $self->vcmp($l,$r) > 0;
  77 }
  78
  79 sub vlt {
  80   my($self,$l,$r) = @_;
  81   0 + ($self->vcmp($l,$r) < 0);
  82 }
  83
  84 sub vstring {
  85   my($self,$n) = @_;
  86   $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
  87   pack "U*", split /\./, $n;
  88 }
  89
  90 # vv => visible vstring
  91 sub float2vv {
  92     my($self,$n) = @_;
  93     my($rev) = int($n);
  94     $rev ||= 0;
  95     my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
  96                                           # architecture influence
  97     $mantissa ||= 0;
  98     $mantissa .= "0" while length($mantissa)%3;
  99     my $ret = "v" . $rev;
 100     while ($mantissa) {
 101         $mantissa =~ s/(\d{1,3})// or
 102             die "Panic: length>0 but not a digit? mantissa[$mantissa]";
 103         $ret .= ".".int($1);
 104     }
 105     # warn "n[$n]ret[$ret]";
 106     $ret;
 107 }
 108
 109 sub readable {
 110   my($self,$n) = @_;
 111   $n =~ /^([\w\-\+\.]+)/;
 112
 113   return $1 if defined $1 && length($1)>0;
 114   # if the first user reaches version v43, he will be treated as "+".
 115   # We'll have to decide about a new rule here then, depending on what
 116   # will be the prevailing versioning behavior then.
 117
 118   if ($] < 5.006) { # or whenever v-strings were introduced
 119     # we get them wrong anyway, whatever we do, because 5.005 will
 120     # have already interpreted 0.2.4 to be "0.24". So even if he
 121     # indexer sends us something like "v0.2.4" we compare wrongly.
 122
 123     # And if they say v1.2, then the old perl takes it as "v12"
 124
 125     if (defined $CPAN::Frontend) {
 126       $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
 127     } else {
 128       warn("Suspicious version string seen [$n]\n");
 129     }
 130     return $n;
 131   }
 132   my $better = sprintf "v%vd", $n;
 133   CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
 134   return $better;
 135 }
 136
 137 1;
 138
 139 __END__
 140
 141 # Local Variables:
 142 # mode: cperl
 143 # cperl-indent-level: 2
 144 # End: