[Feature]Upload Modem source code
Change-Id: Id4294f30faced84d3e6fd6d5e61e1111bf287a37
diff --git a/mcu/tools/perl/OLE/Storage_Lite.pm b/mcu/tools/perl/OLE/Storage_Lite.pm
new file mode 100644
index 0000000..3ea2a57
--- /dev/null
+++ b/mcu/tools/perl/OLE/Storage_Lite.pm
@@ -0,0 +1,1686 @@
+# OLE::Storage_Lite
+# by Kawai, Takanori (Hippo2000) 2000.11.4, 8, 14
+# This Program is Still ALPHA version.
+#//////////////////////////////////////////////////////////////////////////////
+# OLE::Storage_Lite::PPS Object
+#//////////////////////////////////////////////////////////////////////////////
+#==============================================================================
+# OLE::Storage_Lite::PPS
+#==============================================================================
+package OLE::Storage_Lite::PPS;
+require Exporter;
+use strict;
+use vars qw($VERSION @ISA);
+@ISA = qw(Exporter);
+$VERSION = '0.19';
+
+#------------------------------------------------------------------------------
+# new (OLE::Storage_Lite::PPS)
+#------------------------------------------------------------------------------
+sub new ($$$$$$$$$$;$$) {
+#1. Constructor for General Usage
+ my($sClass, $iNo, $sNm, $iType, $iPrev, $iNext, $iDir,
+ $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild) = @_;
+
+ if($iType == OLE::Storage_Lite::PpsType_File()) { #FILE
+ return OLE::Storage_Lite::PPS::File->_new
+ ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd,
+ $iStart, $iSize, $sData, $raChild);
+ }
+ elsif($iType == OLE::Storage_Lite::PpsType_Dir()) { #DIRECTRY
+ return OLE::Storage_Lite::PPS::Dir->_new
+ ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd,
+ $iStart, $iSize, $sData, $raChild);
+ }
+ elsif($iType == OLE::Storage_Lite::PpsType_Root()) { #ROOT
+ return OLE::Storage_Lite::PPS::Root->_new
+ ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd,
+ $iStart, $iSize, $sData, $raChild);
+ }
+ else {
+ die "Error PPS:$iType $sNm\n";
+ }
+}
+#------------------------------------------------------------------------------
+# _new (OLE::Storage_Lite::PPS)
+# for OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub _new ($$$$$$$$$$$;$$) {
+ my($sClass, $iNo, $sNm, $iType, $iPrev, $iNext, $iDir,
+ $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild) = @_;
+#1. Constructor for OLE::Storage_Lite
+ my $oThis = {
+ No => $iNo,
+ Name => $sNm,
+ Type => $iType,
+ PrevPps => $iPrev,
+ NextPps => $iNext,
+ DirPps => $iDir,
+ Time1st => $raTime1st,
+ Time2nd => $raTime2nd,
+ StartBlock => $iStart,
+ Size => $iSize,
+ Data => $sData,
+ Child => $raChild,
+ };
+ bless $oThis, $sClass;
+ return $oThis;
+}
+#------------------------------------------------------------------------------
+# _DataLen (OLE::Storage_Lite::PPS)
+# Check for update
+#------------------------------------------------------------------------------
+sub _DataLen($) {
+ my($oSelf) =@_;
+ return 0 unless(defined($oSelf->{Data}));
+ return ($oSelf->{_PPS_FILE})?
+ ($oSelf->{_PPS_FILE}->stat())[7] : length($oSelf->{Data});
+}
+#------------------------------------------------------------------------------
+# _makeSmallData (OLE::Storage_Lite::PPS)
+#------------------------------------------------------------------------------
+sub _makeSmallData($$$) {
+ my($oThis, $aList, $rhInfo) = @_;
+ my ($sRes);
+ my $FILE = $rhInfo->{_FILEH_};
+ my $iSmBlk = 0;
+
+ foreach my $oPps (@$aList) {
+#1. Make SBD, small data string
+ if($oPps->{Type}==OLE::Storage_Lite::PpsType_File()) {
+ next if($oPps->{Size}<=0);
+ if($oPps->{Size} < $rhInfo->{_SMALL_SIZE}) {
+ my $iSmbCnt = int($oPps->{Size} / $rhInfo->{_SMALL_BLOCK_SIZE})
+ + (($oPps->{Size} % $rhInfo->{_SMALL_BLOCK_SIZE})? 1: 0);
+ #1.1 Add to SBD
+ for (my $i = 0; $i<($iSmbCnt-1); $i++) {
+ print {$FILE} (pack("V", $i+$iSmBlk+1));
+ }
+ print {$FILE} (pack("V", -2));
+
+ #1.2 Add to Data String(this will be written for RootEntry)
+ #Check for update
+ if($oPps->{_PPS_FILE}) {
+ my $sBuff;
+ $oPps->{_PPS_FILE}->seek(0, 0); #To The Top
+ while($oPps->{_PPS_FILE}->read($sBuff, 4096)) {
+ $sRes .= $sBuff;
+ }
+ }
+ else {
+ $sRes .= $oPps->{Data};
+ }
+ $sRes .= ("\x00" x
+ ($rhInfo->{_SMALL_BLOCK_SIZE} - ($oPps->{Size}% $rhInfo->{_SMALL_BLOCK_SIZE})))
+ if($oPps->{Size}% $rhInfo->{_SMALL_BLOCK_SIZE});
+ #1.3 Set for PPS
+ $oPps->{StartBlock} = $iSmBlk;
+ $iSmBlk += $iSmbCnt;
+ }
+ }
+ }
+ my $iSbCnt = int($rhInfo->{_BIG_BLOCK_SIZE}/ OLE::Storage_Lite::LongIntSize());
+ print {$FILE} (pack("V", -1) x ($iSbCnt - ($iSmBlk % $iSbCnt)))
+ if($iSmBlk % $iSbCnt);
+#2. Write SBD with adjusting length for block
+ return $sRes;
+}
+#------------------------------------------------------------------------------
+# _savePpsWk (OLE::Storage_Lite::PPS)
+#------------------------------------------------------------------------------
+sub _savePpsWk($$)
+{
+ my($oThis, $rhInfo) = @_;
+#1. Write PPS
+ my $FILE = $rhInfo->{_FILEH_};
+ print {$FILE} (
+ $oThis->{Name}
+ . ("\x00" x (64 - length($oThis->{Name}))) #64
+ , pack("v", length($oThis->{Name}) + 2) #66
+ , pack("c", $oThis->{Type}) #67
+ , pack("c", 0x00) #UK #68
+ , pack("V", $oThis->{PrevPps}) #Prev #72
+ , pack("V", $oThis->{NextPps}) #Next #76
+ , pack("V", $oThis->{DirPps}) #Dir #80
+ , "\x00\x09\x02\x00" #84
+ , "\x00\x00\x00\x00" #88
+ , "\xc0\x00\x00\x00" #92
+ , "\x00\x00\x00\x46" #96
+ , "\x00\x00\x00\x00" #100
+ , OLE::Storage_Lite::LocalDate2OLE($oThis->{Time1st}) #108
+ , OLE::Storage_Lite::LocalDate2OLE($oThis->{Time2nd}) #116
+ , pack("V", defined($oThis->{StartBlock})?
+ $oThis->{StartBlock}:0) #116
+ , pack("V", defined($oThis->{Size})?
+ $oThis->{Size} : 0) #124
+ , pack("V", 0), #128
+ );
+}
+
+#//////////////////////////////////////////////////////////////////////////////
+# OLE::Storage_Lite::PPS::Root Object
+#//////////////////////////////////////////////////////////////////////////////
+#==============================================================================
+# OLE::Storage_Lite::PPS::Root
+#==============================================================================
+package OLE::Storage_Lite::PPS::Root;
+require Exporter;
+use strict;
+use IO::File;
+use IO::Handle;
+use Fcntl;
+use vars qw($VERSION @ISA);
+@ISA = qw(OLE::Storage_Lite::PPS Exporter);
+$VERSION = '0.19';
+sub _savePpsSetPnt($$$);
+sub _savePpsSetPnt2($$$);
+#------------------------------------------------------------------------------
+# new (OLE::Storage_Lite::PPS::Root)
+#------------------------------------------------------------------------------
+sub new ($;$$$) {
+ my($sClass, $raTime1st, $raTime2nd, $raChild) = @_;
+ OLE::Storage_Lite::PPS::_new(
+ $sClass,
+ undef,
+ OLE::Storage_Lite::Asc2Ucs('Root Entry'),
+ 5,
+ undef,
+ undef,
+ undef,
+ $raTime1st,
+ $raTime2nd,
+ undef,
+ undef,
+ undef,
+ $raChild);
+}
+#------------------------------------------------------------------------------
+# save (OLE::Storage_Lite::PPS::Root)
+#------------------------------------------------------------------------------
+sub save($$;$$) {
+ my($oThis, $sFile, $bNoAs, $rhInfo) = @_;
+ #0.Initial Setting for saving
+ $rhInfo = {} unless($rhInfo);
+ $rhInfo->{_BIG_BLOCK_SIZE} = 2**
+ (($rhInfo->{_BIG_BLOCK_SIZE})?
+ _adjust2($rhInfo->{_BIG_BLOCK_SIZE}) : 9);
+ $rhInfo->{_SMALL_BLOCK_SIZE}= 2 **
+ (($rhInfo->{_SMALL_BLOCK_SIZE})?
+ _adjust2($rhInfo->{_SMALL_BLOCK_SIZE}): 6);
+ $rhInfo->{_SMALL_SIZE} = 0x1000;
+ $rhInfo->{_PPS_SIZE} = 0x80;
+
+ my $closeFile = 1;
+
+ #1.Open File
+ #1.1 $sFile is Ref of scalar
+ if(ref($sFile) eq 'SCALAR') {
+ require IO::Scalar;
+ my $oIo = new IO::Scalar $sFile, O_WRONLY;
+ $rhInfo->{_FILEH_} = $oIo;
+ }
+ #1.1.1 $sFile is a IO::Scalar object
+ # Now handled as a filehandle ref below.
+
+ #1.2 $sFile is a IO::Handle object
+ elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) {
+ # Not all filehandles support binmode() so try it in an eval.
+ eval{ binmode $sFile };
+ $rhInfo->{_FILEH_} = $sFile;
+ }
+ #1.3 $sFile is a simple filename string
+ elsif(!ref($sFile)) {
+ if($sFile ne '-') {
+ my $oIo = new IO::File;
+ $oIo->open(">$sFile") || return undef;
+ binmode($oIo);
+ $rhInfo->{_FILEH_} = $oIo;
+ }
+ else {
+ my $oIo = new IO::Handle;
+ $oIo->fdopen(fileno(STDOUT),"w") || return undef;
+ binmode($oIo);
+ $rhInfo->{_FILEH_} = $oIo;
+ }
+ }
+ #1.4 Assume that if $sFile is a ref then it is a valid filehandle
+ else {
+ # Not all filehandles support binmode() so try it in an eval.
+ eval{ binmode $sFile };
+ $rhInfo->{_FILEH_} = $sFile;
+ # Caller controls filehandle closing
+ $closeFile = 0;
+ }
+
+ my $iBlk = 0;
+ #1. Make an array of PPS (for Save)
+ my @aList=();
+ if($bNoAs) {
+ _savePpsSetPnt2([$oThis], \@aList, $rhInfo);
+ }
+ else {
+ _savePpsSetPnt([$oThis], \@aList, $rhInfo);
+ }
+ my ($iSBDcnt, $iBBcnt, $iPPScnt) = $oThis->_calcSize(\@aList, $rhInfo);
+
+ #2.Save Header
+ $oThis->_saveHeader($rhInfo, $iSBDcnt, $iBBcnt, $iPPScnt);
+
+ #3.Make Small Data string (write SBD)
+ my $sSmWk = $oThis->_makeSmallData(\@aList, $rhInfo);
+ $oThis->{Data} = $sSmWk; #Small Datas become RootEntry Data
+
+ #4. Write BB
+ my $iBBlk = $iSBDcnt;
+ $oThis->_saveBigData(\$iBBlk, \@aList, $rhInfo);
+
+ #5. Write PPS
+ $oThis->_savePps(\@aList, $rhInfo);
+
+ #6. Write BD and BDList and Adding Header informations
+ $oThis->_saveBbd($iSBDcnt, $iBBcnt, $iPPScnt, $rhInfo);
+
+ #7.Close File
+ return $rhInfo->{_FILEH_}->close if $closeFile;
+}
+#------------------------------------------------------------------------------
+# _calcSize (OLE::Storage_Lite::PPS)
+#------------------------------------------------------------------------------
+sub _calcSize($$)
+{
+ my($oThis, $raList, $rhInfo) = @_;
+
+#0. Calculate Basic Setting
+ my ($iSBDcnt, $iBBcnt, $iPPScnt) = (0,0,0);
+ my $iSmallLen = 0;
+ my $iSBcnt = 0;
+ foreach my $oPps (@$raList) {
+ if($oPps->{Type}==OLE::Storage_Lite::PpsType_File()) {
+ $oPps->{Size} = $oPps->_DataLen(); #Mod
+ if($oPps->{Size} < $rhInfo->{_SMALL_SIZE}) {
+ $iSBcnt += int($oPps->{Size} / $rhInfo->{_SMALL_BLOCK_SIZE})
+ + (($oPps->{Size} % $rhInfo->{_SMALL_BLOCK_SIZE})? 1: 0);
+ }
+ else {
+ $iBBcnt +=
+ (int($oPps->{Size}/ $rhInfo->{_BIG_BLOCK_SIZE}) +
+ (($oPps->{Size}% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0));
+ }
+ }
+ }
+ $iSmallLen = $iSBcnt * $rhInfo->{_SMALL_BLOCK_SIZE};
+ my $iSlCnt = int($rhInfo->{_BIG_BLOCK_SIZE}/ OLE::Storage_Lite::LongIntSize());
+ $iSBDcnt = int($iSBcnt / $iSlCnt)+ (($iSBcnt % $iSlCnt)? 1:0);
+ $iBBcnt += (int($iSmallLen/ $rhInfo->{_BIG_BLOCK_SIZE}) +
+ (( $iSmallLen% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0));
+ my $iCnt = scalar(@$raList);
+ my $iBdCnt = $rhInfo->{_BIG_BLOCK_SIZE}/OLE::Storage_Lite::PpsSize();
+ $iPPScnt = (int($iCnt/$iBdCnt) + (($iCnt % $iBdCnt)? 1: 0));
+ return ($iSBDcnt, $iBBcnt, $iPPScnt);
+}
+#------------------------------------------------------------------------------
+# _adjust2 (OLE::Storage_Lite::PPS::Root)
+#------------------------------------------------------------------------------
+sub _adjust2($) {
+ my($i2) = @_;
+ my $iWk;
+ $iWk = log($i2)/log(2);
+ return ($iWk > int($iWk))? int($iWk)+1:$iWk;
+}
+#------------------------------------------------------------------------------
+# _saveHeader (OLE::Storage_Lite::PPS::Root)
+#------------------------------------------------------------------------------
+sub _saveHeader($$$$$) {
+ my($oThis, $rhInfo, $iSBDcnt, $iBBcnt, $iPPScnt) = @_;
+ my $FILE = $rhInfo->{_FILEH_};
+
+#0. Calculate Basic Setting
+ my $iBlCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize();
+ my $i1stBdL = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize());
+ my $i1stBdMax = $i1stBdL * $iBlCnt - $i1stBdL;
+ my $iBdExL = 0;
+ my $iAll = $iBBcnt + $iPPScnt + $iSBDcnt;
+ my $iAllW = $iAll;
+ my $iBdCntW = int($iAllW / $iBlCnt) + (($iAllW % $iBlCnt)? 1: 0);
+ my $iBdCnt = int(($iAll + $iBdCntW) / $iBlCnt) + ((($iAllW+$iBdCntW) % $iBlCnt)? 1: 0);
+ my $i;
+
+ if ($iBdCnt > $i1stBdL) {
+ #0.1 Calculate BD count
+ $iBlCnt--; #the BlCnt is reduced in the count of the last sect is used for a pointer the next Bl
+ my $iBBleftover = $iAll - $i1stBdMax;
+
+ if ($iAll >$i1stBdMax) {
+ while(1) {
+ $iBdCnt = int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0);
+ $iBdExL = int(($iBdCnt) / $iBlCnt) + ((($iBdCnt) % $iBlCnt)? 1: 0);
+ $iBBleftover = $iBBleftover + $iBdExL;
+ last if($iBdCnt == (int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0)));
+ }
+ }
+ $iBdCnt += $i1stBdL;
+ #print "iBdCnt = $iBdCnt \n";
+ }
+#1.Save Header
+ print {$FILE} (
+ "\xD0\xCF\x11\xE0\xA1\xB1\x1A\xE1"
+ , "\x00\x00\x00\x00" x 4
+ , pack("v", 0x3b)
+ , pack("v", 0x03)
+ , pack("v", -2)
+ , pack("v", 9)
+ , pack("v", 6)
+ , pack("v", 0)
+ , "\x00\x00\x00\x00" x 2
+ , pack("V", $iBdCnt),
+ , pack("V", $iBBcnt+$iSBDcnt), #ROOT START
+ , pack("V", 0)
+ , pack("V", 0x1000)
+ , pack("V", $iSBDcnt ? 0 : -2) #Small Block Depot
+ , pack("V", $iSBDcnt)
+ );
+#2. Extra BDList Start, Count
+ if($iAll <= $i1stBdMax) {
+ print {$FILE} (
+ pack("V", -2), #Extra BDList Start
+ pack("V", 0), #Extra BDList Count
+ );
+ }
+ else {
+ print {$FILE} (
+ pack("V", $iAll+$iBdCnt),
+ pack("V", $iBdExL),
+ );
+ }
+
+#3. BDList
+ for($i=0; $i<$i1stBdL and $i < $iBdCnt; $i++) {
+ print {$FILE} (pack("V", $iAll+$i));
+ }
+ print {$FILE} ((pack("V", -1)) x($i1stBdL-$i)) if($i<$i1stBdL);
+}
+#------------------------------------------------------------------------------
+# _saveBigData (OLE::Storage_Lite::PPS)
+#------------------------------------------------------------------------------
+sub _saveBigData($$$$) {
+ my($oThis, $iStBlk, $raList, $rhInfo) = @_;
+ my $iRes = 0;
+ my $FILE = $rhInfo->{_FILEH_};
+
+#1.Write Big (ge 0x1000) Data into Block
+ foreach my $oPps (@$raList) {
+ if($oPps->{Type}!=OLE::Storage_Lite::PpsType_Dir()) {
+#print "PPS: $oPps DEF:", defined($oPps->{Data}), "\n";
+ $oPps->{Size} = $oPps->_DataLen(); #Mod
+ if(($oPps->{Size} >= $rhInfo->{_SMALL_SIZE}) ||
+ (($oPps->{Type} == OLE::Storage_Lite::PpsType_Root()) && defined($oPps->{Data}))) {
+ #1.1 Write Data
+ #Check for update
+ if($oPps->{_PPS_FILE}) {
+ my $sBuff;
+ my $iLen = 0;
+ $oPps->{_PPS_FILE}->seek(0, 0); #To The Top
+ while($oPps->{_PPS_FILE}->read($sBuff, 4096)) {
+ $iLen += length($sBuff);
+ print {$FILE} ($sBuff); #Check for update
+ }
+ }
+ else {
+ print {$FILE} ($oPps->{Data});
+ }
+ print {$FILE} (
+ "\x00" x
+ ($rhInfo->{_BIG_BLOCK_SIZE} -
+ ($oPps->{Size} % $rhInfo->{_BIG_BLOCK_SIZE}))
+ ) if ($oPps->{Size} % $rhInfo->{_BIG_BLOCK_SIZE});
+ #1.2 Set For PPS
+ $oPps->{StartBlock} = $$iStBlk;
+ $$iStBlk +=
+ (int($oPps->{Size}/ $rhInfo->{_BIG_BLOCK_SIZE}) +
+ (($oPps->{Size}% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0));
+ }
+ }
+ }
+}
+#------------------------------------------------------------------------------
+# _savePps (OLE::Storage_Lite::PPS::Root)
+#------------------------------------------------------------------------------
+sub _savePps($$$)
+{
+ my($oThis, $raList, $rhInfo) = @_;
+#0. Initial
+ my $FILE = $rhInfo->{_FILEH_};
+#2. Save PPS
+ foreach my $oItem (@$raList) {
+ $oItem->_savePpsWk($rhInfo);
+ }
+#3. Adjust for Block
+ my $iCnt = scalar(@$raList);
+ my $iBCnt = $rhInfo->{_BIG_BLOCK_SIZE} / $rhInfo->{_PPS_SIZE};
+ print {$FILE} ("\x00" x (($iBCnt - ($iCnt % $iBCnt)) * $rhInfo->{_PPS_SIZE}))
+ if($iCnt % $iBCnt);
+ return int($iCnt / $iBCnt) + (($iCnt % $iBCnt)? 1: 0);
+}
+#------------------------------------------------------------------------------
+# _savePpsSetPnt2 (OLE::Storage_Lite::PPS::Root)
+# For Test
+#------------------------------------------------------------------------------
+sub _savePpsSetPnt2($$$)
+{
+ my($aThis, $raList, $rhInfo) = @_;
+#1. make Array as Children-Relations
+#1.1 if No Children
+ if($#$aThis < 0) {
+ return 0xFFFFFFFF;
+ }
+ elsif($#$aThis == 0) {
+#1.2 Just Only one
+ push @$raList, $aThis->[0];
+ $aThis->[0]->{No} = $#$raList;
+ $aThis->[0]->{PrevPps} = 0xFFFFFFFF;
+ $aThis->[0]->{NextPps} = 0xFFFFFFFF;
+ $aThis->[0]->{DirPps} = _savePpsSetPnt2($aThis->[0]->{Child}, $raList, $rhInfo);
+ return $aThis->[0]->{No};
+ }
+ else {
+#1.3 Array
+ my $iCnt = $#$aThis + 1;
+#1.3.1 Define Center
+ my $iPos = 0; #int($iCnt/ 2); #$iCnt
+
+ my @aWk = @$aThis;
+ my @aPrev = ($#$aThis > 1)? splice(@aWk, 1, 1) : (); #$iPos);
+ my @aNext = splice(@aWk, 1); #, $iCnt - $iPos -1);
+ $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt2(
+ \@aPrev, $raList, $rhInfo);
+ push @$raList, $aThis->[$iPos];
+ $aThis->[$iPos]->{No} = $#$raList;
+
+#1.3.2 Devide a array into Previous,Next
+ $aThis->[$iPos]->{NextPps} = _savePpsSetPnt2(
+ \@aNext, $raList, $rhInfo);
+ $aThis->[$iPos]->{DirPps} = _savePpsSetPnt2($aThis->[$iPos]->{Child}, $raList, $rhInfo);
+ return $aThis->[$iPos]->{No};
+ }
+}
+#------------------------------------------------------------------------------
+# _savePpsSetPnt2 (OLE::Storage_Lite::PPS::Root)
+# For Test
+#------------------------------------------------------------------------------
+sub _savePpsSetPnt2s($$$)
+{
+ my($aThis, $raList, $rhInfo) = @_;
+#1. make Array as Children-Relations
+#1.1 if No Children
+ if($#$aThis < 0) {
+ return 0xFFFFFFFF;
+ }
+ elsif($#$aThis == 0) {
+#1.2 Just Only one
+ push @$raList, $aThis->[0];
+ $aThis->[0]->{No} = $#$raList;
+ $aThis->[0]->{PrevPps} = 0xFFFFFFFF;
+ $aThis->[0]->{NextPps} = 0xFFFFFFFF;
+ $aThis->[0]->{DirPps} = _savePpsSetPnt2($aThis->[0]->{Child}, $raList, $rhInfo);
+ return $aThis->[0]->{No};
+ }
+ else {
+#1.3 Array
+ my $iCnt = $#$aThis + 1;
+#1.3.1 Define Center
+ my $iPos = 0; #int($iCnt/ 2); #$iCnt
+ push @$raList, $aThis->[$iPos];
+ $aThis->[$iPos]->{No} = $#$raList;
+ my @aWk = @$aThis;
+#1.3.2 Devide a array into Previous,Next
+ my @aPrev = splice(@aWk, 0, $iPos);
+ my @aNext = splice(@aWk, 1, $iCnt - $iPos -1);
+ $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt2(
+ \@aPrev, $raList, $rhInfo);
+ $aThis->[$iPos]->{NextPps} = _savePpsSetPnt2(
+ \@aNext, $raList, $rhInfo);
+ $aThis->[$iPos]->{DirPps} = _savePpsSetPnt2($aThis->[$iPos]->{Child}, $raList, $rhInfo);
+ return $aThis->[$iPos]->{No};
+ }
+}
+#------------------------------------------------------------------------------
+# _savePpsSetPnt (OLE::Storage_Lite::PPS::Root)
+#------------------------------------------------------------------------------
+sub _savePpsSetPnt($$$)
+{
+ my($aThis, $raList, $rhInfo) = @_;
+#1. make Array as Children-Relations
+#1.1 if No Children
+ if($#$aThis < 0) {
+ return 0xFFFFFFFF;
+ }
+ elsif($#$aThis == 0) {
+#1.2 Just Only one
+ push @$raList, $aThis->[0];
+ $aThis->[0]->{No} = $#$raList;
+ $aThis->[0]->{PrevPps} = 0xFFFFFFFF;
+ $aThis->[0]->{NextPps} = 0xFFFFFFFF;
+ $aThis->[0]->{DirPps} = _savePpsSetPnt($aThis->[0]->{Child}, $raList, $rhInfo);
+ return $aThis->[0]->{No};
+ }
+ else {
+#1.3 Array
+ my $iCnt = $#$aThis + 1;
+#1.3.1 Define Center
+ my $iPos = int($iCnt/ 2); #$iCnt
+ push @$raList, $aThis->[$iPos];
+ $aThis->[$iPos]->{No} = $#$raList;
+ my @aWk = @$aThis;
+#1.3.2 Devide a array into Previous,Next
+ my @aPrev = splice(@aWk, 0, $iPos);
+ my @aNext = splice(@aWk, 1, $iCnt - $iPos -1);
+ $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt(
+ \@aPrev, $raList, $rhInfo);
+ $aThis->[$iPos]->{NextPps} = _savePpsSetPnt(
+ \@aNext, $raList, $rhInfo);
+ $aThis->[$iPos]->{DirPps} = _savePpsSetPnt($aThis->[$iPos]->{Child}, $raList, $rhInfo);
+ return $aThis->[$iPos]->{No};
+ }
+}
+#------------------------------------------------------------------------------
+# _savePpsSetPnt (OLE::Storage_Lite::PPS::Root)
+#------------------------------------------------------------------------------
+sub _savePpsSetPnt1($$$)
+{
+ my($aThis, $raList, $rhInfo) = @_;
+#1. make Array as Children-Relations
+#1.1 if No Children
+ if($#$aThis < 0) {
+ return 0xFFFFFFFF;
+ }
+ elsif($#$aThis == 0) {
+#1.2 Just Only one
+ push @$raList, $aThis->[0];
+ $aThis->[0]->{No} = $#$raList;
+ $aThis->[0]->{PrevPps} = 0xFFFFFFFF;
+ $aThis->[0]->{NextPps} = 0xFFFFFFFF;
+ $aThis->[0]->{DirPps} = _savePpsSetPnt($aThis->[0]->{Child}, $raList, $rhInfo);
+ return $aThis->[0]->{No};
+ }
+ else {
+#1.3 Array
+ my $iCnt = $#$aThis + 1;
+#1.3.1 Define Center
+ my $iPos = int($iCnt/ 2); #$iCnt
+ push @$raList, $aThis->[$iPos];
+ $aThis->[$iPos]->{No} = $#$raList;
+ my @aWk = @$aThis;
+#1.3.2 Devide a array into Previous,Next
+ my @aPrev = splice(@aWk, 0, $iPos);
+ my @aNext = splice(@aWk, 1, $iCnt - $iPos -1);
+ $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt(
+ \@aPrev, $raList, $rhInfo);
+ $aThis->[$iPos]->{NextPps} = _savePpsSetPnt(
+ \@aNext, $raList, $rhInfo);
+ $aThis->[$iPos]->{DirPps} = _savePpsSetPnt($aThis->[$iPos]->{Child}, $raList, $rhInfo);
+ return $aThis->[$iPos]->{No};
+ }
+}
+#------------------------------------------------------------------------------
+# _saveBbd (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _saveBbd($$$$)
+{
+ my($oThis, $iSbdSize, $iBsize, $iPpsCnt, $rhInfo) = @_;
+ my $FILE = $rhInfo->{_FILEH_};
+#0. Calculate Basic Setting
+ my $iBbCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize();
+ my $iBlCnt = $iBbCnt - 1;
+ my $i1stBdL = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize());
+ my $i1stBdMax = $i1stBdL * $iBbCnt - $i1stBdL;
+ my $iBdExL = 0;
+ my $iAll = $iBsize + $iPpsCnt + $iSbdSize;
+ my $iAllW = $iAll;
+ my $iBdCntW = int($iAllW / $iBbCnt) + (($iAllW % $iBbCnt)? 1: 0);
+ my $iBdCnt = 0;
+ my $i;
+#0.1 Calculate BD count
+ my $iBBleftover = $iAll - $i1stBdMax;
+ if ($iAll >$i1stBdMax) {
+
+ while(1) {
+ $iBdCnt = int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0);
+ $iBdExL = int(($iBdCnt) / $iBlCnt) + ((($iBdCnt) % $iBlCnt)? 1: 0);
+ $iBBleftover = $iBBleftover + $iBdExL;
+ last if($iBdCnt == (int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0)));
+ }
+ }
+ $iAllW += $iBdExL;
+ $iBdCnt += $i1stBdL;
+ #print "iBdCnt = $iBdCnt \n";
+
+#1. Making BD
+#1.1 Set for SBD
+ if($iSbdSize > 0) {
+ for ($i = 0; $i<($iSbdSize-1); $i++) {
+ print {$FILE} (pack("V", $i+1));
+ }
+ print {$FILE} (pack("V", -2));
+ }
+#1.2 Set for B
+ for ($i = 0; $i<($iBsize-1); $i++) {
+ print {$FILE} (pack("V", $i+$iSbdSize+1));
+ }
+ print {$FILE} (pack("V", -2));
+
+#1.3 Set for PPS
+ for ($i = 0; $i<($iPpsCnt-1); $i++) {
+ print {$FILE} (pack("V", $i+$iSbdSize+$iBsize+1));
+ }
+ print {$FILE} (pack("V", -2));
+#1.4 Set for BBD itself ( 0xFFFFFFFD : BBD)
+ for($i=0; $i<$iBdCnt;$i++) {
+ print {$FILE} (pack("V", 0xFFFFFFFD));
+ }
+#1.5 Set for ExtraBDList
+ for($i=0; $i<$iBdExL;$i++) {
+ print {$FILE} (pack("V", 0xFFFFFFFC));
+ }
+#1.6 Adjust for Block
+ print {$FILE} (pack("V", -1) x ($iBbCnt - (($iAllW + $iBdCnt) % $iBbCnt)))
+ if(($iAllW + $iBdCnt) % $iBbCnt);
+#2.Extra BDList
+ if($iBdCnt > $i1stBdL) {
+ my $iN=0;
+ my $iNb=0;
+ for($i=$i1stBdL;$i<$iBdCnt; $i++, $iN++) {
+ if($iN>=($iBbCnt-1)) {
+ $iN = 0;
+ $iNb++;
+ print {$FILE} (pack("V", $iAll+$iBdCnt+$iNb));
+ }
+ print {$FILE} (pack("V", $iBsize+$iSbdSize+$iPpsCnt+$i));
+ }
+ print {$FILE} (pack("V", -1) x (($iBbCnt-1) - (($iBdCnt-$i1stBdL) % ($iBbCnt-1))))
+ if(($iBdCnt-$i1stBdL) % ($iBbCnt-1));
+ print {$FILE} (pack("V", -2));
+ }
+}
+
+#//////////////////////////////////////////////////////////////////////////////
+# OLE::Storage_Lite::PPS::File Object
+#//////////////////////////////////////////////////////////////////////////////
+#==============================================================================
+# OLE::Storage_Lite::PPS::File
+#==============================================================================
+package OLE::Storage_Lite::PPS::File;
+require Exporter;
+use strict;
+use vars qw($VERSION @ISA);
+@ISA = qw(OLE::Storage_Lite::PPS Exporter);
+$VERSION = '0.19';
+#------------------------------------------------------------------------------
+# new (OLE::Storage_Lite::PPS::File)
+#------------------------------------------------------------------------------
+sub new ($$$) {
+ my($sClass, $sNm, $sData) = @_;
+ OLE::Storage_Lite::PPS::_new(
+ $sClass,
+ undef,
+ $sNm,
+ 2,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ $sData,
+ undef);
+}
+#------------------------------------------------------------------------------
+# newFile (OLE::Storage_Lite::PPS::File)
+#------------------------------------------------------------------------------
+sub newFile ($$;$) {
+ my($sClass, $sNm, $sFile) = @_;
+ my $oSelf =
+ OLE::Storage_Lite::PPS::_new(
+ $sClass,
+ undef,
+ $sNm,
+ 2,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ '',
+ undef);
+#
+ if((!defined($sFile)) or ($sFile eq '')) {
+ $oSelf->{_PPS_FILE} = IO::File->new_tmpfile();
+ }
+ elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) {
+ $oSelf->{_PPS_FILE} = $sFile;
+ }
+ elsif(!ref($sFile)) {
+ #File Name
+ $oSelf->{_PPS_FILE} = new IO::File;
+ return undef unless($oSelf->{_PPS_FILE});
+ $oSelf->{_PPS_FILE}->open("$sFile", "r+") || return undef;
+ }
+ else {
+ return undef;
+ }
+ if($oSelf->{_PPS_FILE}) {
+ $oSelf->{_PPS_FILE}->seek(0, 2);
+ binmode($oSelf->{_PPS_FILE});
+ $oSelf->{_PPS_FILE}->autoflush(1);
+ }
+ return $oSelf;
+}
+#------------------------------------------------------------------------------
+# append (OLE::Storage_Lite::PPS::File)
+#------------------------------------------------------------------------------
+sub append ($$) {
+ my($oSelf, $sData) = @_;
+ if($oSelf->{_PPS_FILE}) {
+ print {$oSelf->{_PPS_FILE}} $sData;
+ }
+ else {
+ $oSelf->{Data} .= $sData;
+ }
+}
+
+#//////////////////////////////////////////////////////////////////////////////
+# OLE::Storage_Lite::PPS::Dir Object
+#//////////////////////////////////////////////////////////////////////////////
+#------------------------------------------------------------------------------
+# new (OLE::Storage_Lite::PPS::Dir)
+#------------------------------------------------------------------------------
+package OLE::Storage_Lite::PPS::Dir;
+require Exporter;
+use strict;
+use vars qw($VERSION @ISA);
+@ISA = qw(OLE::Storage_Lite::PPS Exporter);
+$VERSION = '0.19';
+sub new ($$;$$$) {
+ my($sClass, $sName, $raTime1st, $raTime2nd, $raChild) = @_;
+ OLE::Storage_Lite::PPS::_new(
+ $sClass,
+ undef,
+ $sName,
+ 1,
+ undef,
+ undef,
+ undef,
+ $raTime1st,
+ $raTime2nd,
+ undef,
+ undef,
+ undef,
+ $raChild);
+}
+#==============================================================================
+# OLE::Storage_Lite
+#==============================================================================
+package OLE::Storage_Lite;
+require Exporter;
+
+use strict;
+use IO::File;
+use Time::Local 'timegm';
+
+use vars qw($VERSION @ISA @EXPORT);
+@ISA = qw(Exporter);
+$VERSION = '0.19';
+sub _getPpsSearch($$$$$;$);
+sub _getPpsTree($$$;$);
+#------------------------------------------------------------------------------
+# Const for OLE::Storage_Lite
+#------------------------------------------------------------------------------
+#0. Constants
+sub PpsType_Root {5};
+sub PpsType_Dir {1};
+sub PpsType_File {2};
+sub DataSizeSmall{0x1000};
+sub LongIntSize {4};
+sub PpsSize {0x80};
+#------------------------------------------------------------------------------
+# new OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub new($$) {
+ my($sClass, $sFile) = @_;
+ my $oThis = {
+ _FILE => $sFile,
+ };
+ bless $oThis;
+ return $oThis;
+}
+#------------------------------------------------------------------------------
+# getPpsTree: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub getPpsTree($;$)
+{
+ my($oThis, $bData) = @_;
+#0.Init
+ my $rhInfo = _initParse($oThis->{_FILE});
+ return undef unless($rhInfo);
+#1. Get Data
+ my ($oPps) = _getPpsTree(0, $rhInfo, $bData);
+ close(IN);
+ return $oPps;
+}
+#------------------------------------------------------------------------------
+# getSearch: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub getPpsSearch($$;$$)
+{
+ my($oThis, $raName, $bData, $iCase) = @_;
+#0.Init
+ my $rhInfo = _initParse($oThis->{_FILE});
+ return undef unless($rhInfo);
+#1. Get Data
+ my @aList = _getPpsSearch(0, $rhInfo, $raName, $bData, $iCase);
+ close(IN);
+ return @aList;
+}
+#------------------------------------------------------------------------------
+# getNthPps: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub getNthPps($$;$)
+{
+ my($oThis, $iNo, $bData) = @_;
+#0.Init
+ my $rhInfo = _initParse($oThis->{_FILE});
+ return undef unless($rhInfo);
+#1. Get Data
+ my $oPps = _getNthPps($iNo, $rhInfo, $bData);
+ close IN;
+ return $oPps;
+}
+#------------------------------------------------------------------------------
+# _initParse: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub _initParse($) {
+ my($sFile)=@_;
+ my $oIo;
+ #1. $sFile is Ref of scalar
+ if(ref($sFile) eq 'SCALAR') {
+ require IO::Scalar;
+ $oIo = new IO::Scalar;
+ $oIo->open($sFile);
+ }
+ #2. $sFile is a IO::Handle object
+ elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) {
+ $oIo = $sFile;
+ binmode($oIo);
+ }
+ #3. $sFile is a simple filename string
+ elsif(!ref($sFile)) {
+ $oIo = new IO::File;
+ $oIo->open("<$sFile") || return undef;
+ binmode($oIo);
+ }
+ #4 Assume that if $sFile is a ref then it is a valid filehandle
+ else {
+ $oIo = $sFile;
+ # Not all filehandles support binmode() so try it in an eval.
+ eval{ binmode $oIo };
+ }
+ return _getHeaderInfo($oIo);
+}
+#------------------------------------------------------------------------------
+# _getPpsTree: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub _getPpsTree($$$;$) {
+ my($iNo, $rhInfo, $bData, $raDone) = @_;
+ if(defined($raDone)) {
+ return () if(grep {$_ ==$iNo} @$raDone);
+ }
+ else {
+ $raDone=[];
+ }
+ push @$raDone, $iNo;
+
+ my $iRootBlock = $rhInfo->{_ROOT_START} ;
+#1. Get Information about itself
+ my $oPps = _getNthPps($iNo, $rhInfo, $bData);
+#2. Child
+ if($oPps->{DirPps} != 0xFFFFFFFF) {
+ my @aChildL = _getPpsTree($oPps->{DirPps}, $rhInfo, $bData, $raDone);
+ $oPps->{Child} = \@aChildL;
+ }
+ else {
+ $oPps->{Child} = undef;
+ }
+#3. Previous,Next PPSs
+ my @aList = ();
+ push @aList, _getPpsTree($oPps->{PrevPps}, $rhInfo, $bData, $raDone)
+ if($oPps->{PrevPps} != 0xFFFFFFFF);
+ push @aList, $oPps;
+ push @aList, _getPpsTree($oPps->{NextPps}, $rhInfo, $bData, $raDone)
+ if($oPps->{NextPps} != 0xFFFFFFFF);
+ return @aList;
+}
+#------------------------------------------------------------------------------
+# _getPpsSearch: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub _getPpsSearch($$$$$;$) {
+ my($iNo, $rhInfo, $raName, $bData, $iCase, $raDone) = @_;
+ my $iRootBlock = $rhInfo->{_ROOT_START} ;
+ my @aRes;
+#1. Check it self
+ if(defined($raDone)) {
+ return () if(grep {$_==$iNo} @$raDone);
+ }
+ else {
+ $raDone=[];
+ }
+ push @$raDone, $iNo;
+ my $oPps = _getNthPps($iNo, $rhInfo, undef);
+# if(grep($_ eq $oPps->{Name}, @$raName)) {
+ if(($iCase && (grep(/^\Q$oPps->{Name}\E$/i, @$raName))) ||
+ (grep($_ eq $oPps->{Name}, @$raName))) {
+ $oPps = _getNthPps($iNo, $rhInfo, $bData) if ($bData);
+ @aRes = ($oPps);
+ }
+ else {
+ @aRes = ();
+ }
+#2. Check Child, Previous, Next PPSs
+ push @aRes, _getPpsSearch($oPps->{DirPps}, $rhInfo, $raName, $bData, $iCase, $raDone)
+ if($oPps->{DirPps} != 0xFFFFFFFF) ;
+ push @aRes, _getPpsSearch($oPps->{PrevPps}, $rhInfo, $raName, $bData, $iCase, $raDone)
+ if($oPps->{PrevPps} != 0xFFFFFFFF );
+ push @aRes, _getPpsSearch($oPps->{NextPps}, $rhInfo, $raName, $bData, $iCase, $raDone)
+ if($oPps->{NextPps} != 0xFFFFFFFF);
+ return @aRes;
+}
+#===================================================================
+# Get Header Info (BASE Informain about that file)
+#===================================================================
+sub _getHeaderInfo($){
+ my($FILE) = @_;
+ my($iWk);
+ my $rhInfo = {};
+ $rhInfo->{_FILEH_} = $FILE;
+ my $sWk;
+#0. Check ID
+ $rhInfo->{_FILEH_}->seek(0, 0);
+ $rhInfo->{_FILEH_}->read($sWk, 8);
+ return undef unless($sWk eq "\xD0\xCF\x11\xE0\xA1\xB1\x1A\xE1");
+#BIG BLOCK SIZE
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x1E, 2, "v");
+ return undef unless(defined($iWk));
+ $rhInfo->{_BIG_BLOCK_SIZE} = 2 ** $iWk;
+#SMALL BLOCK SIZE
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x20, 2, "v");
+ return undef unless(defined($iWk));
+ $rhInfo->{_SMALL_BLOCK_SIZE} = 2 ** $iWk;
+#BDB Count
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x2C, 4, "V");
+ return undef unless(defined($iWk));
+ $rhInfo->{_BDB_COUNT} = $iWk;
+#START BLOCK
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x30, 4, "V");
+ return undef unless(defined($iWk));
+ $rhInfo->{_ROOT_START} = $iWk;
+#MIN SIZE OF BB
+# $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x38, 4, "V");
+# return undef unless(defined($iWk));
+# $rhInfo->{_MIN_SIZE_BB} = $iWk;
+#SMALL BD START
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x3C, 4, "V");
+ return undef unless(defined($iWk));
+ $rhInfo->{_SBD_START} = $iWk;
+#SMALL BD COUNT
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x40, 4, "V");
+ return undef unless(defined($iWk));
+ $rhInfo->{_SBD_COUNT} = $iWk;
+#EXTRA BBD START
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x44, 4, "V");
+ return undef unless(defined($iWk));
+ $rhInfo->{_EXTRA_BBD_START} = $iWk;
+#EXTRA BD COUNT
+ $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x48, 4, "V");
+ return undef unless(defined($iWk));
+ $rhInfo->{_EXTRA_BBD_COUNT} = $iWk;
+#GET BBD INFO
+ $rhInfo->{_BBD_INFO}= _getBbdInfo($rhInfo);
+#GET ROOT PPS
+ my $oRoot = _getNthPps(0, $rhInfo, undef);
+ $rhInfo->{_SB_START} = $oRoot->{StartBlock};
+ $rhInfo->{_SB_SIZE} = $oRoot->{Size};
+ return $rhInfo;
+}
+#------------------------------------------------------------------------------
+# _getInfoFromFile
+#------------------------------------------------------------------------------
+sub _getInfoFromFile($$$$) {
+ my($FILE, $iPos, $iLen, $sFmt) =@_;
+ my($sWk);
+ return undef unless($FILE);
+ return undef if($FILE->seek($iPos, 0)==0);
+ return undef if($FILE->read($sWk, $iLen)!=$iLen);
+ return unpack($sFmt, $sWk);
+}
+#------------------------------------------------------------------------------
+# _getBbdInfo
+#------------------------------------------------------------------------------
+sub _getBbdInfo($) {
+ my($rhInfo) =@_;
+ my @aBdList = ();
+ my $iBdbCnt = $rhInfo->{_BDB_COUNT};
+ my $iGetCnt;
+ my $sWk;
+ my $i1stCnt = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize());
+ my $iBdlCnt = int($rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize()) - 1;
+
+#1. 1st BDlist
+ $rhInfo->{_FILEH_}->seek(0x4C, 0);
+ $iGetCnt = ($iBdbCnt < $i1stCnt)? $iBdbCnt: $i1stCnt;
+ $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()*$iGetCnt);
+ push @aBdList, unpack("V$iGetCnt", $sWk);
+ $iBdbCnt -= $iGetCnt;
+#2. Extra BDList
+ my $iBlock = $rhInfo->{_EXTRA_BBD_START};
+ while(($iBdbCnt> 0) && _isNormalBlock($iBlock)){
+ _setFilePos($iBlock, 0, $rhInfo);
+ $iGetCnt= ($iBdbCnt < $iBdlCnt)? $iBdbCnt: $iBdlCnt;
+ $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()*$iGetCnt);
+ push @aBdList, unpack("V$iGetCnt", $sWk);
+ $iBdbCnt -= $iGetCnt;
+ $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize());
+ $iBlock = unpack("V", $sWk);
+ }
+#3.Get BDs
+ my @aWk;
+ my %hBd;
+ my $iBlkNo = 0;
+ my $iBdL;
+ my $i;
+ my $iBdCnt = int($rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize());
+ foreach $iBdL (@aBdList) {
+ _setFilePos($iBdL, 0, $rhInfo);
+ $rhInfo->{_FILEH_}->read($sWk, $rhInfo->{_BIG_BLOCK_SIZE});
+ @aWk = unpack("V$iBdCnt", $sWk);
+ for($i=0;$i<$iBdCnt;$i++, $iBlkNo++) {
+ if($aWk[$i] != ($iBlkNo+1)){
+ $hBd{$iBlkNo} = $aWk[$i];
+ }
+ }
+ }
+ return \%hBd;
+}
+#------------------------------------------------------------------------------
+# getNthPps (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _getNthPps($$$){
+ my($iPos, $rhInfo, $bData) = @_;
+ my($iPpsStart) = ($rhInfo->{_ROOT_START});
+ my($iPpsBlock, $iPpsPos);
+ my $sWk;
+ my $iBlock;
+
+ my $iBaseCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::PpsSize();
+ $iPpsBlock = int($iPos / $iBaseCnt);
+ $iPpsPos = $iPos % $iBaseCnt;
+
+ $iBlock = _getNthBlockNo($iPpsStart, $iPpsBlock, $rhInfo);
+ return undef unless(defined($iBlock));
+
+ _setFilePos($iBlock, OLE::Storage_Lite::PpsSize()*$iPpsPos, $rhInfo);
+ $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::PpsSize());
+ return undef unless($sWk);
+ my $iNmSize = unpack("v", substr($sWk, 0x40, 2));
+ $iNmSize = ($iNmSize > 2)? $iNmSize - 2 : $iNmSize;
+ my $sNm= substr($sWk, 0, $iNmSize);
+ my $iType = unpack("C", substr($sWk, 0x42, 2));
+ my $lPpsPrev = unpack("V", substr($sWk, 0x44, OLE::Storage_Lite::LongIntSize()));
+ my $lPpsNext = unpack("V", substr($sWk, 0x48, OLE::Storage_Lite::LongIntSize()));
+ my $lDirPps = unpack("V", substr($sWk, 0x4C, OLE::Storage_Lite::LongIntSize()));
+ my @raTime1st =
+ (($iType == OLE::Storage_Lite::PpsType_Root()) or ($iType == OLE::Storage_Lite::PpsType_Dir()))?
+ OLEDate2Local(substr($sWk, 0x64, 8)) : undef ,
+ my @raTime2nd =
+ (($iType == OLE::Storage_Lite::PpsType_Root()) or ($iType == OLE::Storage_Lite::PpsType_Dir()))?
+ OLEDate2Local(substr($sWk, 0x6C, 8)) : undef,
+ my($iStart, $iSize) = unpack("VV", substr($sWk, 0x74, 8));
+ if($bData) {
+ my $sData = _getData($iType, $iStart, $iSize, $rhInfo);
+ return OLE::Storage_Lite::PPS->new(
+ $iPos, $sNm, $iType, $lPpsPrev, $lPpsNext, $lDirPps,
+ \@raTime1st, \@raTime2nd, $iStart, $iSize, $sData, undef);
+ }
+ else {
+ return OLE::Storage_Lite::PPS->new(
+ $iPos, $sNm, $iType, $lPpsPrev, $lPpsNext, $lDirPps,
+ \@raTime1st, \@raTime2nd, $iStart, $iSize, undef, undef);
+ }
+}
+#------------------------------------------------------------------------------
+# _setFilePos (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _setFilePos($$$){
+ my($iBlock, $iPos, $rhInfo) = @_;
+ $rhInfo->{_FILEH_}->seek(($iBlock+1)*$rhInfo->{_BIG_BLOCK_SIZE}+$iPos, 0);
+}
+#------------------------------------------------------------------------------
+# _getNthBlockNo (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _getNthBlockNo($$$){
+ my($iStBlock, $iNth, $rhInfo) = @_;
+ my $iSv;
+ my $iNext = $iStBlock;
+ for(my $i =0; $i<$iNth; $i++) {
+ $iSv = $iNext;
+ $iNext = _getNextBlockNo($iSv, $rhInfo);
+ return undef unless _isNormalBlock($iNext);
+ }
+ return $iNext;
+}
+#------------------------------------------------------------------------------
+# _getData (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _getData($$$$)
+{
+ my($iType, $iBlock, $iSize, $rhInfo) = @_;
+ if ($iType == OLE::Storage_Lite::PpsType_File()) {
+ if($iSize < OLE::Storage_Lite::DataSizeSmall()) {
+ return _getSmallData($iBlock, $iSize, $rhInfo);
+ }
+ else {
+ return _getBigData($iBlock, $iSize, $rhInfo);
+ }
+ }
+ elsif($iType == OLE::Storage_Lite::PpsType_Root()) { #Root
+ return _getBigData($iBlock, $iSize, $rhInfo);
+ }
+ elsif($iType == OLE::Storage_Lite::PpsType_Dir()) { # Directory
+ return undef;
+ }
+}
+#------------------------------------------------------------------------------
+# _getBigData (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _getBigData($$$)
+{
+ my($iBlock, $iSize, $rhInfo) = @_;
+ my($iRest, $sWk, $sRes);
+
+ return '' unless(_isNormalBlock($iBlock));
+ $iRest = $iSize;
+ my($i, $iGetSize, $iNext);
+ $sRes = '';
+ my @aKeys= sort({$a<=>$b} keys(%{$rhInfo->{_BBD_INFO}}));
+
+ while ($iRest > 0) {
+ my @aRes = grep($_ >= $iBlock, @aKeys);
+ my $iNKey = $aRes[0];
+ $i = $iNKey - $iBlock;
+ $iNext = $rhInfo->{_BBD_INFO}{$iNKey};
+ _setFilePos($iBlock, 0, $rhInfo);
+ my $iGetSize = ($rhInfo->{_BIG_BLOCK_SIZE} * ($i+1));
+ $iGetSize = $iRest if($iRest < $iGetSize);
+ $rhInfo->{_FILEH_}->read( $sWk, $iGetSize);
+ $sRes .= $sWk;
+ $iRest -= $iGetSize;
+ $iBlock= $iNext;
+ }
+ return $sRes;
+}
+#------------------------------------------------------------------------------
+# _getNextBlockNo (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _getNextBlockNo($$){
+ my($iBlockNo, $rhInfo) = @_;
+ my $iRes = $rhInfo->{_BBD_INFO}->{$iBlockNo};
+ return defined($iRes)? $iRes: $iBlockNo+1;
+}
+#------------------------------------------------------------------------------
+# _isNormalBlock (OLE::Storage_Lite)
+# 0xFFFFFFFC : BDList, 0xFFFFFFFD : BBD,
+# 0xFFFFFFFE: End of Chain 0xFFFFFFFF : unused
+#------------------------------------------------------------------------------
+sub _isNormalBlock($){
+ my($iBlock) = @_;
+ return ($iBlock < 0xFFFFFFFC)? 1: undef;
+}
+#------------------------------------------------------------------------------
+# _getSmallData (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _getSmallData($$$)
+{
+ my($iSmBlock, $iSize, $rhInfo) = @_;
+ my($sRes, $sWk);
+ my $iRest = $iSize;
+ $sRes = '';
+ while ($iRest > 0) {
+ _setFilePosSmall($iSmBlock, $rhInfo);
+ $rhInfo->{_FILEH_}->read($sWk,
+ ($iRest >= $rhInfo->{_SMALL_BLOCK_SIZE})?
+ $rhInfo->{_SMALL_BLOCK_SIZE}: $iRest);
+ $sRes .= $sWk;
+ $iRest -= $rhInfo->{_SMALL_BLOCK_SIZE};
+ $iSmBlock= _getNextSmallBlockNo($iSmBlock, $rhInfo);
+ }
+ return $sRes;
+}
+#------------------------------------------------------------------------------
+# _setFilePosSmall(OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _setFilePosSmall($$)
+{
+ my($iSmBlock, $rhInfo) = @_;
+ my $iSmStart = $rhInfo->{_SB_START};
+ my $iBaseCnt = $rhInfo->{_BIG_BLOCK_SIZE} / $rhInfo->{_SMALL_BLOCK_SIZE};
+ my $iNth = int($iSmBlock/$iBaseCnt);
+ my $iPos = $iSmBlock % $iBaseCnt;
+
+ my $iBlk = _getNthBlockNo($iSmStart, $iNth, $rhInfo);
+ _setFilePos($iBlk, $iPos * $rhInfo->{_SMALL_BLOCK_SIZE}, $rhInfo);
+}
+#------------------------------------------------------------------------------
+# _getNextSmallBlockNo (OLE::Storage_Lite)
+#------------------------------------------------------------------------------
+sub _getNextSmallBlockNo($$)
+{
+ my($iSmBlock, $rhInfo) = @_;
+ my($sWk);
+
+ my $iBaseCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize();
+ my $iNth = int($iSmBlock/$iBaseCnt);
+ my $iPos = $iSmBlock % $iBaseCnt;
+ my $iBlk = _getNthBlockNo($rhInfo->{_SBD_START}, $iNth, $rhInfo);
+ _setFilePos($iBlk, $iPos * OLE::Storage_Lite::LongIntSize(), $rhInfo);
+ $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize());
+ return unpack("V", $sWk);
+
+}
+#------------------------------------------------------------------------------
+# Asc2Ucs: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub Asc2Ucs($)
+{
+ my($sAsc) = @_;
+ return join("\x00", split //, $sAsc) . "\x00";
+}
+#------------------------------------------------------------------------------
+# Ucs2Asc: OLE::Storage_Lite
+#------------------------------------------------------------------------------
+sub Ucs2Asc($)
+{
+ my($sUcs) = @_;
+ return join('', map(pack('c', $_), unpack('v*', $sUcs)));
+}
+
+#------------------------------------------------------------------------------
+# OLEDate2Local()
+#
+# Convert from a Window FILETIME structure to a localtime array. FILETIME is
+# a 64-bit value representing the number of 100-nanosecond intervals since
+# January 1 1601.
+#
+# We first convert the FILETIME to seconds and then subtract the difference
+# between the 1601 epoch and the 1970 Unix epoch.
+#
+sub OLEDate2Local {
+
+ my $oletime = shift;
+
+ # Unpack the FILETIME into high and low longs.
+ my ( $lo, $hi ) = unpack 'V2', $oletime;
+
+ # Convert the longs to a double.
+ my $nanoseconds = $hi * 2**32 + $lo;
+
+ # Convert the 100 nanosecond units into seconds.
+ my $time = $nanoseconds / 1e7;
+
+ # Subtract the number of seconds between the 1601 and 1970 epochs.
+ $time -= 11644473600;
+
+ # Convert to a localtime (actually gmtime) structure.
+ my @localtime = gmtime($time);
+
+ return @localtime;
+}
+
+#------------------------------------------------------------------------------
+# LocalDate2OLE()
+#
+# Convert from a a localtime array to a Window FILETIME structure. FILETIME is
+# a 64-bit value representing the number of 100-nanosecond intervals since
+# January 1 1601.
+#
+# We first convert the localtime (actually gmtime) to seconds and then add the
+# difference between the 1601 epoch and the 1970 Unix epoch. We convert that to
+# 100 nanosecond units, divide it into high and low longs and return it as a
+# packed 64bit structure.
+#
+sub LocalDate2OLE {
+
+ my $localtime = shift;
+
+ return "\x00" x 8 unless $localtime;
+
+ # Convert from localtime (actually gmtime) to seconds.
+ my $time = timegm( @{$localtime} );
+
+ # Add the number of seconds between the 1601 and 1970 epochs.
+ $time += 11644473600;
+
+ # The FILETIME seconds are in units of 100 nanoseconds.
+ my $nanoseconds = $time * 1E7;
+
+use POSIX 'fmod';
+
+ # Pack the total nanoseconds into 64 bits...
+ my $hi = int( $nanoseconds / 2**32 );
+ my $lo = fmod($nanoseconds, 2**32);
+
+ my $oletime = pack "VV", $lo, $hi;
+
+ return $oletime;
+}
+
+1;
+__END__
+
+
+=head1 NAME
+
+OLE::Storage_Lite - Simple Class for OLE document interface.
+
+=head1 SYNOPSIS
+
+ use OLE::Storage_Lite;
+
+ # Initialize.
+
+ # From a file
+ my $oOl = OLE::Storage_Lite->new("some.xls");
+
+ # From a filehandle object
+ use IO::File;
+ my $oIo = new IO::File;
+ $oIo->open("<iofile.xls");
+ binmode($oIo);
+ my $oOl = OLE::Storage_Lite->new($oFile);
+
+ # Read data
+ my $oPps = $oOl->getPpsTree(1);
+
+ # Save Data
+ # To a File
+ $oPps->save("kaba.xls"); #kaba.xls
+ $oPps->save('-'); #STDOUT
+
+ # To a filehandle object
+ my $oIo = new IO::File;
+ $oIo->open(">iofile.xls");
+ bimode($oIo);
+ $oPps->save($oIo);
+
+
+=head1 DESCRIPTION
+
+OLE::Storage_Lite allows you to read and write an OLE structured file.
+
+OLE::Storage_Lite::PPS is a class representing PPS. OLE::Storage_Lite::PPS::Root, OLE::Storage_Lite::PPS::File and OLE::Storage_Lite::PPS::Dir
+are subclasses of OLE::Storage_Lite::PPS.
+
+
+=head2 new()
+
+Constructor.
+
+ $oOle = OLE::Storage_Lite->new($sFile);
+
+Creates a OLE::Storage_Lite object for C<$sFile>. C<$sFile> must be a correct file name.
+
+The C<new()> constructor also accepts a valid filehandle. Remember to C<binmode()> the filehandle first.
+
+
+=head2 getPpsTree()
+
+ $oPpsRoot = $oOle->getPpsTree([$bData]);
+
+Returns PPS as an OLE::Storage_Lite::PPS::Root object.
+Other PPS objects will be included as its children.
+
+If C<$bData> is true, the objects will have data in the file.
+
+
+=head2 getPpsSearch()
+
+ $oPpsRoot = $oOle->getPpsTree($raName [, $bData][, $iCase] );
+
+Returns PPSs as OLE::Storage_Lite::PPS objects that has the name specified in C<$raName> array.
+
+If C<$bData> is true, the objects will have data in the file.
+If C<$iCase> is true, search is case insensitive.
+
+
+=head2 getNthPps()
+
+ $oPpsRoot = $oOle->getNthPps($iNth [, $bData]);
+
+Returns PPS as C<OLE::Storage_Lite::PPS> object specified number C<$iNth>.
+
+If C<$bData> is true, the objects will have data in the file.
+
+
+=head2 Asc2Ucs()
+
+ $sUcs2 = OLE::Storage_Lite::Asc2Ucs($sAsc>);
+
+Utility function. Just adds 0x00 after every characters in C<$sAsc>.
+
+
+=head2 Ucs2Asc()
+
+ $sAsc = OLE::Storage_Lite::Ucs2Asc($sUcs2);
+
+Utility function. Just deletes 0x00 after words in C<$sUcs>.
+
+
+=head1 OLE::Storage_Lite::PPS
+
+OLE::Storage_Lite::PPS has these properties:
+
+=over 4
+
+=item No
+
+Order number in saving.
+
+=item Name
+
+Its name in UCS2 (a.k.a Unicode).
+
+=item Type
+
+Its type (1:Dir, 2:File (Data), 5: Root)
+
+=item PrevPps
+
+Previous pps (as No)
+
+=item NextPps
+
+Next pps (as No)
+
+=item DirPps
+
+Dir pps (as No).
+
+=item Time1st
+
+Timestamp 1st in array ref as similar fomat of localtime.
+
+=item Time2nd
+
+Timestamp 2nd in array ref as similar fomat of localtime.
+
+=item StartBlock
+
+Start block number
+
+=item Size
+
+Size of the pps
+
+=item Data
+
+Its data
+
+=item Child
+
+Its child PPSs in array ref
+
+=back
+
+
+=head1 OLE::Storage_Lite::PPS::Root
+
+OLE::Storage_Lite::PPS::Root has 2 methods.
+
+=head2 new()
+
+ $oRoot = OLE::Storage_Lite::PPS::Root->new(
+ $raTime1st,
+ $raTime2nd,
+ $raChild);
+
+
+Constructor.
+
+C<$raTime1st>, C<$raTime2nd> are array refs with ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear).
+$iSec means seconds, $iMin means minutes. $iHour means hours.
+$iDay means day. $iMon is month -1. $iYear is year - 1900.
+
+C<$raChild> is a array ref of children PPSs.
+
+
+=head2 save()
+
+ $oRoot = $oRoot>->save(
+ $sFile,
+ $bNoAs);
+
+
+Saves information into C<$sFile>. If C<$sFile> is '-', this will use STDOUT.
+
+The C<new()> constructor also accepts a valid filehandle. Remember to C<binmode()> the filehandle first.
+
+If C<$bNoAs> is defined, this function will use the No of PPSs for saving order.
+If C<$bNoAs> is undefined, this will calculate PPS saving order.
+
+
+=head1 OLE::Storage_Lite::PPS::Dir
+
+OLE::Storage_Lite::PPS::Dir has 1 method.
+
+=head2 new()
+
+ $oRoot = OLE::Storage_Lite::PPS::Dir->new(
+ $sName,
+ [, $raTime1st]
+ [, $raTime2nd]
+ [, $raChild>]);
+
+
+Constructor.
+
+C<$sName> is a name of the PPS.
+
+C<$raTime1st>, C<$raTime2nd> is a array ref as
+($iSec, $iMin, $iHour, $iDay, $iMon, $iYear).
+$iSec means seconds, $iMin means minutes. $iHour means hours.
+$iDay means day. $iMon is month -1. $iYear is year - 1900.
+
+C<$raChild> is a array ref of children PPSs.
+
+
+=head1 OLE::Storage_Lite::PPS::File
+
+OLE::Storage_Lite::PPS::File has 3 method.
+
+=head2 new
+
+ $oRoot = OLE::Storage_Lite::PPS::File->new($sName, $sData);
+
+C<$sName> is name of the PPS.
+
+C<$sData> is data of the PPS.
+
+
+=head2 newFile()
+
+ $oRoot = OLE::Storage_Lite::PPS::File->newFile($sName, $sFile);
+
+This function makes to use file handle for geting and storing data.
+
+C<$sName> is name of the PPS.
+
+If C<$sFile> is scalar, it assumes that is a filename.
+If C<$sFile> is an IO::Handle object, it uses that specified handle.
+If C<$sFile> is undef or '', it uses temporary file.
+
+CAUTION: Take care C<$sFile> will be updated by C<append> method.
+So if you want to use IO::Handle and append a data to it,
+you should open the handle with "r+".
+
+
+=head2 append()
+
+ $oRoot = $oPps->append($sData);
+
+appends specified data to that PPS.
+
+C<$sData> is appending data for that PPS.
+
+
+=head1 CAUTION
+
+A saved file with VBA (a.k.a Macros) by this module will not work correctly.
+However modules can get the same information from the file,
+the file occurs a error in application(Word, Excel ...).
+
+
+=head1 DEPRECATED FEATURES
+
+Older version of C<OLE::Storage_Lite> autovivified a scalar ref in the C<new()> constructors into a scalar filehandle. This functionality is still there for backwards compatibility but it is highly recommended that you do not use it. Instead create a filehandle (scalar or otherwise) and pass that in.
+
+
+=head1 COPYRIGHT
+
+The OLE::Storage_Lite module is Copyright (c) 2000,2001 Kawai Takanori. Japan.
+All rights reserved.
+
+You may distribute under the terms of either the GNU General Public
+License or the Artistic License, as specified in the Perl README file.
+
+
+=head1 ACKNOWLEDGEMENTS
+
+First of all, I would like to acknowledge to Martin Schwartz and his module OLE::Storage.
+
+
+=head1 AUTHOR
+
+Kawai Takanori kwitknr@cpan.org
+
+This module is currently maintained by John McNamara jmcnamara@cpan.org
+
+
+=head1 SEE ALSO
+
+OLE::Storage
+
+Documentation for the OLE Compound document has been released by Microsoft under the I<Open Specification Promise>. See http://www.microsoft.com/interop/docs/supportingtechnologies.mspx
+
+The Digital Imaging Group have also detailed the OLE format in the JPEG2000 specification: see Appendix A of http://www.i3a.org/pdf/wg1n1017.pdf
+
+
+=cut