File Coverage

lib/CPAN/Version.pm
Criterion Covered Total %
statement 40 48 83.3
branch 12 22 54.5
condition 21 25 84.0
subroutine 8 8 100.0
pod 0 6 0.0
total 81 109 74.3


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