File Coverage

blib/lib/Spreadsheet/XLSX/Reader/LibXML/ParseExcelFormatStrings.pm
Criterion Covered Total %
statement 608 655 92.8
branch 312 390 80.0
condition 109 175 62.2
subroutine 50 51 98.0
pod 2 2 100.0
total 1081 1273 84.9


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