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