← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Spreadsheet/ParseExcel/Utility.pm
StatementsExecuted 13 statements in 3.20ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1119µs10µsSpreadsheet::ParseExcel::Utility::::BEGIN@19Spreadsheet::ParseExcel::Utility::BEGIN@19
1114µs21µsSpreadsheet::ParseExcel::Utility::::BEGIN@23Spreadsheet::ParseExcel::Utility::BEGIN@23
1113µs16µsSpreadsheet::ParseExcel::Utility::::BEGIN@20Spreadsheet::ParseExcel::Utility::BEGIN@20
0000s0sSpreadsheet::ParseExcel::Utility::::AddCommaSpreadsheet::ParseExcel::Utility::AddComma
0000s0sSpreadsheet::ParseExcel::Utility::::ExcelFmtSpreadsheet::ParseExcel::Utility::ExcelFmt
0000s0sSpreadsheet::ParseExcel::Utility::::ExcelLocaltimeSpreadsheet::ParseExcel::Utility::ExcelLocaltime
0000s0sSpreadsheet::ParseExcel::Utility::::LeapYearSpreadsheet::ParseExcel::Utility::LeapYear
0000s0sSpreadsheet::ParseExcel::Utility::::LocaltimeExcelSpreadsheet::ParseExcel::Utility::LocaltimeExcel
0000s0sSpreadsheet::ParseExcel::Utility::::MakeESpreadsheet::ParseExcel::Utility::MakeE
0000s0sSpreadsheet::ParseExcel::Utility::::MakeFractionSpreadsheet::ParseExcel::Utility::MakeFraction
0000s0sSpreadsheet::ParseExcel::Utility::::col2intSpreadsheet::ParseExcel::Utility::col2int
0000s0sSpreadsheet::ParseExcel::Utility::::int2colSpreadsheet::ParseExcel::Utility::int2col
0000s0sSpreadsheet::ParseExcel::Utility::::sheetRefSpreadsheet::ParseExcel::Utility::sheetRef
0000s0sSpreadsheet::ParseExcel::Utility::::xls2csvSpreadsheet::ParseExcel::Utility::xls2csv
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Spreadsheet::ParseExcel::Utility;
2
3###############################################################################
4#
5# Spreadsheet::ParseExcel::Utility - Utility functions for ParseExcel.
6#
7# Used in conjunction with Spreadsheet::ParseExcel.
8#
9# Copyright (c) 2014 Douglas Wilson
10# Copyright (c) 2009-2013 John McNamara
11# Copyright (c) 2006-2008 Gabor Szabo
12# Copyright (c) 2000-2006 Kawai Takanori
13#
14# perltidy with standard settings.
15#
16# Documentation after __END__
17#
18
19216µs211µs
# spent 10µs (9+1) within Spreadsheet::ParseExcel::Utility::BEGIN@19 which was called: # once (9µs+1µs) by Spreadsheet::ParseExcel::FmtDefault::BEGIN@22 at line 19
use strict;
# spent 10µs making 1 call to Spreadsheet::ParseExcel::Utility::BEGIN@19 # spent 1µs making 1 call to strict::import
20217µs228µs
# spent 16µs (3+12) within Spreadsheet::ParseExcel::Utility::BEGIN@20 which was called: # once (3µs+12µs) by Spreadsheet::ParseExcel::FmtDefault::BEGIN@22 at line 20
use warnings;
# spent 16µs making 1 call to Spreadsheet::ParseExcel::Utility::BEGIN@20 # spent 12µs making 1 call to warnings::import
21
221500nsrequire Exporter;
2323.15ms238µs
# spent 21µs (4+17) within Spreadsheet::ParseExcel::Utility::BEGIN@23 which was called: # once (4µs+17µs) by Spreadsheet::ParseExcel::FmtDefault::BEGIN@22 at line 23
use vars qw(@ISA @EXPORT_OK);
# spent 21µs making 1 call to Spreadsheet::ParseExcel::Utility::BEGIN@23 # spent 17µs making 1 call to vars::import
2415µs@ISA = qw(Exporter);
251700ns@EXPORT_OK = qw(ExcelFmt LocaltimeExcel ExcelLocaltime
26 col2int int2col sheetRef xls2csv);
27
281200nsour $VERSION = '0.66';
29
3015µs12µsmy $qrNUMBER = qr/(^[+-]?\d+(\.\d+)?$)|(^[+-]?\d+\.?(\d*)[eE][+-](\d+))$/;
# spent 2µs making 1 call to CORE::qr
31
32###############################################################################
33#
34# ExcelFmt()
35#
36# This function takes an Excel style number format and converts a number into
37# that format. for example: 'hh:mm:ss AM/PM' + 0.01023148 = '12:14:44 AM'.
38#
39# It does this with a type of templating mechanism. The format string is parsed
40# to identify tokens that need to be replaced and their position within the
41# string is recorded. These can be thought of as placeholders. The number is
42# then converted to the required formats and substituted into the placeholders.
43#
44# Interested parties should refer to the Excel documentation on cell formats for
45# more information: http://office.microsoft.com/en-us/excel/HP051995001033.aspx
46# The Microsoft documentation for the Excel Binary File Format, [MS-XLS].pdf,
47# also contains a ABNF grammar for number format strings.
48#
49# Maintainers notes:
50# ==================
51#
52# Note on format subsections:
53# A format string can contain 4 possible sub-sections separated by semi-colons:
54# Positive numbers, negative numbers, zero values, and text.
55# For example: _(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)
56#
57# Note on conditional formats.
58# A number format in Excel can have a conditional expression such as:
59# [>9999999](000)000-0000;000-0000
60# This is equivalent to the following in Perl:
61# $format = $number > 9999999 ? '(000)000-0000' : '000-0000';
62# Nested conditionals are also possible but we don't support them.
63#
64# Efficiency: The excessive use of substr() isn't very efficient. However,
65# it probably doesn't merit rewriting this function with a parser or regular
66# expressions and \G.
67#
68# TODO: I think the single quote handling may not be required. Check.
69#
70sub ExcelFmt {
71
72 my ( $format_str, $number, $is_1904, $number_type, $want_subformats ) = @_;
73
74 # Return text strings without further formatting.
75 return $number unless $number =~ $qrNUMBER;
76
77 # Handle OpenOffice.org GENERAL format.
78 $format_str = '@' if uc($format_str) eq "GENERAL";
79
80 # Check for a conditional at the start of the format. See notes above.
81 my $conditional_op;
82 my $conditional_value;
83 if ( $format_str =~ /^\[([<>=]+)([^\]]+)\](.*)$/ ) {
84 $conditional_op = $1;
85 $conditional_value = $2;
86 $format_str = $3;
87 }
88
89 # Ignore the underscore token which is used to indicate a padding space.
90 $format_str =~ s/_/ /g;
91
92 # Split the format string into 4 possible sub-sections: positive numbers,
93 # negative numbers, zero values, and text. See notes above.
94 my @formats;
95 my $section = 0;
96 my $double_quote = 0;
97 my $single_quote = 0;
98
99 # Initial parsing of the format string to remove escape characters. This
100 # also handles quoted strings. See note about single quotes above.
101 CHARACTER:
102 for my $char ( split //, $format_str ) {
103
104 if ( $double_quote or $single_quote ) {
105 $formats[$section] .= $char;
106 $double_quote = 0 if $char eq '"';
107 $single_quote = 0;
108 next CHARACTER;
109 }
110
111 if ( $char eq ';' ) {
112 $section++;
113 next CHARACTER;
114 }
115 elsif ( $char eq '"' ) {
116 $double_quote = 1;
117 }
118 elsif ( $char eq '!' ) {
119 $single_quote = 1;
120 }
121 elsif ( $char eq '\\' ) {
122 $single_quote = 1;
123 }
124 elsif ( $char eq '(' ) {
125 next CHARACTER; # Ignore.
126 }
127 elsif ( $char eq ')' ) {
128 next CHARACTER; # Ignore.
129 }
130
131 # Convert upper case OpenOffice.org date/time formats to lowercase..
132 $char = lc($char) if $char =~ /[DMYHS]/;
133
134 $formats[$section] .= $char;
135 }
136
137 # Select the appropriate format from the 4 possible sub-sections:
138 # positive numbers, negative numbers, zero values, and text.
139 # We ignore the Text section since non-numeric values are returned
140 # unformatted at the start of the function.
141 my $format;
142 $section = 0;
143
144 if ( @formats == 1 ) {
145 $section = 0;
146 }
147 elsif ( @formats == 2 ) {
148 if ( $number < 0 ) {
149 $section = 1;
150 }
151 else {
152 $section = 0;
153 }
154 }
155 elsif ( @formats == 3 ) {
156 if ( $number == 0 ) {
157 $section = 2;
158 }
159 elsif ( $number < 0 ) {
160 $section = 1;
161 }
162 else {
163 $section = 0;
164 }
165 }
166 else {
167 $section = 0;
168 }
169
170 # Override the previous choice if the format is conditional.
171 if ($conditional_op) {
172 if ($conditional_op eq '>') {
173 $section = $number > $conditional_value ? 0 : 1;
174 } elsif ($conditional_op eq '>=') {
175 $section = $number >= $conditional_value ? 0 : 1;
176 } elsif ($conditional_op eq '<') {
177 $section = $number < $conditional_value ? 0 : 1;
178 } elsif ($conditional_op eq '<=') {
179 $section = $number <= $conditional_value ? 0 : 1;
180 } elsif ($conditional_op eq '=') {
181 $section = $number == $conditional_value ? 0 : 1;
182 } elsif ($conditional_op eq '==') {
183 $section = $number == $conditional_value ? 0 : 1;
184 } elsif ($conditional_op eq '<>') {
185 $section = $number != $conditional_value ? 0 : 1;
186 }
187 }
188 # We now have the required format.
189 $format = $formats[$section];
190
191 # The format string can contain one of the following colours:
192 # [Black] [Blue] [Cyan] [Green] [Magenta] [Red] [White] [Yellow]
193 # or the string [ColorX] where x is a colour index from 1 to 56.
194 # We don't use the colour but we return it to the caller.
195 #
196 my $color = '';
197 if ( $format =~ s/^(\[[A-Za-z]{3,}(\d{1,2})?\])// ) {
198 $color = $1;
199 }
200
201 # Remove the locale, such as [$-409], from the format string.
202 my $locale = '';
203 if ( $format =~ s/^(\[\$?-F?\d+\])// ) {
204 $locale = $1;
205 }
206
207 # Replace currency locale, such as [$$-409], with $ in the format string.
208 # See the RT#60547 test cases in 21_number_format_user.t.
209 if ( $format =~ s/(\[\$([^-]+)(-\d+)?\])/$2/s ) {
210 $locale = $1;
211 }
212
213
214 # Remove leading # from '# ?/?', '# ??/??' fraction formats.
215 $format =~ s{# \?}{?}g;
216
217 # Parse the format string and create an AoA of placeholders that contain
218 # the parts of the string to be replaced. The format of the information
219 # stored is: [ $token, $start_pos, $end_pos, $option_info ].
220 #
221 my $format_mode = ''; # Either: '', 'number', 'date'
222 my $pos = 0; # Character position within format string.
223 my @placeholders = (); # Arefs with parts of the format to be replaced.
224 my $token = ''; # The actual format extracted from the total str.
225 my $start_pos; # A position variable. Initial parser position.
226 my $token_start = -1; # A position variable.
227 my $decimal_pos = -1; # Position of the punctuation char "." or ",".
228 my $comma_count = 0; # Count of the commas in the format.
229 my $is_fraction = 0; # Number format is a fraction.
230 my $is_currency = 0; # Number format is a currency.
231 my $is_percent = 0; # Number format is a percentage.
232 my $is_12_hour = 0; # Time format is using 12 hour clock.
233 my $seen_dot = 0; # Treat only the first "." as the decimal point.
234
235 # Parse the format.
236 PARSER:
237 while ( $pos < length $format ) {
238 $start_pos = $pos;
239 my $char = substr( $format, $pos, 1 );
240
241 # Ignore control format characters such as '#0+-.?eE,%'. However,
242 # only ignore '.' if it is the first one encountered. RT 45502.
243 if ( ( !$seen_dot && $char !~ /[#0\+\-\.\?eE\,\%]/ )
244 || $char !~ /[#0\+\-\?eE\,\%]/ )
245 {
246
247 if ( $token_start != -1 ) {
248 push @placeholders,
249 [
250 substr( $format, $token_start, $pos - $token_start ),
251 $decimal_pos, $pos - $token_start
252 ];
253 $token_start = -1;
254 }
255 }
256
257 # Processing for quoted strings within the format. See notes above.
258 if ( $char eq '"' ) {
259 $double_quote = $double_quote ? 0 : 1;
260 $pos++;
261 next PARSER;
262 }
263 elsif ( $char eq '!' ) {
264 $single_quote = 1;
265 $pos++;
266 next PARSER;
267 }
268 elsif ( $char eq '\\' ) {
269 if ( $single_quote != 1 ) {
270 $single_quote = 1;
271 $pos++;
272 next PARSER;
273 }
274 }
275
276 if ( ( defined($double_quote) and ($double_quote) )
277 or ( defined($single_quote) and ($single_quote) )
278 or ( $seen_dot && $char eq '.' ) )
279 {
280 $single_quote = 0;
281 if (
282 ( $format_mode ne 'date' )
283 and ( ( substr( $format, $pos, 2 ) eq "\x81\xA2" )
284 || ( substr( $format, $pos, 2 ) eq "\x81\xA3" )
285 || ( substr( $format, $pos, 2 ) eq "\xA2\xA4" )
286 || ( substr( $format, $pos, 2 ) eq "\xA2\xA5" ) )
287 )
288 {
289
290 # The above matches are currency symbols.
291 push @placeholders,
292 [ substr( $format, $pos, 2 ), length($token), 2 ];
293 $is_currency = 1;
294 $pos += 2;
295 }
296 else {
297 $pos++;
298 }
299 }
300 elsif (
301 ( $char =~ /[#0\+\.\?eE\,\%]/ )
302 || ( ( $format_mode ne 'date' )
303 and ( ( $char eq '-' ) || ( $char eq '(' ) || ( $char eq ')' ) )
304 )
305 )
306 {
307 $format_mode = 'number' unless $format_mode;
308 if ( substr( $format, $pos, 1 ) =~ /[#0]/ ) {
309 if (
310 substr( $format, $pos ) =~
311 /^([#0]+[\.]?[0#]*[eE][\+\-][0#]+)/ )
312 {
313 push @placeholders, [ $1, $pos, length($1) ];
314 $pos += length($1);
315 }
316 else {
317 if ( $token_start == -1 ) {
318 $token_start = $pos;
319 $decimal_pos = length($token);
320 }
321 }
322 }
323 elsif ( substr( $format, $pos, 1 ) eq '?' ) {
324
325 # Look for a fraction format like ?/? or ??/??
326 if ( $token_start != -1 ) {
327 push @placeholders,
328 [
329 substr(
330 $format, $token_start, $pos - $token_start + 1
331 ),
332 $decimal_pos,
333 $pos - $token_start + 1
334 ];
335 }
336 $token_start = $pos;
337
338 # Find the end of the fraction format.
339 FRACTION:
340 while ( $pos < length($format) ) {
341 if ( substr( $format, $pos, 1 ) eq '/' ) {
342 $is_fraction = 1;
343 }
344 elsif ( substr( $format, $pos, 1 ) eq '?' ) {
345 $pos++;
346 next FRACTION;
347 }
348 else {
349 if ( $is_fraction
350 && ( substr( $format, $pos, 1 ) =~ /[0-9]/ ) )
351 {
352
353 # TODO: Could invert if() logic and remove this.
354 $pos++;
355 next FRACTION;
356 }
357 else {
358 last FRACTION;
359 }
360 }
361 $pos++;
362 }
363 $pos--;
364
365 push @placeholders,
366 [
367 substr( $format, $token_start, $pos - $token_start + 1 ),
368 length($token), $pos - $token_start + 1
369 ];
370 $token_start = -1;
371 }
372 elsif ( substr( $format, $pos, 3 ) =~ /^[eE][\+\-][0#]$/ ) {
373 if ( substr( $format, $pos ) =~ /([eE][\+\-][0#]+)/ ) {
374 push @placeholders, [ $1, $pos, length($1) ];
375 $pos += length($1);
376 }
377 $token_start = -1;
378 }
379 else {
380 if ( $token_start != -1 ) {
381 push @placeholders,
382 [
383 substr( $format, $token_start, $pos - $token_start ),
384 $decimal_pos, $pos - $token_start
385 ];
386 $token_start = -1;
387 }
388 if ( substr( $format, $pos, 1 ) =~ /[\+\-]/ ) {
389 push @placeholders,
390 [ substr( $format, $pos, 1 ), length($token), 1 ];
391 $is_currency = 1;
392 }
393 elsif ( substr( $format, $pos, 1 ) eq '.' ) {
394 push @placeholders,
395 [ substr( $format, $pos, 1 ), length($token), 1 ];
396 $seen_dot = 1;
397 }
398 elsif ( substr( $format, $pos, 1 ) eq ',' ) {
399 $comma_count++;
400 push @placeholders,
401 [ substr( $format, $pos, 1 ), length($token), 1 ];
402 }
403 elsif ( substr( $format, $pos, 1 ) eq '%' ) {
404 $is_percent = 1;
405 }
406 elsif (( substr( $format, $pos, 1 ) eq '(' )
407 || ( substr( $format, $pos, 1 ) eq ')' ) )
408 {
409 push @placeholders,
410 [ substr( $format, $pos, 1 ), length($token), 1 ];
411 $is_currency = 1;
412 }
413 }
414 $pos++;
415 }
416 elsif ( $char =~ /[ymdhsapg]/i ) {
417 $format_mode = 'date' unless $format_mode;
418 if ( substr( $format, $pos, 5 ) =~ /am\/pm/i ) {
419 push @placeholders, [ 'am/pm', length($token), 5 ];
420 $is_12_hour = 1;
421 $pos += 5;
422 }
423 elsif ( substr( $format, $pos, 3 ) =~ /a\/p/i ) {
424 push @placeholders, [ 'a/p', length($token), 3 ];
425 $is_12_hour = 1;
426 $pos += 3;
427 }
428 elsif ( substr( $format, $pos, 5 ) eq 'mmmmm' ) {
429 push @placeholders, [ 'mmmmm', length($token), 5 ];
430 $pos += 5;
431 }
432 elsif (( substr( $format, $pos, 4 ) eq 'mmmm' )
433 || ( substr( $format, $pos, 4 ) eq 'dddd' )
434 || ( substr( $format, $pos, 4 ) eq 'yyyy' )
435 || ( substr( $format, $pos, 4 ) eq 'ggge' ) )
436 {
437 push @placeholders,
438 [ substr( $format, $pos, 4 ), length($token), 4 ];
439 $pos += 4;
440 }
441 elsif (( substr( $format, $pos, 3 ) eq 'ddd' )
442 || ( substr( $format, $pos, 3 ) eq 'mmm' )
443 || ( substr( $format, $pos, 3 ) eq 'yyy' ) )
444 {
445 push @placeholders,
446 [ substr( $format, $pos, 3 ), length($token), 3 ];
447 $pos += 3;
448 }
449 elsif (( substr( $format, $pos, 2 ) eq 'yy' )
450 || ( substr( $format, $pos, 2 ) eq 'mm' )
451 || ( substr( $format, $pos, 2 ) eq 'dd' )
452 || ( substr( $format, $pos, 2 ) eq 'hh' )
453 || ( substr( $format, $pos, 2 ) eq 'ss' )
454 || ( substr( $format, $pos, 2 ) eq 'ge' ) )
455 {
456 if (
457 ( substr( $format, $pos, 2 ) eq 'mm' )
458 && (@placeholders)
459 && ( ( $placeholders[-1]->[0] eq 'h' )
460 or ( $placeholders[-1]->[0] eq 'hh' ) )
461 )
462 {
463
464 # For this case 'm' is minutes not months.
465 push @placeholders, [ 'mm', length($token), 2, 'minutes' ];
466 }
467 else {
468 push @placeholders,
469 [ substr( $format, $pos, 2 ), length($token), 2 ];
470 }
471 if ( ( substr( $format, $pos, 2 ) eq 'ss' )
472 && ( @placeholders > 1 ) )
473 {
474 if ( ( $placeholders[-2]->[0] eq 'm' )
475 || ( $placeholders[-2]->[0] eq 'mm' ) )
476 {
477
478 # For this case 'm' is minutes not months.
479 push( @{ $placeholders[-2] }, 'minutes' );
480 }
481 }
482 $pos += 2;
483 }
484 elsif (( substr( $format, $pos, 1 ) eq 'm' )
485 || ( substr( $format, $pos, 1 ) eq 'd' )
486 || ( substr( $format, $pos, 1 ) eq 'h' )
487 || ( substr( $format, $pos, 1 ) eq 's' ) )
488 {
489 if (
490 ( substr( $format, $pos, 1 ) eq 'm' )
491 && (@placeholders)
492 && ( ( $placeholders[-1]->[0] eq 'h' )
493 or ( $placeholders[-1]->[0] eq 'hh' ) )
494 )
495 {
496
497 # For this case 'm' is minutes not months.
498 push @placeholders, [ 'm', length($token), 1, 'minutes' ];
499 }
500 else {
501 push @placeholders,
502 [ substr( $format, $pos, 1 ), length($token), 1 ];
503 }
504 if ( ( substr( $format, $pos, 1 ) eq 's' )
505 && ( @placeholders > 1 ) )
506 {
507 if ( ( $placeholders[-2]->[0] eq 'm' )
508 || ( $placeholders[-2]->[0] eq 'mm' ) )
509 {
510
511 # For this case 'm' is minutes not months.
512 push( @{ $placeholders[-2] }, 'minutes' );
513 }
514 }
515 $pos += 1;
516 }
517 }
518 elsif ( ( substr( $format, $pos, 3 ) eq '[h]' ) ) {
519 $format_mode = 'date' unless $format_mode;
520 push @placeholders, [ '[h]', length($token), 3 ];
521 $pos += 3;
522 }
523 elsif ( ( substr( $format, $pos, 4 ) eq '[mm]' ) ) {
524 $format_mode = 'date' unless $format_mode;
525 push @placeholders, [ '[mm]', length($token), 4 ];
526 $pos += 4;
527 }
528 elsif ( $char eq '@' ) {
529 push @placeholders, [ '@', length($token), 1 ];
530 $pos++;
531 }
532 elsif ( $char eq '*' ) {
533 push @placeholders,
534 [ substr( $format, $pos, 1 ), length($token), 1 ];
535 }
536 else {
537 $pos++;
538 }
539 $pos++ if ( $pos == $start_pos ); #No Format match
540 $token .= substr( $format, $start_pos, $pos - $start_pos );
541
542 } # End of parsing.
543
544 # Copy the located format string to a result string that we will perform
545 # the substitutions on and return to the user.
546 my $result = $token;
547
548 # Add a placeholder between the decimal/comma and end of the token, if any.
549 if ( $token_start != -1 ) {
550 push @placeholders,
551 [
552 substr( $format, $token_start, $pos - $token_start + 1 ),
553 $decimal_pos, $pos - $token_start + 1
554 ];
555 }
556
557 #
558 # In the next sections we process date, number and text formats. We take a
559 # format such as yyyy/mm/dd and replace it with something like 2008/12/25.
560 #
561 if ( ( $format_mode eq 'date' ) && ( $number =~ $qrNUMBER ) ) {
562
563 # The maximum allowable date in Excel is 9999-12-31T23:59:59.000 which
564 # equates to 2958465.999+ in the 1900 epoch and 2957003.999+ in the
565 # 1904 epoch. We use 0 as the minimum in both epochs. The 1904 system
566 # actually supports negative numbers but that isn't worth the effort.
567 my $min_date = 0;
568 my $max_date = 2958466;
569 $max_date = 2957004 if $is_1904;
570
571 if ( $number < $min_date || $number >= $max_date ) {
572 return $number; # Return unformatted number.
573 }
574
575 # Process date formats.
576 my @time = ExcelLocaltime( $number, $is_1904 );
577
578 # 0 1 2 3 4 5 6 7
579 my ( $sec, $min, $hour, $day, $month, $year, $wday, $msec ) = @time;
580
581 $month++; # localtime() zero indexed month.
582 $year += 1900; # localtime() year.
583
584 my @full_month_name = qw(
585 None January February March April May June July
586 August September October November December
587 );
588 my @short_month_name = qw(
589 None Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
590 );
591 my @full_day_name = qw(
592 Sunday Monday Tuesday Wednesday Thursday Friday Saturday
593 );
594 my @short_day_name = qw(
595 Sun Mon Tue Wed Thu Fri Sat
596 );
597
598 # Replace the placeholders in the template such as yyyy mm dd with
599 # actual numbers or strings.
600 my $replacement;
601 for my $placeholder ( reverse @placeholders ) {
602
603 if ( $placeholder->[-1] eq 'minutes' ) {
604
605 # For this case 'm/mm' is minutes not months.
606 if ( $placeholder->[0] eq 'mm' ) {
607 $replacement = sprintf( "%02d", $min );
608 }
609 else {
610 $replacement = sprintf( "%d", $min );
611 }
612 }
613 elsif ( $placeholder->[0] eq 'yyyy' ) {
614
615 # 4 digit Year. 2000 -> 2000.
616 $replacement = sprintf( '%04d', $year );
617 }
618 elsif ( $placeholder->[0] eq 'yy' ) {
619
620 # 2 digit Year. 2000 -> 00.
621 $replacement = sprintf( '%02d', $year % 100 );
622 }
623 elsif ( $placeholder->[0] eq 'mmmmm' ) {
624
625 # First character of the month name. 1 -> J.
626 $replacement = substr( $short_month_name[$month], 0, 1 );
627 }
628 elsif ( $placeholder->[0] eq 'mmmm' ) {
629
630 # Full month name. 1 -> January.
631 $replacement = $full_month_name[$month];
632 }
633 elsif ( $placeholder->[0] eq 'mmm' ) {
634
635 # Short month name. 1 -> Jan.
636 $replacement = $short_month_name[$month];
637 }
638 elsif ( $placeholder->[0] eq 'mm' ) {
639
640 # 2 digit month. 1 -> 01.
641 $replacement = sprintf( '%02d', $month );
642 }
643 elsif ( $placeholder->[0] eq 'm' ) {
644
645 # 1 digit month. 1 -> 1.
646 $replacement = sprintf( '%d', $month );
647 }
648 elsif ( $placeholder->[0] eq 'dddd' ) {
649
650 # Full day name. Wednesday (for example.)
651 $replacement = $full_day_name[$wday];
652 }
653 elsif ( $placeholder->[0] eq 'ddd' ) {
654
655 # Short day name. Wed (for example.)
656 $replacement = $short_day_name[$wday];
657 }
658 elsif ( $placeholder->[0] eq 'dd' ) {
659
660 # 2 digit day. 1 -> 01.
661 $replacement = sprintf( '%02d', $day );
662 }
663 elsif ( $placeholder->[0] eq 'd' ) {
664
665 # 1 digit day. 1 -> 1.
666 $replacement = sprintf( '%d', $day );
667 }
668 elsif ( $placeholder->[0] eq 'hh' ) {
669
670 # 2 digit hour.
671 if ($is_12_hour) {
672 my $hour_tmp = $hour % 12;
673 $hour_tmp = 12 if $hour % 12 == 0;
674 $replacement = sprintf( '%d', $hour_tmp );
675 }
676 else {
677 $replacement = sprintf( '%02d', $hour );
678 }
679 }
680 elsif ( $placeholder->[0] eq 'h' ) {
681
682 # 1 digit hour.
683 if ($is_12_hour) {
684 my $hour_tmp = $hour % 12;
685 $hour_tmp = 12 if $hour % 12 == 0;
686 $replacement = sprintf( '%2d', $hour_tmp );
687 }
688 else {
689 $replacement = sprintf( '%d', $hour );
690 }
691 }
692 elsif ( $placeholder->[0] eq 'ss' ) {
693
694 # 2 digit seconds.
695 $replacement = sprintf( '%02d', $sec );
696 }
697 elsif ( $placeholder->[0] eq 's' ) {
698
699 # 1 digit seconds.
700 $replacement = sprintf( '%d', $sec );
701 }
702 elsif ( $placeholder->[0] eq 'am/pm' ) {
703
704 # AM/PM.
705 $replacement = ( $hour >= 12 ) ? 'PM' : 'AM';
706 }
707 elsif ( $placeholder->[0] eq 'a/p' ) {
708
709 # AM/PM.
710 $replacement = ( $hour >= 12 ) ? 'P' : 'A';
711 }
712 elsif ( $placeholder->[0] eq '.' ) {
713
714 # Decimal point for seconds.
715 $replacement = '.';
716 }
717 elsif ( $placeholder->[0] =~ /(^0+$)/ ) {
718
719 # Milliseconds. For example h:ss.000.
720 my $length = length($1);
721 $replacement =
722 substr( sprintf( "%.${length}f", $msec / 1000 ), 2, $length );
723 }
724 elsif ( $placeholder->[0] eq '[h]' ) {
725
726 # Hours modulus 24. 25 displays as 25 not as 1.
727 $replacement = sprintf( '%d', int($number) * 24 + $hour );
728 }
729 elsif ( $placeholder->[0] eq '[mm]' ) {
730
731 # Mins modulus 60. 72 displays as 72 not as 12.
732 $replacement =
733 sprintf( '%d', ( int($number) * 24 + $hour ) * 60 + $min );
734 }
735 elsif ( $placeholder->[0] eq 'ge' ) {
736 require Spreadsheet::ParseExcel::FmtJapan;
737 # Japanese Nengo (aka Gengo) in initialism (abbr. name)
738 $replacement =
739 Spreadsheet::ParseExcel::FmtJapan::CnvNengo( abbr_name => @time );
740 }
741 elsif ( $placeholder->[0] eq 'ggge' ) {
742 require Spreadsheet::ParseExcel::FmtJapan;
743 # Japanese Nengo (aka Gengo) in Kanji (full name)
744 $replacement =
745 Spreadsheet::ParseExcel::FmtJapan::CnvNengo( name => @time );
746 }
747 elsif ( $placeholder->[0] eq '@' ) {
748
749 # Text format.
750 $replacement = $number;
751 }
752 elsif ( $placeholder->[0] eq ',' ) {
753 next;
754 }
755
756 # Substitute the replacement string back into the template.
757 substr( $result, $placeholder->[1], $placeholder->[2],
758 $replacement );
759 }
760 }
761 elsif ( ( $format_mode eq 'number' ) && ( $number =~ $qrNUMBER ) ) {
762
763 # Process non date formats.
764 if (@placeholders) {
765 while ( $placeholders[-1]->[0] eq ',' ) {
766 $comma_count--;
767 substr(
768 $result,
769 $placeholders[-1]->[1],
770 $placeholders[-1]->[2], ''
771 );
772 $number /= 1000;
773 pop @placeholders;
774 }
775
776 my $number_format = join( '', map { $_->[0] } @placeholders );
777 my $number_result;
778 my $str_length = 0;
779 my $engineering = 0;
780 my $is_decimal = 0;
781 my $is_integer = 0;
782 my $after_decimal = undef;
783
784 for my $token ( split //, $number_format ) {
785 if ( $token eq '.' ) {
786 $str_length++;
787 $is_decimal = 1;
788 }
789 elsif ( ( $token eq 'E' ) || ( $token eq 'e' ) ) {
790 $engineering = 1;
791 }
792 elsif ( $token eq '0' ) {
793 $str_length++;
794 $after_decimal++ if $is_decimal;
795 $is_integer = 1;
796 }
797 elsif ( $token eq '#' ) {
798 $after_decimal++ if $is_decimal;
799 $is_integer = 1;
800 }
801 elsif ( $token eq '?' ) {
802 $after_decimal++ if $is_decimal;
803 }
804 }
805
806 $number *= 100.0 if $is_percent;
807
808 my $data = ($is_currency) ? abs($number) : $number + 0;
809
810 if ($is_fraction) {
811 $number_result = sprintf( "%0${str_length}d", int($data) );
812 }
813 else {
814 if ($is_decimal) {
815
816 if ( defined $after_decimal ) {
817 $number_result =
818 sprintf "%0${str_length}.${after_decimal}f", $data;
819 }
820 else {
821 $number_result = sprintf "%0${str_length}f", $data;
822 }
823
824 # Fix for Perl and sprintf not rounding up like Excel.
825 # http://rt.cpan.org/Public/Bug/Display.html?id=45626
826 if ( $data =~ /^${number_result}5/ ) {
827 $number_result =
828 sprintf "%0${str_length}.${after_decimal}f",
829 $data . '1';
830 }
831 }
832 else {
833 $number_result = sprintf( "%0${str_length}.0f", $data );
834 }
835 }
836
837 $number_result = AddComma($number_result) if $comma_count > 0;
838
839 my $number_length = length($number_result);
840 my $decimal_pos = -1;
841 my $replacement;
842
843 for ( my $i = @placeholders - 1 ; $i >= 0 ; $i-- ) {
844 my $placeholder = $placeholders[$i];
845
846 if ( $placeholder->[0] =~
847 /([#0]*)([\.]?)([0#]*)([eE])([\+\-])([0#]+)/ )
848 {
849 substr( $result, $placeholder->[1], $placeholder->[2],
850 MakeE( $placeholder->[0], $number ) );
851 }
852 elsif ( $placeholder->[0] =~ /\// ) {
853 substr( $result, $placeholder->[1], $placeholder->[2],
854 MakeFraction( $placeholder->[0], $number, $is_integer )
855 );
856 }
857 elsif ( $placeholder->[0] eq '.' ) {
858 $number_length--;
859 $decimal_pos = $number_length;
860 }
861 elsif ( $placeholder->[0] eq '+' ) {
862 substr( $result, $placeholder->[1], $placeholder->[2],
863 ( $number > 0 )
864 ? '+'
865 : ( ( $number == 0 ) ? '+' : '-' ) );
866 }
867 elsif ( $placeholder->[0] eq '-' ) {
868 substr( $result, $placeholder->[1], $placeholder->[2],
869 ( $number > 0 )
870 ? ''
871 : ( ( $number == 0 ) ? '' : '-' ) );
872 }
873 elsif ( $placeholder->[0] eq '@' ) {
874 substr( $result, $placeholder->[1], $placeholder->[2],
875 $number );
876 }
877 elsif ( $placeholder->[0] eq '*' ) {
878 substr( $result, $placeholder->[1], $placeholder->[2], '' );
879 }
880 elsif (( $placeholder->[0] eq "\xA2\xA4" )
881 or ( $placeholder->[0] eq "\xA2\xA5" )
882 or ( $placeholder->[0] eq "\x81\xA2" )
883 or ( $placeholder->[0] eq "\x81\xA3" ) )
884 {
885 substr(
886 $result, $placeholder->[1],
887 $placeholder->[2], $placeholder->[0]
888 );
889 }
890 elsif (( $placeholder->[0] eq '(' )
891 or ( $placeholder->[0] eq ')' ) )
892 {
893 substr(
894 $result, $placeholder->[1],
895 $placeholder->[2], $placeholder->[0]
896 );
897 }
898 else {
899 if ( $number_length > 0 ) {
900 if ( $i <= 0 ) {
901 $replacement =
902 substr( $number_result, 0, $number_length );
903 $number_length = 0;
904 }
905 else {
906 my $real_part_length = length( $placeholder->[0] );
907 if ( $decimal_pos >= 0 ) {
908 my $format = $placeholder->[0];
909 $format =~ s/^#+//;
910 $real_part_length = length $format;
911 $real_part_length =
912 ( $number_length <= $real_part_length )
913 ? $number_length
914 : $real_part_length;
915 }
916 else {
917 $real_part_length =
918 ( $number_length <= $real_part_length )
919 ? $number_length
920 : $real_part_length;
921 }
922 $replacement =
923 substr( $number_result,
924 $number_length - $real_part_length,
925 $real_part_length );
926 $number_length -= $real_part_length;
927 }
928 }
929 else {
930 $replacement = '';
931 }
932 substr( $result, $placeholder->[1], $placeholder->[2],
933 "\x00" . $replacement );
934 }
935 }
936 $replacement =
937 ( $number_length > 0 )
938 ? substr( $number_result, 0, $number_length )
939 : '';
940 $result =~ s/\x00/$replacement/;
941 $result =~ s/\x00//g;
942 }
943 }
944 else {
945
946 # Process text formats
947 my $is_text = 0;
948 for ( my $i = @placeholders - 1 ; $i >= 0 ; $i-- ) {
949 my $placeholder = $placeholders[$i];
950 if ( $placeholder->[0] eq '@' ) {
951 substr( $result, $placeholder->[1], $placeholder->[2],
952 $number );
953 $is_text++;
954 }
955 else {
956 substr( $result, $placeholder->[1], $placeholder->[2], '' );
957 }
958 }
959
960 $result = $number unless $is_text;
961
962 } # End of placeholder substitutions.
963
964 # Trim the leading and trailing whitespace from the results.
965 $result =~ s/^\s+//;
966 $result =~ s/\s+$//;
967
968 # Fix for negative currency.
969 $result =~ s/^\$\-/\-\$/;
970 $result =~ s/^\$ \-/\-\$ /;
971
972 # Return color and locale strings if required.
973 if ($want_subformats) {
974 return ( $result, $color, $locale );
975 }
976 else {
977 return $result;
978 }
979}
980
981#------------------------------------------------------------------------------
982# AddComma (for Spreadsheet::ParseExcel::Utility)
983#------------------------------------------------------------------------------
984sub AddComma {
985 my ($sNum) = @_;
986
987 if ( $sNum =~ /^([^\d]*)(\d\d\d\d+)(\.*.*)$/ ) {
988 my ( $sPre, $sObj, $sAft ) = ( $1, $2, $3 );
989 for ( my $i = length($sObj) - 3 ; $i > 0 ; $i -= 3 ) {
990 substr( $sObj, $i, 0, ',' );
991 }
992 return $sPre . $sObj . $sAft;
993 }
994 else {
995 return $sNum;
996 }
997}
998
999#------------------------------------------------------------------------------
1000# MakeFraction (for Spreadsheet::ParseExcel::Utility)
1001#------------------------------------------------------------------------------
1002sub MakeFraction {
1003 my ( $sFmt, $iData, $iFlg ) = @_;
1004 my $iBunbo;
1005 my $iShou;
1006
1007 #1. Init
1008 # print "FLG: $iFlg\n";
1009 if ($iFlg) {
1010 $iShou = $iData - int($iData);
1011 return '' if ( $iShou == 0 );
1012 }
1013 else {
1014 $iShou = $iData;
1015 }
1016 $iShou = abs($iShou);
1017 my $sSWk;
1018
1019 #2.Calc BUNBO
1020 #2.1 BUNBO defined
1021 if ( $sFmt =~ /\/(\d+)$/ ) {
1022 $iBunbo = $1;
1023 return sprintf( "%d/%d", $iShou * $iBunbo, $iBunbo );
1024 }
1025 else {
1026
1027 #2.2 Calc BUNBO
1028 $sFmt =~ /\/(\?+)$/;
1029 my $iKeta = length($1);
1030 my $iSWk = 1;
1031 my $sSWk = '';
1032 my $iBunsi;
1033 for ( my $iBunbo = 2 ; $iBunbo < 10**$iKeta ; $iBunbo++ ) {
1034 $iBunsi = int( $iShou * $iBunbo + 0.5 );
1035 my $iCmp = abs( $iShou - ( $iBunsi / $iBunbo ) );
1036 if ( $iCmp < $iSWk ) {
1037 $iSWk = $iCmp;
1038 $sSWk = sprintf( "%d/%d", $iBunsi, $iBunbo );
1039 last if ( $iSWk == 0 );
1040 }
1041 }
1042 return $sSWk;
1043 }
1044}
1045
1046#------------------------------------------------------------------------------
1047# MakeE (for Spreadsheet::ParseExcel::Utility)
1048#------------------------------------------------------------------------------
1049sub MakeE {
1050 my ( $sFmt, $iData ) = @_;
1051
1052 $sFmt =~ /(([#0]*)[\.]?[#0]*)([eE])([\+\-][0#]+)/;
1053 my ( $sKari, $iKeta, $sE, $sSisu ) = ( $1, length($2), $3, $4 );
1054 $iKeta = 1 if ( $iKeta <= 0 );
1055
1056 my $iLog10 = 0;
1057 $iLog10 = ( $iData == 0 ) ? 0 : ( log( abs($iData) ) / log(10) );
1058 $iLog10 = (
1059 int( $iLog10 / $iKeta ) +
1060 ( ( ( $iLog10 - int( $iLog10 / $iKeta ) ) < 0 ) ? -1 : 0 ) ) * $iKeta;
1061
1062 my $sUe = ExcelFmt( $sKari, $iData * ( 10**( $iLog10 * -1 ) ), 0 );
1063 my $sShita = ExcelFmt( $sSisu, $iLog10, 0 );
1064 return $sUe . $sE . $sShita;
1065}
1066
1067#------------------------------------------------------------------------------
1068# LeapYear (for Spreadsheet::ParseExcel::Utility)
1069#------------------------------------------------------------------------------
1070sub LeapYear {
1071 my ($iYear) = @_;
1072 return 1 if ( $iYear == 1900 ); #Special for Excel
1073 return ( ( ( $iYear % 4 ) == 0 )
1074 && ( ( $iYear % 100 ) || ( $iYear % 400 ) == 0 ) )
1075 ? 1
1076 : 0;
1077}
1078
1079#------------------------------------------------------------------------------
1080# LocaltimeExcel (for Spreadsheet::ParseExcel::Utility)
1081#------------------------------------------------------------------------------
1082sub LocaltimeExcel {
1083 my ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec, $flg1904 )
1084 = @_;
1085
1086 #0. Init
1087 $iMon++;
1088 $iYear += 1900;
1089
1090 #1. Calc Time
1091 my $iTime;
1092 $iTime = $iHour;
1093 $iTime *= 60;
1094 $iTime += $iMin;
1095 $iTime *= 60;
1096 $iTime += $iSec;
1097 $iTime += $iMSec / 1000.0 if ( defined($iMSec) );
1098 $iTime /= 86400.0; #3600*24(1day in seconds)
1099 my $iY;
1100 my $iYDays;
1101
1102 #2. Calc Days
1103 if ($flg1904) {
1104 $iY = 1904;
1105 $iTime--; #Start from Jan 1st
1106 $iYDays = 366;
1107 }
1108 else {
1109 $iY = 1900;
1110 $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!)
1111 }
1112 while ( $iY < $iYear ) {
1113 $iTime += $iYDays;
1114 $iY++;
1115 $iYDays = ( LeapYear($iY) ) ? 366 : 365;
1116 }
1117 for ( my $iM = 1 ; $iM < $iMon ; $iM++ ) {
1118 if ( $iM == 1
1119 || $iM == 3
1120 || $iM == 5
1121 || $iM == 7
1122 || $iM == 8
1123 || $iM == 10
1124 || $iM == 12 )
1125 {
1126 $iTime += 31;
1127 }
1128 elsif ( $iM == 4 || $iM == 6 || $iM == 9 || $iM == 11 ) {
1129 $iTime += 30;
1130 }
1131 elsif ( $iM == 2 ) {
1132 $iTime += ( LeapYear($iYear) ) ? 29 : 28;
1133 }
1134 }
1135 $iTime += $iDay;
1136 return $iTime;
1137}
1138
11391800nsmy @month_days = qw(
1140 0 31 28 31 30 31 30 31 31 30 31 30 31
1141);
1142
1143#------------------------------------------------------------------------------
1144# ExcelLocaltime (for Spreadsheet::ParseExcel::Utility)
1145#------------------------------------------------------------------------------
1146sub ExcelLocaltime {
1147
1148 my ( $dObj, $flg1904 ) = @_;
1149 my ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec );
1150 my ( $iDt, $iTime, $iYDays, $iMD );
1151
1152 $iDt = int($dObj);
1153 $iTime = $dObj - $iDt;
1154
1155 #1. Calc Days
1156 if ($flg1904) {
1157 $iYear = 1904;
1158 $iDt++; #Start from Jan 1st
1159 $iYDays = 366;
1160 $iwDay = ( ( $iDt + 4 ) % 7 );
1161 }
1162 else {
1163 $iYear = 1900;
1164 $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!)
1165 $iwDay = ( ( $iDt + 6 ) % 7 );
1166 }
1167 while ( $iDt > $iYDays ) {
1168 $iDt -= $iYDays;
1169 $iYear++;
1170 $iYDays =
1171 ( ( ( $iYear % 4 ) == 0 )
1172 && ( ( $iYear % 100 ) || ( $iYear % 400 ) == 0 ) ) ? 366 : 365;
1173 }
1174 $iYear -= 1900; # Localtime year is relative to 1900.
1175
1176 for ( $iMon = 1 ; $iMon <= 12 ; $iMon++ ) {
1177 $iMD = $month_days[$iMon];
1178 $iMD++ if $iMon == 2 and $iYear % 4 == 0;
1179
1180 last if ( $iDt <= $iMD );
1181 $iDt -= $iMD;
1182 }
1183
1184 #2. Calc Time
1185 $iDay = $iDt;
1186 $iTime += ( 0.0005 / 86400.0 );
1187 if ($iTime >= 1.0)
1188 {
1189 $iTime -= int($iTime);
1190 $iwDay = ($iwDay == 6) ? 0 : $iwDay + 1;
1191 if ($iDay == $iMD)
1192 {
1193 if ($iMon == 12)
1194 {
1195 $iMon = 1;
1196 $iYear++;
1197 }
1198 else
1199 {
1200 $iMon++;
1201 }
1202 $iDay = 1;
1203 }
1204 else
1205 {
1206 $iDay++;
1207 }
1208 }
1209
1210 # Localtime month is 0 based.
1211 $iMon -= 1;
1212 $iTime *= 24.0;
1213 $iHour = int($iTime);
1214 $iTime -= $iHour;
1215 $iTime *= 60.0;
1216 $iMin = int($iTime);
1217 $iTime -= $iMin;
1218 $iTime *= 60.0;
1219 $iSec = int($iTime);
1220 $iTime -= $iSec;
1221 $iTime *= 1000.0;
1222 $iMSec = int($iTime);
1223
1224 return ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec );
1225}
1226
1227# -----------------------------------------------------------------------------
1228# col2int (for Spreadsheet::ParseExcel::Utility)
1229#------------------------------------------------------------------------------
1230# converts a excel row letter into an int for use in an array
1231sub col2int {
1232 my $result = 0;
1233 my $str = shift;
1234 my $incr = 0;
1235
1236 for ( my $i = length($str) ; $i > 0 ; $i-- ) {
1237 my $char = substr( $str, $i - 1 );
1238 my $curr += ord( lc($char) ) - ord('a') + 1;
1239 $curr *= $incr if ($incr);
1240 $result += $curr;
1241 $incr += 26;
1242 }
1243
1244 # this is one out as we range 0..x-1 not 1..x
1245 $result--;
1246
1247 return $result;
1248}
1249
1250# -----------------------------------------------------------------------------
1251# int2col (for Spreadsheet::ParseExcel::Utility)
1252#------------------------------------------------------------------------------
1253### int2col
1254# convert a column number into column letters
1255# @note this is quite a brute force coarse method
1256# does not manage values over 701 (ZZ)
1257# @arg number, to convert
1258# @returns string, column name
1259#
1260sub int2col {
1261 my $out = "";
1262 my $val = shift;
1263
1264 do {
1265 $out .= chr( ( $val % 26 ) + ord('A') );
1266 $val = int( $val / 26 ) - 1;
1267 } while ( $val >= 0 );
1268
1269 return scalar reverse $out;
1270}
1271
1272# -----------------------------------------------------------------------------
1273# sheetRef (for Spreadsheet::ParseExcel::Utility)
1274#------------------------------------------------------------------------------
1275# -----------------------------------------------------------------------------
1276### sheetRef
1277# convert an excel letter-number address into a useful array address
1278# @note that also Excel uses X-Y notation, we normally use Y-X in arrays
1279# @args $str, excel coord eg. A2
1280# @returns an array - 2 elements - column, row, or undefined
1281#
1282sub sheetRef {
1283 my $str = shift;
1284 my @ret;
1285
1286 $str =~ m/^(\D+)(\d+)$/;
1287
1288 if ( $1 && $2 ) {
1289 push( @ret, $2 - 1, col2int($1) );
1290 }
1291 if ( $ret[0] < 0 ) {
1292 undef @ret;
1293 }
1294
1295 return @ret;
1296}
1297
1298# -----------------------------------------------------------------------------
1299# xls2csv (for Spreadsheet::ParseExcel::Utility)
1300#------------------------------------------------------------------------------
1301### xls2csv
1302# convert a chunk of an excel file into csv text chunk
1303# @args $param, sheet-colrow:colrow (1-A1:B2 or A1:B2 for sheet 1
1304# @args $rotate, 0 or 1 decides if output should be rotated or not
1305# @returns string containing a chunk of csv
1306#
1307sub xls2csv {
1308 my ( $filename, $regions, $rotate ) = @_;
1309 my $sheet = 0;
1310
1311 # We need Text::CSV_XS for proper CSV handling.
1312 require Text::CSV_XS;
1313
1314 # extract any sheet number from the region string
1315 $regions =~ m/^(\d+)-(.*)/;
1316
1317 if ($2) {
1318 $sheet = $1 - 1;
1319 $regions = $2;
1320 }
1321
1322 # now extract the start and end regions
1323 $regions =~ m/(.*):(.*)/;
1324
1325 if ( !$1 || !$2 ) {
1326 print STDERR "Bad Params";
1327 return "";
1328 }
1329
1330 my @start = sheetRef($1);
1331 my @end = sheetRef($2);
1332 if ( !@start ) {
1333 print STDERR "Bad coorinates - $1";
1334 return "";
1335 }
1336 if ( !@end ) {
1337 print STDERR "Bad coorinates - $2";
1338 return "";
1339 }
1340
1341 if ( $start[1] > $end[1] ) {
1342 print STDERR "Bad COLUMN ordering\n";
1343 print STDERR "Start column " . int2col( $start[1] );
1344 print STDERR " after end column " . int2col( $end[1] ) . "\n";
1345 return "";
1346 }
1347 if ( $start[0] > $end[0] ) {
1348 print STDERR "Bad ROW ordering\n";
1349 print STDERR "Start row " . ( $start[0] + 1 );
1350 print STDERR " after end row " . ( $end[0] + 1 ) . "\n";
1351 exit;
1352 }
1353
1354 # start the excel object now
1355 my $oExcel = new Spreadsheet::ParseExcel;
1356 my $oBook = $oExcel->Parse($filename);
1357
1358 # open the sheet
1359 my $oWkS = $oBook->{Worksheet}[$sheet];
1360
1361 # now check that the region exists in the file
1362 # if not truncate to the possible region
1363 # output a warning msg
1364 if ( $start[1] < $oWkS->{MinCol} ) {
1365 print STDERR int2col( $start[1] )
1366 . " < min col "
1367 . int2col( $oWkS->{MinCol} )
1368 . " Resetting\n";
1369 $start[1] = $oWkS->{MinCol};
1370 }
1371 if ( $end[1] > $oWkS->{MaxCol} ) {
1372 print STDERR int2col( $end[1] )
1373 . " > max col "
1374 . int2col( $oWkS->{MaxCol} )
1375 . " Resetting\n";
1376 $end[1] = $oWkS->{MaxCol};
1377 }
1378 if ( $start[0] < $oWkS->{MinRow} ) {
1379 print STDERR ""
1380 . ( $start[0] + 1 )
1381 . " < min row "
1382 . ( $oWkS->{MinRow} + 1 )
1383 . " Resetting\n";
1384 $start[0] = $oWkS->{MinCol};
1385 }
1386 if ( $end[0] > $oWkS->{MaxRow} ) {
1387 print STDERR ""
1388 . ( $end[0] + 1 )
1389 . " > max row "
1390 . ( $oWkS->{MaxRow} + 1 )
1391 . " Resetting\n";
1392 $end[0] = $oWkS->{MaxRow};
1393
1394 }
1395
1396 my $x1 = $start[1];
1397 my $y1 = $start[0];
1398 my $x2 = $end[1];
1399 my $y2 = $end[0];
1400
1401 my @cell_data;
1402 my $row = 0;
1403
1404 if ( !$rotate ) {
1405 for ( my $y = $y1 ; $y <= $y2 ; $y++ ) {
1406 for ( my $x = $x1 ; $x <= $x2 ; $x++ ) {
1407 my $cell = $oWkS->{Cells}[$y][$x];
1408
1409 my $value;
1410 if ( defined $cell ) {
1411 $value .= $cell->value();
1412 }
1413 else {
1414 $value = '';
1415 }
1416
1417 push @{ $cell_data[$row] }, $value;
1418 }
1419 $row++;
1420 }
1421 }
1422 else {
1423 for ( my $x = $x1 ; $x <= $x2 ; $x++ ) {
1424 for ( my $y = $y1 ; $y <= $y2 ; $y++ ) {
1425 my $cell = $oWkS->{Cells}[$y][$x];
1426
1427 my $value;
1428 if ( defined $cell ) {
1429 $value .= $cell->value();
1430 }
1431 else {
1432 $value = '';
1433 }
1434
1435 push @{ $cell_data[$row] }, $value;
1436 }
1437 $row++;
1438 }
1439 }
1440
1441 # Create the CSV output string.
1442 my $csv = Text::CSV_XS->new( { binary => 1, eol => $/ } );
1443 my $output = "";
1444
1445 for my $row (@cell_data) {
1446 $csv->combine(@$row);
1447 $output .= $csv->string();
1448 }
1449
1450 return $output;
1451}
1452
145314µs1;
1454
1455__END__