File Coverage

blib/lib/Spreadsheet/XLSX/Utility2007.pm
Criterion Covered Total %
statement 226 505 44.7
branch 156 370 42.1
condition 80 189 42.3
subroutine 7 15 46.6
pod 7 12 58.3
total 476 1091 43.6


line stmt bran cond sub pod time code
1             # This code is adapted for Excel 2007 from:
2             # Spreadsheet::XLSX::Utility
3             # by Kawai, Takanori (Hippo2000) 2001.2.2
4             # This Program is ALPHA version.
5             #==============================================================================
6             # Spreadsheet::XLSX::Utility2007;
7             #==============================================================================
8             package Spreadsheet::XLSX::Utility2007;
9 6     6   56 use strict;
  6         17  
  6         184  
10 6     6   34 use warnings;
  6         13  
  6         213  
11              
12             require Exporter;
13 6     6   33 use vars qw(@ISA @EXPORT_OK);
  6         14  
  6         37186  
14             @ISA = qw(Exporter);
15             @EXPORT_OK = qw(ExcelFmt LocaltimeExcel ExcelLocaltime col2int int2col sheetRef xls2csv);
16             our $VERSION = '0.16';
17              
18             my $sNUMEXP = '(^[+-]?\d+(\.\d+)?$)|(^[+-]?\d+\.?(\d*)[eE][+-](\d+))$';
19              
20             #------------------------------------------------------------------------------
21             # ExcelFmt (for Spreadsheet::XLSX::Utility2007)
22             #------------------------------------------------------------------------------
23             sub ExcelFmt {
24 1782     1782 1 3781 my ($sFmt, $iData, $i1904, $sType) = @_;
25 1782         2892 my $sCond;
26 1782         4393 my $sWkF = '';
27 1782         2529 my $sRes = '';
28 1782         3105 $sFmt = unescape_HTML($sFmt);
29              
30             #1. Get Condition
31 1782 50       4027 if ($sFmt =~ /^\[([<>=][^\]]+)\](.*)$/) {
32 0         0 $sCond = $1;
33 0         0 $sFmt = $2;
34             }
35 1782         3043 $sFmt =~ s/_/ /g;
36              
37 1782         2872 my @sFmtWk;
38             my $sFmtObj;
39 1782         2424 my $iFmtPos = 0;
40 1782         2560 my $iDblQ = 0;
41 1782         2642 my $iQ = 0;
42 1782         5402 foreach my $sWk (split //, $sFmt) {
43 4964 50 33     13918 if ($iDblQ or $iQ) {
44 0         0 $sFmtWk[$iFmtPos] .= $sWk;
45 0 0       0 $iDblQ = 0 if ($sWk eq '"');
46 0         0 $iQ = 0;
47 0         0 next;
48             }
49              
50 4964 100       15659 if ($sWk eq ';') {
    50          
    50          
    50          
    50          
    50          
51 1         2 $iFmtPos++;
52 1         4 next;
53             } elsif ($sWk eq '"') {
54 0         0 $iDblQ = 1;
55             } elsif ($sWk eq '!') {
56 0         0 $iQ = 1;
57             } elsif ($sWk eq '\\') {
58 0         0 $iQ = 1;
59              
60             # next;
61             } elsif ($sWk eq '(') { #Skip?
62 0         0 next;
63             } elsif ($sWk eq ')') { #Skip?
64 0         0 next;
65             }
66 4963         9281 $sFmtWk[$iFmtPos] .= $sWk;
67             }
68              
69             #Get FmtString
70 1782 100       4172 if (scalar(@sFmtWk) > 1) {
71 1 50       4 if ($sCond) {
72 0 0       0 $sFmtObj = $sFmtWk[((eval(qq/"$iData" $sCond/)) ? 0 : 1)];
73             } else {
74 1 50       74 my $iWk = ($iData =~ /$sNUMEXP/) ? $iData : 0;
75              
76             # $iData = abs($iData) if($iWk !=0);
77 1 50       7 if (scalar(@sFmtWk) == 2) {
    0          
78 1 50       9 $sFmtObj = $sFmtWk[(($iWk >= 0) ? 0 : 1)];
79             } elsif (scalar(@sFmtWk) == 3) {
80 0 0       0 $sFmtObj = $sFmtWk[(($iWk > 0) ? 0 : (($iWk < 0) ? 1 : 2))];
    0          
81             } else {
82 0 0       0 if ($iData =~ /$sNUMEXP/) {
83 0 0       0 $sFmtObj = $sFmtWk[(($iWk > 0) ? 0 : (($iWk < 0) ? 1 : 2))];
    0          
84             } else {
85 0         0 $sFmtObj = $sFmtWk[3];
86             }
87             }
88             }
89             } else {
90 1781         3086 $sFmtObj = $sFmtWk[0];
91             }
92 1782         2504 my $sColor;
93 1782 50       3706 if ($sFmtObj =~ /^(\[[^hm\[\]]*\])/) {
94 0         0 $sColor = $1;
95 0         0 $sFmtObj = substr($sFmtObj, length($sColor));
96 0         0 chop($sColor);
97 0         0 $sColor = substr($sColor, 1);
98             }
99              
100             #print "FMT:$sFmtObj Co:$sColor\n";
101              
102             #3.Build Data
103 1782         2537 my $iFmtMode = 0; #1:Number, 2:Date
104 1782         2422 my $i = 0;
105 1782         2346 my $ir = 0;
106 1782         2406 my $sFmtWk;
107 1782         2815 my @aRep = ();
108 1782         2592 my $sFmtRes = '';
109              
110 1782         2357 my $iFflg = -1;
111 1782         2305 my $iRpos = -1;
112 1782         2333 my $iCmmCnt = 0;
113 1782         2401 my $iBunFlg = 0;
114 1782         2246 my $iFugouFlg = 0;
115 1782         2248 my $iPer = 0;
116 1782         2586 my $iAm = 0;
117 1782         2426 my $iSt;
118              
119 1782         3465 while ($i < length($sFmtObj)) {
120 4314         5623 $iSt = $i;
121 4314         7210 my $sWk = substr($sFmtObj, $i, 1);
122              
123 4314 100       10536 if ($sWk !~ /[#0\+\-\.\?eE\,\%]/) {
124 842 50       1677 if ($iFflg != -1) {
125 0         0 push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg), $iRpos, $i - $iFflg];
126 0         0 $iFflg = -1;
127             }
128             }
129              
130 4314 50       10743 if ($sWk eq '"') {
    50          
    50          
131 0 0       0 $iDblQ = $iDblQ ? 0 : 1;
132 0         0 $i++;
133 0         0 next;
134             } elsif ($sWk eq '!') {
135 0         0 $iQ = 1;
136 0         0 $i++;
137 0         0 next;
138             } elsif ($sWk eq '\\') {
139 0 0       0 if ($iQ == 1) {
140             } else {
141 0         0 $iQ = 1;
142 0         0 $i++;
143 0         0 next;
144             }
145             }
146              
147             #print "WK:", ord($sWk), " $iFmtMode \n";
148             #print "DEF1: $iDblQ DEF2: $iQ\n";
149 4314 50 33     28539 if ((defined($iDblQ) and ($iDblQ)) or (defined($iQ) and ($iQ))) {
    100 33        
    100 33        
    50 33        
    50 66        
    100 66        
    50          
150 0         0 $iQ = 0;
151 0 0 0     0 if (
      0        
152             ($iFmtMode != 2)
153             and ( (substr($sFmtObj, $i, 2) eq "\x81\xA2")
154             || (substr($sFmtObj, $i, 2) eq "\x81\xA3")
155             || (substr($sFmtObj, $i, 2) eq "\xA2\xA4")
156             || (substr($sFmtObj, $i, 2) eq "\xA2\xA5"))
157             ) {
158             #print "PUSH:", unpack("H*", substr($sFmtObj, $i, 2)), "\n";
159 0         0 push @aRep, [substr($sFmtObj, $i, 2), length($sFmtRes), 2];
160 0         0 $iFugouFlg = 1;
161 0         0 $i += 2;
162             } else {
163 0         0 $i++;
164             }
165             } elsif (
166             ($sWk =~ /[#0\+\.\?eE\,\%]/)
167             || ( ($iFmtMode != 2)
168             and (($sWk eq '-') || ($sWk eq '(') || ($sWk eq ')')))
169             ) {
170 3470 100       6521 $iFmtMode = 1 unless ($iFmtMode);
171 3470 100       9029 if (substr($sFmtObj, $i, 1) =~ /[#0]/) {
    50          
    50          
172 2752 100       6593 if (substr($sFmtObj, $i) =~ /^([#0]+)([\.]?)([0#]*)([eE])([\+\-])([0#]+)/) {
173 80         390 push @aRep, [substr($sFmtObj, $i, length($&)), $i, length($&)];
174 80         200 $i += length($&);
175             } else {
176 2672 100       5000 if ($iFflg == -1) {
177 1501         1987 $iFflg = $i;
178 1501         2098 $iRpos = length($sFmtRes);
179             }
180             }
181             } elsif (substr($sFmtObj, $i, 1) eq '?') {
182 0 0       0 if ($iFflg != -1) {
183 0         0 push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg + 1), $iRpos, $i - $iFflg + 1];
184             }
185 0         0 $iFflg = $i;
186 0         0 while ($i < length($sFmtObj)) {
187 0 0       0 if (substr($sFmtObj, $i, 1) eq '/') {
    0          
188 0         0 $iBunFlg = 1;
189             } elsif (substr($sFmtObj, $i, 1) eq '?') {
190             ;
191             } else {
192 0 0 0     0 if (($iBunFlg) && (substr($sFmtObj, $i, 1) =~ /[0-9]/)) {
193             ;
194             } else {
195 0         0 last;
196             }
197             }
198 0         0 $i++;
199             }
200 0         0 $i--;
201 0         0 push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg + 1), length($sFmtRes), $i - $iFflg + 1];
202 0         0 $iFflg = -1;
203             } elsif (substr($sFmtObj, $i, 3) =~ /^[eE][\+\-][0#]$/) {
204 0 0       0 if (substr($sFmtObj, $i) =~ /([eE])([\+\-])([0#]+)/) {
205 0         0 push @aRep, [substr($sFmtObj, $i, length($&)), $i, length($&)];
206 0         0 $i += length($&);
207             }
208 0         0 $iFflg = -1;
209             } else {
210 718 100       1434 if ($iFflg != -1) {
211 638         1954 push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg), $iRpos, $i - $iFflg];
212 638         1140 $iFflg = -1;
213             }
214 718 100 0     2049 if (substr($sFmtObj, $i, 1) =~ /[\+\-]/) {
    100          
    50          
    50          
    0          
215 80         248 push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1];
216 80         150 $iFugouFlg = 1;
217             } elsif (substr($sFmtObj, $i, 1) eq '.') {
218 637         1818 push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1];
219             } elsif (substr($sFmtObj, $i, 1) eq ',') {
220 0         0 $iCmmCnt++;
221 0         0 push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1];
222             } elsif (substr($sFmtObj, $i, 1) eq '%') {
223 1         3 $iPer = 1;
224             } elsif ((substr($sFmtObj, $i, 1) eq '(')
225             || (substr($sFmtObj, $i, 1) eq ')')) {
226 0         0 push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1];
227 0         0 $iFugouFlg = 1;
228             }
229             }
230 3470         5038 $i++;
231             } elsif ($sWk =~ /[ymdhsapg]/) {
232 5 100       13 $iFmtMode = 2 unless ($iFmtMode);
233 5 50 33     113 if (substr($sFmtObj, $i, 5) =~ /am\/pm/i) {
    50 66        
    50 66        
    100 33        
    50 66        
    100 100        
    50 66        
      66        
      33        
      33        
      33        
      33        
234 0         0 push @aRep, ['am/pm', length($sFmtRes), 5];
235 0         0 $iAm = 1;
236 0         0 $i += 5;
237             } elsif (substr($sFmtObj, $i, 3) =~ /a\/p/i) {
238 0         0 push @aRep, ['a/p', length($sFmtRes), 3];
239 0         0 $iAm = 1;
240 0         0 $i += 3;
241             } elsif (substr($sFmtObj, $i, 5) eq 'mmmmm') {
242 0         0 push @aRep, ['mmmmm', length($sFmtRes), 5];
243 0         0 $i += 5;
244             } elsif ((substr($sFmtObj, $i, 4) eq 'mmmm')
245             || (substr($sFmtObj, $i, 4) eq 'dddd')
246             || (substr($sFmtObj, $i, 4) eq 'yyyy')
247             || (substr($sFmtObj, $i, 4) eq 'ggge')) {
248 1         6 push @aRep, [substr($sFmtObj, $i, 4), length($sFmtRes), 4];
249 1         4 $i += 4;
250             } elsif ((substr($sFmtObj, $i, 3) eq 'mmm')
251             || (substr($sFmtObj, $i, 3) eq 'yyy')) {
252 0         0 push @aRep, [substr($sFmtObj, $i, 3), length($sFmtRes), 3];
253 0         0 $i += 3;
254             } elsif ((substr($sFmtObj, $i, 2) eq 'yy')
255             || (substr($sFmtObj, $i, 2) eq 'mm')
256             || (substr($sFmtObj, $i, 2) eq 'dd')
257             || (substr($sFmtObj, $i, 2) eq 'hh')
258             || (substr($sFmtObj, $i, 2) eq 'ss')
259             || (substr($sFmtObj, $i, 2) eq 'ge')) {
260 3 100 66     24 if ( (substr($sFmtObj, $i, 2) eq 'mm')
      66        
      100        
261             && ($#aRep >= 0)
262             && (($aRep[$#aRep]->[0] eq 'h') or ($aRep[$#aRep]->[0] eq 'hh'))) {
263 1         4 push @aRep, ['mm', length($sFmtRes), 2, 'min'];
264             } else {
265 2         5 push @aRep, [substr($sFmtObj, $i, 2), length($sFmtRes), 2];
266             }
267 3 50 33     11 if ((substr($sFmtObj, $i, 2) eq 'ss') && ($#aRep > 0)) {
268 0 0 0     0 if ( ($aRep[$#aRep - 1]->[0] eq 'm')
269             || ($aRep[$#aRep - 1]->[0] eq 'mm')) {
270 0         0 push(@{$aRep[$#aRep - 1]}, 'min');
  0         0  
271             }
272             }
273 3         5 $i += 2;
274             } elsif ((substr($sFmtObj, $i, 1) eq 'm')
275             || (substr($sFmtObj, $i, 1) eq 'd')
276             || (substr($sFmtObj, $i, 1) eq 'h')
277             || (substr($sFmtObj, $i, 1) eq 's')) {
278 1 50 33     9 if ( (substr($sFmtObj, $i, 1) eq 'm')
      0        
      33        
279             && ($#aRep >= 0)
280             && (($aRep[$#aRep]->[0] eq 'h') or ($aRep[$#aRep]->[0] eq 'hh'))) {
281 0         0 push @aRep, ['m', length($sFmtRes), 1, 'min'];
282             } else {
283 1         5 push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1];
284             }
285 1 50 33     5 if ((substr($sFmtObj, $i, 1) eq 's') && ($#aRep > 0)) {
286 0 0 0     0 if ( ($aRep[$#aRep - 1]->[0] eq 'm')
287             || ($aRep[$#aRep - 1]->[0] eq 'mm')) {
288 0         0 push(@{$aRep[$#aRep - 1]}, 'min');
  0         0  
289             }
290             }
291 1         3 $i += 1;
292             }
293             } elsif ((substr($sFmtObj, $i, 3) eq '[h]')) {
294 0         0 push @aRep, ['[h]', length($sFmtRes), 3];
295 0         0 $i += 3;
296             } elsif ((substr($sFmtObj, $i, 4) eq '[mm]')) {
297 0         0 push @aRep, ['[mm]', length($sFmtRes), 4];
298 0         0 $i += 4;
299             } elsif ($sWk eq '@') {
300 836         2653 push @aRep, ['@', length($sFmtRes), 1];
301 836         1485 $i++;
302             } elsif ($sWk eq '*') {
303 0         0 push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1];
304             } else {
305 3         4 $i++;
306             }
307 4314 50       7704 $i++ if ($i == $iSt); #No Format match
308 4314         10798 $sFmtRes .= substr($sFmtObj, $iSt, $i - $iSt);
309             }
310              
311             #print "FMT: $iRpos ",$sFmtRes, "\n";
312 1782 100       3323 if ($iFflg != -1) {
313 863         2784 push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg + 1), $iRpos,, $i - $iFflg + 1];
314 863         1695 $iFflg = 0;
315             }
316              
317             #For Date format
318 1782 100 100     5362 $iFmtMode = 0 if (defined $sType && $sType eq 'Text'); #Not Convert Non Numeric
319 1782 100 66     10583 if (($iFmtMode == 2) && ($iData =~ /$sNUMEXP/)) {
    100 66        
320 2         14 my @aTime = ExcelLocaltime($iData, $i1904);
321 2         3 $aTime[4]++;
322 2         4 $aTime[5] += 1900;
323              
324 2         19 my @aMonL = qw (dum January February March April May June July
325             August September October November December );
326 2         8 my @aMonNm = qw (dum Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
327 2         6 my @aWeekNm = qw (Mon Tue Wed Thu Fri Sat Sun);
328 2         7 my @aWeekL = qw (Monday Tuesday Wednesday Thursday Friday Saturday Sunday);
329 2         4 my $sRep;
330 2         10 for (my $iIt = $#aRep ; $iIt >= 0 ; $iIt--) {
331 5         10 my $rItem = $aRep[$iIt];
332 5 100       58 if ((scalar @$rItem) >= 4) {
    100          
    50          
    50          
    50          
    50          
    100          
    50          
    50          
    50          
    100          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
333              
334             #Min
335 1 50       4 if ($rItem->[0] eq 'mm') {
336 1         7 $sRep = sprintf("%02d", $aTime[1]);
337             } else {
338 0         0 $sRep = sprintf("%d", $aTime[1]);
339             }
340             }
341              
342             #Year
343             elsif ($rItem->[0] eq 'yyyy') {
344 1         5 $sRep = sprintf('%04d', $aTime[5]);
345             } elsif ($rItem->[0] eq 'yy') {
346 0         0 $sRep = sprintf('%02d', $aTime[5] % 100);
347             }
348              
349             #Mon
350             elsif ($rItem->[0] eq 'mmmmm') {
351 0         0 $sRep = substr($aMonNm[$aTime[4]], 0, 1);
352             } elsif ($rItem->[0] eq 'mmmm') {
353 0         0 $sRep = $aMonL[$aTime[4]];
354             } elsif ($rItem->[0] eq 'mmm') {
355 0         0 $sRep = $aMonNm[$aTime[4]];
356             } elsif ($rItem->[0] eq 'mm') {
357 1         29 $sRep = sprintf('%02d', $aTime[4]);
358             } elsif ($rItem->[0] eq 'm') {
359 0         0 $sRep = sprintf('%d', $aTime[4]);
360             }
361              
362             #Day
363             elsif ($rItem->[0] eq 'dddd') {
364 0         0 $sRep = $aWeekL[$aTime[7]];
365             } elsif ($rItem->[0] eq 'ddd') {
366 0         0 $sRep = $aWeekNm[$aTime[7]];
367             } elsif ($rItem->[0] eq 'dd') {
368 1         9 $sRep = sprintf('%02d', $aTime[3]);
369             } elsif ($rItem->[0] eq 'd') {
370 0         0 $sRep = sprintf('%d', $aTime[3]);
371             }
372              
373             #Hour
374             elsif ($rItem->[0] eq 'hh') {
375 0 0       0 if ($iAm) {
376 0         0 $sRep = sprintf('%02d', $aTime[2] % 12);
377             } else {
378 0         0 $sRep = sprintf('%02d', $aTime[2]);
379             }
380             } elsif ($rItem->[0] eq 'h') {
381 1 50       5 if ($iAm) {
382 0         0 $sRep = sprintf('%d', $aTime[2] % 12);
383             } else {
384 1         5 $sRep = sprintf('%d', $aTime[2]);
385             }
386             }
387              
388             #SS
389             elsif ($rItem->[0] eq 'ss') {
390 0         0 $sRep = sprintf('%02d', $aTime[0]);
391             } elsif ($rItem->[0] eq 'S') {
392 0         0 $sRep = sprintf('%d', $aTime[0]);
393             }
394              
395             #am/pm
396             elsif ($rItem->[0] eq 'am/pm') {
397 0 0       0 $sRep = ($aTime[4] > 12) ? 'pm' : 'am';
398             } elsif ($rItem->[0] eq 'a/p') {
399 0 0       0 $sRep = ($aTime[4] > 12) ? 'p' : 'a';
400             } elsif ($rItem->[0] eq '.') {
401 0         0 $sRep = '.';
402             } elsif ($rItem->[0] =~ /^0+$/) {
403 0         0 my $i0Len = length($&);
404              
405             #print "SEC:", $aTime[7], "\n";
406 0         0 $sRep = substr(sprintf("%.${i0Len}f", $aTime[7] / 1000.0), 2, $i0Len);
407             } elsif ($rItem->[0] eq '[h]') {
408 0         0 $sRep = sprintf('%d', int($iData) * 24 + $aTime[2]);
409             } elsif ($rItem->[0] eq '[mm]') {
410 0         0 $sRep = sprintf('%d', (int($iData) * 24 + $aTime[2]) * 60 + $aTime[1]);
411             }
412              
413             #NENGO(Japanese)
414             elsif ($rItem->[0] eq 'ge') {
415 0         0 $sRep = Spreadsheet::XLSX::FmtJapan::CnvNengo(1, @aTime);
416             } elsif ($rItem->[0] eq 'ggge') {
417 0         0 $sRep = Spreadsheet::XLSX::FmtJapan::CnvNengo(2, @aTime);
418             } elsif ($rItem->[0] eq '@') {
419 0         0 $sRep = $iData;
420             }
421              
422             #print "REP:$sRep ",$rItem->[0], ":", $rItem->[1], ":" ,$rItem->[2], "\n";
423 5         25 substr($sFmtRes, $rItem->[1], $rItem->[2]) = $sRep;
424             }
425             } elsif (($iFmtMode == 1) && ($iData =~ /$sNUMEXP/)) {
426 944 50       2337 if ($#aRep >= 0) {
427 944         3970 while ($aRep[$#aRep]->[0] eq ',') {
428 0         0 $iCmmCnt--;
429 0         0 substr($sFmtRes, $aRep[$#aRep]->[1], $aRep[$#aRep]->[2]) = '';
430 0         0 $iData /= 1000;
431 0         0 pop @aRep;
432             }
433              
434 944         2062 my $sNumFmt = join('', map {$_->[0]} @aRep);
  2298         6050  
435 944         1656 my $sNumRes;
436 944         1829 my $iTtl = 0;
437 944         1344 my $iE = 0;
438 944         1237 my $iP = 0;
439 944         1356 my $iInt = 0;
440 944         1409 my $iAftP = undef;
441 944         2828 foreach my $sItem (split //, $sNumFmt) {
442 4111 100 66     12485 if ($sItem eq '.') {
    100          
    100          
    50          
    50          
443 717         962 $iTtl++;
444 717         1071 $iP = 1;
445             } elsif (($sItem eq 'E') || ($sItem eq 'e')) {
446 80         123 $iE = 1;
447             } elsif ($sItem eq '0') {
448 3154         4169 $iTtl++;
449 3154 100       5677 $iAftP++ if ($iP);
450 3154         5081 $iInt = 1;
451             } elsif ($sItem eq '#') {
452              
453             #$iTtl++;
454 0 0       0 $iAftP++ if ($iP);
455 0         0 $iInt = 1;
456             } elsif ($sItem eq '?') {
457              
458             #$iTtl++;
459 0 0       0 $iAftP++ if ($iP);
460             }
461             }
462 944 100       2041 $iData *= 100.0 if ($iPer);
463 944 100       2683 my $iDData = ($iFugouFlg) ? abs($iData) : $iData + 0;
464 944 50       1716 if ($iBunFlg) {
465 0         0 $sNumRes = sprintf("%0${iTtl}d", int($iDData));
466             } else {
467 944 100       1875 if ($iP) {
468 717 50       5175 $sNumRes = sprintf((defined($iAftP) ? "%0${iTtl}.${iAftP}f" : "%0${iTtl}f"), $iDData);
469             } else {
470 227         1613 $sNumRes = sprintf("%0${iTtl}.0f", $iDData);
471             }
472             }
473 944 50       2133 $sNumRes = AddComma($sNumRes) if ($iCmmCnt > 0);
474 944         1589 my $iLen = length($sNumRes);
475 944         1267 my $iPPos = -1;
476 944         1251 my $sRep;
477              
478 944         2311 for (my $iIt = $#aRep ; $iIt >= 0 ; $iIt--) {
479 2298         3451 my $rItem = $aRep[$iIt];
480 2298 100 33     17182 if ($rItem->[0] =~ /([#0]*)([\.]?)([0#]*)([eE])([\+\-])([0#]+)/) {
    50 33        
    100 33        
    100 33        
    50          
    50          
    50          
    50          
    50          
481 80         305 substr($sFmtRes, $rItem->[1], $rItem->[2]) =
482             MakeE($rItem->[0], $iData);
483             } elsif ($rItem->[0] =~ /\//) {
484 0         0 substr($sFmtRes, $rItem->[1], $rItem->[2]) =
485             MakeBun($rItem->[0], $iData, $iInt);
486             } elsif ($rItem->[0] eq '.') {
487 637         985 $iLen--;
488 637         1273 $iPPos = $iLen;
489             } elsif ($rItem->[0] eq '+') {
490 80 50       349 substr($sFmtRes, $rItem->[1], $rItem->[2]) =
    50          
491             ($iData > 0) ? '+' : (($iData == 0) ? '+' : '-');
492             } elsif ($rItem->[0] eq '-') {
493 0 0       0 substr($sFmtRes, $rItem->[1], $rItem->[2]) =
    0          
494             ($iData > 0) ? '' : (($iData == 0) ? '' : '-');
495             } elsif ($rItem->[0] eq '@') {
496 0         0 substr($sFmtRes, $rItem->[1], $rItem->[2]) = $iData;
497             } elsif ($rItem->[0] eq '*') {
498 0         0 substr($sFmtRes, $rItem->[1], $rItem->[2]) = ''; #REMOVE
499             } elsif (($rItem->[0] eq "\xA2\xA4")
500             or ($rItem->[0] eq "\xA2\xA5")
501             or ($rItem->[0] eq "\x81\xA2")
502             or ($rItem->[0] eq "\x81\xA3")) {
503 0         0 substr($sFmtRes, $rItem->[1], $rItem->[2]) = $rItem->[0];
504             } elsif (($rItem->[0] eq '(') or ($rItem->[0] eq ')')) {
505 0         0 substr($sFmtRes, $rItem->[1], $rItem->[2]) = $rItem->[0];
506             } else {
507 1501 50       2881 if ($iLen > 0) {
508 1501 100       2586 if ($iIt <= 0) {
509 784         1307 $sRep = substr($sNumRes, 0, $iLen);
510 784         1199 $iLen = 0;
511             } else {
512 717         1117 my $iReal = length($rItem->[0]);
513 717 50       1261 if ($iPPos >= 0) {
514 0         0 my $sWkF = $rItem->[0];
515 0         0 $sWkF =~ s/^#+//;
516 0         0 $iReal = length($sWkF);
517 0 0       0 $iReal = ($iLen <= $iReal) ? $iLen : $iReal;
518             } else {
519 717 100       1376 $iReal = ($iLen <= $iReal) ? $iLen : $iReal;
520             }
521 717         1461 $sRep = substr($sNumRes, $iLen - $iReal, $iReal);
522 717         1183 $iLen -= $iReal;
523             }
524             } else {
525 0         0 $sRep = '';
526             }
527 1501         4105 substr($sFmtRes, $rItem->[1], $rItem->[2]) = "\x00" . $sRep;
528             }
529             }
530 944 100       1955 $sRep = ($iLen > 0) ? substr($sNumRes, 0, $iLen) : '';
531 944         3125 $sFmtRes =~ s/\x00/$sRep/;
532 944         2467 $sFmtRes =~ s/\x00//g;
533             }
534             } else {
535 836         1202 my $iAtMk = 0;
536 836         1880 for (my $iIt = $#aRep ; $iIt >= 0 ; $iIt--) {
537 836         1309 my $rItem = $aRep[$iIt];
538 836 50       1672 if ($rItem->[0] eq '@') {
539 836         2016 substr($sFmtRes, $rItem->[1], $rItem->[2]) = $iData;
540 836         1795 $iAtMk++;
541             } else {
542 0         0 substr($sFmtRes, $rItem->[1], $rItem->[2]) = '';
543             }
544             }
545 836 50       1517 $sFmtRes = $iData unless ($iAtMk);
546             }
547 1782 50       9443 return wantarray() ? ($sFmtRes, $sColor) : $sFmtRes;
548             }
549              
550             #------------------------------------------------------------------------------
551             # AddComma (for Spreadsheet::XLSX::Utility2007)
552             #------------------------------------------------------------------------------
553             sub AddComma {
554 0     0 0 0 my ($sNum) = @_;
555              
556 0 0       0 if ($sNum =~ /^([^\d]*)(\d\d\d\d+)(\.*.*)$/) {
557 0         0 my ($sPre, $sObj, $sAft) = ($1, $2, $3);
558 0         0 for (my $i = length($sObj) - 3 ; $i > 0 ; $i -= 3) {
559 0         0 substr($sObj, $i, 0) = ',';
560             }
561 0         0 return $sPre . $sObj . $sAft;
562             } else {
563 0         0 return $sNum;
564             }
565             }
566              
567             #------------------------------------------------------------------------------
568             # MakeBun (for Spreadsheet::XLSX::Utility2007)
569             #------------------------------------------------------------------------------
570             sub MakeBun {
571 0     0 0 0 my ($sFmt, $iData, $iFlg) = @_;
572 0         0 my $iBunbo;
573             my $iShou;
574              
575             #1. Init
576             #print "FLG: $iFlg\n";
577 0 0       0 if ($iFlg) {
578 0         0 $iShou = $iData - int($iData);
579 0 0       0 return '' if ($iShou == 0);
580             } else {
581 0         0 $iShou = $iData;
582             }
583 0         0 $iShou = abs($iShou);
584 0         0 my $sSWk;
585              
586             #2.Calc BUNBO
587             #2.1 BUNBO defined
588 0 0       0 if ($sFmt =~ /\/(\d+)$/) {
589 0         0 $iBunbo = $1;
590 0         0 return sprintf("%d/%d", $iShou * $iBunbo, $iBunbo);
591             } else {
592              
593             #2.2 Calc BUNBO
594 0         0 $sFmt =~ /\/(\?+)$/;
595 0         0 my $iKeta = length($1);
596 0         0 my $iSWk = 1;
597 0         0 my $sSWk = '';
598 0         0 my $iBunsi;
599 0         0 for (my $iBunbo = 2 ; $iBunbo < 10**$iKeta ; $iBunbo++) {
600 0         0 $iBunsi = int($iShou * $iBunbo + 0.5);
601 0         0 my $iCmp = abs($iShou - ($iBunsi / $iBunbo));
602 0 0       0 if ($iCmp < $iSWk) {
603 0         0 $iSWk = $iCmp;
604 0         0 $sSWk = sprintf("%d/%d", $iBunsi, $iBunbo);
605 0 0       0 last if ($iSWk == 0);
606             }
607             }
608 0         0 return $sSWk;
609             }
610             }
611              
612             #------------------------------------------------------------------------------
613             # MakeE (for Spreadsheet::XLSX::Utility2007)
614             #------------------------------------------------------------------------------
615             sub MakeE {
616 80     80 0 234 my ($sFmt, $iData) = @_;
617              
618 80         298 $sFmt =~ /(([#0]*)[\.]?[#0]*)([eE])([\+\-][0#]+)/;
619 80         455 my ($sKari, $iKeta, $sE, $sSisu) = ($1, length($2), $3, $4);
620 80 50       209 $iKeta = 1 if ($iKeta <= 0);
621              
622 80         141 my $iLog10 = 0;
623 80 50       499 $iLog10 = ($iData == 0) ? 0 : (log(abs($iData)) / log(10));
624 80 50       332 $iLog10 = (int($iLog10 / $iKeta) + ((($iLog10 - int($iLog10 / $iKeta)) < 0) ? -1 : 0)) * $iKeta;
625              
626 80         347 my $sUe = ExcelFmt($sKari, $iData * (10**($iLog10 * -1)), 0);
627 80         228 my $sShita = ExcelFmt($sSisu, $iLog10, 0);
628 80         461 return $sUe . $sE . $sShita;
629             }
630              
631             #------------------------------------------------------------------------------
632             # LeapYear (for Spreadsheet::XLSX::Utility2007)
633             #------------------------------------------------------------------------------
634             sub LeapYear {
635 0     0 0 0 my ($iYear) = @_;
636 0 0       0 return 1 if ($iYear == 1900); #Special for Excel
637 0 0 0     0 return ((($iYear % 4) == 0) && (($iYear % 100) || ($iYear % 400) == 0)) ? 1 : 0;
638             }
639              
640             #------------------------------------------------------------------------------
641             # LocaltimeExcel (for Spreadsheet::XLSX::Utility2007)
642             #------------------------------------------------------------------------------
643             sub LocaltimeExcel {
644 0     0 1 0 my ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iMSec, $flg1904) = @_;
645              
646             #0. Init
647 0         0 $iMon++;
648 0         0 $iYear += 1900;
649              
650             #1. Calc Time
651 0         0 my $iTime;
652 0         0 $iTime = $iHour;
653 0         0 $iTime *= 60;
654 0         0 $iTime += $iMin;
655 0         0 $iTime *= 60;
656 0         0 $iTime += $iSec;
657 0 0       0 $iTime += $iMSec / 1000.0 if (defined($iMSec));
658 0         0 $iTime /= 86400.0; #3600*24(1day in seconds)
659 0         0 my $iY;
660             my $iYDays;
661              
662             #2. Calc Days
663 0 0       0 if ($flg1904) {
664 0         0 $iY = 1904;
665 0         0 $iTime--; #Start from Jan 1st
666 0         0 $iYDays = 366;
667             } else {
668 0         0 $iY = 1900;
669 0         0 $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!)
670             }
671 0         0 while ($iY < $iYear) {
672 0         0 $iTime += $iYDays;
673 0         0 $iY++;
674 0 0       0 $iYDays = (LeapYear($iY)) ? 366 : 365;
675             }
676 0         0 for (my $iM = 1 ; $iM < $iMon ; $iM++) {
677 0 0 0     0 if ( $iM == 1
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
678             || $iM == 3
679             || $iM == 5
680             || $iM == 7
681             || $iM == 8
682             || $iM == 10
683             || $iM == 12) {
684 0         0 $iTime += 31;
685             } elsif ($iM == 4 || $iM == 6 || $iM == 9 || $iM == 11) {
686 0         0 $iTime += 30;
687             } elsif ($iM == 2) {
688 0 0       0 $iTime += (LeapYear($iYear)) ? 29 : 28;
689             }
690             }
691 0         0 $iTime += $iDay;
692 0         0 return $iTime;
693             }
694              
695             #------------------------------------------------------------------------------
696             # ExcelLocaltime (for Spreadsheet::XLSX::Utility2007)
697             #------------------------------------------------------------------------------
698             sub ExcelLocaltime {
699 2     2 1 7 my ($dObj, $flg1904) = @_;
700 2         7 my ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec);
701 2         0 my ($iDt, $iTime, $iYDays);
702              
703 2         7 $iDt = int($dObj);
704 2         4 $iTime = $dObj - $iDt;
705              
706             #1. Calc Days
707 2 50       7 if ($flg1904) {
708 0         0 $iYear = 1904;
709 0         0 $iDt++; #Start from Jan 1st
710 0         0 $iYDays = 366;
711 0         0 $iwDay = (($iDt + 4) % 7);
712             } else {
713 2         4 $iYear = 1900;
714 2         4 $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!)
715 2         5 $iwDay = (($iDt + 6) % 7);
716             }
717 2         7 while ($iDt > $iYDays) {
718 115         146 $iDt -= $iYDays;
719 115         144 $iYear++;
720 115 100 66     289 $iYDays =
721             ((($iYear % 4) == 0) && (($iYear % 100) || ($iYear % 400) == 0)) ? 366 : 365;
722             }
723 2         5 $iYear -= 1900;
724 2         7 for ($iMon = 1 ; $iMon < 12 ; $iMon++) {
725 12         18 my $iMD;
726 12 100 100     99 if ( $iMon == 1
    100 100        
    50 100        
      100        
      100        
      66        
      100        
      100        
      100        
727             || $iMon == 3
728             || $iMon == 5
729             || $iMon == 7
730             || $iMon == 8
731             || $iMon == 10
732             || $iMon == 12) {
733 7         13 $iMD = 31;
734             } elsif ($iMon == 4 || $iMon == 6 || $iMon == 9 || $iMon == 11) {
735 4         7 $iMD = 30;
736             } elsif ($iMon == 2) {
737 1 50       3 $iMD = (($iYear % 4) == 0) ? 29 : 28;
738             }
739 12 100       39 last if ($iDt <= $iMD);
740 11         23 $iDt -= $iMD;
741             }
742              
743             #2. Calc Time
744 2         5 $iDay = $iDt;
745 2         6 $iTime += (0.0005 / 86400.0);
746 2         5 $iTime *= 24.0;
747 2         3 $iHour = int($iTime);
748 2         4 $iTime -= $iHour;
749 2         3 $iTime *= 60.0;
750 2         3 $iMin = int($iTime);
751 2         3 $iTime -= $iMin;
752 2         3 $iTime *= 60.0;
753 2         3 $iSec = int($iTime);
754 2         15 $iTime -= $iSec;
755 2         4 $iTime *= 1000.0;
756 2         3 $iMSec = int($iTime);
757              
758 2         11 return ($iSec, $iMin, $iHour, $iDay, $iMon - 1, $iYear, $iwDay, $iMSec);
759             }
760              
761             # -----------------------------------------------------------------------------
762             # col2int (for Spreadsheet::XLSX::Utility2007)
763             #------------------------------------------------------------------------------
764             # converts a excel row letter into an int for use in an array
765             sub col2int {
766 0     0 1 0 my $result = 0;
767 0         0 my $str = shift;
768 0         0 my $incr = 0;
769              
770 0         0 for (my $i = length($str) ; $i > 0 ; $i--) {
771 0         0 my $char = substr($str, $i - 1);
772 0         0 my $curr += ord(lc($char)) - ord('a') + 1;
773 0 0       0 $curr *= $incr if ($incr);
774 0         0 $result += $curr;
775 0         0 $incr += 26;
776             }
777              
778             # this is one out as we range 0..x-1 not 1..x
779 0         0 $result--;
780              
781 0         0 return $result;
782             }
783              
784             # -----------------------------------------------------------------------------
785             # int2col (for Spreadsheet::XLSX::Utility2007)
786             #------------------------------------------------------------------------------
787             ### int2col
788             # convert a column number into column letters
789             # @note this is quite a brute force coarse method
790             # does not manage values over 701 (ZZ)
791             # @arg number, to convert
792             # @returns string, column name
793             #
794             sub int2col {
795 0     0 1 0 my $out = "";
796 0         0 my $val = shift;
797              
798 0         0 do {
799 0         0 $out .= chr(($val % 26) + ord('A'));
800 0         0 $val = int($val / 26) - 1;
801             } while ($val >= 0);
802              
803 0         0 return reverse $out;
804             }
805              
806             # -----------------------------------------------------------------------------
807             # sheetRef (for Spreadsheet::XLSX::Utility2007)
808             #------------------------------------------------------------------------------
809             # -----------------------------------------------------------------------------
810             ### sheetRef
811             # convert an excel letter-number address into a useful array address
812             # @note that also Excel uses X-Y notation, we normally use Y-X in arrays
813             # @args $str, excel coord eg. A2
814             # @returns an array - 2 elements - column, row, or undefined
815             #
816             sub sheetRef {
817 0     0 1 0 my $str = shift;
818 0         0 my @ret;
819              
820 0         0 $str =~ m/^(\D+)(\d+)$/;
821              
822 0 0 0     0 if ($1 && $2) {
823 0         0 push(@ret, $2 - 1, col2int($1));
824             }
825 0 0       0 if ($ret[0] < 0) {
826 0         0 undef @ret;
827             }
828              
829 0         0 return @ret;
830             }
831              
832             # -----------------------------------------------------------------------------
833             # xls2csv (for Spreadsheet::XLSX::Utility2007)
834             #------------------------------------------------------------------------------
835             ### xls2csv
836             # convert a chunk of an excel file into csv text chunk
837             # @args $param, sheet-colrow:colrow (1-A1:B2 or A1:B2 for sheet 1
838             # @args $rotate, 0 or 1 decides if output should be rotated or not
839             # @returns string containing a chunk of csv
840             #
841             sub xls2csv {
842 0     0 1 0 my ($filename, $regions, $rotate) = @_;
843 0         0 my $sheet = 0;
844 0         0 my $output = "";
845              
846             # extract any sheet number from the region string
847 0         0 $regions =~ m/^(\d+)-(.*)/;
848              
849 0 0       0 if ($2) {
850 0         0 $sheet = $1 - 1;
851 0         0 $regions = $2;
852             }
853              
854             # now extract the start and end regions
855 0         0 $regions =~ m/(.*):(.*)/;
856              
857 0 0 0     0 if (!$1 || !$2) {
858 0         0 print STDERR "Bad Params";
859 0         0 return "";
860             }
861              
862 0         0 my @start = sheetRef($1);
863 0         0 my @end = sheetRef($2);
864 0 0       0 if (!@start) {
865 0         0 print STDERR "Bad coorinates - $1";
866 0         0 return "";
867             }
868 0 0       0 if (!@end) {
869 0         0 print STDERR "Bad coorinates - $2";
870 0         0 return "";
871             }
872              
873 0 0       0 if ($start[1] > $end[1]) {
874 0         0 print STDERR "Bad COLUMN ordering\n";
875 0         0 print STDERR "Start column " . int2col($start[1]);
876 0         0 print STDERR " after end column " . int2col($end[1]) . "\n";
877 0         0 return "";
878             }
879 0 0       0 if ($start[0] > $end[0]) {
880 0         0 print STDERR "Bad ROW ordering\n";
881 0         0 print STDERR "Start row " . ($start[0] + 1);
882 0         0 print STDERR " after end row " . ($end[0] + 1) . "\n";
883 0         0 exit;
884             }
885              
886             # start the excel object now
887 0         0 my $oExcel = new Spreadsheet::XLSX;
888 0         0 my $oBook = $oExcel->Parse($filename);
889              
890             # open the sheet
891 0         0 my $oWkS = $oBook->{Worksheet}[$sheet];
892              
893             # now check that the region exists in the file
894             # if not trucate to the possible region
895             # output a warning msg
896 0 0       0 if ($start[1] < $oWkS->{MinCol}) {
897 0         0 print STDERR int2col($start[1]) . " < min col " . int2col($oWkS->{MinCol}) . " Reseting\n";
898 0         0 $start[1] = $oWkS->{MinCol};
899             }
900 0 0       0 if ($end[1] > $oWkS->{MaxCol}) {
901 0         0 print STDERR int2col($end[1]) . " > max col " . int2col($oWkS->{MaxCol}) . " Reseting\n";
902 0         0 $end[1] = $oWkS->{MaxCol};
903             }
904 0 0       0 if ($start[0] < $oWkS->{MinRow}) {
905 0         0 print STDERR "" . ($start[0] + 1) . " < min row " . ($oWkS->{MinRow} + 1) . " Reseting\n";
906 0         0 $start[0] = $oWkS->{MinCol};
907             }
908 0 0       0 if ($end[0] > $oWkS->{MaxRow}) {
909 0         0 print STDERR "" . ($end[0] + 1) . " > max row " . ($oWkS->{MaxRow} + 1) . " Reseting\n";
910 0         0 $end[0] = $oWkS->{MaxRow};
911              
912             }
913              
914 0         0 my $x1 = $start[1];
915 0         0 my $y1 = $start[0];
916 0         0 my $x2 = $end[1];
917 0         0 my $y2 = $end[0];
918              
919 0 0       0 if (!$rotate) {
920 0         0 for (my $y = $y1 ; $y <= $y2 ; $y++) {
921 0         0 for (my $x = $x1 ; $x <= $x2 ; $x++) {
922 0         0 my $cell = $oWkS->{Cells}[$y][$x];
923 0 0       0 $output .= $cell->Value if (defined $cell);
924 0 0       0 $output .= "," if ($x != $x2);
925             }
926 0         0 $output .= "\n";
927             }
928             } else {
929 0         0 for (my $x = $x1 ; $x <= $x2 ; $x++) {
930 0         0 for (my $y = $y1 ; $y <= $y2 ; $y++) {
931 0         0 my $cell = $oWkS->{Cells}[$y][$x];
932 0 0       0 $output .= $cell->Value if (defined $cell);
933 0 0       0 $output .= "," if ($y != $y2);
934             }
935 0         0 $output .= "\n";
936             }
937             }
938              
939 0         0 return $output;
940             }
941              
942             sub unescape_HTML {
943              
944 1782     1782 0 2859 my $string = shift;
945 1782         2930 my %options = @_;
946              
947 1782 50       3610 return $string if ($string eq '');
948              
949 1782         3094 $string =~ s/"/"/g;
950 1782         2680 $string =~ s/’/'/g;
951 1782         2538 $string =~ s/&/&/g;
952              
953 1782 50       3520 return $string if $options{textarea}; # for textboxes, we leave < and > as < and >
954             # so that people who enter "" into
955             # our text boxes can't break forms
956              
957 1782         2768 $string =~ s/</
958 1782         2788 $string =~ s/>/>/g;
959              
960 1782         4066 return $string;
961             }
962              
963             1;
964             __END__