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