# 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 Math::BigInt;
#use OLE::Storage_Lite;
use vars qw($VERSION @ISA);
@ISA = qw(Exporter);
$VERSION = '0.10';
#------------------------------------------------------------------------------
# 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++) {
$FILE->print(pack("V", $i+$iSmBlk+1));
}
$FILE->print(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());
$FILE->print(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_};
$FILE->print(
$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::Scalar;
use IO::File;
use IO::Handle;
use Fcntl;
use vars qw($VERSION @ISA);
@ISA = qw(OLE::Storage_Lite::PPS Exporter);
$VERSION = '0.10';
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;
#1.Open File
#1.1 $sFile is Ref of scalar
if(ref($sFile) eq 'SCALAR') {
my $oIo = new IO::Scalar $sFile, O_WRONLY;
$rhInfo->{_FILEH_} = $oIo;
}
#1.2 $sFile is a IO::Handle object
elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) {
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 Others
else {
return undef;
}
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
$rhInfo->{_FILEH_}->close unless($sFile ne '-');
}
#------------------------------------------------------------------------------
# _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 = ($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize();
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;
#0.1 Calculate BD count
if ($iBdCnt >$i1stBdL) {
while(1) {
$iBdExL++;
$iAllW++;
$iBdCntW = int($iAllW / $iBlCnt) + (($iAllW % $iBlCnt)? 1: 0);
$iBdCnt = int(($iAllW + $iBdCntW) / $iBlCnt) + ((($iAllW+$iBdCntW) % $iBlCnt)? 1: 0);
last if($iBdCnt <= ($iBdExL*$iBlCnt+ $i1stBdL));
}
}
#1.Save Header
$FILE->print(
"\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", 0) #Small Block Depot
, pack("V", 1)
);
#2. Extra BDList Start, Count
if($iBdCnt < $i1stBdL) {
$FILE->print(
pack("V", -2), #Extra BDList Start
pack("V", 0), #Extra BDList Count
);
}
else {
$FILE->print(
pack("V", $iAll+$iBdCnt),
pack("V", $iBdExL),
);
}
#3. BDList
for($i=0; $i<$i1stBdL and $i < $iBdCnt; $i++) {
$FILE->print(pack("V", $iAll+$i));
}
$FILE->print((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);
$FILE->print($sBuff); #Check for update
}
}
else {
$FILE->print($oPps->{Data});
}
$FILE->print(
"\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};
$FILE->print("\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 $i1stBdL = ($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize();
my $iBdExL = 0;
my $iAll = $iBsize + $iPpsCnt + $iSbdSize;
my $iAllW = $iAll;
my $iBdCntW = int($iAllW / $iBbCnt) + (($iAllW % $iBbCnt)? 1: 0);
my $iBdCnt = int(($iAll + $iBdCntW) / $iBbCnt) + ((($iAllW+$iBdCntW) % $iBbCnt)? 1: 0);
my $i;
#0.1 Calculate BD count
if ($iBdCnt >$i1stBdL) {
while(1) {
$iBdExL++;
$iAllW++;
$iBdCntW = int($iAllW / $iBbCnt) + (($iAllW % $iBbCnt)? 1: 0);
$iBdCnt = int(($iAllW + $iBdCntW) / $iBbCnt) + ((($iAllW+$iBdCntW) % $iBbCnt)? 1: 0);
last if($iBdCnt <= ($iBdExL*$iBbCnt+ $i1stBdL));
}
}
#1. Making BD
#1.1 Set for SBD
if($iSbdSize > 0) {
for ($i = 0; $i<($iSbdSize-1); $i++) {
$FILE->print(pack("V", $i+1));
}
$FILE->print(pack("V", -2));
}
#1.2 Set for B
for ($i = 0; $i<($iBsize-1); $i++) {
$FILE->print(pack("V", $i+$iSbdSize+1));
}
$FILE->print(pack("V", -2));
#1.3 Set for PPS
for ($i = 0; $i<($iPpsCnt-1); $i++) {
$FILE->print(pack("V", $i+$iSbdSize+$iBsize+1));
}
$FILE->print(pack("V", -2));
#1.4 Set for BBD itself ( 0xFFFFFFFD : BBD)
for($i=0; $i<$iBdCnt;$i++) {
$FILE->print(pack("V", 0xFFFFFFFD));
}
#1.5 Set for ExtraBDList
for($i=0; $i<$iBdExL;$i++) {
$FILE->print(pack("V", 0xFFFFFFFC));
}
#1.6 Adjust for Block
$FILE->print(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++;
$FILE->print(pack("V", $iAll+$iBdCnt+$iNb));
}
$FILE->print(pack("V", $iBsize+$iSbdSize+$iPpsCnt+$i));
}
$FILE->print(pack("V", -1) x (($iBbCnt-1) - (($iBdCnt-$i1stBdL) % ($iBbCnt-1))))
if(($iBdCnt-$i1stBdL) % ($iBbCnt-1));
$FILE->print(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.10';
#------------------------------------------------------------------------------
# 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}) {
$oSelf->{_PPS_FILE}->print($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.10';
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 IO::Scalar;
use vars qw($VERSION @ISA @EXPORT);
@ISA = qw(Exporter);
$VERSION = '0.10';
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') {
$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. Others
else {
return undef;
}
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)));
}
#------------------------------------------------------------------------------
# OLE Date->Localtime
#------------------------------------------------------------------------------
sub OLEDate2Local($)
{
my($sDateTime) = @_;
my($iSec, $iMin, $iHour, $iDay, $iMon, $iYear);
my($iDate);
my($iDt, $iYDays);
#1.Divide Day and Time
my $iBigDt = Math::BigInt->new(0);
foreach my $sWk (reverse(split //, $sDateTime)) {
$iBigDt *= 0x100;
$iBigDt += ord($sWk);
}
my $iHSec = $iBigDt % 10000000;
$iBigDt /= 10000000;
my $iBigDay = int($iBigDt / (24*3600)) + 1;
my $iTime = int($iBigDt % (24*3600));
#2. Year->Day(1601/1/2?)
$iDt = $iBigDay;
$iYear = 1601;
$iYDays = _yearDays($iYear); #Not 365 (365 days is Only in Excel World)
while($iDt > $iYDays) {
$iDt -= $iYDays;
$iYear++;
$iYDays = _yearDays($iYear);
}
my $iMD;
for($iMon=1;$iMon < 12; $iMon++){
$iMD = _monthDays($iMon, $iYear);
last if($iDt <= $iMD);
$iDt -= $iMD;
}
$iDay = $iDt;
#3. Hour->iSec
$iHour = int($iTime / 3600);
$iMin = int(($iTime % 3600) / 60);
$iSec = $iTime % 60;
return ($iSec, $iMin, $iHour, $iDay, $iMon - 1, $iYear-1900, $iHSec);
}
#------------------------------------------------------------------------------
# Localtime->OLE Date
#------------------------------------------------------------------------------
sub LocalDate2OLE($)
{
my($raDate) = @_;
return "\x00" x 8 unless($raDate);
my ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iHSec) = @{$raDate};
$iSec ||=0; $iMin ||=0; $iHour ||=0; $iDay ||=0; $iMon ||=0; $iYear ||=0; $iHSec ||=0;
my($iDate);
my($iDt, $iYDays);
#1. Year -> Days
$iDate = -1;
for(my $iY=1601;$iY<($iYear+1900);$iY++){
$iDate += _yearDays($iY);
}
for(my $iM=0;$iM < $iMon ; $iM++){
$iDate += _monthDays($iM+1, ($iYear+1900));
}
$iDate += $iDay;
#2. Hours->Sec + HighReso
my $iBigDt = Math::BigInt->new(0);
$iBigDt += $iHour*3600 + $iMin*60+ $iSec;
$iBigDt += ($iDate*(24*3600));
$iBigDt *= 10000000;
$iBigDt += $iHSec if($iHSec);
#3. Make HEX string
my $iHex;
my $sRes = '';
for(my $i=0;$i<8;$i++) {
$iHex = $iBigDt % 0x100;
$sRes .= pack 'c', $iHex;
$iBigDt /= 0x100;
}
return $sRes;
}
#------------------------------------------------------------------------------
# _leapYear (OLE::Storage_Lite)
#------------------------------------------------------------------------------
sub _leapYear($) {
my($iYear)=@_;
return undef unless($iYear);
return ((($iYear % 4)==0) && (($iYear % 100) || ($iYear % 400)==0))? 1: 0;
}
#------------------------------------------------------------------------------
# _yearDays (OLE::Storage_Lite)
#------------------------------------------------------------------------------
sub _yearDays($) {
my($iYear)=@_;
return _leapYear($iYear)? 366: 365;
}
#------------------------------------------------------------------------------
# _monthDays (OLE::Storage_Lite)
#------------------------------------------------------------------------------
sub _monthDays($$) {
my($iMon, $iYear)=@_;
if($iMon == 1 || $iMon == 3 || $iMon == 5 || $iMon == 7 || $iMon == 8
|| $iMon == 10 || $iMon == 12) {
return 31;
}
elsif($iMon == 4 || $iMon == 6 || $iMon == 9 || $iMon == 11) {
return 30;
}
elsif($iMon == 2) {
return _leapYear($iYear)? 29: 28;
}
}
1;
__END__
=head1 NAME
OLE::Storage_Lite - Simple Class for OLE document interface. (Version: 0.10)
=head1 SYNOPSIS
use OLE::Storage_Lite;
use strict;
#1. Initialize
#1.1 From File
my $oOl = OLE::Storage_Lite->new("some.xls");
#1.2 From Scalar
my $oOl = OLE::Storage_Lite->new(\$sBuff);
#1.3 From IO::Handle object
use IO::File;
my $oIo = new IO::File;
$oIo->open("<iofile.xls");
binmode($oIo);
my $oOl = OLE::Storage_Lite->new($oFile);
#2. Read and Get Data
my $oPps = $oOl->getPpsTree(1);
#3.Save Data
#3.1 As File
$oPps->save("kaba.xls"); #kaba.xls
$oPps->save('-'); #STDOUT
#3.2 As Scalar
$oPps->save(\$sBuff);
#3.3 As IO::Handle 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.
Please refer OLE::Storage by Martin Schwartz.
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
I<$oOle> = OLE::Storage_Lite->new(I<$sFile>);
Constructor.
Creates a OLE::Storage_Lite object for I<$sFile>.
I<$sFile> must be a correct file name.
From 0.06, I<$sFile> may be a scalar reference of file contents (ex. \$sBuff)
and IO::Handle object (including IO::File etc).
=head2 getPpsTree
I<$oPpsRoot> = I<oOle>->getPpsTree([$bData]);
returns PPS as OLE::Storage_Lite::PPS::Root object.
Other PPS objects will be included as its children.
if I<$bData> is true, the objects will have data in the file.
=head2 getPpsSearch
I<$oPpsRoot> = I<oOle>->getPpsTree($raName [, $bData][, $iCase] );
returns PPSs as OLE::Storage_Lite::PPS objects that has the name specified in
I<$raName> array.
if I<$bData> is true, the objects will have data in the file.
if I<$iCase> is true, search with case insensitive.
=head2 getNthPps
I<$oPpsRoot> = I<oOle>->getNthPps($iNth [, $bData]);
returns PPS as OLE::Storage_Lite::PPS object specified number(I<$iNth>).
if I<$bData> is true, the objects will have data in the file.
=head2 Asc2Ucs
I<$sUcs2> = OLE::Storage_Lite::Asc2Ucs(I<$sAsc>);
Utility function.
Just adding 0x00 afeter every characters in I<$sAsc>.
=head2 Ucs2Asc
I<$sAsc> = OLE::Storage_Lite::Ucs2Asc(I<$sUcs2>);
Utility function.
Just deletes 0x00 afeter words in I<$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
timestamp1st in array ref as similar fomat of localtime.
=item Time2nd
timestamp2nd 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
I<$oRoot> = OLE::Storage_Lite::PPS::Root->new(
I<$raTime1st>,
I<$raTime2nd>,
I<$raChild>);
Constructor.
I<$raTime1st>, I<$raTime2nd> is a array ref as
($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iHSec).
$iSec means seconds, $iMin means minutes. $iHour means hours.
$iDay means day. $iMon is month -1. $iYear is year - 1900.
$iHSec is seconds/10,000,000 in Math::BigInt.
I<$raChild> is a array ref of children PPSs.
=head2 save
I<$oRoot> = $o<oRoot>->save(
I<$sFile>,
I<$bNoAs>);
Saves infomations into I<$sFile>. I<$sFile> is '-', this will use STDOUT.
From 0.06, I<$sFile> may be a scalar reference of file contents (ex. \$sBuff)
and IO::Handle object (including IO::File etc).
if I<$bNoAs> is defined, this function will use the No of PPSs for saving order.
if I<$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
I<$oRoot> = OLE::Storage_Lite::PPS::Dir->new(
I<$sName>
[, I<$raTime1st>]
[, I<$raTime2nd>]
[, I<$raChild>]);
Constructor.
I<$sName> is a name of the PPS.
I<$raTime1st>, I<$raTime2nd> is a array ref as
($iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iHSec).
$iSec means seconds, $iMin means minutes. $iHour means hours.
$iDay means day. $iMon is month -1. $iYear is year - 1900.
$iHSec is seconds/10,000,000 in Math::BigInt.
I<$raChild> is a array ref of children PPSs.
=head1 OLE::Storage_Lite::PPS::File
OLE::Storage_Lite::PPS::File has 3 method.
=head2 new
I<$oRoot> = OLE::Storage_Lite::PPS::File->new(I<$sName>, I<$sData>);
I<$sName> is name of the PPS.
I<$sData> is data of the PPS.
=head2 newFile
I<$oRoot> = OLE::Storage_Lite::PPS::File->newFile(I<$sName>, I<$sFile>);
This function makes to use file handle for geting and storing data.
I<$sName> is name of the PPS.
If I<$sFile> is scalar, it assumes that is a filename.
If I<$sFile> is an IO::Handle object, it uses that specified handle.
If I<$sFile> is undef or '', it uses temporary file.
CAUTION: Take care I<$sFile> will be updated by I<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
I<$oRoot> = $oPps->append($sData);
appends specified data to that PPS.
I<$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 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
=head1 SEE ALSO
OLE::Storage
=cut