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 | BEGIN@12 | OLE::Storage_Lite::PPS::
1 | 1 | 1 | 7µs | 24µs | BEGIN@831 | OLE::Storage_Lite::
1 | 1 | 1 | 7µs | 76µs | BEGIN@843 | OLE::Storage_Lite::
1 | 1 | 1 | 7µs | 74µs | BEGIN@169 | OLE::Storage_Lite::PPS::Root::
1 | 1 | 1 | 6µs | 945µs | BEGIN@1383 | OLE::Storage_Lite::
1 | 1 | 1 | 6µs | 7µs | BEGIN@713 | OLE::Storage_Lite::PPS::File::
1 | 1 | 1 | 5µs | 7µs | BEGIN@801 | OLE::Storage_Lite::PPS::Dir::
1 | 1 | 1 | 5µs | 7µs | BEGIN@168 | OLE::Storage_Lite::PPS::Root::
1 | 1 | 1 | 5µs | 152µs | BEGIN@171 | OLE::Storage_Lite::PPS::Root::
1 | 1 | 1 | 4µs | 6µs | BEGIN@828 | OLE::Storage_Lite::
1 | 1 | 1 | 4µs | 22µs | BEGIN@832 | OLE::Storage_Lite::
1 | 1 | 1 | 4µs | 66µs | BEGIN@830 | OLE::Storage_Lite::
1 | 1 | 1 | 4µs | 11µs | BEGIN@170 | OLE::Storage_Lite::PPS::Root::
1 | 1 | 1 | 4µs | 21µs | BEGIN@714 | OLE::Storage_Lite::PPS::File::
1 | 1 | 1 | 4µs | 24µs | BEGIN@13 | OLE::Storage_Lite::PPS::
1 | 1 | 1 | 4µs | 19µs | BEGIN@172 | OLE::Storage_Lite::PPS::Root::
1 | 1 | 1 | 3µs | 27µs | BEGIN@829 | OLE::Storage_Lite::
1 | 1 | 1 | 3µs | 19µs | BEGIN@802 | OLE::Storage_Lite::PPS::Dir::
1 | 1 | 1 | 3µs | 21µs | BEGIN@834 | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | Asc2Ucs | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | LocalDate2OLE | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | OLEDate2Local | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | new | OLE::Storage_Lite::PPS::Dir::
0 | 0 | 0 | 0s | 0s | append | OLE::Storage_Lite::PPS::File::
0 | 0 | 0 | 0s | 0s | new | OLE::Storage_Lite::PPS::File::
0 | 0 | 0 | 0s | 0s | newFile | OLE::Storage_Lite::PPS::File::
0 | 0 | 0 | 0s | 0s | _adjust2 | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _calcSize | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _saveBbd | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _saveBigData | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _saveHeader | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _savePps | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _savePpsSetPnt | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _savePpsSetPnt1 | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _savePpsSetPnt2 | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _savePpsSetPnt2s | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | new | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | save | OLE::Storage_Lite::PPS::Root::
0 | 0 | 0 | 0s | 0s | _DataLen | OLE::Storage_Lite::PPS::
0 | 0 | 0 | 0s | 0s | _makeSmallData | OLE::Storage_Lite::PPS::
0 | 0 | 0 | 0s | 0s | _new | OLE::Storage_Lite::PPS::
0 | 0 | 0 | 0s | 0s | _savePpsWk | OLE::Storage_Lite::PPS::
0 | 0 | 0 | 0s | 0s | new | OLE::Storage_Lite::PPS::
0 | 0 | 0 | 0s | 0s | Ucs2Asc | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | __ANON__[:988] | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | __ANON__[:989] | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getBbdInfo | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getBigData | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getData | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getHeaderInfo | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getInfoFromFile | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getNthBlockNo | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getNthPps | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getPpsSearch | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getPpsTree | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _getSmallData | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | _initParse | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | getNthPps | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | getPpsSearch | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | getPpsTree | OLE::Storage_Lite::
0 | 0 | 0 | 0s | 0s | new | OLE::Storage_Lite::
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__ |