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