File Coverage

blib/lib/Spreadsheet/ParseExcel.pm
Criterion Covered Total %
statement 896 1060 84.5
branch 295 462 63.8
condition 28 57 49.1
subroutine 98 107 91.5
pod 4 15 26.6
total 1321 1701 77.6


line stmt bran cond sub pod time code
1             package Spreadsheet::ParseExcel;
2              
3             ##############################################################################
4             #
5             # Spreadsheet::ParseExcel - Extract information from an Excel file.
6             #
7             # Copyright (c) 2014 Douglas Wilson
8             # Copyright (c) 2009-2013 John McNamara
9             # Copyright (c) 2006-2008 Gabor Szabo
10             # Copyright (c) 2000-2008 Takanori Kawai
11             #
12             # perltidy with standard settings.
13             #
14             # Documentation after __END__
15             #
16              
17 21     21   247255 use strict;
  21         84  
  21         869  
18 21     21   111 use warnings;
  21         36  
  21         721  
19 21     21   627 use 5.008;
  21         81  
  21         765  
20              
21 21     21   30119 use OLE::Storage_Lite;
  21         862240  
  21         1073  
22 21     21   210 use File::Basename qw(fileparse);
  21         39  
  21         1725  
23 21     21   121 use IO::File;
  21         37  
  21         3509  
24 21     21   125 use Config;
  21         46  
  21         814  
25              
26 21     21   27819 use Crypt::RC4;
  21         16223  
  21         1155  
27 21     21   23080 use Digest::Perl::MD5;
  21         157282  
  21         2019  
28              
29             our $VERSION = '0.65';
30              
31 21     21   15717 use Spreadsheet::ParseExcel::Workbook;
  21         61  
  21         682  
32 21     21   23586 use Spreadsheet::ParseExcel::Worksheet;
  21         61  
  21         575  
33 21     21   12967 use Spreadsheet::ParseExcel::Font;
  21         50  
  21         558  
34 21     21   13767 use Spreadsheet::ParseExcel::Format;
  21         50  
  21         516  
35 21     21   13459 use Spreadsheet::ParseExcel::Cell;
  21         53  
  21         537  
36 21     21   13370 use Spreadsheet::ParseExcel::FmtDefault;
  21         69  
  21         2418  
37              
38             my $currentbook;
39             my @aColor = (
40             '000000', # 0x00
41             'FFFFFF', 'FFFFFF', 'FFFFFF', 'FFFFFF',
42             'FFFFFF', 'FFFFFF', 'FFFFFF', '000000', # 0x08
43             'FFFFFF', 'FF0000', '00FF00', '0000FF',
44             'FFFF00', 'FF00FF', '00FFFF', '800000', # 0x10
45             '008000', '000080', '808000', '800080',
46             '008080', 'C0C0C0', '808080', '9999FF', # 0x18
47             '993366', 'FFFFCC', 'CCFFFF', '660066',
48             'FF8080', '0066CC', 'CCCCFF', '000080', # 0x20
49             'FF00FF', 'FFFF00', '00FFFF', '800080',
50             '800000', '008080', '0000FF', '00CCFF', # 0x28
51             'CCFFFF', 'CCFFCC', 'FFFF99', '99CCFF',
52             'FF99CC', 'CC99FF', 'FFCC99', '3366FF', # 0x30
53             '33CCCC', '99CC00', 'FFCC00', 'FF9900',
54             'FF6600', '666699', '969696', '003366', # 0x38
55             '339966', '003300', '333300', '993300',
56             '993366', '333399', '333333', '000000' # 0x40
57             );
58 21     21   145 use constant verExcel95 => 0x500;
  21         38  
  21         1645  
59 21     21   110 use constant verExcel97 => 0x600;
  21         43  
  21         992  
60 21     21   125 use constant verBIFF2 => 0x00;
  21         53  
  21         1204  
61 21     21   118 use constant verBIFF3 => 0x02;
  21         47  
  21         882  
62 21     21   102 use constant verBIFF4 => 0x04;
  21         40  
  21         878  
63 21     21   102 use constant verBIFF5 => 0x08;
  21         36  
  21         825  
64 21     21   106 use constant verBIFF8 => 0x18;
  21         36  
  21         904  
65              
66 21     21   106 use constant MS_BIFF_CRYPTO_NONE => 0;
  21         39  
  21         951  
67 21     21   99 use constant MS_BIFF_CRYPTO_XOR => 1;
  21         57  
  21         847  
68 21     21   112 use constant MS_BIFF_CRYPTO_RC4 => 2;
  21         47  
  21         1136  
69              
70 21     21   116 use constant sizeof_BIFF_8_FILEPASS => ( 6 + 3 * 16 );
  21         50  
  21         896  
71              
72 21     21   100 use constant REKEY_BLOCK => 0x400;
  21         35  
  21         872  
73              
74             # Error code for some of the common parsing errors.
75 21     21   115 use constant ErrorNone => 0;
  21         46  
  21         904  
76 21     21   99 use constant ErrorNoFile => 1;
  21         36  
  21         812  
77 21     21   102 use constant ErrorNoExcelData => 2;
  21         34  
  21         894  
78 21     21   122 use constant ErrorFileEncrypted => 3;
  21         71  
  21         971  
79              
80             # Color index for the 'auto' color
81 21     21   100 use constant AutoColor => 64;
  21         37  
  21         339853  
