home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / CPAN / Version.pm < prev   
Encoding:
Perl POD Document  |  2009-06-26  |  4.2 KB  |  174 lines
  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:
  174.