File Coverage

lib/Changes/Release.pm
Criterion Covered Total %
statement 324 689 47.0
branch 93 622 14.9
condition 73 262 27.8
subroutine 51 65 78.4
pod 28 30 93.3
total 569 1668 34.1


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Changes file management - ~/lib/Changes/Release.pm
3             ## Version v0.2.1
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/11/23
7             ## Modified 2022/12/18
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::Release;
15             BEGIN
16             {
17 19     19   673998 use strict;
  19         48  
  19         693  
18 19     19   104 use warnings;
  19         40  
  19         554  
19 19     19   103 use warnings::register;
  19         34  
  19         2120  
20 19     19   120 use parent qw( Module::Generic );
  19         2060  
  19         119  
21 19     19   11505562 use vars qw( $VERSION $VERSION_CLASS $DEFAULT_DATETIME_FORMAT );
  19         47  
  19         1039  
22 19     19   7578 use Changes::Group;
  19         64  
  19         208  
23 19     19   17788 use Changes::Version;
  19         102  
  19         375  
24 19     19   9592 use DateTime;
  19         545805  
  19         614  
25 19     19   115 use Nice::Try;
  19         38  
  19         173  
26 19     19   19290395 use Want;
  19         51  
  19         2780  
27 19     19   89 our $VERSION_CLASS = 'Changes::Version';
28 19         43 our $DEFAULT_DATETIME_FORMAT = '%FT%T%z';
29 19         407 our $VERSION = 'v0.2.1';
30             };
31              
32 19     19   145 use strict;
  19         45  
  19         568  
33 19     19   108 use warnings;
  19         41  
  19         34084  
