← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/OLE/Storage_Lite.pm
StatementsExecuted 54 statements in 4.25ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11111µs12µsOLE::Storage_Lite::PPS::::BEGIN@12 OLE::Storage_Lite::PPS::BEGIN@12
1117µs24µsOLE::Storage_Lite::::BEGIN@831 OLE::Storage_Lite::BEGIN@831
1117µs76µsOLE::Storage_Lite::::BEGIN@843 OLE::Storage_Lite::BEGIN@843
1117µs74µsOLE::Storage_Lite::PPS::Root::::BEGIN@169OLE::Storage_Lite::PPS::Root::BEGIN@169
1116µs945µsOLE::Storage_Lite::::BEGIN@1383 OLE::Storage_Lite::BEGIN@1383
1116µs7µsOLE::Storage_Lite::PPS::File::::BEGIN@713OLE::Storage_Lite::PPS::File::BEGIN@713
1115µs7µsOLE::Storage_Lite::PPS::Dir::::BEGIN@801 OLE::Storage_Lite::PPS::Dir::BEGIN@801
1115µs7µsOLE::Storage_Lite::PPS::Root::::BEGIN@168OLE::Storage_Lite::PPS::Root::BEGIN@168
1115µs152µsOLE::Storage_Lite::PPS::Root::::BEGIN@171OLE::Storage_Lite::PPS::Root::BEGIN@171
1114µs6µsOLE::Storage_Lite::::BEGIN@828 OLE::Storage_Lite::BEGIN@828
1114µs22µsOLE::Storage_Lite::::BEGIN@832 OLE::Storage_Lite::BEGIN@832
1114µs66µsOLE::Storage_Lite::::BEGIN@830 OLE::Storage_Lite::BEGIN@830
1114µs11µsOLE::Storage_Lite::PPS::Root::::BEGIN@170OLE::Storage_Lite::PPS::Root::BEGIN@170
1114µs21µsOLE::Storage_Lite::PPS::File::::BEGIN@714OLE::Storage_Lite::PPS::File::BEGIN@714
1114µs24µsOLE::Storage_Lite::PPS::::BEGIN@13 OLE::Storage_Lite::PPS::BEGIN@13
1114µs19µsOLE::Storage_Lite::PPS::Root::::BEGIN@172OLE::Storage_Lite::PPS::Root::BEGIN@172
1113µs27µsOLE::Storage_Lite::::BEGIN@829 OLE::Storage_Lite::BEGIN@829
1113µs19µsOLE::Storage_Lite::PPS::Dir::::BEGIN@802 OLE::Storage_Lite::PPS::Dir::BEGIN@802
1113µs21µsOLE::Storage_Lite::::BEGIN@834 OLE::Storage_Lite::BEGIN@834
0000s0sOLE::Storage_Lite::::Asc2Ucs OLE::Storage_Lite::Asc2Ucs
0000s0sOLE::Storage_Lite::::LocalDate2OLE OLE::Storage_Lite::LocalDate2OLE
0000s0sOLE::Storage_Lite::::OLEDate2Local OLE::Storage_Lite::OLEDate2Local
0000s0sOLE::Storage_Lite::PPS::Dir::::new OLE::Storage_Lite::PPS::Dir::new
0000s0sOLE::Storage_Lite::PPS::File::::appendOLE::Storage_Lite::PPS::File::append
0000s0sOLE::Storage_Lite::PPS::File::::newOLE::Storage_Lite::PPS::File::new
0000s0sOLE::Storage_Lite::PPS::File::::newFileOLE::Storage_Lite::PPS::File::newFile
0000s0sOLE::Storage_Lite::PPS::Root::::_adjust2OLE::Storage_Lite::PPS::Root::_adjust2
0000s0sOLE::Storage_Lite::PPS::Root::::_calcSizeOLE::Storage_Lite::PPS::Root::_calcSize
0000s0sOLE::Storage_Lite::PPS::Root::::_saveBbdOLE::Storage_Lite::PPS::Root::_saveBbd
0000s0sOLE::Storage_Lite::PPS::Root::::_saveBigDataOLE::Storage_Lite::PPS::Root::_saveBigData
0000s0sOLE::Storage_Lite::PPS::Root::::_saveHeaderOLE::Storage_Lite::PPS::Root::_saveHeader
0000s0sOLE::Storage_Lite::PPS::Root::::_savePpsOLE::Storage_Lite::PPS::Root::_savePps
0000s0sOLE::Storage_Lite::PPS::Root::::_savePpsSetPntOLE::Storage_Lite::PPS::Root::_savePpsSetPnt
0000s0sOLE::Storage_Lite::PPS::Root::::_savePpsSetPnt1OLE::Storage_Lite::PPS::Root::_savePpsSetPnt1
0000s0sOLE::Storage_Lite::PPS::Root::::_savePpsSetPnt2OLE::Storage_Lite::PPS::Root::_savePpsSetPnt2
0000s0sOLE::Storage_Lite::PPS::Root::::_savePpsSetPnt2sOLE::Storage_Lite::PPS::Root::_savePpsSetPnt2s
0000s0sOLE::Storage_Lite::PPS::Root::::newOLE::Storage_Lite::PPS::Root::new
0000s0sOLE::Storage_Lite::PPS::Root::::saveOLE::Storage_Lite::PPS::Root::save
0000s0sOLE::Storage_Lite::PPS::::_DataLen OLE::Storage_Lite::PPS::_DataLen
0000s0sOLE::Storage_Lite::PPS::::_makeSmallData OLE::Storage_Lite::PPS::_makeSmallData
0000s0sOLE::Storage_Lite::PPS::::_new OLE::Storage_Lite::PPS::_new
0000s0sOLE::Storage_Lite::PPS::::_savePpsWk OLE::Storage_Lite::PPS::_savePpsWk
0000s0sOLE::Storage_Lite::PPS::::new OLE::Storage_Lite::PPS::new
0000s0sOLE::Storage_Lite::::Ucs2Asc OLE::Storage_Lite::Ucs2Asc
0000s0sOLE::Storage_Lite::::__ANON__[:988] OLE::Storage_Lite::__ANON__[:988]
0000s0sOLE::Storage_Lite::::__ANON__[:989] OLE::Storage_Lite::__ANON__[:989]
0000s0sOLE::Storage_Lite::::_getBbdInfo OLE::Storage_Lite::_getBbdInfo
0000s0sOLE::Storage_Lite::::_getBigData OLE::Storage_Lite::_getBigData
0000s0sOLE::Storage_Lite::::_getData OLE::Storage_Lite::_getData
0000s0sOLE::Storage_Lite::::_getHeaderInfo OLE::Storage_Lite::_getHeaderInfo
0000s0sOLE::Storage_Lite::::_getInfoFromFile OLE::Storage_Lite::_getInfoFromFile
0000s0sOLE::Storage_Lite::::_getNthBlockNo OLE::Storage_Lite::_getNthBlockNo
0000s0sOLE::Storage_Lite::::_getNthPps OLE::Storage_Lite::_getNthPps
0000s0sOLE::Storage_Lite::::_getPpsSearch OLE::Storage_Lite::_getPpsSearch
0000s0sOLE::Storage_Lite::::_getPpsTree OLE::Storage_Lite::_getPpsTree
0000s0sOLE::Storage_Lite::::_getSmallData OLE::Storage_Lite::_getSmallData
0000s0sOLE::Storage_Lite::::_initParse OLE::Storage_Lite::_initParse
0000s0sOLE::Storage_Lite::::getNthPps OLE::Storage_Lite::getNthPps
0000s0sOLE::Storage_Lite::::getPpsSearch OLE::Storage_Lite::getPpsSearch
0000s0sOLE::Storage_Lite::::getPpsTree OLE::Storage_Lite::getPpsTree
0000s0sOLE::Storage_Lite::::new OLE::Storage_Lite::new
Call graph for these subroutines as a Graphviz dot language file.
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#==============================================================================
10package OLE::Storage_Lite::PPS;
111500nsrequire Exporter;
12222µs214µ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
use strict;
# spent 12µs making 1 call to OLE::Storage_Lite::PPS::BEGIN@12 # spent 1µs making 1 call to strict::import
132544µs245µ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
use vars qw($VERSION @ISA);
# spent 24µs making 1 call to OLE::Storage_Lite::PPS::BEGIN@13 # spent 21µs making 1 call to vars::import
1415µs@ISA = qw(Exporter);
151200ns$VERSION = '0.22';
16
17#------------------------------------------------------------------------------
18# new (OLE::Storage_Lite::PPS)
19#------------------------------------------------------------------------------
20sub 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#------------------------------------------------------------------------------
48sub _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#------------------------------------------------------------------------------
73sub _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#------------------------------------------------------------------------------
82sub _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 }
9911µ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());
12311µ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#------------------------------------------------------------------------------
131sub _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
1421900ns , 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
1561600ns , 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#==============================================================================
166package OLE::Storage_Lite::PPS::Root;
1671200nsrequire Exporter;
168231µs29µ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
use strict;
# spent 7µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@168 # spent 2µs making 1 call to strict::import
169218µs2141µ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
use IO::File;
# spent 74µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@169 # spent 67µs making 1 call to Exporter::import
170211µs217µ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
use IO::Handle;
# spent 11µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@170 # spent 7µs making 1 call to Exporter::import
171218µs2299µ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
use Fcntl;
# spent 152µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@171 # spent 147µs making 1 call to Exporter::import
17221.56ms235µ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
use vars qw($VERSION @ISA);
# spent 19µs making 1 call to OLE::Storage_Lite::PPS::Root::BEGIN@172 # spent 16µs making 1 call to vars::import
17314µs@ISA = qw(OLE::Storage_Lite::PPS Exporter);
1741200ns$VERSION = '0.22';
175sub _savePpsSetPnt($$$);
176sub _savePpsSetPnt2($$$);
177#------------------------------------------------------------------------------
178# new (OLE::Storage_Lite::PPS::Root)
179#------------------------------------------------------------------------------
180sub 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#------------------------------------------------------------------------------
200sub 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#------------------------------------------------------------------------------
289sub _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#------------------------------------------------------------------------------
324sub _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#------------------------------------------------------------------------------
333sub _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)
36911µs , pack("v", 0x03)
# spent 1µs making 1 call to CORE::pack
3701300ns , pack("v", -2)
# spent 300ns making 1 call to CORE::pack
3711200ns , pack("v", 9)
# spent 200ns making 1 call to CORE::pack
3721100ns , pack("v", 6)
# spent 100ns making 1 call to CORE::pack
3731100ns , pack("v", 0)
# spent 100ns making 1 call to CORE::pack
3741100ns , "\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)
3781300ns , pack("V", 0x1000)
# spent 300ns making 1 call to CORE::pack
37912µ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} (
3851300ns pack("V", -2), #Extra BDList Start
# spent 300ns making 1 call to CORE::pack
3861200ns 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 }
4001400ns 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#------------------------------------------------------------------------------
405sub _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#------------------------------------------------------------------------------
448sub _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#------------------------------------------------------------------------------
468sub _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#------------------------------------------------------------------------------
510sub _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#------------------------------------------------------------------------------
549sub _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#------------------------------------------------------------------------------
588sub _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#------------------------------------------------------------------------------
627sub _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 }
66311µ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 }
6691700ns 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 }
6751300ns 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++) {
6781200ns 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++) {
6821200ns print {$FILE} (pack("V", 0xFFFFFFFC));
# spent 200ns making 1 call to CORE::pack
683 }
684#1.6 Adjust for Block
6851200ns 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 }
6991500ns 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));
7011200ns 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#==============================================================================
711package OLE::Storage_Lite::PPS::File;
7121100nsrequire Exporter;
713220µs28µ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
use strict;
# spent 7µs making 1 call to OLE::Storage_Lite::PPS::File::BEGIN@713 # spent 2µs making 1 call to strict::import
7142197µs238µ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
use vars qw($VERSION @ISA);
# spent 21µs making 1 call to OLE::Storage_Lite::PPS::File::BEGIN@714 # spent 17µs making 1 call to vars::import
71513µs@ISA = qw(OLE::Storage_Lite::PPS Exporter);
7161100ns$VERSION = '0.22';
717#------------------------------------------------------------------------------
718# new (OLE::Storage_Lite::PPS::File)
719#------------------------------------------------------------------------------
720sub 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#------------------------------------------------------------------------------
740sub 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#------------------------------------------------------------------------------
783sub 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#------------------------------------------------------------------------------
799package OLE::Storage_Lite::PPS::Dir;
8001100nsrequire Exporter;
801222µs28µ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
use strict;
# spent 7µs making 1 call to OLE::Storage_Lite::PPS::Dir::BEGIN@801 # spent 1µs making 1 call to strict::import
802258µs235µ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
use vars qw($VERSION @ISA);
# spent 19µs making 1 call to OLE::Storage_Lite::PPS::Dir::BEGIN@802 # spent 16µs making 1 call to vars::import
80313µs@ISA = qw(OLE::Storage_Lite::PPS Exporter);
8041100ns$VERSION = '0.22';
805sub 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#==============================================================================
825package OLE::Storage_Lite;
8261100nsrequire Exporter;
827
828214µs27µ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
use strict;
# spent 6µs making 1 call to OLE::Storage_Lite::BEGIN@828 # spent 1µs making 1 call to strict::import
829214µs250µ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
use Carp;
# spent 27µs making 1 call to OLE::Storage_Lite::BEGIN@829 # spent 24µs making 1 call to Exporter::import
830215µs2127µ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
use IO::File;
# spent 66µs making 1 call to OLE::Storage_Lite::BEGIN@830 # spent 62µs making 1 call to Exporter::import
831216µs231µ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
use List::Util qw(first);
# spent 24µs making 1 call to OLE::Storage_Lite::BEGIN@831 # spent 6µs making 1 call to List::Util::import
832215µs240µ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
use Time::Local 'timegm';
# spent 22µs making 1 call to OLE::Storage_Lite::BEGIN@832 # spent 18µs making 1 call to Exporter::import
833
834240µs239µ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
use vars qw($VERSION @ISA @EXPORT);
# spent 21µs making 1 call to OLE::Storage_Lite::BEGIN@834 # spent 18µs making 1 call to vars::import
83512µs@ISA = qw(Exporter);
8361100ns$VERSION = '0.22';
837sub _getPpsSearch($$$$$;$);
838sub _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
use constant {
84416µs169µ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,
85311.55ms176µs};
# spent 76µs making 1 call to OLE::Storage_Lite::BEGIN@843
854#------------------------------------------------------------------------------
855# new OLE::Storage_Lite
856#------------------------------------------------------------------------------
857sub 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#------------------------------------------------------------------------------
868sub 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#------------------------------------------------------------------------------
882sub 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#------------------------------------------------------------------------------
896sub 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#------------------------------------------------------------------------------
910sub _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#------------------------------------------------------------------------------
941sub _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#------------------------------------------------------------------------------
974sub _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#===================================================================
1008sub _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#------------------------------------------------------------------------------
1091sub _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#------------------------------------------------------------------------------
1102sub _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#------------------------------------------------------------------------------
1151sub _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#------------------------------------------------------------------------------
1195sub _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#------------------------------------------------------------------------------
1207sub _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#------------------------------------------------------------------------------
1228sub _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#------------------------------------------------------------------------------
1270sub _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#------------------------------------------------------------------------------
1310sub Asc2Ucs($)
1311{
1312 return join("\x00", split //, $_[0]) . "\x00";
1313}
1314#------------------------------------------------------------------------------
1315# Ucs2Asc: OLE::Storage_Lite
1316#------------------------------------------------------------------------------
1317sub 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#
1332sub 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#
1366sub 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
1383262µs21.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
use POSIX 'fmod';
# 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
139414µs1;
1395__END__