line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#=============================== Version.pm ================================== |
2
|
|
|
|
|
|
|
# Filename: Version.pm |
3
|
|
|
|
|
|
|
# Description: Version number handling class. |
4
|
|
|
|
|
|
|
# Original Author: Dale M. Amon |
5
|
|
|
|
|
|
|
# Revised by: $Author: amon $ |
6
|
|
|
|
|
|
|
# Date: $Date: 2008-08-28 23:14:03 $ |
7
|
|
|
|
|
|
|
# Version: $Revision: 1.8 $ |
8
|
|
|
|
|
|
|
# License: LGPL 2.1, Perl Artistic or BSD |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
#============================================================================= |
11
|
1
|
|
|
1
|
|
1189
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
162
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
package DMA::Version; |
14
|
1
|
|
|
1
|
|
6
|
use vars qw{@ISA}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1078
|
|
15
|
|
|
|
|
|
|
@ISA = qw( UNIVERSAL ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
#============================================================================= |
18
|
|
|
|
|
|
|
# Class Methods |
19
|
|
|
|
|
|
|
#============================================================================= |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
0
|
|
|
0
|
1
|
|
my ($class,$format,$gre,$numfields,@rest) = @_; |
23
|
0
|
|
|
|
|
|
my $self = bless {}, $class; |
24
|
|
|
|
|
|
|
|
25
|
0
|
0
|
|
|
|
|
$format || (return undef); |
26
|
0
|
0
|
|
|
|
|
$gre || (return undef); |
27
|
0
|
0
|
|
|
|
|
$numfields || (return undef); |
28
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
@$self{'format','gre','numfields'} = ($format,$gre,$numfields); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# If we have more args, assume we're to immediately init the version string |
32
|
0
|
0
|
|
|
|
|
($#rest lt 0) || (return ($self->setlist (@rest))); |
33
|
0
|
|
|
|
|
|
return $self; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub parse { |
39
|
0
|
|
|
0
|
1
|
|
my ($class,$lexeme, $gre) = @_; |
40
|
0
|
|
|
|
|
|
my $version; |
41
|
0
|
0
|
|
|
|
|
$lexeme || return ("",""); |
42
|
0
|
0
|
|
|
|
|
$gre || ($gre = '\d*\.\d\d'); |
43
|
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
($version,$lexeme) = ($lexeme =~ /(^$gre)?(.*)/); |
45
|
0
|
|
|
|
|
|
return ($version,$lexeme); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
#============================================================================= |
49
|
|
|
|
|
|
|
# Object Methods |
50
|
|
|
|
|
|
|
#============================================================================= |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub setVersion { |
53
|
0
|
|
|
0
|
1
|
|
my ($self,$string) = @_; |
54
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
|
my @list = ($string =~ $self->{'gre'}); |
56
|
0
|
0
|
|
|
|
|
($#list+1 eq $self->{'numfields'}) || (return undef); |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
@$self{'list','version'} = ([@list], $string); |
59
|
0
|
|
|
|
|
|
return $self; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub setlist { |
65
|
0
|
|
|
0
|
1
|
|
my ($self,@args) = @_; |
66
|
0
|
0
|
|
|
|
|
($#args+1 eq $self->{'numfields'}) || (return undef); |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
@$self{'list','version'} = ([@args], sprintf $self->{'format'}, @args); |
69
|
0
|
|
|
|
|
|
return $self; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
0
|
1
|
|
sub version {return shift->{'version'};} |
75
|
0
|
|
|
0
|
1
|
|
sub format {return shift->{'format'};} |
76
|
0
|
|
|
0
|
1
|
|
sub gre {return shift->{'gre'};} |
77
|
0
|
|
|
0
|
1
|
|
sub numfields {return shift->{'numfields'};} |
78
|
0
|
|
|
0
|
1
|
|
sub list {return shift->{'list'};} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
#============================================================================= |
81
|
|
|
|
|
|
|
# Pod Documentation |
82
|
|
|
|
|
|
|
#============================================================================= |
83
|
|
|
|
|
|
|
# You may extract and format the documentation section with the 'perldoc' cmd. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 NAME |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
DMA::Version.pm - Version number handling class. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head1 SYNOPSIS |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
use DMA::Version; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$obj = DMA::Version->new ($format, $gre, $numfields, @list); |
94
|
|
|
|
|
|
|
($version,$rest) = DMA::Version->parse ($lexeme,$gre); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
$obj = $obj->setVersion ($string); |
97
|
|
|
|
|
|
|
$obj = $obj->setlist(@list); |
98
|
|
|
|
|
|
|
$string = $obj->version; |
99
|
|
|
|
|
|
|
@list = $obj->list; |
100
|
|
|
|
|
|
|
$format = $obj->format; |
101
|
|
|
|
|
|
|
$gre = $obj->gre; |
102
|
|
|
|
|
|
|
$n = $obj->numfields; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head1 Inheritance |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
UNIVERSAL |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 Description |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
This Class handles parsing, storage and creation of version strings in any |
111
|
|
|
|
|
|
|
format you choose. To handle your desired layout of fields, you must create |
112
|
|
|
|
|
|
|
an DMA::Version object with a printf style format code to build one; a |
113
|
|
|
|
|
|
|
regular expression to break one into a number of fields; and the number of |
114
|
|
|
|
|
|
|
fields the GRE is expected to create. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
At some point we will want more direct use of Linux kernel version |
117
|
|
|
|
|
|
|
nomenclature: Version.Patchlevel.Sublevel-Extraversion. Perl and other |
118
|
|
|
|
|
|
|
applications also use variants of this. We should subclass to get special |
119
|
|
|
|
|
|
|
handling, such as methods and ivars matching the field nomenclature. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
A subclass addition might be methods to increment version elements. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
It would really be nice if we could generate a gre and numfields from a |
124
|
|
|
|
|
|
|
format string. Probably doable but probably more than an evenings work. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Also would be nice to have some algorithm for comparing version numbers in |
127
|
|
|
|
|
|
|
various ways, to be able to pose questions like, Are the Major numbers |
128
|
|
|
|
|
|
|
equal? Is the minor number of one gt, eq, lt than another? |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=head1 Examples |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
use DMA::Version; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my $foo = DMA::Version->new ("%d.%02d",'(\d*).(\d\d)',2,2,4); |
135
|
|
|
|
|
|
|
my $flg1 = $foo->parse ("3.01"); |
136
|
|
|
|
|
|
|
my $flg2 = $foo->setlist (2, 3); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my $ver = $foo->version; |
139
|
|
|
|
|
|
|
my $fmt = $foo->format; |
140
|
|
|
|
|
|
|
my $gre = $foo->gre; |
141
|
|
|
|
|
|
|
my $nf = $foo->numfields; |
142
|
|
|
|
|
|
|
my @ver = $foo->list; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
my $foo2 = DMA::Version->new ("%d.%02d.%02d",'(\d+).(\d+).(\d+)',3,2,4,20); |
145
|
|
|
|
|
|
|
my @ver2 = foo2->list; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 Class Variables |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
None. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head1 Instance Variables |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
version Version string |
154
|
|
|
|
|
|
|
list List of version all components. |
155
|
|
|
|
|
|
|
format Format to build a version string, eg"%d.%02d" |
156
|
|
|
|
|
|
|
for versions like "2.04". |
157
|
|
|
|
|
|
|
gre General regular expression to break up a string, eg |
158
|
|
|
|
|
|
|
"(\d+).(\d\d)" for "2.04" |
159
|
|
|
|
|
|
|
numfields Number of fields in the format and gre. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 Class Methods |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=over 4 |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=item B<$obj = DMA::Version-Enew ($format, $gre, $numfields, @list)> |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Build a version number object based on $format, $gre and $numfields. If there |
168
|
|
|
|
|
|
|
are no other arguments, succeed with other ivars undef. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
The format is used when generating an output version string from it's parts; |
171
|
|
|
|
|
|
|
the gre string and numfields are used when breaking down an input string into |
172
|
|
|
|
|
|
|
a list of items. Note that ' ' delimiters should be used on gre's so that |
173
|
|
|
|
|
|
|
backslashes do not get removed during arg passing. In short: |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
$format printf style format string eg, "%d.%02d" |
176
|
|
|
|
|
|
|
$gre gre to split strings into fields (should be single quoted to |
177
|
|
|
|
|
|
|
prevent \d's from becoming just d's: '(\d*).(\d\d)' |
178
|
|
|
|
|
|
|
$numfields number of fields produced by gre, eg: 2 |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
If @list args are supplied, use the supplied format to build a version string |
181
|
|
|
|
|
|
|
from them. If successful, return the object. Otherwise return undef to |
182
|
|
|
|
|
|
|
indicate failure. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
It may be of value to have a wide range of standard version strings for the |
185
|
|
|
|
|
|
|
default version parse. It also may be of value for new to handle either a list |
186
|
|
|
|
|
|
|
of version elements as above, or a single string which is passed to setVersion |
187
|
|
|
|
|
|
|
as an alternative initializer. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
It would be nice to have a way to confirm the gre arg, if present, really is a |
190
|
|
|
|
|
|
|
valid GRE. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
This is the base initializer and should be overridden and chained to by |
193
|
|
|
|
|
|
|
subclasses. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=item <($version,$rest) = DMA::Version-Eparse ($lexeme,$gre)> |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Parse $lexeme according to the optional version format described by gre. The |
198
|
|
|
|
|
|
|
default GRE, if none is specified, is '\d*.\d\d'. Note that the handling of |
199
|
|
|
|
|
|
|
the split into match and reset is handled internally so the gre argument need |
200
|
|
|
|
|
|
|
only deal with the definition of what is a version number string. Note |
201
|
|
|
|
|
|
|
that ' ' delimiters should be used on GRE's so that backslashes do not get |
202
|
|
|
|
|
|
|
removed during argument passing. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
If $lexeme contains a right justified version string, that is returned as |
205
|
|
|
|
|
|
|
$version and any remaining chars are placed in $rest. If no version is found, |
206
|
|
|
|
|
|
|
$version is and all of $lexeme is return in $rest; if $lexeme is empty or |
207
|
|
|
|
|
|
|
undef to start with, both values are . |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
It may be of value to have a wide range of standard version strings for the |
210
|
|
|
|
|
|
|
default version parse. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=back 4 |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 Instance Methods |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=over 4 |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=item B<$format = $obj-Eformat> |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Return the version format string. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=item B<$gre = $obj-Egre> |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Return the version general regular expression string. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item B<@list = $obj-Elist> |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Return the list of version elements. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=item B<$n = $obj-Enumfields> |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Return the number of fields in the format and gre. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item B<$obj = $obj-Esetlist(@list)> |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Generate the version string from @list according to our format string. Fail |
237
|
|
|
|
|
|
|
if the number of elements does not match the number of fields we require. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
This is a general class and has no way to check the types of the args |
240
|
|
|
|
|
|
|
against the format string requirements. So subclass it if that isn't good |
241
|
|
|
|
|
|
|
enough for you. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Return self on success, undef otherwise. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item B<$obj = $obj-EsetVersion ($string)> |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Break up the string into an ordered set of elements as defined by the objects |
248
|
|
|
|
|
|
|
format string. It will parse $string according to the gre and if successful, |
249
|
|
|
|
|
|
|
set the version and list parseable and return self. Return undef if $string |
250
|
|
|
|
|
|
|
is not parseable. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
A parse is deemed successful if it the gre places numfields items into list. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=item B<$string = $obj-Eversion> |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Return the version string. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=back 4 |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head1 Private Class Methods |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
None. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head1 Private Instance Methods |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
None. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head1 KNOWN BUGS |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
See TODO. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=head1 SEE ALSO |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
None. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=head1 AUTHOR |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
Dale Amon |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=cut |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
#============================================================================ |
283
|
|
|
|
|
|
|
# CVS HISTORY |
284
|
|
|
|
|
|
|
#============================================================================ |
285
|
|
|
|
|
|
|
# $Log: Version.pm,v $ |
286
|
|
|
|
|
|
|
# Revision 1.8 2008-08-28 23:14:03 amon |
287
|
|
|
|
|
|
|
# perldoc section regularization. |
288
|
|
|
|
|
|
|
# |
289
|
|
|
|
|
|
|
# Revision 1.7 2008-08-15 21:47:52 amon |
290
|
|
|
|
|
|
|
# Misc documentation and format changes. |
291
|
|
|
|
|
|
|
# |
292
|
|
|
|
|
|
|
# Revision 1.6 2008-04-18 14:07:54 amon |
293
|
|
|
|
|
|
|
# Minor documentation format changes |
294
|
|
|
|
|
|
|
# |
295
|
|
|
|
|
|
|
# Revision 1.5 2008-04-11 22:25:23 amon |
296
|
|
|
|
|
|
|
# Add blank line after cut. |
297
|
|
|
|
|
|
|
# |
298
|
|
|
|
|
|
|
# Revision 1.4 2008-04-11 18:56:35 amon |
299
|
|
|
|
|
|
|
# Fixed quoting problem with formfeeds. |
300
|
|
|
|
|
|
|
# |
301
|
|
|
|
|
|
|
# Revision 1.3 2008-04-11 18:39:15 amon |
302
|
|
|
|
|
|
|
# Implimented new standard for headers and trailers. |
303
|
|
|
|
|
|
|
# |
304
|
|
|
|
|
|
|
# Revision 1.2 2008-04-10 15:01:08 amon |
305
|
|
|
|
|
|
|
# Added license to headers, removed claim that the documentation section still |
306
|
|
|
|
|
|
|
# relates to the old doc file. |
307
|
|
|
|
|
|
|
# |
308
|
|
|
|
|
|
|
# Revision 1.1.1.1 2004-08-31 00:16:50 amon |
309
|
|
|
|
|
|
|
# Dale's library of primitives in Perl |
310
|
|
|
|
|
|
|
# |
311
|
|
|
|
|
|
|
# 20040828 Dale Amon |
312
|
|
|
|
|
|
|
# Changed parse object method to setVersion; |
313
|
|
|
|
|
|
|
# created a new parse Class method structured |
314
|
|
|
|
|
|
|
# like that in PageId. |
315
|
|
|
|
|
|
|
# |
316
|
|
|
|
|
|
|
# 20040813 Dale Amon |
317
|
|
|
|
|
|
|
# Moved to DMA:: from Archivist:: |
318
|
|
|
|
|
|
|
# to make it easier to enforce layers. |
319
|
|
|
|
|
|
|
# |
320
|
|
|
|
|
|
|
# 20021217 Dale Amon |
321
|
|
|
|
|
|
|
# Created. |
322
|
|
|
|
|
|
|
1; |