File Coverage

blib/lib/Spreadsheet/XLSX/Reader/LibXML/ParseExcelFormatStrings.pm
Criterion Covered Total %
statement 633 680 93.0
branch 325 408 79.6
condition 119 197 60.4
subroutine 51 52 98.0
pod 2 2 100.0
total 1130 1339 84.3


line stmt bran cond sub pod time code
1             package Spreadsheet::XLSX::Reader::LibXML::ParseExcelFormatStrings;
2             our $AUTHORITY = 'cpan:JANDREW';
3 2     2   2868 use version; our $VERSION = version->declare('v0.38.22');
  2         6  
  2         15  
4             ###LogSD warn "You uncovered internal logging statements for Spreadsheet::XLSX::Reader::LibXML::ParseExcelFormatStrings-$VERSION";
5              
6 2     2   250 use 5.010;
  2         6  
7 2     2   733 use Moose::Role;
  2         5097  
  2         14  
8             requires 'get_excel_region', 'set_error', 'get_defined_excel_format',
9             ###LogSD 'get_all_space',
10             ;
11 2         21 use Types::Standard qw(
12             Int Str Maybe
13             Num HashRef ArrayRef
14             CodeRef Object ConsumerOf
15             InstanceOf HasMethods Bool
16             is_Object is_Num is_Int
17 2     2   11268 );
  2         5  
18 2     2   4193 use Carp qw( confess );# cluck
  2         4  
  2         117  
19 2     2   11 use Type::Coercion;
  2         8  
  2         56  
20 2     2   11 use Type::Tiny;
  2         4  
  2         62  
21 2     2   2064 use DateTimeX::Format::Excel 0.012;
  2         500992  
  2         93  
22 2     2   2173 use DateTime::Format::Flexible;
  2         158903  
  2         22  
23 2     2   154 use DateTime;
  2         3  
  2         52  
24 2     2   12 use Clone 'clone';
  2         3  
  2         134  
25 2     2   11 use lib '../../../../../lib',;
  2         5  
  2         18  
26             ###LogSD use Log::Shiras::Telephone;
27             ###LogSD use Log::Shiras::UnhideDebug;
28 2         29 use Spreadsheet::XLSX::Reader::LibXML::Types qw(
29             PositiveNum NegativeNum
30             ZeroOrUndef NotNegativeNum
31             Excel_number_0
32 2     2   1265 );#
  2         6  
33              
34             #########1 Dispatch Tables & Package Variables 5#########6#########7#########8#########9
35              
36             my $coercion_index = 0;
37             my @type_list = ( PositiveNum, NegativeNum, ZeroOrUndef, Str );
38             my $last_date_cldr = 'yyyy-mm-dd';# This is critical to getting the next string to date conversion right
39             my $last_duration = 0;
40             my $last_sub_seconds = 0;
41             my $last_format_rem = 0;
42             my $duration_order ={ h => 'm', m =>'s', s =>'0' };
43             my $number_build_dispatch ={
44             all =>[qw(
45             _convert_negative
46             _divide_by_thousands
47             _convert_to_percent
48             _split_decimal_integer
49             _move_decimal_point
50             _build_fraction
51             _round_decimal
52             _add_commas
53             _pad_exponent
54             )],
55             scientific =>[qw(
56             _convert_negative
57             _split_decimal_integer
58             _move_decimal_point
59             _round_decimal
60             _add_commas
61             _pad_exponent
62             )],
63             percent =>[qw(
64             _convert_negative
65             _convert_to_percent
66             _split_decimal_integer
67             _round_decimal
68             _add_commas
69             )],
70             fraction =>[qw(
71             _convert_negative
72             _split_decimal_integer
73             _build_fraction
74             _add_commas
75             )],
76             integer =>[qw(
77             _convert_negative
78             _divide_by_thousands
79             _split_decimal_integer
80             _round_decimal
81             _add_commas
82             )],
83             decimal =>[qw(
84             _convert_negative
85             _divide_by_thousands
86             _split_decimal_integer
87             _round_decimal
88             _add_commas
89             )],
90             };
91              
92             #########1 Public Attributes 3#########4#########5#########6#########7#########8#########9
93              
94             has epoch_year =>( # Move to required?
95             isa => Int,
96             reader => 'get_epoch_year',
97             writer => 'set_epoch_year',
98             default => 1900,
99             );
100            
101             has cache_formats =>(
102             isa => Bool,
103             reader => 'get_cache_behavior',
104             writer => 'set_cache_behavior',
105             default => 1,
106             );
107            
108             has datetime_dates =>(
109             isa => Bool,
110             reader => 'get_date_behavior',
111             writer => 'set_date_behavior',
112             default => 0,
113             );
114            
115             has european_first =>(
116             isa => Bool,
117             reader => 'get_european_first',
118             writer => 'set_european_first',
119             default => 0,
120             );
121              
122             #########1 Public Methods 3#########4#########5#########6#########7#########8#########9
123              
124             sub get_defined_conversion{
125 0     0 1 0 my( $self, $position, $target_name ) = @_;
126             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
127             ###LogSD $self->get_all_space . '::get_defined_conversion', );
128             ###LogSD $phone->talk( level => 'debug', message => [
129             ###LogSD "Searching for the coercion for position: $position", ($target_name ? "With suggested name: $target_name" : '') ] );
130 0         0 my $coercion_string = $self->get_defined_excel_format( $position );
131 0 0       0 if( !defined $coercion_string ){
132 0         0 $self->set_error( "No coercion available for position: $position" );
133 0         0 return undef;
134             }
135             ###LogSD $phone->talk( level => 'debug', message => [
136             ###LogSD "Position -$position- is associated with the string: $coercion_string", ] );
137 0   0     0 my $coercion = $self->parse_excel_format_string( $coercion_string, ($target_name//"Excel__$position") );
138 0 0       0 if( !$coercion ){
139 0         0 $self->set_error( "Unparsable conversion string at position -$position- found: $coercion_string" );
140 0         0 return undef;
141             }
142             ###LogSD my $level =
143             #~ ###LogSD $position == 164 ? 'fatal' :
144             ###LogSD 'trace';
145             ###LogSD $phone->talk( level => $level, message => [
146             ###LogSD 'Returning coercion:', $coercion,] );
147 0         0 return $coercion;
148             }
149            
150             sub parse_excel_format_string{
151 50     50 1 14784 my( $self, $format_strings, $coercion_name ) = @_;
152             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
153             ###LogSD $self->get_all_space . '::parse_excel_format_string', );
154 50 50       164 if( !defined $format_strings ){
155             ###LogSD $phone->talk( level => 'info', message => [
156             ###LogSD "Nothing passed to convert",] );
157 0         0 return Excel_number_0;
158             }
159 50         148 $format_strings =~ s/\\//g;
160             ###LogSD $phone->talk( level => 'info', message => [
161             ###LogSD "parsing the custom excel format string: $format_strings",] );
162 50         113 my $conversion_type = 'number';
163             # Check the cache
164 50         80 my $cache_key;
165 50 50       3239 if( $self->get_cache_behavior ){
166             ###LogSD $phone->talk( level => 'debug', message => [
167             ###LogSD "checking stored cache of the key: $format_strings",
168             ###LogSD '..searching in stored keys:', keys %{$self->_get_all_format_cache} ] );
169 50         87 $cache_key = $format_strings; # TODO fix the non-hashkey character issues;
170 50 100       3349 if( $self->_has_cached_format( $cache_key ) ){
171             ###LogSD $phone->talk( level => 'debug', message => [
172             ###LogSD "Format already built - returning stored value for: $cache_key", ] );
173 1         74 return $self->_get_cached_format( $cache_key );
174             }else{
175             ###LogSD $phone->talk( level => 'debug', message => [
176             ###LogSD "Building new format for key: $cache_key", ] );
177             }
178             }
179            
180             # Split into the four sections positive, negative, zero, and text
181 49         147 $format_strings =~ s/General/\@/ig;# Change General to text input
182 49         171 my @format_string_list = split /;/, $format_strings;
183 49 100       205 my $last_is_text = ( $format_string_list[-1] =~ /\@/ ) ? 1 : 0 ;
184             ###LogSD $phone->talk( level => 'debug', message => [
185             ###LogSD "Is the last position text: $last_is_text", ] );
186             # Make sure the full range of number inputs are sent down the right path;
187 49         81 my @used_type_list = @{\@type_list};
  49         211  
188 49 100       329 $used_type_list[0] =
    100          
189             ( scalar( @format_string_list ) - $last_is_text == 1 ) ? Maybe[Num] :
190             ( scalar( @format_string_list ) - $last_is_text == 2 ) ? Maybe[NotNegativeNum] : $type_list[0] ;
191             ###LogSD $phone->talk( level => 'debug', message => [
192             ###LogSD "Now operating on each format string", @format_string_list,
193             ###LogSD '..with used type list:', map{ $_->name } @used_type_list, ] );
194 49         6023 my $format_position = 0;
195 49         85 my @coercion_list;
196             my $action_type;
197 49         83 my $is_date = 0;
198 49         82 my $date_text = 0;
199 49         106 for my $format_string ( @format_string_list ){
200 71         209 $format_string =~ s/_.//g;# no character justification to other rows
201 71         143 $format_string =~ s/\*//g;# Remove the repeat character listing (not supported here)
202             ###LogSD $phone->talk( level => 'debug', message => [
203             ###LogSD "Building format for: $format_string", ] );
204            
205             # Pull out all the straight through stuff
206 71         98 my @deconstructed_list;
207 71         117 my $x = 0;
208             #~ $action_type = undef;
209 71   33     913 while( defined $format_string and my @result = $format_string =~
210             /^( # Collect any formatting stuff first
211             (AM\/PM| # Date 12 hr flag
212             A\/P| # Another date 12 hr flag
213             \[hh?\]| # Elapsed hours
214             \[mm\]| # Elapsed minutes
215             \[ss\]| # Elapsed seconds
216             [dmyhms]+)| # DateTime chunks
217             ([0-9#\?]+[,\-\_]?[#0\?]*,*| # Number string
218             \.| # Split integers from decimals
219             [Ee][+\-]| # Exponential notiation
220             %)| # Percentage
221             (\@) # Text input
222             )?( # Finish collecting format actions
223             (\"[^\"]*\")| # Anything in quotes just passes through
224             (\[[^\]]*\])| # Anything in brackets needs modification
225             [\(\)\$\-\+\/\:\!\^\&\'\~\{\}\<\>\=\s]| # All the pass through characters
226             \,\s # comma space for verbal separation
227             )?(.*)/x ){
228             ###LogSD $phone->talk( level => 'debug', message => [
229             ###LogSD "Now processing: $format_string", '..with result:', @result ] );
230 198         413 my $pre_action = $1;
231 198         308 my $date = $2;
232 198         374 my $number = $3;
233 198         317 my $text = $4;
234 198         329 my $fixed_value = $5;
235 198         413 $format_string = $8;
236 198 100       450 if( $fixed_value ){
237 99 100 100     604 if( $fixed_value =~ /\[\$([^\-\]]*)\-?\d*\]/ ){# removed the localized element of fixed values
    100          
    100          
238 2         5 $fixed_value = $1;
239             }elsif( $fixed_value =~ /\[[^hms]*\]/ ){# Remove all color and conditionals as they will not be used
240 4         9 $fixed_value = undef;
241             }elsif( $fixed_value =~ /\"\-\"/ and $format_string ){# remove decimal justification for zero bars
242             ###LogSD $phone->talk( level => 'trace', message => [
243             ###LogSD "Initial format string: $format_string", ] );
244 2         7 $format_string =~ s/^(\?+)//;
245             ###LogSD $phone->talk( level => 'trace', message => [
246             ###LogSD "updated format string: $format_string", ] );
247             }
248             }
249 198 100       414 if( defined $pre_action ){
250 162 50       425 my $current_action =
    100          
    100          
251             ( $date ) ? 'DATE' :
252             ( defined $number ) ? 'NUMBER' :
253             ( $text ) ? 'TEXT' : 'BAD' ;
254 162 100       374 $is_date = 1 if $date;
255             ###LogSD $phone->talk( level => 'debug', message => [
256             ###LogSD "Current action from -$pre_action- is: $current_action",
257             ###LogSD "..now testing against: " . ($action_type//'') ] );
258 162 100 66     955 if( $action_type and $current_action and ($current_action ne $action_type) ){
      100        
259             ###LogSD $phone->talk( level => 'info', message => [
260             ###LogSD "General action type: $action_type",
261             ###LogSD "is failing current action: $current_action", ] );
262 20         38 my $fail = 1;
263 20 100 66     111 if( $action_type eq 'DATE' ){
    100          
    50          
264 4         35 $conversion_type = 'date';
265             ###LogSD $phone->talk( level => 'info', message => [
266             ###LogSD "Checking the date mishmash", ] );
267 4 100       16 if( $current_action eq 'NUMBER' ){
    50          
268             ###LogSD $phone->talk( level => 'info', message => [
269             ###LogSD "Special case of number following action", ] );
270 2 50 66     28 if( ( $pre_action =~ /^\.$/ and $format_string =~ /^0+/ ) or
      33        
      66        
271             ( $pre_action =~ /^0+$/ and $deconstructed_list[-1]->[0] =~ /^\.$/ ) ){
272 2         4 $current_action = 'DATE';
273 2         4 $fail = 0;
274             }
275             }elsif( $pre_action eq '@' ){
276             ###LogSD $phone->talk( level => 'info', message => [
277             ###LogSD "Excel conversion of pre-epoch datestring pass through highjacked here", ] );
278 2         4 $current_action = 'DATESTRING';
279 2         5 $fail = 0;
280             }
281             }elsif( $action_type eq 'NUMBER' ){
282             ###LogSD $phone->talk( level => 'info', message => [
283             ###LogSD "Checking for possible number field exceptions", ] );
284 4 50       11 if( $current_action eq 'TEXT' ){
285             ###LogSD $phone->talk( level => 'info', message => [
286             ###LogSD "Special case of text following a number", ] );
287 4         6 $fail = 0;
288             }
289             }elsif( $action_type eq 'INTEGER' or $action_type eq 'DECIMAL'){
290             ###LogSD $phone->talk( level => 'info', message => [
291             ###LogSD "Checking for possible sub-Number generalities", ] );
292 12 50       48 if( $current_action eq 'NUMBER' ){
293             ###LogSD $phone->talk( level => 'info', message => [
294             ###LogSD "Integers are numbers", ] );
295 12         24 $fail = 0;
296             }
297             }
298 20 50       54 if( $fail ){
299 0         0 confess "Bad combination of actions in this format string: $format_strings - $action_type - $current_action";
300             }
301             }
302 162 50       422 $action_type = $current_action if $current_action;
303             ###LogSD $phone->talk( level => 'debug', message => [
304             ###LogSD (($pre_action) ? "First action resolved to: $pre_action" : undef),
305             ###LogSD (($fixed_value) ? "Extracted fixed value: $fixed_value" : undef),
306             ###LogSD (($format_string) ? "Remaining string: $format_string" : undef),
307             ###LogSD "With updated deconstruction list:", @deconstructed_list, ] );
308             }else{
309             ###LogSD $phone->talk( level => 'debug', message => [
310             ###LogSD "Early elements unusable - remaining string: $format_string", ] );
311             }
312 198         558 push @deconstructed_list, [ $pre_action, $fixed_value ];
313 198 50       557 if( $x++ == 30 ){
314 0         0 confess "Regex matching failed (with an infinite loop) for excel format string: $format_string";
315             }
316             ###LogSD $phone->talk( level => 'debug', message => [
317             ###LogSD (($pre_action) ? "First action resolved to: $pre_action" : undef),
318             ###LogSD (($fixed_value) ? "Extracted fixed value: $fixed_value" : undef),
319             ###LogSD (($format_string) ? "Remaining string: $format_string" : undef),
320             ###LogSD "With updated deconstruction list:", @deconstructed_list, ] );
321 198 100       1871 last if length( $format_string ) == 0;
322             }
323 71 50       217 push @deconstructed_list, [ $format_string, undef ] if $format_string;
324             ###LogSD $phone->talk( level => 'debug', message => [
325             ###LogSD "List with fixed values separated:", @deconstructed_list ] );
326 71 100       318 my $method = '_build_' . ( $action_type =~ /^(NUMBER|SCIENTIFIC|INTEGER|PERCENT|FRACTION|DECIMAL)$/ ? 'number' : lc($action_type) );
327             ###LogSD $phone->talk( level => 'info', message => [ "Method: $method", ] );
328 71 100 66     400 my $filter = ( $action_type and $action_type eq 'TEXT' ) ? Str : $used_type_list[$format_position++];
329 71 100 66     351 if( $action_type and $action_type eq 'DATESTRING' ){
330 2         13 $date_text = 1;
331 2         10 $filter = Str;
332             }
333            
334             ###LogSD $phone->talk( level => 'debug', message => [
335             ###LogSD "Running method -$method- for list:", @deconstructed_list ] );
336 71         335 ( my $intermediate_action, my @intermediate_coercions ) = $self->$method( $filter, \@deconstructed_list );
337             ###LogSD $phone->talk( level => 'trace', message => [ "Returning from: $method", $intermediate_action, @intermediate_coercions ] );
338 71         192 push @coercion_list, @intermediate_coercions;
339 71 100       519 $action_type = $intermediate_action =~ /^(NUMBER|SCIENTIFIC|INTEGER|PERCENT|FRACTION|DECIMAL|DATE|DATESTRING)$/ ? $intermediate_action : $action_type;
340             ###LogSD $phone->talk( level => 'trace', message => [ "Action type: $action_type", $intermediate_action, @coercion_list ] );
341             }
342 49 100 100     227 if( $is_date and !$date_text ){
343 14         72 ( my $intermediate_action, my @intermediate_coercions ) = $self->_build_datestring( Str, [ [ '@', '' ] ] );
344 14         39 push @coercion_list, @intermediate_coercions;
345 14 50       91 $action_type = $intermediate_action =~ /^(NUMBER|SCIENTIFIC|INTEGER|PERCENT|FRACTION|DECIMAL|DATE|DATESTRING)$/ ? $intermediate_action : $action_type;
346             ###LogSD $phone->talk( level => 'info', message => [ "Adjusted action type: $action_type", ] );
347             }
348             ###LogSD $phone->talk( level => 'debug', message => [
349             ###LogSD 'Length of coersion list: ' . scalar( @coercion_list ),
350             ###LogSD "Action type: $action_type", "Conversion type: $conversion_type", ] );
351             ###LogSD $phone->talk( level => 'trace', message => [
352             ###LogSD ($coercion_name ? "Initial coercion name: $coercion_name" : ''), @coercion_list, ] );
353            
354             # Build the final format
355 49 100       140 $conversion_type = 'text' if $action_type eq 'TEXT';
356 49 50       135 $coercion_name =~ s/__/_${conversion_type}_/ if $coercion_name;
357             ###LogSD $phone->talk( level => 'info', message => [ "Action type: $action_type" ] );
358 49   33     547 my %args = (
359             name => $action_type,
360             display_name => ($coercion_name // ($action_type . '_' . $coercion_index++)),
361             coercion => Type::Coercion->new(
362             type_coercion_map => [ @coercion_list ],
363             ),
364             #~ coerce => 1,
365             );
366 49         8505 my $final_type = Type::Tiny->new( %args );
367             ###LogSD $phone->talk( level => 'trace', message => [
368             ###LogSD "Final type:", $final_type ] );
369            
370             # Save the cache
371 49 50       6851 if( $self->get_cache_behavior ){
372             ###LogSD $phone->talk( level => 'debug', message => [
373             ###LogSD "setting cache for key:", $cache_key ] );
374 49         3302 $self->_set_cashed_format( $cache_key => $final_type );
375             }
376            
377 49         384 return $final_type;
378             }
379            
380              
381             #########1 Private Attributes 3#########4#########5#########6#########7#########8#########9
382            
383             has _format_cash =>(
384             isa => HashRef,
385             traits => ['Hash'],
386             reader => '_get_all_format_cache',
387             handles =>{
388             _has_cached_format => 'exists',
389             _get_cached_format => 'get',
390             _set_cashed_format => 'set',
391             },
392             default => sub{ {} },
393             );
394              
395             #########1 Private Methods 3#########4#########5#########6#########7#########8#########9
396              
397             sub _build_text{
398 6     6   13 my( $self, $type_filter, $list_ref ) = @_;
399             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
400             ###LogSD $self->get_all_space . '::hidden::_build_text', );
401             ###LogSD $phone->talk( level => 'debug', message => [
402             ###LogSD "Building an anonymous sub to process text values" ] );
403 6         8 my $sprintf_string;
404 6         12 my $found_string = 0;
405 6         12 for my $piece ( @$list_ref ){
406             ###LogSD $phone->talk( level => 'debug', message => [
407             ###LogSD "processing text piece:", $piece ] );
408 6 50 33     34 if( !$found_string and defined $piece->[0] ){
409 6         10 $sprintf_string .= '%s';
410 6         13 $found_string = 1;
411             }
412 6 50       19 if( $piece->[1] ){
413 0         0 $sprintf_string .= $piece->[1];
414             }
415             }
416             ###LogSD $phone->talk( level => 'debug', message => [
417             ###LogSD "Final sprintf string: $sprintf_string" ] );
418             my $return_sub = sub{
419             ###LogSD my $sub_phone = $phone;
420             ###LogSD if( length( $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space ) > 0 ){
421             ###LogSD $sub_phone = Log::Shiras::Telephone->new( name_space =>
422             ###LogSD $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space . '::hidden::_return_value_only' . '::_build_text', );
423             ###LogSD }
424             ###LogSD $sub_phone->talk( level => 'debug', message => [
425             ###LogSD "Updated Input: $_[0]" ] );
426 4     4   2535 return sprintf( $sprintf_string, $_[0] );
427 6         26 };
428 6         17 return( 'TEXT', Str, $return_sub );
429             }
430              
431             sub _build_date{
432 16     16   47 my( $self, $type_filter, $list_ref ) = @_;
433             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
434             ###LogSD $self->get_all_space . '::hidden::_build_date', );
435             ###LogSD $phone->talk( level => 'debug', message => [
436             ###LogSD "Building an anonymous sub to process date values", $list_ref ] );
437            
438 16         28 my ( $cldr_string, $format_remainder );
439 16         33 my $is_duration = 0;
440 16         25 my $sub_seconds = 0;
441 16 100       1018 if( !$self->get_date_behavior ){
442             # Process once to build the cldr string
443 15         26 my $prior_duration;
444 15         36 for my $piece ( @$list_ref ){
445             ###LogSD $phone->talk( level => 'debug', message => [
446             ###LogSD "processing date piece:", $piece ] );
447 48 100       124 if( defined $piece->[0] ){
448             ###LogSD $phone->talk( level => 'debug', message =>[
449             ###LogSD "Manageing the cldr part: " . $piece->[0] ] );
450 46 100 100     451 if( $piece->[0] =~ /\[(.+)\]/ ){
    100          
    100          
    100          
    100          
    100          
    100          
    100          
451             ###LogSD $phone->talk( level => 'debug', message =>[ "Possible duration" ] );
452 1         5 (my $initial,) = split //, $1;
453 1         5 my $length = length( $1 );
454 1         4 $is_duration = [ $initial, 0, [ $piece->[1] ], [ $length ] ];
455 1 50       7 if( $is_duration->[0] =~ /[hms]/ ){
456 1         2 $piece->[0] = '';
457 1         2 $piece->[1] = '';
458 1         3 $prior_duration = $is_duration->[0];
459             ###LogSD $phone->talk( level => 'debug', message => [
460             ###LogSD "found a duration piece:", $is_duration,
461             ###LogSD "with prior duration: $prior_duration" ] );
462             }else{
463 0         0 confess "Bad duration element found: $is_duration->[0]";
464             }
465             }elsif( ref( $is_duration ) eq 'ARRAY' ){
466             ###LogSD $phone->talk( level => 'debug', message =>[ "adding to duration", $piece ] );
467 2         7 my $next_duration = $duration_order->{$prior_duration};
468 2 50       34 if( $piece->[0] eq '.' ){
    50          
469 0         0 push @{$is_duration->[2]}, $piece->[0];
  0         0  
470             ###LogSD $phone->talk( level => 'debug', message => [
471             ###LogSD "found a period" ] );
472             }elsif( $piece->[0] =~ /$next_duration/ ){
473 2         4 my $length = length( $piece->[0] );
474 2         5 $is_duration->[1]++;
475 2 100       7 push @{$is_duration->[2]}, $piece->[1] if $piece->[1];
  1         3  
476 2         5 push @{$is_duration->[3]}, $length;
  2         4  
477 2         9 ($prior_duration,) = split //, $piece->[0];
478 2 50       10 if( $piece->[0] =~ /^0+$/ ){
479 0         0 $piece->[0] =~ s/0/S/g;
480 0         0 $sub_seconds = $piece->[0];
481             ###LogSD $phone->talk( level => 'debug', message => [
482             ###LogSD "found a subseconds format piece: $sub_seconds" ] );
483             }
484 2         5 $piece->[0] = '';
485 2         6 $piece->[1] = '';
486             ###LogSD $phone->talk( level => 'debug', message => [
487             ###LogSD "Current duration:", $is_duration,
488             ###LogSD "with prior duration: $prior_duration" ] );
489             }else{
490 0         0 confess "Bad duration element found: $piece->[0]";
491             }
492             }elsif( $piece->[0] =~ /m/ ){
493             ###LogSD $phone->talk( level => 'debug', message =>[ "Minutes or Months" ] );
494 15 100 100     158 if( ($cldr_string and $cldr_string =~ /:'?$/) or ($piece->[1] and $piece->[1] eq ':') ){
      100        
      66        
495             ###LogSD $phone->talk( level => 'debug', message => [
496             ###LogSD "Found minutes - leave them alone" ] );
497             }else{
498 8         38 $piece->[0] =~ s/m/L/g;
499             ###LogSD $phone->talk( level => 'debug', message => [
500             ###LogSD "Converting to cldr stand alone months (m->L)" ] );
501             }
502             }elsif( $piece->[0] =~ /h/ ){
503 5         24 $piece->[0] =~ s/h/H/g;
504             ###LogSD $phone->talk( level => 'debug', message => [
505             ###LogSD "Converting 12 hour clock to 24 hour clock" ] );
506             }elsif( $piece->[0] =~ /AM?\/PM?/i ){
507 2         7 $cldr_string =~ s/H/h/g;
508 2         6 $piece->[0] = 'a';
509             ###LogSD $phone->talk( level => 'debug', message =>[ "Set 12 hour clock and AM/PM" ] );
510             }elsif( $piece->[0] =~ /d{3,5}/ ){
511 1         6 $piece->[0] =~ s/d/E/g;
512             ###LogSD $phone->talk( level => 'debug', message =>[ "Found a weekday request" ] );
513             }elsif( !$sub_seconds and $piece->[0] =~ /[\.]/){#
514 1         4 $piece->[0] = "'.'";
515             #~ $piece->[0] = "':'";
516 1         2 $sub_seconds = 1;
517             ###LogSD $phone->talk( level => 'debug', message =>[ "Starting sub seconds" ] );
518             }elsif( $sub_seconds eq '1' ){
519             ###LogSD $phone->talk( level => 'debug', message =>[ "Formatting sub seconds" ] );
520 1 50       6 if( $piece->[0] =~ /^0+$/ ){
521 1         4 $piece->[0] =~ s/0/S/g;
522 1         3 $sub_seconds = $piece->[0];
523 1         4 $piece->[0] = '';
524             ###LogSD $phone->talk( level => 'debug', message => [
525             ###LogSD "found a subseconds format piece: $sub_seconds" ] );
526             }else{
527 0         0 confess "Bad sub-seconds element after [$cldr_string] found: $piece->[0]";
528             }
529             }
530 46 100 100     184 if( $sub_seconds and $sub_seconds ne '1' ){
531 1         2 $format_remainder .= $piece->[0];
532             }else{
533 45         89 $cldr_string .= $piece->[0];
534             }
535             }
536 48 100       152 if( $piece->[1] ){
537 27 50 33     91 if( $sub_seconds and $sub_seconds ne '1' ){
538 0         0 $format_remainder .= $piece->[1];
539             }else{
540 27         60 $cldr_string .= $piece->[1];
541             }
542             }
543             ###LogSD $phone->talk( level => 'debug', message => [
544             ###LogSD (($cldr_string) ? "Updated CLDR string: $cldr_string" : undef),
545             ###LogSD (($format_remainder) ? "Updated format remainder: $format_remainder" : undef),
546             ###LogSD (($is_duration) ? ('Duration ref:', $is_duration) : undef) ] );
547             }
548             ###LogSD $phone->talk( level => 'debug', message => [
549             ###LogSD "Updated CLDR string: $cldr_string",
550             ###LogSD (($is_duration) ? ('...and duration:', $is_duration) : undef ) ] );
551 15         34 $last_date_cldr = $cldr_string;# This is critical to getting the next string to date conversion right
552 15         23 $last_duration = $is_duration;
553 15         29 $last_sub_seconds = $sub_seconds;
554 15         30 $last_format_rem = $format_remainder;
555             }
556 16 50       971 my @args_list = ( $self->get_epoch_year == 1904 ) ? ( system_type => 'apple_excel' ) : ();
557 16         189 my $converter = DateTimeX::Format::Excel->new( @args_list );
558             ###LogSD $phone->talk( level => 'debug', message => [
559             ###LogSD "Building sub with:", @args_list, "And get_date_behavior set to: " . $self->get_date_behavior ] );
560             my $conversion_sub = sub{
561 102     102   66638 my $num = $_[0];
562 102 100       339 if( !defined $num ){
563 16         59 return undef;
564             }
565             ###LogSD my $sub_phone = $phone;
566             ###LogSD if( length( $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space ) > 0 ){
567             ###LogSD $sub_phone = Log::Shiras::Telephone->new( name_space =>
568             ###LogSD $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space . '::hidden::_return_value_only' . '::_build_date', );
569             ###LogSD }
570             ###LogSD $sub_phone->talk( level => 'debug', message => [
571             ###LogSD "Processing date number: $num",
572             ###LogSD '..with duration:', $is_duration,
573             ###LogSD "..and sub-seconds: $sub_seconds",
574             ###LogSD (($format_remainder) ? "..and format_remainder: $format_remainder" : undef) ] );
575 86         388 my $dt = $converter->parse_datetime( $num );
576 86         66583 my $return_string;
577             my $calc_sub_secs;
578 86 100       220 if( $is_duration ){
579 6         269 my $di = $dt->subtract_datetime_absolute( $converter->_get_epoch_start );
580 6 50       1048 if( $self->get_date_behavior ){
581 0         0 return $di;
582             }
583 6         245 my $sign = DateTime->compare_ignore_floating( $dt, $converter->_get_epoch_start );
584 6 50       267 $return_string = ( $sign == -1 ) ? '-' : '' ;
585 6         13 my $key = $is_duration->[0];
586 6         19 my $delta_seconds = $di->seconds;
587 6         162 my $delta_nanosecs = $di->nanoseconds;
588 6         166 $return_string .= $self->_build_duration( $is_duration, $delta_seconds, $delta_nanosecs );
589             ###LogSD $sub_phone->talk( level => 'debug', message => [
590             ###LogSD "Duration return string: $return_string" ] );
591             }else{
592 80 100       5023 if( $self->get_date_behavior ){
593             ###LogSD $sub_phone->talk( level => 'debug', message => [
594             ###LogSD "Returning the DateTime object rather than the format string" ] );
595 2         8 return $dt;
596             }
597 78 100       214 if( $sub_seconds ){
598 6         20 $calc_sub_secs = $dt->format_cldr( $sub_seconds );
599             ###LogSD $sub_phone->talk( level => 'debug', message => [
600             ###LogSD "Processing sub-seconds: $calc_sub_secs" ] );
601 6 100       1006 if( "0.$calc_sub_secs" >= 0.5 ){
602             ###LogSD $phone->talk( level => 'debug', message => [
603             ###LogSD "Rounding seconds back down" ] );
604 5         18 $dt->subtract( seconds => 1 );
605             }
606             }
607             ###LogSD $sub_phone->talk( level => 'debug', message => [
608             ###LogSD "Converting it with CLDR string: $cldr_string" ] );
609 78         3638 $return_string .= $dt->format_cldr( $cldr_string );
610 78 100 66     23732 if( $sub_seconds and $sub_seconds ne '1' ){
611 6         13 $return_string .= $calc_sub_secs;
612             }
613 78 50       192 $return_string .= $dt->format_cldr( $format_remainder ) if $format_remainder;
614             }
615             ###LogSD $sub_phone->talk( level => 'debug', message => [
616             ###LogSD "returning: $return_string" ] );
617 84         590 return $return_string;
618 16         29940 };
619 16         81 return( 'DATE', $type_filter, $conversion_sub );
620             }
621              
622             sub _build_datestring{
623 16     16   132 my( $self, $type_filter, $list_ref ) = @_;
624 16         29 my $this_date_cldr = $last_date_cldr;# This is critical to getting the string to date conversion right (matching the number to date equivalent)
625 16         22 my $this_duration = $last_duration;
626 16         34 my $this_sub_seconds = $last_sub_seconds;
627 16         23 my $this_format_rem = $last_format_rem;
628             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
629             ###LogSD $self->get_all_space . '::hidden::_build_datestring', );
630             ###LogSD $phone->talk( level => 'debug', message => [
631             ###LogSD "Building an anonymous sub to process date strings", $this_date_cldr ] );
632            
633 16         28 my ( $cldr_string, $format_remainder );
634             my $conversion_sub = sub{
635 23     23   12609 my $date = $_[0];
636 23 50       76 if( !$date ){
637 0         0 return undef;
638             }
639 23         38 my $calc_sub_secs;
640 23 100       148 if( $date =~ /(.*:\d+)\.(\d+)(.*)/ ){
641 14         43 $calc_sub_secs = $2;
642 14         36 $date = $1;
643 14 50       62 $date .= $3 if $3;
644 14         57 $calc_sub_secs .= 0 x (9 - length( $calc_sub_secs ));
645             }
646             ###LogSD my $sub_phone = $phone;
647             ###LogSD if( length( $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space ) > 0 ){
648             ###LogSD $sub_phone = Log::Shiras::Telephone->new( name_space =>
649             ###LogSD $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space . '::hidden::_return_value_only' . '::_build_datestring', );
650             ###LogSD }
651             ###LogSD $sub_phone->talk( level => 'debug', message => [
652             ###LogSD "Processing date string: $date",
653             ###LogSD "..with duration:", $last_duration,
654             ###LogSD "..and sub-seconds: $last_sub_seconds",
655             ###LogSD "..and stripped nanoseconds: $calc_sub_secs" ] );
656 23         34 my ( $dt_us, $dt_eu );
657 23         1932 eval '$dt_us = DateTime::Format::Flexible->parse_datetime( $date )';
658 23         138695 eval '$dt_eu = DateTime::Format::Flexible->parse_datetime( $date, european => 1, )';
659 23 50 66     113936 if( !$dt_us and !$dt_eu ){# handle double digit years in formats unreadable by ~::Flexible
660             ###LogSD $sub_phone->talk( level => 'debug', message => [
661             ###LogSD "Initial DateTime conversion failed - attempting backup work for: $date" ] );
662 1         6 my $current_year = DateTime->now()->truncate( to => 'year' );
663 1         458 my $century_prefix = substr( $current_year, 0, 2 );
664 1         28 my $century_postfix = substr( $current_year, 2, 2 );
665 1 50       24 my $bump_year = ( $century_postfix + 20 > 99 ) ? ( $century_postfix - 80 ) : undef;# The double digit years are probably less than 21 years in the future of the processing time
666 1 50       4 my $drop_year = ( $century_postfix - 79 < 0 ) ? ( $century_postfix + 21 ) : undef;# The double digit years are probably less than 81 years in the past of the processing time
667 1         5 $date =~ /(\d{1,2})\D(\d{1,2})\D(\d{1,2})(\s|T)(\d{1,2})\D(\d{1,2})(\D(\d{1,2}))?/;
668 1 50 33     20 if ( defined $1 and defined $2 and defined $3 ){
      33        
669             ###LogSD $sub_phone->talk( level => 'debug', message => [
670             ###LogSD "Processing date parse for: $date", $1, $2, $3, $4, $5, $6, $7 ] );
671 1         3 my $year = $3;
672 1 50 33     12 $year = (
    50 33        
673             (defined $bump_year and $year <= $bump_year ) ? $century_prefix + 1 :
674             (defined $drop_year and $year >= $drop_year ) ? $century_prefix - 1 : $century_prefix ) . sprintf '%02u', $year;
675 1   50     15 my $us_str = sprintf "%u-%02u-%02uT%02u:%02u:%02u", $year, $1, $2, $5, $6, ($7//'00');
676 1   50     11 my $eu_str = sprintf "%u-%02u-%02uT%02u:%02u:%02u", $year, $2, $1, $5, $6, ($7//'00');
677 1         80 eval '$dt_us = DateTime::Format::Flexible->parse_datetime( $us_str )';
678 1         10084 eval '$dt_eu = DateTime::Format::Flexible->parse_datetime( $eu_str )';# european => 1,
679             }
680             }
681 23 50 66     11725 my $dt =
    100          
682             ( $self->get_european_first and $dt_eu )? $dt_eu :# DD-MM-YY tested instead of MM-DD-YY
683             ( $dt_us ) ? $dt_us : $dt_eu ;
684             ###LogSD $sub_phone->talk( level => 'debug', message => [
685             ###LogSD "Result of the processing of -$date- " . $dt ] );
686 23 50       1010 if( $dt ){
687 23 100       874 $dt->add( nanoseconds => $calc_sub_secs ) if $calc_sub_secs;
688             ###LogSD $sub_phone->talk( level => 'debug', message => [
689             ###LogSD "Date building sucessfull - result to this point: $dt" ] );
690             }else{
691             ###LogSD $sub_phone->talk( level => 'debug', message => [
692             ###LogSD "Unable to convert the string to a date time object: $date" ] );
693 0         0 return $date;
694             }
695 23         9425 my $return_string;
696 23 100       72 if( $this_duration ){
697 1 50       64 my @args_list = ( $self->get_epoch_year == 1904 ) ? ( system_type => 'apple_excel' ) : ();
698 1         13 my $converter = DateTimeX::Format::Excel->new( @args_list );
699 1         1826 my $di = $dt->subtract_datetime_absolute( $converter->_get_epoch_start );
700 1 50       181 if( $self->get_date_behavior ){
701 0         0 return $di;
702             }
703 1         42 my $sign = DateTime->compare_ignore_floating( $dt, $converter->_get_epoch_start );
704 1 50       64 $return_string = ( $sign == -1 ) ? '-' : '' ;
705 1         3 my $key = $this_duration->[0];
706 1         6 my $delta_seconds = $di->seconds;
707 1         42 my $delta_nanosecs = $di->nanoseconds;;
708             ###LogSD $sub_phone->talk( level => 'debug', message => [
709             ###LogSD "Delta seconds: $delta_seconds",
710             ###LogSD (($delta_nanosecs) ? "Delta nanoseconds: $delta_nanosecs" : undef) ] );
711 1         52 $return_string .= $self->_build_duration( $this_duration, $delta_seconds, $delta_nanosecs );
712             ###LogSD $phone->talk( level => 'debug', message => [
713             ###LogSD "Duration return string: $return_string" ] );
714             }else{
715 22 50       1369 if( $self->get_date_behavior ){
716 0         0 return $dt;
717             }
718 22 100       69 if( $this_sub_seconds ){
719 1         7 $calc_sub_secs = $dt->format_cldr( $this_sub_seconds );
720             ###LogSD $sub_phone->talk( level => 'debug', message => [
721             ###LogSD "Processing sub-seconds: $calc_sub_secs" ] );
722 1 50       206 if( "0.$calc_sub_secs" >= 0.5 ){
723             ###LogSD $sub_phone->talk( level => 'debug', message => [
724             ###LogSD "Rounding seconds back down" ] );
725 0         0 $dt->subtract( seconds => 1 );
726             }
727             }
728             ###LogSD $sub_phone->talk( level => 'debug', message => [
729             ###LogSD "Converting it with CLDR string: $this_date_cldr" ] );
730 22         95 $return_string .= $dt->format_cldr( $this_date_cldr );
731 22 100 66     6271 if( $this_sub_seconds and $this_sub_seconds ne '1' ){
732 1         3 $return_string .= $calc_sub_secs;
733             }
734 22 50       74 $return_string .= $dt->format_cldr( $this_format_rem ) if $this_format_rem;
735             ###LogSD $sub_phone->talk( level => 'debug', message => [
736             ###LogSD "returning: $return_string" ] );
737             }
738 23         237 return $return_string;
739 16         123 };
740             ###LogSD $phone->talk( level => 'trace', message => [
741             ###LogSD "returning:", 'DATESTRING', $type_filter, $conversion_sub ] );
742 16         69 return( 'DATESTRING', $type_filter, $conversion_sub );
743             }
744              
745             sub _build_duration{
746 7     7   15 my( $self, $duration_ref, $delta_seconds, $delta_nanosecs ) = @_;
747             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
748             ###LogSD $self->get_all_space . '::hidden::_build_date::_build_duration', );
749             ###LogSD $phone->talk( level => 'debug', message => [
750             ###LogSD 'Building a duration string with duration ref:', $duration_ref,
751             ###LogSD "With delta seconds: $delta_seconds",
752             ###LogSD (($delta_nanosecs) ? "And delta nanoseconds: $delta_nanosecs" : undef) ] );
753 7         11 my $return_string;
754 7         14 my $key = $duration_ref->[0];
755 7         10 my $first = 1;
756 7         19 for my $position ( 0 .. $duration_ref->[1] ){
757 21 50       48 if( $key eq '0' ){
758 0         0 my $length = length( $last_sub_seconds );
759 0         0 $return_string .= '.' . sprintf( "%0.${length}f", $delta_nanosecs/1000000000);
760             ###LogSD $phone->talk( level => 'debug', message => [
761             ###LogSD "Return string with nanoseconds: $return_string", ] );
762             }
763 21 100       49 if( $key eq 's' ){
764 7 50       24 $return_string .= ( $first ) ? $delta_seconds :
765             sprintf "%0$duration_ref->[3]->[$position]d", $delta_seconds;
766 7         9 $first = 0;
767 7         15 $key = $duration_order->{$key};
768             ###LogSD $phone->talk( level => 'debug', message => [
769             ###LogSD "Delta seconds: $delta_seconds",
770             ###LogSD "Next key to process: $key" ] );
771             }
772 21 100       50 if( $key eq 'm' ){
773 7         13 my $minutes = int($delta_seconds/60);
774 7         11 $delta_seconds = $delta_seconds - ($minutes*60);
775 7 50       31 $return_string .= ( $first ) ? $minutes :
776             sprintf "%0$duration_ref->[3]->[$position]d", $minutes;
777 7         10 $first = 0;
778 7         16 $key = $duration_order->{$key};
779             ###LogSD $phone->talk( level => 'debug', message => [
780             ###LogSD "Calculated minutes: $minutes",
781             ###LogSD "Remaining seconds: $delta_seconds",
782             ###LogSD "Next key to process: $key" ] );
783             }
784 21 100       46 if( $key eq 'h' ){
785 7         15 my $hours = int($delta_seconds /(60*60));
786 7         12 $delta_seconds = $delta_seconds - ($hours*60*60);
787 7 50       17 $return_string .= ( $first ) ? $hours :
788             sprintf "%0$duration_ref->[3]->[$position]d", $hours;
789 7         11 $first = 0;
790 7         19 $key = $duration_order->{$key};
791             ###LogSD $phone->talk( level => 'debug', message => [
792             ###LogSD "Calculated hours: $hours",
793             ###LogSD "Remaining seconds: $delta_seconds",
794             ###LogSD "Next key to process: $key" ] );
795             }
796 21 100       67 $return_string .= $duration_ref->[2]->[$position] if $duration_ref->[2]->[$position];
797             }
798 7         71 return $return_string;
799             }
800              
801             sub _build_number{
802 47     47   99 my( $self, $type_filter, $list_ref ) = @_;
803             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
804             ###LogSD $self->get_all_space . '::hidden::_build_number', );
805             ###LogSD $phone->talk( level => 'debug', message => [
806             ###LogSD "Processing a number list to see how it should be converted",
807             ###LogSD 'With type constraint: ' . $type_filter->name,
808             ###LogSD '..using list ref:' , $list_ref ] );
809 47         70 my ( $code_hash_ref, $number_type, );
810            
811             # Resolve zero replacements quickly
812 47 50 66     227 if( $type_filter->name eq 'ZeroOrUndef' and
      66        
813             !$list_ref->[-1]->[0] and $list_ref->[-1]->[1] eq '"-"' ){
814             ###LogSD $phone->talk( level => 'debug', message =>[
815             ###LogSD "Found a zero to bar replacement" ] );
816 4         47 my $return_string;
817 4         11 for my $piece ( @$list_ref ){
818 6         14 $return_string .= $piece->[1];
819             }
820 4         13 $return_string =~ s/"\-"/\-/;
821 4     4   22 return( 'NUMBER', $type_filter, sub{ $return_string } );
  4         39  
822             }
823            
824             # Process once to determine what to do
825 43         358 for my $piece ( @$list_ref ){
826             ###LogSD $phone->talk( level => 'debug', message => [
827             ###LogSD "processing number piece:", $piece ] );
828 133 100       397 if( defined $piece->[0] ){
829 105 100       745 if( my @result = $piece->[0] =~ /^([0-9#\?]+)([,\-\_])?([#0\?]+)?(,+)?$/ ){
    50          
830             ###LogSD $phone->talk( level => 'debug', message => [
831             ###LogSD "Regex yielded result:", @result ] );
832 83 100       414 my $comma = ($2) ? $2 : undef,
    100          
833             my $comma_less = defined( $3) ? "$1$3" : $1;
834 83 100       213 my $comma_group = $3 ? length( $3 ) : 0;
835 83 0 0     194 my $divide_by_thousands = ( $4 ) ? (( $2 and $2 ne ',' ) ? $4 : "$2$4" ) : undef;#eval{ $2 . $4 }
    50          
836 83 100       332 my $divisor = $1 if $1 =~ /^([0-9]+)$/;
837 83         110 my ( $leading_zeros, $trailinq_zeros );
838 83 100       293 if( $comma_less =~ /^[\#\?]*(0+)$/ ){
839 53         110 $leading_zeros = $1;
840             }
841 83 100       243 if( $comma_less =~ /^(0+)[\#\?]*$/ ){
842 25         47 $trailinq_zeros = $1;
843             }
844 83 50       177 $code_hash_ref->{divide_by_thousands} = length( $divide_by_thousands ) if $divide_by_thousands;
845             ###LogSD $phone->talk( level => 'debug', message => [
846             ###LogSD "The comma less string is extracted to: $comma_less",
847             ###LogSD ((defined $comma_group) ? "The separator group length is: $comma_group" : undef),
848             ###LogSD (($comma) ? "The separator character is: $comma" : undef),
849             ###LogSD (($leading_zeros and length( $leading_zeros )) ? ".. w/leading zeros: $leading_zeros" : undef),
850             ###LogSD (($trailinq_zeros and length( $trailinq_zeros )) ? ".. w/trailing zeros: $trailinq_zeros" : undef),
851             ###LogSD (($divisor) ? "..with identified divisor: $divisor" : undef),
852             ###LogSD 'Initial code hash:', $code_hash_ref] );
853 83 100 100     370 if( !$number_type ){
    100 66        
    50          
854 43         69 $number_type = 'INTEGER';
855 43 50 33     122 $code_hash_ref->{integer}->{leading_zeros} = length( $leading_zeros ) if $leading_zeros and length( $leading_zeros );
856 43         169 $code_hash_ref->{integer}->{minimum_length} = length( $comma_less );
857 43 100       112 if( $comma ){
858 27         49 @{$code_hash_ref->{integer}}{ 'group_length', 'comma' } = ( $comma_group, $comma );
  27         201  
859             }
860 43 100       193 if( defined $piece->[1] ){
861 16 100       85 if( $piece->[1] =~ /(\s+)/ ){
    50          
862 10         49 $code_hash_ref->{separator} = $1;
863             }elsif( $piece->[1] eq '/' ){
864 0         0 $number_type = 'FRACTION';
865 0 0 0     0 $code_hash_ref->{numerator}->{leading_zeros} = length( $leading_zeros ) if $leading_zeros and length( $leading_zeros );
866 0         0 delete $code_hash_ref->{integer};
867             }
868             }
869             }elsif( ($number_type eq 'INTEGER') or $number_type eq 'DECIMAL' ){
870 27 100 100     133 if( $piece->[1] and $piece->[1] eq '/'){
871 10         35 $number_type = 'FRACTION';
872             }else{
873 17         25 $number_type = 'DECIMAL';
874 17 100 66     101 $code_hash_ref->{decimal}->{trailing_zeros} = length( $trailinq_zeros ) if $trailinq_zeros and length( $trailinq_zeros );
875 17         71 $code_hash_ref->{decimal}->{max_length} = length( $comma_less );
876             }
877             }elsif( ($number_type eq 'SCIENTIFIC') or $number_type eq 'FRACTION' ){
878 13 100 66     49 $code_hash_ref->{exponent}->{leading_zeros} = length( $leading_zeros ) if $leading_zeros and length( $leading_zeros );
879 13         42 $code_hash_ref->{fraction}->{target_length} = length( $comma_less );
880 13 100       45 if( $divisor ){
881 7         38 $code_hash_ref->{fraction}->{divisor} = $divisor;
882             }
883             }
884             ###LogSD $phone->talk( level => 'trace', message => [
885             ###LogSD "Current number type: $number_type", 'updated settings:', $code_hash_ref] );
886             }elsif( $piece->[0] =~ /^((\.)|([Ee][+\-])|(%))$/ ){
887 22 100       75 if( $2 ){
    100          
888 17         34 $number_type = 'DECIMAL';
889 17         60 $code_hash_ref->{separator} = $1;
890             }elsif( $3 ){
891 3         8 $number_type = 'SCIENTIFIC';
892 3         13 $code_hash_ref->{separator} = $2;
893             }else{
894 2         6 $number_type = 'PERCENT';
895             }
896             ###LogSD $phone->talk( level => 'info', message => [
897             ###LogSD "Number type now: $number_type" ] );
898             }else{
899 0         0 confess "badly formed number format passed: $piece->[0]";
900             }
901             }
902             }
903            
904             # Set negative type
905 43 100       140 if( $type_filter->name eq 'NegativeNum' ){
906 12         89 $code_hash_ref->{negative_type} = 1;
907             }
908            
909 43         249 my $method = '_build_' . lc( $number_type ) . '_sub';
910             ###LogSD $phone->talk( level => 'trace', message => [
911             ###LogSD "Resolved the number type to: $number_type",
912             ###LogSD 'Working with settings:', $code_hash_ref ] );
913 43         175 my $conversion_sub = $self->$method( $type_filter, $list_ref, $code_hash_ref );
914            
915 43         185 return( $number_type, $type_filter, $conversion_sub );
916             }
917              
918             sub _build_integer_sub{
919 14     14   30 my( $self, $type_filter, $list_ref, $conversion_defs ) = @_;
920             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
921             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_integer_sub', );
922             ###LogSD $phone->talk( level => 'debug', message => [
923             ###LogSD "Building an anonymous sub to return integer values",
924             ###LogSD 'With type constraint: ' . $type_filter->name,
925             ###LogSD '..using list ref:' , $list_ref, '..and conversion defs:', $conversion_defs ] );
926            
927 14         17 my $sprintf_string;
928             # Process once to determine what to do
929 14         20 my $found_integer = 0;
930 14         27 for my $piece ( @$list_ref ){
931             ###LogSD $phone->talk( level => 'debug', message => [
932             ###LogSD "processing number piece:", $piece ] );
933 28 100 66     124 if( !$found_integer and defined $piece->[0] ){
934 14         22 $sprintf_string .= '%s';
935 14         16 $found_integer = 1;
936             }
937 28 100       75 if( $piece->[1] ){
938 18         35 $sprintf_string .= $piece->[1];
939             }
940             }
941 14         27 $conversion_defs->{no_decimal} = 1;
942 14         26 $conversion_defs->{sprintf_string} = $sprintf_string;
943             ###LogSD $phone->talk( level => 'debug', message => [
944             ###LogSD "Final sprintf string: $sprintf_string" ] );
945 14         25 my $dispatch_sequence = $number_build_dispatch->{decimal};
946            
947             my $conversion_sub = sub{
948             ###LogSD my $sub_phone = $phone;
949             ###LogSD if( length( $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space ) > 0 ){
950             ###LogSD $sub_phone = Log::Shiras::Telephone->new( name_space =>
951             ###LogSD $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space . '::hidden::_return_value_only' . '::_build_number::_build_integer_sub', );
952             ###LogSD }
953 62     62   11153 my $adjusted_input = $_[0];
954 62 100 66     339 if( !defined $adjusted_input or $adjusted_input eq '' ){
955             ###LogSD $sub_phone->talk( level => 'debug', message => [
956             ###LogSD "Return undef for empty strings" ] );
957 6         20 return undef;
958             }
959 56         816 my $value_definitions = clone( $conversion_defs );
960 56         142 $value_definitions->{initial_value} = $adjusted_input;
961             ###LogSD $sub_phone->talk( level => 'trace', message => [
962             ###LogSD 'Building scientific output with:', $conversion_defs,
963             ###LogSD '..and dispatch sequence:', $dispatch_sequence ] );
964 56         173 my $built_ref = $self->_build_elements( $dispatch_sequence, $value_definitions );
965             ###LogSD $sub_phone->talk( level => 'trace', message => [
966             ###LogSD "Received built ref:", $built_ref ] );
967             my $return .= sprintf(
968             $built_ref->{sprintf_string},
969             $built_ref->{integer}->{value}
970 56         180 );
971 56 100 66     164 $return = $built_ref->{sign} . $return if $built_ref->{sign} and $return;
972 56         281 return $return;
973 14         67 };
974             ###LogSD $phone->talk( level => 'debug', message => [
975             ###LogSD "Conversion sub for filter name: " . $type_filter->name, $conversion_sub ] );
976            
977 14         31 return $conversion_sub;
978             }
979              
980             sub _build_decimal_sub{
981 14     14   37 my( $self, $type_filter, $list_ref, $conversion_defs ) = @_;
982             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
983             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_decimal_sub', );
984             ###LogSD $phone->talk( level => 'debug', message => [
985             ###LogSD "Building an anonymous sub to return decimal values",
986             ###LogSD 'With type constraint: ' . $type_filter->name,
987             ###LogSD '..using list ref:' , $list_ref, '..and code hash ref:', $conversion_defs ] );
988            
989 14         18 my $sprintf_string;
990             # Process once to determine what to do
991 14         32 for my $piece ( @$list_ref ){
992             ###LogSD $phone->talk( level => 'debug', message => [
993             ###LogSD "processing number piece:", $piece ] );
994 56 100       127 if( defined $piece->[0] ){
995 42 100       119 if( $piece->[0] eq '.' ){
996 14         26 $sprintf_string .= '.';
997             }else{
998 28         39 $sprintf_string .= '%s';
999             }
1000             }
1001 56 100       142 if( $piece->[1] ){
1002 18         68 $sprintf_string .= $piece->[1];
1003             }
1004             }
1005 14         35 $conversion_defs->{sprintf_string} = $sprintf_string;
1006             ###LogSD $phone->talk( level => 'debug', message => [
1007             ###LogSD "Final sprintf string: $sprintf_string" ] );
1008 14         121 my $dispatch_sequence = $number_build_dispatch->{decimal};
1009            
1010             my $conversion_sub = sub{
1011             ###LogSD my $sub_phone = $phone;
1012             ###LogSD if( length( $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space ) > 0 ){
1013             ###LogSD $sub_phone = Log::Shiras::Telephone->new( name_space =>
1014             ###LogSD $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space . '::hidden::_return_value_only' . '::_build_number::_build_decimal_sub', );
1015             ###LogSD }
1016 62     62   11127 my $adjusted_input = $_[0];
1017 62 100 66     337 if( !defined $adjusted_input or $adjusted_input eq '' ){
1018             ###LogSD $phone->talk( level => 'debug', message => [
1019             ###LogSD "Return undef for empty strings" ] );
1020 6         20 return undef;
1021             }
1022 56         980 my $value_definitions = clone( $conversion_defs );
1023 56         150 $value_definitions->{initial_value} = $adjusted_input;
1024             ###LogSD $sub_phone->talk( level => 'trace', message => [
1025             ###LogSD 'Building scientific output with:', $conversion_defs,
1026             ###LogSD '..and dispatch sequence:', $dispatch_sequence ] );
1027 56         151 my $built_ref = $self->_build_elements( $dispatch_sequence, $value_definitions );
1028             ###LogSD $sub_phone->talk( level => 'trace', message => [
1029             ###LogSD "Received built ref:", $built_ref ] );
1030             my $return .= sprintf(
1031             $built_ref->{sprintf_string},
1032             $built_ref->{integer}->{value},
1033             $built_ref->{decimal}->{value},
1034 56         213 );
1035 56 100 66     192 $return = $built_ref->{sign} . $return if $built_ref->{sign} and $return;
1036 56         313 return $return;
1037 14         82 };
1038             ###LogSD $phone->talk( level => 'debug', message => [
1039             ###LogSD "Conversion sub for filter name: " . $type_filter->name, $conversion_sub ] );
1040            
1041 14         37 return $conversion_sub;
1042             }
1043              
1044             sub _build_percent_sub{
1045 2     2   4 my( $self, $type_filter, $list_ref, $conversion_defs ) = @_;
1046             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1047             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_percent_sub', );
1048             ###LogSD $phone->talk( level => 'debug', message => [
1049             ###LogSD "Building an anonymous sub to return decimal values",
1050             ###LogSD 'With type constraint: ' . $type_filter->name,
1051             ###LogSD '..using list ref:' , $list_ref, '..and code hash ref:', $conversion_defs ] );
1052            
1053 2         4 my $sprintf_string;
1054 2         3 my $decimal_count = 0;
1055             # Process once to determine what to do
1056 2         5 for my $piece ( @$list_ref ){
1057             ###LogSD $phone->talk( level => 'debug', message => [
1058             ###LogSD "processing number piece:", $piece ] );
1059 6 50       15 if( defined $piece->[0] ){
1060 6 100       19 if( $piece->[0] eq '%' ){
    100          
1061 2         3 $sprintf_string .= '%%';
1062             }elsif( $piece->[0] eq '.' ){
1063 1         3 $sprintf_string .= '.';
1064             }else{
1065 3         6 $sprintf_string .= '%s';
1066 3         5 $decimal_count++;
1067             }
1068             }
1069 6 50       18 if( $piece->[1] ){
1070 0         0 $sprintf_string .= $piece->[1];
1071             }
1072             }
1073 2 100       7 $conversion_defs->{no_decimal} = 1 if $decimal_count < 2;
1074 2         5 $conversion_defs->{sprintf_string} = $sprintf_string;
1075             ###LogSD $phone->talk( level => 'debug', message => [
1076             ###LogSD "Final sprintf string: $sprintf_string" ] );
1077 2         6 my $dispatch_sequence = $number_build_dispatch->{percent};
1078            
1079             my $conversion_sub = sub{
1080             ###LogSD my $sub_phone = $phone;
1081             ###LogSD if( length( $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space ) > 0 ){
1082             ###LogSD $sub_phone = Log::Shiras::Telephone->new( name_space =>
1083             ###LogSD $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space . '::hidden::_return_value_only' . '::_build_number::_build_percent_sub', );
1084             ###LogSD }
1085 16     16   8964 my $adjusted_input = $_[0];
1086 16 100 66     95 if( !defined $adjusted_input or $adjusted_input eq '' ){
1087             ###LogSD $sub_phone->talk( level => 'debug', message => [
1088             ###LogSD "Return undef for empty strings" ] );
1089 2         7 return undef;
1090             }
1091 14         206 my $value_definitions = clone( $conversion_defs );
1092 14         38 $value_definitions->{initial_value} = $adjusted_input;
1093             ###LogSD $sub_phone->talk( level => 'trace', message => [
1094             ###LogSD 'Building scientific output with:', $conversion_defs,
1095             ###LogSD '..and dispatch sequence:', $dispatch_sequence ] );
1096 14         41 my $built_ref = $self->_build_elements( $dispatch_sequence, $value_definitions );
1097             ###LogSD $sub_phone->talk( level => 'trace', message => [
1098             ###LogSD "Received built ref:", $built_ref ] );
1099 14         21 my $return;
1100 14 100       30 if( $decimal_count < 2 ){
1101             $return .= sprintf(
1102             $built_ref->{sprintf_string},
1103             $built_ref->{integer}->{value},
1104 7         32 );
1105             }else{
1106             $return .= sprintf(
1107             $built_ref->{sprintf_string},
1108             $built_ref->{integer}->{value},
1109             $built_ref->{decimal}->{value},
1110 7         30 );
1111             }
1112 14 100 66     47 $return = $built_ref->{sign} . $return if $built_ref->{sign} and $return;
1113 14         77 return $return;
1114 2         13 };
1115             ###LogSD $phone->talk( level => 'debug', message => [
1116             ###LogSD "Conversion sub for filter name: " . $type_filter->name, $conversion_sub ] );
1117            
1118 2         5 return $conversion_sub;
1119             }
1120              
1121             sub _build_scientific_sub{
1122 3     3   10 my( $self, $type_filter, $list_ref, $conversion_defs ) = @_;
1123             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1124             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_scientific_sub', );
1125             ###LogSD $phone->talk( level => 'debug', message => [
1126             ###LogSD "Building an anonymous sub to return scientific values",
1127             ###LogSD 'With type constraint: ' . $type_filter->name,
1128             ###LogSD '..using list ref:' , $list_ref, '..and code hash ref:', $conversion_defs ] );
1129            
1130             # Process once to determine what to do
1131 3         6 my ( $sprintf_string, $exponent_sprintf );
1132 3 100       14 $conversion_defs->{no_decimal} = ( exists $conversion_defs->{decimal} ) ? 0 : 1 ;
1133 3         10 for my $piece ( @$list_ref ){
1134             ###LogSD $phone->talk( level => 'debug', message => [
1135             ###LogSD "processing number piece:", $piece ] );
1136 13 50       109 if( defined $piece->[0] ){
1137 13 100       67 if( $piece->[0] =~ /(E)(.)/ ){
    100          
    100          
1138 3         9 $sprintf_string .= $1;
1139 3         8 $exponent_sprintf = '%';
1140 3 50       15 $exponent_sprintf .= '+' if $2 eq '+';
1141 3 100       16 if( exists $conversion_defs->{exponent}->{leading_zeros} ){
1142 1         6 $exponent_sprintf .= '0.' . $conversion_defs->{exponent}->{leading_zeros};
1143             }
1144 3         6 $exponent_sprintf .= 'd';
1145             }elsif( $piece->[0] eq '.' ){
1146 2         5 $sprintf_string .= '.';
1147 2         6 $conversion_defs->{no_decimal} = 0;
1148             }elsif( $exponent_sprintf ){
1149 3         7 $sprintf_string .= $exponent_sprintf;
1150             }else{
1151 5         13 $sprintf_string .= '%s';
1152             }
1153             }
1154 13 50       43 if( $piece->[1] ){
1155 0         0 $sprintf_string .= $piece->[1];
1156             }
1157             }
1158 3         12 $conversion_defs->{sprintf_string} = $sprintf_string;
1159             ###LogSD $phone->talk( level => 'debug', message => [
1160             ###LogSD "Final sprintf string: $sprintf_string" ] );
1161 3         9 my $dispatch_sequence = $number_build_dispatch->{scientific};
1162            
1163             my $conversion_sub = sub{
1164 27     27   15814 my $adjusted_input = $_[0];
1165 27 100 66     257 if( !defined $adjusted_input or $adjusted_input eq '' ){
    50 0        
      0        
      0        
      33        
1166             ###LogSD $phone->talk( level => 'debug', message => [
1167             ###LogSD "Return undef for empty strings" ] );
1168 3         10 return undef;
1169             }elsif( $adjusted_input =~ /^\-?\d*(\.\d+)?$/ or
1170             ( $adjusted_input =~ /^(\-)?((\d{1,3})?(\.\d+)?)[Ee](\-)?(\d+)$/ and $2 and $6 and $6 < 309 ) ){# Check for non-scientific numbers passed to scientific format
1171             ###LogSD $phone->talk( level => 'trace', message => [
1172             ###LogSD "Passed the first scientific format test with: $adjusted_input" ] );
1173 24         530 my $value_definitions = clone( $conversion_defs );
1174 24         82 $value_definitions->{initial_value} = $adjusted_input;
1175            
1176             ###LogSD $phone->talk( level => 'trace', message => [
1177             ###LogSD 'Building scientific output with:', $conversion_defs,
1178             ###LogSD '..and dispatch sequence:', $dispatch_sequence ] );
1179 24         70 my $built_ref = $self->_build_elements( $dispatch_sequence, $value_definitions );
1180             ###LogSD $phone->talk( level => 'trace', message => [
1181             ###LogSD "Received built ref:", $built_ref ] );
1182 24         28 my $return;
1183 24 100       57 if( $built_ref->{no_decimal} ){
1184             $return .= sprintf(
1185             $built_ref->{sprintf_string},
1186             $built_ref->{integer}->{value},
1187             $built_ref->{exponent}->{value}
1188 8         35 );
1189             }else{
1190             $return .= sprintf(
1191             $built_ref->{sprintf_string},
1192             $built_ref->{integer}->{value},
1193             $built_ref->{decimal}->{value} ,
1194             $built_ref->{exponent}->{value}
1195 16         63 );
1196             }
1197 24 100 66     104 $return = $built_ref->{sign} . $return if $built_ref->{sign} and $return;
1198 24         155 return $return;
1199             }else{
1200             ###LogSD $phone->talk( level => 'trace', message => [
1201             ###LogSD "Doesn't really seem like this is a scientific number recognized by excel: $adjusted_input" ] );
1202 0         0 return $adjusted_input;
1203             }
1204 3         25 };
1205             ###LogSD $phone->talk( level => 'debug', message => [
1206             ###LogSD "Conversion sub for filter name: " . $type_filter->name, $conversion_sub ] );
1207            
1208 3         10 return $conversion_sub;
1209             }
1210              
1211             sub _build_fraction_sub{
1212 10     10   26 my( $self, $type_filter, $list_ref, $conversion_defs ) = @_;
1213             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1214             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_fraction_sub', );
1215             ###LogSD $phone->talk( level => 'debug', message => [
1216             ###LogSD "Building an anonymous sub to return integer and fraction strings",
1217             ###LogSD 'With type constraint: ' . $type_filter->name,
1218             ###LogSD '..using list ref:' , $list_ref, '..and code hash ref:', $conversion_defs ] );
1219            
1220             # I'm worried about pulling the sprintf parser out of here and I may need to put it back sometime
1221            
1222 10         23 my $dispatch_sequence = $number_build_dispatch->{fraction};
1223             my $conversion_sub = sub{
1224             ###LogSD my $sub_phone = $phone;
1225             ###LogSD if( length( $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space ) > 0 ){
1226             ###LogSD $sub_phone = Log::Shiras::Telephone->new( name_space =>
1227             ###LogSD $Spreadsheet::XLSX::Reader::LibXML::Cell::all_space . '::hidden::_return_value_only' . '::_build_number::_build_fraction_sub', );
1228             ###LogSD }
1229 240     240   151780 my $adjusted_input = $_[0];
1230 240 100 66     1350 if( !defined $adjusted_input or $adjusted_input eq '' ){
1231             ###LogSD $sub_phone->talk( level => 'debug', message => [
1232             ###LogSD "Return undef for empty strings" ] );
1233 10         35 return undef;
1234             }
1235 230         3577 my $value_definitions = clone( $conversion_defs );
1236 230         675 $value_definitions->{initial_value} = $adjusted_input;
1237             ###LogSD $sub_phone->talk( level => 'trace', message => [
1238             ###LogSD 'Building scientific output with:', $conversion_defs,
1239             ###LogSD '..and dispatch sequence:', $dispatch_sequence ] );
1240 230         726 my $built_ref = $self->_build_elements( $dispatch_sequence, $value_definitions );
1241             ###LogSD $sub_phone->talk( level => 'trace', message => [
1242             ###LogSD "Received built ref:", $built_ref ] );
1243 230         284 my $return;
1244 230 100       581 if( $built_ref->{integer}->{value} ){
1245 149         426 $return = sprintf( '%s', $built_ref->{integer}->{value} );
1246 149 100       355 if( $built_ref->{fraction}->{value} ){
1247 117         172 $return .= ' ';
1248             }
1249             }
1250 230 100       522 if( $built_ref->{fraction}->{value} ){
1251 166         282 $return .= $built_ref->{fraction}->{value};
1252             }
1253 230 50 66     551 if( !$return and $built_ref->{initial_value} ){
1254 32         54 $return = 0;
1255             }
1256 230 100 100     976 $return = $built_ref->{sign} . $return if $built_ref->{sign} and $return;
1257 230         1344 return $return;
1258 10         57 };
1259             ###LogSD $phone->talk( level => 'debug', message => [
1260             ###LogSD "Conversion sub for filter name: " . $type_filter->name, $conversion_sub ] );
1261            
1262 10         25 return $conversion_sub;
1263             }
1264              
1265             sub _build_elements{
1266 380     380   658 my( $self, $dispatch_ref, $value_definitions, ) = @_;
1267             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1268             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements', );
1269             ###LogSD $phone->talk( level => 'debug', message => [
1270             ###LogSD 'Reached the dispatcher for number building with:', $value_definitions,
1271             ###LogSD '..using dispatch list', $dispatch_ref ] );
1272 380         755 for my $method ( @$dispatch_ref ){
1273 1694         4334 $value_definitions = $self->$method( $value_definitions );
1274             ###LogSD $phone->talk( level => 'debug', message => [
1275             ###LogSD 'Updated value definitions:', $value_definitions, ] );
1276             }
1277 380         710 return $value_definitions;
1278             }
1279              
1280             sub _convert_negative{
1281 380     380   532 my( $self, $value_definitions, ) = @_;
1282             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1283             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_convert_negative', );
1284             ###LogSD $phone->talk( level => 'debug', message => [
1285             ###LogSD 'Reached _convert_negative with:', $value_definitions, ] );
1286            
1287 380 100 66     1264 if( $value_definitions->{negative_type} and $value_definitions->{initial_value} < 0 ){
1288 36         82 $value_definitions->{initial_value} = $value_definitions->{initial_value} * -1;
1289             }
1290             ###LogSD $phone->talk( level => 'debug', message => [
1291             ###LogSD 'updated value definitions:', $value_definitions, ] );
1292 380         880 return $value_definitions;
1293             }
1294              
1295             sub _divide_by_thousands{
1296 112     112   170 my( $self, $value_definitions, ) = @_;
1297             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1298             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_divide_by_thousands', );
1299             ###LogSD $phone->talk( level => 'debug', message => [
1300             ###LogSD 'Reached _convert_to_percent with:', $value_definitions, ] );
1301 112 50 33     427 if( $value_definitions->{initial_value} and
1302             $value_definitions->{divide_by_thousands} ){
1303             $value_definitions->{initial_value} =
1304             $value_definitions->{initial_value}/
1305 0         0 ( 1000**$value_definitions->{divide_by_thousands} );
1306             }
1307             ###LogSD $phone->talk( level => 'debug', message => [
1308             ###LogSD 'updated value definitions:', $value_definitions, ] );
1309 112         226 return $value_definitions;
1310             }
1311              
1312             sub _convert_to_percent{
1313 14     14   20 my( $self, $value_definitions, ) = @_;
1314             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1315             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_convert_to_percent', );
1316             ###LogSD $phone->talk( level => 'debug', message => [
1317             ###LogSD 'Reached _convert_to_percent with:', $value_definitions, ] );
1318            
1319 14         45 $value_definitions->{initial_value} = $value_definitions->{initial_value} * 100;
1320             ###LogSD $phone->talk( level => 'debug', message => [
1321             ###LogSD 'updated value definitions:', $value_definitions, ] );
1322 14         29 return $value_definitions;
1323             }
1324              
1325             sub _split_decimal_integer{
1326 380     380   544 my( $self, $value_definitions, ) = @_;
1327             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1328             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_split_decimal_integer', );
1329             ###LogSD $phone->talk( level => 'debug', message => [
1330             ###LogSD 'Reached _split_decimal_integer with:', $value_definitions, ] );
1331            
1332             # Extract negative sign
1333 380 100       1505 if( $value_definitions->{initial_value} < 0 ){
1334 136         266 $value_definitions->{sign} = '-';
1335 136         339 $value_definitions->{initial_value} = $value_definitions->{initial_value} * -1;
1336             }
1337            
1338             # Build the integer
1339 380         883 $value_definitions->{integer}->{value} = int( $value_definitions->{initial_value} );
1340            
1341             # Build the decimal
1342 380         1157 $value_definitions->{decimal}->{value} = $value_definitions->{initial_value} - $value_definitions->{integer}->{value};
1343             ###LogSD $phone->talk( level => 'debug', message =>[ 'Updated ref: ', $value_definitions ] );
1344 380         845 return $value_definitions;
1345             }
1346              
1347             sub _move_decimal_point{
1348 24     24   48 my( $self, $value_definitions, ) = @_;
1349             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1350             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_move_decimal_point', );
1351             ###LogSD $phone->talk( level => 'debug', message => [
1352             ###LogSD 'Reached _move_decimal_point with:', $value_definitions, ] );
1353 24         31 my ( $exponent, $stopped );
1354 24 100 66     205 if(defined $value_definitions->{integer}->{value} and
    50          
1355             sprintf( '%.0f', $value_definitions->{integer}->{value} ) =~ /([1-9])/ ){
1356 18         54 $stopped = $+[0];
1357             ###LogSD $phone->talk( level => 'debug', message =>[ "Matched integer value at: $stopped", ] );
1358 18         58 $exponent = length( sprintf( '%.0f', $value_definitions->{integer}->{value} ) ) - $stopped;
1359             }elsif( $value_definitions->{decimal}->{value} ){
1360 6 50       68 if( $value_definitions->{decimal}->{value} =~ /E(-?\d+)$/i ){
    0          
1361 6         17 $exponent = $1 * 1;
1362             }elsif( $value_definitions->{decimal}->{value} =~ /([1-9])/ ){
1363 0         0 $exponent = $+[0] * -1;
1364 0         0 $exponent += 2;
1365             ###LogSD $phone->talk( level => 'debug', message =>[ "Matched decimal value at: $exponent", ] );
1366             }
1367             }else{
1368 0         0 $exponent = 0;
1369             }
1370             ###LogSD $phone->talk( level => 'debug', message =>[ "Initial exponent: $exponent", ] );
1371 24         48 my $exponent_remainder = $exponent % $value_definitions->{integer}->{minimum_length};
1372             ###LogSD $phone->talk( level => 'debug', message =>[ "Exponent remainder: $exponent_remainder", ] );
1373 24         32 $exponent -= $exponent_remainder;
1374             ###LogSD $phone->talk( level => 'debug', message =>[ "New exponent: $exponent", ] );
1375 24         55 $value_definitions->{exponent}->{value} = $exponent;
1376 24 100       76 if( $exponent < 0 ){
    100          
1377 6         20 my $adjustment = '1' . (0 x abs($exponent));
1378             ###LogSD $phone->talk( level => 'info', message => [
1379             ###LogSD "The exponent |$exponent| is less than zero - the decimal must move to the right by: $adjustment" ] );
1380 6         18 my $new_integer = $value_definitions->{integer}->{value} * $adjustment;
1381 6         12 my $new_decimal = $value_definitions->{decimal}->{value} * $adjustment;
1382 6         13 my $decimal_int = int( $new_decimal );
1383             ###LogSD $phone->talk( level => 'info', message => [
1384             ###LogSD "Bumped integer: $new_integer", "Bumped decimal: $new_decimal", "Decimal integer: $decimal_int" ] );
1385 6         9 $value_definitions->{integer}->{value} = $new_integer + $decimal_int;
1386 6         15 $value_definitions->{decimal}->{value} = $new_decimal - $decimal_int;
1387             }elsif( $exponent > 0 ){
1388 11         32 my $adjustment = '1' . (0 x $exponent);
1389             ###LogSD $phone->talk( level => 'info', message => [
1390             ###LogSD "The exponent -$exponent- is greater than zero - the decimal must move to the left" ] );
1391 11         26 my $new_integer = $value_definitions->{integer}->{value} / $adjustment;
1392 11         21 my $new_decimal = $value_definitions->{decimal}->{value} / $adjustment;
1393 11         21 my $integer_int = int( $new_integer );
1394 11         18 $value_definitions->{integer}->{value} = $integer_int;
1395 11         29 $value_definitions->{decimal}->{value} = $new_decimal + ($new_integer - $integer_int);
1396             }
1397            
1398             ###LogSD $phone->talk( level => 'debug', message => [
1399             ###LogSD 'Updated ref:', $value_definitions ] );
1400 24         57 return $value_definitions;
1401             }
1402              
1403             sub _round_decimal{
1404 150     150   230 my( $self, $value_definitions, ) = @_;
1405             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1406             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_round_decimal', );
1407             ###LogSD $phone->talk( level => 'debug', message => [
1408             ###LogSD 'Reached _round_decimal with:', $value_definitions, ] );
1409 150 100       466 if( $value_definitions->{no_decimal} ){
    50          
1410 71 100       199 if( $value_definitions->{decimal}->{value} > 0.4998 ){# Err on the side of fixing precision up
1411             ###LogSD $phone->talk( level => 'info', message => [
1412             ###LogSD 'Rouding the integer -' . $value_definitions->{integer}->{value} .
1413             ###LogSD "- for the no-decimal condition with decimal: $value_definitions->{decimal}->{value}", ] );
1414 17         33 $value_definitions->{integer}->{value}++;
1415             }
1416 71         160 delete $value_definitions->{decimal};
1417             }elsif( $value_definitions->{decimal}->{max_length} ){
1418             ###LogSD $phone->talk( level => 'info', message => [
1419             ###LogSD "Enforcing decimal max length: " . $value_definitions->{decimal}->{max_length} ] );
1420 79 100       200 if( $value_definitions->{decimal}->{value} ){
1421 35         112 my $adder = '0.' . (0 x $value_definitions->{decimal}->{max_length}) . '00002';
1422 35         90 my $sprintf_string = '%.' . $value_definitions->{decimal}->{max_length} . 'f';
1423 35         348 my $round_decimal = sprintf( $sprintf_string, ($value_definitions->{decimal}->{value}+$adder) );
1424             ###LogSD $phone->talk( level => 'info', message => [
1425             ###LogSD "Sprintf string: $sprintf_string", "Rounded decimal: $round_decimal", "Adder: $adder",] );
1426 35 50       112 if( $round_decimal >= 1 ){
1427 0         0 $value_definitions->{integer}->{value}++;
1428 0         0 $round_decimal -= 1;
1429             ###LogSD $phone->talk( level => 'info', message => [
1430             ###LogSD "New integer: " . $value_definitions->{integer}->{value}, "New decimal: $round_decimal" ] );
1431             }
1432 35         98 my $decimal_multiply = '1' . (0 x $value_definitions->{decimal}->{max_length});
1433 35         57 my $string_sprintf = '%0' . $value_definitions->{decimal}->{max_length} . 's';
1434 35         227 $value_definitions->{decimal}->{value} = sprintf( $string_sprintf, ($round_decimal * $decimal_multiply) );
1435             }
1436            
1437 79 100       207 if( !$value_definitions->{decimal}->{value} ){
1438 45         130 $value_definitions->{decimal}->{value} = 0 x $value_definitions->{decimal}->{max_length};
1439             }
1440             }
1441            
1442             ###LogSD $phone->talk( level => 'debug', message => [
1443             ###LogSD 'Updated ref:', $value_definitions ] );
1444 150         307 return $value_definitions;
1445             }
1446              
1447             sub _add_commas{
1448 380     380   560 my( $self, $value_definitions, ) = @_;
1449             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1450             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_add_commas', );
1451             ###LogSD $phone->talk( level => 'debug', message => [
1452             ###LogSD 'Reached _add_commas with:', $value_definitions, ] );
1453 380 100       953 if( exists $value_definitions->{integer}->{comma} ){
1454             $value_definitions->{integer}->{value} = $self->_add_integer_separator(
1455             sprintf( '%.0f', $value_definitions->{integer}->{value} ),
1456             $value_definitions->{integer}->{comma},
1457             $value_definitions->{integer}->{group_length},
1458 106         535 );
1459             }
1460            
1461             ###LogSD $phone->talk( level => 'debug', message => [
1462             ###LogSD 'Updated ref:', $value_definitions ] );
1463 380         909 return $value_definitions;
1464             }
1465              
1466             sub _pad_exponent{
1467 24     24   33 my( $self, $value_definitions, ) = @_;
1468             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1469             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_pad_exponent', );
1470             ###LogSD $phone->talk( level => 'debug', message => [
1471             ###LogSD 'Reached _pad_exponent with:', $value_definitions, ] );
1472 24 100       68 if( $value_definitions->{exponent}->{leading_zeros} ){
1473 8         15 my $pad_string = '%0' . $value_definitions->{exponent}->{leading_zeros} . 's';
1474             $value_definitions->{exponent}->{value} =
1475 8         31 sprintf( $pad_string, sprintf( '%.0f', $value_definitions->{exponent}->{value} ) );
1476             }
1477             ###LogSD $phone->talk( level => 'debug', message => [
1478             ###LogSD 'Updated ref:', $value_definitions ] );
1479 24         56 return $value_definitions;
1480             }
1481              
1482             sub _build_fraction{
1483 230     230   343 my( $self, $value_definitions, ) = @_;
1484             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1485             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_build_fraction', );
1486             ###LogSD $phone->talk( level => 'debug', message => [
1487             ###LogSD 'Reached _build_fraction with:', $value_definitions, ] );
1488 230 50       601 if( $value_definitions->{decimal}->{value} ){
1489             $value_definitions->{fraction}->{value} =
1490             ( $value_definitions->{fraction}->{divisor} ) ?
1491             $self->_build_divisor_fraction(
1492             $value_definitions->{fraction}->{divisor}, $value_definitions->{decimal}->{value}
1493             ) :
1494             $self->_continued_fraction(
1495             $value_definitions->{decimal}->{value}, 20, $value_definitions->{fraction}->{target_length},
1496 230 100       881 );
1497             }
1498 230         565 delete $value_definitions->{decimal};
1499 230   100     586 $value_definitions->{fraction}->{value} //= 0;
1500 230 100       675 if( $value_definitions->{fraction}->{value} eq '1' ){
1501 23         44 $value_definitions->{integer}->{value}++;
1502 23         42 $value_definitions->{fraction}->{value} = 0;
1503             }
1504             ###LogSD $phone->talk( level => 'debug', message => [
1505             ###LogSD 'Updated ref:', $value_definitions ] );
1506 230         519 return $value_definitions;
1507             }
1508              
1509             sub _build_divisor_fraction{
1510 138     138   239 my( $self, $divisor, $decimal ) = @_;
1511             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1512             ###LogSD $self->get_all_space . '::hidden::_build_number::_build_elements::_build_divisor_fraction', );
1513             ###LogSD $phone->talk( level => 'debug', message => [
1514             ###LogSD 'Reached _build_divisor_fraction with:', $divisor, $decimal ] );
1515 138         317 my $low_numerator = int( $divisor * $decimal );
1516 138         197 my $high_numerator = $low_numerator + 1;
1517 138         236 my $low_delta = $decimal - ($low_numerator / $divisor);
1518 138         214 my $high_delta = ($high_numerator / $divisor) - $decimal;
1519 138         165 my $return;
1520 138         178 my $add_denominator = 0;
1521 138 100       279 if( $low_delta < $high_delta ){
1522 77         104 $return = $low_numerator;
1523 77 100       182 $add_denominator = 1 if $return;
1524             }else{
1525 61         85 $return = $high_numerator;
1526 61 100       112 if( $high_numerator == $divisor ){
1527 17         29 $return = 1;
1528             }else{
1529 44         70 $add_denominator = 1;
1530             }
1531             }
1532 138 100       359 $return .= "/$divisor" if $add_denominator;
1533             ###LogSD $phone->talk( level => 'debug', message => [
1534             ###LogSD "Final fraction: $return" ] );
1535 138         429 return $return;
1536             }
1537              
1538             sub _add_integer_separator{
1539 106     106   207 my ( $self, $int, $comma, $frequency ) = @_;
1540             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1541             ###LogSD $self->get_all_space . '::hidden::_util_function::_add_integer_separator', );
1542             ###LogSD $phone->talk( level => 'info', message => [
1543             ###LogSD "Attempting to add the separator -$comma- to " .
1544             ###LogSD "the integer portion of: $int" ] );
1545 106   50     233 $comma //= ',';
1546 106         121 my @number_segments;
1547 106 50       293 if( is_Int( $int ) ){
1548 106         1324 while( $int =~ /(-?\d+)(\d{$frequency})$/ ){
1549 72         151 $int= $1;
1550 72         390 unshift @number_segments, $2;
1551             }
1552 106         203 unshift @number_segments, $int;
1553             ###LogSD $phone->talk( level => 'info', message => [
1554             ###LogSD 'Final parsed list:', @number_segments ] );
1555 106         427 return join( $comma, @number_segments );
1556             }else{
1557             ###LogSD $phone->talk( level => 'warn', message => [
1558             ###LogSD "-$int- is not an integer!" ] );
1559 0         0 return undef;
1560             }
1561             }
1562              
1563             sub _continued_fraction{# http://www.perlmonks.org/?node_id=41961
1564 92     92   165 my ( $self, $decimal, $max_iterations, $max_digits ) = @_;
1565             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1566             ###LogSD $self->get_all_space . '::hidden::_util_function::_continued_fraction', );
1567             ###LogSD $phone->talk( level => 'info', message => [
1568             ###LogSD "Attempting to build an integer fraction with decimal: $decimal",
1569             ###LogSD "Using max iterations: $max_iterations",
1570             ###LogSD "..and max digits: $max_digits", ] );
1571 92         117 my @continuous_integer_list;
1572 92         122 my $start_decimal = $decimal;
1573 92 50       284 confess "Passed bad decimal: $decimal" if !is_Num( $decimal );
1574 92   66     1009 while( $max_iterations > 0 and ($decimal >= 0.00001) ){
1575 212         305 $decimal = 1/$decimal;
1576 212         469 ( my $integer, $decimal ) = $self->_integer_and_decimal( $decimal );
1577             ###LogSD $phone->talk( level => 'info', message => [
1578             ###LogSD "The integer of the inverse decimal is: $integer",
1579             ###LogSD "The remaining decimal is: $decimal" ] );
1580 212 100 100     1046 if($integer > 999 or ($decimal < 0.00001 and $decimal > 1e-10) ){
      66        
1581             ###LogSD $phone->talk( level => 'info', message => [
1582             ###LogSD "Either I found a large integer: $integer",
1583             ###LogSD "...or the decimal is small: $decimal" ] );
1584 68 100       154 if( $integer <= 999 ){
1585 60         96 push @continuous_integer_list, $integer;
1586             }
1587 68         103 last;
1588             }
1589 144         226 push @continuous_integer_list, $integer;
1590 144         710 $max_iterations--;
1591             ###LogSD $phone->talk( level => 'info', message => [
1592             ###LogSD "Remaining iterations: $max_iterations" ] );
1593             }
1594             ###LogSD $phone->talk( level => 'info', message => [
1595             ###LogSD "The current continuous fraction integer list is:", @continuous_integer_list ] );
1596 92         221 my ( $numerator, $denominator ) = $self->_integers_to_fraction( @continuous_integer_list );
1597 92 100 100     566 if( !$numerator or ( $denominator and length( $denominator ) > $max_digits ) ){
      66        
1598 20         47 my $denom = 9 x $max_digits;
1599 20         67 my ( $int, $dec ) = $self->_integer_and_decimal( $start_decimal * $denom );
1600 20         39 $int++;
1601             ###LogSD $phone->talk( level => 'debug', message => [
1602             ###LogSD "Passing through the possibilities with start numerator: $int",
1603             ###LogSD "..and start denominator: $denom", "Against start decimal: $decimal"] );
1604 20 100       110 my $lowest = ( $start_decimal >= 0.5 ) ?
1605             { delta => (1-$start_decimal), numerator => 1, denominator => 1 } :
1606             { delta => ($start_decimal-0), numerator => 0, denominator => 1 } ;
1607 20         57 while( $int ){
1608 1161         1242 my @check_list;
1609 1161         1391 my $low_int = $int - 1;
1610 1161         1773 my $low_denom = int( $low_int/$start_decimal ) + 1;
1611 1161         7388 push @check_list,
1612             { delta => abs( $int/$denom - $start_decimal ), numerator => $int, denominator => $denom },
1613             { delta => abs( $low_int/$denom - $start_decimal ), numerator => $low_int, denominator => $denom },
1614             { delta => abs( $low_int/$low_denom - $start_decimal ), numerator => $low_int, denominator => $low_denom },
1615             { delta => abs( $int/$low_denom - $start_decimal ), numerator => $int, denominator => $low_denom };
1616 1161         2495 my @fixed_list = sort { $a->{delta} <=> $b->{delta} } @check_list;
  5795         8706  
1617             ###LogSD $phone->talk( level => 'trace', message => [
1618             ###LogSD 'Built possible list of lower fractions:', @fixed_list ] );
1619 1161 100       2552 if( $fixed_list[0]->{delta} < $lowest->{delta} ){
1620 15         24 $lowest = $fixed_list[0];
1621             ###LogSD $phone->talk( level => 'debug', message => [
1622             ###LogSD 'Updated lowest with:', $lowest ] );
1623             }
1624 1161         1281 $int = $low_int;
1625 1161         4570 $denom = $low_denom - 1;
1626             ###LogSD $phone->talk( level => 'debug', message => [
1627             ###LogSD "Attempting new possibilities with start numerator: $int",
1628             ###LogSD "..and start denominator: $denom", "Against start decimal: $decimal"] );
1629             }
1630 20         64 ($numerator, $denominator) = $self->_best_fraction( @$lowest{qw( numerator denominator )} );
1631             }
1632             ###LogSD $phone->talk( level => 'info', message => [
1633             ###LogSD (($numerator) ? "Final numerator: $numerator" : undef),
1634             ###LogSD (($denominator) ? "Final denominator: $denominator" : undef), ] );
1635 92 100 66     476 if( !$numerator ){
    100          
1636             ###LogSD $phone->talk( level => 'info', message => [
1637             ###LogSD "Fraction is below the finite value - returning undef" ] );
1638 8         27 return undef;
1639             }elsif( !$denominator or $denominator == 1 ){
1640             ###LogSD $phone->talk( level => 'info', message => [
1641             ###LogSD "Rounding up to: $numerator" ] );
1642 6         24 return( $numerator );
1643             }else{
1644             ###LogSD $phone->talk( level => 'info', message => [
1645             ###LogSD "The final fraction is: $numerator/$denominator" ] );
1646 78         690 return $numerator . '/' . $denominator;
1647             }
1648             }
1649              
1650             # Takes a list of terms in a continued fraction, and converts them
1651             # into a fraction.
1652             sub _integers_to_fraction {# ints_to_frac
1653 92     92   164 my ( $self, $numerator, $denominator) = (shift, 0, 1); # Seed with 0 (not all elements read here!)
1654             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1655             ###LogSD $self->get_all_space . '::hidden::_util_function::_integers_to_fraction', );
1656             ###LogSD $phone->talk( level => 'info', message => [
1657             ###LogSD "Attempting to build an integer fraction with the continuous fraction list: " .
1658             ###LogSD join( ' - ', @_ ), "With a seed numerator of -0- and seed denominator of -1-" ] );
1659 92         170 for my $integer( reverse @_ ){# Get remaining elements
1660             ###LogSD $phone->talk( level => 'info', message => [ "Now processing: $integer" ] );
1661 204         449 ($numerator, $denominator) =
1662             ($denominator, $integer * $denominator + $numerator);
1663             ###LogSD $phone->talk( level => 'info', message => [
1664             ###LogSD "New numerator: $numerator", "New denominator: $denominator", ] );
1665             }
1666 92         206 ($numerator, $denominator) = $self->_best_fraction($numerator, $denominator);
1667             ###LogSD $phone->talk( level => 'info', message => [
1668             ###LogSD "Updated numerator: $numerator",
1669             ###LogSD (($denominator) ? "..and denominator: $denominator" : undef) ] );
1670 92         209 return ( $numerator, $denominator );
1671             }
1672              
1673              
1674             # Takes a numerator and denominator, in scalar context returns
1675             # the best fraction describing them, in list the numerator and
1676             # denominator
1677             sub _best_fraction{#frac_standard
1678 112     112   173 my ($self, $n, $m) = @_;
1679             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1680             ###LogSD $self->get_all_space . '::hidden::_util_function::_best_fraction', );
1681             ###LogSD $phone->talk( level => 'info', message => [
1682             ###LogSD "Finding the best fraction", "Start numerator: $n", "Start denominator: $m" ] );
1683 112         228 $n = $self->_integer_and_decimal($n);
1684 112         248 $m = $self->_integer_and_decimal($m);
1685             ###LogSD $phone->talk( level => 'info', message => [
1686             ###LogSD "Updated numerator and denominator ( $n / $m )" ] );
1687 112         261 my $k = $self->_gcd($n, $m);
1688             ###LogSD $phone->talk( level => 'info', message => [ "Greatest common divisor: $k" ] );
1689 112         177 $n = $n/$k;
1690 112         135 $m = $m/$k;
1691             ###LogSD $phone->talk( level => 'info', message => [
1692             ###LogSD "Reduced numerator and denominator ( $n / $m )" ] );
1693 112 50       290 if ($m < 0) {
1694             ###LogSD $phone->talk( level => 'info', message => [ "the divisor is less than zero" ] );
1695 0         0 $n *= -1;
1696 0         0 $m *= -1;
1697             }
1698 112 100       248 $m = undef if $m == 1;
1699             ###LogSD no warnings 'uninitialized';
1700             ###LogSD $phone->talk( level => 'info', message => [
1701             ###LogSD "Final numerator and denominator ( $n / $m )" ] );
1702             ###LogSD use warnings 'uninitialized';
1703 112 50       197 if (wantarray) {
1704 112         287 return ($n, $m);
1705             }else {
1706 0 0       0 return ( $m ) ? "$n/$m" : $n;
1707             }
1708             }
1709              
1710             # Takes a number, returns the best integer approximation and
1711             # (in list context) the error.
1712             sub _integer_and_decimal {# In the future see if this will merge with _split_decimal_integer
1713 456     456   683 my ( $self, $decimal ) = @_;
1714             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1715             ###LogSD $self->get_all_space . '::hidden::_util_function::_integer_and_decimal', );
1716             ###LogSD $phone->talk( level => 'info', message => [
1717             ###LogSD "Splitting integer from decimal for: $decimal" ] );
1718 456         610 my $integer = int( $decimal );
1719             ###LogSD $phone->talk( level => 'info', message => [ "Integer: $integer" ] );
1720 456 100       865 if(wantarray){
1721 232         595 return($integer, $decimal - $integer);
1722             }else{
1723 224         435 return $integer;
1724             }
1725             }
1726              
1727             # Euclidean algorithm for calculating a GCD.
1728             # Takes two integers, returns the greatest common divisor.
1729             sub _gcd {
1730 112     112   171 my ($self, $n, $m) = @_;
1731             ###LogSD my $phone = Log::Shiras::Telephone->new( name_space =>
1732             ###LogSD $self->get_all_space . '::hidden::_util_function::_gcd', );
1733             ###LogSD $phone->talk( level => 'info', message => [
1734             ###LogSD "Finding the greatest common divisor for ( $n and $m )" ] );
1735 112         248 while ($m) {
1736 288         361 my $k = $n % $m;
1737             ###LogSD $phone->talk( level => 'info', message => [
1738             ###LogSD "Remainder after division: $k" ] );
1739 288         785 ($n, $m) = ($m, $k);
1740             ###LogSD $phone->talk( level => 'info', message => [
1741             ###LogSD "Updated factors ( $n and $m )" ] );
1742             }
1743 112         197 return $n;
1744             }
1745              
1746             #########1 Phinish 3#########4#########5#########6#########7#########8#########9
1747              
1748 2     2   20821 no Moose::Role;
  2         5  
  2         35  
1749            
1750             1;
1751              
1752             #########1 Documentation 3#########4#########5#########6#########7#########8#########9
1753             __END__
1754              
1755             =head1 NAME
1756              
1757             Spreadsheet::XLSX::Reader::LibXML::ParseExcelFormatStrings - Parser of XLSX format strings
1758              
1759             =head1 SYNOPSYS
1760              
1761             See the L<Spreadsheet::XLSX::Reader::LibXML::FmtDefault/SYNOPSYS>
1762              
1763             =head1 DESCRIPTION
1764              
1765             To use the general package for excel
1766             parsing out of the box please review the documentation for L<Workbooks
1767             |Spreadsheet::XLSX::Reader::LibXML>, L<Worksheets
1768             |Spreadsheet::XLSX::Reader::LibXML::Worksheet>, and
1769             L<Cells|Spreadsheet::XLSX::Reader::LibXML::Cell>
1770              
1771             This is a general purpose L<Moose Role|Moose::Manual::Roles> that will convert Excel
1772             L<format strings
1773             |https://support.office.com/en-us/article/Create-or-delete-a-custom-number-format-83657ca7-9dbe-4ee5-9c89-d8bf836e028e?ui=en-US&rs=en-US&ad=US>
1774             into L<Type::Tiny> objects in order to implement the conversion defined by the format
1775             string. Excel defines the format strings as number conversions only (They do not act
1776             on text). Excel format strings can have up to four parts separated by semi-colons.
1777             The four parts are positive, zero, negative, and text. In Excel the text section is
1778             just a pass through. This is how excel handles dates earlier than 1900sh. This
1779             parser deviates from that for dates. Since this parser parses dates into a L<DateTime>
1780             objects (and then L<potentially back|datetime_dates> to a differently formatted string)
1781             it also attempts to parse strings to DateTime objects if the cell has a date format
1782             applied. All other types of Excel number conversions still treat strings as a pass
1783             through.
1784              
1785             To replace this module just build a L<Moose::Role|Moose::Manual::Roles> that delivers
1786             the method L<parse_excel_format_string|/parse_excel_format_string> and
1787             L<get_defined_conversion|/get_defined_conversion( $position )>. Then use it when building
1788             a replacement for L<Spreadsheet::XLSX::Reader::LibXML::FmtDefault>.
1789              
1790             The decimal (real number) to fractions conversion can be top heavy to build. If you
1791             are experiencing delays when reading values then this is another place to investigate.
1792             In order to get the most accurate answer this parser initially uses the L<continued
1793             fraction|http://en.wikipedia.org/wiki/Continued_fraction> algorythm to calculate a
1794             possible fraction for the pased $decimal value with the setting of 20 max iterations
1795             and a maximum denominator width defined by the format string. If that does not
1796             resolve satisfactorily it then calculates an over/under numerator with decreasing
1797             denominators from the maximum denominator (based on the format string) all the way
1798             to the denominator of 2 and takes the most accurate result. There is no early-out
1799             set in this computation so if you reach this point for multi digit denominators it
1800             is computationally intensive. (Not that continued fractions are computationally
1801             so cheap.). However, doing the calculation this way generally yields the same result as Excel.
1802             In some few cases the result is more accurate. I was unable to duplicate the results from
1803             Excel exactly (or even come close otherwise). If you have a faster conversion then
1804             implemenation of the speed-up can be acheived by
1805             substituting the fraction coercion using
1806             L<Spreadsheet::XLSX::Reader::LibXML::GetCell/set_custom_formats( { $key =E<gt> $conversion } )>
1807              
1808             =head2 requires
1809              
1810             These are method(s) used by this role but not provided by the role. Any class consuming this
1811             role will not build without first providing these methods prior to loading this role.
1812              
1813             =head3 get_excel_region
1814              
1815             =over
1816              
1817             B<Definition:> Used to return the two letter region ID. This ID is then used by
1818             L<DateTime::Format::Flexible> to interpret date strings. Currently this method is
1819             provided by L<Spreadsheet::XLSX::Reader::LibXML::FmtDefault> and (potentially) reset
1820             when that instance is loaded to the parser.
1821              
1822             =back
1823              
1824             =head3 set_error
1825              
1826             =over
1827              
1828             B<Definition:> Used to set the error string in a shared error instance.
1829              
1830             =back
1831              
1832             =head3 get_defined_excel_format
1833              
1834             =over
1835              
1836             B<Definition:> Used to return the default error string for a defined position.
1837              
1838             See L<Spreadsheet::XLSX::Reader::LibXML::FmtDefault/defined_excel_translations>
1839              
1840             =back
1841              
1842             =head2 Primary Methods
1843              
1844             These are the primary ways to use this Role. For additional ParseExcelFormatStrings options
1845             see the L<Attributes|/Attributes> section.
1846              
1847             =head3 parse_excel_format_string( $string, $name )
1848              
1849             =over
1850              
1851             B<Definition:> This is the method to convert Excel L<format strings
1852             |https://support.office.com/en-us/article/Create-or-delete-a-custom-number-format-83657ca7-9dbe-4ee5-9c89-d8bf836e028e?ui=en-US&rs=en-US&ad=US>
1853             into L<Type::Tiny> objects with built in coercions. The type coercion objects are then used to
1854             convert L<unformatted|Spreadsheet::XLSX::Reader::LibXML::Cell/unformatted> values into formatted
1855             values using the L<assert_coerce|Type::Coercion/Coercion> method. Coercions built by this module
1856             allow for the format string to have up to four parts separated by semi-colons. These four parts
1857             correlate to four different data input ranges. The four parts are positive, zero, negative, and
1858             text. If three substrings are sent then the data input is split to (positive and zero), negative,
1859             and text. If two input types are sent the data input is split between numbers and text. One input
1860             type is a take all comers type with the exception of dates. When dates are built by this module it
1861             always adds a possible from-text conversion to process Excel pre-1900ish dates. This is because
1862             Excel does not record dates prior to 1900ish as numbers. All date unformatted values are then
1863             processed into and then L<potentially|/datetime_dates> back out of L<DateTime> objects. This
1864             requires L<Type::Tiny::Manual::Coercions/Chained Coercions>. The two packages used for conversion
1865             to DateTime objects are L<DateTime::Format::Flexible> and L<DateTimeX::Format::Excel>.
1866              
1867             B<Accepts:> an Excel number L<format string
1868             |https://support.office.com/en-us/article/Create-or-delete-a-custom-number-format-83657ca7-9dbe-4ee5-9c89-d8bf836e028e?ui=en-US&rs=en-US&ad=US>
1869             and a conversion name stored in the Type::Tiny object. This package will auto-generate a name if
1870             none is given
1871              
1872             B<Returns:> a L<Type::Tiny> object with type coercions and pre-filters set for each input type
1873             from the formatting string
1874              
1875             B<Delegated to the workbook class:> yes
1876              
1877             =back
1878              
1879             =head3 get_defined_conversion( $position )
1880              
1881             =over
1882              
1883             B<Definition:> This is a helper method that combines the call to
1884             L<Spreadsheet::XLSX::Reader::LibXML::FmtDefault/get_defined_excel_format( $position )> and
1885             parse_excel_format_string above in order to get all the information with one request.
1886              
1887             B<Accepts:> an Excel format position
1888              
1889             B<Returns:> a L<Type::Tiny> object with type coercions and pre-filters set for each input type
1890             from the formatting string
1891              
1892             B<Delegated to the workbook class:> no
1893              
1894             =back
1895              
1896             =head2 Attributes
1897              
1898             Data passed to new when creating the L<Spreadsheet::XLSX::Reader::LibXML::FmtDefault>
1899             instance. For modification of these attributes see the listed 'attribute methods'.
1900             For more information on attributes see L<Moose::Manual::Attributes>. Most of these are
1901             not exposed to the top level of L<Spreadsheet::XLSX::Reader::LibXML>.
1902              
1903             =head3 epoch_year
1904              
1905             =over
1906              
1907             B<Definition:> This is the epoch year in the Excel sheet. It differentiates between
1908             Windows and Apple Excel implementations. For more information see
1909             L<DateTimeX::Format::Excel|DateTimeX::Format::Excel/DESCRIPTION>. It is generally
1910             (re)set by the workbook when the formatter instance is passed to the workbook.
1911              
1912             B<Default:> 1900
1913              
1914             B<Range:> 1900 or 1904
1915              
1916             B<attribute methods> Methods provided to adjust this attribute
1917            
1918             =over
1919              
1920             B<get_epoch_year>
1921              
1922             =over
1923              
1924             B<Definition:> returns the value of the attribute
1925              
1926             B<Delegated to the workbook class:> no
1927              
1928             =back
1929              
1930             B<set_epoch_year>
1931              
1932             =over
1933              
1934             B<Definition:> sets the value of the attribute
1935              
1936             B<Delegated to the workbook class:> no
1937              
1938             =back
1939              
1940             =back
1941              
1942             =back
1943              
1944             =head3 datetime_dates
1945              
1946             =over
1947              
1948             B<Definition:> It may be that you desire the full L<DateTime> object as output
1949             rather than the finalized datestring when converting unformatted date data to
1950             formatted date data. This attribute sets whether data coersions are built to do
1951             the full conversion or just to a DateTime object level. It is generally
1952             (re)set by the workbook when the formatter instance is passed to the workbook.
1953              
1954             B<Default:> 0 = unformatted values are coerced completely to date strings (1 =
1955             stop at DateTime)
1956              
1957             B<attribute methods> Methods provided to adjust this attribute.
1958            
1959             =over
1960              
1961             B<get_date_behavior>
1962              
1963             =over
1964              
1965             B<Definition:> returns the value of the attribute
1966              
1967             B<Delegated to the workbook class:> yes
1968              
1969             =back
1970              
1971             =back
1972            
1973             =over
1974              
1975             B<set_date_behavior( $Bool )>
1976              
1977             =over
1978              
1979             B<Definition:> sets the attribute value (only L<new|/cache_formats> coercions
1980             are affected)
1981              
1982             B<Accepts:> Boolean values
1983              
1984             B<Delegated to the workbook class:> yes
1985              
1986             =back
1987              
1988             =back
1989              
1990             =back
1991              
1992             =head3 cache_formats
1993              
1994             =over
1995              
1996             B<Definition:> In order to save re-building the coercion each time they are
1997             used, the built coercions can be cached with the format string as the key.
1998             This attribute sets whether caching is turned on or not.
1999              
2000             B<Default:> 1 = caching is on
2001              
2002             B<attribute methods> Methods provided to adjust this attribute
2003            
2004             =over
2005              
2006             B<get_cache_behavior>
2007              
2008             =over
2009              
2010             B<Definition:> returns the value of the attribute
2011              
2012             B<Delegated to the workbook class:> inherited
2013              
2014             =back
2015              
2016             B<set_cache_behavior>
2017              
2018             =over
2019              
2020             B<Definition:> sets the value of the attribute
2021              
2022             B<Range:> Boolean 1 = cache formats, 0 = Don't cache formats
2023              
2024             B<Delegated to the workbook class:> inherited
2025              
2026             =back
2027              
2028             =back
2029              
2030             =back
2031              
2032             =head3 european_first
2033              
2034             =over
2035              
2036             B<Definition:> This is a way to check for DD-MM-YY formatting of string
2037             dates prior to checking for MM-DD-YY. Since this checks both ways the
2038             goal is to catch ambiguous data where the substring for DD < 13 and
2039             assign it correctly.
2040              
2041             B<Default:> 0 = MM-DD-YY is tested first
2042              
2043             B<attribute methods> Methods provided to adjust this attribute
2044            
2045             =over
2046              
2047             B<get_european_first>
2048              
2049             =over
2050              
2051             B<Definition:> returns the value of the attribute
2052              
2053             =back
2054              
2055             B<set_european_first>
2056              
2057             =over
2058              
2059             B<Definition:> sets the value of the attribute
2060              
2061             B<Range:> Boolean 0 = MM-DD-YY is tested first, 1 = DD-MM-YY is tested first
2062              
2063             B<Delegated to the workbook class:> yes
2064              
2065             =back
2066              
2067             =back
2068              
2069             =back
2070              
2071             =head1 SUPPORT
2072              
2073             =over
2074              
2075             L<github Spreadsheet::XLSX::Reader::LibXML/issues
2076             |https://github.com/jandrew/Spreadsheet-XLSX-Reader-LibXML/issues>
2077              
2078             =back
2079              
2080             =head1 TODO
2081              
2082             =over
2083              
2084             B<1.> Attempt to merge _split_decimal_integer and _integer_and_decimal
2085              
2086             =back
2087              
2088             =head1 AUTHOR
2089              
2090             =over
2091              
2092             =item Jed Lund
2093              
2094             =item jandrew@cpan.org
2095              
2096             =back
2097              
2098             =head1 COPYRIGHT
2099              
2100             This program is free software; you can redistribute
2101             it and/or modify it under the same terms as Perl itself.
2102              
2103             The full text of the license can be found in the
2104             LICENSE file included with this module.
2105              
2106             This software is copyrighted (c) 2014, 2015 by Jed Lund
2107              
2108             =head1 DEPENDENCIES
2109              
2110             =over
2111              
2112             L<perl 5.010|perl/5.10.0>
2113              
2114             L<version> 0.77
2115              
2116             L<Carp> - confess
2117              
2118             L<Type::Tiny> - 1.000
2119              
2120             L<DateTimeX::Format::Excel> - 0.012
2121              
2122             L<DateTime::Format::Flexible>
2123              
2124             L<Clone> - clone
2125              
2126             L<Spreadsheet::XLSX::Reader::LibXML::Types>
2127              
2128             L<Moose::Role>
2129              
2130             =over
2131              
2132             B<requires;>
2133              
2134             =over
2135              
2136             get_excel_region
2137              
2138             set_error
2139              
2140             get_defined_excel_format
2141              
2142             =back
2143              
2144             =back
2145              
2146             =back
2147              
2148             =head1 SEE ALSO
2149              
2150             =over
2151              
2152             L<Spreadsheet::ParseExcel> - Excel 2003 and earlier
2153              
2154             L<Spreadsheet::XLSX> - 2007+
2155              
2156             L<Spreadsheet::ParseXLSX> - 2007+
2157              
2158             L<Log::Shiras|https://github.com/jandrew/Log-Shiras>
2159              
2160             =over
2161              
2162             All lines in this package that use Log::Shiras are commented out
2163              
2164             =back
2165              
2166             =back
2167              
2168             =cut
2169              
2170             #########1#########2 main pod documentation end 5#########6#########7#########8#########9