File Coverage

blib/lib/Spreadsheet/Reader/Format/ParseExcelFormatStrings.pm
Criterion Covered Total %
statement 651 708 91.9
branch 331 420 78.8
condition 123 203 60.5
subroutine 53 54 98.1
pod 2 2 100.0
total 1160 1387 83.6


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