| 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.04'; | 
| 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 | 10 |  |  | 10 |  | 86 | no strict 'refs'; | 
|  | 10 |  |  |  |  | 25 |  | 
|  | 10 |  |  |  |  | 868 |  | 
| 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 |  |  |  |  |  |  |  |