File Manager

Editing File: /usr/local/cpanel/3rdparty/perl/536/cpanel-lib/OLE/Storage_Lite.pm

# 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.20';

#------------------------------------------------------------------------------
# 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.20';
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.20';
#------------------------------------------------------------------------------
# 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.20';
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.20';
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 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 @localtimecopy = @{$localtime};
    $localtimecopy[5] += 1900 unless $localtimecopy[5] > 99;
    my $time = timegm( @localtimecopy );

# 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 format of localtime.

=item Time2nd

Timestamp 2nd in array ref as similar format 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 getting 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

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

Back to Directory File Manager