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