line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
2
|
|
|
|
|
|
|
## Changes file management - ~/lib/Changes/Version.pm |
3
|
|
|
|
|
|
|
## Version v0.1.0 |
4
|
|
|
|
|
|
|
## Copyright(c) 2022 DEGUEST Pte. Ltd. |
5
|
|
|
|
|
|
|
## Author: Jacques Deguest <jack@deguest.jp> |
6
|
|
|
|
|
|
|
## Created 2022/12/01 |
7
|
|
|
|
|
|
|
## Modified 2022/12/01 |
8
|
|
|
|
|
|
|
## All rights reserved |
9
|
|
|
|
|
|
|
## |
10
|
|
|
|
|
|
|
## |
11
|
|
|
|
|
|
|
## This program is free software; you can redistribute it and/or modify it |
12
|
|
|
|
|
|
|
## under the same terms as Perl itself. |
13
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
14
|
|
|
|
|
|
|
package Changes::Version; |
15
|
|
|
|
|
|
|
BEGIN |
16
|
|
|
|
|
|
|
{ |
17
|
20
|
|
|
20
|
|
114028
|
use strict; |
|
20
|
|
|
|
|
62
|
|
|
20
|
|
|
|
|
759
|
|
18
|
20
|
|
|
20
|
|
121
|
use warnings; |
|
20
|
|
|
|
|
45
|
|
|
20
|
|
|
|
|
608
|
|
19
|
20
|
|
|
20
|
|
114
|
use warnings::register; |
|
20
|
|
|
|
|
171
|
|
|
20
|
|
|
|
|
2255
|
|
20
|
20
|
|
|
20
|
|
659
|
use parent qw( Module::Generic ); |
|
20
|
|
|
|
|
341
|
|
|
20
|
|
|
|
|
117
|
|
21
|
20
|
|
|
20
|
|
11551868
|
use vars qw( $VERSION $VERSION_LAX_REGEX $DEFAULT_TYPE ); |
|
20
|
|
|
|
|
49
|
|
|
20
|
|
|
|
|
1099
|
|
22
|
20
|
|
|
20
|
|
129
|
use version (); |
|
20
|
|
|
|
|
41
|
|
|
20
|
|
|
|
|
350
|
|
23
|
20
|
|
|
20
|
|
99
|
use Nice::Try; |
|
20
|
|
|
|
|
36
|
|
|
20
|
|
|
|
|
184
|
|
24
|
|
|
|
|
|
|
# From version::regex |
25
|
|
|
|
|
|
|
# Comments in the regular expression below are taken from version::regex |
26
|
20
|
|
|
20
|
|
5700
|
our $VERSION_LAX_REGEX = qr/ |
27
|
|
|
|
|
|
|
(?<ver_str> |
28
|
|
|
|
|
|
|
# Lax dotted-decimal version number. Distinguished by having either leading "v" |
29
|
|
|
|
|
|
|
# or at least three non-alpha parts. Alpha part is only permitted if there are |
30
|
|
|
|
|
|
|
# at least two non-alpha parts. Strangely enough, without the leading "v", Perl |
31
|
|
|
|
|
|
|
# takes .1.2 to mean v0.1.2, so when there is no "v", the leading part is optional |
32
|
|
|
|
|
|
|
(?<dotted> |
33
|
|
|
|
|
|
|
(?<has_v>v) |
34
|
|
|
|
|
|
|
(?<ver> |
35
|
|
|
|
|
|
|
(?<major>[0-9]+) |
36
|
|
|
|
|
|
|
(?: |
37
|
|
|
|
|
|
|
(?<minor_patch>(?:\.[0-9]+)+) |
38
|
|
|
|
|
|
|
(?:_(?<alpha>[0-9]+))? |
39
|
|
|
|
|
|
|
)? |
40
|
|
|
|
|
|
|
) |
41
|
|
|
|
|
|
|
| |
42
|
|
|
|
|
|
|
(?<ver> |
43
|
|
|
|
|
|
|
(?<major>[0-9]+)? |
44
|
|
|
|
|
|
|
(?<minor_patch>(?:\.[0-9]+){2,}) |
45
|
|
|
|
|
|
|
(?:_(?<alpha>[0-9]+))? |
46
|
|
|
|
|
|
|
) |
47
|
|
|
|
|
|
|
) |
48
|
|
|
|
|
|
|
| |
49
|
|
|
|
|
|
|
# Lax decimal version number. Just like the strict one except for allowing an |
50
|
|
|
|
|
|
|
# alpha suffix or allowing a leading or trailing decimal-point |
51
|
|
|
|
|
|
|
(?<decimal> |
52
|
|
|
|
|
|
|
(?<ver>(?<release>(?<major>[0-9]+) (?: (?:\.(?<minor>[0-9]+)) | \. )?) (?:_(?<alpha>[0-9]+))?) |
53
|
|
|
|
|
|
|
| |
54
|
|
|
|
|
|
|
(?<ver>(?:\.(?<release>(?<major>[0-9]+))) (?:_(?<alpha>[0-9]+))?) |
55
|
|
|
|
|
|
|
) |
56
|
|
|
|
|
|
|
)/x; |
57
|
20
|
|
|
|
|
51
|
our $DEFAULT_TYPE = 'dotted'; |
58
|
|
|
|
|
|
|
use overload ( |
59
|
|
|
|
|
|
|
'""' => \&as_string, |
60
|
|
|
|
|
|
|
# '=' => \&clone, |
61
|
|
|
|
|
|
|
'0+' => \&numify, |
62
|
|
|
|
|
|
|
'<=>' => \&_compare, |
63
|
|
|
|
|
|
|
'cmp' => \&_compare, |
64
|
|
|
|
|
|
|
'bool' => \&_bool, |
65
|
12
|
|
|
12
|
|
4147
|
'+' => sub { return( shift->_compute( @_, { op => '+' }) ); }, |
66
|
12
|
|
|
12
|
|
4180
|
'-' => sub { return( shift->_compute( @_, { op => '-' }) ); }, |
67
|
12
|
|
|
12
|
|
4226
|
'*' => sub { return( shift->_compute( @_, { op => '*' }) ); }, |
68
|
12
|
|
|
12
|
|
4014
|
'/' => sub { return( shift->_compute( @_, { op => '/' }) ); }, |
69
|
8
|
|
|
8
|
|
2669
|
'+=' => sub { return( shift->_compute( @_, { op => '+=' }) ); }, |
70
|
8
|
|
|
8
|
|
2675
|
'-=' => sub { return( shift->_compute( @_, { op => '-=' }) ); }, |
71
|
8
|
|
|
8
|
|
3059
|
'*=' => sub { return( shift->_compute( @_, { op => '*=' }) ); }, |
72
|
8
|
|
|
8
|
|
2725
|
'/=' => sub { return( shift->_compute( @_, { op => '/=' }) ); }, |
73
|
8
|
|
|
8
|
|
66
|
'++' => sub { return( shift->_compute( @_, { op => '++' }) ); }, |
74
|
8
|
|
|
8
|
|
68
|
'--' => sub { return( shift->_compute( @_, { op => '--' }) ); }, |
75
|
|
|
|
|
|
|
# We put it here so perl won't trigger the noop overload method |
76
|
16
|
|
|
16
|
|
5258
|
'=' => sub { $_[0] }, |
77
|
20
|
|
|
|
|
633
|
'abs' => \&_noop, |
78
|
|
|
|
|
|
|
'nomethod' => \&_noop, |
79
|
20
|
|
|
20
|
|
34334342
|
); |
|
20
|
|
|
|
|
60
|
|
80
|
20
|
|
|
|
|
433
|
our $VERSION = 'v0.1.0'; |
81
|
|
|
|
|
|
|
}; |
82
|
|
|
|
|
|
|
|
83
|
20
|
|
|
20
|
|
147
|
use strict; |
|
20
|
|
|
|
|
45
|
|
|
20
|
|
|
|
|
583
|
|
84
|
20
|
|
|
20
|
|
129
|
use warnings; |
|
20
|
|
|
|
|
36
|
|
|
20
|
|
|
|
|
13947
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub init |
87
|
|
|
|
|
|
|
{ |
88
|
132
|
|
|
132
|
1
|
19743
|
my $self = shift( @_ ); |
89
|
|
|
|
|
|
|
# XXX |
90
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::init: called with args: '", join( "', '", map( defined( $_ ) ? $_ : 'undef', @_ ) ), "'\n" ); |
91
|
132
|
|
|
|
|
576
|
$self->{alpha} = undef; |
92
|
|
|
|
|
|
|
# Used for other version types |
93
|
132
|
|
|
|
|
349
|
$self->{beta} = undef; |
94
|
132
|
|
|
|
|
379
|
$self->{compat} = 0; |
95
|
|
|
|
|
|
|
# What version fragment to increase/decrease by default, such as when we do operations like $v++ or $v-- |
96
|
132
|
|
|
|
|
410
|
$self->{default_frag} = 'minor'; |
97
|
132
|
|
|
|
|
346
|
$self->{extra} = []; |
98
|
132
|
|
|
|
|
318
|
$self->{major} = undef; |
99
|
132
|
|
|
|
|
296
|
$self->{minor} = undef; |
100
|
132
|
|
|
|
|
408
|
$self->{original} = undef; |
101
|
132
|
|
|
|
|
346
|
$self->{padded} = 1; |
102
|
132
|
|
|
|
|
283
|
$self->{patch} = undef; |
103
|
132
|
|
|
|
|
296
|
$self->{pretty} = 0; |
104
|
132
|
|
|
|
|
347
|
$self->{qv} = 0; |
105
|
|
|
|
|
|
|
# Release candidate used by non-perl open source softwares |
106
|
132
|
|
|
|
|
306
|
$self->{rc} = undef; |
107
|
132
|
|
|
|
|
352
|
$self->{target} = 'perl'; |
108
|
132
|
|
|
|
|
260
|
$self->{type} = undef; |
109
|
132
|
|
|
|
|
836
|
my $keys = [qw( alpha beta compat default_frag extra major minor original patch qv rc target type _version )]; |
110
|
132
|
|
|
|
|
228
|
my $vstr; |
111
|
|
|
|
|
|
|
# Changes::Version->new( 'v0.1.2_3' ); or |
112
|
|
|
|
|
|
|
# Changes::Version->new( 'v0.1.2_3', alpha => 4 ); or |
113
|
|
|
|
|
|
|
# Changes::Version->new( 'v0.1.2_3', { alpha => 4 } ); or |
114
|
|
|
|
|
|
|
# Changes::Version->new( major => 0, minor => 1, patch => 2, alpha => 3, qv => 1 ); or |
115
|
|
|
|
|
|
|
# Changes::Version->new({ major => 0, minor => 1, patch => 2, alpha => 3, qv => 1 }); or |
116
|
132
|
100
|
33
|
|
|
2131
|
if( ( @_ == 1 && ref( $_[0] ) ne 'HASH' ) || |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
117
|
|
|
|
|
|
|
( @_ > 1 && ref( $_[0] ) ne 'HASH' && ( ( @_ % 2 ) || ref( $_[1] ) eq 'HASH' ) ) ) |
118
|
|
|
|
|
|
|
{ |
119
|
42
|
|
|
|
|
125
|
$vstr = shift( @_ ); |
120
|
42
|
50
|
33
|
|
|
327
|
return( $self->error( "version string provided is empty." ) ) if( !defined( $vstr ) || !length( "$vstr" ) ); |
121
|
|
|
|
|
|
|
# So we can get options like debug for parser |
122
|
42
|
|
|
|
|
268
|
my $opts = $self->_get_args_as_hash( @_ ); |
123
|
42
|
100
|
66
|
|
|
6298
|
$self->debug( $opts->{debug} ) if( exists( $opts->{debug} ) && defined( $opts->{debug} ) && length( "$opts->{debug}" ) ); |
|
|
|
66
|
|
|
|
|
124
|
|
|
|
|
|
|
# A version string was provided, so we parse it |
125
|
42
|
|
|
|
|
284
|
my $v = $self->parse( $vstr ); |
126
|
42
|
50
|
|
|
|
178
|
return( $self->pass_error ) if( !defined( $v ) ); |
127
|
|
|
|
|
|
|
# And we copy the collected value as default values for our new object, which can then be overriden by additional option passed here. |
128
|
42
|
|
|
|
|
819
|
@$self{ @$keys } = @$v{ @$keys }; |
129
|
|
|
|
|
|
|
# XXX |
130
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::init: \$v -> ", $self->dump( $v ), "\n" ); |
131
|
|
|
|
|
|
|
} |
132
|
132
|
|
|
|
|
502
|
$self->{_init_strict_use_sub} = 1; |
133
|
|
|
|
|
|
|
# XXX |
134
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::init: passing \@_ to SUPER::init: '", join( "', '", @_ ), "'\n" ); |
135
|
132
|
|
|
|
|
849
|
my $rv = $self->SUPER::init( @_ ); |
136
|
|
|
|
|
|
|
# XXX |
137
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::init: \$rv is defined ? ", ( defined( $rv ) ? 'yes' : 'no' ), "\n" ); |
138
|
132
|
50
|
|
|
|
429808
|
return( $self->pass_error ) if( !defined( $rv ) ); |
139
|
132
|
|
|
|
|
786
|
return( $self ); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
439
|
|
|
439
|
1
|
21177
|
sub alpha { return( shift->reset(@_)->_set_get_number( { field => 'alpha', undef_ok => 1 }, @_ ) ); } |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub as_string |
145
|
|
|
|
|
|
|
{ |
146
|
309
|
|
|
309
|
1
|
185179
|
my $self = shift( @_ ); |
147
|
|
|
|
|
|
|
# XXX |
148
|
|
|
|
|
|
|
# my $caller = [caller]; |
149
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::as_string: called from file $caller->[1] at line $caller->[2]\n" ); |
150
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::as_string: _reset exists? ", ( exists( $self->{_reset} ) ? 'yes' : 'no' ), "\n" ); |
151
|
309
|
50
|
66
|
|
|
2153
|
if( !exists( $self->{_reset} ) || |
|
|
|
33
|
|
|
|
|
152
|
|
|
|
|
|
|
!defined( $self->{_reset} ) || |
153
|
|
|
|
|
|
|
!CORE::length( $self->{_reset} ) ) |
154
|
|
|
|
|
|
|
{ |
155
|
192
|
|
100
|
|
|
2276
|
$self->message( 5, "Reset is disabled, checking for cache value '", ( $self->{_cache_value} // '' ), "' and raw cache '", ( $self->{raw} // '' ), "'" ); |
|
|
|
50
|
|
|
|
|
156
|
192
|
100
|
66
|
|
|
6516
|
if( exists( $self->{_cache_value} ) && |
|
|
50
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
157
|
|
|
|
|
|
|
defined( $self->{_cache_value} ) && |
158
|
|
|
|
|
|
|
length( $self->{_cache_value} ) ) |
159
|
|
|
|
|
|
|
{ |
160
|
68
|
|
|
|
|
628
|
return( $self->{_cache_value} ); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
elsif( defined( $self->{original} ) && length( "$self->{original}" ) ) |
163
|
|
|
|
|
|
|
{ |
164
|
124
|
|
|
|
|
1564
|
$self->message( 5, "Re-using the original cache '", $self->{original}->scalar, "' (", overload::StrVal( $self->{original} ), ")." ); |
165
|
124
|
|
|
|
|
4181
|
return( $self->{original}->scalar ); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
117
|
|
|
|
|
416
|
my $type = $self->type; |
169
|
117
|
|
|
|
|
25943
|
my $str; |
170
|
117
|
100
|
100
|
|
|
928
|
if( ( defined( $type ) && $type eq 'dotted' ) || |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
171
|
|
|
|
|
|
|
( !defined( $type ) && $DEFAULT_TYPE eq 'dotted' ) ) |
172
|
|
|
|
|
|
|
{ |
173
|
59
|
|
|
|
|
257
|
$str = $self->normal( raw => 1 ); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
else |
176
|
|
|
|
|
|
|
{ |
177
|
58
|
|
|
|
|
1013
|
$str = $self->numify( raw => 1 ); |
178
|
58
|
100
|
66
|
|
|
243
|
if( !$self->padded && index( $str, '_' ) == -1 ) |
179
|
|
|
|
|
|
|
{ |
180
|
2
|
|
|
|
|
346
|
return( $str * 1 ); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
56
|
100
|
100
|
|
|
9008
|
if( $self->pretty && index( $str, '_' ) == -1 && !( length( [split( /\./, $str )]->[1] ) % 3 ) ) |
|
|
|
66
|
|
|
|
|
184
|
|
|
|
|
|
|
{ |
185
|
|
|
|
|
|
|
# $str = join( '_', grep{ $_ ne ''} split( /(...)/, $str ) ); |
186
|
|
|
|
|
|
|
# Credit: <https://stackoverflow.com/questions/33442240/perl-printf-to-use-commas-as-thousands-separator> |
187
|
3
|
|
|
|
|
484
|
while( $str =~ s/(\d+)(\d{3})/$1\_$2/ ){}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
} |
190
|
115
|
|
|
|
|
7773
|
$self->{_cache_value} = $str; |
191
|
115
|
|
|
|
|
341
|
CORE::delete( $self->{_reset} ); |
192
|
115
|
|
|
|
|
773
|
return( $str ); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
{ |
196
|
20
|
|
|
20
|
|
194
|
no warnings 'once'; |
|
20
|
|
|
|
|
52
|
|
|
20
|
|
|
|
|
29225
|
|
197
|
|
|
|
|
|
|
*stringify = \&as_string; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
0
|
|
|
0
|
1
|
0
|
sub beta { return( shift->reset(@_)->_set_get_number( { field => 'beta', undef_ok => 1 }, @_ ) ); } |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# NOTE: clone() is inherited |
203
|
|
|
|
|
|
|
|
204
|
1
|
|
|
1
|
1
|
5
|
sub compat { return( shift->_set_get_boolean( 'compat', @_ ) ); } |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
0
|
1
|
0
|
sub dec { return( shift->_inc_dec( 'dec', @_ ) ); } |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
0
|
1
|
0
|
sub dec_alpha { return( shift->_inc_dec( 'dec' => 'alpha', @_ ) ); } |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# For non-perl open source softwares |
211
|
0
|
|
|
0
|
1
|
0
|
sub dec_beta { return( shift->_inc_dec( 'dec' => 'beta', @_ ) ); } |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
0
|
1
|
0
|
sub dec_major { return( shift->_inc_dec( 'dec' => 'major', @_ ) ); } |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
0
|
1
|
0
|
sub dec_minor { return( shift->_inc_dec( 'dec' => 'minor', @_ ) ); } |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
0
|
1
|
0
|
sub dec_patch { return( shift->_inc_dec( 'dec' => 'patch', @_ ) ); } |
218
|
|
|
|
|
|
|
|
219
|
288
|
|
|
288
|
1
|
383977
|
sub default_frag { return( shift->_set_get_scalar_as_object( 'default_frag', @_ ) ); } |
220
|
|
|
|
|
|
|
|
221
|
273
|
|
|
273
|
1
|
329661
|
sub extra { return( shift->_set_get_array_as_object( 'extra', @_ ) ); } |
222
|
|
|
|
|
|
|
|
223
|
4
|
|
|
4
|
1
|
17
|
sub inc { return( shift->_inc_dec( 'inc', @_ ) ); } |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
0
|
1
|
0
|
sub inc_alpha { return( shift->_inc_dec( 'inc' => 'alpha', @_ ) ); } |
226
|
|
|
|
|
|
|
|
227
|
0
|
|
|
0
|
1
|
0
|
sub inc_beta { return( shift->_inc_dec( 'inc' => 'beta', @_ ) ); } |
228
|
|
|
|
|
|
|
|
229
|
0
|
|
|
0
|
1
|
0
|
sub inc_major { return( shift->_inc_dec( 'inc' => 'major', @_ ) ); } |
230
|
|
|
|
|
|
|
|
231
|
0
|
|
|
0
|
1
|
0
|
sub inc_minor { return( shift->_inc_dec( 'inc' => 'minor', @_ ) ); } |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
0
|
1
|
0
|
sub inc_patch { return( shift->_inc_dec( 'inc' => 'patch', @_ ) ); } |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
|
0
|
1
|
0
|
sub is_alpha { return( shift->alpha->length > 0 ? 1 : 0 ); } |
236
|
|
|
|
|
|
|
|
237
|
0
|
0
|
|
0
|
1
|
0
|
sub is_qv { return( shift->qv ? 1 : 0 ); } |
238
|
|
|
|
|
|
|
|
239
|
346
|
|
|
346
|
1
|
246052
|
sub major { return( shift->reset(@_)->_set_get_number( { field => 'major', undef_ok => 1 }, @_ ) ); } |
240
|
|
|
|
|
|
|
|
241
|
367
|
|
|
367
|
1
|
3791330
|
sub minor { return( shift->reset(@_)->_set_get_number( { field => 'minor', undef_ok => 1 }, @_ ) ); } |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub normal |
244
|
|
|
|
|
|
|
{ |
245
|
60
|
|
|
60
|
1
|
119
|
my $self = shift( @_ ); |
246
|
60
|
|
|
|
|
257
|
my $opts = $self->_get_args_as_hash( @_ ); |
247
|
60
|
|
100
|
|
|
7786
|
$opts->{raw} //= 0; |
248
|
60
|
|
|
|
|
130
|
my $v; |
249
|
60
|
50
|
33
|
|
|
171
|
try |
|
60
|
|
|
|
|
101
|
|
|
60
|
|
|
|
|
116
|
|
|
60
|
|
|
|
|
213
|
|
|
0
|
|
|
|
|
0
|
|
|
60
|
|
|
|
|
83
|
|
|
60
|
|
|
|
|
165
|
|
|
60
|
|
|
|
|
152
|
|
250
|
60
|
|
|
60
|
|
106
|
{ |
251
|
60
|
|
|
|
|
1798
|
my $clone = $self->clone; |
252
|
60
|
100
|
|
|
|
78327
|
if( !$self->qv ) |
253
|
|
|
|
|
|
|
{ |
254
|
1
|
|
|
|
|
158
|
$clone->qv(1); |
255
|
|
|
|
|
|
|
} |
256
|
60
|
100
|
|
|
|
9895
|
if( $opts->{raw} ) |
257
|
|
|
|
|
|
|
{ |
258
|
59
|
|
|
|
|
208
|
$v = $clone->_stringify; |
259
|
59
|
|
|
|
|
808
|
$self->message( 4, "Wants raw. String is already formatted with qv, returning '$v'" ); |
260
|
|
|
|
|
|
|
# We already did it with stringify, so we return what we got |
261
|
59
|
|
|
|
|
1591
|
return( $v ); |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
else |
264
|
|
|
|
|
|
|
{ |
265
|
1
|
|
|
|
|
7
|
$self->message( 4, "Does not want raw. String is already formatted with qv, returning a clone of self" ); |
266
|
1
|
|
|
|
|
25
|
$clone->type( 'dotted' ); |
267
|
1
|
|
|
|
|
221
|
return( $clone ); |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} |
270
|
60
|
0
|
0
|
|
|
283
|
catch( $e ) |
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
60
|
0
|
|
|
|
120
|
|
|
60
|
0
|
|
|
|
83
|
|
|
60
|
0
|
|
|
|
94
|
|
|
60
|
0
|
|
|
|
103
|
|
|
60
|
0
|
|
|
|
264
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
60
|
|
|
|
|
207
|
|
|
0
|
|
|
|
|
0
|
|
|
60
|
|
|
|
|
115
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
60
|
|
|
|
|
22866
|
|
|
60
|
|
|
|
|
297
|
|
|
60
|
|
|
|
|
150
|
|
|
60
|
|
|
|
|
196
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
271
|
0
|
|
|
0
|
|
0
|
{ |
272
|
0
|
|
|
|
|
0
|
return( $self->error( "Error normalising version $v: $e" ) ); |
273
|
20
|
0
|
0
|
20
|
|
197
|
} |
|
20
|
0
|
0
|
|
|
51
|
|
|
20
|
0
|
33
|
|
|
23632
|
|
|
0
|
0
|
66
|
|
|
0
|
|
|
0
|
0
|
66
|
|
|
0
|
|
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
60
|
0
|
|
|
|
154
|
|
|
0
|
0
|
|
|
|
0
|
|
|
60
|
50
|
|
|
|
471
|
|
|
60
|
50
|
|
|
|
311
|
|
|
60
|
50
|
|
|
|
185
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
60
|
|
|
|
|
760
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub numify |
277
|
|
|
|
|
|
|
{ |
278
|
59
|
|
|
59
|
1
|
123
|
my $self = shift( @_ ); |
279
|
59
|
|
|
|
|
266
|
my $opts = $self->_get_args_as_hash( @_ ); |
280
|
59
|
|
100
|
|
|
7635
|
$opts->{raw} //= 0; |
281
|
59
|
|
|
|
|
99
|
my $v; |
282
|
59
|
50
|
33
|
|
|
187
|
try |
|
59
|
|
|
|
|
101
|
|
|
59
|
|
|
|
|
99
|
|
|
59
|
|
|
|
|
215
|
|
|
0
|
|
|
|
|
0
|
|
|
59
|
|
|
|
|
85
|
|
|
59
|
|
|
|
|
166
|
|
|
59
|
|
|
|
|
124
|
|
283
|
59
|
|
|
59
|
|
77
|
{ |
284
|
59
|
100
|
|
|
|
136
|
if( $opts->{raw} ) |
285
|
|
|
|
|
|
|
{ |
286
|
|
|
|
|
|
|
# If alpha is set, such as when we convert a dotted decimal into a decimal, we need to remove it and add it back later, because version mess it up |
287
|
|
|
|
|
|
|
# For example: version->parse( '1.0_3' )->normal yields v1.30.0 instead of v1.0.0_3 whereas version->parse( '1.0' )->normal yields correctly v1.0.0 |
288
|
58
|
|
|
|
|
1706
|
my $clone = $self->clone; |
289
|
58
|
|
|
|
|
74157
|
my $alpha = $clone->alpha; |
290
|
58
|
|
|
|
|
10809
|
$clone->alpha( undef ); |
291
|
58
|
|
|
|
|
11284
|
$v = $clone->_stringify; |
292
|
58
|
|
100
|
|
|
921
|
$self->message( 4, "Alpha value is '", ( $alpha // '' ), "'. Stringified version string, before calling version, is: $v" ); |
293
|
58
|
|
|
|
|
2365
|
my $str = version->parse( $v )->numify; |
294
|
58
|
100
|
66
|
|
|
364
|
$str .= "_${alpha}" if( defined( $alpha ) && length( "$alpha" ) ); |
295
|
58
|
100
|
66
|
|
|
663
|
$self->message( 4, "Numified version string is '$str', appending alpha ? ", ( ( defined( $alpha ) && length( "$alpha" ) ) ? "'_${alpha}'" : 'no' ) ); |
296
|
58
|
|
|
|
|
1545
|
return( $str ); |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
else |
299
|
|
|
|
|
|
|
{ |
300
|
1
|
|
|
|
|
4
|
$self->message( 4, "Returning cloned object for numified version." ); |
301
|
1
|
|
|
|
|
48
|
my $new = $self->clone; |
302
|
|
|
|
|
|
|
# This will also remove qv boolean |
303
|
1
|
|
|
|
|
1216
|
$new->type( 'decimal' ); |
304
|
1
|
|
|
|
|
222
|
return( $new ); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
} |
307
|
59
|
0
|
0
|
|
|
361
|
catch( $e ) |
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
59
|
0
|
|
|
|
114
|
|
|
59
|
0
|
|
|
|
87
|
|
|
59
|
0
|
|
|
|
96
|
|
|
59
|
0
|
|
|
|
105
|
|
|
59
|
0
|
|
|
|
214
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
59
|
|
|
|
|
197
|
|
|
0
|
|
|
|
|
0
|
|
|
59
|
|
|
|
|
92
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
59
|
|
|
|
|
22369
|
|
|
59
|
|
|
|
|
306
|
|
|
59
|
|
|
|
|
133
|
|
|
59
|
|
|
|
|
185
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
308
|
0
|
|
|
0
|
|
0
|
{ |
309
|
0
|
|
|
|
|
0
|
return( $self->error( "Error numifying version $v: $e" ) ); |
310
|
20
|
0
|
0
|
20
|
|
181
|
} |
|
20
|
0
|
0
|
|
|
49
|
|
|
20
|
0
|
33
|
|
|
36636
|
|
|
0
|
0
|
66
|
|
|
0
|
|
|
0
|
0
|
66
|
|
|
0
|
|
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
59
|
0
|
|
|
|
166
|
|
|
0
|
0
|
|
|
|
0
|
|
|
59
|
50
|
|
|
|
514
|
|
|
59
|
50
|
|
|
|
359
|
|
|
59
|
50
|
|
|
|
193
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
59
|
|
|
|
|
928
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
89
|
|
|
89
|
1
|
435345
|
sub original { return( shift->_set_get_scalar_as_object( 'original', @_ ) ); } |
314
|
|
|
|
|
|
|
|
315
|
61
|
|
|
61
|
1
|
184
|
sub padded { return( shift->reset(@_)->_set_get_boolean( 'padded', @_ ) ); } |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub parse |
318
|
|
|
|
|
|
|
{ |
319
|
89
|
|
|
89
|
1
|
48312
|
my $self = shift( @_ ); |
320
|
89
|
|
|
|
|
260
|
my $str = shift( @_ ); |
321
|
89
|
50
|
33
|
|
|
754
|
return( $self->error( "No version string was provided." ) ) if( !defined( $str ) || !length( "$str" ) ); |
322
|
89
|
50
|
|
|
|
3403
|
if( $str =~ /^$VERSION_LAX_REGEX$/ ) |
323
|
|
|
|
|
|
|
{ |
324
|
89
|
|
|
|
|
2862
|
my $re = { %+ }; |
325
|
89
|
|
|
0
|
|
1507
|
$self->message( 4, "Found version with regexp data -> ", sub{ $self->dump( $re ) } ); |
|
0
|
|
|
|
|
0
|
|
326
|
89
|
|
|
|
|
5140
|
my $def = { original => $str }; |
327
|
89
|
100
|
66
|
|
|
1103
|
if( defined( $re->{dotted} ) && length( $re->{dotted} ) ) |
|
|
50
|
33
|
|
|
|
|
328
|
|
|
|
|
|
|
{ |
329
|
10
|
|
|
|
|
33
|
$def->{type} = 'dotted'; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
elsif( defined( $re->{decimal} ) && length( $re->{decimal} ) ) |
332
|
|
|
|
|
|
|
{ |
333
|
79
|
|
|
|
|
342
|
$def->{type} = 'decimal'; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
else |
336
|
|
|
|
|
|
|
{ |
337
|
0
|
|
|
|
|
0
|
return( $self->error( "No version types found. This should not happen." ) ); |
338
|
|
|
|
|
|
|
} |
339
|
89
|
|
|
|
|
171
|
my $v; |
340
|
89
|
100
|
66
|
|
|
515
|
$def->{qv} = 1 if( defined( $re->{has_v} ) && length( $re->{has_v} ) ); |
341
|
89
|
|
|
|
|
297
|
$def->{major} = $re->{major}; |
342
|
89
|
100
|
66
|
|
|
774
|
$def->{alpha} = $re->{alpha} if( defined( $re->{alpha} ) && length( $re->{alpha} ) ); |
343
|
89
|
100
|
|
|
|
516
|
if( $def->{type} eq 'dotted' ) |
|
|
50
|
|
|
|
|
|
344
|
|
|
|
|
|
|
{ |
345
|
10
|
50
|
|
|
|
41
|
if( defined( $re->{minor_patch} ) ) |
346
|
|
|
|
|
|
|
{ |
347
|
10
|
|
|
|
|
57
|
my @frags = split( /\./, $re->{minor_patch} ); |
348
|
10
|
|
|
|
|
25
|
shift( @frags ); |
349
|
10
|
|
|
|
|
25
|
$def->{minor} = shift( @frags ); |
350
|
10
|
|
|
|
|
29
|
$def->{patch} = shift( @frags ); |
351
|
10
|
|
|
|
|
30
|
$def->{extra} = \@frags; |
352
|
|
|
|
|
|
|
} |
353
|
10
|
|
|
|
|
148
|
$v = version->parse( $re->{dotted} ); |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
elsif( $def->{type} eq 'decimal' ) |
356
|
|
|
|
|
|
|
{ |
357
|
|
|
|
|
|
|
# $def->{minor} = $re->{minor} if( defined( $re->{minor} ) ); |
358
|
|
|
|
|
|
|
# $re->{release} is the decimal version without the alpha information if it is smaller than 3 |
359
|
|
|
|
|
|
|
# This issue stems from decimal number having an underscore can either mean they have a version like |
360
|
|
|
|
|
|
|
# 5.006_002 which would be equivalent v5.6.2 and in this case, "_002" is not an alpha information; and |
361
|
|
|
|
|
|
|
# 1.002_03 where 03 is the alpha version and should be converted to 1.2_03, but instead becomes v1.2.30 |
362
|
|
|
|
|
|
|
# If compatibility with 'compat' is enabled, then we use the classic albeit erroneous way of converting the decimal version |
363
|
79
|
100
|
66
|
|
|
444
|
if( defined( $def->{alpha} ) && |
|
|
|
66
|
|
|
|
|
364
|
|
|
|
|
|
|
length( $def->{alpha} ) < 3 && |
365
|
|
|
|
|
|
|
!$self->compat ) |
366
|
|
|
|
|
|
|
{ |
367
|
1
|
|
|
|
|
169
|
$self->message( 5, "Decimal version has alpha value. Getting version object from '$re->{release}'" ); |
368
|
1
|
|
|
|
|
29
|
$v = version->parse( "$re->{release}" ); |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
else |
371
|
|
|
|
|
|
|
{ |
372
|
78
|
|
|
|
|
512
|
$self->message( 5, "Getting version object from '$str'" ); |
373
|
78
|
|
|
|
|
2789
|
$v = version->parse( "$str" ); |
374
|
|
|
|
|
|
|
} |
375
|
79
|
|
|
|
|
774
|
my $vstr = $v->normal; |
376
|
79
|
|
|
|
|
776
|
$self->message( 5, "Sub parsing normalised version '$v'" ); |
377
|
79
|
50
|
|
|
|
4061
|
if( $vstr =~ /^$VERSION_LAX_REGEX$/ ) |
378
|
|
|
|
|
|
|
{ |
379
|
79
|
|
|
|
|
1927
|
my $re2 = { %+ }; |
380
|
79
|
|
|
0
|
|
910
|
$self->message( 5, "Subparsing yielded -> ", sub{ $self->dump( $re2 ) } ); |
|
0
|
|
|
|
|
0
|
|
381
|
79
|
50
|
33
|
|
|
2739
|
if( defined( $re2->{dotted} ) && length( $re2->{dotted} ) ) |
382
|
|
|
|
|
|
|
{ |
383
|
79
|
50
|
|
|
|
336
|
if( defined( $re2->{minor_patch} ) ) |
384
|
|
|
|
|
|
|
{ |
385
|
79
|
|
|
|
|
231
|
$def->{major} = $re2->{major}; |
386
|
79
|
|
|
|
|
421
|
my @frags = split( /\./, $re2->{minor_patch} ); |
387
|
79
|
|
|
|
|
173
|
shift( @frags ); |
388
|
79
|
|
|
|
|
234
|
$def->{minor} = shift( @frags ); |
389
|
79
|
|
|
|
|
233
|
$def->{patch} = shift( @frags ); |
390
|
79
|
|
|
|
|
423
|
$def->{extra} = \@frags; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
} |
395
|
89
|
|
|
0
|
|
705
|
$self->message( 5, "Version components are -> ", sub{ $self->dump( $def ) } ); |
|
0
|
|
|
|
|
0
|
|
396
|
89
|
|
|
|
|
2689
|
my $new = $self->new( %$def ); |
397
|
89
|
50
|
|
|
|
1004
|
$new->{_version} = $v if( defined( $v ) ); |
398
|
89
|
50
|
|
|
|
406
|
return( $self->pass_error ) if( !defined( $new ) ); |
399
|
89
|
|
|
|
|
285
|
CORE::delete( $new->{_reset} ); |
400
|
89
|
|
|
|
|
1427
|
return( $new ); |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
else |
403
|
|
|
|
|
|
|
{ |
404
|
0
|
|
|
|
|
0
|
return( $self->error( "Invalid version '$str'" ) ); |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
390
|
|
|
390
|
1
|
359260
|
sub patch { return( shift->reset(@_)->_set_get_number( { field => 'patch', undef_ok => 1 }, @_ ) ); } |
409
|
|
|
|
|
|
|
|
410
|
57
|
|
|
57
|
1
|
177
|
sub pretty { return( shift->reset(@_)->_set_get_boolean( 'pretty', @_ ) ); } |
411
|
|
|
|
|
|
|
|
412
|
448
|
|
|
448
|
1
|
20880
|
sub qv { return( shift->reset(@_)->_set_get_boolean( 'qv', @_ ) ); } |
413
|
|
|
|
|
|
|
|
414
|
0
|
|
|
0
|
1
|
0
|
sub rc { return( shift->_set_get_scalar_as_object( 'rc', @_ ) ); } |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub reset |
417
|
|
|
|
|
|
|
{ |
418
|
2509
|
|
|
2509
|
1
|
3835
|
my $self = shift( @_ ); |
419
|
2509
|
100
|
33
|
|
|
16302
|
if( ( |
|
|
|
100
|
|
|
|
|
420
|
|
|
|
|
|
|
!exists( $self->{_reset} ) || |
421
|
|
|
|
|
|
|
!defined( $self->{_reset} ) || |
422
|
|
|
|
|
|
|
!CORE::length( $self->{_reset} ) |
423
|
|
|
|
|
|
|
) && scalar( @_ ) ) |
424
|
|
|
|
|
|
|
{ |
425
|
|
|
|
|
|
|
# XXX |
426
|
|
|
|
|
|
|
# my $trace = $self->_get_stack_trace; |
427
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::reset called with trace $trace\n" ); |
428
|
163
|
|
|
|
|
521
|
$self->{_reset} = scalar( @_ ); |
429
|
163
|
100
|
|
|
|
671
|
if( defined( $self->{major} ) ) |
430
|
|
|
|
|
|
|
{ |
431
|
73
|
|
|
|
|
286
|
my $str = $self->_stringify; |
432
|
73
|
50
|
33
|
|
|
741
|
try |
|
73
|
|
|
|
|
226
|
|
|
73
|
|
|
|
|
162
|
|
|
73
|
|
|
|
|
645
|
|
|
0
|
|
|
|
|
0
|
|
|
73
|
|
|
|
|
132
|
|
|
73
|
|
|
|
|
198
|
|
|
73
|
|
|
|
|
153
|
|
433
|
73
|
|
|
73
|
|
128
|
{ |
434
|
73
|
|
|
|
|
743
|
my $v = version->parse( "$str" ); |
435
|
73
|
|
|
|
|
369
|
$self->{_version} = $v; |
436
|
|
|
|
|
|
|
} |
437
|
73
|
0
|
50
|
|
|
431
|
catch( $e ) |
|
73
|
0
|
33
|
|
|
250
|
|
|
73
|
0
|
|
|
|
227
|
|
|
73
|
0
|
|
|
|
134
|
|
|
73
|
0
|
|
|
|
146
|
|
|
73
|
0
|
|
|
|
154
|
|
|
73
|
0
|
|
|
|
145
|
|
|
73
|
0
|
|
|
|
319
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
73
|
|
|
|
|
350
|
|
|
0
|
|
|
|
|
0
|
|
|
73
|
|
|
|
|
162
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
73
|
|
|
|
|
220
|
|
|
73
|
|
|
|
|
291
|
|
|
73
|
|
|
|
|
167
|
|
|
73
|
|
|
|
|
185
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
438
|
0
|
|
|
0
|
|
0
|
{ |
439
|
0
|
0
|
|
|
|
0
|
warn( "Warning only: error trying to get a version object from version string '$str': $e\n" ) if( $self->_warnings_is_enabled ); |
440
|
20
|
0
|
0
|
20
|
|
183
|
} |
|
20
|
0
|
0
|
|
|
44
|
|
|
20
|
0
|
33
|
|
|
65666
|
|
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
33
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
73
|
0
|
|
|
|
184
|
|
|
0
|
0
|
|
|
|
0
|
|
|
73
|
0
|
|
|
|
1413
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
73
|
|
|
|
|
249
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
73
|
|
|
|
|
234
|
|
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
} |
443
|
2509
|
|
|
|
|
13322
|
return( $self ); |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
0
|
|
|
0
|
1
|
0
|
sub target { return( shift->_set_get_scalar_as_object( 'target', @_ ) ); } |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub type { return( shift->reset(@_)->_set_get_scalar_as_object({ |
449
|
|
|
|
|
|
|
field => 'type', |
450
|
|
|
|
|
|
|
callbacks => |
451
|
|
|
|
|
|
|
{ |
452
|
|
|
|
|
|
|
add => sub |
453
|
|
|
|
|
|
|
{ |
454
|
92
|
|
|
92
|
|
11337
|
my $self = shift( @_ ); |
455
|
92
|
100
|
|
|
|
501
|
if( $self->{type} eq 'decimal' ) |
|
|
50
|
|
|
|
|
|
456
|
|
|
|
|
|
|
{ |
457
|
82
|
|
|
|
|
1236
|
$self->{qv} = 0; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
elsif( $self->{type} eq 'dotted' ) |
460
|
|
|
|
|
|
|
{ |
461
|
|
|
|
|
|
|
# By default |
462
|
10
|
|
|
|
|
233
|
$self->{qv} = 1; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
} |
466
|
401
|
|
|
401
|
1
|
686488
|
}, @_ ) ); } |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub _bool |
469
|
|
|
|
|
|
|
{ |
470
|
0
|
|
|
0
|
|
0
|
my $self = shift( @_ ); |
471
|
|
|
|
|
|
|
# return( $self->_compare( $self->_version, version->new("0"), 1 ) ); |
472
|
0
|
|
|
|
|
0
|
return( $self->_compare( $self, "0", 1 ) ); |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
sub _cascade |
476
|
|
|
|
|
|
|
{ |
477
|
84
|
|
|
84
|
|
183
|
my $self = shift( @_ ); |
478
|
84
|
|
|
|
|
175
|
my $frag = shift( @_ ); |
479
|
|
|
|
|
|
|
# We die, because this is an internal method and those cases should not happen unless this were a design bug |
480
|
84
|
50
|
33
|
|
|
457
|
if( !defined( $frag ) || !length( $frag ) ) |
|
|
50
|
|
|
|
|
|
481
|
|
|
|
|
|
|
{ |
482
|
0
|
|
|
|
|
0
|
die( "No fragment was provided to cascade" ); |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
elsif( $frag !~ /^(major|minor|patch|alpha|\d+)$/ ) |
485
|
|
|
|
|
|
|
{ |
486
|
0
|
|
|
|
|
0
|
die( "Unsupported version fragment '$frag'. Only use 'major', 'minor', 'patch' or 'alpha' or a number starting from 1 (1 = major, 2 = minor, etc)." ); |
487
|
|
|
|
|
|
|
} |
488
|
84
|
|
|
|
|
1522
|
my $extra = $self->extra; |
489
|
84
|
50
|
|
|
|
12454
|
my $frag_is_int = ( $frag =~ /^\d+$/ ? 1 : 0 ); |
490
|
84
|
100
|
33
|
|
|
1182
|
if( $frag eq 'major' || ( $frag_is_int && $frag == 1 ) ) |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
0
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
491
|
|
|
|
|
|
|
{ |
492
|
21
|
|
|
|
|
329
|
$self->alpha( undef ); |
493
|
21
|
|
|
|
|
6795
|
$self->patch(0); |
494
|
21
|
|
|
|
|
198175
|
$self->minor(0); |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
elsif( $frag eq 'minor' || ( $frag_is_int && $frag == 2 ) ) |
497
|
|
|
|
|
|
|
{ |
498
|
21
|
|
|
|
|
536
|
$self->alpha( undef ); |
499
|
21
|
|
|
|
|
6623
|
$self->patch(0); |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
elsif( $frag eq 'patch' || ( $frag_is_int && $frag == 3 ) ) |
502
|
|
|
|
|
|
|
{ |
503
|
21
|
|
|
|
|
710
|
$self->alpha( undef ); |
504
|
21
|
|
50
|
|
|
6887
|
$self->message( 4, "After setting undef, value for alpha is '", ( $self->{alpha} // '' ), "'" ); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
elsif( $frag eq 'alpha' ) |
507
|
|
|
|
|
|
|
{ |
508
|
|
|
|
|
|
|
# Nothing to do |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
elsif( $frag_is_int ) |
511
|
|
|
|
|
|
|
{ |
512
|
0
|
|
|
|
|
0
|
my $offset = ( $frag - 4 ); |
513
|
0
|
|
|
|
|
0
|
my $len = $extra->length; |
514
|
|
|
|
|
|
|
# Before the fragment offset, we set the value to 0 if it is undefined or empty, and |
515
|
|
|
|
|
|
|
# after the fragment offset everything else is reset to 0 |
516
|
0
|
0
|
|
|
|
0
|
for( my $i = 0; $i < ( $offset < $len ? $len : $offset ); $i++ ) |
517
|
|
|
|
|
|
|
{ |
518
|
0
|
0
|
0
|
|
|
0
|
if( ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
519
|
|
|
|
|
|
|
$i < $offset && |
520
|
|
|
|
|
|
|
( !defined( $extra->[$i] ) || !length( $extra->[$i] ) ) |
521
|
|
|
|
|
|
|
) || $i > $offset ) |
522
|
|
|
|
|
|
|
{ |
523
|
0
|
|
|
|
|
0
|
$extra->[$i] = 0; |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
} |
526
|
0
|
|
|
|
|
0
|
$self->alpha( undef ); |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
sub _compare |
531
|
|
|
|
|
|
|
{ |
532
|
40
|
|
|
40
|
|
17597
|
my( $left, $right, $swap ) = @_; |
533
|
40
|
50
|
|
|
|
267
|
$left->message( 4, "Arguments received: '", overload::StrVal( $left ), "' '", ( defined( $right ) ? $right : 'undef' ), "', '", ( defined( $swap ) ? $swap : 'undef' ), "'" ); |
|
|
50
|
|
|
|
|
|
534
|
40
|
|
|
|
|
1486
|
my $class = ref( $left ); |
535
|
40
|
50
|
|
|
|
282
|
unless( $left->_is_a( $right => $class ) ) |
536
|
|
|
|
|
|
|
{ |
537
|
40
|
|
|
|
|
964
|
$right = $class->new( $right, debug => $left->debug ); |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
40
|
50
|
|
|
|
358
|
if( $swap ) |
541
|
|
|
|
|
|
|
{ |
542
|
0
|
|
|
|
|
0
|
( $left, $right ) = ( $right, $left ); |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
|
545
|
40
|
50
|
|
|
|
207
|
unless( _verify( $left ) ) |
546
|
|
|
|
|
|
|
{ |
547
|
0
|
0
|
|
|
|
0
|
die( "Invalid version ", ( $swap ? 'format' : 'object ' . overload::StrVal( $left ) ), "." ); |
548
|
|
|
|
|
|
|
} |
549
|
40
|
50
|
|
|
|
145
|
unless( _verify( $right ) ) |
550
|
|
|
|
|
|
|
{ |
551
|
0
|
0
|
|
|
|
0
|
die( "Invalid version ", ( $swap ? 'format' : 'object' . overload::StrVal( $right ) ), "." ); |
552
|
|
|
|
|
|
|
} |
553
|
40
|
|
|
|
|
213
|
my $lv = $left->_version; |
554
|
40
|
|
|
|
|
119
|
my $rv = $right->_version; |
555
|
|
|
|
|
|
|
# TODO: better compare version. perl's version fails at comparing version that have alpha. |
556
|
|
|
|
|
|
|
# For example, the documentation states: |
557
|
|
|
|
|
|
|
# Note that "alpha" version objects (where the version string contains a trailing underscore segment) compare as less than the equivalent version without an underscore: |
558
|
|
|
|
|
|
|
# $bool = version->parse("1.23_45") < version->parse("1.2345"); # TRUE |
559
|
|
|
|
|
|
|
# However, this is not true. The above doc example will yield FALSE, not TRUE, and even the following too: |
560
|
|
|
|
|
|
|
# perl -Mversion -lE 'my $v = version->parse("v1.2.3"); my $v2 = version->parse("v1.2.3_4"); say $v > $v2' |
561
|
|
|
|
|
|
|
# See RT#145290: <https://rt.cpan.org/Ticket/Display.html?id=145290> |
562
|
|
|
|
|
|
|
# return( $left->{_version} == $right->{_version} ); |
563
|
40
|
|
|
|
|
742
|
$left->message( 5, "Comparing '$lv' to '$rv' -> '", ( $lv == $rv ), "'" ); |
564
|
|
|
|
|
|
|
# return( $lv == $rv ); |
565
|
40
|
|
|
|
|
1076
|
return( $lv <=> $rv ); |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
sub _compute |
569
|
|
|
|
|
|
|
{ |
570
|
96
|
|
|
96
|
|
236
|
my $self = shift( @_ ); |
571
|
96
|
|
|
|
|
189
|
my $opts = pop( @_ ); |
572
|
96
|
|
|
|
|
298
|
my( $other, $swap, $nomethod, $bitwise ) = @_; |
573
|
|
|
|
|
|
|
# XXX |
574
|
|
|
|
|
|
|
# print( STDERR ref( $self ), "::compute: Called with \$other = '", ( $other // '' ), "', swap = '", ( $swap // '' ), "' and extra '", ( $nomethod // '' ), "' and \$bitwise is '", ( $bitwise // '' ), "'\n" ); |
575
|
96
|
|
50
|
|
|
284
|
my $frag = $self->default_frag // 'minor'; |
576
|
96
|
|
50
|
|
|
19285
|
$self->message( 5, "Called with \$frag = '$frag' (default fragment is '", ( $self->default_frag // 'undef' ), "'), \$other = '", ( $other // '' ), "', swap = '", ( $swap // '' ), "' and extra '", ( $nomethod // '' ), "' and \$bitwise is '", ( $bitwise // '' ), "'" ); |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
577
|
96
|
50
|
|
|
|
18924
|
$frag = 'minor' if( $frag !~ /^(major|minor|patch|alpha|\d+)$/ ); |
578
|
96
|
50
|
33
|
|
|
2466
|
if( !defined( $opts ) || |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
579
|
|
|
|
|
|
|
ref( $opts ) ne 'HASH' || |
580
|
|
|
|
|
|
|
!exists( $opts->{op} ) || |
581
|
|
|
|
|
|
|
!defined( $opts->{op} ) || |
582
|
|
|
|
|
|
|
!length( $opts->{op} ) ) |
583
|
|
|
|
|
|
|
{ |
584
|
0
|
|
|
|
|
0
|
die( "No argument 'op' provided" ); |
585
|
|
|
|
|
|
|
} |
586
|
96
|
|
|
|
|
271
|
my $op = $opts->{op}; |
587
|
96
|
|
|
|
|
2358
|
my $clone = $self->clone; |
588
|
96
|
|
|
|
|
124519
|
my $extra = $self->extra; |
589
|
96
|
50
|
|
|
|
16296
|
my $frag_is_int = ( $frag =~ /^\d+$/ ? 1 : 0 ); |
590
|
96
|
|
|
|
|
1148
|
my $map = |
591
|
|
|
|
|
|
|
{ |
592
|
|
|
|
|
|
|
1 => 'major', |
593
|
|
|
|
|
|
|
2 => 'minor', |
594
|
|
|
|
|
|
|
3 => 'patch', |
595
|
|
|
|
|
|
|
}; |
596
|
96
|
|
|
|
|
178
|
my $coderef; |
597
|
96
|
50
|
33
|
|
|
691
|
if( ( $frag_is_int && exists( $map->{ $frag } ) ) || !$frag_is_int ) |
|
|
|
33
|
|
|
|
|
598
|
|
|
|
|
|
|
{ |
599
|
|
|
|
|
|
|
$coderef = $self->can( $map->{ $frag } // $frag ) || |
600
|
96
|
|
50
|
|
|
261
|
die( "Cannot find code reference for method ", ( $frag_is_int ? $map->{ $frag } : $frag ) ); |
601
|
|
|
|
|
|
|
} |
602
|
96
|
50
|
|
|
|
1991
|
my $val = defined( $coderef ) ? $coderef->( $self ) : $extra->[ $frag - 4 ]; |
603
|
96
|
50
|
|
|
|
16420
|
$self->message( 4, "Operation is '$op' for fragment '$frag' and $frag value '", ( defined( $val ) ? $val : 'undef' ), "' (", overload::StrVal( $val ), "), other is '", ( defined( $other ) ? $other : 'undef' ), " (", overload::StrVal( $other ), ") and swap is ", ( $swap ? 'true' : 'not true' ) ); |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
604
|
96
|
|
|
|
|
4166
|
my $err; |
605
|
96
|
50
|
|
|
|
572
|
if( !defined( $val ) ) |
|
|
50
|
|
|
|
|
|
606
|
|
|
|
|
|
|
{ |
607
|
0
|
|
|
|
|
0
|
$val = $self->new_number(0); |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
elsif( !$self->_is_a( $val => 'Module::Generic::Number' ) ) |
610
|
|
|
|
|
|
|
{ |
611
|
0
|
|
|
|
|
0
|
$val = $self->new_number( "$val" ); |
612
|
0
|
0
|
|
|
|
0
|
if( !defined( $val ) ) |
613
|
|
|
|
|
|
|
{ |
614
|
0
|
|
|
|
|
0
|
$err = $self->error->message; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
} |
617
|
96
|
|
|
|
|
4138
|
my $n = $val->scalar; |
618
|
96
|
|
|
|
|
784
|
my $eval; |
619
|
96
|
100
|
100
|
|
|
596
|
if( $opts->{op} eq '++' || $opts->{op} eq '--' ) |
620
|
|
|
|
|
|
|
{ |
621
|
16
|
|
|
|
|
52
|
$eval = "\$n${op}"; |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
else |
624
|
|
|
|
|
|
|
{ |
625
|
80
|
50
|
|
|
|
395
|
$eval = $swap ? ( defined( $other ) ? $other : 'undef' ) . "${op} \$n" : "\$n ${op} " . ( defined( $other ) ? $other : 'undef' ); |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
626
|
|
|
|
|
|
|
} |
627
|
96
|
|
|
|
|
429
|
$self->message( 5, "Evaluating '$eval'" ); |
628
|
96
|
|
|
|
|
8689
|
my $rv = eval( $eval ); |
629
|
96
|
50
|
|
|
|
571
|
$err = $@ if( $@ ); |
630
|
96
|
|
|
|
|
731
|
$self->message( 5, "\$rv = '$rv' and \$@ = '$@'" ); |
631
|
96
|
50
|
|
|
|
2216
|
if( defined( $err ) ) |
632
|
|
|
|
|
|
|
{ |
633
|
0
|
0
|
|
|
|
0
|
warn( $err, "\n" ) if( $self->_warnings_is_enabled ); |
634
|
|
|
|
|
|
|
# Return unchanged |
635
|
|
|
|
|
|
|
# return( $swap ? $other : $self ); |
636
|
0
|
|
|
|
|
0
|
return; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
96
|
100
|
|
|
|
350
|
if( $swap ) |
640
|
|
|
|
|
|
|
{ |
641
|
16
|
50
|
|
|
|
142
|
return( ref( $rv ) ? $rv->scalar : $rv ); |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
else |
644
|
|
|
|
|
|
|
{ |
645
|
80
|
|
|
|
|
128
|
my $new = $clone; |
646
|
80
|
|
|
|
|
129
|
my $new_val; |
647
|
80
|
100
|
100
|
|
|
390
|
if( $op eq '++' || $op eq '--' ) |
648
|
|
|
|
|
|
|
{ |
649
|
16
|
|
|
|
|
30
|
$new = $self; |
650
|
16
|
|
|
|
|
35
|
$new_val = $n; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
else |
653
|
|
|
|
|
|
|
{ |
654
|
64
|
|
|
|
|
151
|
$new_val = int( $rv ); |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
|
657
|
80
|
50
|
|
|
|
170
|
if( defined( $coderef ) ) |
658
|
|
|
|
|
|
|
{ |
659
|
80
|
|
|
|
|
369
|
$self->message( 5, "Updating $frag level to $new_val" ); |
660
|
80
|
|
|
|
|
1741
|
$coderef->( $new, $new_val ); |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
else |
663
|
|
|
|
|
|
|
{ |
664
|
0
|
|
|
|
|
0
|
$self->message( 5, "Setting fragment offset $frag to $new_val" ); |
665
|
0
|
|
|
|
|
0
|
$extra->[( $frag - 4 )] = $new_val; |
666
|
|
|
|
|
|
|
} |
667
|
80
|
|
|
|
|
767593
|
$self->message( 5, "$frag is set to '", $coderef->( $new ), "'" ); |
668
|
80
|
|
|
|
|
14299
|
$new->_cascade( $frag ); |
669
|
80
|
|
|
|
|
379230
|
return( $new ); |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
sub _inc_dec |
674
|
|
|
|
|
|
|
{ |
675
|
4
|
|
|
4
|
|
8
|
my $self = shift( @_ ); |
676
|
4
|
|
50
|
|
|
15
|
my $op = shift( @_ ) || return( $self->error( "No op was provided." ) ); |
677
|
4
|
50
|
|
|
|
27
|
return( $self->error( "Op can only be 'inc' or 'dec'" ) ) if( $op !~ /^(inc|dec)$/ ); |
678
|
4
|
|
|
|
|
10
|
my $frag = shift( @_ ); |
679
|
4
|
|
|
|
|
7
|
my $unit = shift( @_ ); |
680
|
4
|
50
|
33
|
|
|
47
|
if( !defined( $frag ) || !length( "$frag" ) ) |
|
|
50
|
|
|
|
|
|
681
|
|
|
|
|
|
|
{ |
682
|
0
|
0
|
|
|
|
0
|
return( $self->error( "No version fragment was specified to ", ( $op eq 'inc' ? 'increase' : 'decrease' ), " the version number." ) ); |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
elsif( $frag !~ /^(major|minor|patch|alpha|\d+)$/ ) |
685
|
|
|
|
|
|
|
{ |
686
|
0
|
0
|
|
|
|
0
|
return( $self->error( "Unsupported version fragment '$frag' to ", ( $op eq 'inc' ? 'increase' : 'decrease' ), ". Only use 'major', 'minor', 'patch' or 'alpha' or a number starting from 1 (1 = major, 2 = minor, etc)." ) ); |
687
|
|
|
|
|
|
|
} |
688
|
4
|
50
|
33
|
|
|
13
|
if( defined( $unit ) && $unit !~ /^\d+$/ ) |
689
|
|
|
|
|
|
|
{ |
690
|
0
|
0
|
|
|
|
0
|
return( $self->error( "Unit to ", ( $op eq 'inc' ? 'increase' : 'decrease' ), " fragment $frag value must be an integer." ) ); |
691
|
|
|
|
|
|
|
} |
692
|
4
|
|
|
|
|
13
|
my $extra = $self->extra; |
693
|
4
|
50
|
|
|
|
647
|
my $frag_is_int = ( $frag =~ /^\d+$/ ? 1 : 0 ); |
694
|
4
|
|
|
|
|
17
|
my $map = |
695
|
|
|
|
|
|
|
{ |
696
|
|
|
|
|
|
|
1 => 'major', |
697
|
|
|
|
|
|
|
2 => 'minor', |
698
|
|
|
|
|
|
|
3 => 'patch', |
699
|
|
|
|
|
|
|
}; |
700
|
4
|
|
|
|
|
5
|
my $coderef; |
701
|
4
|
50
|
33
|
|
|
26
|
if( ( $frag_is_int && exists( $map->{ $frag } ) ) || !$frag_is_int ) |
|
|
|
33
|
|
|
|
|
702
|
|
|
|
|
|
|
{ |
703
|
|
|
|
|
|
|
$coderef = $self->can( $map->{ $frag } // $frag ) || |
704
|
4
|
|
50
|
|
|
35
|
die( "Cannot find code reference for method ", ( $frag_is_int ? $map->{ $frag } : $frag ) ); |
705
|
|
|
|
|
|
|
} |
706
|
4
|
50
|
|
|
|
17
|
my $n = defined( $coderef ) ? $coderef->( $self ) : $extra->[ $frag - 4 ]; |
707
|
|
|
|
|
|
|
# The offset specified is out of bound |
708
|
4
|
50
|
33
|
|
|
689
|
if( $frag_is_int && ( $frag - 4 ) > $extra->size ) |
|
|
50
|
33
|
|
|
|
|
709
|
|
|
|
|
|
|
{ |
710
|
0
|
0
|
|
|
|
0
|
$n = ( |
|
|
0
|
|
|
|
|
|
711
|
|
|
|
|
|
|
$op eq 'inc' |
712
|
|
|
|
|
|
|
? ( defined( $unit ) ? $unit : 1 ) |
713
|
|
|
|
|
|
|
: 0 |
714
|
|
|
|
|
|
|
); |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
elsif( defined( $unit ) && $unit == 1 ) |
717
|
|
|
|
|
|
|
{ |
718
|
0
|
0
|
|
|
|
0
|
$op eq 'inc' ? ( $n += $unit ) : ( $n -= $unit ); |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
else |
721
|
|
|
|
|
|
|
{ |
722
|
4
|
50
|
|
|
|
24
|
$op eq 'inc' ? $n++ : $n--; |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
4
|
50
|
|
|
|
29
|
if( defined( $coderef ) ) |
726
|
|
|
|
|
|
|
{ |
727
|
4
|
|
|
|
|
15
|
$self->message( 5, "Updating $frag level to $n" ); |
728
|
4
|
|
|
|
|
101
|
$coderef->( $self, $n ); |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
else |
731
|
|
|
|
|
|
|
{ |
732
|
0
|
|
|
|
|
0
|
$extra->[( $frag - 4 )] = $n; |
733
|
|
|
|
|
|
|
} |
734
|
4
|
|
|
|
|
37160
|
$self->_cascade( $frag ); |
735
|
4
|
|
|
|
|
18627
|
return( $self ); |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
sub _noop |
739
|
|
|
|
|
|
|
{ |
740
|
0
|
|
|
0
|
|
0
|
my( $self, $other, $swap, $nomethod, $bitwise ) = @_; |
741
|
0
|
0
|
|
|
|
0
|
warn( "This operation $nomethod is not supported by Changes::Version\n" ) if( $self->_warnings_is_enabled ); |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
sub _stringify |
745
|
|
|
|
|
|
|
{ |
746
|
190
|
|
|
190
|
|
402
|
my $self = shift( @_ ); |
747
|
190
|
|
|
|
|
564
|
my $comp = $self->new_array; |
748
|
190
|
|
|
|
|
2821
|
my $def = {}; |
749
|
190
|
|
|
|
|
430
|
for( qw( major minor patch alpha ) ) |
750
|
|
|
|
|
|
|
{ |
751
|
760
|
|
|
|
|
87963
|
$def->{ $_ } = $self->$_; |
752
|
|
|
|
|
|
|
} |
753
|
190
|
|
|
|
|
31085
|
my $type = $self->type; |
754
|
190
|
50
|
33
|
|
|
40794
|
$def->{major} = 0 if( !defined( $def->{major} ) || !length( $def->{major} ) ); |
755
|
190
|
100
|
50
|
|
|
1628
|
if( $self->qv || ( ( $type // '' ) eq 'dotted' ) ) |
|
|
50
|
66
|
|
|
|
|
|
|
|
50
|
|
|
|
|
756
|
|
|
|
|
|
|
{ |
757
|
94
|
50
|
33
|
|
|
14371
|
$def->{minor} = 0 if( !defined( $def->{minor} ) || !length( "$def->{minor}" ) ); |
758
|
94
|
50
|
33
|
|
|
878
|
$def->{patch} = 0 if( !defined( $def->{patch} ) || !length( "$def->{patch}" ) ); |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
elsif( ( $type // '' ) eq 'decimal' ) |
761
|
|
|
|
|
|
|
{ |
762
|
|
|
|
|
|
|
# We need to avoid the scenario where we would have a major and alpha, but not minor. |
763
|
|
|
|
|
|
|
# For example: 3_6 would trigger version error "Invalid version format (alpha without decimal)" |
764
|
96
|
0
|
33
|
|
|
17216
|
$def->{minor} = 0 if( ( !defined( $def->{minor} ) || !length( "$def->{minor}" ) ) && defined( $def->{alpha} ) && length( "$def->{alpha}" ) ); |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
# $self->message( 4, "version fragments are -> ", sub{ $self->dump( $def ) } ); |
767
|
190
|
|
|
|
|
1426
|
my $ok = 0; |
768
|
190
|
|
|
|
|
382
|
for( qw( patch minor major ) ) |
769
|
|
|
|
|
|
|
{ |
770
|
570
|
50
|
66
|
|
|
3044
|
next if( !length( $def->{ $_ } ) && !$ok ); |
771
|
|
|
|
|
|
|
# We stop skipping version fragments as soon as one is defined |
772
|
567
|
|
|
|
|
2347
|
$ok++; |
773
|
567
|
|
|
|
|
1695
|
$comp->unshift( $def->{ $_ } ); |
774
|
|
|
|
|
|
|
} |
775
|
190
|
100
|
|
567
|
|
1389
|
my $v = ( $self->qv ? 'v' : '' ) . $comp->map(sub{ 0 + $_ })->join( '.' )->scalar; |
|
567
|
|
|
|
|
446908
|
|
776
|
190
|
100
|
66
|
|
|
226871
|
$v .= '_' . $def->{alpha} if( defined( $def->{alpha} ) && length( $def->{alpha} ) ); |
777
|
190
|
|
|
|
|
66550
|
return( $v ); |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
sub _verify |
781
|
|
|
|
|
|
|
{ |
782
|
80
|
|
|
80
|
|
166
|
my $self = shift( @_ ); |
783
|
80
|
50
|
|
|
|
215
|
if( defined( $self ) ) |
784
|
|
|
|
|
|
|
{ |
785
|
80
|
50
|
|
|
|
340
|
$self->message( 5, "Is \$self a Changes::Version object? -> ", ( Module::Generic->_is_a( $self => 'Changes::Version' ) ? 'yes' : 'no' ), " and _version exists ? ", ( exists( $self->{_version} ) ? 'yes' : 'no' ), " and is _version (", overload::StrVal( $self->{_version} ), ") a version object ? ", ( Module::Generic->_is_a( $self->{_version} => 'version' ) ? 'yes' : 'no' ) ); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
786
|
|
|
|
|
|
|
} |
787
|
80
|
50
|
33
|
|
|
7081
|
if( defined( $self ) && |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
788
|
|
|
|
|
|
|
Module::Generic->_is_a( $self => 'Changes::Version' ) && |
789
|
80
|
|
|
|
|
2621
|
eval{ exists( $self->{_version} ) } && |
790
|
|
|
|
|
|
|
Module::Generic->_is_a( $self->{_version} => 'version' ) ) |
791
|
|
|
|
|
|
|
{ |
792
|
80
|
|
|
|
|
2256
|
return(1); |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
else |
795
|
|
|
|
|
|
|
{ |
796
|
0
|
|
|
|
|
0
|
return(0); |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
sub _version |
801
|
|
|
|
|
|
|
{ |
802
|
80
|
|
|
80
|
|
157
|
my $self = shift( @_ ); |
803
|
80
|
50
|
33
|
|
|
584
|
if( @_ ) |
|
|
50
|
|
|
|
|
|
804
|
|
|
|
|
|
|
{ |
805
|
0
|
|
|
|
|
0
|
my $v = shift( @_ ); |
806
|
0
|
0
|
|
|
|
0
|
return( $self->error( "Value provided is not a version object." ) ) if( !$self->_is_a( $v => 'version' ) ); |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
elsif( !exists( $self->{_version} ) || !defined( $self->{_version} ) ) |
809
|
|
|
|
|
|
|
{ |
810
|
0
|
|
|
|
|
0
|
my $str = $self->_stringify; |
811
|
0
|
0
|
0
|
|
|
0
|
try |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
812
|
0
|
|
|
0
|
|
0
|
{ |
813
|
0
|
|
|
|
|
0
|
$self->{_version} = version->parse( "$str" ); |
814
|
|
|
|
|
|
|
} |
815
|
0
|
0
|
0
|
|
|
0
|
catch( $e ) |
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
816
|
0
|
|
|
0
|
|
0
|
{ |
817
|
0
|
0
|
|
|
|
0
|
warn( "Warning only: error trying to get a version object from version string '$str': $e\n" ) if( $self->_warnings_is_enabled ); |
818
|
20
|
0
|
0
|
20
|
|
188
|
} |
|
20
|
0
|
0
|
|
|
50
|
|
|
20
|
0
|
0
|
|
|
3781
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
0
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
0
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
819
|
|
|
|
|
|
|
} |
820
|
80
|
|
|
|
|
194
|
return( $self->{_version} ); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
1; |
824
|
|
|
|
|
|
|
# NOTE: POD |
825
|
|
|
|
|
|
|
__END__ |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=encoding utf-8 |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=head1 NAME |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Changes::Version - Version string object class |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=head1 SYNOPSIS |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
use Changes::Version; |
836
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
837
|
|
|
|
|
|
|
major => 1, |
838
|
|
|
|
|
|
|
minor => 2, |
839
|
|
|
|
|
|
|
patch => 3, |
840
|
|
|
|
|
|
|
alpha => 4, |
841
|
|
|
|
|
|
|
qv => 1, |
842
|
|
|
|
|
|
|
debug => 2, |
843
|
|
|
|
|
|
|
); |
844
|
|
|
|
|
|
|
# or |
845
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v0.1.2_3' ); |
846
|
|
|
|
|
|
|
# or |
847
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v0.1.2_3', alpha => 4 ); |
848
|
|
|
|
|
|
|
# or |
849
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v0.1.2_3', { alpha => 4 } ); |
850
|
|
|
|
|
|
|
# or |
851
|
|
|
|
|
|
|
my $v = Changes::Version->new( major => 0, minor => 1, patch => 2, alpha => 3, qv => 1 ); |
852
|
|
|
|
|
|
|
# or |
853
|
|
|
|
|
|
|
my $v = Changes::Version->new({ major => 0, minor => 1, patch => 2, alpha => 3, qv => 1 }); |
854
|
|
|
|
|
|
|
die( Changes::Version->error ) if( !defined( $v ) ); |
855
|
|
|
|
|
|
|
my $v = Changes::Version->parse( 'v1.2.3_4' ); |
856
|
|
|
|
|
|
|
die( Changes::Version->error ) if( !defined( $v ) ); |
857
|
|
|
|
|
|
|
my $type = $v->type; |
858
|
|
|
|
|
|
|
$v->type( 'decimal' ); |
859
|
|
|
|
|
|
|
$v->padded(0); |
860
|
|
|
|
|
|
|
$v->pretty(1); |
861
|
|
|
|
|
|
|
$v->type( 'dotted' ); |
862
|
|
|
|
|
|
|
$v++; |
863
|
|
|
|
|
|
|
# Updating 'minor' |
864
|
|
|
|
|
|
|
say "$v"; # v1.3.0 |
865
|
|
|
|
|
|
|
$v += 2; |
866
|
|
|
|
|
|
|
$v->default_frag( 'major' ); |
867
|
|
|
|
|
|
|
$v++; |
868
|
|
|
|
|
|
|
say "$v"; # v2.0.0 |
869
|
|
|
|
|
|
|
$v->inc_patch; |
870
|
|
|
|
|
|
|
say $v->is_alpha; # false |
871
|
|
|
|
|
|
|
say $v->numify; # returns new Changes::Version object |
872
|
|
|
|
|
|
|
say $v->normal; # returns new Changes::Version object |
873
|
|
|
|
|
|
|
say $v->as_string; # same as say "$v"; |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=head1 VERSION |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
v0.1.0 |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=head1 DESCRIPTION |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
This class represents a software version based on perl's definition and providing for perl recommended C<dotted decimal> and also C<decimal> types. In the future, this will be expanded to other non-perl version formats. |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
It allows for parsing and manipulation of version objects. |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=head2 new |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Provided with an optional version string and an optional hash or hash reference of options and this will instantiate a new L<Changes::Version> object. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
If an error occurs, it will return an L<error|Module::Generic/error>, so alway check for the definedness of the returned value. |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
894
|
|
|
|
|
|
|
major => 1, |
895
|
|
|
|
|
|
|
minor => 2, |
896
|
|
|
|
|
|
|
patch => 3, |
897
|
|
|
|
|
|
|
alpha => 4, |
898
|
|
|
|
|
|
|
); |
899
|
|
|
|
|
|
|
die( Changes::Version->error ) if( !defined( $v ) ); |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
Note that if you do: |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
my $v = Changes::Version->new( ... ) || die( Changes::Version->error ); |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
would be dangerous, because you would be assessing the return version object in a boolean context that could return false if the version was C<0>. |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
It supports the following options that can also be accessed or changed with their corresponding method. |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=over 4 |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=item * C<alpha> |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
Specifies the alpha fragment integer of the version. See L</alpha> for more information. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
916
|
|
|
|
|
|
|
major => 1, |
917
|
|
|
|
|
|
|
minor => 2, |
918
|
|
|
|
|
|
|
patch => 3, |
919
|
|
|
|
|
|
|
alpha => 4, |
920
|
|
|
|
|
|
|
); |
921
|
|
|
|
|
|
|
my $alpha = $v->alpha; # 4 |
922
|
|
|
|
|
|
|
$v->alpha(7); |
923
|
|
|
|
|
|
|
say "$v"; # v1.2.3_7 |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=item * C<beta> |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
Specifies the beta fragment integer of the version. See L</beta> for more information. |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
Currently unused and reserved for future release. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=item * C<compat> |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
Boolean. When enabled, this will ensure the version formatting is strictly compliant with the L<version> module. Default to false. |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=item * C<default_frag> |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
Specifies the fragment name or integer value used by overloaded operations. |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3_4' ); |
940
|
|
|
|
|
|
|
my $default = $v->default_frag; # By default 'minor' |
941
|
|
|
|
|
|
|
$v->default_frag( 'major' ); |
942
|
|
|
|
|
|
|
$v++; # Version is now v2.2.3_4 |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=item * C<extra> |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Specifies the array reference of version fragments beyond C<patch> |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
949
|
|
|
|
|
|
|
major => 1, |
950
|
|
|
|
|
|
|
minor => 2, |
951
|
|
|
|
|
|
|
patch => 3, |
952
|
|
|
|
|
|
|
alpha => 12, |
953
|
|
|
|
|
|
|
extra => [qw( 4 5 6 7 )], |
954
|
|
|
|
|
|
|
); |
955
|
|
|
|
|
|
|
say "$v"; # v1.2.3.4.5.6.7_12 |
956
|
|
|
|
|
|
|
my $a = $v->extra; # contains 4, 5, 6, 7 |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=item * C<major> |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Specifies the C<major> fragment of the version string. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
963
|
|
|
|
|
|
|
major => 1, |
964
|
|
|
|
|
|
|
minor => 2, |
965
|
|
|
|
|
|
|
patch => 3, |
966
|
|
|
|
|
|
|
alpha => 4, |
967
|
|
|
|
|
|
|
); |
968
|
|
|
|
|
|
|
my $major = $v->major; # 1 |
969
|
|
|
|
|
|
|
say "$v"; # v1.2.3_4 |
970
|
|
|
|
|
|
|
$v->major(3); |
971
|
|
|
|
|
|
|
say "$v"; # v3.0.0 |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=item * C<minor> |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
Specifies the C<minor> fragment of the version string. |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
978
|
|
|
|
|
|
|
major => 1, |
979
|
|
|
|
|
|
|
minor => 2, |
980
|
|
|
|
|
|
|
patch => 3, |
981
|
|
|
|
|
|
|
alpha => 4, |
982
|
|
|
|
|
|
|
); |
983
|
|
|
|
|
|
|
my $minor = $v->minor; # 2 |
984
|
|
|
|
|
|
|
say "$v"; # v1.2.3_4 |
985
|
|
|
|
|
|
|
$v->minor(3); |
986
|
|
|
|
|
|
|
say "$v"; # v1.3.0 |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
=item * C<original> |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
Specifies an original version string. This is normally set by L</parse> and used by L</as_string> to bypass any formatting when nothing has been changed. |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
=item * C<padded> |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
Specifies whether version string of type decimal should be zero padded or not. Default to true. |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
my $v = Change::Version->new( |
997
|
|
|
|
|
|
|
major => 1, |
998
|
|
|
|
|
|
|
minor => 20, |
999
|
|
|
|
|
|
|
patch => 300, |
1000
|
|
|
|
|
|
|
type => 'decimal', |
1001
|
|
|
|
|
|
|
); |
1002
|
|
|
|
|
|
|
say "$v"; # 1.020300 |
1003
|
|
|
|
|
|
|
$v->padded(0); |
1004
|
|
|
|
|
|
|
say "$v"; # 1.0203 |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=item * C<patch> |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
Specifies the C<patch> fragment of the version string. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
1011
|
|
|
|
|
|
|
major => 1, |
1012
|
|
|
|
|
|
|
minor => 2, |
1013
|
|
|
|
|
|
|
patch => 3, |
1014
|
|
|
|
|
|
|
alpha => 4, |
1015
|
|
|
|
|
|
|
); |
1016
|
|
|
|
|
|
|
my $patch = $v->patch; # 3 |
1017
|
|
|
|
|
|
|
say "$v"; # v1.2.3_4 |
1018
|
|
|
|
|
|
|
$v->patch(7); |
1019
|
|
|
|
|
|
|
say "$v"; # v1.3.7 |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item * C<pretty> |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
Specifies whether version string of type C<decimal> should be formatted with an underscore (C<_>) separating thousands in the fraction part. |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
my $v = Change::Version->new( |
1026
|
|
|
|
|
|
|
major => 1, |
1027
|
|
|
|
|
|
|
minor => 20, |
1028
|
|
|
|
|
|
|
patch => 300, |
1029
|
|
|
|
|
|
|
type => 'decimal', |
1030
|
|
|
|
|
|
|
pretty => 1, |
1031
|
|
|
|
|
|
|
); |
1032
|
|
|
|
|
|
|
say "$v"; # 1.020_300 |
1033
|
|
|
|
|
|
|
$v->pretty(0); |
1034
|
|
|
|
|
|
|
say "$v"; # 1.020300 |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=item * C<qv> |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
Specifies whether version string of type C<dotted> should be formatted with the prefix C<v>. Defaults to true. |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
1041
|
|
|
|
|
|
|
major => 1, |
1042
|
|
|
|
|
|
|
minor => 2, |
1043
|
|
|
|
|
|
|
patch => 3, |
1044
|
|
|
|
|
|
|
alpha => 4, |
1045
|
|
|
|
|
|
|
); |
1046
|
|
|
|
|
|
|
say "$v"; # v1.2.3_4 |
1047
|
|
|
|
|
|
|
$v->qv(0); |
1048
|
|
|
|
|
|
|
say "$v"; # 1.2.3_4 |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=item * C<rc> |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Specifies the release candidate value. This is currently unused and reserved for future release. |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=item * C<target> |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
Specifies the target formatting for the version string. By default this is C<perl> and is the only supported value for now. In future release, other format types will be supported, such as C<opensource>. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=item * C<type> |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
Specifies the version type. Possible values are C<dotted> for dotted decimal versions such as C<v1.2.3> or C<decimal> for decimal versions such as C<1.002003> |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=back |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=head2 parse |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
Provided with a version string, and this will parse it and return a new L<Changes::Version> object. |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
Currently, only 2 version types are supported: C<dotted decimal> and C<decimal> |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
v1.2 |
1071
|
|
|
|
|
|
|
1.2345.6 |
1072
|
|
|
|
|
|
|
v1.23_4 |
1073
|
|
|
|
|
|
|
1.2345 |
1074
|
|
|
|
|
|
|
1.2345_01 |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
are all legitimate version strings. |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
If an error occurred, this will return an L<error|Module::Generic/error>. |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
=head1 METHODS |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
=head2 alpha |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
Sets or gets the C<alpha> fragment integer of the version. |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
Setting this to C<undef> effectively removes it. |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
Returns a L<number object|Module::Generic::Number> |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
=head2 as_string |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
Returns a version string properly formatted according to the C<type> set with L</type> and other parameters sets such as L</qv>, L</padded> and L</pretty> |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
Resulting value is cached, which means the second time this is called, the cached value will be returned for speed. |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
Any change to the version object parameters, and this will force the re-formatting of the version string. |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
For example: |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3_4' ); |
1101
|
|
|
|
|
|
|
# This is a version of type 'dotted' for dotted decimal |
1102
|
|
|
|
|
|
|
say "$v"; # v1.2.3_4 |
1103
|
|
|
|
|
|
|
# Changing the patch level |
1104
|
|
|
|
|
|
|
$v->inc( 'patch' ); |
1105
|
|
|
|
|
|
|
# Now forced to re-format |
1106
|
|
|
|
|
|
|
say "$v"; # v1.2.4 |
1107
|
|
|
|
|
|
|
# No change, using the cache |
1108
|
|
|
|
|
|
|
say "$v"; # v1.2.4 |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=head2 beta |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
The beta fragment integer of the version. This is currently unused and reserved for future release of this class. |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
=head2 compat |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
Boolean. When enabled, this will ensure the version formatting is strictly compliant with the L<version> module. Default to false. |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=head2 dec |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
Provided with a version fragment, and an optiona integer, and this will decrease the version fragment value by as much. If no integer is provided, the default decrement is 1. |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
1123
|
|
|
|
|
|
|
major => 1, |
1124
|
|
|
|
|
|
|
minor => 2, |
1125
|
|
|
|
|
|
|
patch => 3, |
1126
|
|
|
|
|
|
|
alpha => 4, |
1127
|
|
|
|
|
|
|
); |
1128
|
|
|
|
|
|
|
say "$v"; # v1.2.3_4; |
1129
|
|
|
|
|
|
|
$v->dec( 'alpha' ); |
1130
|
|
|
|
|
|
|
say "$v"; # v1.2.3_3; |
1131
|
|
|
|
|
|
|
$v->dec( 'patch', 2 ); |
1132
|
|
|
|
|
|
|
say "$v"; # v1.2.1 |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3.4.5.6.7_8' ); |
1135
|
|
|
|
|
|
|
# Decrease the 5th fragment |
1136
|
|
|
|
|
|
|
$v->dec(5); |
1137
|
|
|
|
|
|
|
say "$v"; # v1.2.3.4.4.0.0 |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
Any change to a fragment value will reset the lower fragment values to zero. Thus: |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
=over 4 |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
=item * changing the C<major> value will reset C<minor> and C<patch> to 0 and C<alpha> to C<undef> |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
=item * changing the C<minor> value will reset C<patch> to 0 and C<alpha> to C<undef> |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
=item * changing the C<patch> value will reset C<alpha> to C<undef> |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
=item * changing the nth fragment value will reset all fragment value after that to 0 |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
=back |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
If you pass a fragment that is an integer and it is outside the maximum number of fragments, it will automatically expand the number of version fragments and initialise the intermediary fragments to 0. A fragment as an integer starts at 1. |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
Using the example above: |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
$v->dec(10); |
1158
|
|
|
|
|
|
|
say "$v"; # v1.2.3.4.5.6.7.0.0.0 |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
The 10th element is set to 0 because it does not exist, so it cannot be decreased. |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
=head2 dec_alpha |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
This is a shortcut for calling L</dec> on fragment C<alpha> |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=head2 dec_beta |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
This is a shortcut for calling L</dec> on fragment C<beta> |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=head2 dec_major |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
This is a shortcut for calling L</dec> on fragment C<major> |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
=head2 dec_minor |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
This is a shortcut for calling L</dec> on fragment C<minor> |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=head2 dec_patch |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
This is a shortcut for calling L</dec> on fragment C<patch> |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
=head2 default_frag |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3_4' ); |
1185
|
|
|
|
|
|
|
my $default = $v->default_frag; # By default 'minor' |
1186
|
|
|
|
|
|
|
$v->default_frag( 'major' ); |
1187
|
|
|
|
|
|
|
$v++; # Version is now v2.2.3_4 |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
String. Sets or gets the name or the integer value for the version fragment. Supported value can be C<major>, C<minor>. C<patch>, C<alpha>, or an integer. |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
Returns a L<scalar object|Module::Generic::Scalar> |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=head2 extra |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
Sets or gets an array reference of version fragments starting from C<1> for C<major>, C<2> for C<minor>, C<3> for C<patch>, etc. For example: |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3.4.5.6.7_8' ); |
1198
|
|
|
|
|
|
|
my $a = $v->extra; # contains 4, 5, 6, 7 |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
Note that C<alpha> is not accessible via digits, but only using L</alpha> |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
You should not be accessing this directly. |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
Returns an L<array object|Module::Generic::Array> |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
=head2 inc |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
Same as L</dec>, but increasing instead of decreasing. |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=head2 inc_alpha |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
This is a shortcut for calling L</inc> on fragment C<alpha> |
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=head2 inc_beta |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
This is a shortcut for calling L</inc> on fragment C<beta> |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
=head2 inc_major |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
This is a shortcut for calling L</inc> on fragment C<major> |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
=head2 inc_minor |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
This is a shortcut for calling L</inc> on fragment C<minor> |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
=head2 inc_patch |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
This is a shortcut for calling L</inc> on fragment C<patch> |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
=head2 is_alpha |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
Returns true if L</alpha> has a value set. |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
=head2 is_qv |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
Returns true if L</qv> is set to true, false otherwise. |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
=head2 major |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
Sets or gets the C<major> fragment of the version string. |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3_4' ); |
1243
|
|
|
|
|
|
|
my $major = $v->major; # 1 |
1244
|
|
|
|
|
|
|
$v->major(3); |
1245
|
|
|
|
|
|
|
say "$v"; # v3.2.3_4 |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
Setting this to C<undef> effectively removes it. |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
Returns a L<number object|Module::Generic::Number> |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
=head2 minor |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
Sets or gets the C<minor> fragment of the version string. |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3_4' ); |
1256
|
|
|
|
|
|
|
my $minor = $v->minor; # 2 |
1257
|
|
|
|
|
|
|
$v->minor(3); |
1258
|
|
|
|
|
|
|
say "$v"; # v1.3.3_4 |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
Setting this to C<undef> effectively removes it. |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
Returns a L<number object|Module::Generic::Number> |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
=head2 normal |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
Returns a new L<Changes::Version> object as a normalised version, which is a dotted decimal format with the C<v> prefix. |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
If an error occurred, an L<error|Module::Generic/error> is returned. |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=head2 numify |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
Returns a new L<Changes::Version> object as a number, which represent a decimal-type version |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
Contrary to L<version> if there is an C<alpha> value set, it will add it to the numified version. |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
1277
|
|
|
|
|
|
|
major => 1, |
1278
|
|
|
|
|
|
|
minor => 2, |
1279
|
|
|
|
|
|
|
patch => 3, |
1280
|
|
|
|
|
|
|
alpha => 4, |
1281
|
|
|
|
|
|
|
); |
1282
|
|
|
|
|
|
|
say $v->numify; # 1.002003_4 |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
L<version> would yields a different, albeit wrong result: |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
perl -Mversion -lE 'say version->parse("v1.2.3_4")->numify' |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
would wrongly return C<1.002034> and not C<1.002003_4> |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
perl -Mversion -lE 'say version->parse("1.002034")->normal' |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
then yields C<v1.2.34> |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
If an error occurred, an L<error|Module::Generic/error> is returned. |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
=head2 original |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
Sets or gets the original string. This is set by L</parse> |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
Returns a L<scalar object|Module::Generic::Scalar> |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
=head2 padded |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
Boolean. Sets or ges whether the resulting version string of type C<decimal> should be '0' padded or not. Default to pad with zeroes decimal numbers. |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
For example: |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
1309
|
|
|
|
|
|
|
major => 1, |
1310
|
|
|
|
|
|
|
minor => 2, |
1311
|
|
|
|
|
|
|
patch => 30, |
1312
|
|
|
|
|
|
|
type => 'decimal', |
1313
|
|
|
|
|
|
|
padded => 1, |
1314
|
|
|
|
|
|
|
); |
1315
|
|
|
|
|
|
|
say "$v"; # 1.002030 |
1316
|
|
|
|
|
|
|
$v->padded(0); |
1317
|
|
|
|
|
|
|
say "$v"; # 1.00203 |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
Returns a L<boolean object|Module::Generic::Boolean> |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
=head2 patch |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
Sets or gets the C<patch> fragment of the version string. |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
my $v = Changes::Version->new( 'v1.2.3_4' ); |
1326
|
|
|
|
|
|
|
my $patch = $v->patch; # 3 |
1327
|
|
|
|
|
|
|
$v->patch(5); |
1328
|
|
|
|
|
|
|
say "$v"; # v1.3.5_4 |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
Returns a L<number object|Module::Generic::Number> |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
=head2 pretty |
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
Boolean. When enabled, this will render version number for decimal type a bit cleaner by separating blocks of 3 digits by an underscore (C<_>). This does not work on dotted decimal version numbers such as C<v1.2.3> or on version that have an C<alpha> set up. |
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
1337
|
|
|
|
|
|
|
major => 1, |
1338
|
|
|
|
|
|
|
minor => 2, |
1339
|
|
|
|
|
|
|
patch => 30, |
1340
|
|
|
|
|
|
|
type => 'decimal', |
1341
|
|
|
|
|
|
|
); |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
Returns a L<boolean object|Module::Generic::Boolean> |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
=head2 qv |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
Boolean. When enabled, this will prepend the dotted decimal version strings with C<v>. This is true by default. |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
my $v = Changes::Version->new( |
1350
|
|
|
|
|
|
|
major => 1, |
1351
|
|
|
|
|
|
|
minor => 2, |
1352
|
|
|
|
|
|
|
patch => 3, |
1353
|
|
|
|
|
|
|
alpha => 4, |
1354
|
|
|
|
|
|
|
); |
1355
|
|
|
|
|
|
|
say "$v"; # v1.2.3_4 |
1356
|
|
|
|
|
|
|
$v->qv(0); |
1357
|
|
|
|
|
|
|
say "$v"; # 1.2.3_4 |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
Returns a L<boolean object|Module::Generic::Boolean> |
1360
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
=head2 rc |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
Sets or gets the release candidate value. This is currently unused and reserved for future releases. |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
Returns a L<scalar object|Module::Generic::Scalar> |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
=for Pod::Coverage reset |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
=head2 stringify |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
This is an alias for L</as_string> |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
=head2 target |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
Sets or gets the target format. By default this is C<perl>. This means that L</as_string> will format the version string for C<perl>. n future release of this class, other format wil be supported, such as C<opensource> |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
Returns a L<scalar object|Module::Generic::Scalar> |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=head2 type |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
Sets or gets the version type. Currently, supported values are C<dotted> for dotted decimal versions such as C<v1.2.3>, and C<decimal> for decimal versions such as C<1.002003>. |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
Returns a L<scalar object|Module::Generic::Scalar> |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
=head1 OVERLOADED OPERATIONS |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
The following operations are overloaded, and internally relies on L<version> to return the value. See also L<overload> for more information. |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
Note that calling the version object with any operations other than those listed below will trigger a warning, if warnings are enabled with L<warnings> and C<undef> is return in scalar context or an empty list in list context. |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
=over 4 |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=item * C<stringification> |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
Returns value from L</as_string> |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
=item * C<0+> |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
Returns value from L</numify> |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
=item * C<< <=> >> |
1402
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
Compares two versions. If the other version being compared is not a L<Changes::Version>, it is made one before comparison actually occurs. |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
Note that, C<version> core module L<states in its documentation|version/"How to compare version objects"> that: "alpha" version objects (where the version string contains a trailing underscore segment) compare as less than the equivalent version without an underscore." |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
$bool = version->parse("1.23_45") < version->parse("1.2345"); # TRUE |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
However, as of perl v5.10, this is not true. The above will actually return false, not true. And so will the following: |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
perl -Mversion -lE 'say version->parse("v1.002003") > version->parse("v1.002003_4");' |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
This is on my bucket list of things to improve. |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
=item * C<cmp> |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
Same as above. |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
=item * C<bool> |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
=item * C<+>, C<->, C<*>, C</> |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
When performing those operations, it will use the value of the fragment of the version set with L</default_frag>, which, by default, is C<minor>. |
1424
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
It returns a new L<Changes::Version> object reflecting the new version value. However, if the operation is swapped, with the version object on the right-hand side instead of the left-hand side, this will return a regular number. |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
my $vers = Changes::Version->new( 'v1.2.3_4' ); |
1428
|
|
|
|
|
|
|
my $new_version_object = $vers + 2; # Now v1.4.3_4 (minor has been bumped up by 2) |
1429
|
|
|
|
|
|
|
$vers->default_frag( 'major' ); |
1430
|
|
|
|
|
|
|
my $new_version_object = $vers + 2; # Now v3.2.3_4 (this time, 'major' was increased) |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
But, when swapped: |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
my $vers = Changes::Version->new( 'v1.2.3_4' ); |
1435
|
|
|
|
|
|
|
my $n = 3 + $vers; # yields 5 (using the 'minor' fragment by default) |
1436
|
|
|
|
|
|
|
$vers->default_frag( 'major' ); |
1437
|
|
|
|
|
|
|
my $n = 3 + $vers; # yields 4 (this time, using the 'major' fragment) |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
=item * C<+=>, C<-=>, C<*=>, C</=> |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
In this operations, it modifies the current object with the operand provided and returns the current object, instead of creating a new one. |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
my $vers = Changes::Version->new( 'v1.2.3_4' ); |
1444
|
|
|
|
|
|
|
# By default, using the 'minor' fragment |
1445
|
|
|
|
|
|
|
$vers += 1; # version is now v2.2.3_4 |
1446
|
|
|
|
|
|
|
$vers->default_frag( 'alpha' ); |
1447
|
|
|
|
|
|
|
$vers /= 2; # version is now v1.2.3_2 |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
=item * C<++>, C<--> |
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
When using those operations, it updates the current object directly and returns it. For example: |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
my $vers = Changes::Version->new( 'v1.2.3_4' ); |
1454
|
|
|
|
|
|
|
# By default, using the 'minor' fragment |
1455
|
|
|
|
|
|
|
$vers++; # version is now v1.3.3_4 |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
=back |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
=head1 AUTHOR |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
=head1 SEE ALSO |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
L<Changes>, L<Changes::Release>, L<Changes::Group>, L<Changes::Change> and L<Changes::NewLine> |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
L<version>, L<Perl::Version> |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
L<CPAN::Meta::Spec/"Version Formats"> |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
L<http://www.modernperlbooks.com/mt/2009/07/version-confusion.html> |
1472
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
L<https://xdg.me/version-numbers-should-be-boring/> |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
L<https://en.wikipedia.org/wiki/Software_versioning> |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
Copyright(c) 2022 DEGUEST Pte. Ltd. |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
All rights reserved |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
=cut |