# 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