82              
83             our %error_strings = (
84             ErrorNone, '', # 0
85             ErrorNoFile, 'File not found', # 1
86             ErrorNoExcelData, 'No Excel data found in file', # 2
87             ErrorFileEncrypted, 'File is encrypted', # 3
88              
89             );
90              
91              
92             our %ProcTbl = (
93              
94             #Develpers' Kit P291
95             0x14 => \&_subHeader, # Header
96             0x15 => \&_subFooter, # Footer
97             0x18 => \&_subName, # NAME(?)
98             0x1A => \&_subVPageBreak, # Vertical Page Break
99             0x1B => \&_subHPageBreak, # Horizontal Page Break
100             0x22 => \&_subFlg1904, # 1904 Flag
101             0x26 => \&_subMargin, # Left Margin
102             0x27 => \&_subMargin, # Right Margin
103             0x28 => \&_subMargin, # Top Margin
104             0x29 => \&_subMargin, # Bottom Margin
105             0x2A => \&_subPrintHeaders, # Print Headers
106             0x2B => \&_subPrintGridlines, # Print Gridlines
107             0x3C => \&_subContinue, # Continue
108             0x3D => \&_subWindow1, # Window1
109             0x43 => \&_subXF, # XF for Excel < 4.
110             0x0443 => \&_subXF, # XF for Excel = 4.
111             0x862 => \&_subSheetLayout, # Sheet Layout
112             0x1B8 => \&_subHyperlink, # HYPERLINK
113              
114             #Develpers' Kit P292
115             0x55 => \&_subDefColWidth, # Consider
116             0x5C => \&_subWriteAccess, # WRITEACCESS
117             0x7D => \&_subColInfo, # Colinfo
118             0x7E => \&_subRK, # RK
119             0x81 => \&_subWSBOOL, # WSBOOL
120             0x83 => \&_subHcenter, # HCENTER
121             0x84 => \&_subVcenter, # VCENTER
122             0x85 => \&_subBoundSheet, # BoundSheet
123              
124             0x92 => \&_subPalette, # Palette, fgp
125              
126             0x99 => \&_subStandardWidth, # Standard Col
127              
128             #Develpers' Kit P293
129             0xA1 => \&_subSETUP, # SETUP
130             0xBD => \&_subMulRK, # MULRK
131             0xBE => \&_subMulBlank, # MULBLANK
132             0xD6 => \&_subRString, # RString
133              
134             #Develpers' Kit P294
135             0xE0 => \&_subXF, # ExTended Format
136             0xE5 => \&_subMergeArea, # MergeArea (Not Documented)
137             0xFC => \&_subSST, # Shared String Table
138             0xFD => \&_subLabelSST, # Label SST
139              
140             #Develpers' Kit P295
141             0x201 => \&_subBlank, # Blank
142              
143             0x202 => \&_subInteger, # Integer(Not Documented)
144             0x203 => \&_subNumber, # Number
145             0x204 => \&_subLabel, # Label
146             0x205 => \&_subBoolErr, # BoolErr
147             0x207 => \&_subString, # STRING
148             0x208 => \&_subRow, # RowData
149             0x221 => \&_subArray, # Array (Consider)
150             0x225 => \&_subDefaultRowHeight, # Consider
151              
152             0x31 => \&_subFont, # Font
153             0x231 => \&_subFont, # Font
154              
155             0x27E => \&_subRK, # RK
156             0x41E => \&_subFormat, # Format
157              
158             0x06 => \&_subFormula, # Formula
159             0x406 => \&_subFormula, # Formula
160              
161             0x009 => \&_subBOF, # BOF(BIFF2)
162             0x209 => \&_subBOF, # BOF(BIFF3)
163             0x409 => \&_subBOF, # BOF(BIFF4)
164             0x809 => \&_subBOF, # BOF(BIFF5-8)
165             );
166              
167             our $BIGENDIAN;
168             our $PREFUNC;
169             our $_use_perlio;
170              
171             #------------------------------------------------------------------------------
172             # Spreadsheet::ParseExcel->new
173             #------------------------------------------------------------------------------
174             sub new {
175 46     46 1 20776 my ( $class, %hParam ) = @_;
176              
177 46 100       250 if ( not defined $_use_perlio ) {
178 20 50 33     29856 if ( exists $Config{useperlio}
      33        
179             && defined $Config{useperlio}
180             && $Config{useperlio} eq "define" )
181             {
182 20         67407 $_use_perlio = 1;
183             }
184             else {
185 0         0 $_use_perlio = 0;
186 0         0 require IO::Scalar;
187 0         0 import IO::Scalar;
188             }
189             }
190              
191             # Check ENDIAN(Little: Intel etc. BIG: Sparc etc)
192             $BIGENDIAN =
193 46 50       533 ( defined $hParam{Endian} ) ? $hParam{Endian}
    50          
194             : ( unpack( "H08", pack( "L", 2 ) ) eq '02000000' ) ? 0
195             : 1;
196 46         152 my $self = {};
197 46         173 bless $self, $class;
198              
199 46         272 $self->{GetContent} = \&_subGetContent;
200              
201 46 50       183 if ( $hParam{EventHandlers} ) {
202 0         0 $self->SetEventHandlers( $hParam{EventHandlers} );
203             }
204             else {
205 46         252 $self->SetEventHandlers( \%ProcTbl );
206             }
207 46 50       395 if ( $hParam{AddHandlers} ) {
208 0         0 foreach my $sKey ( keys( %{ $hParam{AddHandlers} } ) ) {
  0         0  
209 0         0 $self->SetEventHandler( $sKey, $hParam{AddHandlers}->{$sKey} );
210             }
211             }
212 46         144 $self->{CellHandler} = $hParam{CellHandler};
213 46         113 $self->{NotSetCell} = $hParam{NotSetCell};
214 46         114 $self->{Object} = $hParam{Object};
215              
216              
217 46 100       157 if ( defined $hParam{Password} ) {
218 2         6 $self->{Password} = $hParam{Password};
219             }
220             else {
221 44         138 $self->{Password} = 'VelvetSweatshop';
222             }
223              
224 46         157 $self->{_error_status} = ErrorNone;
225 46         198 return $self;
226             }
227              
228             #------------------------------------------------------------------------------
229             # Spreadsheet::ParseExcel->SetEventHandler
230             #------------------------------------------------------------------------------
231             sub SetEventHandler {
232 0     0 0 0 my ( $self, $key, $sub_ref ) = @_;
233 0         0 $self->{FuncTbl}->{$key} = $sub_ref;
234             }
235              
236             #------------------------------------------------------------------------------
237             # Spreadsheet::ParseExcel->SetEventHandlers
238             #------------------------------------------------------------------------------
239             sub SetEventHandlers {
240 46     46 0 99 my ( $self, $rhTbl ) = @_;
241 46         125 $self->{FuncTbl} = undef;
242 46         781 foreach my $sKey ( keys %$rhTbl ) {
243 2530         8003 $self->{FuncTbl}->{$sKey} = $rhTbl->{$sKey};
244             }
245             }
246              
247             #------------------------------------------------------------------------------
248             # Decryption routines
249             # based on sources of gnumeric (ms-biff.c ms-excel-read.c)
250             #------------------------------------------------------------------------------
251             sub md5state {
252 24     24 0 44 my ( $md5 ) = @_;
253 24         37 my $s = '';
254 24         158 for ( my $i = 0 ; $i < 4 ; $i++ ) {
255 96         269 my $v = $md5->{_state}[$i];
256 96         123 $s .= chr( $v & 0xff );
257 96         140 $s .= chr( ( $v >> 8 ) & 0xff );
258 96         116 $s .= chr( ( $v >> 16 ) & 0xff );
259 96         233 $s .= chr( ( $v >> 24 ) & 0xff );
260             }
261              
262 24         55 return $s;
263             }
264              
265             sub MakeKey {
266 15     15 0 67 my ( $block, $key, $valContext ) = @_;
267              
268 15         33 my $pwarray = "\0" x 64;
269              
270 15         42 substr( $pwarray, 0, 5 ) = substr( $valContext, 0, 5 );
271              
272 15         34 substr( $pwarray, 5, 1 ) = chr( $block & 0xff );
273 15         35 substr( $pwarray, 6, 1 ) = chr( ( $block >> 8 ) & 0xff );
274 15         27 substr( $pwarray, 7, 1 ) = chr( ( $block >> 16 ) & 0xff );
275 15         23 substr( $pwarray, 8, 1 ) = chr( ( $block >> 24 ) & 0xff );
276              
277 15         28 substr( $pwarray, 9, 1 ) = "\x80";
278 15         16 substr( $pwarray, 56, 1 ) = "\x48";
279              
280 15         94 my $md5 = Digest::Perl::MD5->new();
281 15         442 $md5->add( $pwarray );
282              
283 15         2827 my $s = md5state( $md5 );
284              
285 15         663 ${$key} = Crypt::RC4->new( $s );
  15         8286  
286             }
287              
288             sub VerifyPassword {
289 3     3 0 16 my ( $password, $docid, $salt_data, $hashedsalt_data, $valContext ) = @_;
290              
291 3         9 my $pwarray = "\0" x 64;
292 3         5 my $i;
293 3         38 my $md5 = Digest::Perl::MD5->new();
294              
295 3         87 for ( $i = 0 ; $i < length( $password ) ; $i++ ) {
296 40         164 my $o = ord( substr( $password, $i, 1 ) );
297 40         57 substr( $pwarray, 2 * $i, 1 ) = chr( $o & 0xff );
298 40         141 substr( $pwarray, 2 * $i + 1, 1 ) = chr( ( $o >> 8 ) & 0xff );
299             }
300 3         9 substr( $pwarray, 2 * $i, 1 ) = chr( 0x80 );
301 3         10 substr( $pwarray, 56, 1 ) = chr( ( $i << 4 ) & 0xff );
302              
303 3         19 $md5->add( $pwarray );
304              
305 3         644 my $mdContext1 = md5state( $md5 );
306              
307 3         10 my $offset = 0;
308 3         6 my $keyoffset = 0;
309 3         6 my $tocopy = 5;
310              
311 3         12 $md5->reset;
312              
313 3         32 while ( $offset != 16 ) {
314 63 100       130 if ( ( 64 - $offset ) < 5 ) {
315 12         130 $tocopy = 64 - $offset;
316             }
317              
318 63         96 substr( $pwarray, $offset, $tocopy ) =
319             substr( $mdContext1, $keyoffset, $tocopy );
320              
321 63         63 $offset += $tocopy;
322              
323 63 100       117 if ( $offset == 64 ) {
324 15         50 $md5->add( $pwarray );
325 15         1897 $keyoffset = $tocopy;
326 15         147 $tocopy = 5 - $tocopy;
327 15         17 $offset = 0;
328 15         40 next;
329             }
330              
331 48         56 $keyoffset = 0;
332 48         51 $tocopy = 5;
333 48         101 substr( $pwarray, $offset, 16 ) = $docid;
334 48         91 $offset += 16;
335             }
336              
337 3         8 substr( $pwarray, 16, 1 ) = "\x80";
338 3         6 substr( $pwarray, 17, 47 ) = "\0" x 47;
339 3         7 substr( $pwarray, 56, 1 ) = "\x80";
340 3         7 substr( $pwarray, 57, 1 ) = "\x0a";
341              
342 3         12 $md5->add( $pwarray );
343 3         515 ${$valContext} = md5state( $md5 );
  3         8  
344              
345 3         7 my $key;
346              
347 3         6 MakeKey( 0, \$key, ${$valContext} );
  3         12  
348              
349 3         17 my $salt = $key->RC4( $salt_data );
350 3         611 my $hashedsalt = $key->RC4( $hashedsalt_data );
351              
352 3         334 $salt .= "\x80" . "\0" x 47;
353              
354 3         8 substr( $salt, 56, 1 ) = "\x80";
355              
356 3         13 $md5->reset;
357 3         34 $md5->add( $salt );
358 3         420 my $mdContext2 = md5state( $md5 );
359              
360 3         59 return ( $mdContext2 eq $hashedsalt );
361             }
362              
363             sub SkipBytes {
364 401     401 0 759 my ( $q, $start, $count ) = @_;
365              
366 401         591 my $scratch = "\0" x REKEY_BLOCK;
367 401         379 my $block;
368              
369 401         705 $block = int( ( $start + $count ) / REKEY_BLOCK );
370              
371 401 100       895 if ( $block != $q->{block} ) {
372 3         14 MakeKey( $q->{block} = $block, \$q->{rc4_key}, $q->{md5_ctxt} );
373 3         12 $count = ( $start + $count ) % REKEY_BLOCK;
374             }
375              
376 401         1814 $q->{rc4_key}->RC4( substr( $scratch, 0, $count ) );
377              
378 401         32311 return 1;
379             }
380              
381             sub SetDecrypt {
382 4     4 0 12 my ( $q, $version, $password ) = @_;
383              
384 4 50       17 if ( $q->{opcode} != 0x2f ) {
385 0         0 return 0;
386             }
387              
388 4 50       17 if ( $password eq '' ) {
389 0         0 return 0;
390             }
391              
392             # TODO old versions decryption
393             #if (version < MS_BIFF_V8 || q->data[0] == 0)
394             # return ms_biff_pre_biff8_query_set_decrypt (q, password);
395              
396 4 100       17 if ( $q->{length} != sizeof_BIFF_8_FILEPASS ) {
397 1         314 return 0;
398             }
399              
400 3 100       23 unless (
401             VerifyPassword(
402             $password,
403             substr( $q->{data}, 6, 16 ),
404             substr( $q->{data}, 22, 16 ),
405             substr( $q->{data}, 38, 16 ),
406             \$q->{md5_ctxt}
407             )
408             )
409             {
410 1         6 return 0;
411             }
412              
413 2         10 $q->{encryption} = MS_BIFF_CRYPTO_RC4;
414 2         5 $q->{block} = -1;
415              
416             # The first record after FILEPASS seems to be unencrypted
417 2         4 $q->{dont_decrypt_next_record} = 1;
418              
419             # Pretend to decrypt the entire stream up till this point, it was
420             # encrypted, but do it anyway to keep the rc4 state in sync
421              
422 2         8 SkipBytes( $q, 0, $q->{streamPos} );
423              
424 2         12 return 1;
425             }
426              
427             sub InitStream {
428 44     44 0 100 my ( $stream_data ) = @_;
429 44         94 my %q;
430              
431 44         141 $q{opcode} = 0;
432 44         112 $q{length} = 0;
433 44         253 $q{data} = '';
434              
435 44         220 $q{stream} = $stream_data; # data stream
436 44         154 $q{streamLen} = length( $stream_data ); # stream length
437 44         133 $q{streamPos} = 0; # stream position
438              
439 44         104 $q{encryption} = 0;
440 44         146 $q{xor_key} = '';
441 44         118 $q{rc4_key} = '';
442 44         107 $q{md5_ctxt} = '';
443 44         186 $q{block} = 0;
444 44         103 $q{dont_decrypt_next_record} = 0;
445              
446 44         140 return \%q;
447             }
448              
449             sub QueryNext {
450 10089     10089 0 28270 my ( $q ) = @_;
451              
452 10089 100       24847 if ( $q->{streamPos} + 4 >= $q->{streamLen} ) {
453 42         172 return 0;
454             }
455              
456 10047         25432 my $data = substr( $q->{stream}, $q->{streamPos}, 4 );
457              
458 10047         25954 ( $q->{opcode}, $q->{length} ) = unpack( 'v2', $data );
459              
460             # No biff record should be larger than around 20,000.
461 10047 50       24480 if ( $q->{length} >= 20000 ) {
462 0         0 return 0;
463             }
464              
465 10047 100       23759 if ( $q->{length} > 0 ) {
466 7562         23119 $q->{data} = substr( $q->{stream}, $q->{streamPos} + 4, $q->{length} );
467             }
468             else {
469 2485         3292 $q->{data} = undef;
470 2485         6643 $q->{dont_decrypt_next_record} = 1;
471             }
472              
473 10047 100       39634 if ( $q->{encryption} == MS_BIFF_CRYPTO_RC4 ) {
    50          
    50          
474 399 100       695 if ( $q->{dont_decrypt_next_record} ) {
475 12         33 SkipBytes( $q, $q->{streamPos}, 4 + $q->{length} );
476 12         24 $q->{dont_decrypt_next_record} = 0;
477             }
478             else {
479 387         861 my $pos = $q->{streamPos};
480 387         575 my $data = $q->{data};
481 387         450 my $len = $q->{length};
482 387         512 my $res = '';
483              
484             # Pretend to decrypt header.
485 387         1574 SkipBytes( $q, $pos, 4 );
486 387         513 $pos += 4;
487              
488 387         1372 while ( $q->{block} != int( ( $pos + $len ) / REKEY_BLOCK ) ) {
489 9         19 my $step = REKEY_BLOCK - ( $pos % REKEY_BLOCK );
490 9         35 $res .= $q->{rc4_key}->RC4( substr( $data, 0, $step ) );
491 9         7595 $data = substr( $data, $step );
492 9         13 $pos += $step;
493 9         11 $len -= $step;
494 9         56 MakeKey( ++$q->{block}, \$q->{rc4_key}, $q->{md5_ctxt} );
495             }
496              
497 387         1494 $res .= $q->{rc4_key}->RC4( substr( $data, 0, $len ) );
498 387         59618 $q->{data} = $res;
499             }
500             }
501             elsif ( $q->{encryption} == MS_BIFF_CRYPTO_XOR ) {
502              
503             # not implemented
504 0         0 return 0;
505             }
506             elsif ( $q->{encryption} == MS_BIFF_CRYPTO_NONE ) {
507              
508             }
509              
510 10047         16056 $q->{streamPos} += 4 + $q->{length};
511              
512 10047         29929 return 1;
513             }
514              
515             ###############################################################################
516             #
517             # Parse()
518             #
519             # Parse the Excel file and convert it into a tree of objects..
520             #
521             sub parse {
522              
523 48     48 1 3814 my ( $self, $source, $formatter ) = @_;
524              
525 48         493 my $workbook = Spreadsheet::ParseExcel::Workbook->new();
526 48         110 $currentbook = $workbook;
527 48         1338 $workbook->{SheetCount} = 0;
528 48         140 $workbook->{CellHandler} = $self->{CellHandler};
529 48         122 $workbook->{NotSetCell} = $self->{NotSetCell};
530 48         117 $workbook->{Object} = $self->{Object};
531 48         659 $workbook->{aColor} = [ @aColor ];
532              
533 48         244 my ( $biff_data, $data_length ) = $self->_get_content( $source, $workbook );
534 48 100       220 return undef if not $biff_data;
535              
536 44 100       176 if ( $formatter ) {
537 7         23 $workbook->{FmtClass} = $formatter;
538             }
539             else {
540 37         463 $workbook->{FmtClass} = Spreadsheet::ParseExcel::FmtDefault->new();
541             }
542              
543             # Parse the BIFF data.
544 44         207 my $stream = InitStream( $biff_data );
545              
546 44         184 while ( QueryNext( $stream ) ) {
547              
548 10047         15413 my $record = $stream->{opcode};
549 10047         12607 my $record_length = $stream->{length};
550              
551 10047         15823 my $record_header = $stream->{data};
552              
553             # If the file contains a FILEPASS record we assume that it is encrypted
554             # and cannot be parsed.
555 10047 100       24549 if ( $record == 0x002F ) {
556 4 100       19 unless ( SetDecrypt( $stream, '', $self->{Password} ) ) {
557 2         8 $self->{_error_status} = ErrorFileEncrypted;
558 2         20 return undef;
559             }
560             }
561              
562             # Special case of a formula String with no string.
563 10045 0 33     30283 if ( $workbook->{_PrevPos}
      33        
564             && ( defined $self->{FuncTbl}->{$record} )
565             && ( $record != 0x207 ) )
566             {
567 0         0 my $iPos = $workbook->{_PrevPos};
568 0         0 $workbook->{_PrevPos} = undef;
569              
570 0         0 my ( $row, $col, $format_index ) = @$iPos;
571 0         0 _NewCell(
572             $workbook, $row, $col,
573             Kind => 'Formula String',
574             Val => '',
575             FormatNo => $format_index,
576             Format => $workbook->{Format}[$format_index],
577             Numeric => 0,
578             Code => undef,
579             Book => $workbook,
580             );
581             }
582              
583             # If the BIFF record matches 0x0*09 then it is a BOF record.
584             # We reset the _skip_chart flag to ensure we check the sheet type.
585 10045 100       22202 if ( ( $record & 0xF0FF ) == 0x09 ) {
586 138         548 $workbook->{_skip_chart} = 0;
587             }
588              
589 10045 100 100     45943 if ( defined $self->{FuncTbl}->{$record} && !$workbook->{_skip_chart} )
590             {
591 4889         16434 $self->{FuncTbl}->{$record}
592             ->( $workbook, $record, $record_length, $record_header );
593             }
594              
595 10045 100       24528 $PREFUNC = $record if ( $record != 0x3C ); #Not Continue
596              
597 10045 50       39334 last if defined $workbook->{_ParseAbort};
598             }
599              
600 42         96 foreach my $worksheet (@{$workbook->{Worksheet}} ) {
  42         172  
601             # Install hyperlinks into each cell
602             # Range is undocumented for user; allows reuse of data
603              
604 87 100       406 if ($worksheet->{HyperLinks}) {
605 2         11 foreach my $link (@{$worksheet->{HyperLinks}}) {
  2         6  
606 28         65 for( my $row = $link->[3]; $row <= $link->[4]; $row++ ) {
607 28         62 for( my $col = $link->[5]; $col <= $link->[6]; $col++ ) {
608 28         159 $worksheet->{Cells}[$row][$col]{Hyperlink} = $link;
609             }
610             }
611             }
612             }
613             }
614 42         759 return $workbook;
615             }
616              
617             ###############################################################################
618             #
619             # _get_content()
620             #
621             # Get the Excel BIFF content from the file or filehandle.
622             #
623             sub _get_content {
624              
625 48     48   106 my ( $self, $source, $workbook ) = @_;
626 48         90 my ( $biff_data, $data_length );
627              
628             # Reset the error status in case method is called more than once.
629 48         113 $self->{_error_status} = ErrorNone;
630            
631 48         164 my $ref = ref($source);
632              
633 48 100       154 if ( $ref ) {
634 6 100       49 if ( $ref eq 'SCALAR' ) {
    100          
635              
636             # Specified by a scalar buffer.
637 1         6 ( $biff_data, $data_length ) = $self->{GetContent}->( $source );
638              
639             }
640             elsif ( $ref eq 'ARRAY' ) {
641              
642             # Specified by file content
643 1         4 $workbook->{File} = undef;
644 1         45 my $sData = join( '', @$source );
645 1         5 ( $biff_data, $data_length ) = $self->{GetContent}->( \$sData );
646             }
647             else {
648              
649             # Assume filehandle
650              
651             # For CGI.pm (Light FileHandle)
652 4         10 my $sBuff = '';
653 4 100       11 if ( eval { binmode( $source ) } ) {
  4         32  
654 3         9 my $sWk;
655              
656 3         2857 while ( read( $source, $sWk, 4096 ) ) {
657 13         188 $sBuff .= $sWk;
658             }
659             }
660             else {
661              
662             # Assume IO::Wrap or some other filehandle-like OO-only object
663 1         2 my $sWk;
664              
665             # IO::Wrap does not implement binmode
666 1         2 eval { $source->binmode() };
  1         16  
667              
668 1         6 while ( $source->read( $sWk, 4096 ) ) {
669 4         111 $sBuff .= $sWk;
670             }
671             }
672              
673 4         30 ( $biff_data, $data_length ) = $self->{GetContent}->( \$sBuff );
674              
675             }
676             }
677             else {
678              
679             # Specified by filename .
680 42         118 $workbook->{File} = $source;
681              
682 42 100       37954 if ( !-e $source ) {
683 2         32 $self->{_error_status} = ErrorNoFile;
684 2         19 return undef;
685             }
686              
687 40         196 ( $biff_data, $data_length ) = $self->{GetContent}->( $source );
688             }
689              
690             # If the read was successful return the data.
691 46 100       238 if ( $data_length ) {
692 44         240 return ( $biff_data, $data_length );
693             }
694             else {
695 2         8 $self->{_error_status} = ErrorNoExcelData;
696 2         8 return undef;
697             }
698              
699             }
700              
701             #------------------------------------------------------------------------------
702             # _subGetContent (for Spreadsheet::ParseExcel)
703             #------------------------------------------------------------------------------
704             sub _subGetContent {
705 46     46   140 my ( $sFile ) = @_;
706              
707 46         469 my $oOl = OLE::Storage_Lite->new( $sFile );
708 46 50       662 return ( undef, undef ) unless ( $oOl );
709 46         249 my @aRes = $oOl->getPpsSearch(
710             [
711             OLE::Storage_Lite::Asc2Ucs( 'Book' ),
712             OLE::Storage_Lite::Asc2Ucs( 'Workbook' )
713             ],
714             1, 1
715             );
716 46 50       6293843 return ( undef, undef ) if ( $#aRes < 0 );
717              
718             #Hack from Herbert
719 46 100       245 if ( $aRes[0]->{Data} ) {
720 44         675 return ( $aRes[0]->{Data}, length( $aRes[0]->{Data} ) );
721             }
722              
723             #Same as OLE::Storage_Lite
724 2         6 my $oIo;
725              
726             #1. $sFile is Ref of scalar
727 2 50       28 if ( ref( $sFile ) eq 'SCALAR' ) {
    50          
    50          
728 0 0       0 if ( $_use_perlio ) {
729 0         0 open $oIo, "<", \$sFile;
730             }
731             else {
732 0         0 $oIo = IO::Scalar->new;
733 0         0 $oIo->open( $sFile );
734             }
735             }
736              
737             #2. $sFile is a IO::Handle object
738             elsif ( UNIVERSAL::isa( $sFile, 'IO::Handle' ) ) {
739 0         0 $oIo = $sFile;
740 0         0 binmode( $oIo );
741             }
742              
743             #3. $sFile is a simple filename string
744             elsif ( !ref( $sFile ) ) {
745 2         15 $oIo = IO::File->new;
746 2 50       158 $oIo->open( "<$sFile" ) || return undef;
747 2         94 binmode( $oIo );
748             }
749 2         4 my $sWk;
750 2         6 my $sBuff = '';
751              
752 2         11 while ( $oIo->read( $sWk, 4096 ) ) { #4_096 has no special meanings
753 3         85 $sBuff .= $sWk;
754             }
755 2         36 $oIo->close();
756              
757             #Not Excel file (simple method)
758 2 50       550 return ( undef, undef ) if ( substr( $sBuff, 0, 1 ) ne "\x09" );
759 0         0 return ( $sBuff, length( $sBuff ) );
760             }
761              
762             #------------------------------------------------------------------------------
763             # _subBOF (for Spreadsheet::ParseExcel) Developers' Kit : P303
764             #------------------------------------------------------------------------------
765             sub _subBOF {
766 138     138   328 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
767 138         387 my ( $iVer, $iDt ) = unpack( "v2", $sWk );
768              
769             #Workbook Global
770 138 100       537 if ( $iDt == 0x0005 ) {
    100          
771 44         159 $oBook->{Version} = unpack( "v", $sWk );
772 44 100       494 $oBook->{BIFFVersion} =
773             ( $oBook->{Version} == verExcel95 ) ? verBIFF5 : verBIFF8;
774 44         106 $oBook->{_CurSheet} = undef;
775 44         145 $oBook->{_CurSheet_} = -1;
776             }
777              
778             #Worksheet or Dialogsheet
779             elsif ( $iDt != 0x0020 ) { #if($iDt == 0x0010)
780 87 50       391 if ( defined $oBook->{_CurSheet_} ) {
781 87         200 $oBook->{_CurSheet} = $oBook->{_CurSheet_} + 1;
782 87         161 $oBook->{_CurSheet_}++;
783              
784             (
785 87 50       1286 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{SheetVersion},
786             $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{SheetType},
787             )
788             = unpack( "v2", $sWk )
789             if ( length( $sWk ) > 4 );
790             }
791             else {
792 0         0 $oBook->{BIFFVersion} = int( $bOp / 0x100 );
793 0 0 0     0 if ( ( $oBook->{BIFFVersion} == verBIFF2 )
      0        
794             || ( $oBook->{BIFFVersion} == verBIFF3 )
795             || ( $oBook->{BIFFVersion} == verBIFF4 ) )
796             {
797 0         0 $oBook->{Version} = $oBook->{BIFFVersion};
798 0         0 $oBook->{_CurSheet} = 0;
799 0         0 $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
800             Spreadsheet::ParseExcel::Worksheet->new(
801             _Name => '',
802             Name => '',
803             _Book => $oBook,
804             _SheetNo => $oBook->{SheetCount},
805             );
806 0         0 $oBook->{SheetCount}++;
807             }
808             }
809             }
810             else {
811              
812             # Set flag to ignore all chart records until we reach another BOF.
813 7         20 $oBook->{_skip_chart} = 1;
814             }
815             }
816              
817             #------------------------------------------------------------------------------
818             # _subBlank (for Spreadsheet::ParseExcel) DK:P303
819             #------------------------------------------------------------------------------
820             sub _subBlank {
821 9     9   27 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
822 9         31 my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
823 9         48 _NewCell(
824             $oBook, $iR, $iC,
825             Kind => 'BLANK',
826             Val => '',
827             FormatNo => $iF,
828             Format => $oBook->{Format}[$iF],
829             Numeric => 0,
830             Code => undef,
831             Book => $oBook,
832             );
833              
834             #2.MaxRow, MaxCol, MinRow, MinCol
835 9         29 _SetDimension( $oBook, $iR, $iC, $iC );
836             }
837              
838             #------------------------------------------------------------------------------
839             # _subInteger (for Spreadsheet::ParseExcel) Not in DK
840             #------------------------------------------------------------------------------
841             sub _subInteger {
842 0     0   0 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
843 0         0 my ( $iR, $iC, $iF, $sTxt, $sDum );
844              
845 0         0 ( $iR, $iC, $iF, $sDum, $sTxt ) = unpack( "v3cv", $sWk );
846 0         0 _NewCell(
847             $oBook, $iR, $iC,
848             Kind => 'INTEGER',
849             Val => $sTxt,
850             FormatNo => $iF,
851             Format => $oBook->{Format}[$iF],
852             Numeric => 0,
853             Code => undef,
854             Book => $oBook,
855             );
856              
857             #2.MaxRow, MaxCol, MinRow, MinCol
858 0         0 _SetDimension( $oBook, $iR, $iC, $iC );
859             }
860              
861             #------------------------------------------------------------------------------
862             # _subNumber (for Spreadsheet::ParseExcel) : DK: P354
863             #------------------------------------------------------------------------------
864             sub _subNumber {
865 38     38   104 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
866              
867 38         541 my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
868 38         686 my $dVal = _convDval( substr( $sWk, 6, 8 ) );
869 38         170 _NewCell(
870             $oBook, $iR, $iC,
871             Kind => 'Number',
872             Val => $dVal,
873             FormatNo => $iF,
874             Format => $oBook->{Format}[$iF],
875             Numeric => 1,
876             Code => undef,
877             Book => $oBook,
878             );
879              
880             #2.MaxRow, MaxCol, MinRow, MinCol
881 38         94 _SetDimension( $oBook, $iR, $iC, $iC );
882             }
883              
884             #------------------------------------------------------------------------------
885             # _convDval (for Spreadsheet::ParseExcel)
886             #------------------------------------------------------------------------------
887             sub _convDval {
888 285     285   924 my ( $sWk ) = @_;
889             return
890 285 50       1207 unpack( "d",
891             ( $BIGENDIAN ) ? pack( "c8", reverse( unpack( "c8", $sWk ) ) ) : $sWk );
892             }
893              
894             #------------------------------------------------------------------------------
895             # _subRString (for Spreadsheet::ParseExcel) DK:P405
896             #------------------------------------------------------------------------------
897             sub _subRString {
898 0     0   0 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
899 0         0 my ( $iR, $iC, $iF, $iL, $sTxt );
900 0         0 ( $iR, $iC, $iF, $iL ) = unpack( "v4", $sWk );
901 0         0 $sTxt = substr( $sWk, 8, $iL );
902              
903             #Has STRUN
904 0 0       0 if ( length( $sWk ) > ( 8 + $iL ) ) {
905 0         0 _NewCell(
906             $oBook, $iR, $iC,
907             Kind => 'RString',
908             Val => $sTxt,
909             FormatNo => $iF,
910             Format => $oBook->{Format}[$iF],
911             Numeric => 0,
912             Code => '_native_', #undef,
913             Book => $oBook,
914             Rich => substr( $sWk, ( 8 + $iL ) + 1 ),
915             );
916             }
917             else {
918 0         0 _NewCell(
919             $oBook, $iR, $iC,
920             Kind => 'RString',
921             Val => $sTxt,
922             FormatNo => $iF,
923             Format => $oBook->{Format}[$iF],
924             Numeric => 0,
925             Code => '_native_',
926             Book => $oBook,
927             );
928             }
929              
930             #2.MaxRow, MaxCol, MinRow, MinCol
931 0         0 _SetDimension( $oBook, $iR, $iC, $iC );
932             }
933              
934             #------------------------------------------------------------------------------
935             # _subBoolErr (for Spreadsheet::ParseExcel) DK:P306
936             #------------------------------------------------------------------------------
937             sub _subBoolErr {
938 0     0   0 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
939 0         0 my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
940 0         0 my ( $iVal, $iFlg ) = unpack( "cc", substr( $sWk, 6, 2 ) );
941 0         0 my $sTxt = DecodeBoolErr( $iVal, $iFlg );
942              
943 0         0 _NewCell(
944             $oBook, $iR, $iC,
945             Kind => 'BoolError',
946             Val => $sTxt,
947             FormatNo => $iF,
948             Format => $oBook->{Format}[$iF],
949             Numeric => 0,
950             Code => undef,
951             Book => $oBook,
952             );
953              
954             #2.MaxRow, MaxCol, MinRow, MinCol
955 0         0 _SetDimension( $oBook, $iR, $iC, $iC );
956             }
957              
958             ###############################################################################
959             #
960             # _subRK()
961             #
962             # Decode the RK BIFF record.
963             #
964             sub _subRK {
965              
966 171     171   339 my ( $workbook, $biff_number, $length, $data ) = @_;
967              
968 171         406 my ( $row, $col, $format_index, $rk_number ) = unpack( 'vvvV', $data );
969              
970 171         374 my $number = _decode_rk_number( $rk_number );
971              
972 171         580 _NewCell(
973             $workbook, $row, $col,
974             Kind => 'RK',
975             Val => $number,
976             FormatNo => $format_index,
977             Format => $workbook->{Format}->[$format_index],
978             Numeric => 1,
979             Code => undef,
980             Book => $workbook,
981             );
982              
983             # Store the max and min row/col values.
984 171         449 _SetDimension( $workbook, $row, $col, $col );
985             }
986              
987             #------------------------------------------------------------------------------
988             # _subArray (for Spreadsheet::ParseExcel) DK:P297
989             #------------------------------------------------------------------------------
990             sub _subArray {
991 0     0   0 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
992 0         0 my ( $iBR, $iER, $iBC, $iEC ) = unpack( "v2c2", $sWk );
993              
994             }
995              
996             #------------------------------------------------------------------------------
997             # _subFormula (for Spreadsheet::ParseExcel) DK:P336
998             #------------------------------------------------------------------------------
999             sub _subFormula {
1000 25     25   71 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1001 25         296 my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
1002              
1003 25         123 my ( $iFlg ) = unpack( "v", substr( $sWk, 12, 2 ) );
1004 25 50       67 if ( $iFlg == 0xFFFF ) {
1005 0         0 my ( $iKind ) = unpack( "c", substr( $sWk, 6, 1 ) );
1006 0         0 my ( $iVal ) = unpack( "c", substr( $sWk, 8, 1 ) );
1007              
1008 0 0 0     0 if ( ( $iKind == 1 ) or ( $iKind == 2 ) ) {
1009 0 0       0 my $sTxt =
1010             ( $iKind == 1 )
1011             ? DecodeBoolErr( $iVal, 0 )
1012             : DecodeBoolErr( $iVal, 1 );
1013 0         0 _NewCell(
1014             $oBook, $iR, $iC,
1015             Kind => 'Formula Bool',
1016             Val => $sTxt,
1017             FormatNo => $iF,
1018             Format => $oBook->{Format}[$iF],
1019             Numeric => 0,
1020             Code => undef,
1021             Book => $oBook,
1022             );
1023             }
1024             else { # Result (Reserve Only)
1025 0         0 $oBook->{_PrevPos} = [ $iR, $iC, $iF ];
1026             }
1027             }
1028             else {
1029 25         93 my $dVal = _convDval( substr( $sWk, 6, 8 ) );
1030 25         117 _NewCell(
1031             $oBook, $iR, $iC,
1032             Kind => 'Formula Number',
1033             Val => $dVal,
1034             FormatNo => $iF,
1035             Format => $oBook->{Format}[$iF],
1036             Numeric => 1,
1037             Code => undef,
1038             Book => $oBook,
1039             );
1040             }
1041              
1042             #2.MaxRow, MaxCol, MinRow, MinCol
1043 25         89 _SetDimension( $oBook, $iR, $iC, $iC );
1044             }
1045              
1046             #------------------------------------------------------------------------------
1047             # _subString (for Spreadsheet::ParseExcel) DK:P414
1048             #------------------------------------------------------------------------------
1049             sub _subString {
1050 0     0   0 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1051              
1052             #Position (not enough for ARRAY)
1053              
1054 0         0 my $iPos = $oBook->{_PrevPos};
1055 0 0       0 return undef unless ( $iPos );
1056 0         0 $oBook->{_PrevPos} = undef;
1057 0         0 my ( $iR, $iC, $iF ) = @$iPos;
1058              
1059 0         0 my ( $iLen, $sTxt, $sCode );
1060 0 0       0 if ( $oBook->{BIFFVersion} == verBIFF8 ) {
    0          
1061 0         0 my ( $raBuff, $iLen ) = _convBIFF8String( $oBook, $sWk, 1 );
1062 0         0 $sTxt = $raBuff->[0];
1063 0 0       0 $sCode = ( $raBuff->[1] ) ? 'ucs2' : undef;
1064             }
1065             elsif ( $oBook->{BIFFVersion} == verBIFF5 ) {
1066 0         0 $sCode = '_native_';
1067 0         0 $iLen = unpack( "v", $sWk );
1068 0         0 $sTxt = substr( $sWk, 2, $iLen );
1069             }
1070             else {
1071 0         0 $sCode = '_native_';
1072 0         0 $iLen = unpack( "c", $sWk );
1073 0         0 $sTxt = substr( $sWk, 1, $iLen );
1074             }
1075 0         0 _NewCell(
1076             $oBook, $iR, $iC,
1077             Kind => 'String',
1078             Val => $sTxt,
1079             FormatNo => $iF,
1080             Format => $oBook->{Format}[$iF],
1081             Numeric => 0,
1082             Code => $sCode,
1083             Book => $oBook,
1084             );
1085              
1086             #2.MaxRow, MaxCol, MinRow, MinCol
1087 0         0 _SetDimension( $oBook, $iR, $iC, $iC );
1088             }
1089              
1090             #------------------------------------------------------------------------------
1091             # _subLabel (for Spreadsheet::ParseExcel) DK:P344
1092             #------------------------------------------------------------------------------
1093             sub _subLabel {
1094 147     147   267 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1095 147         298 my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
1096 147         180 my ( $sLbl, $sCode );
1097              
1098             #BIFF8
1099 147 50       298 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
1100 0         0 my ( $raBuff, $iLen, $iStPos, $iLenS ) =
1101             _convBIFF8String( $oBook, substr( $sWk, 6 ), 1 );
1102 0         0 $sLbl = $raBuff->[0];
1103 0 0       0 $sCode = ( $raBuff->[1] ) ? 'ucs2' : undef;
1104             }
1105              
1106             #Before BIFF8
1107             else {
1108 147         247 $sLbl = substr( $sWk, 8 );
1109 147         187 $sCode = '_native_';
1110             }
1111 147         451 _NewCell(
1112             $oBook, $iR, $iC,
1113             Kind => 'Label',
1114             Val => $sLbl,
1115             FormatNo => $iF,
1116             Format => $oBook->{Format}[$iF],
1117             Numeric => 0,
1118             Code => $sCode,
1119             Book => $oBook,
1120             );
1121              
1122             #2.MaxRow, MaxCol, MinRow, MinCol
1123 147         1403 _SetDimension( $oBook, $iR, $iC, $iC );
1124             }
1125              
1126             ###############################################################################
1127             #
1128             # _subMulRK()
1129             #
1130             # Decode the Multiple RK BIFF record.
1131             #
1132             sub _subMulRK {
1133              
1134 62     62   148 my ( $workbook, $biff_number, $length, $data ) = @_;
1135              
1136             # JMN: I don't know why this is here.
1137 62 50       197 return if $workbook->{SheetCount} <= 0;
1138              
1139 62         135 my ( $row, $first_col ) = unpack( "v2", $data );
1140 62         186 my $last_col = unpack( "v", substr( $data, length( $data ) - 2, 2 ) );
1141              
1142             # Iterate over the RK array and decode the data.
1143 62         86 my $pos = 4;
1144 62         151 for my $col ( $first_col .. $last_col ) {
1145              
1146 151         318 my $data = substr( $data, $pos, 6 );
1147 151         404 my ( $format_index, $rk_number ) = unpack 'vV', $data;
1148 151         383 my $number = _decode_rk_number( $rk_number );
1149              
1150 151         553 _NewCell(
1151             $workbook, $row, $col,
1152             Kind => 'MulRK',
1153             Val => $number,
1154             FormatNo => $format_index,
1155             Format => $workbook->{Format}->[$format_index],
1156             Numeric => 1,
1157             Code => undef,
1158             Book => $workbook,
1159             );
1160 151         388 $pos += 6;
1161             }
1162              
1163             # Store the max and min row/col values.
1164 62         212 _SetDimension( $workbook, $row, $first_col, $last_col );
1165             }
1166              
1167             #------------------------------------------------------------------------------
1168             # _subMulBlank (for Spreadsheet::ParseExcel) DK:P349
1169             #------------------------------------------------------------------------------
1170             sub _subMulBlank {
1171 15     15   42 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1172 15         49 my ( $iR, $iSc ) = unpack( "v2", $sWk );
1173 15         40 my $iEc = unpack( "v", substr( $sWk, length( $sWk ) - 2, 2 ) );
1174 15         24 my $iPos = 4;
1175 15         54 for ( my $iC = $iSc ; $iC <= $iEc ; $iC++ ) {
1176 56         120 my $iF = unpack( 'v', substr( $sWk, $iPos, 2 ) );
1177 56         155 _NewCell(
1178             $oBook, $iR, $iC,
1179             Kind => 'MulBlank',
1180             Val => '',
1181             FormatNo => $iF,
1182             Format => $oBook->{Format}[$iF],
1183             Numeric => 0,
1184             Code => undef,
1185             Book => $oBook,
1186             );
1187 56         164 $iPos += 2;
1188             }
1189              
1190             #2.MaxRow, MaxCol, MinRow, MinCol
1191 15         47 _SetDimension( $oBook, $iR, $iSc, $iEc );
1192             }
1193              
1194             #------------------------------------------------------------------------------
1195             # _subLabelSST (for Spreadsheet::ParseExcel) DK: P345
1196             #------------------------------------------------------------------------------
1197             sub _subLabelSST {
1198 525     525   944 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1199 525         1103 my ( $iR, $iC, $iF, $iIdx ) = unpack( 'v3V', $sWk );
1200              
1201 525 100       3012 _NewCell(
1202             $oBook, $iR, $iC,
1203             Kind => 'PackedIdx',
1204             Val => $oBook->{PkgStr}[$iIdx]->{Text},
1205             FormatNo => $iF,
1206             Format => $oBook->{Format}[$iF],
1207             Numeric => 0,
1208             Code => ( $oBook->{PkgStr}[$iIdx]->{Unicode} ) ? 'ucs2' : undef,
1209             Book => $oBook,
1210             Rich => $oBook->{PkgStr}[$iIdx]->{Rich},
1211             );
1212              
1213             #2.MaxRow, MaxCol, MinRow, MinCol
1214 525         1066 _SetDimension( $oBook, $iR, $iC, $iC );
1215             }
1216              
1217             #------------------------------------------------------------------------------
1218             # _subFlg1904 (for Spreadsheet::ParseExcel) DK:P296
1219             #------------------------------------------------------------------------------
1220             sub _subFlg1904 {
1221 42     42   118 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1222 42         204 $oBook->{Flg1904} = unpack( "v", $sWk );
1223             }
1224              
1225             #------------------------------------------------------------------------------
1226             # _subRow (for Spreadsheet::ParseExcel) DK:P403
1227             #------------------------------------------------------------------------------
1228             sub _subRow {
1229 585     585   1082 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1230 585 50       1315 return undef unless ( defined $oBook->{_CurSheet} );
1231              
1232             #0. Get Worksheet info (MaxRow, MaxCol, MinRow, MinCol)
1233 585         1505 my ( $iR, $iSc, $iEc, $iHght, $undef1, $undef2, $iGr, $iXf ) =
1234             unpack( "v8", $sWk );
1235 585         881 $iEc--;
1236              
1237 585 100       1141 if ( $iGr & 0x20 ) {
1238 8         36 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RowHidden}[$iR] = 1;
1239             }
1240              
1241 585         2098 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RowHeight}[$iR] = $iHght / 20;
1242              
1243             #2.MaxRow, MaxCol, MinRow, MinCol
1244 585         1215 _SetDimension( $oBook, $iR, $iSc, $iEc );
1245             }
1246              
1247             #------------------------------------------------------------------------------
1248             # _SetDimension (for Spreadsheet::ParseExcel)
1249             #------------------------------------------------------------------------------
1250             sub _SetDimension {
1251 1577     1577   3123 my ( $oBook, $iR, $iSc, $iEc ) = @_;
1252 1577 50       4092 return undef unless ( defined $oBook->{_CurSheet} );
1253              
1254             #2.MaxRow, MaxCol, MinRow, MinCol
1255             #2.1 MinRow
1256 1577 100 66     8322 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} = $iR
1257             unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} )
1258             and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} <= $iR );
1259              
1260             #2.2 MaxRow
1261 1577 100 100     18161 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} = $iR
1262             unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} )
1263             and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} > $iR );
1264              
1265             #2.3 MinCol
1266 1577 100 66     8350 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} = $iSc
1267             unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} )
1268             and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} <= $iSc );
1269              
1270             #2.4 MaxCol
1271 1577 100 100     10415 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} = $iEc
1272             unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} )
1273             and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} > $iEc );
1274              
1275             }
1276              
1277             #------------------------------------------------------------------------------
1278             # _subDefaultRowHeight (for Spreadsheet::ParseExcel) DK: P318
1279             #------------------------------------------------------------------------------
1280             sub _subDefaultRowHeight {
1281 87     87   202 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1282 87 50       286 return undef unless ( defined $oBook->{_CurSheet} );
1283              
1284             #1. RowHeight
1285 87         235 my ( $iDum, $iHght ) = unpack( "v2", $sWk );
1286 87         424 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{DefRowHeight} = $iHght / 20;
1287              
1288             }
1289              
1290             #------------------------------------------------------------------------------
1291             # _subStandardWidth(for Spreadsheet::ParseExcel) DK:P413
1292             #------------------------------------------------------------------------------
1293             sub _subStandardWidth {
1294 4     4   11 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1295 4         12 my $iW = unpack( "v", $sWk );
1296 4         11 $oBook->{StandardWidth} = _convert_col_width( $oBook, $iW );
1297             }
1298              
1299             ###############################################################################
1300             #
1301             # _subDefColWidth()
1302             #
1303             # Read the DEFCOLWIDTH Biff record. This gives the width in terms of chars
1304             # and is different from the width in the COLINFO record.
1305             #
1306             sub _subDefColWidth {
1307              
1308 87     87   203 my ( $self, $record, $length, $data ) = @_;
1309              
1310 87         181 my $width = unpack 'v', $data;
1311              
1312             # Adjustment for default Arial 10 width.
1313 87 50       362 $width = 8.43 if $width == 8;
1314              
1315 87         313 $self->{Worksheet}->[ $self->{_CurSheet} ]->{DefColWidth} = $width;
1316             }
1317              
1318             ###############################################################################
1319             #
1320             # _convert_col_width()
1321             #
1322             # Converts from the internal Excel column width units to user units seen in the
1323             # interface. It is first necessary to convert the internal width to pixels and
1324             # then to user units. The conversion is specific to a default font of Arial 10.
1325             # TODO, the conversion should be extended to other fonts and sizes.
1326             #
1327             sub _convert_col_width {
1328              
1329 2171     2171   21552 my $self = shift;
1330 2171         7884 my $excel_width = shift;
1331              
1332             # Convert from Excel units to pixels (rounded up).
1333 2171         3059 my $pixels = int( 0.5 + $excel_width * 7 / 256 );
1334              
1335             # Convert from pixels to user units.
1336             # The conversion is different for columns <= 1 user unit (12 pixels).
1337 2171         2029 my $user_width;
1338 2171 100       3091 if ( $pixels <= 12 ) {
1339 14         19 $user_width = $pixels / 12;
1340             }
1341             else {
1342 2157         2488 $user_width = ( $pixels - 5 ) / 7;
1343             }
1344              
1345             # Round up to 2 decimal places.
1346 2171         2843 $user_width = int( $user_width * 100 + 0.5 ) / 100;
1347              
1348 2171         6007 return $user_width;
1349             }
1350              
1351             #------------------------------------------------------------------------------
1352             # _subColInfo (for Spreadsheet::ParseExcel) DK:P309
1353             #------------------------------------------------------------------------------
1354             sub _subColInfo {
1355              
1356 98     98   194 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1357              
1358 98 50       292 return undef unless defined $oBook->{_CurSheet};
1359              
1360 98         333 my ( $iSc, $iEc, $iW, $iXF, $iGr ) = unpack( "v5", $sWk );
1361              
1362 98         291 for ( my $i = $iSc ; $i <= $iEc ; $i++ ) {
1363              
1364 2130         3190 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{ColWidth}[$i] =
1365             _convert_col_width( $oBook, $iW );
1366              
1367 2130         3908 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{ColFmtNo}[$i] = $iXF;
1368              
1369 2130 100       6411 if ( $iGr & 0x01 ) {
1370 8         45 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{ColHidden}[$i] = 1;
1371             }
1372             }
1373             }
1374              
1375             #------------------------------------------------------------------------------
1376             # _subWindow1 Window information P 273
1377             #------------------------------------------------------------------------------
1378             sub _subWindow1 {
1379 60     60   219 my ( $workbook, $op, $len, $wk ) = @_;
1380              
1381 60 50       361 return if ( $workbook->{BIFFVersion} <= verBIFF4() );
1382              
1383             my (
1384 60         252 $hpos, $vpos, $width,
1385             $height, $options, $active,
1386             $firsttab, $numselected, $tabbarwidth
1387             ) = unpack( "v9", $wk );
1388              
1389 60         406 $workbook->{ActiveSheet} = $active;
1390             }
1391              
1392             #------------------------------------------------------------------------------
1393             # _subSheetLayout OpenOffice 5.96 (P207)
1394             #------------------------------------------------------------------------------
1395             sub _subSheetLayout {
1396 2     2   7 my ( $workbook, $op, $len, $wk ) = @_;
1397              
1398 2         3 my @unused;
1399             (
1400 2         26 my $rc,
1401             @unused[ 1 .. 10 ],
1402             @unused[ 11 .. 14 ],
1403             my $color, @unused[ 15, 16 ]
1404             ) = unpack( "vC10C4vC2", $wk );
1405              
1406 2 50       9 return unless ( $rc == 0x0862 );
1407              
1408 2         18 $workbook->{Worksheet}[ $workbook->{_CurSheet} ]->{TabColor} = $color;
1409             }
1410              
1411             #------------------------------------------------------------------------------
1412             # _subHyperlink OpenOffice 5.96 (P182)
1413             #
1414             # Also see: http://msdn.microsoft.com/en-us/library/gg615407(v=office.14).aspx
1415             #------------------------------------------------------------------------------
1416              
1417             # Helper: Extract a GID, returns as text string
1418              
1419             sub _getguid {
1420 50     50   106 my( $wk ) = @_;
1421 50         63 my( $text, $guidl, $guids1, $guids2, @guidb );
1422              
1423 50         232 ( $guidl, $guids1, $guids2, @guidb[0..7] ) = unpack( 'Vv2C8', $wk );
1424              
1425 50         311 $text = sprintf( '%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X', $guidl, $guids1, $guids2, @guidb);
1426 50         124 return $text;
1427             }
1428              
1429             # Helper: Extract a counted (16-bit) unicode string, returns string,
1430             # updates $offset
1431             # $zterm == 1 if string is null-terminated.
1432             # $bc if length is in bytes (not chars)
1433              
1434             sub _getustr {
1435 52     52   80 my( $wk, $offset, $zterm, $bc ) = @_;
1436              
1437 52         99 my $len = unpack( 'V', substr( $wk, $offset ) );
1438 52         70 $offset += 4;
1439              
1440 52 100       94 if( $bc ) {
1441 14         21 $len /= 2;
1442             }
1443 52         58 $len -= $zterm;
1444 52         193 my $text = join( '', map { chr $_ } unpack( "v$len", substr( $wk, $offset ) ) );
  1320         2184  
1445 52 50       340 $text =~ s/\0.*\z// if( $zterm );
1446 52         92 $_[1] = ( $offset += ($len + $zterm) *2 );
1447 52         138 return $text;
1448             }
1449              
1450             # HYPERLINK record
1451              
1452             sub _subHyperlink {
1453 28     28   69 my ( $workbook, $op, $len, $wk ) = @_;
1454              
1455             # REF
1456 28         56 my( $srow, $erow, $scol, $ecol ) = unpack( 'v4', $wk );
1457              
1458 28         82 my $guid = _getguid( substr( $wk, 8 ) );
1459 28 50       115 return unless( $guid eq '79EAC9D0-BAF9-11CE-8C82-00AA004BA90B' );
1460              
1461 28         70 my( $stmvers, $flags ) = unpack( 'VV', substr( $wk, 24 ) );
1462 28 50 33     122 return if( $flags & 0x60 || $stmvers != 2 );
1463              
1464 28         31 my $offset = 32;
1465 28         28 my( $desc,$frame, $link, $mark );
1466              
1467 28 50       57 if( ($flags & 0x14) == 0x14 ) {
1468 28         53 $desc = _getustr( $wk, $offset, 1, 0 );
1469             }
1470              
1471 28 50       60 if( $flags & 0x80 ) {
1472 0         0 $frame = _getustr( $wk, $offset, 1, 0 );
1473             }
1474              
1475 28         35 $link = '';
1476 28 100       91 if( $flags & 0x100 ) {
    100          
1477             # UNC path
1478 4         12 $link = 'file:///' . _getustr( $wk, $offset, 1, 0 );
1479             } elsif( $flags & 0x1 ) {
1480             # Has link (URI)
1481 22         54 $guid = _getguid( substr( $wk, $offset ) );
1482 22         41 $offset += 16;
1483 22 100       51 if( $guid eq '79EAC9E0-BAF9-11CE-8C82-00AA004BA90B' ) {
    50          
1484             # URI
1485 14         29 $link = _getustr( $wk, $offset, 1, 1 );
1486             } elsif( $guid eq '00000303-0000-0000-C000-000000000046' ) {
1487             # Local file
1488 8         11 $link = 'file:///';
1489             # !($flags & 2) = 'relative path'
1490 8 100       26 if( !($flags & 0x2) ) {
1491 4         9 my $file = $workbook->{File};
1492 4 50 33     23 if( defined $file && length $file ) {
1493 4         107 $link .= (fileparse($file))[1];
1494             }
1495             else {
1496 0         0 $link .= '%REL%'
1497             }
1498             }
1499 8         21 my $dirn = unpack( 'v', substr( $wk, $offset ) );
1500 8         10 $offset += 2;
1501 8         17 $link .= '..\\' x $dirn;
1502 8         22 my $namelen = unpack( 'V', substr( $wk, $offset ) );
1503 8         11 $offset += 4;
1504 8         23 my $name = unpack( 'Z*', substr( $wk, $offset ) );
1505 8         10 $offset += $namelen;
1506 8         9 $offset += 24;
1507 8         14 my $size = unpack( 'V', substr( $wk, $offset ) );
1508 8         10 $offset += 4;
1509 8 100       19 if( $size ) {
1510 4         22 my $xlen = unpack( 'V', substr( $wk, $offset ) ) / 2;
1511 4         46 $name = join( '', map { chr $_} unpack( "v$xlen", substr( $wk, $offset+4+2) ) );
  76         213  
1512 4         16 $offset += $size;
1513             }
1514 8         18 $link .= $name;
1515             } else {
1516 0         0 return;
1517             }
1518             }
1519              
1520             # Text mark (Fragment identifier)
1521 28 100       66 if( $flags & 0x8 ) {
1522             # Cellrefs contain reserved characters, so url-encode
1523 6         14 my $fragment = _getustr( $wk, $offset, 1 );
1524 6         23 $fragment =~ s/([^\w.~-])/sprintf( '%%%02X', ord( $1 ) )/gems;
  2         18  
1525 6         17 $link .= '#' . $fragment;
1526             }
1527              
1528             # Update loop at end of parse() if this changes
1529              
1530 28         32 push @{ $workbook->{Worksheet}[ $workbook->{_CurSheet} ]->{HyperLinks} }, [
  28         241  
1531             $desc, $link, $frame, $srow, $erow, $scol, $ecol ];
1532             }
1533              
1534             #------------------------------------------------------------------------------
1535             # _subSST (for Spreadsheet::ParseExcel) DK:P413
1536             #------------------------------------------------------------------------------
1537             sub _subSST {
1538 33     33   294 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1539 33         196 _subStrWk( $oBook, substr( $sWk, 8 ) );
1540             }
1541              
1542             #------------------------------------------------------------------------------
1543             # _subContinue (for Spreadsheet::ParseExcel) DK:P311
1544             #------------------------------------------------------------------------------
1545             sub _subContinue {
1546 27     27   68 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1547              
1548             #if(defined $self->{FuncTbl}->{$bOp}) {
1549             # $self->{FuncTbl}->{$PREFUNC}->($oBook, $bOp, $bLen, $sWk);
1550             #}
1551              
1552 27 50       135 _subStrWk( $oBook, $sWk, 1 ) if ( $PREFUNC == 0xFC );
1553             }
1554              
1555             #------------------------------------------------------------------------------
1556             # _subWriteAccess (for Spreadsheet::ParseExcel) DK:P451
1557             #------------------------------------------------------------------------------
1558             sub _subWriteAccess {
1559 42     42   123 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1560 42 50       277 return if ( defined $oBook->{_Author} );
1561              
1562             #BIFF8
1563 42 100       172 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
1564 33         138 $oBook->{Author} = _convBIFF8String( $oBook, $sWk );
1565             }
1566              
1567             #Before BIFF8
1568             else {
1569 9         29 my ( $iLen ) = unpack( "c", $sWk );
1570 9         73 $oBook->{Author} =
1571             $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
1572             }
1573             }
1574              
1575             #------------------------------------------------------------------------------
1576             # _convBIFF8String (for Spreadsheet::ParseExcel)
1577             #------------------------------------------------------------------------------
1578             sub _convBIFF8String {
1579 929     929   3017 my ( $oBook, $sWk, $iCnvFlg ) = @_;
1580 929         2119 my ( $iLen, $iFlg ) = unpack( "vc", $sWk );
1581 929         2737 my ( $iHigh, $iExt, $iRich ) = ( $iFlg & 0x01, $iFlg & 0x04, $iFlg & 0x08 );
1582 929         1216 my ( $iStPos, $iExtCnt, $iRichCnt, $sStr );
1583              
1584             #2. Rich and Ext
1585 929 50 66     3592 if ( $iRich && $iExt ) {
    100          
    100          
1586 0         0 $iStPos = 9;
1587 0         0 ( $iRichCnt, $iExtCnt ) = unpack( 'vV', substr( $sWk, 3, 6 ) );
1588             }
1589             elsif ( $iRich ) { #Only Rich
1590 6         12 $iStPos = 5;
1591 6         14 $iRichCnt = unpack( 'v', substr( $sWk, 3, 2 ) );
1592 6         12 $iExtCnt = 0;
1593             }
1594             elsif ( $iExt ) { #Only Ext
1595 31         42 $iStPos = 7;
1596 31         38 $iRichCnt = 0;
1597 31         76 $iExtCnt = unpack( 'V', substr( $sWk, 3, 4 ) );
1598             }
1599             else { #Nothing Special
1600 892         1032 $iStPos = 3;
1601 892         1288 $iExtCnt = 0;
1602 892         1057 $iRichCnt = 0;
1603             }
1604              
1605             #3.Get String
1606 929 100       1699 if ( $iHigh ) { #Compressed
1607 254         385 $iLen *= 2;
1608 254         5216 $sStr = substr( $sWk, $iStPos, $iLen );
1609 254         606 _SwapForUnicode( \$sStr );
1610 254 100       1512 $sStr = $oBook->{FmtClass}->TextFmt( $sStr, 'ucs2' )
1611             unless ( $iCnvFlg );
1612             }
1613             else { #Not Compressed
1614 675         1602 $sStr = substr( $sWk, $iStPos, $iLen );
1615 675 100       2162 $sStr = $oBook->{FmtClass}->TextFmt( $sStr, undef ) unless ( $iCnvFlg );
1616             }
1617              
1618             #4. return
1619 929 100       2166 if ( wantarray ) {
1620              
1621             #4.1 Get Rich and Ext
1622 524 100       1269 if ( length( $sWk ) < $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt ) {
1623             return (
1624 27         296 [ undef, $iHigh, undef, undef ],
1625             $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt,
1626             $iStPos, $iLen
1627             );
1628             }
1629             else {
1630             return (
1631             [
1632 497         3968 $sStr,
1633             $iHigh,
1634             substr( $sWk, $iStPos + $iLen, $iRichCnt * 4 ),
1635             substr( $sWk, $iStPos + $iLen + $iRichCnt * 4, $iExtCnt )
1636             ],
1637             $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt,
1638             $iStPos, $iLen
1639             );
1640             }
1641             }
1642             else {
1643 405         1166 return $sStr;
1644             }
1645             }
1646              
1647             #------------------------------------------------------------------------------
1648             # _subXF (for Spreadsheet::ParseExcel) DK:P453
1649             #------------------------------------------------------------------------------
1650             sub _subXF {
1651 1065     1065   17771 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1652              
1653 1065         1330 my ( $iFnt, $iIdx );
1654             my (
1655 0         0 $iLock, $iHidden, $iStyle, $i123, $iAlH, $iWrap,
1656             $iAlV, $iJustL, $iRotate, $iInd, $iShrink, $iMerge,
1657             $iReadDir, $iBdrD, $iBdrSL, $iBdrSR, $iBdrST, $iBdrSB,
1658             $iBdrSD, $iBdrCL, $iBdrCR, $iBdrCT, $iBdrCB, $iBdrCD,
1659             $iFillP, $iFillCF, $iFillCB
1660             );
1661              
1662              
1663 1065 50       3988 if ( $oBook->{BIFFVersion} == verBIFF4 ) {
    100          
1664              
1665             # Minimal support for Excel 4. We just get the font and format indices
1666             # so that the cell data value can be formatted.
1667 0         0 ( $iFnt, $iIdx, ) = unpack( "CC", $sWk );
1668             }
1669             elsif ( $oBook->{BIFFVersion} == verBIFF8 ) {
1670 864         877 my ( $iGen, $iAlign, $iGen2, $iBdr1, $iBdr2, $iBdr3, $iPtn );
1671              
1672 864         3041 ( $iFnt, $iIdx, $iGen, $iAlign, $iGen2, $iBdr1, $iBdr2, $iBdr3, $iPtn )
1673             = unpack( "v7Vv", $sWk );
1674 864 100       2086 $iLock = ( $iGen & 0x01 ) ? 1 : 0;
1675 864 50       2033 $iHidden = ( $iGen & 0x02 ) ? 1 : 0;
1676 864 100       1454 $iStyle = ( $iGen & 0x04 ) ? 1 : 0;
1677 864 100       1369 $i123 = ( $iGen & 0x08 ) ? 1 : 0;
1678 864         1000 $iAlH = ( $iAlign & 0x07 );
1679 864 100       1377 $iWrap = ( $iAlign & 0x08 ) ? 1 : 0;
1680 864         1894 $iAlV = ( $iAlign & 0x70 ) / 0x10;
1681 864 50       1413 $iJustL = ( $iAlign & 0x80 ) ? 1 : 0;
1682              
1683 864         1169 $iRotate = ( ( $iAlign & 0xFF00 ) / 0x100 ) & 0x00FF;
1684 864 50       2281 $iRotate = 90 if ( $iRotate == 255 );
1685 864 50       1984 $iRotate = 90 - $iRotate if ( $iRotate > 90 );
1686              
1687 864         1241 $iInd = ( $iGen2 & 0x0F );
1688 864 50       1364 $iShrink = ( $iGen2 & 0x10 ) ? 1 : 0;
1689 864 50       1320 $iMerge = ( $iGen2 & 0x20 ) ? 1 : 0;
1690 864         1430 $iReadDir = ( ( $iGen2 & 0xC0 ) / 0x40 ) & 0x03;
1691 864         1750 $iBdrSL = $iBdr1 & 0x0F;
1692 864         1305 $iBdrSR = ( ( $iBdr1 & 0xF0 ) / 0x10 ) & 0x0F;
1693 864         1097 $iBdrST = ( ( $iBdr1 & 0xF00 ) / 0x100 ) & 0x0F;
1694 864         1243 $iBdrSB = ( ( $iBdr1 & 0xF000 ) / 0x1000 ) & 0x0F;
1695              
1696 864         5662 $iBdrCL = ( ( $iBdr2 & 0x7F ) ) & 0x7F;
1697 864         1244 $iBdrCR = ( ( $iBdr2 & 0x3F80 ) / 0x80 ) & 0x7F;
1698 864         1087 $iBdrD = ( ( $iBdr2 & 0xC000 ) / 0x4000 ) & 0x3;
1699              
1700 864         2097 $iBdrCT = ( ( $iBdr3 & 0x7F ) ) & 0x7F;
1701 864         4292 $iBdrCB = ( ( $iBdr3 & 0x3F80 ) / 0x80 ) & 0x7F;
1702 864         1226 $iBdrCD = ( ( $iBdr3 & 0x1FC000 ) / 0x4000 ) & 0x7F;
1703 864         1222 $iBdrSD = ( ( $iBdr3 & 0x1E00000 ) / 0x200000 ) & 0xF;
1704 864         1170 $iFillP = ( ( $iBdr3 & 0xFC000000 ) / 0x4000000 ) & 0x3F;
1705              
1706 864         1206 $iFillCF = ( $iPtn & 0x7F );
1707 864         1541 $iFillCB = ( ( $iPtn & 0x3F80 ) / 0x80 ) & 0x7F;
1708             }
1709             else {
1710 201         222 my ( $iGen, $iAlign, $iPtn, $iPtn2, $iBdr1, $iBdr2 );
1711              
1712 201         734 ( $iFnt, $iIdx, $iGen, $iAlign, $iPtn, $iPtn2, $iBdr1, $iBdr2 ) =
1713             unpack( "v8", $sWk );
1714 201 50       410 $iLock = ( $iGen & 0x01 ) ? 1 : 0;
1715 201 50       334 $iHidden = ( $iGen & 0x02 ) ? 1 : 0;
1716 201 100       435 $iStyle = ( $iGen & 0x04 ) ? 1 : 0;
1717 201 50       315 $i123 = ( $iGen & 0x08 ) ? 1 : 0;
1718              
1719 201         315 $iAlH = ( $iAlign & 0x07 );
1720 201 50       375 $iWrap = ( $iAlign & 0x08 ) ? 1 : 0;
1721 201         252 $iAlV = ( $iAlign & 0x70 ) / 0x10;
1722 201 50       312 $iJustL = ( $iAlign & 0x80 ) ? 1 : 0;
1723              
1724 201         289 $iRotate = ( ( $iAlign & 0x300 ) / 0x100 ) & 0x3;
1725              
1726 201         270 $iFillCF = ( $iPtn & 0x7F );
1727 201         250 $iFillCB = ( ( $iPtn & 0x1F80 ) / 0x80 ) & 0x7F;
1728              
1729 201         217 $iFillP = ( $iPtn2 & 0x3F );
1730 201         237 $iBdrSB = ( ( $iPtn2 & 0x1C0 ) / 0x40 ) & 0x7;
1731 201         237 $iBdrCB = ( ( $iPtn2 & 0xFE00 ) / 0x200 ) & 0x7F;
1732              
1733 201         240 $iBdrST = ( $iBdr1 & 0x07 );
1734 201         400 $iBdrSL = ( ( $iBdr1 & 0x38 ) / 0x8 ) & 0x07;
1735 201         250 $iBdrSR = ( ( $iBdr1 & 0x1C0 ) / 0x40 ) & 0x07;
1736 201         222 $iBdrCT = ( ( $iBdr1 & 0xFE00 ) / 0x200 ) & 0x7F;
1737              
1738 201         221 $iBdrCL = ( $iBdr2 & 0x7F ) & 0x7F;
1739 201         330 $iBdrCR = ( ( $iBdr2 & 0x3F80 ) / 0x80 ) & 0x7F;
1740             }
1741              
1742 1065         1187 push @{ $oBook->{Format} }, Spreadsheet::ParseExcel::Format->new(
  1065         16446  
1743             FontNo => $iFnt,
1744             Font => $oBook->{Font}[$iFnt],
1745             FmtIdx => $iIdx,
1746              
1747             Lock => $iLock,
1748             Hidden => $iHidden,
1749             Style => $iStyle,
1750             Key123 => $i123,
1751             AlignH => $iAlH,
1752             Wrap => $iWrap,
1753             AlignV => $iAlV,
1754             JustLast => $iJustL,
1755             Rotate => $iRotate,
1756              
1757             Indent => $iInd,
1758             Shrink => $iShrink,
1759             Merge => $iMerge,
1760             ReadDir => $iReadDir,
1761              
1762             BdrStyle => [ $iBdrSL, $iBdrSR, $iBdrST, $iBdrSB ],
1763             BdrColor => [ $iBdrCL, $iBdrCR, $iBdrCT, $iBdrCB ],
1764             BdrDiag => [ $iBdrD, $iBdrSD, $iBdrCD ],
1765             Fill => [ $iFillP, $iFillCF, $iFillCB ],
1766             );
1767             }
1768              
1769             #------------------------------------------------------------------------------
1770             # _subFormat (for Spreadsheet::ParseExcel) DK: P336
1771             #------------------------------------------------------------------------------
1772             sub _subFormat {
1773              
1774 465     465   987 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1775 465         541 my $sFmt;
1776              
1777 465 100       1224 if ( $oBook->{BIFFVersion} <= verBIFF5 ) {
1778 117         305 $sFmt = substr( $sWk, 3, unpack( 'c', substr( $sWk, 2, 1 ) ) );
1779 117         527 $sFmt = $oBook->{FmtClass}->TextFmt( $sFmt, '_native_' );
1780             }
1781             else {
1782 348         936 $sFmt = _convBIFF8String( $oBook, substr( $sWk, 2 ) );
1783             }
1784              
1785 465         1250 my $format_index = unpack( 'v', substr( $sWk, 0, 2 ) );
1786              
1787             # Excel 4 and earlier used an index of 0 to indicate that a built-in format
1788             # that was stored implicitly.
1789 465 50 33     1817 if ( $oBook->{BIFFVersion} <= verBIFF4 && $format_index == 0 ) {
1790 0         0 $format_index = keys %{ $oBook->{FormatStr} };
  0         0  
1791             }
1792              
1793 465         1856 $oBook->{FormatStr}->{$format_index} = $sFmt;
1794             }
1795              
1796             #------------------------------------------------------------------------------
1797             # _subPalette (for Spreadsheet::ParseExcel) DK: P393
1798             #------------------------------------------------------------------------------
1799             sub _subPalette {
1800 9     9   32 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1801 9         49 for ( my $i = 0 ; $i < unpack( 'v', $sWk ) ; $i++ ) {
1802              
1803             # push @aColor, unpack('H6', substr($sWk, $i*4+2));
1804 504         2378 $oBook->{aColor}[ $i + 8 ] = unpack( 'H6', substr( $sWk, $i * 4 + 2 ) );
1805             }
1806             }
1807              
1808             #------------------------------------------------------------------------------
1809             # _subFont (for Spreadsheet::ParseExcel) DK:P333
1810             #------------------------------------------------------------------------------
1811             sub _subFont {
1812 236     236   469 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1813 236         308 my ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline, $sFntName );
1814 0         0 my ( $bBold, $bItalic, $bUnderline, $bStrikeout );
1815              
1816 236 100       610 if ( $oBook->{BIFFVersion} == verBIFF8 ) {
    50          
1817 191         507 ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline ) =
1818             unpack( "v5c", $sWk );
1819 191         569 my ( $iSize, $iHigh ) = unpack( 'cc', substr( $sWk, 14, 2 ) );
1820 191 50       559 if ( $iHigh ) {
1821 191         590 $sFntName = substr( $sWk, 16, $iSize * 2 );
1822 191         508 _SwapForUnicode( \$sFntName );
1823 191         932 $sFntName = $oBook->{FmtClass}->TextFmt( $sFntName, 'ucs2' );
1824             }
1825             else {
1826 0         0 $sFntName = substr( $sWk, 16, $iSize );
1827 0         0 $sFntName = $oBook->{FmtClass}->TextFmt( $sFntName, '_native_' );
1828             }
1829 191 100       610 $bBold = ( $iBold >= 0x2BC ) ? 1 : 0;
1830 191 100       585 $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
1831 191 50       418 $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
1832 191 100       424 $bUnderline = ( $iUnderline ) ? 1 : 0;
1833             }
1834             elsif ( $oBook->{BIFFVersion} == verBIFF5 ) {
1835 45         124 ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline ) =
1836             unpack( "v5c", $sWk );
1837 45         240 $sFntName =
1838             $oBook->{FmtClass}
1839             ->TextFmt( substr( $sWk, 15, unpack( "c", substr( $sWk, 14, 1 ) ) ),
1840             '_native_' );
1841 45 50       126 $bBold = ( $iBold >= 0x2BC ) ? 1 : 0;
1842 45 50       94 $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
1843 45 50       80 $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
1844 45 50       92 $bUnderline = ( $iUnderline ) ? 1 : 0;
1845             }
1846             else {
1847 0         0 ( $iHeight, $iAttr ) = unpack( "v2", $sWk );
1848 0         0 $iCIdx = undef;
1849 0         0 $iSuper = 0;
1850              
1851 0 0       0 $bBold = ( $iAttr & 0x01 ) ? 1 : 0;
1852 0 0       0 $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
1853 0 0       0 $bUnderline = ( $iAttr & 0x04 ) ? 1 : 0;
1854 0 0       0 $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
1855              
1856 0         0 $sFntName = substr( $sWk, 5, unpack( "c", substr( $sWk, 4, 1 ) ) );
1857             }
1858 236         288 push @{ $oBook->{Font} }, Spreadsheet::ParseExcel::Font->new(
  236         1707  
1859             Height => $iHeight / 20.0,
1860             Attr => $iAttr,
1861             Color => $iCIdx,
1862             Super => $iSuper,
1863             UnderlineStyle => $iUnderline,
1864             Name => $sFntName,
1865              
1866             Bold => $bBold,
1867             Italic => $bItalic,
1868             Underline => $bUnderline,
1869             Strikeout => $bStrikeout,
1870             );
1871              
1872             #Skip Font[4]
1873 236 100       344 push @{ $oBook->{Font} }, {} if ( scalar( @{ $oBook->{Font} } ) == 4 );
  42         184  
  236         881  
1874              
1875             }
1876              
1877             #------------------------------------------------------------------------------
1878             # _subBoundSheet (for Spreadsheet::ParseExcel): DK: P307
1879             #------------------------------------------------------------------------------
1880             sub _subBoundSheet {
1881 91     91   287 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1882 91         273 my ( $iPos, $iGr, $iKind ) = unpack( "Lc2", $sWk );
1883 91         145 $iKind &= 0x0F;
1884 91 100 66     325 return if ( ( $iKind != 0x00 ) && ( $iKind != 0x01 ) );
1885              
1886 87 100       276 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
1887 69         197 my ( $iSize, $iUni ) = unpack( "cc", substr( $sWk, 6, 2 ) );
1888 69         169 my $sWsName = substr( $sWk, 8 );
1889 69 100       198 if ( $iUni & 0x01 ) {
1890 8         31 _SwapForUnicode( \$sWsName );
1891 8         49 $sWsName = $oBook->{FmtClass}->TextFmt( $sWsName, 'ucs2' );
1892             }
1893 69         628 $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
1894             Spreadsheet::ParseExcel::Worksheet->new(
1895             Name => $sWsName,
1896             Kind => $iKind,
1897             _Pos => $iPos,
1898             _Book => $oBook,
1899             _SheetNo => $oBook->{SheetCount},
1900             SheetHidden => $iGr & 0x03
1901             );
1902             }
1903             else {
1904 18         118 $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
1905             Spreadsheet::ParseExcel::Worksheet->new(
1906             Name =>
1907             $oBook->{FmtClass}->TextFmt( substr( $sWk, 7 ), '_native_' ),
1908             Kind => $iKind,
1909             _Pos => $iPos,
1910             _Book => $oBook,
1911             _SheetNo => $oBook->{SheetCount},
1912             SheetHidden => $iGr & 0x03
1913             );
1914             }
1915 87         331 $oBook->{SheetCount}++;
1916             }
1917              
1918             #------------------------------------------------------------------------------
1919             # _subHeader (for Spreadsheet::ParseExcel) DK: P340
1920             #------------------------------------------------------------------------------
1921             sub _subHeader {
1922 87     87   207 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1923 87 50       453 return undef unless ( defined $oBook->{_CurSheet} );
1924 87         156 my $sW;
1925              
1926 87 100       386 if ( !defined $sWk ) {
1927 75         249 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} = undef;
1928 75         184 return;
1929             }
1930              
1931             #BIFF8
1932 12 50       54 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
1933 12         46 $sW = _convBIFF8String( $oBook, $sWk );
1934 12 50       74 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} =
1935             ( $sW eq "\x00" ) ? undef : $sW;
1936             }
1937              
1938             #Before BIFF8
1939             else {
1940 0         0 my ( $iLen ) = unpack( "c", $sWk );
1941 0         0 $sW =
1942             $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
1943 0 0       0 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} =
1944             ( $sW eq "\x00\x00\x00" ) ? undef : $sW;
1945             }
1946             }
1947              
1948             #------------------------------------------------------------------------------
1949             # _subFooter (for Spreadsheet::ParseExcel) DK: P335
1950             #------------------------------------------------------------------------------
1951             sub _subFooter {
1952 87     87   204 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1953 87 50       295 return undef unless ( defined $oBook->{_CurSheet} );
1954 87         118 my $sW;
1955              
1956 87 100       351 if ( !defined $sWk ) {
1957 75         528 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} = undef;
1958 75         163 return;
1959             }
1960              
1961             #BIFF8
1962 12 50       59 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
1963 12         30 $sW = _convBIFF8String( $oBook, $sWk );
1964 12 50       88 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} =
1965             ( $sW eq "\x00" ) ? undef : $sW;
1966             }
1967              
1968             #Before BIFF8
1969             else {
1970 0         0 my ( $iLen ) = unpack( "c", $sWk );
1971 0         0 $sW =
1972             $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
1973 0 0       0 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} =
1974             ( $sW eq "\x00\x00\x00" ) ? undef : $sW;
1975             }
1976             }
1977              
1978             #------------------------------------------------------------------------------
1979             # _subHPageBreak (for Spreadsheet::ParseExcel) DK: P341
1980             #------------------------------------------------------------------------------
1981             sub _subHPageBreak {
1982 6     6   16 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
1983 6         10 my @aBreak;
1984 6         13 my $iCnt = unpack( "v", $sWk );
1985              
1986 6 50       29 return undef unless ( defined $oBook->{_CurSheet} );
1987              
1988             #BIFF8
1989 6 50       19 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
1990 6         25 for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
1991 12         54 my ( $iRow, $iColB, $iColE ) =
1992             unpack( 'v3', substr( $sWk, 2 + $i * 6, 6 ) );
1993              
1994             # push @aBreak, [$iRow, $iColB, $iColE];
1995 12         38 push @aBreak, $iRow;
1996             }
1997             }
1998              
1999             #Before BIFF8
2000             else {
2001 0         0 for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
2002 0         0 my ( $iRow ) = unpack( 'v', substr( $sWk, 2 + $i * 2, 2 ) );
2003 0         0 push @aBreak, $iRow;
2004              
2005             # push @aBreak, [$iRow, 0, 255];
2006             }
2007             }
2008 6         44 @aBreak = sort { $a <=> $b } @aBreak;
  6         22  
2009 6         26 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{HPageBreak} = \@aBreak;
2010             }
2011              
2012             #------------------------------------------------------------------------------
2013             # _subVPageBreak (for Spreadsheet::ParseExcel) DK: P447
2014             #------------------------------------------------------------------------------
2015             sub _subVPageBreak {
2016 6     6   18 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2017 6 50       29 return undef unless ( defined $oBook->{_CurSheet} );
2018              
2019 6         8 my @aBreak;
2020 6         15 my $iCnt = unpack( "v", $sWk );
2021              
2022             #BIFF8
2023 6 50       59 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
2024 6         24 for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
2025 6         25 my ( $iCol, $iRowB, $iRowE ) =
2026             unpack( 'v3', substr( $sWk, 2 + $i * 6, 6 ) );
2027 6         34 push @aBreak, $iCol;
2028              
2029             # push @aBreak, [$iCol, $iRowB, $iRowE];
2030             }
2031             }
2032              
2033             #Before BIFF8
2034             else {
2035 0         0 for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
2036 0         0 my ( $iCol ) = unpack( 'v', substr( $sWk, 2 + $i * 2, 2 ) );
2037 0         0 push @aBreak, $iCol;
2038              
2039             # push @aBreak, [$iCol, 0, 65535];
2040             }
2041             }
2042 6         12 @aBreak = sort { $a <=> $b } @aBreak;
  0         0  
