File Coverage

lib/Changes/Change.pm
Criterion Covered Total %
statement 100 206 48.5
branch 19 160 11.8
condition 28 93 30.1
subroutine 26 28 92.8
pod 13 15 86.6
total 186 502 37.0


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Changes file management - ~/lib/Changes/Change.pm
3             ## Version v0.1.0
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/11/23
7             ## Modified 2022/11/23
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::Change;
15             BEGIN
16             {
17 19     19   104011 use strict;
  19         52  
  19         643  
18 19     19   107 use warnings;
  19         47  
  19         512  
19 19     19   114 use warnings::register;
  19         38  
  19         2918  
20 19     19   573 use parent qw( Module::Generic );
  19         434  
  19         182  
21 19     19   12380787 use vars qw( $VERSION );
  19         48  
  19         939  
22 19     19   122 use Nice::Try;
  19         40  
  19         152  
23 19     19   6772657 our $VERSION = 'v0.1.0';
24             };
25              
26 19     19   234 use strict;
  19         37  
  19         559  
27 19     19   102 use warnings;
  19         39  
  19         28358  
28              
29             sub init
30             {
31 47     47 1 9596 my $self = shift( @_ );
32 47         1147 $self->{line} = undef;
33 47         200 $self->{marker} = undef;
34 47         143 $self->{max_width} = 0;
35 47         159 $self->{nl} = "\n";
36 47         191 $self->{raw} = undef;
37 47         125 $self->{spacer1} = undef;
38 47         147 $self->{spacer2} = undef;
39 47         172 $self->{text} = undef;
40 47         142 $self->{wrapper} = undef;
41 47         132 $self->{_init_strict_use_sub} = 1;
42 47 50       297 $self->SUPER::init( @_ ) || return( $self->pass_error );
43 47         326838 $self->{_reset} = 1;
44 47         166 $self->{_reset_normalise} = 1;
45 47         602 return( $self );
46             }
47              
48             sub as_string
49             {
50 49     49 1 5239 my $self = shift( @_ );
51 49 50 66     265 if( !exists( $self->{_reset} ) ||
      33        
52             !defined( $self->{_reset} ) ||
53             !CORE::length( $self->{_reset} ) )
54             {
55 43 100 66     472 if( exists( $self->{_cache_value} ) &&
    50 66        
      33        
56             defined( $self->{_cache_value} ) &&
57             length( $self->{_cache_value} ) )
58             {
59 4         34 return( $self->{_cache_value} );
60             }
61             elsif( defined( $self->{raw} ) && length( "$self->{raw}" ) )
62             {
63 39         382 return( $self->{raw} );
64             }
65             }
66 6         36 my $nl = $self->nl;
67 6   50     5511 my $str = $self->new_scalar( ( $self->spacer1 // '' ) . ( $self->marker // '-' ) . ( $self->spacer2 // '' ) );
      100        
      50        
68 6         5669 my $max = $self->max_width;
69 6 100 100     167367 if( $max > 0 && ( $self->normalise->length + $str->length ) > $max )
70             {
71 1         140170 my $text;
72 1 100       7 my @spaces = map{ $_ eq "\t" ? "\t" : ' ' } split( //, "$str" );
  3         26  
73 1         5 my $sep = join( '', @spaces );
74 1         7 my $wrapper = $self->wrapper;
75 1 50       942 if( $self->_is_code( $wrapper ) )
    50          
    0          
76             {
77 0 0 0     0 try
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
78 0     0   0 {
79 0         0 $text = $wrapper->( $self->normalise->scalar, ( $max - $str->length ) );
80             }
81 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  
82 0     0   0 {
83 0 0       0 warn( "Warning only: an error occurred while calling the wrapper calback with ", $self->normalise->length, " bytes of change text and a maximum width of ", ( $max - $str->length ), " characters: $e\n" ) if( $self->_warnings_is_enabled );
84 19 0 0 19   169 }
  19 0 0     44  
  19 0 0     1597  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
85             }
86             elsif( $self->_load_class( 'Text::Wrap' ) )
87             {
88             # Silence the use of $Text::Wrap::columns used once
89 19     19   134 no warnings 'once';
  19         49  
  19         17476  
90             # We need to reduce $max by as much indentation there is
91 1         3863 local $Text::Wrap::columns = ( $max - $str->length );
92 1         42011 $text = Text::Wrap::wrap( '', '', $self->normalise->scalar );
93             }
94             elsif( $self->_load_class( 'Text::Format' ) )
95             {
96 0         0 my $fmt = Text::Format->new({
97             columns => ( $max - $str->length ),
98             extraSpace => 0,
99             firstIndent => 0,
100             });
101 0         0 $text = $fmt->format( $self->normalise->scalar );
102             }
103            
104 1 50 33     5584 if( defined( $text ) && length( "$text" ) )
105             {
106 1         16 $str->append( join( "\n$sep", split( /\r?\n/, "$text" ) ) );
107             }
108             }
109             else
110             {
111 5         137915 $str->append( $self->normalise );
112             }
113 6         117 $str->append( $nl );
114 6         845 $self->{_cache_value} = $str;
115 6         25 CORE::delete( $self->{_reset} );
116 6         38 return( $str );
117             }
118              
119             sub freeze
120             {
121 41     41 0 89 my $self = shift( @_ );
122 41         168 CORE::delete( @$self{qw( _reset _reset_normalise )} );
123 41         161 return( $self );
124             }
125              
126 41     41 1 75926 sub line { return( shift->reset(@_)->_set_get_number( 'line', @_ ) ); }
127              
128 55     55 1 969173 sub marker { return( shift->reset(@_)->_set_get_scalar_as_object( 'marker', @_ ) ); }
129              
130 51     51 1 3566244 sub max_width { return( shift->_set_get_number( 'max_width', @_ ) ); }
131              
132 55     55 1 323432 sub nl { return( shift->reset(@_)->_set_get_scalar_as_object( 'nl', @_ ) ); }
133              
134             sub normalise
135             {
136 10     10 1 2120 my $self = shift( @_ );
137 10 100 33     271 if( (
      100        
      66        
138             !exists( $self->{_reset_normalise} ) ||
139             !defined( $self->{_reset_normalise} ) ||
140             !CORE::length( $self->{_reset_normalise} )
141             ) && exists( $self->{_normalised} ) &&
142             $self->_is_a( $self->{_normalised} => 'Module::Generic::Scalar' ) )
143             {
144 2         134 return( $self->{_normalised} );
145             }
146 8         40 my $str = $self->text->clone;
147 8 50       5511 return( $str ) if( $str->is_empty );
148 8 100       107 if( $str->index( "\n" ) != -1 )
149             {
150 2         80271 $str->replace( qr/[[:blank:]\h]*\n[[:blank:]\h]*/ => ' ' );
151             }
152 8         242774 $self->{_normalised} = $str;
153 8         1122 CORE::delete( $self->{_reset_normalise} );
154 8         72 return( $str );
155             }
156              
157             sub prefix
158             {
159 4     4 1 1392 my $self = shift( @_ );
160 4   50     19 my $s = ( $self->spacer1 // '' ) . ( $self->marker // '' ) . ( $self->spacer2 // '' );
      50        
      50        
161 4         3713 return( $self->new_scalar( \$s ) );
162             }
163              
164 46     46 1 640336 sub raw { return( shift->_set_get_scalar_as_object( 'raw', @_ ) ); }
165              
166             sub reset
167             {
168 366     366 0 744 my $self = shift( @_ );
169 366 100 33     3504 if( (
      100        
170             !exists( $self->{_reset} ) ||
171             !defined( $self->{_reset} ) ||
172             !CORE::length( $self->{_reset} )
173             ) && scalar( @_ ) )
174             {
175 47         281 $self->{_reset} = scalar( @_ );
176 47         203 $self->{_reset_normalise} = 1;
177             }
178 366         2121 return( $self );
179             }
180              
181             # space before the marker
182 58     58 1 531698 sub spacer1 { return( shift->reset(@_)->_set_get_scalar_as_object( 'spacer1', @_ ) ); }
183              
184             # space after the marker
185 58     58 1 530336 sub spacer2 { return( shift->reset(@_)->_set_get_scalar_as_object( 'spacer2', @_ ) ); }
186              
187 99     99 1 399663 sub text { return( shift->reset(@_)->_set_get_scalar_as_object( 'text', @_ ) ); }
188              
189             # We do not use the reset here, because just setting a wrap callback has no direct impact on the output
190 1     1 1 11 sub wrapper { return( shift->_set_get_code( 'wrapper', @_ ) ); }
191              
192             1;
193             # NOTE: POD
194             __END__
195              
196             =encoding utf-8
197              
198             =head1 NAME
199              
200             Changes::Change - Changes object class
201              
202             =head1 SYNOPSIS
203              
204             use Changes::Change;
205             my $this = Changes::Change->new(
206             line => 12,
207             marker => '-',
208             max_width => 68,
209             spacer1 => "\t",
210             # Defaults to just one space
211             spacer2 => undef,
212             text => "This is a change note",
213             wrapper => sub
214             {
215             my( $text, $width ) = @_;
216             require Text::Wrap;
217             local $Text::Wrap::columns = $width;
218             my $result = Text::Wrap::wrap( '', '', "$text" );
219             return( $result );
220             }
221             ) || die( Changes::Change->error, "\n" );
222              
223             =head1 VERSION
224              
225             v0.1.0
226              
227             =head1 DESCRIPTION
228              
229             This represents a change line within a release. A change line is usually represented by some indentation spaces, followed by a marker such as a dash, a space and a text:
230              
231             - This is a change note
232              
233             A change text can be written on a very long line or broken into lines of C<max_width>. You can change this value with L</max_width> and by default it is 0, which means it will be all on one line.
234              
235             =head1 METHODS
236              
237             =head2 as_string
238              
239             Returns a L<scalar object|Module::Generic::Scalar> of the change line. This information is cached unless other information has been changed.
240              
241             Also, if nothing was changed and L</raw> is set with a value, that value will be returned instead.
242              
243             If L</wrapper> is defined, the perl code reference set will be called by providing it the text of the change and the adjusted width to use. The actual width is the width of the change text with any leading spaces and characters as specified with L</spacer1>, L</spacer2> and L</marker>.
244              
245             If the callback dies, this exception will be caught and displayed as a warning if C<use warnings> is enabled.
246              
247             If no callback is specified, it will attempt to load L<Text::Wrap> (a perl core module) and L<Text::Format> in this order.
248              
249             If none of it is possible, the change text will simply not be wrapped.
250              
251             If an error occurred, it returns an L<error|Module::Generic/error>
252              
253             The resulting string is terminated by the carriage return sequence defined with L</nl>
254              
255             It returns a L<scalar object|Module::Generic::Scalar>
256              
257             =for Pod::Coverage freeze
258              
259             =head2 line
260              
261             Sets or gets an integer representing the line number where this line containing the change information was found in the original C<Changes> file. If this object was instantiated separately, then obviously this value will be C<undef>
262              
263             =head2 marker
264              
265             Sets or gets the character representing the marker preceding the text of the change. This is usually a dash.
266              
267             It returns a L<scalar object|Module::Generic::Scalar>
268              
269             =head2 max_width
270              
271             Sets or gets the change line maximum width. The line width includes any spaces and characters at the beginning of the line, as set with L</spacer1>, L</spacer2> and L</marker> and not just the text of the change itself.
272              
273             It returns a L<number object|Module::Generic::Number>
274              
275             =head2 nl
276              
277             Sets or gets the new line character, which defaults to C<\n>
278              
279             It returns a L<number object|Module::Generic::Number>
280              
281             =head2 normalise
282              
283             This returns a "normalised" version of the change text, which means that if the change text is wrapped and has new lines with possibly preceding and trailing spaces, those will be replaced by a single space.
284              
285             It does not modify the original change text.
286              
287             It returns a L<scalar object|Module::Generic::Scalar>
288              
289             =head2 prefix
290              
291             Read-only. This returns what precedes the text of the change, which is an optional leading space, and a marker such as a dash.
292              
293             It returns a L<scalar object|Module::Generic::Scalar>
294              
295             =head2 raw
296              
297             Sets or gets the raw version of the line as found in the C<Changes> file. If set and nothing has been changed, this will be returned by L</as_string> instead of computing the formatting of the change.
298              
299             It returns a L<scalar object|Module::Generic::Scalar>
300              
301             =for Pod::Coverage reset
302              
303             =head2 spacer1
304              
305             Sets or gets the leading space, if any, found before the marker.
306              
307             It returns a L<scalar object|Module::Generic::Scalar>
308              
309             =head2 spacer2
310              
311             Sets or gets the space found after the marker and before the text of the change.
312              
313             It returns a L<scalar object|Module::Generic::Scalar>
314              
315             =head2 text
316              
317             Sets or gets the text o the change. If the text is broken into multiple lines in the C<Changes> file, it will be collected as on L<scalar object|Module::Generic::Scalar> here.
318              
319             It returns a L<scalar object|Module::Generic::Scalar>
320              
321             =head2 wrapper
322              
323             Sets or gets a code reference as a callback mechanism to return a properly wrapped change text. This allows flexibility beyond the default use of L<Text::Wrap> and L<Text::Format>
324              
325             =head1 AUTHOR
326              
327             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
328              
329             =head1 SEE ALSO
330              
331             L<Changes>, L<Changes::Release>, L<Changes::Group>, L<Changes::Version>, L<Changes::NewLine>
332              
333             =head1 COPYRIGHT & LICENSE
334              
335             Copyright(c) 2022 DEGUEST Pte. Ltd.
336              
337             All rights reserved
338              
339             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
340              
341             =cut