# This code is adapted for Excel 2007 from: # Spreadsheet::XLSX::Utility # by Kawai, Takanori (Hippo2000) 2001.2.2 # This Program is ALPHA version. #============================================================================== # Spreadsheet::XLSX::Utility2007; #============================================================================== package Spreadsheet::XLSX::Utility2007; use strict; use warnings; require Exporter; use vars qw(@ISA @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw(ExcelFmt LocaltimeExcel ExcelLocaltime col2int int2col sheetRef xls2csv); our $VERSION = '0.17'; my $sNUMEXP = '(^[+-]?\d+(\.\d+)?$)|(^[+-]?\d+\.?(\d*)[eE][+-](\d+))$'; #------------------------------------------------------------------------------ # ExcelFmt (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ sub ExcelFmt { my ($sFmt, $iData, $i1904, $sType) = @_; my $sCond; my $sWkF = ''; my $sRes = ''; $sFmt = unescape_HTML($sFmt); #1. Get Condition if ($sFmt =~ /^\[([<>=][^\]]+)\](.*)$/) { $sCond = $1; $sFmt = $2; } $sFmt =~ s/_/ /g; my @sFmtWk; my $sFmtObj; my $iFmtPos = 0; my $iDblQ = 0; my $iQ = 0; foreach my $sWk (split //, $sFmt) { if ($iDblQ or $iQ) { $sFmtWk[$iFmtPos] .= $sWk; $iDblQ = 0 if ($sWk eq '"'); $iQ = 0; next; } if ($sWk eq ';') { $iFmtPos++; next; } elsif ($sWk eq '"') { $iDblQ = 1; } elsif ($sWk eq '!') { $iQ = 1; } elsif ($sWk eq '\\') { $iQ = 1; # next; } elsif ($sWk eq '(') { #Skip? next; } elsif ($sWk eq ')') { #Skip? next; } $sFmtWk[$iFmtPos] .= $sWk; } #Get FmtString if (scalar(@sFmtWk) > 1) { if ($sCond) { $sFmtObj = $sFmtWk[((eval(qq/"$iData" $sCond/)) ? 0 : 1)]; } else { my $iWk = ($iData =~ /$sNUMEXP/) ? $iData : 0; # $iData = abs($iData) if($iWk !=0); if (scalar(@sFmtWk) == 2) { $sFmtObj = $sFmtWk[(($iWk >= 0) ? 0 : 1)]; } elsif (scalar(@sFmtWk) == 3) { $sFmtObj = $sFmtWk[(($iWk > 0) ? 0 : (($iWk < 0) ? 1 : 2))]; } else { if ($iData =~ /$sNUMEXP/) { $sFmtObj = $sFmtWk[(($iWk > 0) ? 0 : (($iWk < 0) ? 1 : 2))]; } else { $sFmtObj = $sFmtWk[3]; } } } } else { $sFmtObj = $sFmtWk[0]; } my $sColor; if ($sFmtObj =~ /^(\[[^hm\[\]]*\])/) { $sColor = $1; $sFmtObj = substr($sFmtObj, length($sColor)); chop($sColor); $sColor = substr($sColor, 1); } #print "FMT:$sFmtObj Co:$sColor\n"; #3.Build Data my $iFmtMode = 0; #1:Number, 2:Date my $i = 0; my $ir = 0; my $sFmtWk; my @aRep = (); my $sFmtRes = ''; my $iFflg = -1; my $iRpos = -1; my $iCmmCnt = 0; my $iBunFlg = 0; my $iFugouFlg = 0; my $iPer = 0; my $iAm = 0; my $iSt; while ($i < length($sFmtObj)) { $iSt = $i; my $sWk = substr($sFmtObj, $i, 1); if ($sWk !~ /[#0\+\-\.\?eE\,\%]/) { if ($iFflg != -1) { push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg), $iRpos, $i - $iFflg]; $iFflg = -1; } } if ($sWk eq '"') { $iDblQ = $iDblQ ? 0 : 1; $i++; next; } elsif ($sWk eq '!') { $iQ = 1; $i++; next; } elsif ($sWk eq '\\') { if ($iQ == 1) { } else { $iQ = 1; $i++; next; } } #print "WK:", ord($sWk), " $iFmtMode \n"; #print "DEF1: $iDblQ DEF2: $iQ\n"; if ((defined($iDblQ) and ($iDblQ)) or (defined($iQ) and ($iQ))) { $iQ = 0; if ( ($iFmtMode != 2) and ( (substr($sFmtObj, $i, 2) eq "\x81\xA2") || (substr($sFmtObj, $i, 2) eq "\x81\xA3") || (substr($sFmtObj, $i, 2) eq "\xA2\xA4") || (substr($sFmtObj, $i, 2) eq "\xA2\xA5")) ) { #print "PUSH:", unpack("H*", substr($sFmtObj, $i, 2)), "\n"; push @aRep, [substr($sFmtObj, $i, 2), length($sFmtRes), 2]; $iFugouFlg = 1; $i += 2; } else { $i++; } } elsif ( ($sWk =~ /[#0\+\.\?eE\,\%]/) || ( ($iFmtMode != 2) and (($sWk eq '-') || ($sWk eq '(') || ($sWk eq ')'))) ) { $iFmtMode = 1 unless ($iFmtMode); if (substr($sFmtObj, $i, 1) =~ /[#0]/) { if (substr($sFmtObj, $i) =~ /^([#0]+)([\.]?)([0#]*)([eE])([\+\-])([0#]+)/) { push @aRep, [substr($sFmtObj, $i, length($&)), $i, length($&)]; $i += length($&); } else { if ($iFflg == -1) { $iFflg = $i; $iRpos = length($sFmtRes); } } } elsif (substr($sFmtObj, $i, 1) eq '?') { if ($iFflg != -1) { push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg + 1), $iRpos, $i - $iFflg + 1]; } $iFflg = $i; while ($i < length($sFmtObj)) { if (substr($sFmtObj, $i, 1) eq '/') { $iBunFlg = 1; } elsif (substr($sFmtObj, $i, 1) eq '?') { ; } else { if (($iBunFlg) && (substr($sFmtObj, $i, 1) =~ /[0-9]/)) { ; } else { last; } } $i++; } $i--; push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg + 1), length($sFmtRes), $i - $iFflg + 1]; $iFflg = -1; } elsif (substr($sFmtObj, $i, 3) =~ /^[eE][\+\-][0#]$/) { if (substr($sFmtObj, $i) =~ /([eE])([\+\-])([0#]+)/) { push @aRep, [substr($sFmtObj, $i, length($&)), $i, length($&)]; $i += length($&); } $iFflg = -1; } else { if ($iFflg != -1) { push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg), $iRpos, $i - $iFflg]; $iFflg = -1; } if (substr($sFmtObj, $i, 1) =~ /[\+\-]/) { push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1]; $iFugouFlg = 1; } elsif (substr($sFmtObj, $i, 1) eq '.') { push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1]; } elsif (substr($sFmtObj, $i, 1) eq ',') { $iCmmCnt++; push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1]; } elsif (substr($sFmtObj, $i, 1) eq '%') { $iPer = 1; } elsif ((substr($sFmtObj, $i, 1) eq '(') || (substr($sFmtObj, $i, 1) eq ')')) { push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1]; $iFugouFlg = 1; } } $i++; } elsif ($sWk =~ /[ymdhsapg]/) { $iFmtMode = 2 unless ($iFmtMode); if (substr($sFmtObj, $i, 5) =~ /am\/pm/i) { push @aRep, ['am/pm', length($sFmtRes), 5]; $iAm = 1; $i += 5; } elsif (substr($sFmtObj, $i, 3) =~ /a\/p/i) { push @aRep, ['a/p', length($sFmtRes), 3]; $iAm = 1; $i += 3; } elsif (substr($sFmtObj, $i, 5) eq 'mmmmm') { push @aRep, ['mmmmm', length($sFmtRes), 5]; $i += 5; } elsif ((substr($sFmtObj, $i, 4) eq 'mmmm') || (substr($sFmtObj, $i, 4) eq 'dddd') || (substr($sFmtObj, $i, 4) eq 'yyyy') || (substr($sFmtObj, $i, 4) eq 'ggge')) { push @aRep, [substr($sFmtObj, $i, 4), length($sFmtRes), 4]; $i += 4; } elsif ((substr($sFmtObj, $i, 3) eq 'mmm') || (substr($sFmtObj, $i, 3) eq 'yyy')) { push @aRep, [substr($sFmtObj, $i, 3), length($sFmtRes), 3]; $i += 3; } elsif ((substr($sFmtObj, $i, 2) eq 'yy') || (substr($sFmtObj, $i, 2) eq 'mm') || (substr($sFmtObj, $i, 2) eq 'dd') || (substr($sFmtObj, $i, 2) eq 'hh') || (substr($sFmtObj, $i, 2) eq 'ss') || (substr($sFmtObj, $i, 2) eq 'ge')) { if ( (substr($sFmtObj, $i, 2) eq 'mm') && ($#aRep >= 0) && (($aRep[$#aRep]->[0] eq 'h') or ($aRep[$#aRep]->[0] eq 'hh'))) { push @aRep, ['mm', length($sFmtRes), 2, 'min']; } else { push @aRep, [substr($sFmtObj, $i, 2), length($sFmtRes), 2]; } if ((substr($sFmtObj, $i, 2) eq 'ss') && ($#aRep > 0)) { if ( ($aRep[$#aRep - 1]->[0] eq 'm') || ($aRep[$#aRep - 1]->[0] eq 'mm')) { push(@{$aRep[$#aRep - 1]}, 'min'); } } $i += 2; } elsif ((substr($sFmtObj, $i, 1) eq 'm') || (substr($sFmtObj, $i, 1) eq 'd') || (substr($sFmtObj, $i, 1) eq 'h') || (substr($sFmtObj, $i, 1) eq 's')) { if ( (substr($sFmtObj, $i, 1) eq 'm') && ($#aRep >= 0) && (($aRep[$#aRep]->[0] eq 'h') or ($aRep[$#aRep]->[0] eq 'hh'))) { push @aRep, ['m', length($sFmtRes), 1, 'min']; } else { push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1]; } if ((substr($sFmtObj, $i, 1) eq 's') && ($#aRep > 0)) { if ( ($aRep[$#aRep - 1]->[0] eq 'm') || ($aRep[$#aRep - 1]->[0] eq 'mm')) { push(@{$aRep[$#aRep - 1]}, 'min'); } } $i += 1; } } elsif ((substr($sFmtObj, $i, 3) eq '[h]')) { push @aRep, ['[h]', length($sFmtRes), 3]; $i += 3; } elsif ((substr($sFmtObj, $i, 4) eq '[mm]')) { push @aRep, ['[mm]', length($sFmtRes), 4]; $i += 4; } elsif ($sWk eq '@') { push @aRep, ['@', length($sFmtRes), 1]; $i++; } elsif ($sWk eq '*') { push @aRep, [substr($sFmtObj, $i, 1), length($sFmtRes), 1]; } else { $i++; } $i++ if ($i == $iSt); #No Format match $sFmtRes .= substr($sFmtObj, $iSt, $i - $iSt); } #print "FMT: $iRpos ",$sFmtRes, "\n"; if ($iFflg != -1) { push @aRep, [substr($sFmtObj, $iFflg, $i - $iFflg + 1), $iRpos,, $i - $iFflg + 1]; $iFflg = 0; } #For Date format $iFmtMode = 0 if (defined $sType && $sType eq 'Text'); #Not Convert Non Numeric if (($iFmtMode == 2) && ($iData =~ /$sNUMEXP/)) { my @aTime = ExcelLocaltime($iData, $i1904); $aTime[4]++; $aTime[5] += 1900; my @aMonL = qw (dum January February March April May June July August September October November December ); my @aMonNm = qw (dum Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @aWeekNm = qw (Mon Tue Wed Thu Fri Sat Sun); my @aWeekL = qw (Monday Tuesday Wednesday Thursday Friday Saturday Sunday); my $sRep; for (my $iIt = $#aRep ; $iIt >= 0 ; $iIt--) { my $rItem = $aRep[$iIt]; if ((scalar @$rItem) >= 4) { #Min if ($rItem->[0] eq 'mm') { $sRep = sprintf("%02d", $aTime[1]); } else { $sRep = sprintf("%d", $aTime[1]); } } #Year elsif ($rItem->[0] eq 'yyyy') { $sRep = sprintf('%04d', $aTime[5]); } elsif ($rItem->[0] eq 'yy') { $sRep = sprintf('%02d', $aTime[5] % 100); } #Mon elsif ($rItem->[0] eq 'mmmmm') { $sRep = substr($aMonNm[$aTime[4]], 0, 1); } elsif ($rItem->[0] eq 'mmmm') { $sRep = $aMonL[$aTime[4]]; } elsif ($rItem->[0] eq 'mmm') { $sRep = $aMonNm[$aTime[4]]; } elsif ($rItem->[0] eq 'mm') { $sRep = sprintf('%02d', $aTime[4]); } elsif ($rItem->[0] eq 'm') { $sRep = sprintf('%d', $aTime[4]); } #Day elsif ($rItem->[0] eq 'dddd') { $sRep = $aWeekL[$aTime[7]]; } elsif ($rItem->[0] eq 'ddd') { $sRep = $aWeekNm[$aTime[7]]; } elsif ($rItem->[0] eq 'dd') { $sRep = sprintf('%02d', $aTime[3]); } elsif ($rItem->[0] eq 'd') { $sRep = sprintf('%d', $aTime[3]); } #Hour elsif ($rItem->[0] eq 'hh') { if ($iAm) { $sRep = sprintf('%02d', $aTime[2] % 12); } else { $sRep = sprintf('%02d', $aTime[2]); } } elsif ($rItem->[0] eq 'h') { if ($iAm) { $sRep = sprintf('%d', $aTime[2] % 12); } else { $sRep = sprintf('%d', $aTime[2]); } } #SS elsif ($rItem->[0] eq 'ss') { $sRep = sprintf('%02d', $aTime[0]); } elsif ($rItem->[0] eq 'S') { $sRep = sprintf('%d', $aTime[0]); } #am/pm elsif ($rItem->[0] eq 'am/pm') { $sRep = ($aTime[4] > 12) ? 'pm' : 'am'; } elsif ($rItem->[0] eq 'a/p') { $sRep = ($aTime[4] > 12) ? 'p' : 'a'; } elsif ($rItem->[0] eq '.') { $sRep = '.'; } elsif ($rItem->[0] =~ /^0+$/) { my $i0Len = length($&); #print "SEC:", $aTime[7], "\n"; $sRep = substr(sprintf("%.${i0Len}f", $aTime[7] / 1000.0), 2, $i0Len); } elsif ($rItem->[0] eq '[h]') { $sRep = sprintf('%d', int($iData) * 24 + $aTime[2]); } elsif ($rItem->[0] eq '[mm]') { $sRep = sprintf('%d', (int($iData) * 24 + $aTime[2]) * 60 + $aTime[1]); } #NENGO(Japanese) elsif ($rItem->[0] eq 'ge') { $sRep = Spreadsheet::XLSX::FmtJapan::CnvNengo(1, @aTime); } elsif ($rItem->[0] eq 'ggge') { $sRep = Spreadsheet::XLSX::FmtJapan::CnvNengo(2, @aTime); } elsif ($rItem->[0] eq '@') { $sRep = $iData; } #print "REP:$sRep ",$rItem->[0], ":", $rItem->[1], ":" ,$rItem->[2], "\n"; substr($sFmtRes, $rItem->[1], $rItem->[2]) = $sRep; } } elsif (($iFmtMode == 1) && ($iData =~ /$sNUMEXP/)) { if ($#aRep >= 0) { while ($aRep[$#aRep]->[0] eq ',') { $iCmmCnt--; substr($sFmtRes, $aRep[$#aRep]->[1], $aRep[$#aRep]->[2]) = ''; $iData /= 1000; pop @aRep; } my $sNumFmt = join('', map {$_->[0]} @aRep); my $sNumRes; my $iTtl = 0; my $iE = 0; my $iP = 0; my $iInt = 0; my $iAftP = undef; foreach my $sItem (split //, $sNumFmt) { if ($sItem eq '.') { $iTtl++; $iP = 1; } elsif (($sItem eq 'E') || ($sItem eq 'e')) { $iE = 1; } elsif ($sItem eq '0') { $iTtl++; $iAftP++ if ($iP); $iInt = 1; } elsif ($sItem eq '#') { #$iTtl++; $iAftP++ if ($iP); $iInt = 1; } elsif ($sItem eq '?') { #$iTtl++; $iAftP++ if ($iP); } } $iData *= 100.0 if ($iPer); my $iDData = ($iFugouFlg) ? abs($iData) : $iData + 0; if ($iBunFlg) { $sNumRes = sprintf("%0${iTtl}d", int($iDData)); } else { if ($iP) { $sNumRes = sprintf((defined($iAftP) ? "%0${iTtl}.${iAftP}f" : "%0${iTtl}f"), $iDData); } else { $sNumRes = sprintf("%0${iTtl}.0f", $iDData); } } $sNumRes = AddComma($sNumRes) if ($iCmmCnt > 0); my $iLen = length($sNumRes); my $iPPos = -1; my $sRep; for (my $iIt = $#aRep ; $iIt >= 0 ; $iIt--) { my $rItem = $aRep[$iIt]; if ($rItem->[0] =~ /([#0]*)([\.]?)([0#]*)([eE])([\+\-])([0#]+)/) { substr($sFmtRes, $rItem->[1], $rItem->[2]) = MakeE($rItem->[0], $iData); } elsif ($rItem->[0] =~ /\//) { substr($sFmtRes, $rItem->[1], $rItem->[2]) = MakeBun($rItem->[0], $iData, $iInt); } elsif ($rItem->[0] eq '.') { $iLen--; $iPPos = $iLen; } elsif ($rItem->[0] eq '+') { substr($sFmtRes, $rItem->[1], $rItem->[2]) = ($iData > 0) ? '+' : (($iData == 0) ? '+' : '-'); } elsif ($rItem->[0] eq '-') { substr($sFmtRes, $rItem->[1], $rItem->[2]) = ($iData > 0) ? '' : (($iData == 0) ? '' : '-'); } elsif ($rItem->[0] eq '@') { substr($sFmtRes, $rItem->[1], $rItem->[2]) = $iData; } elsif ($rItem->[0] eq '*') { substr($sFmtRes, $rItem->[1], $rItem->[2]) = ''; #REMOVE } elsif (($rItem->[0] eq "\xA2\xA4") or ($rItem->[0] eq "\xA2\xA5") or ($rItem->[0] eq "\x81\xA2") or ($rItem->[0] eq "\x81\xA3")) { substr($sFmtRes, $rItem->[1], $rItem->[2]) = $rItem->[0]; } elsif (($rItem->[0] eq '(') or ($rItem->[0] eq ')')) { substr($sFmtRes, $rItem->[1], $rItem->[2]) = $rItem->[0]; } else { if ($iLen > 0) { if ($iIt <= 0) { $sRep = substr($sNumRes, 0, $iLen); $iLen = 0; } else { my $iReal = length($rItem->[0]); if ($iPPos >= 0) { my $sWkF = $rItem->[0]; $sWkF =~ s/^#+//; $iReal = length($sWkF); $iReal = ($iLen <= $iReal) ? $iLen : $iReal; } else { $iReal = ($iLen <= $iReal) ? $iLen : $iReal; } $sRep = substr($sNumRes, $iLen - $iReal, $iReal); $iLen -= $iReal; } } else { $sRep = ''; } substr($sFmtRes, $rItem->[1], $rItem->[2]) = "\x00" . $sRep; } } $sRep = ($iLen > 0) ? substr($sNumRes, 0, $iLen) : ''; $sFmtRes =~ s/\x00/$sRep/; $sFmtRes =~ s/\x00//g; } } else { my $iAtMk = 0; for (my $iIt = $#aRep ; $iIt >= 0 ; $iIt--) { my $rItem = $aRep[$iIt]; if ($rItem->[0] eq '@') { substr($sFmtRes, $rItem->[1], $rItem->[2]) = $iData; $iAtMk++; } else { substr($sFmtRes, $rItem->[1], $rItem->[2]) = ''; } } $sFmtRes = $iData unless ($iAtMk); } return wantarray() ? ($sFmtRes, $sColor) : $sFmtRes; } #------------------------------------------------------------------------------ # AddComma (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ sub AddComma { my ($sNum) = @_; if ($sNum =~ /^([^\d]*)(\d\d\d\d+)(\.*.*)$/) { my ($sPre, $sObj, $sAft) = ($1, $2, $3); for (my $i = length($sObj) - 3 ; $i > 0 ; $i -= 3) { substr($sObj, $i, 0) = ','; } return $sPre . $sObj . $sAft; } else { return $sNum; } } #------------------------------------------------------------------------------ # MakeBun (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ sub MakeBun { my ($sFmt, $iData, $iFlg) = @_; my $iBunbo; my $iShou; #1. Init #print "FLG: $iFlg\n"; if ($iFlg) { $iShou = $iData - int($iData); return '' if ($iShou == 0); } else { $iShou = $iData; } $iShou = abs($iShou); my $sSWk; #2.Calc BUNBO #2.1 BUNBO defined if ($sFmt =~ /\/(\d+)$/) { $iBunbo = $1; return sprintf("%d/%d", $iShou * $iBunbo, $iBunbo); } else { #2.2 Calc BUNBO $sFmt =~ /\/(\?+)$/; my $iKeta = length($1); my $iSWk = 1; my $sSWk = ''; my $iBunsi; for (my $iBunbo = 2 ; $iBunbo < 10**$iKeta ; $iBunbo++) { $iBunsi = int($iShou * $iBunbo + 0.5); my $iCmp = abs($iShou - ($iBunsi / $iBunbo)); if ($iCmp < $iSWk) { $iSWk = $iCmp; $sSWk = sprintf("%d/%d", $iBunsi, $iBunbo); last if ($iSWk == 0); } } return $sSWk; } } #------------------------------------------------------------------------------ # MakeE (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ sub MakeE { my ($sFmt, $iData) = @_; $sFmt =~ /(([#0]*)[\.]?[#0]*)([eE])([\+\-][0#]+)/; my ($sKari, $iKeta, $sE, $sSisu) = ($1, length($2), $3, $4); $iKeta = 1 if ($iKeta <= 0); my $iLog10 = 0; $iLog10 = ($iData == 0) ? 0 : (log(abs($iData)) / log(10)); $iLog10 = (int($iLog10 / $iKeta) + ((($iLog10 - int($iLog10 / $iKeta)) < 0) ? -1 : 0)) * $iKeta; my $sUe = ExcelFmt($sKari, $iData * (10**($iLog10 * -1)), 0); my $sShita = ExcelFmt($sSisu, $iLog10, 0); return $sUe . $sE . $sShita; } #------------------------------------------------------------------------------ # LeapYear (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ sub LeapYear { my ($iYear) = @_; return 1 if ($iYear == 1900); #Special for Excel return ((($iYear % 4) == 0) && (($iYear % 100) || ($iYear % 400) == 0)) ? 1 : 0; } #------------------------------------------------------------------------------ # LocaltimeExcel (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ sub LocaltimeExcel { my ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iMSec, $flg1904) = @_; #0. Init $iMon++; $iYear += 1900; #1. Calc Time my $iTime; $iTime = $iHour; $iTime *= 60; $iTime += $iMin; $iTime *= 60; $iTime += $iSec; $iTime += $iMSec / 1000.0 if (defined($iMSec)); $iTime /= 86400.0; #3600*24(1day in seconds) my $iY; my $iYDays; #2. Calc Days if ($flg1904) { $iY = 1904; $iTime--; #Start from Jan 1st $iYDays = 366; } else { $iY = 1900; $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!) } while ($iY < $iYear) { $iTime += $iYDays; $iY++; $iYDays = (LeapYear($iY)) ? 366 : 365; } for (my $iM = 1 ; $iM < $iMon ; $iM++) { if ( $iM == 1 || $iM == 3 || $iM == 5 || $iM == 7 || $iM == 8 || $iM == 10 || $iM == 12) { $iTime += 31; } elsif ($iM == 4 || $iM == 6 || $iM == 9 || $iM == 11) { $iTime += 30; } elsif ($iM == 2) { $iTime += (LeapYear($iYear)) ? 29 : 28; } } $iTime += $iDay; return $iTime; } #------------------------------------------------------------------------------ # ExcelLocaltime (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ sub ExcelLocaltime { my ($dObj, $flg1904) = @_; my ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec); my ($iDt, $iTime, $iYDays); $iDt = int($dObj); $iTime = $dObj - $iDt; #1. Calc Days if ($flg1904) { $iYear = 1904; $iDt++; #Start from Jan 1st $iYDays = 366; $iwDay = (($iDt + 4) % 7); } else { $iYear = 1900; $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!) $iwDay = (($iDt + 6) % 7); } while ($iDt > $iYDays) { $iDt -= $iYDays; $iYear++; $iYDays = ((($iYear % 4) == 0) && (($iYear % 100) || ($iYear % 400) == 0)) ? 366 : 365; } $iYear -= 1900; for ($iMon = 1 ; $iMon < 12 ; $iMon++) { my $iMD; if ( $iMon == 1 || $iMon == 3 || $iMon == 5 || $iMon == 7 || $iMon == 8 || $iMon == 10 || $iMon == 12) { $iMD = 31; } elsif ($iMon == 4 || $iMon == 6 || $iMon == 9 || $iMon == 11) { $iMD = 30; } elsif ($iMon == 2) { $iMD = (($iYear % 4) == 0) ? 29 : 28; } last if ($iDt <= $iMD); $iDt -= $iMD; } #2. Calc Time $iDay = $iDt; $iTime += (0.0005 / 86400.0); $iTime *= 24.0; $iHour = int($iTime); $iTime -= $iHour; $iTime *= 60.0; $iMin = int($iTime); $iTime -= $iMin; $iTime *= 60.0; $iSec = int($iTime); $iTime -= $iSec; $iTime *= 1000.0; $iMSec = int($iTime); return ($iSec, $iMin, $iHour, $iDay, $iMon - 1, $iYear, $iwDay, $iMSec); } # ----------------------------------------------------------------------------- # col2int (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ # converts a excel row letter into an int for use in an array sub col2int { my $result = 0; my $str = shift; my $incr = 0; for (my $i = length($str) ; $i > 0 ; $i--) { my $char = substr($str, $i - 1); my $curr += ord(lc($char)) - ord('a') + 1; $curr *= $incr if ($incr); $result += $curr; $incr += 26; } # this is one out as we range 0..x-1 not 1..x $result--; return $result; } # ----------------------------------------------------------------------------- # int2col (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ ### int2col # convert a column number into column letters # @note this is quite a brute force coarse method # does not manage values over 701 (ZZ) # @arg number, to convert # @returns string, column name # sub int2col { my $out = ""; my $val = shift; do { $out .= chr(($val % 26) + ord('A')); $val = int($val / 26) - 1; } while ($val >= 0); return reverse $out; } # ----------------------------------------------------------------------------- # sheetRef (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ # ----------------------------------------------------------------------------- ### sheetRef # convert an excel letter-number address into a useful array address # @note that also Excel uses X-Y notation, we normally use Y-X in arrays # @args $str, excel coord eg. A2 # @returns an array - 2 elements - column, row, or undefined # sub sheetRef { my $str = shift; my @ret; $str =~ m/^(\D+)(\d+)$/; if ($1 && $2) { push(@ret, $2 - 1, col2int($1)); } if ($ret[0] < 0) { undef @ret; } return @ret; } # ----------------------------------------------------------------------------- # xls2csv (for Spreadsheet::XLSX::Utility2007) #------------------------------------------------------------------------------ ### xls2csv # convert a chunk of an excel file into csv text chunk # @args $param, sheet-colrow:colrow (1-A1:B2 or A1:B2 for sheet 1 # @args $rotate, 0 or 1 decides if output should be rotated or not # @returns string containing a chunk of csv # sub xls2csv { my ($filename, $regions, $rotate) = @_; my $sheet = 0; my $output = ""; # extract any sheet number from the region string $regions =~ m/^(\d+)-(.*)/; if ($2) { $sheet = $1 - 1; $regions = $2; } # now extract the start and end regions $regions =~ m/(.*):(.*)/; if (!$1 || !$2) { print STDERR "Bad Params"; return ""; } my @start = sheetRef($1); my @end = sheetRef($2); if (!@start) { print STDERR "Bad coorinates - $1"; return ""; } if (!@end) { print STDERR "Bad coorinates - $2"; return ""; } if ($start[1] > $end[1]) { print STDERR "Bad COLUMN ordering\n"; print STDERR "Start column " . int2col($start[1]); print STDERR " after end column " . int2col($end[1]) . "\n"; return ""; } if ($start[0] > $end[0]) { print STDERR "Bad ROW ordering\n"; print STDERR "Start row " . ($start[0] + 1); print STDERR " after end row " . ($end[0] + 1) . "\n"; exit; } # start the excel object now my $oExcel = new Spreadsheet::XLSX; my $oBook = $oExcel->Parse($filename); # open the sheet my $oWkS = $oBook->{Worksheet}[$sheet]; # now check that the region exists in the file # if not trucate to the possible region # output a warning msg if ($start[1] < $oWkS->{MinCol}) { print STDERR int2col($start[1]) . " < min col " . int2col($oWkS->{MinCol}) . " Reseting\n"; $start[1] = $oWkS->{MinCol}; } if ($end[1] > $oWkS->{MaxCol}) { print STDERR int2col($end[1]) . " > max col " . int2col($oWkS->{MaxCol}) . " Reseting\n"; $end[1] = $oWkS->{MaxCol}; } if ($start[0] < $oWkS->{MinRow}) { print STDERR "" . ($start[0] + 1) . " < min row " . ($oWkS->{MinRow} + 1) . " Reseting\n"; $start[0] = $oWkS->{MinCol}; } if ($end[0] > $oWkS->{MaxRow}) { print STDERR "" . ($end[0] + 1) . " > max row " . ($oWkS->{MaxRow} + 1) . " Reseting\n"; $end[0] = $oWkS->{MaxRow}; } my $x1 = $start[1]; my $y1 = $start[0]; my $x2 = $end[1]; my $y2 = $end[0]; if (!$rotate) { for (my $y = $y1 ; $y <= $y2 ; $y++) { for (my $x = $x1 ; $x <= $x2 ; $x++) { my $cell = $oWkS->{Cells}[$y][$x]; $output .= $cell->Value if (defined $cell); $output .= "," if ($x != $x2); } $output .= "\n"; } } else { for (my $x = $x1 ; $x <= $x2 ; $x++) { for (my $y = $y1 ; $y <= $y2 ; $y++) { my $cell = $oWkS->{Cells}[$y][$x]; $output .= $cell->Value if (defined $cell); $output .= "," if ($y != $y2); } $output .= "\n"; } } return $output; } sub unescape_HTML { my $string = shift; my %options = @_; return $string if ($string eq ''); $string =~ s/"/"/g; $string =~ s/’/'/g; $string =~ s/&/&/g; return $string if $options{textarea}; # for textboxes, we leave < and > as < and > # so that people who enter "" into # our text boxes can't break forms $string =~ s/<//g; return $string; } 1; __END__ =head1 NAME Spreadsheet::XLSX::Utility2007 - Utility function for Spreadsheet::XLSX =head1 SYNOPSIS use strict; #Declare use Spreadsheet::XLSX::Utility2007 qw(ExcelFmt ExcelLocaltime LocaltimeExcel); #Convert localtime ->Excel Time my $iBirth = LocaltimeExcel(11, 10, 12, 23, 2, 64); # = 1964-3-23 12:10:11 print $iBirth, "\n"; # 23459.5070717593 #Convert Excel Time -> localtime my @aBirth = ExcelLocaltime($iBirth, undef); print join(":", @aBirth), "\n"; # 11:10:12:23:2:64:1:0 #Formatting print ExcelFmt('yyyy-mm-dd', $iBirth), "\n"; #1964-3-23 print ExcelFmt('m-d-yy', $iBirth), "\n"; # 3-23-64 print ExcelFmt('#,##0', $iBirth), "\n"; # 23,460 print ExcelFmt('#,##0.00', $iBirth), "\n"; # 23,459.51 print ExcelFmt('"My Birthday is (m/d):" m/d', $iBirth), "\n"; # My Birthday is (m/d): 3/23 =head1 DESCRIPTION Spreadsheet::XLSX::Utility2007 exports utility functions concerned with Excel format setting. ExcelFmt is used by Spreadsheet::XLSX::Fmt2007.pm which is used by Spreadsheet::XLSX. =head1 Functions This module can export 3 functions: ExcelFmt, ExcelLocaltime and LocaltimeExcel. =head2 ExcelFmt $sTxt = ExcelFmt($sFmt, $iData [, $i1904]); I<$sFmt> is a format string for Excel. I<$iData> is the target value. If I<$flg1904> is true, this functions assumes that epoch is 1904. I<$sTxt> is the result. For more detail and examples, please refer sample/chkFmt.pl in this distribution. ex. =head2 ExcelLocaltime ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec) = ExcelLocaltime($iExTime [, $flg1904]); I converts time information in Excel format into Perl localtime format. I<$iExTime> is a time of Excel. If I<$flg1904> is true, this functions assumes that epoch is 1904. I<$iSec>, I<$iMin>, I<$iHour>, I<$iDay>, I<$iMon>, I<$iYear>, I<$iwDay> are same as localtime. I<$iMSec> means 1/1,000,000 seconds(ms). =head2 LocaltimeExcel I<$iExTime> = LocaltimeExcel($iSec, $iMin, $iHour, $iDay, $iMon, $iYear [,$iMSec] [,$flg1904]) I converts time information in Perl localtime format into Excel format . I<$iSec>, I<$iMin>, I<$iHour>, I<$iDay>, I<$iMon>, I<$iYear> are same as localtime. If I<$flg1904> is true, this functions assumes that epoch is 1904. I<$iExTime> is a time of Excel. =head2 col2int I<$iInt> = col2int($sCol); converts a excel row letter into an int for use in an array This function was contributed by Kevin Mulholland. =head2 int2col I<$sCol> = int2col($iRow); convert a column number into column letters NOET: This is quite a brute force coarse method does not manage values over 701 (ZZ) This function was contributed by Kevin Mulholland. =head2 sheetRef (I<$iRow>, I<$iCol>) = sheetRef($sStr); convert an excel letter-number address into a useful array address NOTE: That also Excel uses X-Y notation, we normally use Y-X in arrays $sStr, excel coord (eg. A2). This function was contributed by Kevin Mulholland. =head2 xls2csv $sCsvTxt = xls2csv($sFileName, $sRegion, $iRotate); convert a chunk of an excel file into csv text chunk $sRegions = "sheet-colrow:colrow" (ex. '1-A1:B2' means 'A1:B2' for sheet 1) $iRotate = 0 or 1 (output should be rotated or not) This function was contributed by Kevin Mulholland. =head1 AUTHOR Rob Polocz rob.polocz@trackvia.com based on work by for Spreadsheet::ParseExcel by Kawai Takanori (Hippo2000) used with permission =head1 SEE ALSO Spreadsheet::ParseExcel, Spreadsheet::WriteExcel =head1 COPYRIGHT This module is part of the Spreadsheet::XLSX distribution. =cut