2043 6         59 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{VPageBreak} = \@aBreak;
2044             }
2045              
2046             #------------------------------------------------------------------------------
2047             # _subMargin (for Spreadsheet::ParseExcel) DK: P306, 345, 400, 440
2048             #------------------------------------------------------------------------------
2049             sub _subMargin {
2050 48     48   96 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2051 48 50       122 return undef unless ( defined $oBook->{_CurSheet} );
2052              
2053             # The "Mergin" options are a workaround for a backward compatible typo.
2054              
2055 48         130 my $dWk = _convDval( substr( $sWk, 0, 8 ) );
2056 48 100       205 if ( $bOp == 0x26 ) {
    100          
    100          
    50          
2057 12         40 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{LeftMergin} = $dWk;
2058 12         49 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{LeftMargin} = $dWk;
2059             }
2060             elsif ( $bOp == 0x27 ) {
2061 12         96 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RightMergin} = $dWk;
2062 12         44 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RightMargin} = $dWk;
2063             }
2064             elsif ( $bOp == 0x28 ) {
2065 12         35 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{TopMergin} = $dWk;
2066 12         49 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{TopMargin} = $dWk;
2067             }
2068             elsif ( $bOp == 0x29 ) {
2069 12         47 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{BottomMergin} = $dWk;
2070 12         43 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{BottomMargin} = $dWk;
2071             }
2072             }
2073              
2074             #------------------------------------------------------------------------------
2075             # _subHcenter (for Spreadsheet::ParseExcel) DK: P340
2076             #------------------------------------------------------------------------------
2077             sub _subHcenter {
2078 87     87   226 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2079 87 50       506 return undef unless ( defined $oBook->{_CurSheet} );
2080              
2081 87         180 my $iWk = unpack( "v", $sWk );
2082 87         339 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{HCenter} = $iWk;
2083              
2084             }
2085              
2086             #------------------------------------------------------------------------------
2087             # _subVcenter (for Spreadsheet::ParseExcel) DK: P447
2088             #------------------------------------------------------------------------------
2089             sub _subVcenter {
2090 87     87   190 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2091 87 50       282 return undef unless ( defined $oBook->{_CurSheet} );
2092              
2093 87         191 my $iWk = unpack( "v", $sWk );
2094 87         299 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{VCenter} = $iWk;
2095             }
2096              
2097             #------------------------------------------------------------------------------
2098             # _subPrintGridlines (for Spreadsheet::ParseExcel) DK: P397
2099             #------------------------------------------------------------------------------
2100             sub _subPrintGridlines {
2101 87     87   214 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2102 87 50       378 return undef unless ( defined $oBook->{_CurSheet} );
2103              
2104 87         198 my $iWk = unpack( "v", $sWk );
2105 87         319 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PrintGrid} = $iWk;
2106              
2107             }
2108              
2109             #------------------------------------------------------------------------------
2110             # _subPrintHeaders (for Spreadsheet::ParseExcel) DK: P397
2111             #------------------------------------------------------------------------------
2112             sub _subPrintHeaders {
2113 87     87   221 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2114 87 50       315 return undef unless ( defined $oBook->{_CurSheet} );
2115              
2116 87         197 my $iWk = unpack( "v", $sWk );
2117 87         562 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PrintHeaders} = $iWk;
2118             }
2119              
2120             #------------------------------------------------------------------------------
2121             # _subSETUP (for Spreadsheet::ParseExcel) DK: P409
2122             #------------------------------------------------------------------------------
2123             sub _subSETUP {
2124 87     87   208 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2125 87 50       309 return undef unless ( defined $oBook->{_CurSheet} );
2126              
2127             # Workaround for some apps and older Excels that don't write a
2128             # complete SETUP record.
2129 87 50       366 return undef if $bLen != 34;
2130              
2131 87         208 my $oWkS = $oBook->{Worksheet}[ $oBook->{_CurSheet} ];
2132 87         119 my $iGrBit;
2133              
2134             (
2135 87         798 $oWkS->{PaperSize}, $oWkS->{Scale}, $oWkS->{PageStart},
2136             $oWkS->{FitWidth}, $oWkS->{FitHeight}, $iGrBit,
2137             $oWkS->{Res}, $oWkS->{VRes},
2138             ) = unpack( 'v8', $sWk );
2139              
2140 87         446 $oWkS->{HeaderMargin} = _convDval( substr( $sWk, 16, 8 ) );
2141 87         333 $oWkS->{FooterMargin} = _convDval( substr( $sWk, 24, 8 ) );
2142 87         324 $oWkS->{Copis} = unpack( 'v2', substr( $sWk, 32, 2 ) );
2143 87 100       358 $oWkS->{LeftToRight} = ( ( $iGrBit & 0x01 ) ? 1 : 0 );
2144 87 100       303 $oWkS->{Landscape} = ( ( $iGrBit & 0x02 ) ? 1 : 0 );
2145 87 100       349 $oWkS->{NoPls} = ( ( $iGrBit & 0x04 ) ? 1 : 0 );
2146 87 100       514 $oWkS->{NoColor} = ( ( $iGrBit & 0x08 ) ? 1 : 0 );
2147 87 100       295 $oWkS->{Draft} = ( ( $iGrBit & 0x10 ) ? 1 : 0 );
2148 87 100       278 $oWkS->{Notes} = ( ( $iGrBit & 0x20 ) ? 1 : 0 );
2149 87 100       291 $oWkS->{NoOrient} = ( ( $iGrBit & 0x40 ) ? 1 : 0 );
2150 87 100       370 $oWkS->{UsePage} = ( ( $iGrBit & 0x80 ) ? 1 : 0 );
2151              
2152             # The NoPls flag indicates that the values have not been taken from an
2153             # actual printer and thus may not be accurate.
2154              
2155             # Set default scale if NoPls otherwise it may be an invalid value of 0XFF.
2156 87 100       331 $oWkS->{Scale} = 100 if $oWkS->{NoPls};
2157              
2158             # Workaround for a backward compatible typo.
2159 87         234 $oWkS->{HeaderMergin} = $oWkS->{HeaderMargin};
2160 87         1352 $oWkS->{FooterMergin} = $oWkS->{FooterMargin};
2161              
2162             }
2163              
2164             #------------------------------------------------------------------------------
2165             # _subName (for Spreadsheet::ParseExcel) DK: P350
2166             #------------------------------------------------------------------------------
2167             sub _subName {
2168 24     24   54 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2169             my (
2170 24         91 $iGrBit, $cKey, $cCh, $iCce, $ixAls,
2171             $iTab, $cchCust, $cchDsc, $cchHep, $cchStatus
2172             ) = unpack( 'vc2v3c4', $sWk );
2173              
2174             #Builtin Name + Length == 1
2175 24 50 33     286 if ( ( $iGrBit & 0x20 ) && ( $cCh == 1 ) ) {
2176              
2177             #BIFF8
2178 24 50       59 if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
2179 24         50 my $iName = unpack( 'n', substr( $sWk, 14 ) );
2180 24         56 my $iSheet = unpack( 'v', substr( $sWk, 8 ) ) - 1;
2181              
2182             # Workaround for mal-formed Excel workbooks where Print_Title is
2183             # set as Global (i.e. itab = 0). Note, this will have to be
2184             # treated differently when we get around to handling global names.
2185 24 50       57 return undef if $iSheet == -1;
2186              
2187 24 100       69 if ( $iName == 6 ) { #PrintArea
    50          
2188 12         45 my ( $iSheetW, $raArea ) = _ParseNameArea( substr( $sWk, 16 ) );
2189 12         129 $oBook->{PrintArea}[$iSheet] = $raArea;
2190             }
2191             elsif ( $iName == 7 ) { #Title
2192 12         32 my ( $iSheetW, $raArea ) = _ParseNameArea( substr( $sWk, 16 ) );
2193 12         29 my @aTtlR = ();
2194 12         14 my @aTtlC = ();
2195 12         28 foreach my $raI ( @$raArea ) {
2196 18 100       39 if ( $raI->[3] == 0xFF ) { #Row Title
2197 6         24 push @aTtlR, [ $raI->[0], $raI->[2] ];
2198             }
2199             else { #Col Title
2200 12         38 push @aTtlC, [ $raI->[1], $raI->[3] ];
2201             }
2202             }
2203 12         86 $oBook->{PrintTitle}[$iSheet] =
2204             { Row => \@aTtlR, Column => \@aTtlC };
2205             }
2206             }
2207             else {
2208 0         0 my $iName = unpack( 'c', substr( $sWk, 14 ) );
2209 0 0       0 if ( $iName == 6 ) { #PrintArea
    0          
2210 0         0 my ( $iSheet, $raArea ) =
2211             _ParseNameArea95( substr( $sWk, 15 ) );
2212 0         0 $oBook->{PrintArea}[$iSheet] = $raArea;
2213             }
2214             elsif ( $iName == 7 ) { #Title
2215 0         0 my ( $iSheet, $raArea ) =
2216             _ParseNameArea95( substr( $sWk, 15 ) );
2217 0         0 my @aTtlR = ();
2218 0         0 my @aTtlC = ();
2219 0         0 foreach my $raI ( @$raArea ) {
2220 0 0       0 if ( $raI->[3] == 0xFF ) { #Row Title
2221 0         0 push @aTtlR, [ $raI->[0], $raI->[2] ];
2222             }
2223             else { #Col Title
2224 0         0 push @aTtlC, [ $raI->[1], $raI->[3] ];
2225             }
2226             }
2227 0         0 $oBook->{PrintTitle}[$iSheet] =
2228             { Row => \@aTtlR, Column => \@aTtlC };
2229             }
2230             }
2231             }
2232             }
2233              
2234             #------------------------------------------------------------------------------
2235             # ParseNameArea (for Spreadsheet::ParseExcel) DK: 494 (ptgAread3d)
2236             #------------------------------------------------------------------------------
2237             sub _ParseNameArea {
2238 24     24   58 my ( $sObj ) = @_;
2239 24         20 my ( $iOp );
2240 24         39 my @aRes = ();
2241 24         43 $iOp = unpack( 'C', $sObj );
2242 24         27 my $iSheet;
2243 24 100       70 if ( $iOp == 0x3b ) {
    50          
2244 12         32 my ( $iWkS, $iRs, $iRe, $iCs, $iCe ) =
2245             unpack( 'v5', substr( $sObj, 1 ) );
2246 12         19 $iSheet = $iWkS;
2247 12         32 push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
2248             }
2249             elsif ( $iOp == 0x29 ) {
2250 12         26 my $iLen = unpack( 'v', substr( $sObj, 1, 2 ) );
2251 12         17 my $iSt = 0;
2252 12         28 while ( $iSt < $iLen ) {
2253 24         68 my ( $iOpW, $iWkS, $iRs, $iRe, $iCs, $iCe ) =
2254             unpack( 'cv5', substr( $sObj, $iSt + 3, 11 ) );
2255              
2256 24 50       55 if ( $iOpW == 0x3b ) {
2257 24         23 $iSheet = $iWkS;
2258 24         48 push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
2259             }
2260              
2261 24 100       646 if ( $iSt == 0 ) {
2262 12         29 $iSt += 11;
2263             }
2264             else {
2265 12         34 $iSt += 12; #Skip 1 byte;
2266             }
2267             }
2268             }
2269 24         406 return ( $iSheet, \@aRes );
2270             }
2271              
2272             #------------------------------------------------------------------------------
2273             # ParseNameArea95 (for Spreadsheet::ParseExcel) DK: 494 (ptgAread3d)
2274             #------------------------------------------------------------------------------
2275             sub _ParseNameArea95 {
2276 0     0   0 my ( $sObj ) = @_;
2277 0         0 my ( $iOp );
2278 0         0 my @aRes = ();
2279 0         0 $iOp = unpack( 'C', $sObj );
2280 0         0 my $iSheet;
2281 0 0       0 if ( $iOp == 0x3b ) {
    0          
2282 0         0 $iSheet = unpack( 'v', substr( $sObj, 11, 2 ) );
2283 0         0 my ( $iRs, $iRe, $iCs, $iCe ) =
2284             unpack( 'v2C2', substr( $sObj, 15, 6 ) );
2285 0         0 push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
2286             }
2287             elsif ( $iOp == 0x29 ) {
2288 0         0 my $iLen = unpack( 'v', substr( $sObj, 1, 2 ) );
2289 0         0 my $iSt = 0;
2290 0         0 while ( $iSt < $iLen ) {
2291 0         0 my $iOpW = unpack( 'c', substr( $sObj, $iSt + 3, 6 ) );
2292 0         0 $iSheet = unpack( 'v', substr( $sObj, $iSt + 14, 2 ) );
2293 0         0 my ( $iRs, $iRe, $iCs, $iCe ) =
2294             unpack( 'v2C2', substr( $sObj, $iSt + 18, 6 ) );
2295 0 0       0 push @aRes, [ $iRs, $iCs, $iRe, $iCe ] if ( $iOpW == 0x3b );
2296              
2297 0 0       0 if ( $iSt == 0 ) {
2298 0         0 $iSt += 21;
2299             }
2300             else {
2301 0         0 $iSt += 22; #Skip 1 byte;
2302             }
2303             }
2304             }
2305 0         0 return ( $iSheet, \@aRes );
2306             }
2307              
2308             #------------------------------------------------------------------------------
2309             # _subBOOL (for Spreadsheet::ParseExcel) DK: P452
2310             #------------------------------------------------------------------------------
2311             sub _subWSBOOL {
2312 87     87   218 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2313 87 50       300 return undef unless ( defined $oBook->{_CurSheet} );
2314              
2315 87 100       469 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PageFit} =
2316             ( ( unpack( 'v', $sWk ) & 0x100 ) ? 1 : 0 );
2317             }
2318              
2319             #------------------------------------------------------------------------------
2320             # _subMergeArea (for Spreadsheet::ParseExcel) DK: (Not)
2321             #------------------------------------------------------------------------------
2322             sub _subMergeArea {
2323 18     18   57 my ( $oBook, $bOp, $bLen, $sWk ) = @_;
2324 18 50       76 return undef unless ( defined $oBook->{_CurSheet} );
2325              
2326 18         51 my $iCnt = unpack( "v", $sWk );
2327 18         49 my $oWkS = $oBook->{Worksheet}[ $oBook->{_CurSheet} ];
2328 18 50       136 $oWkS->{MergedArea} = [] unless ( defined $oWkS->{MergedArea} );
2329 18         76 for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
2330 18         83 my ( $iRs, $iRe, $iCs, $iCe ) =
2331             unpack( 'v4', substr( $sWk, $i * 8 + 2, 8 ) );
2332 18         67 for ( my $iR = $iRs ; $iR <= $iRe ; $iR++ ) {
2333 24         83 for ( my $iC = $iCs ; $iC <= $iCe ; $iC++ ) {
2334 75 100       403 $oWkS->{Cells}[$iR][$iC]->{Merged} = 1
2335             if ( defined $oWkS->{Cells}[$iR][$iC] );
2336             }
2337             }
2338 18         31 push @{ $oWkS->{MergedArea} }, [ $iRs, $iCs, $iRe, $iCe ];
  18         107  
2339             }
2340             }
2341              
2342             #------------------------------------------------------------------------------
2343             # DecodeBoolErr (for Spreadsheet::ParseExcel) DK: P306
2344             #------------------------------------------------------------------------------
2345             sub DecodeBoolErr {
2346 0     0 0 0 my ( $iVal, $iFlg ) = @_;
2347 0 0       0 if ( $iFlg ) { # ERROR
2348 0 0       0 if ( $iVal == 0x00 ) {
    0          
    0          
    0          
    0          
    0          
    0          
2349 0         0 return "#NULL!";
2350             }
2351             elsif ( $iVal == 0x07 ) {
2352 0         0 return "#DIV/0!";
2353             }
2354             elsif ( $iVal == 0x0F ) {
2355 0         0 return "#VALUE!";
2356             }
2357             elsif ( $iVal == 0x17 ) {
2358 0         0 return "#REF!";
2359             }
2360             elsif ( $iVal == 0x1D ) {
2361 0         0 return "#NAME?";
2362             }
2363             elsif ( $iVal == 0x24 ) {
2364 0         0 return "#NUM!";
2365             }
2366             elsif ( $iVal == 0x2A ) {
2367 0         0 return "#N/A!";
2368             }
2369             else {
2370 0         0 return "#ERR";
2371             }
2372             }
2373             else {
2374 0 0       0 return ( $iVal ) ? "TRUE" : "FALSE";
2375             }
2376             }
2377              
2378             ###############################################################################
2379             #
2380             # _decode_rk_number()
2381             #
2382             # Convert an encoded RK number into a real number. The RK encoding is
2383             # explained in some detail in the MS docs. It is a way of storing applicable
2384             # ints and doubles in 32bits (30 data + 2 info bits) in order to save space.
2385             #
2386             sub _decode_rk_number {
2387              
2388 506     506   75510 my $rk_number = shift;
2389 506         542 my $number;
2390              
2391             # Check the main RK type.
2392 506 100       1065 if ( $rk_number & 0x02 ) {
2393              
2394             # RK Type 2 and 4, a packed integer.
2395              
2396             # Shift off the info bits.
2397 75         120 $number = $rk_number >> 2;
2398              
2399             # Convert from unsigned to signed if required.
2400 75 100       200 $number -= 0x40000000 if $number & 0x20000000;
2401             }
2402             else {
2403              
2404             # RK Type 1 and 3, a truncated IEEE Double.
2405              
2406             # Pack the RK number into the high 30 bits of an IEEE double.
2407 431         1415 $number = pack "VV", 0x0000, $rk_number & 0xFFFFFFFC;
2408              
2409             # Reverse the packed IEEE double on big-endian machines.
2410 431 50       945 $number = reverse $number if $BIGENDIAN;
2411              
2412             # Unpack the number.
2413 431         931 $number = unpack "d", $number;
2414             }
2415              
2416             # RK Types 3 and 4 were multiplied by 100 prior to encoding.
2417 506 100       1151 $number /= 100 if $rk_number & 0x01;
2418              
2419 506         982 return $number;
2420             }
2421              
2422             ###############################################################################
2423             #
2424             # _subStrWk()
2425             #
2426             # Extract the workbook strings from the SST (Shared String Table) record and
2427             # any following CONTINUE records.
2428             #
2429             # The workbook strings are initially contained in the SST block but may also
2430             # occupy one or more CONTINUE blocks. Reading the CONTINUE blocks is made a
2431             # little tricky by the fact that they can contain an additional initial byte
2432             # if a string is continued from a previous block.
2433             #
2434             # Parsing is further complicated by the fact that the continued section of the
2435             # string may have a different encoding (ASCII or UTF-8) from the previous
2436             # section. Excel does this to save space.
2437             #
2438             sub _subStrWk {
2439              
2440 60     60   236 my ( $self, $biff_data, $is_continue ) = @_;
2441              
2442 60 100       175 if ( $is_continue ) {
2443              
2444             # We are reading a CONTINUE record.
2445              
2446 27 50       141 if ( $self->{_buffer} eq '' ) {
    50          
2447              
2448             # A CONTINUE block with no previous SST.
2449 0         0 $self->{_buffer} .= $biff_data;
2450             }
2451             elsif ( !defined $self->{_string_continued} ) {
2452              
2453             # The CONTINUE block starts with a new (non-continued) string.
2454              
2455             # Strip the Grbit byte and store the string data.
2456 0         0 $self->{_buffer} .= substr $biff_data, 1;
2457             }
2458             else {
2459              
2460             # A CONTINUE block that starts with a continued string.
2461              
2462             # The first byte (Grbit) of the CONTINUE record indicates if (0)
2463             # the continued string section is single bytes or (1) double bytes.
2464 27         67 my $grbit = ord $biff_data;
2465              
2466 27         68 my ( $str_position, $str_length ) = @{ $self->{_previous_info} };
  27         73  
2467 27         47 my $buff_length = length $self->{_buffer};
2468              
2469 27 50       126 if ( $buff_length >= ( $str_position + $str_length ) ) {
    100          
2470              
2471             # Not in a string.
2472 0         0 $self->{_buffer} .= $biff_data;
2473             }
2474             elsif ( ( $self->{_string_continued} & 0x01 ) == ( $grbit & 0x01 ) )
2475             {
2476              
2477             # Same encoding as the previous block of the string.
2478 10         295 $self->{_buffer} .= substr( $biff_data, 1 );
2479             }
2480             else {
2481              
2482             # Different encoding to the previous block of the string.
2483 17 100       48 if ( $grbit & 0x01 ) {
2484              
2485             # Current block is UTF-16, previous was ASCII.
2486 4         102 my ( undef, $cch ) = unpack 'vc', $self->{_buffer};
2487 4         27 substr( $self->{_buffer}, 2, 1 ) = pack( 'C', $cch | 0x01 );
2488              
2489             # Convert the previous ASCII, single character, portion of
2490             # the string into a double character UTF-16 string by
2491             # inserting zero bytes.
2492 4         20 for (
2493             my $i = ( $buff_length - $str_position ) ;
2494             $i >= 1 ;
2495             $i--
2496             )
2497             {
2498 57305         1643123 substr( $self->{_buffer}, $str_position + $i, 0 ) =
2499             "\x00";
2500             }
2501              
2502             }
2503             else {
2504              
2505             # Current block is ASCII, previous was UTF-16.
2506              
2507             # Convert the current ASCII, single character, portion of
2508             # the string into a double character UTF-16 string by
2509             # inserting null bytes.
2510 13         44 my $change_length =
2511             ( $str_position + $str_length ) - $buff_length;
2512              
2513             # Length of the current CONTINUE record data.
2514 13         28 my $biff_length = length $biff_data;
2515              
2516             # Restrict the portion to be changed to the current block
2517             # if the string extends over more than one block.
2518 13 100       42 if ( $change_length > ( $biff_length - 1 ) * 2 ) {
2519 9         16 $change_length = ( $biff_length - 1 ) * 2;
2520             }
2521              
2522             # Insert the null bytes.
2523 13         54 for ( my $i = ( $change_length / 2 ) ; $i >= 1 ; $i-- ) {
2524 88832         1202825 substr( $biff_data, $i + 1, 0 ) = "\x00";
2525             }
2526              
2527             }
2528              
2529             # Strip the Grbit byte and store the string data.
2530 17         1066 $self->{_buffer} .= substr $biff_data, 1;
2531             }
2532             }
2533             }
2534             else {
2535              
2536             # Not a CONTINUE block therefore an SST block.
2537 33         231 $self->{_buffer} .= $biff_data;
2538             }
2539              
2540             # Reset the state variables.
2541 60         541 $self->{_string_continued} = undef;
2542 60         164 $self->{_previous_info} = undef;
2543              
2544             # Extract out any full strings from the current buffer leaving behind a
2545             # partial string that is continued into the next block, or an empty
2546             # buffer is no string is continued.
2547 60         778 while ( length $self->{_buffer} >= 4 ) {
2548 524         1792 my ( $str_info, $length, $str_position, $str_length ) =
2549             _convBIFF8String( $self, $self->{_buffer}, 1 );
2550              
2551 524 100       1339 if ( defined $str_info->[0] ) {
2552 497         507 push @{ $self->{PkgStr} },
  497         2790  
2553             {
2554             Text => $str_info->[0],
2555             Unicode => $str_info->[1],
2556             Rich => $str_info->[2],
2557             Ext => $str_info->[3],
2558             };
2559 497         2568 $self->{_buffer} = substr( $self->{_buffer}, $length );
2560             }
2561             else {
2562 27         132 $self->{_string_continued} = $str_info->[1];
2563 27         117 $self->{_previous_info} = [ $str_position, $str_length ];
2564 27         290 last;
2565             }
2566             }
2567             }
2568              
2569             #------------------------------------------------------------------------------
2570             # _SwapForUnicode (for Spreadsheet::ParseExcel)
2571             #------------------------------------------------------------------------------
2572             sub _SwapForUnicode {
2573 453     453   683 my ( $sObj ) = @_;
2574              
2575             # for(my $i = 0; $i
2576 453         1902 for ( my $i = 0 ; $i < ( int( length( $$sObj ) / 2 ) * 2 ) ; $i += 2 ) {
2577 528882         721504 my $sIt = substr( $$sObj, $i, 1 );
2578 528882         769231 substr( $$sObj, $i, 1 ) = substr( $$sObj, $i + 1, 1 );
2579 528882         1393036 substr( $$sObj, $i + 1, 1 ) = $sIt;
2580             }
2581             }
2582              
2583             #------------------------------------------------------------------------------
2584             # _NewCell (for Spreadsheet::ParseExcel)
2585             #------------------------------------------------------------------------------
2586             sub _NewCell {
2587 1122     1122   6162 my ( $oBook, $iR, $iC, %rhKey ) = @_;
2588 1122         1353 my ( $sWk, $iLen );
2589 1122 50       2974 return undef unless ( defined $oBook->{_CurSheet} );
2590              
2591 1122         1629 my $FmtClass = $oBook->{FmtClass};
2592 1122         4985 $rhKey{Type} =
2593             $FmtClass->ChkType( $rhKey{Numeric}, $rhKey{Format}{FmtIdx} );
2594 1122         2890 my $FmtStr = $oBook->{FormatStr}{ $rhKey{Format}{FmtIdx} };
2595              
2596             # Set "Date" type if required for numbers in a MulRK BIFF block.
2597 1122 100 100     2919 if ( defined $FmtStr && $rhKey{Type} eq "Numeric" ) {
2598              
2599             # Match a range of possible date formats. Note: this isn't important
2600             # except for reporting. The number will still be converted to a date
2601             # by ExcelFmt() even if 'Type' isn't set to 'Date'.
2602 43 100       328 if ( $FmtStr =~ m{^[dmy][-\\/dmy]*$}i ) {
2603 39         76 $rhKey{Type} = "Date";
2604             }
2605             }
2606              
2607 1122         5687 my $oCell = Spreadsheet::ParseExcel::Cell->new(
2608             Val => $rhKey{Val},
2609             FormatNo => $rhKey{FormatNo},
2610             Format => $rhKey{Format},
2611             Code => $rhKey{Code},
2612             Type => $rhKey{Type},
2613             );
2614 1122         2523 $oCell->{_Kind} = $rhKey{Kind};
2615 1122         4273 $oCell->{_Value} = $FmtClass->ValFmt( $oCell, $oBook );
2616 1122 100       2683 if ( $rhKey{Rich} ) {
2617 6         17 my @aRich = ();
2618 6         12 my $sRich = $rhKey{Rich};
2619 6         30 for ( my $iWk = 0 ; $iWk < length( $sRich ) ; $iWk += 4 ) {
2620 18         56 my ( $iPos, $iFnt ) = unpack( 'v2', substr( $sRich, $iWk ) );
2621 18         85 push @aRich, [ $iPos, $oBook->{Font}[$iFnt] ];
2622             }
2623 6         24 $oCell->{Rich} = \@aRich;
2624             }
2625              
2626 1122 100       3343 if ( defined $oBook->{CellHandler} ) {
2627 56 50       340 if ( defined $oBook->{Object} ) {
2628 21     21   331 no strict;
  21         55  
  21         8954  
2629 0 0       0 ref( $oBook->{CellHandler} ) eq "CODE"
2630             ? $oBook->{CellHandler}->(
2631             $_Object, $oBook, $oBook->{_CurSheet}, $iR, $iC, $oCell
2632             )
2633             : $oBook->{CellHandler}->callback( $_Object, $oBook, $oBook->{_CurSheet},
2634             $iR, $iC, $oCell );
2635             }
2636             else {
2637 56         259 $oBook->{CellHandler}->( $oBook, $oBook->{_CurSheet}, $iR, $iC, $oCell );
2638             }
2639             }
2640 1122 100       43896 unless ( $oBook->{NotSetCell} ) {
2641 1066         3419 $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Cells}[$iR][$iC] = $oCell;
2642             }
2643 1122         3861 return $oCell;
2644             }
2645              
2646             #------------------------------------------------------------------------------
2647             # ColorIdxToRGB (for Spreadsheet::ParseExcel)
2648             #
2649             # Returns for most recently opened book for compatibility, use
2650             # Workbook::color_idx_to_rgb instead
2651             #
2652             #------------------------------------------------------------------------------
2653             sub ColorIdxToRGB {
2654 0     0 0 0 my ( $sPkg, $iIdx ) = @_;
2655              
2656              
2657 0 0       0 unless( defined $currentbook ) {
2658 0 0       0 return ( ( defined $aColor[$iIdx] ) ? $aColor[$iIdx] : $aColor[0] );
2659             }
2660              
2661 0         0 return $currentbook->color_idx_to_rgb( $iIdx );
2662             }
2663              
2664              
2665             ###############################################################################
2666             #
2667             # error().
2668             #
2669             # Return an error string for a failed parse().
2670             #
2671             sub error {
2672              
2673 8     8 1 1101 my $self = shift;
2674              
2675 8         98 my $parse_error = $self->{_error_status};
2676              
2677 8 50       50 if ( exists $error_strings{$parse_error} ) {
2678 8         44 return $error_strings{$parse_error};
2679             }
2680             else {
2681 0         0 return 'Unknown parse error';
2682             }
2683             }
2684              
2685              
2686             ###############################################################################
2687             #
2688             # error_code().
2689             #
2690             # Return an error code for a failed parse().
2691             #
2692             sub error_code {
2693              
2694 8     8 1 47 my $self = shift;
2695              
2696 8         36 return $self->{_error_status};
2697             }
2698              
2699              
2700             ###############################################################################
2701             #
2702             # Mapping between legacy method names and new names.
2703             #
2704             {
2705 21     21   141 no warnings; # Ignore warnings about variables used only once.
  21         43  
  21         3188  
2706             *Parse = *parse;
2707             }
2708              
2709             1;
2710              
2711             __END__