[Summary view] [Print] [Text view]

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