This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to CPAN-1.83_66.
[perl5.git] / lib / CPAN / Version.pm
1 package CPAN::Version;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = sprintf "%.6f", substr(q$Rev: 1387 $,4)/1000000 + 5.4;
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;
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 vstring {
64   my($self,$n) = @_;
65   $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
66   pack "U*", split /\./, $n;
67 }
68
69 # vv => visible vstring
70 sub float2vv {
71     my($self,$n) = @_;
72     my($rev) = int($n);
73     $rev ||= 0;
74     my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
75                                           # architecture influence
76     $mantissa ||= 0;
77     $mantissa .= "0" while length($mantissa)%3;
78     my $ret = "v" . $rev;
79     while ($mantissa) {
80         $mantissa =~ s/(\d{1,3})// or
81             die "Panic: length>0 but not a digit? mantissa[$mantissa]";
82         $ret .= ".".int($1);
83     }
84     # warn "n[$n]ret[$ret]";
85     $ret;
86 }
87
88 sub readable {
89   my($self,$n) = @_;
90   $n =~ /^([\w\-\+\.]+)/;
91
92   return $1 if defined $1 && length($1)>0;
93   # if the first user reaches version v43, he will be treated as "+".
94   # We'll have to decide about a new rule here then, depending on what
95   # will be the prevailing versioning behavior then.
96
97   if ($] < 5.006) { # or whenever v-strings were introduced
98     # we get them wrong anyway, whatever we do, because 5.005 will
99     # have already interpreted 0.2.4 to be "0.24". So even if he
100     # indexer sends us something like "v0.2.4" we compare wrongly.
101
102     # And if they say v1.2, then the old perl takes it as "v12"
103
104     if (defined $CPAN::Frontend) {
105       $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
106     } else {
107       warn("Suspicious version string seen [$n]\n");
108     }
109     return $n;
110   }
111   my $better = sprintf "v%vd", $n;
112   CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
113   return $better;
114 }
115
116 1;
117
118 __END__
119
120 =head1 NAME
121
122 CPAN::Version - utility functions to compare CPAN versions
123
124 =head1 SYNOPSIS
125
126   use CPAN::Version;
127
128   CPAN::Version->vgt("1.1","1.1.1");    # 1 bc. 1.1 > 1.001001
129
130   CPAN::Version->vlt("1.1","1.1");      # 0 bc. 1.1 not < 1.1
131
132   CPAN::Version->vcmp("1.1","1.1.1");   # 1 bc. first is larger
133
134   CPAN::Version->vcmp("1.1.1","1.1");   # -1 bc. first is smaller
135
136   CPAN::Version->readable(v1.2.3);      # "v1.2.3"
137
138   CPAN::Version->vstring("v1.2.3");     # v1.2.3
139
140   CPAN::Version->float2vv(1.002003);    # "v1.2.3"
141
142 =head1 DESCRIPTION
143
144 This module mediates between some version that perl sees in a package
145 and the version that is published by the CPAN indexer.
146
147 It's only written as a helper module for both CPAN.pm and CPANPLUS.pm.
148
149 As it stands it predates version.pm but has the same goal: make
150 version strings visible and comparable.
151
152 =head1 LICENSE
153
154 This program is free software; you can redistribute it and/or
155 modify it under the same terms as Perl itself.
156
157 =cut
158
159 # Local Variables:
160 # mode: cperl
161 # cperl-indent-level: 2
162 # End: