Fix [perl #114812] Configure not finding isblank().
[perl.git] / lib / version.pm
1 #!perl -w
2 package version;
3
4 use 5.005_04;
5 use strict;
6
7 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
8
9 $VERSION = 0.99;
10
11 $CLASS = 'version';
12
13 #--------------------------------------------------------------------------#
14 # Version regexp components
15 #--------------------------------------------------------------------------#
16
17 # Fraction part of a decimal version number.  This is a common part of
18 # both strict and lax decimal versions
19
20 my $FRACTION_PART = qr/\.[0-9]+/;
21
22 # First part of either decimal or dotted-decimal strict version number.
23 # Unsigned integer with no leading zeroes (except for zero itself) to
24 # avoid confusion with octal.
25
26 my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
27
28 # First part of either decimal or dotted-decimal lax version number.
29 # Unsigned integer, but allowing leading zeros.  Always interpreted
30 # as decimal.  However, some forms of the resulting syntax give odd
31 # results if used as ordinary Perl expressions, due to how perl treats
32 # octals.  E.g.
33 #   version->new("010" ) == 10
34 #   version->new( 010  ) == 8
35 #   version->new( 010.2) == 82  # "8" . "2"
36
37 my $LAX_INTEGER_PART = qr/[0-9]+/;
38
39 # Second and subsequent part of a strict dotted-decimal version number.
40 # Leading zeroes are permitted, and the number is always decimal.
41 # Limited to three digits to avoid overflow when converting to decimal
42 # form and also avoid problematic style with excessive leading zeroes.
43
44 my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
45
46 # Second and subsequent part of a lax dotted-decimal version number.
47 # Leading zeroes are permitted, and the number is always decimal.  No
48 # limit on the numerical value or number of digits, so there is the
49 # possibility of overflow when converting to decimal form.
50
51 my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
52
53 # Alpha suffix part of lax version number syntax.  Acts like a
54 # dotted-decimal part.
55
56 my $LAX_ALPHA_PART = qr/_[0-9]+/;
57
58 #--------------------------------------------------------------------------#
59 # Strict version regexp definitions
60 #--------------------------------------------------------------------------#
61
62 # Strict decimal version number.
63
64 my $STRICT_DECIMAL_VERSION =
65     qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
66
67 # Strict dotted-decimal version number.  Must have both leading "v" and
68 # at least three parts, to avoid confusion with decimal syntax.
69
70 my $STRICT_DOTTED_DECIMAL_VERSION =
71     qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
72
73 # Complete strict version number syntax -- should generally be used
74 # anchored: qr/ \A $STRICT \z /x
75
76 $STRICT =
77     qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
78
79 #--------------------------------------------------------------------------#
80 # Lax version regexp definitions
81 #--------------------------------------------------------------------------#
82
83 # Lax decimal version number.  Just like the strict one except for
84 # allowing an alpha suffix or allowing a leading or trailing
85 # decimal-point
86
87 my $LAX_DECIMAL_VERSION =
88     qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
89         |
90         $FRACTION_PART $LAX_ALPHA_PART?
91     /x;
92
93 # Lax dotted-decimal version number.  Distinguished by having either
94 # leading "v" or at least three non-alpha parts.  Alpha part is only
95 # permitted if there are at least two non-alpha parts. Strangely
96 # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
97 # so when there is no "v", the leading part is optional
98
99 my $LAX_DOTTED_DECIMAL_VERSION =
100     qr/
101         v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
102         |
103         $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
104     /x;
105
106 # Complete lax version number syntax -- should generally be used
107 # anchored: qr/ \A $LAX \z /x
108 #
109 # The string 'undef' is a special case to make for easier handling
110 # of return values from ExtUtils::MM->parse_version
111
112 $LAX =
113     qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
114
115 #--------------------------------------------------------------------------#
116
117 # Preloaded methods go here.
118 sub import {
119     no strict 'refs';
120     my ($class) = shift;
121
122     # Set up any derived class
123     unless ($class eq 'version') {
124         local $^W;
125         *{$class.'::declare'} =  \&version::declare;
126         *{$class.'::qv'} = \&version::qv;
127     }
128
129     my %args;
130     if (@_) { # any remaining terms are arguments
131         map { $args{$_} = 1 } @_
132     }
133     else { # no parameters at all on use line
134         %args = 
135         (
136             qv => 1,
137             'UNIVERSAL::VERSION' => 1,
138         );
139     }
140
141     my $callpkg = caller();
142     
143     if (exists($args{declare})) {
144         *{$callpkg.'::declare'} = 
145             sub {return $class->declare(shift) }
146           unless defined(&{$callpkg.'::declare'});
147     }
148
149     if (exists($args{qv})) {
150         *{$callpkg.'::qv'} =
151             sub {return $class->qv(shift) }
152           unless defined(&{$callpkg.'::qv'});
153     }
154
155     if (exists($args{'VERSION'})) {
156         *{$callpkg.'::VERSION'} = \&version::_VERSION;
157     }
158
159     if (exists($args{'is_strict'})) {
160         *{$callpkg.'::is_strict'} = \&version::is_strict
161           unless defined(&{$callpkg.'::is_strict'});
162     }
163
164     if (exists($args{'is_lax'})) {
165         *{$callpkg.'::is_lax'} = \&version::is_lax
166           unless defined(&{$callpkg.'::is_lax'});
167     }
168 }
169
170 sub is_strict   { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
171 sub is_lax      { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
172
173 1;