# 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::Utility;
#==============================================================================
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.1';
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::Utility)
#------------------------------------------------------------------------------
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::Utility)
#------------------------------------------------------------------------------
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::Utility)
#------------------------------------------------------------------------------
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::Utility)
#------------------------------------------------------------------------------
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::Utility)
#------------------------------------------------------------------------------
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::Utility)
#------------------------------------------------------------------------------
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::Utility)
#------------------------------------------------------------------------------
# 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::Utility)
#------------------------------------------------------------------------------
### 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::Utility)
#------------------------------------------------------------------------------
# -----------------------------------------------------------------------------
### 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::Utility)
#------------------------------------------------------------------------------
### 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 "</textarea>" into
# our text boxes can't break forms
$string =~ s/</</g;
$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::Utility 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::Utility 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<ExcelLocaltime> 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<LocaltimeExcel> 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