| Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/OLE/Storage_Lite.pm |
| Statements | Executed 54 statements in 4.25ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 11µs | 12µs | OLE::Storage_Lite::PPS::BEGIN@12 |
| 1 | 1 | 1 | 7µs | 24µs | OLE::Storage_Lite::BEGIN@831 |
| 1 | 1 | 1 | 7µs | 76µs | OLE::Storage_Lite::BEGIN@843 |
| 1 | 1 | 1 | 7µs | 74µs | OLE::Storage_Lite::PPS::Root::BEGIN@169 |
| 1 | 1 | 1 | 6µs | 945µs | OLE::Storage_Lite::BEGIN@1383 |
| 1 | 1 | 1 | 6µs | 7µs | OLE::Storage_Lite::PPS::File::BEGIN@713 |
| 1 | 1 | 1 | 5µs | 7µs | OLE::Storage_Lite::PPS::Dir::BEGIN@801 |
| 1 | 1 | 1 | 5µs | 7µs | OLE::Storage_Lite::PPS::Root::BEGIN@168 |
| 1 | 1 | 1 | 5µs | 152µs | OLE::Storage_Lite::PPS::Root::BEGIN@171 |
| 1 | 1 | 1 | 4µs | 6µs | OLE::Storage_Lite::BEGIN@828 |
| 1 | 1 | 1 | 4µs | 22µs | OLE::Storage_Lite::BEGIN@832 |
| 1 | 1 | 1 | 4µs | 66µs | OLE::Storage_Lite::BEGIN@830 |
| 1 | 1 | 1 | 4µs | 11µs | OLE::Storage_Lite::PPS::Root::BEGIN@170 |
| 1 | 1 | 1 | 4µs | 21µs | OLE::Storage_Lite::PPS::File::BEGIN@714 |
| 1 | 1 | 1 | 4µs | 24µs | OLE::Storage_Lite::PPS::BEGIN@13 |
| 1 | 1 | 1 | 4µs | 19µs | OLE::Storage_Lite::PPS::Root::BEGIN@172 |
| 1 | 1 | 1 | 3µs | 27µs | OLE::Storage_Lite::BEGIN@829 |
| 1 | 1 | 1 | 3µs | 19µs | OLE::Storage_Lite::PPS::Dir::BEGIN@802 |
| 1 | 1 | 1 | 3µs | 21µs | OLE::Storage_Lite::BEGIN@834 |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::Asc2Ucs |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::LocalDate2OLE |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::OLEDate2Local |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Dir::new |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::File::append |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::File::new |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::File::newFile |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_adjust2 |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_calcSize |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_saveBbd |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_saveBigData |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_saveHeader |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_savePps |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_savePpsSetPnt |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_savePpsSetPnt1 |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_savePpsSetPnt2 |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::_savePpsSetPnt2s |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::new |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::Root::save |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::_DataLen |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::_makeSmallData |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::_new |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::_savePpsWk |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::PPS::new |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::Ucs2Asc |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::__ANON__[:988] |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::__ANON__[:989] |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getBbdInfo |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getBigData |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getData |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getHeaderInfo |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getInfoFromFile |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getNthBlockNo |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getNthPps |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getPpsSearch |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getPpsTree |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_getSmallData |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::_initParse |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::getNthPps |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::getPpsSearch |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::getPpsTree |
| 0 | 0 | 0 | 0s | 0s | OLE::Storage_Lite::new |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # OLE::Storage_Lite | ||||
| 2 | # by Kawai, Takanori (Hippo2000) 2000.11.4, 8, 14 | ||||
| 3 | # This Program is Still ALPHA version. | ||||
| 4 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 5 | # OLE::Storage_Lite::PPS Object | ||||
| 6 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 7 | #============================================================================== | ||||
| 8 | # OLE::Storage_Lite::PPS | ||||
| 9 | #============================================================================== | ||||
| 10 | package OLE::Storage_Lite::PPS; | ||||
| 11 | 1 | 500ns | require Exporter; | ||
| 12 | 2 | 22µs | 2 | 14µs | # spent 12µs (11+1) within OLE::Storage_Lite::PPS::BEGIN@12 which was called:
# once (11µs+1µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 12 # spent 12µs making 1 call to OLE::Storage_Lite::PPS::BEGIN@12
# spent 1µs making 1 call to strict::import |
| 13 | 2 | 544µs | 2 | 45µs | # spent 24µs (4+21) within OLE::Storage_Lite::PPS::BEGIN@13 which was called:
# once (4µs+21µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 13 # spent 24µs making 1 call to OLE::Storage_Lite::PPS::BEGIN@13
# spent 21µs making 1 call to vars::import |
| 14 | 1 | 5µs | @ISA = qw(Exporter); | ||
| 15 | 1 | 200ns | $VERSION = '0.22'; | ||
| 16 | |||||
| 17 | #------------------------------------------------------------------------------ | ||||
| 18 | # new (OLE::Storage_Lite::PPS) | ||||
| 19 | #------------------------------------------------------------------------------ | ||||
| 20 | sub new ($$$$$$$$$$;$$) { | ||||
| 21 | #1. Constructor for General Usage | ||||
| 22 | my($sClass, $iNo, $sNm, $iType, $iPrev, $iNext, $iDir, | ||||
| 23 | $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild) = @_; | ||||
| 24 | |||||
| 25 | if($iType == OLE::Storage_Lite::PpsType_File()) { #FILE | ||||
| 26 | return OLE::Storage_Lite::PPS::File->_new | ||||
| 27 | ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, | ||||
| 28 | $iStart, $iSize, $sData, $raChild); | ||||
| 29 | } | ||||
| 30 | elsif($iType == OLE::Storage_Lite::PpsType_Dir()) { #DIRECTRY | ||||
| 31 | return OLE::Storage_Lite::PPS::Dir->_new | ||||
| 32 | ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, | ||||
| 33 | $iStart, $iSize, $sData, $raChild); | ||||
| 34 | } | ||||
| 35 | elsif($iType == OLE::Storage_Lite::PpsType_Root()) { #ROOT | ||||
| 36 | return OLE::Storage_Lite::PPS::Root->_new | ||||
| 37 | ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, | ||||
| 38 | $iStart, $iSize, $sData, $raChild); | ||||
| 39 | } | ||||
| 40 | else { | ||||
| 41 | die "Error PPS:$iType $sNm\n"; | ||||
| 42 | } | ||||
| 43 | } | ||||
| 44 | #------------------------------------------------------------------------------ | ||||
| 45 | # _new (OLE::Storage_Lite::PPS) | ||||
| 46 | # for OLE::Storage_Lite | ||||
| 47 | #------------------------------------------------------------------------------ | ||||
| 48 | sub _new ($$$$$$$$$$$;$$) { | ||||
| 49 | my($sClass, $iNo, $sNm, $iType, $iPrev, $iNext, $iDir, | ||||
| 50 | $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild) = @_; | ||||
| 51 | #1. Constructor for OLE::Storage_Lite | ||||
| 52 | my $oThis = { | ||||
| 53 | No => $iNo, | ||||
| 54 | Name => $sNm, | ||||
| 55 | Type => $iType, | ||||
| 56 | PrevPps => $iPrev, | ||||
| 57 | NextPps => $iNext, | ||||
| 58 | DirPps => $iDir, | ||||
| 59 | Time1st => $raTime1st, | ||||
| 60 | Time2nd => $raTime2nd, | ||||
| 61 | StartBlock => $iStart, | ||||
| 62 | Size => $iSize, | ||||
| 63 | Data => $sData, | ||||
| 64 | Child => $raChild, | ||||
| 65 | }; | ||||
| 66 | bless $oThis, $sClass; | ||||
| 67 | return $oThis; | ||||
| 68 | } | ||||
| 69 | #------------------------------------------------------------------------------ | ||||
| 70 | # _DataLen (OLE::Storage_Lite::PPS) | ||||
| 71 | # Check for update | ||||
| 72 | #------------------------------------------------------------------------------ | ||||
| 73 | sub _DataLen($) { | ||||
| 74 | my($oSelf) =@_; | ||||
| 75 | return 0 unless(defined($oSelf->{Data})); | ||||
| 76 | return ($oSelf->{_PPS_FILE})? | ||||
| 77 | ($oSelf->{_PPS_FILE}->stat())[7] : length($oSelf->{Data}); | ||||
| 78 | } | ||||
| 79 | #------------------------------------------------------------------------------ | ||||
| 80 | # _makeSmallData (OLE::Storage_Lite::PPS) | ||||
| 81 | #------------------------------------------------------------------------------ | ||||
| 82 | sub _makeSmallData($$$) { | ||||
| 83 | my($oThis, $aList, $rhInfo) = @_; | ||||
| 84 | my ($sRes); | ||||
| 85 | my $FILE = $rhInfo->{_FILEH_}; | ||||
| 86 | my $iSmBlk = 0; | ||||
| 87 | |||||
| 88 | foreach my $oPps (@$aList) { | ||||
| 89 | #1. Make SBD, small data string | ||||
| 90 | if($oPps->{Type}==OLE::Storage_Lite::PpsType_File()) { | ||||
| 91 | next if($oPps->{Size}<=0); | ||||
| 92 | if($oPps->{Size} < $rhInfo->{_SMALL_SIZE}) { | ||||
| 93 | my $iSmbCnt = int($oPps->{Size} / $rhInfo->{_SMALL_BLOCK_SIZE}) | ||||
| 94 | + (($oPps->{Size} % $rhInfo->{_SMALL_BLOCK_SIZE})? 1: 0); | ||||
| 95 | #1.1 Add to SBD | ||||
| 96 | for (my $i = 0; $i<($iSmbCnt-1); $i++) { | ||||
| 97 | print {$FILE} (pack("V", $i+$iSmBlk+1)); | ||||
| 98 | } | ||||
| 99 | 1 | 1µs | print {$FILE} (pack("V", -2)); # spent 1µs making 1 call to CORE::pack | ||
| 100 | |||||
| 101 | #1.2 Add to Data String(this will be written for RootEntry) | ||||
| 102 | #Check for update | ||||
| 103 | if($oPps->{_PPS_FILE}) { | ||||
| 104 | my $sBuff; | ||||
| 105 | $oPps->{_PPS_FILE}->seek(0, 0); #To The Top | ||||
| 106 | while($oPps->{_PPS_FILE}->read($sBuff, 4096)) { | ||||
| 107 | $sRes .= $sBuff; | ||||
| 108 | } | ||||
| 109 | } | ||||
| 110 | else { | ||||
| 111 | $sRes .= $oPps->{Data}; | ||||
| 112 | } | ||||
| 113 | $sRes .= ("\x00" x | ||||
| 114 | ($rhInfo->{_SMALL_BLOCK_SIZE} - ($oPps->{Size}% $rhInfo->{_SMALL_BLOCK_SIZE}))) | ||||
| 115 | if($oPps->{Size}% $rhInfo->{_SMALL_BLOCK_SIZE}); | ||||
| 116 | #1.3 Set for PPS | ||||
| 117 | $oPps->{StartBlock} = $iSmBlk; | ||||
| 118 | $iSmBlk += $iSmbCnt; | ||||
| 119 | } | ||||
| 120 | } | ||||
| 121 | } | ||||
| 122 | my $iSbCnt = int($rhInfo->{_BIG_BLOCK_SIZE}/ OLE::Storage_Lite::LongIntSize()); | ||||
| 123 | 1 | 1µs | print {$FILE} (pack("V", -1) x ($iSbCnt - ($iSmBlk % $iSbCnt))) # spent 1µs making 1 call to CORE::pack | ||
| 124 | if($iSmBlk % $iSbCnt); | ||||
| 125 | #2. Write SBD with adjusting length for block | ||||
| 126 | return $sRes; | ||||
| 127 | } | ||||
| 128 | #------------------------------------------------------------------------------ | ||||
| 129 | # _savePpsWk (OLE::Storage_Lite::PPS) | ||||
| 130 | #------------------------------------------------------------------------------ | ||||
| 131 | sub _savePpsWk($$) | ||||
| 132 | { | ||||
| 133 | my($oThis, $rhInfo) = @_; | ||||
| 134 | #1. Write PPS | ||||
| 135 | my $FILE = $rhInfo->{_FILEH_}; | ||||
| 136 | print {$FILE} ( | ||||
| 137 | $oThis->{Name} | ||||
| 138 | . ("\x00" x (64 - length($oThis->{Name}))) #64 | ||||
| 139 | , pack("v", length($oThis->{Name}) + 2) #66 | ||||
| 140 | , pack("c", $oThis->{Type}) #67 | ||||
| 141 | , pack("c", 0x00) #UK #68 | ||||
| 142 | 1 | 900ns | , pack("V", $oThis->{PrevPps}) #Prev #72 # spent 900ns making 1 call to CORE::pack | ||
| 143 | , pack("V", $oThis->{NextPps}) #Next #76 | ||||
| 144 | , pack("V", $oThis->{DirPps}) #Dir #80 | ||||
| 145 | , "\x00\x09\x02\x00" #84 | ||||
| 146 | , "\x00\x00\x00\x00" #88 | ||||
| 147 | , "\xc0\x00\x00\x00" #92 | ||||
| 148 | , "\x00\x00\x00\x46" #96 | ||||
| 149 | , "\x00\x00\x00\x00" #100 | ||||
| 150 | , OLE::Storage_Lite::LocalDate2OLE($oThis->{Time1st}) #108 | ||||
| 151 | , OLE::Storage_Lite::LocalDate2OLE($oThis->{Time2nd}) #116 | ||||
| 152 | , pack("V", defined($oThis->{StartBlock})? | ||||
| 153 | $oThis->{StartBlock}:0) #116 | ||||
| 154 | , pack("V", defined($oThis->{Size})? | ||||
| 155 | $oThis->{Size} : 0) #124 | ||||
| 156 | 1 | 600ns | , pack("V", 0), #128 # spent 600ns making 1 call to CORE::pack | ||
| 157 | ); | ||||
| 158 | } | ||||
| 159 | |||||
| 160 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 161 | # OLE::Storage_Lite::PPS::Root Object | ||||
| 162 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 163 | #============================================================================== | ||||
| 164 | # OLE::Storage_Lite::PPS::Root | ||||
| 165 | #============================================================================== | ||||
| 166 | package OLE::Storage_Lite::PPS::Root; | ||||
| 167 | 1 | 200ns | require Exporter; | ||
| 168 | 2 | 31µs | 2 | 9µs | # spent 7µs (5+2) within OLE::Storage_Lite::PPS::Root::BEGIN@168 which was called:
# once (5µs+2µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 168 # spent 7µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@168
# spent 2µs making 1 call to strict::import |
| 169 | 2 | 18µs | 2 | 141µs | # spent 74µs (7+67) within OLE::Storage_Lite::PPS::Root::BEGIN@169 which was called:
# once (7µs+67µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 169 # spent 74µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@169
# spent 67µs making 1 call to Exporter::import |
| 170 | 2 | 11µs | 2 | 17µs | # spent 11µs (4+7) within OLE::Storage_Lite::PPS::Root::BEGIN@170 which was called:
# once (4µs+7µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 170 # spent 11µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@170
# spent 7µs making 1 call to Exporter::import |
| 171 | 2 | 18µs | 2 | 299µs | # spent 152µs (5+147) within OLE::Storage_Lite::PPS::Root::BEGIN@171 which was called:
# once (5µs+147µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 171 # spent 152µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@171
# spent 147µs making 1 call to Exporter::import |
| 172 | 2 | 1.56ms | 2 | 35µs | # spent 19µs (4+16) within OLE::Storage_Lite::PPS::Root::BEGIN@172 which was called:
# once (4µs+16µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 172 # spent 19µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@172
# spent 16µs making 1 call to vars::import |
| 173 | 1 | 4µs | @ISA = qw(OLE::Storage_Lite::PPS Exporter); | ||
| 174 | 1 | 200ns | $VERSION = '0.22'; | ||
| 175 | sub _savePpsSetPnt($$$); | ||||
| 176 | sub _savePpsSetPnt2($$$); | ||||
| 177 | #------------------------------------------------------------------------------ | ||||
| 178 | # new (OLE::Storage_Lite::PPS::Root) | ||||
| 179 | #------------------------------------------------------------------------------ | ||||
| 180 | sub new ($;$$$) { | ||||
| 181 | my($sClass, $raTime1st, $raTime2nd, $raChild) = @_; | ||||
| 182 | OLE::Storage_Lite::PPS::_new( | ||||
| 183 | $sClass, | ||||
| 184 | undef, | ||||
| 185 | OLE::Storage_Lite::Asc2Ucs('Root Entry'), | ||||
| 186 | 5, | ||||
| 187 | undef, | ||||
| 188 | undef, | ||||
| 189 | undef, | ||||
| 190 | $raTime1st, | ||||
| 191 | $raTime2nd, | ||||
| 192 | undef, | ||||
| 193 | undef, | ||||
| 194 | undef, | ||||
| 195 | $raChild); | ||||
| 196 | } | ||||
| 197 | #------------------------------------------------------------------------------ | ||||
| 198 | # save (OLE::Storage_Lite::PPS::Root) | ||||
| 199 | #------------------------------------------------------------------------------ | ||||
| 200 | sub save($$;$$) { | ||||
| 201 | my($oThis, $sFile, $bNoAs, $rhInfo) = @_; | ||||
| 202 | #0.Initial Setting for saving | ||||
| 203 | $rhInfo = {} unless($rhInfo); | ||||
| 204 | $rhInfo->{_BIG_BLOCK_SIZE} = 2** | ||||
| 205 | (($rhInfo->{_BIG_BLOCK_SIZE})? | ||||
| 206 | _adjust2($rhInfo->{_BIG_BLOCK_SIZE}) : 9); | ||||
| 207 | $rhInfo->{_SMALL_BLOCK_SIZE}= 2 ** | ||||
| 208 | (($rhInfo->{_SMALL_BLOCK_SIZE})? | ||||
| 209 | _adjust2($rhInfo->{_SMALL_BLOCK_SIZE}): 6); | ||||
| 210 | $rhInfo->{_SMALL_SIZE} = 0x1000; | ||||
| 211 | $rhInfo->{_PPS_SIZE} = 0x80; | ||||
| 212 | |||||
| 213 | my $closeFile = 1; | ||||
| 214 | |||||
| 215 | #1.Open File | ||||
| 216 | #1.1 $sFile is Ref of scalar | ||||
| 217 | if(ref($sFile) eq 'SCALAR') { | ||||
| 218 | require IO::Scalar; | ||||
| 219 | my $oIo = new IO::Scalar $sFile, O_WRONLY; | ||||
| 220 | $rhInfo->{_FILEH_} = $oIo; | ||||
| 221 | } | ||||
| 222 | #1.1.1 $sFile is a IO::Scalar object | ||||
| 223 | # Now handled as a filehandle ref below. | ||||
| 224 | |||||
| 225 | #1.2 $sFile is a IO::Handle object | ||||
| 226 | elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) { | ||||
| 227 | # Not all filehandles support binmode() so try it in an eval. | ||||
| 228 | eval{ binmode $sFile }; | ||||
| 229 | $rhInfo->{_FILEH_} = $sFile; | ||||
| 230 | } | ||||
| 231 | #1.3 $sFile is a simple filename string | ||||
| 232 | elsif(!ref($sFile)) { | ||||
| 233 | if($sFile ne '-') { | ||||
| 234 | my $oIo = new IO::File; | ||||
| 235 | $oIo->open(">$sFile") || return undef; | ||||
| 236 | binmode($oIo); | ||||
| 237 | $rhInfo->{_FILEH_} = $oIo; | ||||
| 238 | } | ||||
| 239 | else { | ||||
| 240 | my $oIo = new IO::Handle; | ||||
| 241 | $oIo->fdopen(fileno(STDOUT),"w") || return undef; | ||||
| 242 | binmode($oIo); | ||||
| 243 | $rhInfo->{_FILEH_} = $oIo; | ||||
| 244 | } | ||||
| 245 | } | ||||
| 246 | #1.4 Assume that if $sFile is a ref then it is a valid filehandle | ||||
| 247 | else { | ||||
| 248 | # Not all filehandles support binmode() so try it in an eval. | ||||
| 249 | eval{ binmode $sFile }; | ||||
| 250 | $rhInfo->{_FILEH_} = $sFile; | ||||
| 251 | # Caller controls filehandle closing | ||||
| 252 | $closeFile = 0; | ||||
| 253 | } | ||||
| 254 | |||||
| 255 | my $iBlk = 0; | ||||
| 256 | #1. Make an array of PPS (for Save) | ||||
| 257 | my @aList=(); | ||||
| 258 | if($bNoAs) { | ||||
| 259 | _savePpsSetPnt2([$oThis], \@aList, $rhInfo); | ||||
| 260 | } | ||||
| 261 | else { | ||||
| 262 | _savePpsSetPnt([$oThis], \@aList, $rhInfo); | ||||
| 263 | } | ||||
| 264 | my ($iSBDcnt, $iBBcnt, $iPPScnt) = $oThis->_calcSize(\@aList, $rhInfo); | ||||
| 265 | |||||
| 266 | #2.Save Header | ||||
| 267 | $oThis->_saveHeader($rhInfo, $iSBDcnt, $iBBcnt, $iPPScnt); | ||||
| 268 | |||||
| 269 | #3.Make Small Data string (write SBD) | ||||
| 270 | my $sSmWk = $oThis->_makeSmallData(\@aList, $rhInfo); | ||||
| 271 | $oThis->{Data} = $sSmWk; #Small Datas become RootEntry Data | ||||
| 272 | |||||
| 273 | #4. Write BB | ||||
| 274 | my $iBBlk = $iSBDcnt; | ||||
| 275 | $oThis->_saveBigData(\$iBBlk, \@aList, $rhInfo); | ||||
| 276 | |||||
| 277 | #5. Write PPS | ||||
| 278 | $oThis->_savePps(\@aList, $rhInfo); | ||||
| 279 | |||||
| 280 | #6. Write BD and BDList and Adding Header informations | ||||
| 281 | $oThis->_saveBbd($iSBDcnt, $iBBcnt, $iPPScnt, $rhInfo); | ||||
| 282 | |||||
| 283 | #7.Close File | ||||
| 284 | return $rhInfo->{_FILEH_}->close if $closeFile; | ||||
| 285 | } | ||||
| 286 | #------------------------------------------------------------------------------ | ||||
| 287 | # _calcSize (OLE::Storage_Lite::PPS) | ||||
| 288 | #------------------------------------------------------------------------------ | ||||
| 289 | sub _calcSize($$) | ||||
| 290 | { | ||||
| 291 | my($oThis, $raList, $rhInfo) = @_; | ||||
| 292 | |||||
| 293 | #0. Calculate Basic Setting | ||||
| 294 | my ($iSBDcnt, $iBBcnt, $iPPScnt) = (0,0,0); | ||||
| 295 | my $iSmallLen = 0; | ||||
| 296 | my $iSBcnt = 0; | ||||
| 297 | foreach my $oPps (@$raList) { | ||||
| 298 | if($oPps->{Type}==OLE::Storage_Lite::PpsType_File()) { | ||||
| 299 | $oPps->{Size} = $oPps->_DataLen(); #Mod | ||||
| 300 | if($oPps->{Size} < $rhInfo->{_SMALL_SIZE}) { | ||||
| 301 | $iSBcnt += int($oPps->{Size} / $rhInfo->{_SMALL_BLOCK_SIZE}) | ||||
| 302 | + (($oPps->{Size} % $rhInfo->{_SMALL_BLOCK_SIZE})? 1: 0); | ||||
| 303 | } | ||||
| 304 | else { | ||||
| 305 | $iBBcnt += | ||||
| 306 | (int($oPps->{Size}/ $rhInfo->{_BIG_BLOCK_SIZE}) + | ||||
| 307 | (($oPps->{Size}% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0)); | ||||
| 308 | } | ||||
| 309 | } | ||||
| 310 | } | ||||
| 311 | $iSmallLen = $iSBcnt * $rhInfo->{_SMALL_BLOCK_SIZE}; | ||||
| 312 | my $iSlCnt = int($rhInfo->{_BIG_BLOCK_SIZE}/ OLE::Storage_Lite::LongIntSize()); | ||||
| 313 | $iSBDcnt = int($iSBcnt / $iSlCnt)+ (($iSBcnt % $iSlCnt)? 1:0); | ||||
| 314 | $iBBcnt += (int($iSmallLen/ $rhInfo->{_BIG_BLOCK_SIZE}) + | ||||
| 315 | (( $iSmallLen% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0)); | ||||
| 316 | my $iCnt = scalar(@$raList); | ||||
| 317 | my $iBdCnt = $rhInfo->{_BIG_BLOCK_SIZE}/OLE::Storage_Lite::PpsSize(); | ||||
| 318 | $iPPScnt = (int($iCnt/$iBdCnt) + (($iCnt % $iBdCnt)? 1: 0)); | ||||
| 319 | return ($iSBDcnt, $iBBcnt, $iPPScnt); | ||||
| 320 | } | ||||
| 321 | #------------------------------------------------------------------------------ | ||||
| 322 | # _adjust2 (OLE::Storage_Lite::PPS::Root) | ||||
| 323 | #------------------------------------------------------------------------------ | ||||
| 324 | sub _adjust2($) { | ||||
| 325 | my($i2) = @_; | ||||
| 326 | my $iWk; | ||||
| 327 | $iWk = log($i2)/log(2); | ||||
| 328 | return ($iWk > int($iWk))? int($iWk)+1:$iWk; | ||||
| 329 | } | ||||
| 330 | #------------------------------------------------------------------------------ | ||||
| 331 | # _saveHeader (OLE::Storage_Lite::PPS::Root) | ||||
| 332 | #------------------------------------------------------------------------------ | ||||
| 333 | sub _saveHeader($$$$$) { | ||||
| 334 | my($oThis, $rhInfo, $iSBDcnt, $iBBcnt, $iPPScnt) = @_; | ||||
| 335 | my $FILE = $rhInfo->{_FILEH_}; | ||||
| 336 | |||||
| 337 | #0. Calculate Basic Setting | ||||
| 338 | my $iBlCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize(); | ||||
| 339 | my $i1stBdL = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize()); | ||||
| 340 | my $i1stBdMax = $i1stBdL * $iBlCnt - $i1stBdL; | ||||
| 341 | my $iBdExL = 0; | ||||
| 342 | my $iAll = $iBBcnt + $iPPScnt + $iSBDcnt; | ||||
| 343 | my $iAllW = $iAll; | ||||
| 344 | my $iBdCntW = int($iAllW / $iBlCnt) + (($iAllW % $iBlCnt)? 1: 0); | ||||
| 345 | my $iBdCnt = int(($iAll + $iBdCntW) / $iBlCnt) + ((($iAllW+$iBdCntW) % $iBlCnt)? 1: 0); | ||||
| 346 | my $i; | ||||
| 347 | |||||
| 348 | if ($iBdCnt > $i1stBdL) { | ||||
| 349 | #0.1 Calculate BD count | ||||
| 350 | $iBlCnt--; #the BlCnt is reduced in the count of the last sect is used for a pointer the next Bl | ||||
| 351 | my $iBBleftover = $iAll - $i1stBdMax; | ||||
| 352 | |||||
| 353 | if ($iAll >$i1stBdMax) { | ||||
| 354 | while(1) { | ||||
| 355 | $iBdCnt = int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0); | ||||
| 356 | $iBdExL = int(($iBdCnt) / $iBlCnt) + ((($iBdCnt) % $iBlCnt)? 1: 0); | ||||
| 357 | $iBBleftover = $iBBleftover + $iBdExL; | ||||
| 358 | last if($iBdCnt == (int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0))); | ||||
| 359 | } | ||||
| 360 | } | ||||
| 361 | $iBdCnt += $i1stBdL; | ||||
| 362 | #print "iBdCnt = $iBdCnt \n"; | ||||
| 363 | } | ||||
| 364 | #1.Save Header | ||||
| 365 | print {$FILE} ( | ||||
| 366 | "\xD0\xCF\x11\xE0\xA1\xB1\x1A\xE1" | ||||
| 367 | , "\x00\x00\x00\x00" x 4 | ||||
| 368 | , pack("v", 0x3b) | ||||
| 369 | 1 | 1µs | , pack("v", 0x03) # spent 1µs making 1 call to CORE::pack | ||
| 370 | 1 | 300ns | , pack("v", -2) # spent 300ns making 1 call to CORE::pack | ||
| 371 | 1 | 200ns | , pack("v", 9) # spent 200ns making 1 call to CORE::pack | ||
| 372 | 1 | 100ns | , pack("v", 6) # spent 100ns making 1 call to CORE::pack | ||
| 373 | 1 | 100ns | , pack("v", 0) # spent 100ns making 1 call to CORE::pack | ||
| 374 | 1 | 100ns | , "\x00\x00\x00\x00" x 2 # spent 100ns making 1 call to CORE::pack | ||
| 375 | , pack("V", $iBdCnt), | ||||
| 376 | , pack("V", $iBBcnt+$iSBDcnt), #ROOT START | ||||
| 377 | , pack("V", 0) | ||||
| 378 | 1 | 300ns | , pack("V", 0x1000) # spent 300ns making 1 call to CORE::pack | ||
| 379 | 1 | 2µs | , pack("V", $iSBDcnt ? 0 : -2) #Small Block Depot # spent 2µs making 1 call to CORE::pack | ||
| 380 | , pack("V", $iSBDcnt) | ||||
| 381 | ); | ||||
| 382 | #2. Extra BDList Start, Count | ||||
| 383 | if($iAll <= $i1stBdMax) { | ||||
| 384 | print {$FILE} ( | ||||
| 385 | 1 | 300ns | pack("V", -2), #Extra BDList Start # spent 300ns making 1 call to CORE::pack | ||
| 386 | 1 | 200ns | pack("V", 0), #Extra BDList Count # spent 200ns making 1 call to CORE::pack | ||
| 387 | ); | ||||
| 388 | } | ||||
| 389 | else { | ||||
| 390 | print {$FILE} ( | ||||
| 391 | pack("V", $iAll+$iBdCnt), | ||||
| 392 | pack("V", $iBdExL), | ||||
| 393 | ); | ||||
| 394 | } | ||||
| 395 | |||||
| 396 | #3. BDList | ||||
| 397 | for($i=0; $i<$i1stBdL and $i < $iBdCnt; $i++) { | ||||
| 398 | print {$FILE} (pack("V", $iAll+$i)); | ||||
| 399 | } | ||||
| 400 | 1 | 400ns | print {$FILE} ((pack("V", -1)) x($i1stBdL-$i)) if($i<$i1stBdL); # spent 400ns making 1 call to CORE::pack | ||
| 401 | } | ||||
| 402 | #------------------------------------------------------------------------------ | ||||
| 403 | # _saveBigData (OLE::Storage_Lite::PPS) | ||||
| 404 | #------------------------------------------------------------------------------ | ||||
| 405 | sub _saveBigData($$$$) { | ||||
| 406 | my($oThis, $iStBlk, $raList, $rhInfo) = @_; | ||||
| 407 | my $iRes = 0; | ||||
| 408 | my $FILE = $rhInfo->{_FILEH_}; | ||||
| 409 | |||||
| 410 | #1.Write Big (ge 0x1000) Data into Block | ||||
| 411 | foreach my $oPps (@$raList) { | ||||
| 412 | if($oPps->{Type}!=OLE::Storage_Lite::PpsType_Dir()) { | ||||
| 413 | #print "PPS: $oPps DEF:", defined($oPps->{Data}), "\n"; | ||||
| 414 | $oPps->{Size} = $oPps->_DataLen(); #Mod | ||||
| 415 | if(($oPps->{Size} >= $rhInfo->{_SMALL_SIZE}) || | ||||
| 416 | (($oPps->{Type} == OLE::Storage_Lite::PpsType_Root()) && defined($oPps->{Data}))) { | ||||
| 417 | #1.1 Write Data | ||||
| 418 | #Check for update | ||||
| 419 | if($oPps->{_PPS_FILE}) { | ||||
| 420 | my $sBuff; | ||||
| 421 | my $iLen = 0; | ||||
| 422 | $oPps->{_PPS_FILE}->seek(0, 0); #To The Top | ||||
| 423 | while($oPps->{_PPS_FILE}->read($sBuff, 4096)) { | ||||
| 424 | $iLen += length($sBuff); | ||||
| 425 | print {$FILE} ($sBuff); #Check for update | ||||
| 426 | } | ||||
| 427 | } | ||||
| 428 | else { | ||||
| 429 | print {$FILE} ($oPps->{Data}); | ||||
| 430 | } | ||||
| 431 | print {$FILE} ( | ||||
| 432 | "\x00" x | ||||
| 433 | ($rhInfo->{_BIG_BLOCK_SIZE} - | ||||
| 434 | ($oPps->{Size} % $rhInfo->{_BIG_BLOCK_SIZE})) | ||||
| 435 | ) if ($oPps->{Size} % $rhInfo->{_BIG_BLOCK_SIZE}); | ||||
| 436 | #1.2 Set For PPS | ||||
| 437 | $oPps->{StartBlock} = $$iStBlk; | ||||
| 438 | $$iStBlk += | ||||
| 439 | (int($oPps->{Size}/ $rhInfo->{_BIG_BLOCK_SIZE}) + | ||||
| 440 | (($oPps->{Size}% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0)); | ||||
| 441 | } | ||||
| 442 | } | ||||
| 443 | } | ||||
| 444 | } | ||||
| 445 | #------------------------------------------------------------------------------ | ||||
| 446 | # _savePps (OLE::Storage_Lite::PPS::Root) | ||||
| 447 | #------------------------------------------------------------------------------ | ||||
| 448 | sub _savePps($$$) | ||||
| 449 | { | ||||
| 450 | my($oThis, $raList, $rhInfo) = @_; | ||||
| 451 | #0. Initial | ||||
| 452 | my $FILE = $rhInfo->{_FILEH_}; | ||||
| 453 | #2. Save PPS | ||||
| 454 | foreach my $oItem (@$raList) { | ||||
| 455 | $oItem->_savePpsWk($rhInfo); | ||||
| 456 | } | ||||
| 457 | #3. Adjust for Block | ||||
| 458 | my $iCnt = scalar(@$raList); | ||||
| 459 | my $iBCnt = $rhInfo->{_BIG_BLOCK_SIZE} / $rhInfo->{_PPS_SIZE}; | ||||
| 460 | print {$FILE} ("\x00" x (($iBCnt - ($iCnt % $iBCnt)) * $rhInfo->{_PPS_SIZE})) | ||||
| 461 | if($iCnt % $iBCnt); | ||||
| 462 | return int($iCnt / $iBCnt) + (($iCnt % $iBCnt)? 1: 0); | ||||
| 463 | } | ||||
| 464 | #------------------------------------------------------------------------------ | ||||
| 465 | # _savePpsSetPnt2 (OLE::Storage_Lite::PPS::Root) | ||||
| 466 | # For Test | ||||
| 467 | #------------------------------------------------------------------------------ | ||||
| 468 | sub _savePpsSetPnt2($$$) | ||||
| 469 | { | ||||
| 470 | my($aThis, $raList, $rhInfo) = @_; | ||||
| 471 | #1. make Array as Children-Relations | ||||
| 472 | #1.1 if No Children | ||||
| 473 | if($#$aThis < 0) { | ||||
| 474 | return 0xFFFFFFFF; | ||||
| 475 | } | ||||
| 476 | elsif($#$aThis == 0) { | ||||
| 477 | #1.2 Just Only one | ||||
| 478 | push @$raList, $aThis->[0]; | ||||
| 479 | $aThis->[0]->{No} = $#$raList; | ||||
| 480 | $aThis->[0]->{PrevPps} = 0xFFFFFFFF; | ||||
| 481 | $aThis->[0]->{NextPps} = 0xFFFFFFFF; | ||||
| 482 | $aThis->[0]->{DirPps} = _savePpsSetPnt2($aThis->[0]->{Child}, $raList, $rhInfo); | ||||
| 483 | return $aThis->[0]->{No}; | ||||
| 484 | } | ||||
| 485 | else { | ||||
| 486 | #1.3 Array | ||||
| 487 | my $iCnt = $#$aThis + 1; | ||||
| 488 | #1.3.1 Define Center | ||||
| 489 | my $iPos = 0; #int($iCnt/ 2); #$iCnt | ||||
| 490 | |||||
| 491 | my @aWk = @$aThis; | ||||
| 492 | my @aPrev = ($#$aThis > 1)? splice(@aWk, 1, 1) : (); #$iPos); | ||||
| 493 | my @aNext = splice(@aWk, 1); #, $iCnt - $iPos -1); | ||||
| 494 | $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt2( | ||||
| 495 | \@aPrev, $raList, $rhInfo); | ||||
| 496 | push @$raList, $aThis->[$iPos]; | ||||
| 497 | $aThis->[$iPos]->{No} = $#$raList; | ||||
| 498 | |||||
| 499 | #1.3.2 Devide a array into Previous,Next | ||||
| 500 | $aThis->[$iPos]->{NextPps} = _savePpsSetPnt2( | ||||
| 501 | \@aNext, $raList, $rhInfo); | ||||
| 502 | $aThis->[$iPos]->{DirPps} = _savePpsSetPnt2($aThis->[$iPos]->{Child}, $raList, $rhInfo); | ||||
| 503 | return $aThis->[$iPos]->{No}; | ||||
| 504 | } | ||||
| 505 | } | ||||
| 506 | #------------------------------------------------------------------------------ | ||||
| 507 | # _savePpsSetPnt2 (OLE::Storage_Lite::PPS::Root) | ||||
| 508 | # For Test | ||||
| 509 | #------------------------------------------------------------------------------ | ||||
| 510 | sub _savePpsSetPnt2s($$$) | ||||
| 511 | { | ||||
| 512 | my($aThis, $raList, $rhInfo) = @_; | ||||
| 513 | #1. make Array as Children-Relations | ||||
| 514 | #1.1 if No Children | ||||
| 515 | if($#$aThis < 0) { | ||||
| 516 | return 0xFFFFFFFF; | ||||
| 517 | } | ||||
| 518 | elsif($#$aThis == 0) { | ||||
| 519 | #1.2 Just Only one | ||||
| 520 | push @$raList, $aThis->[0]; | ||||
| 521 | $aThis->[0]->{No} = $#$raList; | ||||
| 522 | $aThis->[0]->{PrevPps} = 0xFFFFFFFF; | ||||
| 523 | $aThis->[0]->{NextPps} = 0xFFFFFFFF; | ||||
| 524 | $aThis->[0]->{DirPps} = _savePpsSetPnt2($aThis->[0]->{Child}, $raList, $rhInfo); | ||||
| 525 | return $aThis->[0]->{No}; | ||||
| 526 | } | ||||
| 527 | else { | ||||
| 528 | #1.3 Array | ||||
| 529 | my $iCnt = $#$aThis + 1; | ||||
| 530 | #1.3.1 Define Center | ||||
| 531 | my $iPos = 0; #int($iCnt/ 2); #$iCnt | ||||
| 532 | push @$raList, $aThis->[$iPos]; | ||||
| 533 | $aThis->[$iPos]->{No} = $#$raList; | ||||
| 534 | my @aWk = @$aThis; | ||||
| 535 | #1.3.2 Devide a array into Previous,Next | ||||
| 536 | my @aPrev = splice(@aWk, 0, $iPos); | ||||
| 537 | my @aNext = splice(@aWk, 1, $iCnt - $iPos -1); | ||||
| 538 | $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt2( | ||||
| 539 | \@aPrev, $raList, $rhInfo); | ||||
| 540 | $aThis->[$iPos]->{NextPps} = _savePpsSetPnt2( | ||||
| 541 | \@aNext, $raList, $rhInfo); | ||||
| 542 | $aThis->[$iPos]->{DirPps} = _savePpsSetPnt2($aThis->[$iPos]->{Child}, $raList, $rhInfo); | ||||
| 543 | return $aThis->[$iPos]->{No}; | ||||
| 544 | } | ||||
| 545 | } | ||||
| 546 | #------------------------------------------------------------------------------ | ||||
| 547 | # _savePpsSetPnt (OLE::Storage_Lite::PPS::Root) | ||||
| 548 | #------------------------------------------------------------------------------ | ||||
| 549 | sub _savePpsSetPnt($$$) | ||||
| 550 | { | ||||
| 551 | my($aThis, $raList, $rhInfo) = @_; | ||||
| 552 | #1. make Array as Children-Relations | ||||
| 553 | #1.1 if No Children | ||||
| 554 | if($#$aThis < 0) { | ||||
| 555 | return 0xFFFFFFFF; | ||||
| 556 | } | ||||
| 557 | elsif($#$aThis == 0) { | ||||
| 558 | #1.2 Just Only one | ||||
| 559 | push @$raList, $aThis->[0]; | ||||
| 560 | $aThis->[0]->{No} = $#$raList; | ||||
| 561 | $aThis->[0]->{PrevPps} = 0xFFFFFFFF; | ||||
| 562 | $aThis->[0]->{NextPps} = 0xFFFFFFFF; | ||||
| 563 | $aThis->[0]->{DirPps} = _savePpsSetPnt($aThis->[0]->{Child}, $raList, $rhInfo); | ||||
| 564 | return $aThis->[0]->{No}; | ||||
| 565 | } | ||||
| 566 | else { | ||||
| 567 | #1.3 Array | ||||
| 568 | my $iCnt = $#$aThis + 1; | ||||
| 569 | #1.3.1 Define Center | ||||
| 570 | my $iPos = int($iCnt/ 2); #$iCnt | ||||
| 571 | push @$raList, $aThis->[$iPos]; | ||||
| 572 | $aThis->[$iPos]->{No} = $#$raList; | ||||
| 573 | my @aWk = @$aThis; | ||||
| 574 | #1.3.2 Devide a array into Previous,Next | ||||
| 575 | my @aPrev = splice(@aWk, 0, $iPos); | ||||
| 576 | my @aNext = splice(@aWk, 1, $iCnt - $iPos -1); | ||||
| 577 | $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt( | ||||
| 578 | \@aPrev, $raList, $rhInfo); | ||||
| 579 | $aThis->[$iPos]->{NextPps} = _savePpsSetPnt( | ||||
| 580 | \@aNext, $raList, $rhInfo); | ||||
| 581 | $aThis->[$iPos]->{DirPps} = _savePpsSetPnt($aThis->[$iPos]->{Child}, $raList, $rhInfo); | ||||
| 582 | return $aThis->[$iPos]->{No}; | ||||
| 583 | } | ||||
| 584 | } | ||||
| 585 | #------------------------------------------------------------------------------ | ||||
| 586 | # _savePpsSetPnt (OLE::Storage_Lite::PPS::Root) | ||||
| 587 | #------------------------------------------------------------------------------ | ||||
| 588 | sub _savePpsSetPnt1($$$) | ||||
| 589 | { | ||||
| 590 | my($aThis, $raList, $rhInfo) = @_; | ||||
| 591 | #1. make Array as Children-Relations | ||||
| 592 | #1.1 if No Children | ||||
| 593 | if($#$aThis < 0) { | ||||
| 594 | return 0xFFFFFFFF; | ||||
| 595 | } | ||||
| 596 | elsif($#$aThis == 0) { | ||||
| 597 | #1.2 Just Only one | ||||
| 598 | push @$raList, $aThis->[0]; | ||||
| 599 | $aThis->[0]->{No} = $#$raList; | ||||
| 600 | $aThis->[0]->{PrevPps} = 0xFFFFFFFF; | ||||
| 601 | $aThis->[0]->{NextPps} = 0xFFFFFFFF; | ||||
| 602 | $aThis->[0]->{DirPps} = _savePpsSetPnt($aThis->[0]->{Child}, $raList, $rhInfo); | ||||
| 603 | return $aThis->[0]->{No}; | ||||
| 604 | } | ||||
| 605 | else { | ||||
| 606 | #1.3 Array | ||||
| 607 | my $iCnt = $#$aThis + 1; | ||||
| 608 | #1.3.1 Define Center | ||||
| 609 | my $iPos = int($iCnt/ 2); #$iCnt | ||||
| 610 | push @$raList, $aThis->[$iPos]; | ||||
| 611 | $aThis->[$iPos]->{No} = $#$raList; | ||||
| 612 | my @aWk = @$aThis; | ||||
| 613 | #1.3.2 Devide a array into Previous,Next | ||||
| 614 | my @aPrev = splice(@aWk, 0, $iPos); | ||||
| 615 | my @aNext = splice(@aWk, 1, $iCnt - $iPos -1); | ||||
| 616 | $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt( | ||||
| 617 | \@aPrev, $raList, $rhInfo); | ||||
| 618 | $aThis->[$iPos]->{NextPps} = _savePpsSetPnt( | ||||
| 619 | \@aNext, $raList, $rhInfo); | ||||
| 620 | $aThis->[$iPos]->{DirPps} = _savePpsSetPnt($aThis->[$iPos]->{Child}, $raList, $rhInfo); | ||||
| 621 | return $aThis->[$iPos]->{No}; | ||||
| 622 | } | ||||
| 623 | } | ||||
| 624 | #------------------------------------------------------------------------------ | ||||
| 625 | # _saveBbd (OLE::Storage_Lite) | ||||
| 626 | #------------------------------------------------------------------------------ | ||||
| 627 | sub _saveBbd($$$$) | ||||
| 628 | { | ||||
| 629 | my($oThis, $iSbdSize, $iBsize, $iPpsCnt, $rhInfo) = @_; | ||||
| 630 | my $FILE = $rhInfo->{_FILEH_}; | ||||
| 631 | #0. Calculate Basic Setting | ||||
| 632 | my $iBbCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize(); | ||||
| 633 | my $iBlCnt = $iBbCnt - 1; | ||||
| 634 | my $i1stBdL = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize()); | ||||
| 635 | my $i1stBdMax = $i1stBdL * $iBbCnt - $i1stBdL; | ||||
| 636 | my $iBdExL = 0; | ||||
| 637 | my $iAll = $iBsize + $iPpsCnt + $iSbdSize; | ||||
| 638 | my $iAllW = $iAll; | ||||
| 639 | my $iBdCntW = int($iAllW / $iBbCnt) + (($iAllW % $iBbCnt)? 1: 0); | ||||
| 640 | my $iBdCnt = 0; | ||||
| 641 | my $i; | ||||
| 642 | #0.1 Calculate BD count | ||||
| 643 | my $iBBleftover = $iAll - $i1stBdMax; | ||||
| 644 | if ($iAll >$i1stBdMax) { | ||||
| 645 | |||||
| 646 | while(1) { | ||||
| 647 | $iBdCnt = int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0); | ||||
| 648 | $iBdExL = int(($iBdCnt) / $iBlCnt) + ((($iBdCnt) % $iBlCnt)? 1: 0); | ||||
| 649 | $iBBleftover = $iBBleftover + $iBdExL; | ||||
| 650 | last if($iBdCnt == (int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0))); | ||||
| 651 | } | ||||
| 652 | } | ||||
| 653 | $iAllW += $iBdExL; | ||||
| 654 | $iBdCnt += $i1stBdL; | ||||
| 655 | #print "iBdCnt = $iBdCnt \n"; | ||||
| 656 | |||||
| 657 | #1. Making BD | ||||
| 658 | #1.1 Set for SBD | ||||
| 659 | if($iSbdSize > 0) { | ||||
| 660 | for ($i = 0; $i<($iSbdSize-1); $i++) { | ||||
| 661 | print {$FILE} (pack("V", $i+1)); | ||||
| 662 | } | ||||
| 663 | 1 | 1µs | print {$FILE} (pack("V", -2)); # spent 1µs making 1 call to CORE::pack | ||
| 664 | } | ||||
| 665 | #1.2 Set for B | ||||
| 666 | for ($i = 0; $i<($iBsize-1); $i++) { | ||||
| 667 | print {$FILE} (pack("V", $i+$iSbdSize+1)); | ||||
| 668 | } | ||||
| 669 | 1 | 700ns | print {$FILE} (pack("V", -2)); # spent 700ns making 1 call to CORE::pack | ||
| 670 | |||||
| 671 | #1.3 Set for PPS | ||||
| 672 | for ($i = 0; $i<($iPpsCnt-1); $i++) { | ||||
| 673 | print {$FILE} (pack("V", $i+$iSbdSize+$iBsize+1)); | ||||
| 674 | } | ||||
| 675 | 1 | 300ns | print {$FILE} (pack("V", -2)); # spent 300ns making 1 call to CORE::pack | ||
| 676 | #1.4 Set for BBD itself ( 0xFFFFFFFD : BBD) | ||||
| 677 | for($i=0; $i<$iBdCnt;$i++) { | ||||
| 678 | 1 | 200ns | print {$FILE} (pack("V", 0xFFFFFFFD)); # spent 200ns making 1 call to CORE::pack | ||
| 679 | } | ||||
| 680 | #1.5 Set for ExtraBDList | ||||
| 681 | for($i=0; $i<$iBdExL;$i++) { | ||||
| 682 | 1 | 200ns | print {$FILE} (pack("V", 0xFFFFFFFC)); # spent 200ns making 1 call to CORE::pack | ||
| 683 | } | ||||
| 684 | #1.6 Adjust for Block | ||||
| 685 | 1 | 200ns | print {$FILE} (pack("V", -1) x ($iBbCnt - (($iAllW + $iBdCnt) % $iBbCnt))) # spent 200ns making 1 call to CORE::pack | ||
| 686 | if(($iAllW + $iBdCnt) % $iBbCnt); | ||||
| 687 | #2.Extra BDList | ||||
| 688 | if($iBdCnt > $i1stBdL) { | ||||
| 689 | my $iN=0; | ||||
| 690 | my $iNb=0; | ||||
| 691 | for($i=$i1stBdL;$i<$iBdCnt; $i++, $iN++) { | ||||
| 692 | if($iN>=($iBbCnt-1)) { | ||||
| 693 | $iN = 0; | ||||
| 694 | $iNb++; | ||||
| 695 | print {$FILE} (pack("V", $iAll+$iBdCnt+$iNb)); | ||||
| 696 | } | ||||
| 697 | print {$FILE} (pack("V", $iBsize+$iSbdSize+$iPpsCnt+$i)); | ||||
| 698 | } | ||||
| 699 | 1 | 500ns | print {$FILE} (pack("V", -1) x (($iBbCnt-1) - (($iBdCnt-$i1stBdL) % ($iBbCnt-1)))) # spent 500ns making 1 call to CORE::pack | ||
| 700 | if(($iBdCnt-$i1stBdL) % ($iBbCnt-1)); | ||||
| 701 | 1 | 200ns | print {$FILE} (pack("V", -2)); # spent 200ns making 1 call to CORE::pack | ||
| 702 | } | ||||
| 703 | } | ||||
| 704 | |||||
| 705 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 706 | # OLE::Storage_Lite::PPS::File Object | ||||
| 707 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 708 | #============================================================================== | ||||
| 709 | # OLE::Storage_Lite::PPS::File | ||||
| 710 | #============================================================================== | ||||
| 711 | package OLE::Storage_Lite::PPS::File; | ||||
| 712 | 1 | 100ns | require Exporter; | ||
| 713 | 2 | 20µs | 2 | 8µs | # spent 7µs (6+2) within OLE::Storage_Lite::PPS::File::BEGIN@713 which was called:
# once (6µs+2µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 713 # spent 7µs making 1 call to OLE::Storage_Lite::PPS::File::BEGIN@713
# spent 2µs making 1 call to strict::import |
| 714 | 2 | 197µs | 2 | 38µs | # spent 21µs (4+17) within OLE::Storage_Lite::PPS::File::BEGIN@714 which was called:
# once (4µs+17µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 714 # spent 21µs making 1 call to OLE::Storage_Lite::PPS::File::BEGIN@714
# spent 17µs making 1 call to vars::import |
| 715 | 1 | 3µs | @ISA = qw(OLE::Storage_Lite::PPS Exporter); | ||
| 716 | 1 | 100ns | $VERSION = '0.22'; | ||
| 717 | #------------------------------------------------------------------------------ | ||||
| 718 | # new (OLE::Storage_Lite::PPS::File) | ||||
| 719 | #------------------------------------------------------------------------------ | ||||
| 720 | sub new ($$$) { | ||||
| 721 | my($sClass, $sNm, $sData) = @_; | ||||
| 722 | OLE::Storage_Lite::PPS::_new( | ||||
| 723 | $sClass, | ||||
| 724 | undef, | ||||
| 725 | $sNm, | ||||
| 726 | 2, | ||||
| 727 | undef, | ||||
| 728 | undef, | ||||
| 729 | undef, | ||||
| 730 | undef, | ||||
| 731 | undef, | ||||
| 732 | undef, | ||||
| 733 | undef, | ||||
| 734 | $sData, | ||||
| 735 | undef); | ||||
| 736 | } | ||||
| 737 | #------------------------------------------------------------------------------ | ||||
| 738 | # newFile (OLE::Storage_Lite::PPS::File) | ||||
| 739 | #------------------------------------------------------------------------------ | ||||
| 740 | sub newFile ($$;$) { | ||||
| 741 | my($sClass, $sNm, $sFile) = @_; | ||||
| 742 | my $oSelf = | ||||
| 743 | OLE::Storage_Lite::PPS::_new( | ||||
| 744 | $sClass, | ||||
| 745 | undef, | ||||
| 746 | $sNm, | ||||
| 747 | 2, | ||||
| 748 | undef, | ||||
| 749 | undef, | ||||
| 750 | undef, | ||||
| 751 | undef, | ||||
| 752 | undef, | ||||
| 753 | undef, | ||||
| 754 | undef, | ||||
| 755 | '', | ||||
| 756 | undef); | ||||
| 757 | # | ||||
| 758 | if((!defined($sFile)) or ($sFile eq '')) { | ||||
| 759 | $oSelf->{_PPS_FILE} = IO::File->new_tmpfile(); | ||||
| 760 | } | ||||
| 761 | elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) { | ||||
| 762 | $oSelf->{_PPS_FILE} = $sFile; | ||||
| 763 | } | ||||
| 764 | elsif(!ref($sFile)) { | ||||
| 765 | #File Name | ||||
| 766 | $oSelf->{_PPS_FILE} = new IO::File; | ||||
| 767 | return undef unless($oSelf->{_PPS_FILE}); | ||||
| 768 | $oSelf->{_PPS_FILE}->open("$sFile", "r+") || return undef; | ||||
| 769 | } | ||||
| 770 | else { | ||||
| 771 | return undef; | ||||
| 772 | } | ||||
| 773 | if($oSelf->{_PPS_FILE}) { | ||||
| 774 | $oSelf->{_PPS_FILE}->seek(0, 2); | ||||
| 775 | binmode($oSelf->{_PPS_FILE}); | ||||
| 776 | $oSelf->{_PPS_FILE}->autoflush(1); | ||||
| 777 | } | ||||
| 778 | return $oSelf; | ||||
| 779 | } | ||||
| 780 | #------------------------------------------------------------------------------ | ||||
| 781 | # append (OLE::Storage_Lite::PPS::File) | ||||
| 782 | #------------------------------------------------------------------------------ | ||||
| 783 | sub append ($$) { | ||||
| 784 | my($oSelf, $sData) = @_; | ||||
| 785 | if($oSelf->{_PPS_FILE}) { | ||||
| 786 | print {$oSelf->{_PPS_FILE}} $sData; | ||||
| 787 | } | ||||
| 788 | else { | ||||
| 789 | $oSelf->{Data} .= $sData; | ||||
| 790 | } | ||||
| 791 | } | ||||
| 792 | |||||
| 793 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 794 | # OLE::Storage_Lite::PPS::Dir Object | ||||
| 795 | #////////////////////////////////////////////////////////////////////////////// | ||||
| 796 | #------------------------------------------------------------------------------ | ||||
| 797 | # new (OLE::Storage_Lite::PPS::Dir) | ||||
| 798 | #------------------------------------------------------------------------------ | ||||
| 799 | package OLE::Storage_Lite::PPS::Dir; | ||||
| 800 | 1 | 100ns | require Exporter; | ||
| 801 | 2 | 22µs | 2 | 8µs | # spent 7µs (5+1) within OLE::Storage_Lite::PPS::Dir::BEGIN@801 which was called:
# once (5µs+1µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 801 # spent 7µs making 1 call to OLE::Storage_Lite::PPS::Dir::BEGIN@801
# spent 1µs making 1 call to strict::import |
| 802 | 2 | 58µs | 2 | 35µs | # spent 19µs (3+16) within OLE::Storage_Lite::PPS::Dir::BEGIN@802 which was called:
# once (3µs+16µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 802 # spent 19µs making 1 call to OLE::Storage_Lite::PPS::Dir::BEGIN@802
# spent 16µs making 1 call to vars::import |
| 803 | 1 | 3µs | @ISA = qw(OLE::Storage_Lite::PPS Exporter); | ||
| 804 | 1 | 100ns | $VERSION = '0.22'; | ||
| 805 | sub new ($$;$$$) { | ||||
| 806 | my($sClass, $sName, $raTime1st, $raTime2nd, $raChild) = @_; | ||||
| 807 | OLE::Storage_Lite::PPS::_new( | ||||
| 808 | $sClass, | ||||
| 809 | undef, | ||||
| 810 | $sName, | ||||
| 811 | 1, | ||||
| 812 | undef, | ||||
| 813 | undef, | ||||
| 814 | undef, | ||||
| 815 | $raTime1st, | ||||
| 816 | $raTime2nd, | ||||
| 817 | undef, | ||||
| 818 | undef, | ||||
| 819 | undef, | ||||
| 820 | $raChild); | ||||
| 821 | } | ||||
| 822 | #============================================================================== | ||||
| 823 | # OLE::Storage_Lite | ||||
| 824 | #============================================================================== | ||||
| 825 | package OLE::Storage_Lite; | ||||
| 826 | 1 | 100ns | require Exporter; | ||
| 827 | |||||
| 828 | 2 | 14µs | 2 | 7µs | # spent 6µs (4+1) within OLE::Storage_Lite::BEGIN@828 which was called:
# once (4µs+1µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 828 # spent 6µs making 1 call to OLE::Storage_Lite::BEGIN@828
# spent 1µs making 1 call to strict::import |
| 829 | 2 | 14µs | 2 | 50µs | # spent 27µs (3+24) within OLE::Storage_Lite::BEGIN@829 which was called:
# once (3µs+24µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 829 # spent 27µs making 1 call to OLE::Storage_Lite::BEGIN@829
# spent 24µs making 1 call to Exporter::import |
| 830 | 2 | 15µs | 2 | 127µs | # spent 66µs (4+62) within OLE::Storage_Lite::BEGIN@830 which was called:
# once (4µs+62µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 830 # spent 66µs making 1 call to OLE::Storage_Lite::BEGIN@830
# spent 62µs making 1 call to Exporter::import |
| 831 | 2 | 16µs | 2 | 31µs | # spent 24µs (7+17) within OLE::Storage_Lite::BEGIN@831 which was called:
# once (7µs+17µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 831 # spent 24µs making 1 call to OLE::Storage_Lite::BEGIN@831
# spent 6µs making 1 call to List::Util::import |
| 832 | 2 | 15µs | 2 | 40µs | # spent 22µs (4+18) within OLE::Storage_Lite::BEGIN@832 which was called:
# once (4µs+18µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 832 # spent 22µs making 1 call to OLE::Storage_Lite::BEGIN@832
# spent 18µs making 1 call to Exporter::import |
| 833 | |||||
| 834 | 2 | 40µs | 2 | 39µs | # spent 21µs (3+18) within OLE::Storage_Lite::BEGIN@834 which was called:
# once (3µs+18µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 834 # spent 21µs making 1 call to OLE::Storage_Lite::BEGIN@834
# spent 18µs making 1 call to vars::import |
| 835 | 1 | 2µs | @ISA = qw(Exporter); | ||
| 836 | 1 | 100ns | $VERSION = '0.22'; | ||
| 837 | sub _getPpsSearch($$$$$;$); | ||||
| 838 | sub _getPpsTree($$$;$); | ||||
| 839 | #------------------------------------------------------------------------------ | ||||
| 840 | # Const for OLE::Storage_Lite | ||||
| 841 | #------------------------------------------------------------------------------ | ||||
| 842 | #0. Constants | ||||
| 843 | # spent 76µs (7+69) within OLE::Storage_Lite::BEGIN@843 which was called:
# once (7µs+69µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 853 | ||||
| 844 | 1 | 6µs | 1 | 69µs | PpsType_Root => 5, # spent 69µs making 1 call to constant::import |
| 845 | PpsType_Dir => 1, | ||||
| 846 | PpsType_File => 2, | ||||
| 847 | DataSizeSmall => 0x1000, | ||||
| 848 | LongIntSize => 4, | ||||
| 849 | PpsSize => 0x80, | ||||
| 850 | # 0xFFFFFFFC : BDList, 0xFFFFFFFD : BBD, | ||||
| 851 | # 0xFFFFFFFE: End of Chain 0xFFFFFFFF : unused | ||||
| 852 | NormalBlockEnd => 0xFFFFFFFC, | ||||
| 853 | 1 | 1.55ms | 1 | 76µs | }; # spent 76µs making 1 call to OLE::Storage_Lite::BEGIN@843 |
| 854 | #------------------------------------------------------------------------------ | ||||
| 855 | # new OLE::Storage_Lite | ||||
| 856 | #------------------------------------------------------------------------------ | ||||
| 857 | sub new($$) { | ||||
| 858 | my($sClass, $sFile) = @_; | ||||
| 859 | my $oThis = { | ||||
| 860 | _FILE => $sFile, | ||||
| 861 | }; | ||||
| 862 | bless $oThis; | ||||
| 863 | return $oThis; | ||||
| 864 | } | ||||
| 865 | #------------------------------------------------------------------------------ | ||||
| 866 | # getPpsTree: OLE::Storage_Lite | ||||
| 867 | #------------------------------------------------------------------------------ | ||||
| 868 | sub getPpsTree($;$) | ||||
| 869 | { | ||||
| 870 | my($oThis, $bData) = @_; | ||||
| 871 | #0.Init | ||||
| 872 | my $rhInfo = _initParse($oThis->{_FILE}); | ||||
| 873 | return undef unless($rhInfo); | ||||
| 874 | #1. Get Data | ||||
| 875 | my ($oPps) = _getPpsTree(0, $rhInfo, $bData); | ||||
| 876 | close(IN); | ||||
| 877 | return $oPps; | ||||
| 878 | } | ||||
| 879 | #------------------------------------------------------------------------------ | ||||
| 880 | # getSearch: OLE::Storage_Lite | ||||
| 881 | #------------------------------------------------------------------------------ | ||||
| 882 | sub getPpsSearch($$;$$) | ||||
| 883 | { | ||||
| 884 | my($oThis, $raName, $bData, $iCase) = @_; | ||||
| 885 | #0.Init | ||||
| 886 | my $rhInfo = _initParse($oThis->{_FILE}); | ||||
| 887 | return undef unless($rhInfo); | ||||
| 888 | #1. Get Data | ||||
| 889 | my @aList = _getPpsSearch(0, $rhInfo, $raName, $bData, $iCase); | ||||
| 890 | close(IN); | ||||
| 891 | return @aList; | ||||
| 892 | } | ||||
| 893 | #------------------------------------------------------------------------------ | ||||
| 894 | # getNthPps: OLE::Storage_Lite | ||||
| 895 | #------------------------------------------------------------------------------ | ||||
| 896 | sub getNthPps($$;$) | ||||
| 897 | { | ||||
| 898 | my($oThis, $iNo, $bData) = @_; | ||||
| 899 | #0.Init | ||||
| 900 | my $rhInfo = _initParse($oThis->{_FILE}); | ||||
| 901 | return undef unless($rhInfo); | ||||
| 902 | #1. Get Data | ||||
| 903 | my $oPps = _getNthPps($iNo, $rhInfo, $bData); | ||||
| 904 | close IN; | ||||
| 905 | return $oPps; | ||||
| 906 | } | ||||
| 907 | #------------------------------------------------------------------------------ | ||||
| 908 | # _initParse: OLE::Storage_Lite | ||||
| 909 | #------------------------------------------------------------------------------ | ||||
| 910 | sub _initParse($) { | ||||
| 911 | my($sFile)=@_; | ||||
| 912 | my $oIo; | ||||
| 913 | #1. $sFile is Ref of scalar | ||||
| 914 | if(ref($sFile) eq 'SCALAR') { | ||||
| 915 | require IO::Scalar; | ||||
| 916 | $oIo = new IO::Scalar; | ||||
| 917 | $oIo->open($sFile); | ||||
| 918 | } | ||||
| 919 | #2. $sFile is a IO::Handle object | ||||
| 920 | elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) { | ||||
| 921 | $oIo = $sFile; | ||||
| 922 | binmode($oIo); | ||||
| 923 | } | ||||
| 924 | #3. $sFile is a simple filename string | ||||
| 925 | elsif(!ref($sFile)) { | ||||
| 926 | $oIo = new IO::File; | ||||
| 927 | $oIo->open("<$sFile") || return undef; | ||||
| 928 | binmode($oIo); | ||||
| 929 | } | ||||
| 930 | #4 Assume that if $sFile is a ref then it is a valid filehandle | ||||
| 931 | else { | ||||
| 932 | $oIo = $sFile; | ||||
| 933 | # Not all filehandles support binmode() so try it in an eval. | ||||
| 934 | eval{ binmode $oIo }; | ||||
| 935 | } | ||||
| 936 | return _getHeaderInfo($oIo); | ||||
| 937 | } | ||||
| 938 | #------------------------------------------------------------------------------ | ||||
| 939 | # _getPpsTree: OLE::Storage_Lite | ||||
| 940 | #------------------------------------------------------------------------------ | ||||
| 941 | sub _getPpsTree($$$;$) { | ||||
| 942 | my($iNo, $rhInfo, $bData, $raDone) = @_; | ||||
| 943 | if(defined($raDone)) { | ||||
| 944 | return () if(exists($raDone->{$iNo})); | ||||
| 945 | } | ||||
| 946 | else { | ||||
| 947 | $raDone={}; | ||||
| 948 | } | ||||
| 949 | $raDone->{$iNo} = undef; | ||||
| 950 | |||||
| 951 | my $iRootBlock = $rhInfo->{_ROOT_START} ; | ||||
| 952 | #1. Get Information about itself | ||||
| 953 | my $oPps = _getNthPps($iNo, $rhInfo, $bData); | ||||
| 954 | #2. Child | ||||
| 955 | if($oPps->{DirPps} != 0xFFFFFFFF) { | ||||
| 956 | my @aChildL = _getPpsTree($oPps->{DirPps}, $rhInfo, $bData, $raDone); | ||||
| 957 | $oPps->{Child} = \@aChildL; | ||||
| 958 | } | ||||
| 959 | else { | ||||
| 960 | $oPps->{Child} = undef; | ||||
| 961 | } | ||||
| 962 | #3. Previous,Next PPSs | ||||
| 963 | my @aList = (); | ||||
| 964 | push @aList, _getPpsTree($oPps->{PrevPps}, $rhInfo, $bData, $raDone) | ||||
| 965 | if($oPps->{PrevPps} != 0xFFFFFFFF); | ||||
| 966 | push @aList, $oPps; | ||||
| 967 | push @aList, _getPpsTree($oPps->{NextPps}, $rhInfo, $bData, $raDone) | ||||
| 968 | if($oPps->{NextPps} != 0xFFFFFFFF); | ||||
| 969 | return @aList; | ||||
| 970 | } | ||||
| 971 | #------------------------------------------------------------------------------ | ||||
| 972 | # _getPpsSearch: OLE::Storage_Lite | ||||
| 973 | #------------------------------------------------------------------------------ | ||||
| 974 | sub _getPpsSearch($$$$$;$) { | ||||
| 975 | my($iNo, $rhInfo, $raName, $bData, $iCase, $raDone) = @_; | ||||
| 976 | my $iRootBlock = $rhInfo->{_ROOT_START} ; | ||||
| 977 | my @aRes; | ||||
| 978 | #1. Check it self | ||||
| 979 | if(defined($raDone)) { | ||||
| 980 | return () if(exists($raDone->{$iNo})); | ||||
| 981 | } | ||||
| 982 | else { | ||||
| 983 | $raDone={}; | ||||
| 984 | } | ||||
| 985 | $raDone->{$iNo} = undef; | ||||
| 986 | my $oPps = _getNthPps($iNo, $rhInfo, undef); | ||||
| 987 | # if(first {$_ eq $oPps->{Name}} @$raName) { | ||||
| 988 | if(($iCase && (first {/^\Q$oPps->{Name}\E$/i} @$raName)) || | ||||
| 989 | (first {$_ eq $oPps->{Name}} @$raName)) { | ||||
| 990 | $oPps = _getNthPps($iNo, $rhInfo, $bData) if ($bData); | ||||
| 991 | @aRes = ($oPps); | ||||
| 992 | } | ||||
| 993 | else { | ||||
| 994 | @aRes = (); | ||||
| 995 | } | ||||
| 996 | #2. Check Child, Previous, Next PPSs | ||||
| 997 | push @aRes, _getPpsSearch($oPps->{DirPps}, $rhInfo, $raName, $bData, $iCase, $raDone) | ||||
| 998 | if($oPps->{DirPps} != 0xFFFFFFFF) ; | ||||
| 999 | push @aRes, _getPpsSearch($oPps->{PrevPps}, $rhInfo, $raName, $bData, $iCase, $raDone) | ||||
| 1000 | if($oPps->{PrevPps} != 0xFFFFFFFF ); | ||||
| 1001 | push @aRes, _getPpsSearch($oPps->{NextPps}, $rhInfo, $raName, $bData, $iCase, $raDone) | ||||
| 1002 | if($oPps->{NextPps} != 0xFFFFFFFF); | ||||
| 1003 | return @aRes; | ||||
| 1004 | } | ||||
| 1005 | #=================================================================== | ||||
| 1006 | # Get Header Info (BASE Informain about that file) | ||||
| 1007 | #=================================================================== | ||||
| 1008 | sub _getHeaderInfo($){ | ||||
| 1009 | my($FILE) = @_; | ||||
| 1010 | my($iWk); | ||||
| 1011 | my $rhInfo = {}; | ||||
| 1012 | $rhInfo->{_FILEH_} = $FILE; | ||||
| 1013 | my $sWk; | ||||
| 1014 | #0. Check ID | ||||
| 1015 | $rhInfo->{_FILEH_}->seek(0, 0); | ||||
| 1016 | $rhInfo->{_FILEH_}->read($sWk, 8); | ||||
| 1017 | return undef unless($sWk eq "\xD0\xCF\x11\xE0\xA1\xB1\x1A\xE1"); | ||||
| 1018 | #BIG BLOCK SIZE | ||||
| 1019 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x1E, 2, "v"); | ||||
| 1020 | return undef unless(defined($iWk)); | ||||
| 1021 | $rhInfo->{_BIG_BLOCK_SIZE} = 2 ** $iWk; | ||||
| 1022 | #SMALL BLOCK SIZE | ||||
| 1023 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x20, 2, "v"); | ||||
| 1024 | return undef unless(defined($iWk)); | ||||
| 1025 | $rhInfo->{_SMALL_BLOCK_SIZE} = 2 ** $iWk; | ||||
| 1026 | #BDB Count | ||||
| 1027 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x2C, 4, "V"); | ||||
| 1028 | return undef unless(defined($iWk)); | ||||
| 1029 | $rhInfo->{_BDB_COUNT} = $iWk; | ||||
| 1030 | #START BLOCK | ||||
| 1031 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x30, 4, "V"); | ||||
| 1032 | return undef unless(defined($iWk)); | ||||
| 1033 | $rhInfo->{_ROOT_START} = $iWk; | ||||
| 1034 | #MIN SIZE OF BB | ||||
| 1035 | # $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x38, 4, "V"); | ||||
| 1036 | # return undef unless(defined($iWk)); | ||||
| 1037 | # $rhInfo->{_MIN_SIZE_BB} = $iWk; | ||||
| 1038 | #SMALL BD START | ||||
| 1039 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x3C, 4, "V"); | ||||
| 1040 | return undef unless(defined($iWk)); | ||||
| 1041 | $rhInfo->{_SBD_START} = $iWk; | ||||
| 1042 | #SMALL BD COUNT | ||||
| 1043 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x40, 4, "V"); | ||||
| 1044 | return undef unless(defined($iWk)); | ||||
| 1045 | $rhInfo->{_SBD_COUNT} = $iWk; | ||||
| 1046 | #EXTRA BBD START | ||||
| 1047 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x44, 4, "V"); | ||||
| 1048 | return undef unless(defined($iWk)); | ||||
| 1049 | $rhInfo->{_EXTRA_BBD_START} = $iWk; | ||||
| 1050 | #EXTRA BD COUNT | ||||
| 1051 | $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x48, 4, "V"); | ||||
| 1052 | return undef unless(defined($iWk)); | ||||
| 1053 | $rhInfo->{_EXTRA_BBD_COUNT} = $iWk; | ||||
| 1054 | #GET BBD INFO | ||||
| 1055 | $rhInfo->{_BBD_INFO}= _getBbdInfo($rhInfo); | ||||
| 1056 | #GET ROOT PPS | ||||
| 1057 | my $oRoot = _getNthPps(0, $rhInfo, undef); | ||||
| 1058 | $rhInfo->{_SB_START} = $oRoot->{StartBlock}; | ||||
| 1059 | $rhInfo->{_SB_SIZE} = $oRoot->{Size}; | ||||
| 1060 | # cache lookaheads for huge performance improvement in some cases | ||||
| 1061 | my $iNextCount = keys(%{$rhInfo->{_BBD_INFO}}); | ||||
| 1062 | my $iBlockNo = $rhInfo->{_ROOT_START}; | ||||
| 1063 | my $iBigBlkSize=$rhInfo->{_BIG_BLOCK_SIZE}; | ||||
| 1064 | $rhInfo->{_BBD_ROOT_START}= [$iBlockNo]; | ||||
| 1065 | for(1..$iNextCount) { | ||||
| 1066 | $iBlockNo = $rhInfo->{_BBD_INFO}->{$iBlockNo} // $iBlockNo+1; | ||||
| 1067 | last unless $iBlockNo < OLE::Storage_Lite::NormalBlockEnd(); | ||||
| 1068 | $rhInfo->{_BBD_ROOT_START}->[$_] = $iBlockNo; | ||||
| 1069 | } | ||||
| 1070 | $iBlockNo = $rhInfo->{_SB_START}; | ||||
| 1071 | $rhInfo->{_BBD_SB_START}= [($iBlockNo+1)*$iBigBlkSize]; | ||||
| 1072 | for(1..$iNextCount) { | ||||
| 1073 | $iBlockNo = $rhInfo->{_BBD_INFO}->{$iBlockNo} // $iBlockNo+1; | ||||
| 1074 | last unless $iBlockNo < OLE::Storage_Lite::NormalBlockEnd(); | ||||
| 1075 | $rhInfo->{_BBD_SB_START}->[$_] = ($iBlockNo+1)*$iBigBlkSize; | ||||
| 1076 | } | ||||
| 1077 | $iBlockNo = $rhInfo->{_SBD_START}; | ||||
| 1078 | $rhInfo->{_BBD_SBD_START}= [($iBlockNo+1)*$iBigBlkSize]; | ||||
| 1079 | for(1..$iNextCount) { | ||||
| 1080 | $iBlockNo = $rhInfo->{_BBD_INFO}->{$iBlockNo} // $iBlockNo+1; | ||||
| 1081 | last unless $iBlockNo < OLE::Storage_Lite::NormalBlockEnd(); | ||||
| 1082 | $rhInfo->{_BBD_SBD_START}->[$_] = ($iBlockNo+1)*$iBigBlkSize; | ||||
| 1083 | } | ||||
| 1084 | my @aKeys= sort({$a<=>$b} keys(%{$rhInfo->{_BBD_INFO}})); | ||||
| 1085 | $rhInfo->{_BBD_INFO_SORTED}= \@aKeys; | ||||
| 1086 | return $rhInfo; | ||||
| 1087 | } | ||||
| 1088 | #------------------------------------------------------------------------------ | ||||
| 1089 | # _getInfoFromFile | ||||
| 1090 | #------------------------------------------------------------------------------ | ||||
| 1091 | sub _getInfoFromFile($$$$) { | ||||
| 1092 | my($FILE, $iPos, $iLen, $sFmt) =@_; | ||||
| 1093 | my($sWk); | ||||
| 1094 | return undef unless($FILE); | ||||
| 1095 | return undef if($FILE->seek($iPos, 0)==0); | ||||
| 1096 | return undef if($FILE->read($sWk, $iLen)!=$iLen); | ||||
| 1097 | return unpack($sFmt, $sWk); | ||||
| 1098 | } | ||||
| 1099 | #------------------------------------------------------------------------------ | ||||
| 1100 | # _getBbdInfo | ||||
| 1101 | #------------------------------------------------------------------------------ | ||||
| 1102 | sub _getBbdInfo($) { | ||||
| 1103 | my($rhInfo) =@_; | ||||
| 1104 | my @aBdList = (); | ||||
| 1105 | my $iBdbCnt = $rhInfo->{_BDB_COUNT}; | ||||
| 1106 | my $iBigBlkSize = $rhInfo->{_BIG_BLOCK_SIZE}; | ||||
| 1107 | my $iGetCnt; | ||||
| 1108 | my $sWk; | ||||
| 1109 | my $i1stCnt = int(($iBigBlkSize - 0x4C) / OLE::Storage_Lite::LongIntSize()); | ||||
| 1110 | my $iBdlCnt = int($iBigBlkSize / OLE::Storage_Lite::LongIntSize()) - 1; | ||||
| 1111 | |||||
| 1112 | #1. 1st BDlist | ||||
| 1113 | $rhInfo->{_FILEH_}->seek(0x4C, 0); | ||||
| 1114 | $iGetCnt = ($iBdbCnt < $i1stCnt)? $iBdbCnt: $i1stCnt; | ||||
| 1115 | $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()*$iGetCnt); | ||||
| 1116 | push @aBdList, unpack("V$iGetCnt", $sWk); | ||||
| 1117 | $iBdbCnt -= $iGetCnt; | ||||
| 1118 | #2. Extra BDList | ||||
| 1119 | my $iBlock = $rhInfo->{_EXTRA_BBD_START}; | ||||
| 1120 | while(($iBdbCnt> 0) && $iBlock < OLE::Storage_Lite::NormalBlockEnd()){ | ||||
| 1121 | $rhInfo->{_FILEH_}->seek(($iBlock+1)*$iBigBlkSize, 0); | ||||
| 1122 | $iGetCnt= ($iBdbCnt < $iBdlCnt)? $iBdbCnt: $iBdlCnt; | ||||
| 1123 | $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()*$iGetCnt); | ||||
| 1124 | push @aBdList, unpack("V$iGetCnt", $sWk); | ||||
| 1125 | $iBdbCnt -= $iGetCnt; | ||||
| 1126 | $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()); | ||||
| 1127 | $iBlock = unpack("V", $sWk); | ||||
| 1128 | } | ||||
| 1129 | #3.Get BDs | ||||
| 1130 | my @aWk; | ||||
| 1131 | my %hBd; | ||||
| 1132 | my $iBlkNo = 0; | ||||
| 1133 | my $iBdL; | ||||
| 1134 | my $i; | ||||
| 1135 | my $iBdCnt = int($iBigBlkSize / OLE::Storage_Lite::LongIntSize()); | ||||
| 1136 | foreach $iBdL (@aBdList) { | ||||
| 1137 | $rhInfo->{_FILEH_}->seek(($iBdL+1)*$iBigBlkSize, 0); | ||||
| 1138 | $rhInfo->{_FILEH_}->read($sWk, $iBigBlkSize); | ||||
| 1139 | @aWk = unpack("V$iBdCnt", $sWk); | ||||
| 1140 | for($i=0;$i<$iBdCnt;$i++, $iBlkNo++) { | ||||
| 1141 | if($aWk[$i] != ($iBlkNo+1)){ | ||||
| 1142 | $hBd{$iBlkNo} = $aWk[$i]; | ||||
| 1143 | } | ||||
| 1144 | } | ||||
| 1145 | } | ||||
| 1146 | return \%hBd; | ||||
| 1147 | } | ||||
| 1148 | #------------------------------------------------------------------------------ | ||||
| 1149 | # getNthPps (OLE::Storage_Lite) | ||||
| 1150 | #------------------------------------------------------------------------------ | ||||
| 1151 | sub _getNthPps($$$){ | ||||
| 1152 | my($iPos, $rhInfo, $bData) = @_; | ||||
| 1153 | my($iPpsBlock, $iPpsPos); | ||||
| 1154 | my $sWk; | ||||
| 1155 | my $iBlock; | ||||
| 1156 | |||||
| 1157 | my $iBaseCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::PpsSize(); | ||||
| 1158 | $iPpsBlock = int($iPos / $iBaseCnt); | ||||
| 1159 | $iPpsPos = $iPos % $iBaseCnt; | ||||
| 1160 | |||||
| 1161 | $iBlock = $rhInfo->{_BBD_ROOT_START}->[$iPpsBlock] // | ||||
| 1162 | _getNthBlockNo($rhInfo->{_ROOT_START}, $iPpsBlock, $rhInfo); | ||||
| 1163 | return undef unless(defined($iBlock)); | ||||
| 1164 | |||||
| 1165 | $rhInfo->{_FILEH_}->seek(($iBlock+1)*$rhInfo->{_BIG_BLOCK_SIZE}+ | ||||
| 1166 | (OLE::Storage_Lite::PpsSize()*$iPpsPos), 0); | ||||
| 1167 | $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::PpsSize()); | ||||
| 1168 | return undef unless($sWk); | ||||
| 1169 | my ($iNmSize, $iType, undef, $lPpsPrev, $lPpsNext, $lDirPps) = | ||||
| 1170 | unpack("vCCVVV", substr($sWk, 0x40, 2+2+3*OLE::Storage_Lite::LongIntSize())); | ||||
| 1171 | $iNmSize = ($iNmSize > 2)? $iNmSize - 2 : $iNmSize; | ||||
| 1172 | my $sNm= substr($sWk, 0, $iNmSize); | ||||
| 1173 | my @raTime1st = | ||||
| 1174 | (($iType == OLE::Storage_Lite::PpsType_Root()) or ($iType == OLE::Storage_Lite::PpsType_Dir()))? | ||||
| 1175 | OLEDate2Local(substr($sWk, 0x64, 8)) : undef , | ||||
| 1176 | my @raTime2nd = | ||||
| 1177 | (($iType == OLE::Storage_Lite::PpsType_Root()) or ($iType == OLE::Storage_Lite::PpsType_Dir()))? | ||||
| 1178 | OLEDate2Local(substr($sWk, 0x6C, 8)) : undef, | ||||
| 1179 | my($iStart, $iSize) = unpack("VV", substr($sWk, 0x74, 8)); | ||||
| 1180 | if($bData) { | ||||
| 1181 | my $sData = _getData($iType, $iStart, $iSize, $rhInfo); | ||||
| 1182 | return OLE::Storage_Lite::PPS->new( | ||||
| 1183 | $iPos, $sNm, $iType, $lPpsPrev, $lPpsNext, $lDirPps, | ||||
| 1184 | \@raTime1st, \@raTime2nd, $iStart, $iSize, $sData, undef); | ||||
| 1185 | } | ||||
| 1186 | else { | ||||
| 1187 | return OLE::Storage_Lite::PPS->new( | ||||
| 1188 | $iPos, $sNm, $iType, $lPpsPrev, $lPpsNext, $lDirPps, | ||||
| 1189 | \@raTime1st, \@raTime2nd, $iStart, $iSize, undef, undef); | ||||
| 1190 | } | ||||
| 1191 | } | ||||
| 1192 | #------------------------------------------------------------------------------ | ||||
| 1193 | # _getNthBlockNo (OLE::Storage_Lite) | ||||
| 1194 | #------------------------------------------------------------------------------ | ||||
| 1195 | sub _getNthBlockNo($$$){ | ||||
| 1196 | my($iBlockNo, $iNth, $rhInfo) = @_; | ||||
| 1197 | my $rhBbdInfo = $rhInfo->{_BBD_INFO}; | ||||
| 1198 | for(1..$iNth) { | ||||
| 1199 | $iBlockNo = $rhBbdInfo->{$iBlockNo} // $iBlockNo+1; | ||||
| 1200 | return undef unless $iBlockNo < OLE::Storage_Lite::NormalBlockEnd(); | ||||
| 1201 | } | ||||
| 1202 | return $iBlockNo; | ||||
| 1203 | } | ||||
| 1204 | #------------------------------------------------------------------------------ | ||||
| 1205 | # _getData (OLE::Storage_Lite) | ||||
| 1206 | #------------------------------------------------------------------------------ | ||||
| 1207 | sub _getData($$$$) | ||||
| 1208 | { | ||||
| 1209 | my($iType, $iBlock, $iSize, $rhInfo) = @_; | ||||
| 1210 | if ($iType == OLE::Storage_Lite::PpsType_File()) { | ||||
| 1211 | if($iSize < OLE::Storage_Lite::DataSizeSmall()) { | ||||
| 1212 | return _getSmallData($iBlock, $iSize, $rhInfo); | ||||
| 1213 | } | ||||
| 1214 | else { | ||||
| 1215 | return _getBigData($iBlock, $iSize, $rhInfo); | ||||
| 1216 | } | ||||
| 1217 | } | ||||
| 1218 | elsif($iType == OLE::Storage_Lite::PpsType_Root()) { #Root | ||||
| 1219 | return _getBigData($iBlock, $iSize, $rhInfo); | ||||
| 1220 | } | ||||
| 1221 | elsif($iType == OLE::Storage_Lite::PpsType_Dir()) { # Directory | ||||
| 1222 | return undef; | ||||
| 1223 | } | ||||
| 1224 | } | ||||
| 1225 | #------------------------------------------------------------------------------ | ||||
| 1226 | # _getBigData (OLE::Storage_Lite) | ||||
| 1227 | #------------------------------------------------------------------------------ | ||||
| 1228 | sub _getBigData($$$) | ||||
| 1229 | { | ||||
| 1230 | my($iBlock, $iSize, $rhInfo) = @_; | ||||
| 1231 | my($iRest, $sWk, $sRes); | ||||
| 1232 | |||||
| 1233 | return '' unless($iBlock < OLE::Storage_Lite::NormalBlockEnd()); | ||||
| 1234 | $iRest = $iSize; | ||||
| 1235 | my($i, $iGetSize, $iNext); | ||||
| 1236 | $sRes = ''; | ||||
| 1237 | my $aKeys= $rhInfo->{_BBD_INFO_SORTED}; | ||||
| 1238 | |||||
| 1239 | while ($iRest > 0) { | ||||
| 1240 | # lower_bound binary search | ||||
| 1241 | my $iCount = @$aKeys; | ||||
| 1242 | my $iFirst = 0; | ||||
| 1243 | while ($iCount > 0) { | ||||
| 1244 | my $iStep = $iCount >> 1; | ||||
| 1245 | my $iIndex = $iFirst + $iStep; | ||||
| 1246 | if ($$aKeys[$iIndex] < $iBlock) { | ||||
| 1247 | $iFirst = ++$iIndex; | ||||
| 1248 | $iCount -= $iStep + 1; | ||||
| 1249 | } else { | ||||
| 1250 | $iCount = $iStep; | ||||
| 1251 | } | ||||
| 1252 | } | ||||
| 1253 | my $iNKey = $$aKeys[$iFirst]; | ||||
| 1254 | $i = $iNKey - $iBlock; | ||||
| 1255 | croak "Invalid block read" if ($i < 0); | ||||
| 1256 | $iNext = $rhInfo->{_BBD_INFO}{$iNKey}; | ||||
| 1257 | $rhInfo->{_FILEH_}->seek(($iBlock+1)*$rhInfo->{_BIG_BLOCK_SIZE}, 0); | ||||
| 1258 | my $iGetSize = ($rhInfo->{_BIG_BLOCK_SIZE} * ($i+1)); | ||||
| 1259 | $iGetSize = $iRest if($iRest < $iGetSize); | ||||
| 1260 | $rhInfo->{_FILEH_}->read( $sWk, $iGetSize); | ||||
| 1261 | $sRes .= $sWk; | ||||
| 1262 | $iRest -= $iGetSize; | ||||
| 1263 | $iBlock= $iNext; | ||||
| 1264 | } | ||||
| 1265 | return $sRes; | ||||
| 1266 | } | ||||
| 1267 | #------------------------------------------------------------------------------ | ||||
| 1268 | # _getSmallData (OLE::Storage_Lite) | ||||
| 1269 | #------------------------------------------------------------------------------ | ||||
| 1270 | sub _getSmallData($$$) | ||||
| 1271 | { | ||||
| 1272 | my($iSmBlock, $iSize, $rhInfo) = @_; | ||||
| 1273 | my($sRes, $sWk); | ||||
| 1274 | my($iBigBlkSize, $iSmallBlkSize, $rhFd) = | ||||
| 1275 | @$rhInfo{qw(_BIG_BLOCK_SIZE _SMALL_BLOCK_SIZE _FILEH_)}; | ||||
| 1276 | |||||
| 1277 | $sRes = ''; | ||||
| 1278 | while ($iSize > 0) { | ||||
| 1279 | my $iBaseCnt = $iBigBlkSize / $iSmallBlkSize; | ||||
| 1280 | my $iNth = int($iSmBlock/$iBaseCnt); | ||||
| 1281 | my $iPos = $iSmBlock % $iBaseCnt; | ||||
| 1282 | my $iBlk = $rhInfo->{_BBD_SB_START}->[$iNth] // | ||||
| 1283 | ((_getNthBlockNo($rhInfo->{_SB_START}, $iNth, $rhInfo)+1)*$iBigBlkSize); | ||||
| 1284 | |||||
| 1285 | $rhFd->seek($iBlk+($iPos*$iSmallBlkSize), 0); | ||||
| 1286 | if ($iSize > $iSmallBlkSize) { | ||||
| 1287 | $rhFd->read($sWk, $iSmallBlkSize); | ||||
| 1288 | $sRes .= $sWk; | ||||
| 1289 | $iSize -= $iSmallBlkSize; | ||||
| 1290 | } else { | ||||
| 1291 | $rhFd->read($sWk, $iSize); | ||||
| 1292 | $sRes .= $sWk; | ||||
| 1293 | last; | ||||
| 1294 | } | ||||
| 1295 | # get next small block | ||||
| 1296 | $iBaseCnt = $iBigBlkSize / OLE::Storage_Lite::LongIntSize(); | ||||
| 1297 | $iNth = int($iSmBlock/$iBaseCnt); | ||||
| 1298 | $iPos = $iSmBlock % $iBaseCnt; | ||||
| 1299 | $iBlk = $rhInfo->{_BBD_SBD_START}->[$iNth] // | ||||
| 1300 | ((_getNthBlockNo($rhInfo->{_SBD_START}, $iNth, $rhInfo)+1)*$iBigBlkSize); | ||||
| 1301 | $rhFd->seek($iBlk+($iPos*OLE::Storage_Lite::LongIntSize()), 0); | ||||
| 1302 | $rhFd->read($sWk, OLE::Storage_Lite::LongIntSize()); | ||||
| 1303 | $iSmBlock = unpack("V", $sWk); | ||||
| 1304 | } | ||||
| 1305 | return $sRes; | ||||
| 1306 | } | ||||
| 1307 | #------------------------------------------------------------------------------ | ||||
| 1308 | # Asc2Ucs: OLE::Storage_Lite | ||||
| 1309 | #------------------------------------------------------------------------------ | ||||
| 1310 | sub Asc2Ucs($) | ||||
| 1311 | { | ||||
| 1312 | return join("\x00", split //, $_[0]) . "\x00"; | ||||
| 1313 | } | ||||
| 1314 | #------------------------------------------------------------------------------ | ||||
| 1315 | # Ucs2Asc: OLE::Storage_Lite | ||||
| 1316 | #------------------------------------------------------------------------------ | ||||
| 1317 | sub Ucs2Asc($) | ||||
| 1318 | { | ||||
| 1319 | return pack('c*', unpack('v*', $_[0])); | ||||
| 1320 | } | ||||
| 1321 | |||||
| 1322 | #------------------------------------------------------------------------------ | ||||
| 1323 | # OLEDate2Local() | ||||
| 1324 | # | ||||
| 1325 | # Convert from a Window FILETIME structure to a localtime array. FILETIME is | ||||
| 1326 | # a 64-bit value representing the number of 100-nanosecond intervals since | ||||
| 1327 | # January 1 1601. | ||||
| 1328 | # | ||||
| 1329 | # We first convert the FILETIME to seconds and then subtract the difference | ||||
| 1330 | # between the 1601 epoch and the 1970 Unix epoch. | ||||
| 1331 | # | ||||
| 1332 | sub OLEDate2Local { | ||||
| 1333 | |||||
| 1334 | my $oletime = shift; | ||||
| 1335 | |||||
| 1336 | # Unpack the FILETIME into high and low longs. | ||||
| 1337 | my ( $lo, $hi ) = unpack 'V2', $oletime; | ||||
| 1338 | |||||
| 1339 | # Convert the longs to a double. | ||||
| 1340 | my $nanoseconds = $hi * 2**32 + $lo; | ||||
| 1341 | |||||
| 1342 | # Convert the 100 nanosecond units into seconds. | ||||
| 1343 | my $time = $nanoseconds / 1e7; | ||||
| 1344 | |||||
| 1345 | # Subtract the number of seconds between the 1601 and 1970 epochs. | ||||
| 1346 | $time -= 11644473600; | ||||
| 1347 | |||||
| 1348 | # Convert to a localtime (actually gmtime) structure. | ||||
| 1349 | my @localtime = gmtime($time); | ||||
| 1350 | |||||
| 1351 | return @localtime; | ||||
| 1352 | } | ||||
| 1353 | |||||
| 1354 | #------------------------------------------------------------------------------ | ||||
| 1355 | # LocalDate2OLE() | ||||
| 1356 | # | ||||
| 1357 | # Convert from a localtime array to a Window FILETIME structure. FILETIME is | ||||
| 1358 | # a 64-bit value representing the number of 100-nanosecond intervals since | ||||
| 1359 | # January 1 1601. | ||||
| 1360 | # | ||||
| 1361 | # We first convert the localtime (actually gmtime) to seconds and then add the | ||||
| 1362 | # difference between the 1601 epoch and the 1970 Unix epoch. We convert that to | ||||
| 1363 | # 100 nanosecond units, divide it into high and low longs and return it as a | ||||
| 1364 | # packed 64bit structure. | ||||
| 1365 | # | ||||
| 1366 | sub LocalDate2OLE { | ||||
| 1367 | |||||
| 1368 | my $localtime = shift; | ||||
| 1369 | |||||
| 1370 | return "\x00" x 8 unless $localtime; | ||||
| 1371 | |||||
| 1372 | # Convert from localtime (actually gmtime) to seconds. | ||||
| 1373 | my @localtimecopy = @{$localtime}; | ||||
| 1374 | $localtimecopy[5] += 1900 unless $localtimecopy[5] > 99; | ||||
| 1375 | my $time = timegm( @localtimecopy ); | ||||
| 1376 | |||||
| 1377 | # Add the number of seconds between the 1601 and 1970 epochs. | ||||
| 1378 | $time += 11644473600; | ||||
| 1379 | |||||
| 1380 | # The FILETIME seconds are in units of 100 nanoseconds. | ||||
| 1381 | my $nanoseconds = $time * 1E7; | ||||
| 1382 | |||||
| 1383 | 2 | 62µs | 2 | 1.88ms | # spent 945µs (6+939) within OLE::Storage_Lite::BEGIN@1383 which was called:
# once (6µs+939µs) by Spreadsheet::ParseExcel::BEGIN@21 at line 1383 # spent 945µs making 1 call to OLE::Storage_Lite::BEGIN@1383
# spent 939µs making 1 call to POSIX::import |
| 1384 | |||||
| 1385 | # Pack the total nanoseconds into 64 bits... | ||||
| 1386 | my $hi = int( $nanoseconds / 2**32 ); | ||||
| 1387 | my $lo = fmod($nanoseconds, 2**32); | ||||
| 1388 | |||||
| 1389 | my $oletime = pack "VV", $lo, $hi; | ||||
| 1390 | |||||
| 1391 | return $oletime; | ||||
| 1392 | } | ||||
| 1393 | |||||
| 1394 | 1 | 4µs | 1; | ||
| 1395 | __END__ |