File Coverage

blib/lib/Spreadsheet/ParseExcel/Utility.pm
Criterion Covered Total %
statement 415 555 74.7
branch 279 380 73.4
condition 125 180 69.4
subroutine 13 15 86.6
pod 7 11 63.6
total 839 1141 73.5


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