34              
35             sub init
36             {
37 47     47 1 3823 my $self = shift( @_ );
38 47         1436 $self->{changes} = [];
39 47         195 $self->{container} = undef;
40 47         150 $self->{datetime} = undef;
41 47         152 $self->{datetime_formatter} = undef;
42 47         156 $self->{defaults} = undef;
43 47         166 $self->{elements} = [];
44             # DateTime format
45 47         149 $self->{format} = undef;
46 47         182 $self->{line} = undef;
47 47         151 $self->{nl} = "\n";
48 47         163 $self->{note} = undef;
49 47         145 $self->{raw} = undef;
50 47         167 $self->{spacer} = undef;
51 47         151 $self->{time_zone} = undef;
52 47         172 $self->{version} = '';
53 47         145 $self->{_init_strict_use_sub} = 1;
54 47 50       349 $self->SUPER::init( @_ ) || return( $self->pass_error );
55 47         795681 $self->{_reset} = 1;
56 47         188 return( $self );
57             }
58              
59             sub add_change
60             {
61 1     1 1 1038 my $self = shift( @_ );
62 1         5 my( $change, $opts );
63 1         5 my $elements = $self->elements;
64 1 50 33     155 if( scalar( @_ ) == 1 && $self->_is_a( $_[0] => 'Changes::Change' ) )
65             {
66 0         0 $change = shift( @_ );
67 0 0       0 if( $elements->exists( $change ) )
68             {
69 0         0 $self->_load_class( 'overload' );
70 0         0 return( $self->error( "A very same change object (", overload::StrVal( $change ), ") is already registered." ) );
71             }
72             }
73             else
74             {
75 1         8 $opts = $self->_get_args_as_hash( @_ );
76 1   50     167 $change = $self->new_change( %$opts ) || return( $self->pass_error );
77             }
78 1         8 $elements->push( $change );
79 1         10 return( $change );
80             }
81              
82             sub add_group
83             {
84 4     4 1 1537 my $self = shift( @_ );
85 4         6 my( $group, $opts );
86 4         14 my $elements = $self->elements;
87 4 100 66     577 if( scalar( @_ ) == 1 && $self->_is_a( $_[0] => 'Changes::Group' ) )
88             {
89 2         85 $group = shift( @_ );
90 2 50       8 if( $elements->exists( $group ) )
91             {
92 0         0 $self->_load_class( 'overload' );
93 0         0 return( $self->error( "A very same group object (", overload::StrVal( $group ), ") is already registered." ) );
94             }
95 2         62 my $name = $group->name;
96 2 50 33     393 if( !defined( $name ) || !length( "$name" ) )
97             {
98 0         0 return( $self->error( "Group object provided has empty name." ) );
99             }
100 2 50 50 1   38 my $same = $elements->grep(sub{ $self->_is_a( $_ => 'Changes::Group' ) && ( ( $_->name // '' ) eq "$name" ) });
  1         13  
101 2 50       359 return( $self->error( "A similar group with name '$name' is already registered." ) ) if( !$same->is_empty );
102             }
103             else
104             {
105 2         9 $opts = $self->_get_args_as_hash( @_ );
106 2   50     247 $group = $self->new_group( %$opts ) || return( $self->pass_error );
107 2         20 return( $self->add_group( $group ) );
108             }
109 2         54 my $last = $elements->last;
110             # If we are not the first element of this release, and the last element is not a blank new line, we add one to separate this new group from the preceding rest
111 2 100 66     137 if( $elements->length && !$self->_is_a( $last => 'Changes::NewLine' ) )
112             {
113 1   50     9300 $elements->push( $self->new_line( nl => ( $self->nl // "\n" ) ) );
114             }
115 2         9262 $elements->push( $group );
116 2         262 return( $group );
117             }
118              
119             sub as_string
120             {
121 47     47 1 10267 my $self = shift( @_ );
122 47 100 100     567 $self->message( 5, "Is reset set ? ", ( exists( $self->{_reset} ) ? 'yes' : 'no' ), " and what is cache value '", ( $self->{_cache_value} // '' ), "' and raw cache '", ( $self->{raw} // '' ), "'" );
      100        
123 47 50 66     1297 if( !exists( $self->{_reset} ) ||
      33        
124             !defined( $self->{_reset} ) ||
125             !CORE::length( $self->{_reset} ) )
126             {
127 44         79 my $cache;
128 44 100 66     375 if( exists( $self->{_cache_value} ) &&
    50 66        
      33        
129             defined( $self->{_cache_value} ) &&
130             length( $self->{_cache_value} ) )
131             {
132 2         15 $cache = $self->{_cache_value};
133             }
134             elsif( defined( $self->{raw} ) && length( "$self->{raw}" ) )
135             {
136 42         352 $cache = $self->{raw};
137             }
138            
139 44         176 my $lines = $self->new_array( $cache->scalar );
140             $self->elements->foreach(sub
141             {
142 42     42   6613 $self->message( 4, "Calling as_string on $_" );
143 42         928 my $this = $_->as_string;
144 42 50       269 if( defined( $this ) )
145             {
146 42         144 $self->message( 4, "Adding string '$this' to new lines" );
147 42         997 $lines->push( $this->scalar );
148             }
149 44         1135 });
150             # my $str = $lines->join( "\n" );
151 44         7133 my $str = $lines->join( '' );
152 44         1585 return( $str );
153             }
154 3         14 my $v = $self->version;
155 3 50 33     354 return( $self->error( "No version set yet. Set a version before calling as_string()" ) ) if( !defined( $v ) || !length( "$v" ) );
156 3         44 my $dt = $self->datetime;
157 3         1126 my $code = $self->datetime_formatter;
158 3 100 66     600 if( defined( $code ) && ref( $code ) eq 'CODE' )
159             {
160 1 50 33     4 try
  1         2  
  1         3  
  1         6  
  0         0  
  1         2  
  1         4  
  1         3  
161 1     1   3 {
162 1 50       6 $dt = $code->( defined( $dt ) ? $dt : () );
163             }
164 1 0 50     7 catch( $e )
  1 0 33     2802  
  1 0       5  
  1 0       2  
  1 0       3  
  1 0       2  
  1 0       3  
  1 0       6  
  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  
  1         11  
  0         0  
  1         2  
  0         0  
  0         0  
  1         5  
  1         6  
  1         16  
  1         5  
  0         0  
  0         0  
  0         0  
  0         0  
165 0     0   0 {
166 0 0       0 warn( "Warning only: error with datetime formatter calback: $e\n" ) if( $self->_warnings_is_enabled( 'Changes' ) );
167 19 0 0 19   218 }
  19 0 0     49  
  19 0 33     23474  
  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  
  1 0       4  
  0 0       0  
  1 0       25  
  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  
  1         4  
  0         0  
  0         0  
  0         0  
  0         0  
  1         5  
168             }
169 3 50 33     36 if( !defined( $dt ) || !length( "$dt" ) )
170             {
171 0         0 $dt = DateTime->now;
172             }
173            
174 3         1351 my $fmt_pattern = $self->format;
175 3 50 33     649 $fmt_pattern = $DEFAULT_DATETIME_FORMAT if( defined( $fmt_pattern ) && $fmt_pattern eq 'default' );
176 3         51 my $tz = $self->time_zone;
177 3 0 33     27 if( ( !defined( $fmt_pattern ) || !length( "$fmt_pattern" ) ) &&
      33        
      33        
178             !$dt->formatter &&
179             defined( $DEFAULT_DATETIME_FORMAT ) &&
180             length( "$DEFAULT_DATETIME_FORMAT" ) )
181             {
182 0         0 $fmt_pattern = $DEFAULT_DATETIME_FORMAT;
183             }
184 3 50       42 if( defined( $tz ) )
185             {
186 3 50 33     13 try
  3         7  
  3         8  
  3         17  
  0         0  
  3         8  
  3         12  
  3         9  
187 3     3   6 {
188 3         27 $dt->set_time_zone( $tz );
189             }
190 3 0 50     28 catch( $e )
  3 0 33     967  
  3 0       13  
  3 0       11  
  3 0       7  
  3 0       5  
  3 0       6  
  3 0       16  
  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  
  3         14  
  0         0  
  3         9  
  0         0  
  0         0  
  3         14  
  3         17  
  3         10  
  3         10  
  0         0  
  0         0  
  0         0  
  0         0  
191 0     0   0 {
192 0 0       0 warn( "Warning only: error trying to set the time zone '", $tz->name, "' (", overload::StrVal( $tz ), ") to DateTime object: $e\n" ) if( $self->_warnings_is_enabled( 'Changes' ) );
193 19 0 0 19   177 }
  19 0 0     53  
  19 0 33     21710  
  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  
  3 0       11  
  0 0       0  
  3 0       108  
  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  
  3         13  
  0         0  
  0         0  
  0         0  
  0         0  
  3         15  
194             }
195 3 50 33     29 if( defined( $fmt_pattern ) &&
196             length( "$fmt_pattern" ) )
197             {
198 3 50 33     31 try
  3         7  
  3         5  
  3         16  
  0         0  
  3         10  
  3         13  
  3         8  
199 3     3   8 {
200 3         26 require DateTime::Format::Strptime;
201 3         21 my $dt_fmt = DateTime::Format::Strptime->new(
202             pattern => $fmt_pattern,
203             locale => 'en_GB',
204             );
205 3         5485 $dt->set_formatter( $dt_fmt );
206             }
207 3 0 50     32 catch( $e )
  3 0 33     442  
  3 0       22  
  3 0       8  
  3 0       7  
  3 0       8  
  3 0       7  
  3 0       19  
  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  
  3         27  
  0         0  
  3         21  
  0         0  
  0         0  
  3         18  
  3         29  
  3         10  
  3         13  
  0         0  
  0         0  
  0         0  
  0         0  
208 0     0   0 {
209 0         0 return( $self->error( "Error trying to set formatter for format '${fmt_pattern}': $e" ) );
210 19 0 0 19   182 }
  19 0 0     52  
  19 0 33     58622  
  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  
  3 0       11  
  0 0       0  
  3 0       92  
  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  
  3         13  
  0         0  
  0         0  
  0         0  
  0         0  
  3         14  
211             }
212 3         16 my $nl = $self->nl;
213 3         581 my $lines = $self->new_array;
214 3 100 100     59 my $rel_str = $self->new_scalar( $v . ( $self->spacer // ' ' ) . "$dt" . ( $self->note->length ? ( ' ' . $self->note->scalar ) : '' ) . ( $nl // '' ) );
      50        
215 3         961 $self->message( 4, "Adding release string '$rel_str' to new lines." );
216 3         243 $lines->push( $rel_str->scalar );
217             $self->elements->foreach(sub
218             {
219 4     4   665 $self->message( 4, "Calling as_string on $_" );
220             # XXX
221 4         110 $_->debug( $self->debug );
222 4         191 my $this = $_->as_string;
223 4 50       103 if( defined( $this ) )
224             {
225 4         17 $self->message( 4, "Adding string '$this' (", overload::StrVal( $this ), ") to new lines" );
226 4         161 $lines->push( $this->scalar );
227             }
228 3         90 });
229             # my $str = $lines->join( "$nl" );
230 3         568 my $str = $lines->join( '' );
231 3         132 $self->{_cache_value} = $str;
232 3         10 CORE::delete( $self->{_reset} );
233 3         14 return( $str );
234             }
235              
236             sub changes
237             {
238 156     156 1 387648 my $self = shift( @_ );
239             # my $a = $self->elements->grep(sub{ $self->_is_a( $_ => 'Changes::Change' ) });
240             # We account for both Changes::Change objects registered directly under this release object, and
241             # and Changes::Change objects registered under any Changes::Group objects
242 156         652 my $a = $self->new_array;
243             $self->elements->foreach(sub
244             {
245 110 100   110   17066 if( $self->_is_a( $_ => 'Changes::Change' ) )
    50          
246             {
247 102         3693 $a->push( $_ );
248             }
249             elsif( $self->_is_a( $_ => 'Changes::Group' ) )
250             {
251 8         510 my $changes = $_->elements->grep(sub{ $self->_is_a( $_ => 'Changes::Change' ) });
  9         1171  
252 8 50       799 $a->push( $changes->list ) if( defined( $changes ) );
253             }
254 156         13331 });
255 156         26546 return( $a );
256             }
257              
258 44     44 1 976293 sub container { return( shift->_set_get_object_without_init( 'container', 'Changes', @_ ) ); }
259              
260 86     86 1 133276 sub datetime { return( shift->reset(@_)->_set_get_datetime( 'datetime', @_ ) ); }
261              
262 5     5 1 4614820 sub datetime_formatter { return( shift->reset(@_)->_set_get_code( { field => 'datetime_formatter', undef_ok => 1 }, @_ ) ); }
263              
264 5     5 1 4591821 sub defaults { return( shift->_set_get_hash_as_mix_object( { field => 'defaults', undef_ok => 1 }, @_ ) ); }
265              
266             sub delete_change
267             {
268 0     0 1 0 my $self = shift( @_ );
269 0         0 my $elements = $self->elements;
270 0         0 my $removed = $self->new_array;
271 0         0 $self->_load_class( 'overload' );
272 0         0 foreach my $change ( @_ )
273             {
274 0 0       0 if( $self->_is_a( $change => 'Changes::Change' ) )
275             {
276 0         0 my $pos = $elements->pos( $change );
277 0 0       0 if( !defined( $pos ) )
278             {
279 0 0       0 $self->message( 4, "No change object found for object $change (", overload::StrVal( $change ), ")" ) if( !defined( $pos ) );
280 0         0 next;
281             }
282 0         0 my $deleted = $elements->delete( $pos, 1 );
283 0 0       0 $removed->push( $deleted->list ) if( !$deleted->is_empty );
284             }
285             else
286             {
287 0 0 0     0 warn( "I was expecting a Changes::Change object, but instead got '", ( $_[0] // '' ), "' (", ( defined( $_[0] ) ? overload::StrVal( $_[0] ) : 'undef' ), ").\n" ) if( $self->_warnings_is_enabled );
    0          
288             }
289             }
290 0         0 return( $removed );
291             }
292              
293             sub delete_group
294             {
295 0     0 1 0 my $self = shift( @_ );
296 0         0 my $elements = $self->elements;
297 0         0 my $removed = $self->new_array;
298 0         0 $self->_load_class( 'overload' );
299 0         0 foreach my $group ( @_ )
300             {
301 0 0       0 if( $self->_is_a( $group => 'Changes::Group' ) )
302             {
303 0         0 my $pos = $elements->pos( $group );
304 0 0       0 if( !defined( $pos ) )
305             {
306 0         0 $self->message( 4, "No group object found for object $group (", overload::StrVal( $group ), ")" );
307 0         0 next;
308             }
309 0         0 my $deleted = $elements->delete( $pos, 1 );
310 0 0       0 $removed->push( $deleted->list ) if( !$deleted->is_empty );
311             }
312             else
313             {
314 0         0 my $name = $group;
315 0 0 0     0 if( !defined( $name ) || !length( "$name" ) )
316             {
317 0 0       0 warn( "No group name provided to remove its corresponding group object.\n" ) if( $self->_warnings_is_enabled );
318 0         0 next;
319             }
320 0 0   0   0 my $found = $elements->grep(sub{ $self->_is_a( $_ => 'Changes::Group' ) && $_->name eq "$name" });
  0         0  
321 0 0       0 if( $found->is_empty )
322             {
323 0         0 next;
324             }
325             $found->foreach(sub
326             {
327 0     0   0 my $deleted = $self->delete_group( $_ );
328 0 0       0 $removed->push( $deleted->list ) if( !$deleted->is_empty );
329 0         0 });
330             }
331             }
332 0         0 return( $removed );
333             }
334              
335 298     298 1 1235 sub elements { return( shift->_set_get_array_as_object( 'elements', @_ ) ); }
336              
337 7     7 1 2415 sub format { return( shift->reset(@_)->_set_get_scalar_as_object( 'format', @_ ) ); }
338              
339             sub freeze
340             {
341 44     44 0 111 my $self = shift( @_ );
342 44   50     288 $self->message( 5, "Removing the reset marker -> '", ( $self->{_reset} // '' ), "'" );
343 44         849 CORE::delete( @$self{qw( _reset )} );
344             $self->elements->foreach(sub
345             {
346 40 50   40   5554 if( $self->_can( $_ => 'freeze' ) )
347             {
348 40         666 $_->freeze;
349             }
350 44         159 });
351 44         2331 return( $self );
352             }
353              
354             sub groups
355             {
356 6     6 1 26583 my $self = shift( @_ );
357 6     8   29 my $a = $self->elements->grep(sub{ $self->_is_a( $_ => 'Changes::Group' ) });
  8         1074  
358 6         638 return( $a );
359             }
360              
361 44     44 1 842164 sub line { return( shift->reset(@_)->_set_get_number( 'line', @_ ) ); }
362              
363             sub new_change
364             {
365 1     1 1 8 my $self = shift( @_ );
366 1         8 my $opts = $self->_get_args_as_hash( @_ );
367 1 50       120 $self->_load_class( 'Changes::Change' ) || return( $self->pass_error );
368 1         37 my $defaults = $self->defaults;
369 1 50       154 if( defined( $defaults ) )
370             {
371 1         10 foreach my $opt ( qw( spacer1 marker spacer2 max_width wrapper ) )
372             {
373 5 100 33     154 $opts->{ $opt } //= $defaults->{ $opt } if( defined( $defaults->{ $opt } ) );
374             }
375             }
376 1   50     37 my $c = Changes::Change->new( $opts ) ||
377             return( $self->pass_error( Changes::Change->error ) );
378 1         10 return( $c );
379             }
380              
381             sub new_group
382             {
383 2     2 1 4 my $self = shift( @_ );
384 2         5 my $opts = $self->_get_args_as_hash( @_ );
385 2 50       215 $self->_load_class( 'Changes::Group' ) || return( $self->pass_error );
386 2         88 my $defaults = $self->defaults;
387 2 50       634 if( defined( $defaults ) )
388             {
389 2         13 my $def = { %$defaults };
390 2         182 foreach my $opt ( qw( spacer type ) )
391             {
392 4 50 66     52 if( !defined( $opts->{ "group_${opt}" } ) &&
      66        
      66        
393             exists( $def->{ "group_${opt}" } ) &&
394             defined( $def->{ "group_${opt}" } ) &&
395             length( $def->{ "group_${opt}" } ) )
396             {
397 2         11 $opts->{ $opt } = CORE::delete( $def->{ "group_${opt}" } );
398             }
399             }
400 2   33     43 $opts->{defaults} //= $def;
401             }
402 2   50     31 my $g = Changes::Group->new( $opts ) ||
403             return( $self->pass_error( Changes::Group->error ) );
404 2         20 return( $g );
405             }
406              
407             sub new_line
408             {
409 1     1 1 179 my $self = shift( @_ );
410 1 50       4 $self->_load_class( 'Changes::NewLine' ) || return( $self->pass_error );
411 1   50     37 my $nl = Changes::NewLine->new( @_ ) ||
412             return( $self->pass_error( Changes::NewLine->error ) );
413 1         10 return( $nl );
414             }
415              
416             sub new_version
417             {
418 0     0 1 0 my $self = shift( @_ );
419 0 0       0 $self->_load_class( 'Changes::Version' ) || return( $self->pass_error );
420 0   0     0 my $v = Changes::Version->new( @_ ) ||
421             return( $self->pass_error( Changes::Version->error ) );
422 0         0 return( $v );
423             }
424              
425 48     48 1 954330 sub nl { return( shift->reset(@_)->_set_get_scalar_as_object( 'nl', @_ ) ); }
426              
427 29     29 1 4346374 sub note { return( shift->reset(@_)->_set_get_scalar_as_object( 'note', @_ ) ); }
428              
429 45     45 1 549424 sub raw { return( shift->_set_get_scalar_as_object( 'raw', @_ ) ); }
430              
431 0     0 1 0 sub remove_change { return( shift->delete_change( @_ ) ); }
432              
433 0     0 1 0 sub remove_group { return( shift->delete_group( @_ ) ); }
434              
435             sub reset
436             {
437 378     378 0 826 my $self = shift( @_ );
438 378 100 33     3384 if( (
      100        
439             !exists( $self->{_reset} ) ||
440             !defined( $self->{_reset} ) ||
441             !CORE::length( $self->{_reset} )
442             ) && scalar( @_ ) )
443             {
444 47     0   485 $self->message( 4, "Reset called from -> ", sub{ $self->_get_stack_trace } );
  0         0  
445 47         1194 $self->{_reset} = scalar( @_ );
446             # Cascade down the need for reset
447             $self->changes->foreach(sub
448             {
449 0 0   0   0 if( $self->_can( $_ => 'reset' ) )
450             {
451 0         0 $_->reset(1);
452             }
453 47         263 });
454             }
455 378         5328 return( $self );
456             }
457              
458 0     0 1 0 sub set_default_format { return( shift->format( $DEFAULT_DATETIME_FORMAT ) ); }
459              
460 52     52 1 982644 sub spacer { return( shift->reset(@_)->_set_get_scalar_as_object( 'spacer', @_ ) ); }
461              
462             sub time_zone
463             {
464 10     10 1 8533 my $self = shift( @_ );
465 10 100       47 if( @_ )
466             {
467 5         15 my $v = shift( @_ );
468 5 100       28 if( $self->_is_a( $v => 'DateTime::TimeZone' ) )
469             {
470 2         104 $self->{time_zone} = $v;
471             }
472             else
473             {
474 3 50 33     67 try
  3         6  
  3         45  
  3         22  
  0         0  
  3         5  
  3         10  
  3         7  
475 3     3   8 {
476 3 50       16 $self->_load_class( 'DateTime::TimeZone' ) || return( $self->pass_error );
477 3         158 my $tz = DateTime::TimeZone->new( name => "$v" );
478 3         27275 $self->{time_zone} = $tz;
479             }
480 3 0 50     29 catch( $e )
  3 0 33     16  
  3 0       14  
  3 0       7  
  3 0       16  
  3 0       6  
  3 0       6  
  3 0       18  
  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  
  3         13  
  0         0  
  3         8  
  0         0  
  0         0  
  3         35  
  3         23  
  3         9  
  3         12  
  0         0  
  0         0  
  0         0  
  0         0  
481 0     0   0 {
482 0         0 return( $self->error( "Error setting time zone for '$v': $e" ) );
483 19 0 0 19   178 }
  19 0 0     53  
  19 0 33     5274  
  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  
  3 0       11  
  0 0       0  
  3 0       119  
  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  
  3         13  
  0         0  
  0         0  
  0         0  
  0         0  
  3         14  
484             }
485 5         21 $self->reset(1);
486             }
487 10 50       61 if( !defined( $self->{time_zone} ) )
488             {
489 0 0       0 if( Want::want( 'OBJECT' ) )
490             {
491 0         0 require Module::Generic::Null;
492 0         0 rreturn( Module::Generic::Null->new( wants => 'OBJECT' ) );
493             }
494             else
495             {
496 0         0 return;
497             }
498             }
499             else
500             {
501 10         51 return( $self->{time_zone} );
502             }
503             }
504              
505 102     102 1 1048419 sub version { return( shift->reset(@_)->_set_get_version( { field => 'version', class => $VERSION_CLASS }, @_ ) ); }
506              
507             1;
508             # NOTE: POD
509             __END__
510              
511             =encoding utf-8
512              
513             =head1 NAME
514              
515             Changes::Release - Release object class
516              
517             =head1 SYNOPSIS
518              
519             use Changes::Release;
520             my $rel = Changes::Release->new(
521             # A Changes object
522             container => $changes_object,
523             datetime => '2022-11-17T08:12:42+0900',
524             datetime_formatter => sub
525             {
526             my $dt = shift( @_ ) || DateTime->now;
527             require DateTime::Format::Strptime;
528             my $fmt = DateTime::Format::Strptime->new(
529             pattern => '%FT%T%z',
530             locale => 'en_GB',
531             );
532             $dt->set_formatter( $fmt );
533             $dt->set_time_zone( 'Asia/Tokyo' );
534             return( $dt );
535             },
536             format => '%FT%T%z',
537             line => 12,
538             note => 'Initial release',
539             spacer => "\t",
540             time_zone => 'Asia/Tokyo',
541             version => 'v0.1.0',
542             ) || die( Changes::Release->error, "\n" );
543             my $change = $rel->add_change( $change_object );
544             # or
545             my $change = $rel->add_change( text => 'Some comments' );
546             my $group = $rel->add_group( $group_object );
547             # or
548             my $group = $rel->add_group( name => 'Some group' );
549             my $change = $rel->delete_change( $change_object );
550             my $group = $rel->delete_group( $group_object );
551             say $rel->as_string;
552              
553             =head1 VERSION
554              
555             v0.2.1
556              
557             =head1 DESCRIPTION
558              
559             This class implements a C<Changes> file release line. Such information usually comprise of a C<version> number, a C<release datetime> and an optional note
560              
561             Each release section can contain L<group|Changes::Group> and L<changes|Changes::Change> that are all stored and accessible in L</changes>
562              
563             If an error occurred, it returns an L<error|Module::Generic/error>
564              
565             The result of this method is cached so that the second time it is called, the cache is used unless there has been any change.
566              
567             =head1 METHODS
568              
569             =head2 add_change
570              
571             Provided with a L<Changes::Change> object, or an hash or hash reference of options passed to the constructor of L<Changes::Change>, and this will add the change object to the list of elements for this release object.
572              
573             It returns the L<Changes::Change> object, or an L<error|Module::Generic/error> if an error occurred.
574              
575             =head2 add_group
576              
577             Provided with a L<Changes::Group> object, or an hash or hash reference of options passed to the constructor of L<Changes::Group>, and this will add the change object to the list of elements.
578              
579             It returns the L<Changes::Group> object, or an L<error|Module::Generic/error> if an error occurred.
580              
581             =head2 as_string
582              
583             Returns a L<string object|Module::Generic::Scalar> representing the release. It does so by calling C<as_string> on each element stored in L</elements>. Those elements can be L<Changes::Group> and L<Changes::Change> objects.
584              
585             If an error occurred, it returns an L<error|Module::Generic/error>
586              
587             The result of this method is cached so that the second time it is called, the cache is used unless there has been any change.
588              
589             =head2 changes
590              
591             Read only. This returns an L<array object|Module::Generic::Array> containing all the L<change objects|Changes::Change> within this release object.
592              
593             =head2 container
594              
595             Sets or gets the L<container object|Changes> for this release object. A container is the object representing the C<Changes> file: a L<Changes> object.
596              
597             Note that if you instantiate a release object directly, this value will obviously be C<undef>. This value is set by L<Changes> upon parsing the C<Changes> file.
598              
599             =head2 datetime
600              
601             Sets or gets the release datetime information. This uses L<Module::Generic/_parse_datetime> to parse the string, so please check that documentation for supported formats.
602              
603             However, most format are supported including ISO8601 format and L<W3CDTF format|http://www.w3.org/TR/NOTE-datetime> (e.g. C<2022-07-17T12:10:03+09:00>)
604              
605             Note that if you use a relative datetime format such as C<-2D> for 2 days ago, the datetime format will be set to a unix timestamp, and in that case you need to also specify the C<format> option with the desired datetime format.
606              
607             You can alternatively directly set a L<DateTime> object.
608              
609             It returns a L<DateTime> object whose L<date formatter|DateTime::Format::Strptime> object is set to the same format as provided. This ensures that any stringification of the L<DateTime> object reverts back to the string as found in the C<Changes> file or as provided by the user.
610              
611             =head2 datetime_formatter
612              
613             Sets or gets a code reference callback to be used when formatting the release datetime. This allows you to use alternative formatter and greater control over the formatting of the release datetime.
614              
615             This code is called with a L<DateTime> object, and it must return a L<DateTime> object. Any other value will be discarded and it will fallback on setting up a L<DateTime> with current date and time using UTC as time zone and C<$DEFAULT_DATETIME_FORMAT> as default datetime format.
616              
617             The code executed may die if needed and any exception will be caught and a warning will be issued if L<warnings> are enabled for L<Changes>.
618              
619             =head2 defaults
620              
621             Sets or gets an hash of default values for the L<Changes::Change> object when it is instantiated by the C<new_change> method.
622              
623             Default is C<undef>, which means no default value is set.
624              
625             my $ch = Changes->new(
626             file => '/some/where/Changes',
627             defaults => {
628             # For Changes::Change
629             spacer1 => "\t",
630             spacer2 => ' ',
631             marker => '-',
632             max_width => 72,
633             wrapper => $code_reference,
634             # For Changes::Group
635             group_spacer => "\t",
636             group_type => 'bracket', # [Some group]
637             }
638             );
639              
640             =head2 delete_change
641              
642             This takes a list of change to remove and returns an L<array object|Module::Generic::Array> of those changes thus removed.
643              
644             A change provided can only be a L<Changes::Change> object.
645              
646             If an error occurred, this will return an L<error|Module::Generic/error>
647              
648             =head2 delete_group
649              
650             This takes a list of group to remove and returns an L<array object|Module::Generic::Array> of those groups thus removed.
651              
652             A group provided can either be a L<Changes::Group> object, or a group name as a string.
653              
654             If an error occurred, this will return an L<error|Module::Generic/error>
655              
656             =head2 elements
657              
658             Sets or gets an L<array object|Module::Generic::Array> of all the elements within this release object. Those elements can be L<Changes::Group>, L<Changes::Change> and C<Changes::NewLine> objects.
659              
660             =head2 format
661              
662             Sets or gets a L<DateTime> format to be used with L<DateTime::Format::Strptime>. See L<DateTime::Format::Strptime/"STRPTIME PATTERN TOKENS"> for details on possible patterns.
663              
664             You can also specify an alternative formatter with L</datetime_formatter>
665              
666             If you specify the special value C<default>, it will use default value set in the global variable C<$DEFAULT_DATETIME_FORMAT>, which is C<%FT%T%z> (for example: C<2022-12-08T20:13:09+0900>)
667              
668             It returns a L<scalar object|Module::Generic::Scalar>
669              
670             =for Pod::Coverage freeze
671              
672             =head2 groups
673              
674             Read only. This returns an L<array object|Module::Generic::Array> containing all the L<group objects|Changes::Group> within this release object.
675              
676             =head2 line
677              
678             Sets or gets an integer representing the line number where this release line was found in the original C<Changes> file. If this object was instantiated separately, then obviously this value will be C<undef>
679              
680             =head2 new_change
681              
682             Instantiates and returns a new L<Changes::Change>, passing its constructor any argument provided.
683              
684             my $change = $rel->new_change( text => 'Some change' ) ||
685             die( $rel->error );
686              
687             =head2 new_group
688              
689             Instantiates and returns a new L<Changes::Group>, passing its constructor any argument provided.
690              
691             my $change = $rel->new_group( name => 'Some group' ) ||
692             die( $rel->error );
693              
694             =head2 new_line
695              
696             Returns a new C<Changes::NewLine> object, passing it any parameters provided.
697              
698             If an error occurred, it returns an L<error object|Module::Generic/error>
699              
700             =head2 new_version
701              
702             Returns a new C<Changes::Version> object, passing it any parameters provided.
703              
704             If an error occurred, it returns an L<error object|Module::Generic/error>
705              
706             =head2 nl
707              
708             Sets or gets the new line character, which defaults to C<\n>
709              
710             It returns a L<number object|Module::Generic::Number>
711              
712             =head2 note
713              
714             Sets or gets an optional note that is set after the release datetime.
715              
716             It returns a L<scalar object|Module::Generic::Scalar>
717              
718             =head2 raw
719              
720             Sets or gets the raw line as found in the C<Changes> file for this release. If nothing is change, and a raw version exists, then it is returned instead of computing the formatting of the line.
721              
722             It returns a L<scalar object|Module::Generic::Scalar>
723              
724             =head2 remove_change
725              
726             This is an alias for L</delete_change>
727              
728             =head2 remove_group
729              
730             This is an alias for L</delete_group>
731              
732             =for Pod::Coverage reset
733              
734             =head2 set_default_format
735              
736             Sets the default L<DateTime> format pattern used by L<DateTime::Format::Strptime>. This default value used is C<$DEFAULT_DATETIME_FORMAT>, which, by default is: C<%FT%T%z>, i.e. something that would look like C<2022-12-06T20:13:09+0900>
737              
738             =head2 spacer
739              
740             Sets or gets the space that can be found between the version information and the datetime. Normally this would be just one space, but since it can be other space, this is used to capture it and ensure the result is identical to what was parsed.
741              
742             This defaults to a single space if it is not set.
743              
744             It returns a L<scalar object|Module::Generic::Scalar>
745              
746             =head2 time_zone
747              
748             Sets or gets a time zone to use for the release date. A valid time zone can either be an olson time zone string such as C<Asia/Tokyo>, or an L<DateTime::TimeZone> object.
749              
750             It returns a L<DateTime::TimeZone> object upon success, or an L<error|Module::Generic/error> if an error occurred.
751              
752             =head2 version
753              
754             Sets or gets the version information for this release. This returns a L<version> object. If you prefer to use a different class, such as L<Perl::Version>, then you can set the global variable C<$VERSION_CLASS> accordingly.
755              
756             It returns a L<version object|version>, or an object of whatever class you have set with C<$VERSION_CLASS>
757              
758             =head2 changes
759              
760             Sets or gets the L<array object|Module::Generic::Array> containing all the object representing the changes for that release. Those changes can be L<Changes::Group>, L<Changes::Change> or C<Changes::Line>
761              
762             =head1 AUTHOR
763              
764             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
765              
766             =head1 SEE ALSO
767              
768             L<Changes>, L<Changes::Group>, L<Changes::Change>, L<Changes::Version>, L<Changes::NewLine>
769              
770             =head1 COPYRIGHT & LICENSE
771              
772             Copyright(c) 2022 DEGUEST Pte. Ltd.
773              
774             All rights reserved
775              
776             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
777              
778             =cut