shell bypass 403
# 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