File Coverage

lib/CPANPLUS/YACSmoke/SortVers.pm
Criterion Covered Total %
statement 3 27 11.1
branch 0 22 0.0
condition 0 15 0.0
subroutine 1 3 33.3
pod 2 2 100.0
total 6 69 8.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             # $Id: Versions.pm,v 1.9 2003/08/24 22:58:14 ed Exp $
4              
5             # Copyright (c) 1996, Kenneth J. Albanowski. All rights reserved. This
6             # program is free software; you can redistribute it and/or modify it under
7             # the same terms as Perl itself.
8              
9             package CPANPLUS::YACSmoke::SortVers;
10             $CPANPLUS::YACSmoke::SortVers::VERSION = '1.08';
11             require Exporter;
12             @ISA=qw(Exporter);
13              
14             @EXPORT=qw(&versions &versioncmp);
15             @EXPORT_OK=qw();
16              
17             sub versioncmp( $$ ) {
18 0     0 1   my @A = ($_[0] =~ /([-.]|\d+|[^-.\d]+)/g);
19 0           my @B = ($_[1] =~ /([-.]|\d+|[^-.\d]+)/g);
20              
21 0           my ($A, $B);
22 0   0       while (@A and @B) {
23 0           $A = shift @A;
24 0           $B = shift @B;
25 0 0 0       if ($A eq '-' and $B eq '-') {
    0 0        
    0 0        
    0          
    0          
    0          
    0          
26 0           next;
27             } elsif ( $A eq '-' ) {
28 0           return -1;
29             } elsif ( $B eq '-') {
30 0           return 1;
31             } elsif ($A eq '.' and $B eq '.') {
32 0           next;
33             } elsif ( $A eq '.' ) {
34 0           return -1;
35             } elsif ( $B eq '.' ) {
36 0           return 1;
37             } elsif ($A =~ /^\d+$/ and $B =~ /^\d+$/) {
38 0 0 0       if ($A =~ /^0/ || $B =~ /^0/) {
39 0 0         return $A cmp $B if $A cmp $B;
40             } else {
41 0 0         return $A <=> $B if $A <=> $B;
42             }
43             } else {
44 0           $A = uc $A;
45 0           $B = uc $B;
46 0 0         return $A cmp $B if $A cmp $B;
47             }
48             }
49 0           @A <=> @B;
50             }
51              
52             sub versions() {
53 0     0 1   my $callerpkg = (caller)[0];
54 0           my $caller_a = "${callerpkg}::a";
55 0           my $caller_b = "${callerpkg}::b";
56 12     12   107 no strict 'refs';
  12         26  
  12         1109  
57 0           return versioncmp($$caller_a, $$caller_b);
58             }
59              
60             =head1 NAME
61              
62             Sort::Versions - a perl 5 module for sorting of revision-like numbers
63              
64             =head1 SYNOPSIS
65              
66             use Sort::Versions;
67             @l = sort { versioncmp($a, $b) } qw( 1.2 1.2.0 1.2a.0 1.2.a 1.a 02.a );
68              
69             ...
70              
71             use Sort::Versions;
72             print 'lower' if versioncmp('1.2', '1.2a') == -1;
73            
74             ...
75            
76             use Sort::Versions;
77             %h = (1 => 'd', 2 => 'c', 3 => 'b', 4 => 'a');
78             @h = sort { versioncmp($h{$a}, $h{$b}) } keys %h;
79              
80             =head1 DESCRIPTION
81              
82             Sort::Versions allows easy sorting of mixed non-numeric and numeric strings,
83             like the 'version numbers' that many shared library systems and revision
84             control packages use. This is quite useful if you are trying to deal with
85             shared libraries. It can also be applied to applications that intersperse
86             variable-width numeric fields within text. Other applications can
87             undoubtedly be found.
88              
89             For an explanation of the algorithm, itE<39>s simplest to look at these examples:
90              
91             1.1 < 1.2
92             1.1a < 1.2
93             1.1 < 1.1.1
94             1.1 < 1.1a
95             1.1.a < 1.1a
96             1 < a
97             a < b
98             1 < 2
99             1.1-3 < 1.1-4
100             1.1-5 < 1.1.6
101              
102             More precisely (but less comprehensibly), the two strings are treated
103             as subunits delimited by periods or hyphens. Each subunit can contain
104             any number of groups of digits or non-digits. If digit groups are
105             being compared on both sides, a numeric comparison is used, otherwise
106             a ASCII ordering is used. A group or subgroup with more units will win
107             if all comparisons are equal. A period binds digit groups together
108             more tightly than a hyphen.
109              
110             Some packages use a different style of version numbering: a simple
111             real number written as a decimal. Sort::Versions has limited support
112             for this style: when comparing two subunits which are both digit
113             groups, if either subunit has a leading zero, then both are treated
114             like digits after a decimal point. So for example:
115              
116             0002 < 1
117             1.06 < 1.5
118              
119             This wonE<39>t always work, because there wonE<39>t always be a leading zero
120             in real-number style version numbers. There is no way for
121             Sort::Versions to know which style was intended. But a lot of the time
122             it will do the right thing. If you are making up version numbers, the
123             style with (possibly) more than one dot is the style to use.
124              
125             =head1 USAGE
126              
127             =over
128              
129             =item C
130              
131             The function C takes two arguments and compares them like C.
132             With perl 5.6 or later, you can also use this function directly in sorting:
133              
134             @l = sort versioncmp qw(1.1 1.2 1.0.3);
135              
136             =item C
137              
138             The function C can be used directly as a sort function even on
139             perl 5.005 and earlier, but its use is deprecated.
140              
141             =back
142              
143             =head1 AUTHOR
144              
145             Ed Avis and Matt Johnson for
146             recent releases; the original author is Kenneth J. Albanowski
147             . Thanks to Hack Kampbjorn and Slaven Rezic for
148             patches and bug reports.
149              
150             Copyright (c) 1996, Kenneth J. Albanowski. All rights reserved. This
151             program is free software; you can redistribute it and/or modify it under the
152             same terms as Perl itself.
153              
154             =cut
155              
156             1;
157