File Coverage

blib/lib/Spreadsheet/WriteExcel/Workbook.pm
Criterion Covered Total %
statement 973 1329 73.2
branch 179 346 51.7
condition 48 134 35.8
subroutine 63 79 79.7
pod 0 19 0.0
total 1263 1907 66.2


line stmt bran cond sub pod time code
1             package Spreadsheet::WriteExcel::Workbook;
2              
3             ###############################################################################
4             #
5             # Workbook - A writer class for Excel Workbooks.
6             #
7             #
8             # Used in conjunction with Spreadsheet::WriteExcel
9             #
10             # Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
11             #
12             # Documentation after __END__
13             #
14 30     30   178 use Exporter;
  30         54  
  30         1492  
15 30     30   165 use strict;
  30         55  
  30         835  
16 30     30   204 use Carp;
  30         46  
  30         7251  
17 30     30   21765 use Spreadsheet::WriteExcel::BIFFwriter;
  30         75  
  30         3894  
18 30     30   23526 use Spreadsheet::WriteExcel::OLEwriter;
  30         114  
  30         1700  
19 30     30   69685 use Spreadsheet::WriteExcel::Worksheet;
  30         130  
  30         2973  
20 30     30   421 use Spreadsheet::WriteExcel::Format;
  30         68  
  30         1236  
21 30     30   39958 use Spreadsheet::WriteExcel::Chart;
  30         136  
  30         3016  
22 30     30   28266 use Spreadsheet::WriteExcel::Properties ':property_sets';
  30         126  
  30         6310  
23              
24 30     30   210 use vars qw($VERSION @ISA);
  30         61  
  30         502987  
25             @ISA = qw(Spreadsheet::WriteExcel::BIFFwriter Exporter);
26              
27             $VERSION = '2.40';
28              
29             ###############################################################################
30             #
31             # new()
32             #
33             # Constructor. Creates a new Workbook object from a BIFFwriter object.
34             #
35             sub new {
36              
37 61     61 0 142 my $class = shift;
38 61         585 my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
39 61         188 my $byte_order = $self->{_byte_order};
40 61         667 my $parser = Spreadsheet::WriteExcel::Formula->new($byte_order);
41              
42 61   50     315 $self->{_filename} = $_[0] || '';
43 61         187 $self->{_parser} = $parser;
44 61         285 $self->{_tempdir} = undef;
45 61         178 $self->{_1904} = 0;
46 61         169 $self->{_activesheet} = 0;
47 61         212 $self->{_firstsheet} = 0;
48 61         160 $self->{_selected} = 0;
49 61         161 $self->{_xf_index} = 0;
50 61         156 $self->{_fileclosed} = 0;
51 61         153 $self->{_biffsize} = 0;
52 61         287 $self->{_sheet_name} = 'Sheet';
53 61         186 $self->{_chart_name} = 'Chart';
54 61         142 $self->{_sheet_count} = 0;
55 61         141 $self->{_chart_count} = 0;
56 61         203 $self->{_url_format} = '';
57 61         142 $self->{_codepage} = 0x04E4;
58 61         221 $self->{_country} = 1;
59 61         272 $self->{_worksheets} = [];
60 61         184 $self->{_sheetnames} = [];
61 61         217 $self->{_formats} = [];
62 61         193 $self->{_palette} = [];
63              
64 61         153 $self->{_using_tmpfile} = 1;
65 61         178 $self->{_filehandle} = "";
66 61         172 $self->{_temp_file} = "";
67 61         156 $self->{_internal_fh} = 0;
68 61         170 $self->{_fh_out} = "";
69              
70 61         278 $self->{_str_total} = 0;
71 61         152 $self->{_str_unique} = 0;
72 61         174 $self->{_str_table} = {};
73 61         236 $self->{_str_array} = [];
74 61         161 $self->{_str_block_sizes} = [];
75 61         174 $self->{_extsst_offsets} = [];
76 61         156 $self->{_extsst_buckets} = 0;
77 61         190 $self->{_extsst_bucket_size} = 0;
78              
79 61         141 $self->{_ext_ref_count} = 0;
80 61         148 $self->{_ext_refs} = {};
81              
82 61         150 $self->{_mso_clusters} = [];
83 61         140 $self->{_mso_size} = 0;
84              
85 61         163 $self->{_hideobj} = 0;
86 61         155 $self->{_compatibility} = 0;
87              
88 61         174 $self->{_add_doc_properties} = 0;
89 61         3242 $self->{_localtime} = [localtime()];
90              
91 61         207 $self->{_defined_names} = [];
92              
93 61         209 bless $self, $class;
94              
95              
96             # Add the in-built style formats and the default cell format.
97 61         356 $self->add_format(type => 1); # 0 Normal
98 61         187 $self->add_format(type => 1); # 1 RowLevel 1
99 61         201 $self->add_format(type => 1); # 2 RowLevel 2
100 61         215 $self->add_format(type => 1); # 3 RowLevel 3
101 61         206 $self->add_format(type => 1); # 4 RowLevel 4
102 61         183 $self->add_format(type => 1); # 5 RowLevel 5
103 61         193 $self->add_format(type => 1); # 6 RowLevel 6
104 61         180 $self->add_format(type => 1); # 7 RowLevel 7
105 61         195 $self->add_format(type => 1); # 8 ColLevel 1
106 61         339 $self->add_format(type => 1); # 9 ColLevel 2
107 61         180 $self->add_format(type => 1); # 10 ColLevel 3
108 61         206 $self->add_format(type => 1); # 11 ColLevel 4
109 61         222 $self->add_format(type => 1); # 12 ColLevel 5
110 61         217 $self->add_format(type => 1); # 13 ColLevel 6
111 61         202 $self->add_format(type => 1); # 14 ColLevel 7
112 61         179 $self->add_format(); # 15 Cell XF
113 61         200 $self->add_format(type => 1, num_format => 0x2B); # 16 Comma
114 61         226 $self->add_format(type => 1, num_format => 0x29); # 17 Comma[0]
115 61         279 $self->add_format(type => 1, num_format => 0x2C); # 18 Currency
116 61         209 $self->add_format(type => 1, num_format => 0x2A); # 19 Currency[0]
117 61         223 $self->add_format(type => 1, num_format => 0x09); # 20 Percent
118              
119              
120             # Add the default format for hyperlinks
121 61         212 $self->{_url_format} = $self->add_format(color => 'blue', underline => 1);
122              
123              
124             # Check for a filename unless it is an existing filehandle
125 61 50 33     578 if (not ref $self->{_filename} and $self->{_filename} eq '') {
126 0         0 carp 'Filename required by Spreadsheet::WriteExcel->new()';
127 0         0 return undef;
128             }
129              
130              
131             # Convert the filename to a filehandle to pass to the OLE writer when the
132             # file is closed. If the filename is a reference it is assumed that it is
133             # a valid filehandle.
134             #
135 61 50       295 if (not ref $self->{_filename}) {
136              
137 61         818 my $fh = FileHandle->new('>'. $self->{_filename});
138              
139 61 50       12802 if (not defined $fh) {
140 0         0 carp "Can't open " .
141             $self->{_filename} .
142             ". It may be in use or protected";
143 0         0 return undef;
144             }
145              
146             # binmode file whether platform requires it or not
147 61         273 binmode($fh);
148 61         151 $self->{_internal_fh} = 1;
149 61         155 $self->{_fh_out} = $fh;
150             }
151             else {
152 0         0 $self->{_internal_fh} = 0;
153 0         0 $self->{_fh_out} = $self->{_filename};
154              
155             }
156              
157              
158             # Set colour palette.
159 61         425 $self->set_palette_xl97();
160              
161             # Load Encode if we can.
162 61 50       39818 require Encode if $] >= 5.008;
163              
164 61         370976 $self->_initialize();
165 61         277 $self->_get_checksum_method();
166 61         343 return $self;
167             }
168              
169              
170             ###############################################################################
171             #
172             # _initialize()
173             #
174             # Open a tmp file to store the majority of the Worksheet data. If this fails,
175             # for example due to write permissions, store the data in memory. This can be
176             # slow for large files.
177             #
178             # TODO: Move this and other methods shared with Worksheet up into BIFFwriter.
179             #
180             sub _initialize {
181              
182 61     61   168 my $self = shift;
183 61         138 my $fh;
184             my $tmp_dir;
185              
186             # The following code is complicated by Windows limitations. Porters can
187             # choose a more direct method.
188              
189              
190              
191             # In the default case we use IO::File->new_tmpfile(). This may fail, in
192             # particular with IIS on Windows, so we allow the user to specify a temp
193             # directory via File::Temp.
194             #
195 61 50       398 if (defined $self->{_tempdir}) {
196              
197             # Delay loading File:Temp to reduce the module dependencies.
198 0         0 eval { require File::Temp };
  0         0  
199 0 0       0 die "The File::Temp module must be installed in order ".
200             "to call set_tempdir().\n" if $@;
201              
202              
203             # Trap but ignore File::Temp errors.
204 0         0 eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
  0         0  
205              
206             # Store the failed tmp dir in case of errors.
207 0 0 0     0 $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
208             }
209             else {
210              
211 61         21060 $fh = IO::File->new_tmpfile();
212              
213             # Store the failed tmp dir in case of errors.
214 61 50       774 $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
215             }
216              
217              
218             # Check if the temp file creation was successful. Else store data in memory.
219 61 50       270 if ($fh) {
220              
221             # binmode file whether platform requires it or not.
222 61         183 binmode($fh);
223              
224             # Store filehandle
225 61         277 $self->{_filehandle} = $fh;
226             }
227             else {
228              
229             # Set flag to store data in memory if XX::tempfile() failed.
230 0         0 $self->{_using_tmpfile} = 0;
231              
232 0 0       0 if ($^W) {
233 0   0     0 my $dir = $self->{_tempdir} || File::Spec->tmpdir();
234              
235 0         0 warn "Unable to create temp files in $tmp_dir. Data will be ".
236             "stored in memory. Refer to set_tempdir() in the ".
237             "Spreadsheet::WriteExcel documentation.\n" ;
238             }
239             }
240             }
241              
242              
243             ###############################################################################
244             #
245             # _get_checksum_method.
246             #
247             # Check for modules available to calculate image checksum. Excel uses MD4 but
248             # MD5 will also work.
249             #
250             sub _get_checksum_method {
251              
252 61     61   149 my $self = shift;
253              
254 61         139 eval { require Digest::MD4};
  61         28091  
255 61 50       634 if (not $@) {
256 0         0 $self->{_checksum_method} = 1;
257 0         0 return;
258             }
259              
260              
261 61         138 eval { require Digest::Perl::MD4};
  61         25005  
262 61 50       384 if (not $@) {
263 0         0 $self->{_checksum_method} = 2;
264 0         0 return;
265             }
266              
267              
268 61         160 eval { require Digest::MD5};
  61         364  
269 61 50       236 if (not $@) {
270 61         220 $self->{_checksum_method} = 3;
271 61         176 return;
272             }
273              
274             # Default.
275 0         0 $self->{_checksum_method} = 0;
276             }
277              
278              
279             ###############################################################################
280             #
281             # _append(), overridden.
282             #
283             # Store Worksheet data in memory using the base class _append() or to a
284             # temporary file, the default.
285             #
286             sub _append {
287              
288 3145     3145   4064 my $self = shift;
289 3145         3764 my $data = '';
290              
291 3145 100       6396 if ($self->{_using_tmpfile}) {
292 2211         5413 $data = join('', @_);
293              
294             # Add CONTINUE records if necessary
295 2211 50       8827 $data = $self->_add_continue($data) if length($data) > $self->{_limit};
296              
297             # Protect print() from -l on the command line.
298 2211         6199 local $\ = undef;
299              
300 2211         2424 print {$self->{_filehandle}} $data;
  2211         8159  
301 2211         5773 $self->{_datasize} += length($data);
302             }
303             else {
304 934         2766 $data = $self->SUPER::_append(@_);
305             }
306              
307 3145         7301 return $data;
308             }
309              
310              
311             ###############################################################################
312             #
313             # get_data().
314             #
315             # Retrieves data from memory in one chunk, or from disk in $buffer
316             # sized chunks.
317             #
318             sub get_data {
319              
320 166     166 0 420 my $self = shift;
321 166         244 my $buffer = 4096;
322 166         190 my $tmp;
323              
324             # Return data stored in memory
325 166 100       519 if (defined $self->{_data}) {
326 61         169 $tmp = $self->{_data};
327 61         125 $self->{_data} = undef;
328 61         170 my $fh = $self->{_filehandle};
329 61 100       4296 seek($fh, 0, 0) if $self->{_using_tmpfile};
330 61         404 return $tmp;
331             }
332              
333             # Return data stored on disk
334 105 100       398 if ($self->{_using_tmpfile}) {
335 88 100       1384 return $tmp if read($self->{_filehandle}, $tmp, $buffer);
336             }
337              
338             # No data to return
339 61         249 return undef;
340             }
341              
342              
343             ###############################################################################
344             #
345             # close()
346             #
347             # Calls finalization methods and explicitly close the OLEwriter file
348             # handle.
349             #
350             sub close {
351              
352 62     62 0 65521 my $self = shift;
353              
354 62 100       354 return if $self->{_fileclosed}; # Prevent close() from being called twice.
355              
356 61         151 $self->{_fileclosed} = 1;
357              
358 61         512 return $self->_store_workbook();
359             }
360              
361              
362             ###############################################################################
363             #
364             # DESTROY()
365             #
366             # Close the workbook if it hasn't already been explicitly closed.
367             #
368             sub DESTROY {
369              
370 61     61   9546 my $self = shift;
371              
372 61         649 local ($@, $!, $^E, $?);
373              
374 61 100       24993 $self->close() if not $self->{_fileclosed};
375             }
376              
377              
378             ###############################################################################
379             #
380             # sheets(slice,...)
381             #
382             # An accessor for the _worksheets[] array
383             #
384             # Returns: an optionally sliced list of the worksheet objects in a workbook.
385             #
386             sub sheets {
387              
388 18     18 0 20579 my $self = shift;
389              
390 18 50       67 if (@_) {
391             # Return a slice of the array
392 0         0 return @{$self->{_worksheets}}[@_];
  0         0  
393             }
394             else {
395             # Return the entire list
396 18         31 return @{$self->{_worksheets}};
  18         98  
397             }
398             }
399              
400              
401             ###############################################################################
402             #
403             # worksheets()
404             #
405             # An accessor for the _worksheets[] array.
406             # This method is now deprecated. Use the sheets() method instead.
407             #
408             # Returns: an array reference
409             #
410             sub worksheets {
411              
412 0     0 0 0 my $self = shift;
413              
414 0         0 return $self->{_worksheets};
415             }
416              
417              
418             ###############################################################################
419             #
420             # add_worksheet($name, $encoding)
421             #
422             # Add a new worksheet to the Excel workbook.
423             #
424             # Returns: reference to a worksheet object
425             #
426             sub add_worksheet {
427              
428 133     133 0 33105 my $self = shift;
429 133         211 my $index = @{$self->{_worksheets}};
  133         626  
430              
431 133         979 my ($name, $encoding) = $self->_check_sheetname($_[0], $_[1]);
432              
433              
434             # Porters take note, the following scheme of passing references to Workbook
435             # data (in the \$self->{_foo} cases) instead of a reference to the Workbook
436             # itself is a workaround to avoid circular references between Workbook and
437             # Worksheet objects. Feel free to implement this in any way the suits your
438             # language.
439             #
440 133         1201 my @init_data = (
441             $name,
442             $index,
443             $encoding,
444             \$self->{_activesheet},
445             \$self->{_firstsheet},
446             $self->{_url_format},
447             $self->{_parser},
448             $self->{_tempdir},
449             \$self->{_str_total},
450             \$self->{_str_unique},
451             \$self->{_str_table},
452             $self->{_1904},
453             $self->{_compatibility},
454             undef, # Palette. Not used yet. See add_chart().
455             );
456              
457 133         1249 my $worksheet = Spreadsheet::WriteExcel::Worksheet->new(@init_data);
458 133         392 $self->{_worksheets}->[$index] = $worksheet; # Store ref for iterator
459 133         305 $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
460 133         901 $self->{_parser}->set_ext_sheets($name, $index); # Store names in Formula.pm
461 133         535 return $worksheet;
462             }
463              
464             # Older method name for backwards compatibility.
465             *addworksheet = *add_worksheet;
466              
467              
468             ###############################################################################
469             #
470             # add_chart(%args)
471             #
472             # Create a chart for embedding or as a new sheet.
473             #
474             #
475             sub add_chart {
476              
477 2     2 0 32 my $self = shift;
478 2         11 my %arg = @_;
479 2         7 my $name = '';
480 2         6 my $encoding = 0;
481 2         5 my $index = @{ $self->{_worksheets} };
  2         28  
482              
483             # Type must be specified so we can create the required chart instance.
484 2         8 my $type = $arg{type};
485 2 50       10 if ( !defined $type ) {
486 0         0 croak "Must define chart type in add_chart()";
487             }
488              
489             # Ensure that the chart defaults to non embedded.
490 2   50     18 my $embedded = $arg{embedded} ||= 0;
491              
492             # Check the worksheet name for non-embedded charts.
493 2 50       9 if ( !$embedded ) {
494 2         30 ( $name, $encoding ) =
495             $self->_check_sheetname( $arg{name}, $arg{name_encoding}, 1 );
496             }
497              
498 2         29 my @init_data = (
499             $name,
500             $index,
501             $encoding,
502             \$self->{_activesheet},
503             \$self->{_firstsheet},
504             $self->{_url_format},
505             $self->{_parser},
506             $self->{_tempdir},
507             \$self->{_str_total},
508             \$self->{_str_unique},
509             \$self->{_str_table},
510             $self->{_1904},
511             $self->{_compatibility},
512             $self->{_palette},
513             );
514              
515 2         30 my $chart = Spreadsheet::WriteExcel::Chart->factory( $type, @init_data );
516              
517             # If the chart isn't embedded let the workbook control it.
518 2 50       11 if ( !$embedded ) {
519 2         9 $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
520 2         6 $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
521             }
522             else {
523             # Set index to 0 so that the activate() and set_first_sheet() methods
524             # point back to the first worksheet if used for embedded charts.
525 0         0 $chart->{_index} = 0;
526              
527 0         0 $chart->_set_embedded_config_data();
528             }
529              
530 2         15 return $chart;
531             }
532              
533              
534             ###############################################################################
535             #
536             # add_chart_ext($filename, $name)
537             #
538             # Add an externally created chart.
539             #
540             #
541             sub add_chart_ext {
542              
543 0     0 0 0 my $self = shift;
544 0         0 my $filename = $_[0];
545 0         0 my $index = @{$self->{_worksheets}};
  0         0  
546 0         0 my $type = 'external';
547              
548 0         0 my ($name, $encoding) = $self->_check_sheetname($_[1], $_[2]);
549              
550              
551 0         0 my @init_data = (
552             $filename,
553             $name,
554             $index,
555             $encoding,
556             \$self->{_activesheet},
557             \$self->{_firstsheet},
558             );
559              
560 0         0 my $chart = Spreadsheet::WriteExcel::Chart->factory($type, @init_data);
561 0         0 $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
562 0         0 $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
563              
564 0         0 return $chart;
565             }
566              
567              
568             ###############################################################################
569             #
570             # _check_sheetname($name, $encoding)
571             #
572             # Check for valid worksheet names. We check the length, if it contains any
573             # invalid characters and if the name is unique in the workbook.
574             #
575             sub _check_sheetname {
576              
577 204     204   54843 my $self = shift;
578 204   100     1109 my $name = $_[0] || "";
579 204   100     1042 my $encoding = $_[1] || 0;
580 204   100     877 my $chart = $_[2] || 0;
581 204 100       561 my $limit = $encoding ? 62 : 31;
582 204         946 my $invalid_char = qr([\[\]:*?/\\]);
583              
584             # Increment the Sheet/Chart number used for default sheet names below.
585 204 100       499 if ( $chart ) {
586 2         7 $self->{_chart_count}++;
587             }
588             else {
589 202         477 $self->{_sheet_count}++;
590             }
591              
592             # Supply default Sheet/Chart name if none has been defined.
593 204 100       646 if ( $name eq "" ) {
594 134         196 $encoding = 0;
595              
596 134 100       317 if ( $chart ) {
597 2         10 $name = $self->{_chart_name} . $self->{_chart_count};
598             }
599             else {
600 132         504 $name = $self->{_sheet_name} . $self->{_sheet_count};
601             }
602             }
603              
604              
605             # Check that sheetname is <= 31 (1 or 2 byte chars). Excel limit.
606 204 100       1213 croak "Sheetname $name must be <= 31 chars" if length $name > $limit;
607              
608             # Check that Unicode sheetname has an even number of bytes
609 200 50 66     704 croak 'Odd number of bytes in Unicode worksheet name:' . $name
610             if $encoding == 1 and length($name) % 2;
611              
612              
613             # Check that sheetname doesn't contain any invalid characters
614 200 100 100     1672 if ($encoding != 1 and $name =~ $invalid_char) {
615             # Check ASCII names
616 21         2904 croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
617             }
618             else {
619             # Extract any 8bit clean chars from the UTF16 name and validate them.
620 179         1264 for my $wchar ($name =~ /../sg) {
621 606         1885 my ($hi, $lo) = unpack "aa", $wchar;
622 606 100 100     2345 if ($hi eq "\0" and $lo =~ $invalid_char) {
623 7         1050 croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
624             }
625             }
626             }
627              
628              
629             # Handle utf8 strings in perl 5.8.
630 172 50       620 if ($] >= 5.008) {
631 172         1311 require Encode;
632              
633 172 100       944 if (Encode::is_utf8($name)) {
634 5         23 $name = Encode::encode("UTF-16BE", $name);
635 5         162 $encoding = 1;
636             }
637             }
638              
639              
640             # Check that the worksheet name doesn't already exist since this is a fatal
641             # error in Excel 97. The check must also exclude case insensitive matches
642             # since the names 'Sheet1' and 'sheet1' are equivalent. The tests also have
643             # to take the encoding into account.
644             #
645 172         257 foreach my $worksheet (@{$self->{_worksheets}}) {
  172         475  
646 618         755 my $name_a = $name;
647 618         755 my $encd_a = $encoding;
648 618         1143 my $name_b = $worksheet->{_name};
649 618         869 my $encd_b = $worksheet->{_encoding};
650 618         751 my $error = 0;
651              
652 618 100 100     2689 if ($encd_a == 0 and $encd_b == 0) {
    100 66        
    100 66        
    50 33        
653 552 100       1396 $error = 1 if lc($name_a) eq lc($name_b);
654             }
655             elsif ($encd_a == 0 and $encd_b == 1) {
656 12         54 $name_a = pack "n*", unpack "C*", $name_a;
657 12 100       42 $error = 1 if lc($name_a) eq lc($name_b);
658             }
659             elsif ($encd_a == 1 and $encd_b == 0) {
660 41         121 $name_b = pack "n*", unpack "C*", $name_b;
661 41 100       128 $error = 1 if lc($name_a) eq lc($name_b);
662             }
663             elsif ($encd_a == 1 and $encd_b == 1) {
664             # We can do a true case insensitive test with Perl 5.8 and utf8.
665 13 50       32 if ($] >= 5.008) {
666 13         51 $name_a = Encode::decode("UTF-16BE", $name_a);
667 13         9878 $name_b = Encode::decode("UTF-16BE", $name_b);
668 13 100   1   483 $error = 1 if lc($name_a) eq lc($name_b);
  1         1379  
  1         13  
  1         18  
669             }
670             else {
671             # We can't easily do a case insensitive test of the UTF16 names.
672             # As a special case we check if all of the high bytes are nulls and
673             # then do an ASCII style case insensitive test.
674              
675             # Strip out the high bytes (funkily).
676 0         0 my $hi_a = grep {ord} $name_a =~ /(.)./sg;
  0         0  
677 0         0 my $hi_b = grep {ord} $name_b =~ /(.)./sg;
  0         0  
678              
679 0 0 0     0 if ($hi_a or $hi_b) {
680 0 0       0 $error = 1 if $name_a eq $name_b;
681             }
682             else {
683 0 0       0 $error = 1 if lc($name_a) eq lc($name_b);
684             }
685             }
686             }
687              
688             # If any of the cases failed we throw the error here.
689 618 100       36576 if ($error) {
690 23         3759 croak "Worksheet name '$name', with case ignored, " .
691             "is already in use";
692             }
693             }
694              
695 149         722 return ($name, $encoding);
696             }
697              
698              
699             ###############################################################################
700             #
701             # add_format(%properties)
702             #
703             # Add a new format to the Excel workbook. This adds an XF record and
704             # a FONT record. Also, pass any properties to the Format::new().
705             #
706             sub add_format {
707              
708 1346     1346 0 1990 my $self = shift;
709              
710 1346         5229 my $format = Spreadsheet::WriteExcel::Format->new($self->{_xf_index}, @_);
711              
712 1346         2161 $self->{_xf_index} += 1;
713 1346         1490 push @{$self->{_formats}}, $format; # Store format reference
  1346         2975  
714              
715 1346         2190 return $format;
716             }
717              
718             # Older method name for backwards compatibility.
719             *addformat = *add_format;
720              
721              
722             ###############################################################################
723             #
724             # compatibility_mode()
725             #
726             # Set the compatibility mode.
727             #
728             # Excel doesn't require every possible Biff record to be present in a file.
729             # In particular if the indexing records INDEX, ROW and DBCELL aren't present
730             # it just ignores the fact and reads the cells anyway. This is also true of
731             # the EXTSST record. Gnumeric and OOo also take this approach. This allows
732             # WriteExcel to ignore these records in order to minimise the amount of data
733             # stored in memory. However, other third party applications that read Excel
734             # files often expect these records to be present. In "compatibility mode"
735             # WriteExcel writes these records and tries to be as close to an Excel
736             # generated file as possible.
737             #
738             # This requires additional data to be stored in memory until the file is
739             # about to be written. This incurs a memory and speed penalty and may not be
740             # suitable for very large files.
741             #
742             sub compatibility_mode {
743              
744 1     1 0 13 my $self = shift;
745              
746 1 50       8 croak "compatibility_mode() must be called before add_worksheet()"
747             if $self->sheets();
748              
749 1 50       3 if (defined($_[0])) {
750 1         4 $self->{_compatibility} = $_[0];
751             }
752             else {
753 0         0 $self->{_compatibility} = 1;
754             }
755             }
756              
757              
758             ###############################################################################
759             #
760             # set_1904()
761             #
762             # Set the date system: 0 = 1900 (the default), 1 = 1904
763             #
764             sub set_1904 {
765              
766 0     0 0 0 my $self = shift;
767              
768 0 0       0 croak "set_1904() must be called before add_worksheet()"
769             if $self->sheets();
770              
771              
772 0 0       0 if (defined($_[0])) {
773 0         0 $self->{_1904} = $_[0];
774             }
775             else {
776 0         0 $self->{_1904} = 1;
777             }
778             }
779              
780              
781             ###############################################################################
782             #
783             # get_1904()
784             #
785             # Return the date system: 0 = 1900, 1 = 1904
786             #
787             sub get_1904 {
788              
789 0     0 0 0 my $self = shift;
790              
791 0         0 return $self->{_1904};
792             }
793              
794              
795             ###############################################################################
796             #
797             # set_custom_color()
798             #
799             # Change the RGB components of the elements in the colour palette.
800             #
801             sub set_custom_color {
802              
803 0     0 0 0 my $self = shift;
804              
805              
806             # Match a HTML #xxyyzz style parameter
807 0 0 0     0 if (defined $_[1] and $_[1] =~ /^#(\w\w)(\w\w)(\w\w)/ ) {
808 0         0 @_ = ($_[0], hex $1, hex $2, hex $3);
809             }
810              
811              
812 0   0     0 my $index = $_[0] || 0;
813 0   0     0 my $red = $_[1] || 0;
814 0   0     0 my $green = $_[2] || 0;
815 0   0     0 my $blue = $_[3] || 0;
816              
817 0         0 my $aref = $self->{_palette};
818              
819             # Check that the colour index is the right range
820 0 0 0     0 if ($index < 8 or $index > 64) {
821 0         0 carp "Color index $index outside range: 8 <= index <= 64";
822 0         0 return 0;
823             }
824              
825             # Check that the colour components are in the right range
826 0 0 0     0 if ( ($red < 0 or $red > 255) ||
      0        
      0        
      0        
      0        
827             ($green < 0 or $green > 255) ||
828             ($blue < 0 or $blue > 255) )
829             {
830 0         0 carp "Color component outside range: 0 <= color <= 255";
831 0         0 return 0;
832             }
833              
834 0         0 $index -=8; # Adjust colour index (wingless dragonfly)
835              
836             # Set the RGB value
837 0         0 $aref->[$index] = [$red, $green, $blue, 0];
838              
839 0         0 return $index +8;
840             }
841              
842              
843             ###############################################################################
844             #
845             # set_palette_xl97()
846             #
847             # Sets the colour palette to the Excel 97+ default.
848             #
849             sub set_palette_xl97 {
850              
851 61     61 0 134 my $self = shift;
852              
853 61         3700 $self->{_palette} = [
854             [0x00, 0x00, 0x00, 0x00], # 8
855             [0xff, 0xff, 0xff, 0x00], # 9
856             [0xff, 0x00, 0x00, 0x00], # 10
857             [0x00, 0xff, 0x00, 0x00], # 11
858             [0x00, 0x00, 0xff, 0x00], # 12
859             [0xff, 0xff, 0x00, 0x00], # 13
860             [0xff, 0x00, 0xff, 0x00], # 14
861             [0x00, 0xff, 0xff, 0x00], # 15
862             [0x80, 0x00, 0x00, 0x00], # 16
863             [0x00, 0x80, 0x00, 0x00], # 17
864             [0x00, 0x00, 0x80, 0x00], # 18
865             [0x80, 0x80, 0x00, 0x00], # 19
866             [0x80, 0x00, 0x80, 0x00], # 20
867             [0x00, 0x80, 0x80, 0x00], # 21
868             [0xc0, 0xc0, 0xc0, 0x00], # 22
869             [0x80, 0x80, 0x80, 0x00], # 23
870             [0x99, 0x99, 0xff, 0x00], # 24
871             [0x99, 0x33, 0x66, 0x00], # 25
872             [0xff, 0xff, 0xcc, 0x00], # 26
873             [0xcc, 0xff, 0xff, 0x00], # 27
874             [0x66, 0x00, 0x66, 0x00], # 28
875             [0xff, 0x80, 0x80, 0x00], # 29
876             [0x00, 0x66, 0xcc, 0x00], # 30
877             [0xcc, 0xcc, 0xff, 0x00], # 31
878             [0x00, 0x00, 0x80, 0x00], # 32
879             [0xff, 0x00, 0xff, 0x00], # 33
880             [0xff, 0xff, 0x00, 0x00], # 34
881             [0x00, 0xff, 0xff, 0x00], # 35
882             [0x80, 0x00, 0x80, 0x00], # 36
883             [0x80, 0x00, 0x00, 0x00], # 37
884             [0x00, 0x80, 0x80, 0x00], # 38
885             [0x00, 0x00, 0xff, 0x00], # 39
886             [0x00, 0xcc, 0xff, 0x00], # 40
887             [0xcc, 0xff, 0xff, 0x00], # 41
888             [0xcc, 0xff, 0xcc, 0x00], # 42
889             [0xff, 0xff, 0x99, 0x00], # 43
890             [0x99, 0xcc, 0xff, 0x00], # 44
891             [0xff, 0x99, 0xcc, 0x00], # 45
892             [0xcc, 0x99, 0xff, 0x00], # 46
893             [0xff, 0xcc, 0x99, 0x00], # 47
894             [0x33, 0x66, 0xff, 0x00], # 48
895             [0x33, 0xcc, 0xcc, 0x00], # 49
896             [0x99, 0xcc, 0x00, 0x00], # 50
897             [0xff, 0xcc, 0x00, 0x00], # 51
898             [0xff, 0x99, 0x00, 0x00], # 52
899             [0xff, 0x66, 0x00, 0x00], # 53
900             [0x66, 0x66, 0x99, 0x00], # 54
901             [0x96, 0x96, 0x96, 0x00], # 55
902             [0x00, 0x33, 0x66, 0x00], # 56
903             [0x33, 0x99, 0x66, 0x00], # 57
904             [0x00, 0x33, 0x00, 0x00], # 58
905             [0x33, 0x33, 0x00, 0x00], # 59
906             [0x99, 0x33, 0x00, 0x00], # 60
907             [0x99, 0x33, 0x66, 0x00], # 61
908             [0x33, 0x33, 0x99, 0x00], # 62
909             [0x33, 0x33, 0x33, 0x00], # 63
910             ];
911              
912 61         266 return 0;
913             }
914              
915              
916             ###############################################################################
917             #
918             # set_tempdir()
919             #
920             # Change the default temp directory used by _initialize() in Worksheet.pm.
921             #
922             sub set_tempdir {
923              
924 0     0 0 0 my $self = shift;
925              
926             # Windows workaround. See Worksheet::_initialize()
927 0   0     0 my $dir = shift || '';
928              
929 0 0 0     0 croak "$dir is not a valid directory" if $dir ne '' and not -d $dir;
930 0 0       0 croak "set_tempdir must be called before add_worksheet" if $self->sheets();
931              
932 0         0 $self->{_tempdir} = $dir ;
933             }
934              
935              
936             ###############################################################################
937             #
938             # set_codepage()
939             #
940             # See also the _store_codepage method. This is used to store the code page, i.e.
941             # the character set used in the workbook.
942             #
943             sub set_codepage {
944              
945 0     0 0 0 my $self = shift;
946              
947 0   0     0 my $codepage = $_[0] || 1;
948 0 0       0 $codepage = 0x04E4 if $codepage == 1;
949 0 0       0 $codepage = 0x8000 if $codepage == 2;
950              
951 0         0 $self->{_codepage} = $codepage;
952             }
953              
954              
955             ###############################################################################
956             #
957             # set_country()
958             #
959             # See also the _store_country method. This is used to store the country code.
960             # Some non-english versions of Excel may need this set to some value other
961             # than 1 = "United States". In general the country code is equal to the
962             # international dialling code.
963             #
964             sub set_country {
965              
966 0     0 0 0 my $self = shift;
967              
968 0   0     0 $self->{_country} = $_[0] || 1;
969             }
970              
971              
972              
973              
974              
975              
976              
977             ###############################################################################
978             #
979             # define_name()
980             #
981             # TODO.
982             #
983             sub define_name {
984              
985 0     0 0 0 my $self = shift;
986 0         0 my $name = shift;
987 0         0 my $formula = shift;
988 0   0     0 my $encoding = shift || 0;
989 0         0 my $sheet_index = 0;
990 0         0 my @tokens;
991              
992 0         0 my $full_name = $name;
993              
994 0 0       0 if ($name =~ /^(.*)!(.*)$/) {
995 0         0 my $sheetname = $1;
996 0         0 $name = $2;
997 0         0 $sheet_index = 1 + $self->{_parser}->_get_sheet_index($sheetname);
998             }
999              
1000              
1001              
1002             # Strip the = sign at the beginning of the formula string
1003 0         0 $formula =~ s(^=)();
1004              
1005             # Parse the formula using the parser in Formula.pm
1006 0         0 my $parser = $self->{_parser};
1007              
1008             # In order to raise formula errors from the point of view of the calling
1009             # program we use an eval block and re-raise the error from here.
1010             #
1011 0         0 eval { @tokens = $parser->parse_formula($formula) };
  0         0  
1012              
1013 0 0       0 if ($@) {
1014 0         0 $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
1015 0         0 croak $@; # Re-raise the error
1016             }
1017              
1018             # Force 2d ranges to be a reference class.
1019 0         0 s/_ref3d/_ref3dR/ for @tokens;
1020 0         0 s/_range3d/_range3dR/ for @tokens;
1021              
1022              
1023             # Parse the tokens into a formula string.
1024 0         0 $formula = $parser->parse_tokens(@tokens);
1025              
1026              
1027              
1028 0         0 $full_name = lc $full_name;
1029              
1030 0         0 push @{$self->{_defined_names}}, {
  0         0  
1031             name => $name,
1032             encoding => $encoding,
1033             sheet_index => $sheet_index,
1034             formula => $formula,
1035             };
1036              
1037 0         0 my $index = scalar @{$self->{_defined_names}};
  0         0  
1038              
1039 0         0 $parser->set_ext_name($name, $index);
1040             }
1041              
1042              
1043              
1044              
1045              
1046              
1047              
1048              
1049              
1050             ###############################################################################
1051             #
1052             # set_properties()
1053             #
1054             # Set the document properties such as Title, Author etc. These are written to
1055             # property sets in the OLE container.
1056             #
1057             sub set_properties {
1058              
1059 14     14 0 8985 my $self = shift;
1060 14         20 my %param;
1061              
1062             # Ignore if no args were passed.
1063 14 50       37 return -1 unless @_;
1064              
1065              
1066             # Allow the parameters to be passed as a hash or hash ref.
1067 14 100       35 if (ref $_[0] eq 'HASH') {
1068 1         2 %param = %{$_[0]};
  1         6  
1069             }
1070             else {
1071 13         53 %param = @_;
1072             }
1073              
1074              
1075             # List of valid input parameters.
1076 14         156 my %properties = (
1077             codepage => [0x0001, 'VT_I2' ],
1078             title => [0x0002, 'VT_LPSTR' ],
1079             subject => [0x0003, 'VT_LPSTR' ],
1080             author => [0x0004, 'VT_LPSTR' ],
1081             keywords => [0x0005, 'VT_LPSTR' ],
1082             comments => [0x0006, 'VT_LPSTR' ],
1083             last_author => [0x0008, 'VT_LPSTR' ],
1084             created => [0x000C, 'VT_FILETIME'],
1085             category => [0x0002, 'VT_LPSTR' ],
1086             manager => [0x000E, 'VT_LPSTR' ],
1087             company => [0x000F, 'VT_LPSTR' ],
1088             utf8 => 1,
1089             );
1090              
1091             # Check for valid input parameters.
1092 14         49 for my $parameter (keys %param) {
1093 60 50       137 if (not exists $properties{$parameter}) {
1094 0         0 carp "Unknown parameter '$parameter' in set_properties()";
1095 0         0 return -1;
1096             }
1097             }
1098              
1099              
1100             # Set the creation time unless specified by the user.
1101 14 100       38 if (!exists $param{created}){
1102 1         4 $param{created} = $self->{_localtime};
1103             }
1104              
1105              
1106             #
1107             # Create the SummaryInformation property set.
1108             #
1109              
1110             # Get the codepage of the strings in the property set.
1111 14         34 my @strings = qw(title subject author keywords comments last_author);
1112 14         48 $param{codepage} = $self->_get_property_set_codepage(\%param,
1113             \@strings);
1114              
1115             # Create an array of property set values.
1116 14         23 my @property_sets;
1117              
1118 14         22 for my $property (qw(codepage title subject author
1119             keywords comments last_author created))
1120             {
1121 112 100 100     416 if (exists $param{$property} && defined $param{$property}) {
1122 63         204 push @property_sets, [
1123             $properties{$property}->[0],
1124             $properties{$property}->[1],
1125             $param{$property}
1126             ];
1127             }
1128             }
1129              
1130             # Pack the property sets.
1131 14         55 $self->{summary} = create_summary_property_set(\@property_sets);
1132              
1133              
1134             #
1135             # Create the DocSummaryInformation property set.
1136             #
1137              
1138             # Get the codepage of the strings in the property set.
1139 14         42 @strings = qw(category manager company);
1140 14         37 $param{codepage} = $self->_get_property_set_codepage(\%param,
1141             \@strings);
1142              
1143             # Create an array of property set values.
1144 14         47 @property_sets = ();
1145              
1146 14         24 for my $property (qw(codepage category manager company))
1147             {
1148 56 100 66     198 if (exists $param{$property} && defined $param{$property}) {
1149 14         53 push @property_sets, [
1150             $properties{$property}->[0],
1151             $properties{$property}->[1],
1152             $param{$property}
1153             ];
1154             }
1155             }
1156              
1157             # Pack the property sets.
1158 14         54 $self->{doc_summary} = create_doc_summary_property_set(\@property_sets);
1159              
1160             # Set a flag for when the files is written.
1161 14         119 $self->{_add_doc_properties} = 1;
1162             }
1163              
1164              
1165             ###############################################################################
1166             #
1167             # _get_property_set_codepage()
1168             #
1169             # Get the character codepage used by the strings in a property set. If one of
1170             # the strings used is utf8 then the codepage is marked as utf8. Otherwise
1171             # Latin 1 is used (although in our case this is limited to 7bit ASCII).
1172             #
1173             sub _get_property_set_codepage {
1174              
1175 31     31   1034 my $self = shift;
1176              
1177 31         38 my $params = $_[0];
1178 31         35 my $strings = $_[1];
1179              
1180             # Allow for manually marked utf8 strings.
1181 31 100       81 return 0xFDE9 if defined $params->{utf8};
1182              
1183             # Check for utf8 strings in perl 5.8.
1184 28 50       59 if ($] >= 5.008) {
1185 28         134 require Encode;
1186 28         37 for my $string (@{$strings }) {
  28         69  
1187 110 100       248 next unless exists $params->{$string};
1188 50 100       154 return 0xFDE9 if Encode::is_utf8($params->{$string});
1189             }
1190             }
1191              
1192 24         65 return 0x04E4; # Default codepage, Latin 1.
1193             }
1194              
1195              
1196             ###############################################################################
1197             #
1198             # _store_workbook()
1199             #
1200             # Assemble worksheets into a workbook and send the BIFF data to an OLE
1201             # storage.
1202             #
1203             sub _store_workbook {
1204              
1205 61     61   118 my $self = shift;
1206              
1207             # Add a default worksheet if non have been added.
1208 61 100       121 $self->add_worksheet() if not @{$self->{_worksheets}};
  61         399  
1209              
1210             # Calculate size required for MSO records and update worksheets.
1211 61         482 $self->_calc_mso_sizes();
1212              
1213             # Ensure that at least one worksheet has been selected.
1214 61 50       384 if ($self->{_activesheet} == 0) {
1215 61         126 @{$self->{_worksheets}}[0]->{_selected} = 1;
  61         249  
1216 61         144 @{$self->{_worksheets}}[0]->{_hidden} = 0;
  61         199  
1217             }
1218              
1219             # Calculate the number of selected sheet tabs and set the active sheet.
1220 61         140 foreach my $sheet (@{$self->{_worksheets}}) {
  61         176  
1221 135 100       454 $self->{_selected}++ if $sheet->{_selected};
1222 135 100       684 $sheet->{_active} = 1 if $sheet->{_index} == $self->{_activesheet};
1223             }
1224              
1225             # Add Workbook globals
1226 61         596 $self->_store_bof(0x0005);
1227 61         438 $self->_store_codepage();
1228 61         380 $self->_store_window1();
1229 61         383 $self->_store_hideobj();
1230 61         477 $self->_store_1904();
1231 61         553 $self->_store_all_fonts();
1232 61         461 $self->_store_all_num_formats();
1233 61         393 $self->_store_all_xfs();
1234 61         535 $self->_store_all_styles();
1235 61         515 $self->_store_palette();
1236              
1237             # Calculate the offsets required by the BOUNDSHEET records
1238 61         384 $self->_calc_sheet_offsets();
1239              
1240             # Add BOUNDSHEET records.
1241 61         118 foreach my $sheet (@{$self->{_worksheets}}) {
  61         217  
1242 135         849 $self->_store_boundsheet($sheet->{_name},
1243             $sheet->{_offset},
1244             $sheet->{_sheet_type},
1245             $sheet->{_hidden},
1246             $sheet->{_encoding});
1247             }
1248              
1249             # NOTE: If any records are added between here and EOF the
1250             # _calc_sheet_offsets() should be updated to include the new length.
1251 61         425 $self->_store_country();
1252 61 100       238 if ($self->{_ext_ref_count}) {
1253 17         85 $self->_store_supbook();
1254 17         56 $self->_store_externsheet();
1255 17         56 $self->_store_names();
1256             }
1257 61         603 $self->_add_mso_drawing_group();
1258 61         1048 $self->_store_shared_strings();
1259 61         371 $self->_store_extsst();
1260              
1261             # End Workbook globals
1262 61         395 $self->_store_eof();
1263              
1264             # Store the workbook in an OLE container
1265 61         352 return $self->_store_OLE_file();
1266             }
1267              
1268              
1269             ###############################################################################
1270             #
1271             # _store_OLE_file()
1272             #
1273             # Store the workbook in an OLE container using the default handler or using
1274             # OLE::Storage_Lite if the workbook data is > ~ 7MB.
1275             #
1276             sub _store_OLE_file {
1277              
1278 61     61   118 my $self = shift;
1279 61         122 my $maxsize = 7_087_104;
1280              
1281 61 100 66     501 if (!$self->{_add_doc_properties} && $self->{_biffsize} <= $maxsize) {
1282             # Write the OLE file using OLEwriter if data <= 7MB
1283 60         912 my $OLE = Spreadsheet::WriteExcel::OLEwriter->new($self->{_fh_out});
1284              
1285             # Write the BIFF data without the OLE container for testing.
1286 60         178 $OLE->{_biff_only} = $self->{_biff_only};
1287              
1288             # Indicate that we created the filehandle and want to close it.
1289 60         165 $OLE->{_internal_fh} = $self->{_internal_fh};
1290              
1291 60         347 $OLE->set_size($self->{_biffsize});
1292 60         302 $OLE->write_header();
1293              
1294 60         501 while (my $tmp = $self->get_data()) {
1295 103         551 $OLE->write($tmp);
1296             }
1297              
1298 60         122 foreach my $worksheet (@{$self->{_worksheets}}) {
  60         683  
1299 134         907 while (my $tmp = $worksheet->get_data()) {
1300 265         1017 $OLE->write($tmp);
1301             }
1302             }
1303              
1304 60         510 return $OLE->close();
1305             }
1306             else {
1307             # Write the OLE file using OLE::Storage_Lite if data > 7MB
1308 1         2 eval { require OLE::Storage_Lite };
  1         1226  
1309              
1310 1 50       11149 if (not $@) {
1311              
1312             # Protect print() from -l on the command line.
1313 1         5 local $\ = undef;
1314              
1315 1         4 my @streams;
1316              
1317             # Create the Workbook stream.
1318 1         10 my $stream = pack 'v*', unpack 'C*', 'Workbook';
1319 1         7 my $workbook = OLE::Storage_Lite::PPS::File->newFile($stream);
1320              
1321 1         362 while (my $tmp = $self->get_data()) {
1322 2         9 $workbook->append($tmp);
1323             }
1324              
1325 1         3 foreach my $worksheet (@{$self->{_worksheets}}) {
  1         5  
1326 1         8 while (my $tmp = $worksheet->get_data()) {
1327 2         8 $workbook->append($tmp);
1328             }
1329             }
1330              
1331 1         3 push @streams, $workbook;
1332              
1333              
1334             # Create the properties streams, if any.
1335 1 50       6 if ($self->{_add_doc_properties}) {
1336 1         2 my $stream;
1337             my $summary;
1338              
1339 1         5 $stream = pack 'v*', unpack 'C*', "\5SummaryInformation";
1340 1         4 $summary = $self->{summary};
1341 1         1107 $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
1342 1         21 push @streams, $summary;
1343              
1344 1         7 $stream = pack 'v*', unpack 'C*', "\5DocumentSummaryInformation";
1345 1         5 $summary = $self->{doc_summary};
1346 1         14 $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
1347 1         18 push @streams, $summary;
1348             }
1349              
1350             # Create the OLE root document and add the substreams.
1351 1         2 my @localtime = @{ $self->{_localtime} };
  1         6  
1352 1         4 splice(@localtime, 6);
1353              
1354 1         9 my $ole_root = OLE::Storage_Lite::PPS::Root->new(\@localtime,
1355             \@localtime,
1356             \@streams);
1357 1         36 $ole_root->save($self->{_filename});
1358              
1359              
1360             # Close the filehandle if it was created internally.
1361 1 50       1273 return CORE::close($self->{_fh_out}) if $self->{_internal_fh};
1362             }
1363             else {
1364             # File in greater than limit, set $! to "File too large"
1365 0         0 $! = 27; # Perl error code "File too large"
1366              
1367 0         0 croak "Maximum Spreadsheet::WriteExcel filesize, $maxsize bytes, ".
1368             "exceeded. To create files bigger than this limit please " .
1369             "install OLE::Storage_Lite\n";
1370              
1371             # return 0;
1372             }
1373             }
1374             }
1375              
1376              
1377             ###############################################################################
1378             #
1379             # _calc_sheet_offsets()
1380             #
1381             # Calculate Worksheet BOF offsets records for use in the BOUNDSHEET records.
1382             #
1383             sub _calc_sheet_offsets {
1384              
1385 61     61   135 my $self = shift;
1386 61         208 my $BOF = 12;
1387 61         110 my $EOF = 4;
1388 61         147 my $offset = $self->{_datasize};
1389              
1390             # Add the length of the COUNTRY record
1391 61         108 $offset += 8;
1392              
1393             # Add the length of the SST and associated CONTINUEs
1394 61         468 $offset += $self->_calculate_shared_string_sizes();
1395              
1396             # Add the length of the EXTSST record.
1397 61         567 $offset += $self->_calculate_extsst_size();
1398              
1399             # Add the length of the SUPBOOK, EXTERNSHEET and NAME records
1400 61         1393 $offset += $self->_calculate_extern_sizes();
1401              
1402             # Add the length of the MSODRAWINGGROUP records including an extra 4 bytes
1403             # for any CONTINUE headers. See _add_mso_drawing_group_continue().
1404 61         167 my $mso_size = $self->{_mso_size};
1405 61         301 $mso_size += 4 * int(($mso_size -1) / $self->{_limit});
1406 61         203 $offset += $mso_size ;
1407              
1408 61         315 foreach my $sheet (@{$self->{_worksheets}}) {
  61         279  
1409 135         514 $offset += $BOF + length($sheet->{_name});
1410             }
1411              
1412 61         144 $offset += $EOF;
1413              
1414 61         106 foreach my $sheet (@{$self->{_worksheets}}) {
  61         159  
1415 135         313 $sheet->{_offset} = $offset;
1416 135         944 $sheet->_close();
1417 135         423 $offset += $sheet->{_datasize};
1418             }
1419              
1420 61         341 $self->{_biffsize} = $offset;
1421             }
1422              
1423              
1424             ###############################################################################
1425             #
1426             # _calc_mso_sizes()
1427             #
1428             # Calculate the MSODRAWINGGROUP sizes and the indexes of the Worksheet
1429             # MSODRAWING records.
1430             #
1431             # In the following SPID is shape id, according to Escher nomenclature.
1432             #
1433             sub _calc_mso_sizes {
1434              
1435 78     78   310 my $self = shift;
1436              
1437 78         156 my $mso_size = 0; # Size of the MSODRAWINGGROUP record
1438 78         163 my $start_spid = 1024; # Initial spid for each sheet
1439 78         131 my $max_spid = 1024; # spidMax
1440 78         163 my $num_clusters = 1; # cidcl
1441 78         142 my $shapes_saved = 0; # cspSaved
1442 78         125 my $drawings_saved = 0; # cdgSaved
1443 78         182 my @clusters = ();
1444              
1445              
1446 78         537 $self->_process_images();
1447              
1448             # Add Bstore container size if there are images.
1449 78 50       184 $mso_size += 8 if @{$self->{_images_data}};
  78         368  
1450              
1451              
1452             # Iterate through the worksheets, calculate the MSODRAWINGGROUP parameters
1453             # and space required to store the record and the MSODRAWING parameters
1454             # required by each worksheet.
1455             #
1456 78         170 foreach my $sheet (@{$self->{_worksheets}}) {
  78         527  
1457 168 100       594 next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
1458              
1459 166   50     879 my $num_images = $sheet->{_num_images} || 0;
1460 166   50     854 my $image_mso_size = $sheet->{_image_mso_size} || 0;
1461 166         656 my $num_comments = $sheet->_prepare_comments();
1462 166         862 my $num_charts = $sheet->_prepare_charts();
1463 166         357 my $num_filters = $sheet->{_filter_count};
1464              
1465 166 100       748 next unless $num_images + $num_comments + $num_charts +$num_filters;
1466              
1467              
1468             # Include 1 parent MSODRAWING shape, per sheet, in the shape count.
1469 37         94 my $num_shapes = 1 + $num_images
1470             + $num_comments
1471             + $num_charts
1472             + $num_filters;
1473 37         58 $shapes_saved += $num_shapes;
1474 37         59 $mso_size += $image_mso_size;
1475              
1476              
1477             # Add a drawing object for each sheet with comments.
1478 37         71 $drawings_saved++;
1479              
1480              
1481             # For each sheet start the spids at the next 1024 interval.
1482 37         158 $max_spid = 1024 * (1 + int(($max_spid -1)/1024));
1483 37         60 $start_spid = $max_spid;
1484              
1485              
1486             # Max spid for each sheet and eventually for the workbook.
1487 37         77 $max_spid += $num_shapes;
1488              
1489              
1490             # Store the cluster ids
1491 37         181 for (my $i = $num_shapes; $i > 0; $i -= 1024) {
1492 49         94 $num_clusters += 1;
1493 49         105 $mso_size += 8;
1494 49 100       127 my $size = $i > 1024 ? 1024 : $i;
1495              
1496 49         227 push @clusters, [$drawings_saved, $size];
1497             }
1498              
1499              
1500             # Pass calculated values back to the worksheet
1501 37         246 $sheet->{_object_ids} = [$start_spid, $drawings_saved,
1502             $num_shapes, $max_spid -1];
1503             }
1504              
1505              
1506             # Calculate the MSODRAWINGGROUP size if we have stored some shapes.
1507 78 100       392 $mso_size += 86 if $mso_size; # Smallest size is 86+8=94
1508              
1509              
1510 78         245 $self->{_mso_size} = $mso_size;
1511 78         440 $self->{_mso_clusters} = [
1512             $max_spid, $num_clusters, $shapes_saved,
1513             $drawings_saved, [@clusters]
1514             ];
1515             }
1516              
1517              
1518              
1519             ###############################################################################
1520             #
1521             # _process_images()
1522             #
1523             # We need to process each image in each worksheet and extract information.
1524             # Some of this information is stored and used in the Workbook and some is
1525             # passed back into each Worksheet. The overall size for the image related
1526             # BIFF structures in the Workbook is calculated here.
1527             #
1528             # MSO size = 8 bytes for bstore_container +
1529             # 44 bytes for blip_store_entry +
1530             # 25 bytes for blip
1531             # = 77 + image size.
1532             #
1533             sub _process_images {
1534              
1535 78     78   166 my $self = shift;
1536              
1537 78         154 my %images_seen;
1538             my @image_data;
1539 0         0 my @previous_images;
1540 78         149 my $image_id = 1;
1541 78         132 my $images_size = 0;
1542              
1543              
1544 78         162 foreach my $sheet (@{$self->{_worksheets}}) {
  78         290  
1545 168 100       755 next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
1546 166 50       677 next unless $sheet->_prepare_images();
1547              
1548 0         0 my $num_images = 0;
1549 0         0 my $image_mso_size = 0;
1550              
1551              
1552 0         0 for my $image_ref (@{$sheet->{_images_array}}) {
  0         0  
1553 0         0 my $filename = $image_ref->[2];
1554 0         0 $num_images++;
1555              
1556             #
1557             # For each Worksheet image we get a structure like this
1558             # [
1559             # $row,
1560             # $col,
1561             # $name,
1562             # $x_offset,
1563             # $y_offset,
1564             # $scale_x,
1565             # $scale_y,
1566             # ]
1567             #
1568             # And we add additional information:
1569             #
1570             # $image_id,
1571             # $type,
1572             # $width,
1573             # $height;
1574              
1575 0 0       0 if (not exists $images_seen{$filename}) {
1576             # TODO should also match seen images based on checksum.
1577              
1578             # Open the image file and import the data.
1579 0         0 my $fh = FileHandle->new($filename);
1580 0 0       0 croak "Couldn't import $filename: $!" unless defined $fh;
1581 0         0 binmode $fh;
1582              
1583             # Slurp the file into a string and do some size calcs.
1584 0         0 my $data = do {local $/; <$fh>};
  0         0  
  0         0  
1585 0         0 my $size = length $data;
1586 0         0 my $checksum1 = $self->_image_checksum($data, $image_id);
1587 0         0 my $checksum2 = $checksum1;
1588 0         0 my $ref_count = 1;
1589              
1590              
1591             # Process the image and extract dimensions.
1592 0         0 my ($type, $width, $height);
1593              
1594             # Test for PNGs...
1595 0 0 0     0 if (unpack('x A3', $data) eq 'PNG') {
    0 0        
    0          
1596 0         0 ($type, $width, $height) = $self->_process_png($data);
1597             }
1598             # Test for JFIF and Exif JPEGs...
1599             elsif ( (unpack('n', $data) == 0xFFD8) &&
1600             ( (unpack('x6 A4', $data) eq 'JFIF') ||
1601             (unpack('x6 A4', $data) eq 'Exif')
1602             )
1603             )
1604             {
1605 0         0 ($type, $width, $height) = $self->_process_jpg($data, $filename);
1606             }
1607             # Test for BMPs...
1608             elsif (unpack('A2', $data) eq 'BM') {
1609 0         0 ($type, $width, $height) = $self->_process_bmp($data,
1610             $filename);
1611             # The 14 byte header of the BMP is stripped off.
1612 0         0 $data = substr $data, 14;
1613              
1614             # A checksum of the new image data is also required.
1615 0         0 $checksum2 = $self->_image_checksum($data,
1616             $image_id,
1617             $image_id
1618             );
1619              
1620             # Adjust size -14 (header) + 16 (extra checksum).
1621 0         0 $size += 2;
1622             }
1623             else {
1624 0         0 croak "Unsupported image format for file: $filename\n";
1625             }
1626              
1627              
1628             # Push the new data back into the Worksheet array;
1629 0         0 push @$image_ref, $image_id, $type, $width, $height;
1630              
1631             # Also store new data for use in duplicate images.
1632 0         0 push @previous_images, [$image_id, $type, $width, $height];
1633              
1634              
1635             # Store information required by the Workbook.
1636 0         0 push @image_data, [$ref_count, $type, $data, $size,
1637             $checksum1, $checksum2];
1638              
1639             # Keep track of overall data size.
1640 0         0 $images_size += $size +61; # Size for bstore container.
1641 0         0 $image_mso_size += $size +69; # Size for dgg container.
1642              
1643 0         0 $images_seen{$filename} = $image_id++;
1644 0         0 $fh->close;
1645             }
1646             else {
1647             # We've processed this file already.
1648 0         0 my $index = $images_seen{$filename} -1;
1649              
1650             # Increase image reference count.
1651 0         0 $image_data[$index]->[0]++;
1652              
1653             # Add previously calculated data back onto the Worksheet array.
1654             # $image_id, $type, $width, $height
1655 0         0 my $a_ref = $sheet->{_images_array}->[$index];
1656 0         0 push @$image_ref, @{$previous_images[$index]};
  0         0  
1657             }
1658             }
1659              
1660             # Store information required by the Worksheet.
1661 0         0 $sheet->{_num_images} = $num_images;
1662 0         0 $sheet->{_image_mso_size} = $image_mso_size;
1663              
1664             }
1665              
1666              
1667             # Store information required by the Workbook.
1668 78         263 $self->{_images_size} = $images_size;
1669 78         617 $self->{_images_data} = \@image_data; # Store the data for MSODRAWINGGROUP.
1670              
1671             }
1672              
1673              
1674             ###############################################################################
1675             #
1676             # _image_checksum()
1677             #
1678             # Generate a checksum for the image using whichever module is available..The
1679             # available modules are checked in _get_checksum_method(). Excel uses an MD4
1680             # checksum but any other will do. In the event of no checksum module being
1681             # available we simulate a checksum using the image index.
1682             #
1683             sub _image_checksum {
1684              
1685 0     0   0 my $self = shift;
1686              
1687 0         0 my $data = $_[0];
1688 0         0 my $index1 = $_[1];
1689 0   0     0 my $index2 = $_[2] || 0;
1690              
1691 0 0       0 if ($self->{_checksum_method} == 1) {
    0          
    0          
1692             # Digest::MD4
1693 0         0 return Digest::MD4::md4_hex($data);
1694             }
1695             elsif ($self->{_checksum_method} == 2) {
1696             # Digest::Perl::MD4
1697 0         0 return Digest::Perl::MD4::md4_hex($data);
1698             }
1699             elsif ($self->{_checksum_method} == 3) {
1700             # Digest::MD5
1701 0         0 return Digest::MD5::md5_hex($data);
1702             }
1703             else {
1704             # Default
1705 0         0 return sprintf '%016X%016X', $index2, $index1;
1706             }
1707             }
1708              
1709              
1710             ###############################################################################
1711             #
1712             # _process_png()
1713             #
1714             # Extract width and height information from a PNG file.
1715             #
1716             sub _process_png {
1717              
1718 0     0   0 my $self = shift;
1719              
1720 0         0 my $type = 6; # Excel Blip type (MSOBLIPTYPE).
1721 0         0 my $width = unpack "N", substr $_[0], 16, 4;
1722 0         0 my $height = unpack "N", substr $_[0], 20, 4;
1723              
1724 0         0 return ($type, $width, $height);
1725             }
1726              
1727              
1728             ###############################################################################
1729             #
1730             # _process_bmp()
1731             #
1732             # Extract width and height information from a BMP file.
1733             #
1734             # Most of these checks came from the old Worksheet::_process_bitmap() method.
1735             #
1736             sub _process_bmp {
1737              
1738 0     0   0 my $self = shift;
1739 0         0 my $data = $_[0];
1740 0         0 my $filename = $_[1];
1741 0         0 my $type = 7; # Excel Blip type (MSOBLIPTYPE).
1742              
1743              
1744             # Check that the file is big enough to be a bitmap.
1745 0 0       0 if (length $data <= 0x36) {
1746 0         0 croak "$filename doesn't contain enough data.";
1747             }
1748              
1749              
1750             # Read the bitmap width and height. Verify the sizes.
1751 0         0 my ($width, $height) = unpack "x18 V2", $data;
1752              
1753 0 0       0 if ($width > 0xFFFF) {
1754 0         0 croak "$filename: largest image width $width supported is 65k.";
1755             }
1756              
1757 0 0       0 if ($height > 0xFFFF) {
1758 0         0 croak "$filename: largest image height supported is 65k.";
1759             }
1760              
1761             # Read the bitmap planes and bpp data. Verify them.
1762 0         0 my ($planes, $bitcount) = unpack "x26 v2", $data;
1763              
1764 0 0       0 if ($bitcount != 24) {
1765 0         0 croak "$filename isn't a 24bit true color bitmap.";
1766             }
1767              
1768 0 0       0 if ($planes != 1) {
1769 0         0 croak "$filename: only 1 plane supported in bitmap image.";
1770             }
1771              
1772              
1773             # Read the bitmap compression. Verify compression.
1774 0         0 my $compression = unpack "x30 V", $data;
1775              
1776 0 0       0 if ($compression != 0) {
1777 0         0 croak "$filename: compression not supported in bitmap image.";
1778             }
1779              
1780 0         0 return ($type, $width, $height);
1781             }
1782              
1783              
1784             ###############################################################################
1785             #
1786             # _process_jpg()
1787             #
1788             # Extract width and height information from a JPEG file.
1789             #
1790             sub _process_jpg {
1791              
1792 5     5   3328 my $self = shift;
1793 5         10 my $data = $_[0];
1794 5         6 my $filename = $_[1];
1795 5         8 my $type = 5; # Excel Blip type (MSOBLIPTYPE).
1796 5         6 my $width;
1797             my $height;
1798              
1799 5         6 my $offset = 2;
1800 5         6 my $data_length = length $data;
1801              
1802             # Search through the image data to find the 0xFFC0 marker. The height and
1803             # width are contained in the data for that sub element.
1804 5         14 while ($offset < $data_length) {
1805              
1806 24         37 my $marker = unpack "n", substr $data, $offset, 2;
1807 24         32 my $length = unpack "n", substr $data, $offset +2, 2;
1808              
1809 24 100 100     89 if ($marker == 0xFFC0 || $marker == 0xFFC2) {
1810 3         5 $height = unpack "n", substr $data, $offset +5, 2;
1811 3         7 $width = unpack "n", substr $data, $offset +7, 2;
1812 3         5 last;
1813             }
1814              
1815 21         19 $offset = $offset + $length + 2;
1816 21 100       52 last if $marker == 0xFFDA;
1817             }
1818              
1819 5 100       11 if (not defined $height) {
1820 2         424 croak "$filename: no size data found in jpeg image.\n";
1821             }
1822              
1823 3         11 return ($type, $width, $height);
1824             }
1825              
1826              
1827             ###############################################################################
1828             #
1829             # _store_all_fonts()
1830             #
1831             # Store the Excel FONT records.
1832             #
1833             sub _store_all_fonts {
1834              
1835 61     61   272 my $self = shift;
1836              
1837 61         221 my $format = $self->{_formats}->[15]; # The default cell format.
1838 61         443 my $font = $format->get_font();
1839              
1840             # Fonts are 0-indexed. According to the SDK there is no index 4,
1841 61         217 for (0..3) {
1842 244         618 $self->_append($font);
1843             }
1844              
1845              
1846             # Add the default fonts for charts and comments. This aren't connected
1847             # to XF formats. Note, the font size, and some other properties of
1848             # chart fonts are set in the FBI record of the chart.
1849 61         132 my $tmp_format;
1850              
1851             # Index 5. Axis numbers.
1852 61         647 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1853             undef,
1854             font_only => 1,
1855             );
1856 61         277 $self->_append( $tmp_format->get_font() );
1857              
1858             # Index 6. Series names.
1859 61         324 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1860             undef,
1861             font_only => 1,
1862             );
1863 61         658 $self->_append( $tmp_format->get_font() );
1864              
1865             # Index 7. Title.
1866 61         304 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1867             undef,
1868             font_only => 1,
1869             bold => 1,
1870             );
1871 61         479 $self->_append( $tmp_format->get_font() );
1872              
1873             # Index 8. Axes.
1874 61         303 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1875             undef,
1876             font_only => 1,
1877             bold => 1,
1878             );
1879 61         473 $self->_append( $tmp_format->get_font() );
1880              
1881             # Index 9. Comments.
1882 61         334 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1883             undef,
1884             font_only => 1,
1885             font => 'Tahoma',
1886             size => 8,
1887             );
1888 61         551 $self->_append( $tmp_format->get_font() );
1889              
1890              
1891             # Iterate through the XF objects and write a FONT record if it isn't the
1892             # same as the default FONT and if it hasn't already been used.
1893             #
1894 61         115 my %fonts;
1895             my $key;
1896 61         126 my $index = 10; # The first user defined FONT
1897              
1898 61         453 $key = $format->get_font_key(); # The default font for cell formats.
1899 61         214 $fonts{$key} = 0; # Index of the default font
1900              
1901             # Fonts that are marked as '_font_only' are always stored. These are used
1902             # mainly for charts and may not have an associated XF record.
1903              
1904 61         126 foreach $format (@{$self->{_formats}}) {
  61         211  
1905 1346         3757 $key = $format->get_font_key();
1906              
1907 1346 100 66     6960 if (not $format->{_font_only} and exists $fonts{$key}) {
1908             # FONT has already been used
1909 1284         3458 $format->{_font_index} = $fonts{$key};
1910             }
1911             else {
1912             # Add a new FONT record
1913              
1914 62 50       258 if (not $format->{_font_only}) {
1915 62         205 $fonts{$key} = $index;
1916             }
1917              
1918 62         142 $format->{_font_index} = $index;
1919 62         111 $index++;
1920 62         276 $font = $format->get_font();
1921 62         230 $self->_append($font);
1922             }
1923             }
1924             }
1925              
1926              
1927             ###############################################################################
1928             #
1929             # _store_all_num_formats()
1930             #
1931             # Store user defined numerical formats i.e. FORMAT records
1932             #
1933             sub _store_all_num_formats {
1934              
1935 61     61   340 my $self = shift;
1936              
1937 61         102 my %num_formats;
1938             my @num_formats;
1939 0         0 my $num_format;
1940 61         133 my $index = 164; # User defined FORMAT records start from 0xA4
1941              
1942              
1943             # Iterate through the XF objects and write a FORMAT record if it isn't a
1944             # built-in format type and if the FORMAT string hasn't already been used.
1945             #
1946 61         122 foreach my $format (@{$self->{_formats}}) {
  61         219  
1947 1346         1980 my $num_format = $format->{_num_format};
1948 1346         2062 my $encoding = $format->{_num_format_enc};
1949              
1950             # Check if $num_format is an index to a built-in format.
1951             # Also check for a string of zeros, which is a valid format string
1952             # but would evaluate to zero.
1953             #
1954 1346 50       3033 if ($num_format !~ m/^0+\d/) {
1955 1346 50       4841 next if $num_format =~ m/^\d+$/; # built-in
1956             }
1957              
1958 0 0       0 if (exists($num_formats{$num_format})) {
1959             # FORMAT has already been used
1960 0         0 $format->{_num_format} = $num_formats{$num_format};
1961             }
1962             else{
1963             # Add a new FORMAT
1964 0         0 $num_formats{$num_format} = $index;
1965 0         0 $format->{_num_format} = $index;
1966 0         0 $self->_store_num_format($num_format, $index, $encoding);
1967 0         0 $index++;
1968             }
1969             }
1970             }
1971              
1972              
1973             ###############################################################################
1974             #
1975             # _store_all_xfs()
1976             #
1977             # Write all XF records.
1978             #
1979             sub _store_all_xfs {
1980              
1981 61     61   144 my $self = shift;
1982              
1983 61         122 foreach my $format (@{$self->{_formats}}) {
  61         203  
1984 1346         4118 my $xf = $format->get_xf();
1985 1346         3323 $self->_append($xf);
1986             }
1987             }
1988              
1989              
1990             ###############################################################################
1991             #
1992             # _store_all_styles()
1993             #
1994             # Write all STYLE records.
1995             #
1996             sub _store_all_styles {
1997              
1998 61     61   135 my $self = shift;
1999              
2000             # Excel adds the built-in styles in alphabetical order.
2001 61         989 my @built_ins = (
2002             [0x03, 16], # Comma
2003             [0x06, 17], # Comma[0]
2004             [0x04, 18], # Currency
2005             [0x07, 19], # Currency[0]
2006             [0x00, 0], # Normal
2007             [0x05, 20], # Percent
2008              
2009             # We don't deal with these styles yet.
2010             #[0x08, 21], # Hyperlink
2011             #[0x02, 8], # ColLevel_n
2012             #[0x01, 1], # RowLevel_n
2013             );
2014              
2015              
2016 61         175 for my $aref (@built_ins) {
2017 366         538 my $type = $aref->[0];
2018 366         460 my $xf_index = $aref->[1];
2019              
2020 366         1124 $self->_store_style($type, $xf_index);
2021             }
2022             }
2023              
2024              
2025             ###############################################################################
2026             #
2027             # _store_names()
2028             #
2029             # Write the NAME record to define the print area and the repeat rows and cols.
2030             #
2031             sub _store_names {
2032              
2033 34     34   26050 my $self = shift;
2034 34         60 my $index;
2035 34         85 my %ext_refs = %{$self->{_ext_refs}};
  34         142  
2036              
2037              
2038             # Create the user defined names.
2039 34         79 for my $defined_name (@{$self->{_defined_names}}) {
  34         94  
2040              
2041 0         0 $self->_store_name(
2042             $defined_name->{name},
2043             $defined_name->{encoding},
2044             $defined_name->{sheet_index},
2045             $defined_name->{formula},
2046             );
2047             }
2048              
2049             # Sort the worksheets into alphabetical order by name. This is a
2050             # requirement for some non-English language Excel patch levels.
2051 34         55 my @worksheets = @{$self->{_worksheets}};
  34         90  
2052 34         78 @worksheets = sort { $a->{_name} cmp $b->{_name} } @worksheets;
  46         93  
2053              
2054             # Create the autofilter NAME records
2055 34         68 foreach my $worksheet (@worksheets) {
2056 60         120 $index = $worksheet->{_index};
2057 60         143 my $key = "$index:$index";
2058 60         89 my $ref = $ext_refs{$key};
2059              
2060             # Write a Name record if Autofilter has been defined
2061 60 100       240 if ($worksheet->{_filter_count}) {
2062 6         40 $self->_store_name_short(
2063             $worksheet->{_index},
2064             0x0D, # NAME type = Filter Database
2065             $ref,
2066             $worksheet->{_filter_area}->[0],
2067             $worksheet->{_filter_area}->[1],
2068             $worksheet->{_filter_area}->[2],
2069             $worksheet->{_filter_area}->[3],
2070             1, # Hidden
2071             );
2072             }
2073             }
2074              
2075             # Create the print area NAME records
2076 34         75 foreach my $worksheet (@worksheets) {
2077 60         101 $index = $worksheet->{_index};
2078 60         122 my $key = "$index:$index";
2079 60         77 my $ref = $ext_refs{$key};
2080              
2081             # Write a Name record if the print area has been defined
2082 60 100       181 if (defined $worksheet->{_print_rowmin}) {
2083 20         84 $self->_store_name_short(
2084             $worksheet->{_index},
2085             0x06, # NAME type = Print_Area
2086             $ref,
2087             $worksheet->{_print_rowmin},
2088             $worksheet->{_print_rowmax},
2089             $worksheet->{_print_colmin},
2090             $worksheet->{_print_colmax}
2091             );
2092             }
2093             }
2094              
2095             # Create the print title NAME records
2096 34         73 foreach my $worksheet (@worksheets) {
2097 60         98 $index = $worksheet->{_index};
2098              
2099 60         83 my $rowmin = $worksheet->{_title_rowmin};
2100 60         94 my $rowmax = $worksheet->{_title_rowmax};
2101 60         90 my $colmin = $worksheet->{_title_colmin};
2102 60         91 my $colmax = $worksheet->{_title_colmax};
2103 60         96 my $key = "$index:$index";
2104 60         89 my $ref = $ext_refs{$key};
2105              
2106             # Determine if row + col, row, col or nothing has been defined
2107             # and write the appropriate record
2108             #
2109 60 100 100     351 if (defined $rowmin && defined $colmin) {
    100          
    100          
2110             # Row and column titles have been defined.
2111             # Row title has been defined.
2112 2         18 $self->_store_name_long(
2113             $worksheet->{_index},
2114             0x07, # NAME type = Print_Titles
2115             $ref,
2116             $rowmin,
2117             $rowmax,
2118             $colmin,
2119             $colmax
2120             );
2121             }
2122             elsif (defined $rowmin) {
2123             # Row title has been defined.
2124 16         61 $self->_store_name_short(
2125             $worksheet->{_index},
2126             0x07, # NAME type = Print_Titles
2127             $ref,
2128             $rowmin,
2129             $rowmax,
2130             0x00,
2131             0xff
2132             );
2133             }
2134             elsif (defined $colmin) {
2135             # Column title has been defined.
2136 8         39 $self->_store_name_short(
2137             $worksheet->{_index},
2138             0x07, # NAME type = Print_Titles
2139             $ref,
2140             0x0000,
2141             0xffff,
2142             $colmin,
2143             $colmax
2144             );
2145             }
2146             else {
2147             # Nothing left to do
2148             }
2149             }
2150             }
2151              
2152              
2153              
2154              
2155             ###############################################################################
2156             ###############################################################################
2157             #
2158             # BIFF RECORDS
2159             #
2160              
2161              
2162             ###############################################################################
2163             #
2164             # _store_window1()
2165             #
2166             # Write Excel BIFF WINDOW1 record.
2167             #
2168             sub _store_window1 {
2169              
2170 61     61   137 my $self = shift;
2171              
2172 61         121 my $record = 0x003D; # Record identifier
2173 61         114 my $length = 0x0012; # Number of bytes to follow
2174              
2175 61         125 my $xWn = 0x0000; # Horizontal position of window
2176 61         137 my $yWn = 0x0000; # Vertical position of window
2177 61         118 my $dxWn = 0x355C; # Width of window
2178 61         120 my $dyWn = 0x30ED; # Height of window
2179              
2180 61         115 my $grbit = 0x0038; # Option flags
2181 61         206 my $ctabsel = $self->{_selected}; # Number of workbook tabs selected
2182 61         118 my $wTabRatio = 0x0258; # Tab to scrollbar ratio
2183              
2184 61         152 my $itabFirst = $self->{_firstsheet}; # 1st displayed worksheet
2185 61         142 my $itabCur = $self->{_activesheet}; # Active worksheet
2186              
2187 61         186 my $header = pack("vv", $record, $length);
2188 61         212 my $data = pack("vvvvvvvvv", $xWn, $yWn, $dxWn, $dyWn,
2189             $grbit,
2190             $itabCur, $itabFirst,
2191             $ctabsel, $wTabRatio);
2192              
2193 61         240 $self->_append($header, $data);
2194             }
2195              
2196              
2197             ###############################################################################
2198             #
2199             # _store_boundsheet()
2200             #
2201             # Writes Excel BIFF BOUNDSHEET record.
2202             #
2203             sub _store_boundsheet {
2204              
2205 135     135   220 my $self = shift;
2206              
2207 135         183 my $record = 0x0085; # Record identifier
2208 135         223 my $length = 0x08 + length($_[0]); # Number of bytes to follow
2209              
2210 135         210 my $sheetname = $_[0]; # Worksheet name
2211 135         197 my $offset = $_[1]; # Location of worksheet BOF
2212 135         167 my $type = $_[2]; # Worksheet type
2213 135         199 my $hidden = $_[3]; # Worksheet hidden flag
2214 135         179 my $encoding = $_[4]; # Sheet name encoding
2215 135         1329 my $cch = length($sheetname); # Length of sheet name
2216              
2217 135         1639 my $grbit = $type | $hidden;
2218              
2219             # Character length is num of chars not num of bytes
2220 135 100       318 $cch /= 2 if $encoding;
2221              
2222             # Change the UTF-16 name from BE to LE
2223 135 100       353 $sheetname = pack 'n*', unpack 'v*', $sheetname if $encoding;
2224              
2225 135         284 my $header = pack("vv", $record, $length);
2226 135         302 my $data = pack("VvCC", $offset, $grbit, $cch, $encoding);
2227              
2228 135         399 $self->_append($header, $data, $sheetname);
2229             }
2230              
2231              
2232             ###############################################################################
2233             #
2234             # _store_style()
2235             #
2236             # Write Excel BIFF STYLE records.
2237             #
2238             sub _store_style {
2239              
2240 366     366   455 my $self = shift;
2241              
2242 366         421 my $record = 0x0293; # Record identifier
2243 366         426 my $length = 0x0004; # Bytes to follow
2244              
2245 366         684 my $type = $_[0]; # Built-in style
2246 366         433 my $xf_index = $_[1]; # Index to style XF
2247 366         407 my $level = 0xff; # Outline style level
2248              
2249 366         464 $xf_index |= 0x8000; # Add flag to indicate built-in style.
2250              
2251              
2252 366         689 my $header = pack("vv", $record, $length);
2253 366         699 my $data = pack("vCC", $xf_index, $type, $level);
2254              
2255 366         818 $self->_append($header, $data);
2256             }
2257              
2258              
2259             ###############################################################################
2260             #
2261             # _store_num_format()
2262             #
2263             # Writes Excel FORMAT record for non "built-in" numerical formats.
2264             #
2265             sub _store_num_format {
2266              
2267 0     0   0 my $self = shift;
2268              
2269 0         0 my $record = 0x041E; # Record identifier
2270 0         0 my $length; # Number of bytes to follow
2271              
2272 0         0 my $format = $_[0]; # Custom format string
2273 0         0 my $ifmt = $_[1]; # Format index code
2274 0         0 my $encoding = $_[2]; # Char encoding for format string
2275              
2276              
2277             # Handle utf8 strings in perl 5.8.
2278 0 0       0 if ($] >= 5.008) {
2279 0         0 require Encode;
2280              
2281 0 0       0 if (Encode::is_utf8($format)) {
2282 0         0 $format = Encode::encode("UTF-16BE", $format);
2283 0         0 $encoding = 1;
2284             }
2285             }
2286              
2287              
2288             # Char length of format string
2289 0         0 my $cch = length $format;
2290              
2291              
2292             # Handle Unicode format strings.
2293 0 0       0 if ($encoding == 1) {
2294 0 0       0 croak "Uneven number of bytes in Unicode font name" if $cch % 2;
2295 0 0       0 $cch /= 2 if $encoding;
2296 0         0 $format = pack 'v*', unpack 'n*', $format;
2297             }
2298              
2299              
2300             # Special case to handle Euro symbol, 0x80, in non-Unicode strings.
2301 0 0 0     0 if ($encoding == 0 and $format =~ /\x80/) {
2302 0         0 $format = pack 'v*', unpack 'C*', $format;
2303 0         0 $format =~ s/\x80\x00/\xAC\x20/g;
2304 0         0 $encoding = 1;
2305             }
2306              
2307 0         0 $length = 0x05 + length $format;
2308              
2309 0         0 my $header = pack("vv", $record, $length);
2310 0         0 my $data = pack("vvC", $ifmt, $cch, $encoding);
2311              
2312 0         0 $self->_append($header, $data, $format);
2313             }
2314              
2315              
2316             ###############################################################################
2317             #
2318             # _store_1904()
2319             #
2320             # Write Excel 1904 record to indicate the date system in use.
2321             #
2322             sub _store_1904 {
2323              
2324 61     61   132 my $self = shift;
2325              
2326 61         115 my $record = 0x0022; # Record identifier
2327 61         130 my $length = 0x0002; # Bytes to follow
2328              
2329 61         148 my $f1904 = $self->{_1904}; # Flag for 1904 date system
2330              
2331 61         196 my $header = pack("vv", $record, $length);
2332 61         147 my $data = pack("v", $f1904);
2333              
2334 61         221 $self->_append($header, $data);
2335             }
2336              
2337              
2338             ###############################################################################
2339             #
2340             # _store_supbook()
2341             #
2342             # Write BIFF record SUPBOOK to indicate that the workbook contains external
2343             # references, in our case, formula, print area and print title refs.
2344             #
2345             sub _store_supbook {
2346              
2347 17     17   33 my $self = shift;
2348              
2349 17         26 my $record = 0x01AE; # Record identifier
2350 17         27 my $length = 0x0004; # Number of bytes to follow
2351              
2352 17         27 my $ctabs = @{$self->{_worksheets}}; # Number of worksheets
  17         37  
2353 17         25 my $StVirtPath = 0x0401; # Encoded workbook filename
2354              
2355 17         39 my $header = pack("vv", $record, $length);
2356 17         34 my $data = pack("vv", $ctabs, $StVirtPath);
2357              
2358 17         47 $self->_append($header, $data);
2359             }
2360              
2361              
2362             ###############################################################################
2363             #
2364             # _store_externsheet()
2365             #
2366             # Writes the Excel BIFF EXTERNSHEET record. These references are used by
2367             # formulas. TODO NAME record is required to define the print area and the
2368             # repeat rows and columns.
2369             #
2370             sub _store_externsheet {
2371              
2372 34     34   125 my $self = shift;
2373              
2374 34         44 my $record = 0x0017; # Record identifier
2375 34         58 my $length; # Number of bytes to follow
2376              
2377              
2378             # Get the external refs
2379 34         39 my %ext_refs = %{$self->{_ext_refs}};
  34         174  
2380 34         202 my @ext_refs = sort {$ext_refs{$a} <=> $ext_refs{$b}} keys %ext_refs;
  25         73  
2381              
2382             # Change the external refs from stringified "1:1" to [1, 1]
2383 34         66 foreach my $ref (@ext_refs) {
2384 52         294 $ref = [split /:/, $ref];
2385             }
2386              
2387              
2388 34         49 my $cxti = scalar @ext_refs; # Number of Excel XTI structures
2389 34         61 my $rgxti = ''; # Array of XTI structures
2390              
2391             # Write the XTI structs
2392 34         54 foreach my $ext_ref (@ext_refs) {
2393 52         253 $rgxti .= pack("vvv", 0, $ext_ref->[0], $ext_ref->[1])
2394             }
2395              
2396              
2397 34         102 my $data = pack("v", $cxti) . $rgxti;
2398 34         76 my $header = pack("vv", $record, length $data);
2399              
2400 34         104 $self->_append($header, $data);
2401             }
2402              
2403              
2404             ###############################################################################
2405             #
2406             # _store_name()
2407             #
2408             #
2409             # Store the NAME record used for storing the print area, repeat rows, repeat
2410             # columns, autofilters and defined names.
2411             #
2412             # TODO. This is a more generic version that will replace _store_name_short()
2413             # and _store_name_long().
2414             #
2415             sub _store_name {
2416              
2417 8     8   8601 my $self = shift;
2418              
2419 8         11 my $record = 0x0018; # Record identifier
2420 8         12 my $length; # Number of bytes to follow
2421              
2422 8         11 my $name = shift;
2423 8         9 my $encoding = shift;
2424 8         13 my $sheet_index = shift;
2425 8         9 my $formula = shift;
2426              
2427 8         13 my $text_length = length $name;
2428 8         8 my $formula_length = length $formula;
2429              
2430             # UTF-16 string length is in characters not bytes.
2431 8 50       22 $text_length /= 2 if $encoding;
2432              
2433              
2434 8         9 my $grbit = 0x0000; # Option flags
2435 8         10 my $shortcut = 0x00; # Keyboard shortcut
2436 8         6 my $ixals = 0x0000; # Unused index.
2437 8         10 my $menu_length = 0x00; # Length of cust menu text
2438 8         9 my $desc_length = 0x00; # Length of description text
2439 8         9 my $help_length = 0x00; # Length of help topic text
2440 8         8 my $status_length = 0x00; # Length of status bar text
2441              
2442             # Set grbit built-in flag and the hidden flag for autofilters.
2443 8 100       22 if ($text_length == 1) {
2444 7 100       17 $grbit = 0x0020 if ord $name == 0x06; # Print area
2445 7 100       18 $grbit = 0x0020 if ord $name == 0x07; # Print titles
2446 7 100       17 $grbit = 0x0021 if ord $name == 0x0D; # Autofilter
2447             }
2448              
2449 8         21 my $data = pack "v", $grbit;
2450 8         19 $data .= pack "C", $shortcut;
2451 8         12 $data .= pack "C", $text_length;
2452 8         14 $data .= pack "v", $formula_length;
2453 8         13 $data .= pack "v", $ixals;
2454 8         18 $data .= pack "v", $sheet_index;
2455 8         11 $data .= pack "C", $menu_length;
2456 8         11 $data .= pack "C", $desc_length;
2457 8         14 $data .= pack "C", $help_length;
2458 8         11 $data .= pack "C", $status_length;
2459 8         10 $data .= pack "C", $encoding;
2460 8         10 $data .= $name;
2461 8         9 $data .= $formula;
2462              
2463 8         19 my $header = pack "vv", $record, length $data;
2464              
2465 8         26 $self->_append($header, $data);
2466             }
2467              
2468              
2469             ###############################################################################
2470             #
2471             # _store_name_short()
2472             #
2473             #
2474             # Store the NAME record in the short format that is used for storing the print
2475             # area, repeat rows only and repeat columns only.
2476             #
2477             sub _store_name_short {
2478              
2479 50     50   64 my $self = shift;
2480              
2481 50         63 my $record = 0x0018; # Record identifier
2482 50         57 my $length = 0x001b; # Number of bytes to follow
2483              
2484 50         78 my $index = shift; # Sheet index
2485 50         56 my $type = shift;
2486 50         60 my $ext_ref = shift; # TODO
2487              
2488 50         59 my $grbit = 0x0020; # Option flags
2489 50         58 my $chKey = 0x00; # Keyboard shortcut
2490 50         50 my $cch = 0x01; # Length of text name
2491 50         59 my $cce = 0x000b; # Length of text definition
2492 50         62 my $unknown01 = 0x0000; #
2493 50         70 my $ixals = $index +1; # Sheet index
2494 50         59 my $unknown02 = 0x00; #
2495 50         56 my $cchCustMenu = 0x00; # Length of cust menu text
2496 50         52 my $cchDescription = 0x00; # Length of description text
2497 50         56 my $cchHelptopic = 0x00; # Length of help topic text
2498 50         56 my $cchStatustext = 0x00; # Length of status bar text
2499 50         51 my $rgch = $type; # Built-in name type
2500 50         58 my $unknown03 = 0x3b; #
2501              
2502 50         64 my $rowmin = $_[0]; # Start row
2503 50         72 my $rowmax = $_[1]; # End row
2504 50         66 my $colmin = $_[2]; # Start column
2505 50         74 my $colmax = $_[3]; # end column
2506              
2507 50         60 my $hidden = $_[4]; # Name is hidden
2508 50 100       127 $grbit = 0x0021 if $hidden;
2509              
2510 50         113 my $header = pack("vv", $record, $length);
2511 50         76 my $data = pack("v", $grbit);
2512 50         89 $data .= pack("C", $chKey);
2513 50         72 $data .= pack("C", $cch);
2514 50         78 $data .= pack("v", $cce);
2515 50         77 $data .= pack("v", $unknown01);
2516 50         66 $data .= pack("v", $ixals);
2517 50         72 $data .= pack("C", $unknown02);
2518 50         67 $data .= pack("C", $cchCustMenu);
2519 50         119 $data .= pack("C", $cchDescription);
2520 50         70 $data .= pack("C", $cchHelptopic);
2521 50         65 $data .= pack("C", $cchStatustext);
2522 50         72 $data .= pack("C", $rgch);
2523 50         73 $data .= pack("C", $unknown03);
2524 50         68 $data .= pack("v", $ext_ref);
2525              
2526 50         62 $data .= pack("v", $rowmin);
2527 50         75 $data .= pack("v", $rowmax);
2528 50         72 $data .= pack("v", $colmin);
2529 50         63 $data .= pack("v", $colmax);
2530              
2531 50         111 $self->_append($header, $data);
2532             }
2533              
2534              
2535             ###############################################################################
2536             #
2537             # _store_name_long()
2538             #
2539             #
2540             # Store the NAME record in the long format that is used for storing the repeat
2541             # rows and columns when both are specified. This share a lot of code with
2542             # _store_name_short() but we use a separate method to keep the code clean.
2543             # Code abstraction for reuse can be carried too far, and I should know. ;-)
2544             #
2545             sub _store_name_long {
2546              
2547 2     2   4 my $self = shift;
2548              
2549 2         4 my $record = 0x0018; # Record identifier
2550 2         3 my $length = 0x002a; # Number of bytes to follow
2551              
2552 2         3 my $index = shift; # Sheet index
2553 2         4 my $type = shift;
2554 2         3 my $ext_ref = shift; # TODO
2555              
2556 2         4 my $grbit = 0x0020; # Option flags
2557 2         4 my $chKey = 0x00; # Keyboard shortcut
2558 2         7 my $cch = 0x01; # Length of text name
2559 2         3 my $cce = 0x001a; # Length of text definition
2560 2         3 my $unknown01 = 0x0000; #
2561 2         3 my $ixals = $index +1; # Sheet index
2562 2         3 my $unknown02 = 0x00; #
2563 2         2 my $cchCustMenu = 0x00; # Length of cust menu text
2564 2         4 my $cchDescription = 0x00; # Length of description text
2565 2         2 my $cchHelptopic = 0x00; # Length of help topic text
2566 2         3 my $cchStatustext = 0x00; # Length of status bar text
2567 2         4 my $rgch = $type; # Built-in name type
2568              
2569 2         3 my $unknown03 = 0x29;
2570 2         2 my $unknown04 = 0x0017;
2571 2         4 my $unknown05 = 0x3b;
2572              
2573 2         3 my $rowmin = $_[0]; # Start row
2574 2         4 my $rowmax = $_[1]; # End row
2575 2         4 my $colmin = $_[2]; # Start column
2576 2         3 my $colmax = $_[3]; # end column
2577              
2578              
2579 2         7 my $header = pack("vv", $record, $length);
2580 2         5 my $data = pack("v", $grbit);
2581 2         5 $data .= pack("C", $chKey);
2582 2         4 $data .= pack("C", $cch);
2583 2         3 $data .= pack("v", $cce);
2584 2         4 $data .= pack("v", $unknown01);
2585 2         6 $data .= pack("v", $ixals);
2586 2         4 $data .= pack("C", $unknown02);
2587 2         4 $data .= pack("C", $cchCustMenu);
2588 2         3 $data .= pack("C", $cchDescription);
2589 2         5 $data .= pack("C", $cchHelptopic);
2590 2         4 $data .= pack("C", $cchStatustext);
2591 2         4 $data .= pack("C", $rgch);
2592              
2593             # Column definition
2594 2         4 $data .= pack("C", $unknown03);
2595 2         4 $data .= pack("v", $unknown04);
2596 2         5 $data .= pack("C", $unknown05);
2597 2         4 $data .= pack("v", $ext_ref);
2598 2         3 $data .= pack("v", 0x0000);
2599 2         3 $data .= pack("v", 0xffff);
2600 2         5 $data .= pack("v", $colmin);
2601 2         4 $data .= pack("v", $colmax);
2602              
2603             # Row definition
2604 2         4 $data .= pack("C", $unknown05);
2605 2         4 $data .= pack("v", $ext_ref);
2606 2         4 $data .= pack("v", $rowmin);
2607 2         3 $data .= pack("v", $rowmax);
2608 2         3 $data .= pack("v", 0x00);
2609 2         4 $data .= pack("v", 0xff);
2610             # End of data
2611 2         3 $data .= pack("C", 0x10);
2612              
2613 2         6 $self->_append($header, $data);
2614             }
2615              
2616              
2617             ###############################################################################
2618             #
2619             # _store_palette()
2620             #
2621             # Stores the PALETTE biff record.
2622             #
2623             sub _store_palette {
2624              
2625 61     61   141 my $self = shift;
2626              
2627 61         178 my $aref = $self->{_palette};
2628              
2629 61         135 my $record = 0x0092; # Record identifier
2630 61         188 my $length = 2 + 4 * @$aref; # Number of bytes to follow
2631 61         103 my $ccv = @$aref; # Number of RGB values to follow
2632 61         98 my $data; # The RGB data
2633              
2634             # Pack the RGB data
2635 61         2996 $data .= pack "CCCC", @$_ for @$aref;
2636              
2637 61         234 my $header = pack("vvv", $record, $length, $ccv);
2638              
2639 61         206 $self->_append($header, $data);
2640             }
2641              
2642              
2643             ###############################################################################
2644             #
2645             # _store_codepage()
2646             #
2647             # Stores the CODEPAGE biff record.
2648             #
2649             sub _store_codepage {
2650              
2651 61     61   128 my $self = shift;
2652              
2653 61         127 my $record = 0x0042; # Record identifier
2654 61         121 my $length = 0x0002; # Number of bytes to follow
2655 61         207 my $cv = $self->{_codepage}; # The code page
2656              
2657 61         172 my $header = pack("vv", $record, $length);
2658 61         186 my $data = pack("v", $cv);
2659              
2660 61         350 $self->_append($header, $data);
2661             }
2662              
2663              
2664             ###############################################################################
2665             #
2666             # _store_country()
2667             #
2668             # Stores the COUNTRY biff record.
2669             #
2670             sub _store_country {
2671              
2672 61     61   122 my $self = shift;
2673              
2674 61         142 my $record = 0x008C; # Record identifier
2675 61         100 my $length = 0x0004; # Number of bytes to follow
2676 61         137 my $country_default = $self->{_country};
2677 61         134 my $country_win_ini = $self->{_country};
2678              
2679 61         3209 my $header = pack("vv", $record, $length);
2680 61         313 my $data = pack("vv", $country_default, $country_win_ini);
2681              
2682 61         201 $self->_append($header, $data);
2683             }
2684              
2685              
2686             ###############################################################################
2687             #
2688             # _store_hideobj()
2689             #
2690             # Stores the HIDEOBJ biff record.
2691             #
2692             sub _store_hideobj {
2693              
2694 61     61   141 my $self = shift;
2695              
2696 61         114 my $record = 0x008D; # Record identifier
2697 61         108 my $length = 0x0002; # Number of bytes to follow
2698 61         150 my $hide = $self->{_hideobj}; # Option to hide objects
2699              
2700 61         192 my $header = pack("vv", $record, $length);
2701 61         167 my $data = pack("v", $hide);
2702              
2703 61         253 $self->_append($header, $data);
2704             }
2705              
2706              
2707             ###############################################################################
2708             ###############################################################################
2709             ###############################################################################
2710              
2711              
2712              
2713             ###############################################################################
2714             #
2715             # _calculate_extern_sizes()
2716             #
2717             # We need to calculate the space required by the SUPBOOK, EXTERNSHEET and NAME
2718             # records so that it can be added to the BOUNDSHEET offsets.
2719             #
2720             sub _calculate_extern_sizes {
2721              
2722 78     78   229 my $self = shift;
2723              
2724              
2725 78         562 my %ext_refs = $self->{_parser}->get_ext_sheets();
2726 78         215 my $ext_ref_count = scalar keys %ext_refs;
2727 78         129 my $length = 0;
2728 78         125 my $index = 0;
2729              
2730              
2731 78 50       125 if (@{$self->{_defined_names}}) {
  78         348  
2732 0         0 my $index = 0;
2733 0         0 my $key = "$index:$index";
2734              
2735 0 0       0 if (not exists $ext_refs{$key}) {
2736 0         0 $ext_refs{$key} = $ext_ref_count++;
2737             }
2738             }
2739              
2740 78         485 for my $defined_name (@{$self->{_defined_names}}) {
  78         254  
2741 0         0 $length += 19
2742             + length($defined_name->{name})
2743             + length($defined_name->{formula});
2744             }
2745              
2746              
2747 78         171 foreach my $worksheet (@{$self->{_worksheets}}) {
  78         236  
2748              
2749 165         386 my $rowmin = $worksheet->{_title_rowmin};
2750 165         456 my $colmin = $worksheet->{_title_colmin};
2751 165         297 my $filter = $worksheet->{_filter_count};
2752 165         354 my $key = "$index:$index";
2753 165         272 $index++;
2754              
2755              
2756             # Add area NAME records
2757             #
2758 165 100       520 if (defined $worksheet->{_print_rowmin}) {
2759 20 50       65 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2760              
2761 20         22 $length += 31 ;
2762             }
2763              
2764              
2765             # Add title NAME records
2766             #
2767 165 100 100     1147 if (defined $rowmin and defined $colmin) {
    100 100        
2768 2 50       9 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2769              
2770 2         3 $length += 46;
2771             }
2772             elsif (defined $rowmin or defined $colmin) {
2773 24 50       85 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2774              
2775 24         35 $length += 31;
2776             }
2777             else {
2778             # TODO, may need this later.
2779             }
2780              
2781              
2782             # Add Autofilter NAME records
2783             #
2784 165 100       784 if ($filter) {
2785 6 50       21 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2786              
2787 6         16 $length += 31;
2788             }
2789             }
2790              
2791              
2792             # Update the ref counts.
2793 78         398 $self->{_ext_ref_count} = $ext_ref_count;
2794 78         277 $self->{_ext_refs} = {%ext_refs};
2795              
2796              
2797             # If there are no external refs then we don't write, SUPBOOK, EXTERNSHEET
2798             # and NAME. Therefore the length is 0.
2799              
2800 78 100       411 return $length = 0 if $ext_ref_count == 0;
2801              
2802              
2803             # The SUPBOOK record is 8 bytes
2804 34         53 $length += 8;
2805              
2806             # The EXTERNSHEET record is 6 bytes + 6 bytes for each external ref
2807 34         65 $length += 6 * (1 + $ext_ref_count);
2808              
2809 34         90 return $length;
2810             }
2811              
2812              
2813             ###############################################################################
2814             #
2815             # _calculate_shared_string_sizes()
2816             #
2817             # Handling of the SST continue blocks is complicated by the need to include an
2818             # additional continuation byte depending on whether the string is split between
2819             # blocks or whether it starts at the beginning of the block. (There are also
2820             # additional complications that will arise later when/if Rich Strings are
2821             # supported). As such we cannot use the simple CONTINUE mechanism provided by
2822             # the _add_continue() method in BIFFwriter.pm. Thus we have to make two passes
2823             # through the strings data. The first is to calculate the required block sizes
2824             # and the second, in _store_shared_strings(), is to write the actual strings.
2825             # The first pass through the data is also used to calculate the size of the SST
2826             # and CONTINUE records for use in setting the BOUNDSHEET record offsets. The
2827             # downside of this is that the same algorithm repeated in _store_shared_strings.
2828             #
2829             sub _calculate_shared_string_sizes {
2830              
2831 61     61   138 my $self = shift;
2832              
2833 61         110 my @strings;
2834 61         352 $#strings = $self->{_str_unique} -1; # Pre-extend array
2835              
2836 61         203 while (my $key = each %{$self->{_str_table}}) {
  68         437  
2837 7         24 $strings[$self->{_str_table}->{$key}] = $key;
2838             }
2839              
2840             # The SST data could be very large, free some memory (maybe).
2841 61         163 $self->{_str_table} = undef;
2842 61         257 $self->{_str_array} = [@strings];
2843              
2844              
2845             # Iterate through the strings to calculate the CONTINUE block sizes.
2846             #
2847             # The SST blocks requires a specialised CONTINUE block, so we have to
2848             # ensure that the maximum data block size is less than the limit used by
2849             # _add_continue() in BIFFwriter.pm. For simplicity we use the same size
2850             # for the SST and CONTINUE records:
2851             # 8228 : Maximum Excel97 block size
2852             # -4 : Length of block header
2853             # -8 : Length of additional SST header information
2854             # -8 : Arbitrary number to keep within _add_continue() limit
2855             # = 8208
2856             #
2857 61         141 my $continue_limit = 8208;
2858 61         110 my $block_length = 0;
2859 61         125 my $written = 0;
2860 61         292 my @block_sizes;
2861 61         282 my $continue = 0;
2862              
2863 61         172 for my $string (@strings) {
2864              
2865 7         9 my $string_length = length $string;
2866 7         21 my $encoding = unpack "xx C", $string;
2867 7         12 my $split_string = 0;
2868              
2869              
2870             # Block length is the total length of the strings that will be
2871             # written out in a single SST or CONTINUE block.
2872             #
2873 7         8 $block_length += $string_length;
2874              
2875              
2876             # We can write the string if it doesn't cross a CONTINUE boundary
2877 7 50       19 if ($block_length < $continue_limit) {
2878 7         15 $written += $string_length;
2879 7         17 next;
2880             }
2881              
2882              
2883             # Deal with the cases where the next string to be written will exceed
2884             # the CONTINUE boundary. If the string is very long it may need to be
2885             # written in more than one CONTINUE record.
2886             #
2887 0         0 while ($block_length >= $continue_limit) {
2888              
2889             # We need to avoid the case where a string is continued in the first
2890             # n bytes that contain the string header information.
2891             #
2892 0         0 my $header_length = 3; # Min string + header size -1
2893 0         0 my $space_remaining = $continue_limit -$written -$continue;
2894              
2895              
2896             # Unicode data should only be split on char (2 byte) boundaries.
2897             # Therefore, in some cases we need to reduce the amount of available
2898             # space by 1 byte to ensure the correct alignment.
2899 0         0 my $align = 0;
2900              
2901             # Only applies to Unicode strings
2902 0 0       0 if ($encoding == 1) {
2903             # Min string + header size -1
2904 0         0 $header_length = 4;
2905              
2906 0 0       0 if ($space_remaining > $header_length) {
2907             # String contains 3 byte header => split on odd boundary
2908 0 0 0     0 if (not $split_string and $space_remaining % 2 != 1) {
    0 0        
2909 0         0 $space_remaining--;
2910 0         0 $align = 1;
2911             }
2912             # Split section without header => split on even boundary
2913             elsif ($split_string and $space_remaining % 2 == 1) {
2914 0         0 $space_remaining--;
2915 0         0 $align = 1;
2916             }
2917              
2918 0         0 $split_string = 1;
2919             }
2920             }
2921              
2922              
2923 0 0       0 if ($space_remaining > $header_length) {
2924             # Write as much as possible of the string in the current block
2925 0         0 $written += $space_remaining;
2926              
2927             # Reduce the current block length by the amount written
2928 0         0 $block_length -= $continue_limit -$continue -$align;
2929              
2930             # Store the max size for this block
2931 0         0 push @block_sizes, $continue_limit -$align;
2932              
2933             # If the current string was split then the next CONTINUE block
2934             # should have the string continue flag (grbit) set unless the
2935             # split string fits exactly into the remaining space.
2936             #
2937 0 0       0 if ($block_length > 0) {
2938 0         0 $continue = 1;
2939             }
2940             else {
2941 0         0 $continue = 0;
2942             }
2943              
2944             }
2945             else {
2946             # Store the max size for this block
2947 0         0 push @block_sizes, $written +$continue;
2948              
2949             # Not enough space to start the string in the current block
2950 0         0 $block_length -= $continue_limit -$space_remaining -$continue;
2951 0         0 $continue = 0;
2952              
2953             }
2954              
2955             # If the string (or substr) is small enough we can write it in the
2956             # new CONTINUE block. Else, go through the loop again to write it in
2957             # one or more CONTINUE blocks
2958             #
2959 0 0       0 if ($block_length < $continue_limit) {
2960 0         0 $written = $block_length;
2961             }
2962             else {
2963 0         0 $written = 0;
2964             }
2965             }
2966             }
2967              
2968             # Store the max size for the last block unless it is empty
2969 61 100       246 push @block_sizes, $written +$continue if $written +$continue;
2970              
2971              
2972 61         180 $self->{_str_block_sizes} = [@block_sizes];
2973              
2974              
2975             # Calculate the total length of the SST and associated CONTINUEs (if any).
2976             # The SST record will have a length even if it contains no strings.
2977             # This length is required to set the offsets in the BOUNDSHEET records since
2978             # they must be written before the SST records
2979             #
2980 61         299 my $length = 12;
2981 61 100       233 $length += shift @block_sizes if @block_sizes; # SST
2982 61         245 $length += 4 + shift @block_sizes while @block_sizes; # CONTINUEs
2983              
2984 61         390 return $length;
2985             }
2986              
2987              
2988             ###############################################################################
2989             #
2990             # _store_shared_strings()
2991             #
2992             # Write all of the workbooks strings into an indexed array.
2993             #
2994             # See the comments in _calculate_shared_string_sizes() for more information.
2995             #
2996             # We also use this routine to record the offsets required by the EXTSST table.
2997             # In order to do this we first identify the first string in an EXTSST bucket
2998             # and then store its global and local offset within the SST table. The offset
2999             # occurs wherever the start of the bucket string is written out via append().
3000             #
3001             sub _store_shared_strings {
3002              
3003 61     61   284 my $self = shift;
3004              
3005 61         105 my @strings = @{$self->{_str_array}};
  61         1281  
3006              
3007              
3008 61         281 my $record = 0x00FC; # Record identifier
3009 61         218 my $length = 0x0008; # Number of bytes to follow
3010 61         113 my $total = 0x0000;
3011              
3012             # Iterate through the strings to calculate the CONTINUE block sizes
3013 61         97 my $continue_limit = 8208;
3014 61         91 my $block_length = 0;
3015 61         119 my $written = 0;
3016 61         86 my $continue = 0;
3017              
3018             # The SST and CONTINUE block sizes have been pre-calculated by
3019             # _calculate_shared_string_sizes()
3020 61         91 my @block_sizes = @{$self->{_str_block_sizes}};
  61         240  
3021              
3022              
3023             # The SST record is required even if it contains no strings. Thus we will
3024             # always have a length
3025             #
3026 61 100       214 if (@block_sizes) {
3027 3         6 $length = 8 + shift @block_sizes;
3028             }
3029             else {
3030             # No strings
3031 58         122 $length = 8;
3032             }
3033              
3034              
3035             # Initialise variables used to track EXTSST bucket offsets.
3036 61         116 my $extsst_str_num = -1;
3037 61         112 my $sst_block_start = $self->{_datasize};
3038              
3039              
3040             # Write the SST block header information
3041 61         192 my $header = pack("vv", $record, $length);
3042 61         215 my $data = pack("VV", $self->{_str_total}, $self->{_str_unique});
3043 61         192 $self->_append($header, $data);
3044              
3045              
3046             # Iterate through the strings and write them out
3047 61         188 for my $string (@strings) {
3048              
3049 7         13 my $string_length = length $string;
3050 7         24 my $encoding = unpack "xx C", $string;
3051 7         10 my $split_string = 0;
3052 7         9 my $bucket_string = 0; # Used to track EXTSST bucket offsets.
3053              
3054              
3055             # Check if the string is at the start of a EXTSST bucket.
3056 7 100       30 if (++$extsst_str_num % $self->{_extsst_bucket_size} == 0) {
3057 3         7 $bucket_string = 1;
3058             }
3059              
3060              
3061             # Block length is the total length of the strings that will be
3062             # written out in a single SST or CONTINUE block.
3063             #
3064 7         20 $block_length += $string_length;
3065              
3066              
3067             # We can write the string if it doesn't cross a CONTINUE boundary
3068 7 50       17 if ($block_length < $continue_limit) {
3069              
3070             # Store location of EXTSST bucket string.
3071 7 100       16 if ($bucket_string) {
3072 3         6 my $global_offset = $self->{_datasize};
3073 3         7 my $local_offset = $self->{_datasize} - $sst_block_start;
3074              
3075 3         6 push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
  3         11  
3076 3         6 $bucket_string = 0;
3077             }
3078              
3079 7         17 $self->_append($string);
3080 7         9 $written += $string_length;
3081 7         21 next;
3082             }
3083              
3084              
3085             # Deal with the cases where the next string to be written will exceed
3086             # the CONTINUE boundary. If the string is very long it may need to be
3087             # written in more than one CONTINUE record.
3088             #
3089 0         0 while ($block_length >= $continue_limit) {
3090              
3091             # We need to avoid the case where a string is continued in the first
3092             # n bytes that contain the string header information.
3093             #
3094 0         0 my $header_length = 3; # Min string + header size -1
3095 0         0 my $space_remaining = $continue_limit -$written -$continue;
3096              
3097              
3098             # Unicode data should only be split on char (2 byte) boundaries.
3099             # Therefore, in some cases we need to reduce the amount of available
3100             # space by 1 byte to ensure the correct alignment.
3101 0         0 my $align = 0;
3102              
3103             # Only applies to Unicode strings
3104 0 0       0 if ($encoding == 1) {
3105             # Min string + header size -1
3106 0         0 $header_length = 4;
3107              
3108 0 0       0 if ($space_remaining > $header_length) {
3109             # String contains 3 byte header => split on odd boundary
3110 0 0 0     0 if (not $split_string and $space_remaining % 2 != 1) {
    0 0        
3111 0         0 $space_remaining--;
3112 0         0 $align = 1;
3113             }
3114             # Split section without header => split on even boundary
3115             elsif ($split_string and $space_remaining % 2 == 1) {
3116 0         0 $space_remaining--;
3117 0         0 $align = 1;
3118             }
3119              
3120 0         0 $split_string = 1;
3121             }
3122             }
3123              
3124              
3125 0 0       0 if ($space_remaining > $header_length) {
3126             # Write as much as possible of the string in the current block
3127 0         0 my $tmp = substr $string, 0, $space_remaining;
3128              
3129             # Store location of EXTSST bucket string.
3130 0 0       0 if ($bucket_string) {
3131 0         0 my $global_offset = $self->{_datasize};
3132 0         0 my $local_offset = $self->{_datasize} - $sst_block_start;
3133              
3134 0         0 push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
  0         0  
3135 0         0 $bucket_string = 0;
3136             }
3137              
3138 0         0 $self->_append($tmp);
3139              
3140              
3141             # The remainder will be written in the next block(s)
3142 0         0 $string = substr $string, $space_remaining;
3143              
3144             # Reduce the current block length by the amount written
3145 0         0 $block_length -= $continue_limit -$continue -$align;
3146              
3147             # If the current string was split then the next CONTINUE block
3148             # should have the string continue flag (grbit) set unless the
3149             # split string fits exactly into the remaining space.
3150             #
3151 0 0       0 if ($block_length > 0) {
3152 0         0 $continue = 1;
3153             }
3154             else {
3155 0         0 $continue = 0;
3156             }
3157             }
3158             else {
3159             # Not enough space to start the string in the current block
3160 0         0 $block_length -= $continue_limit -$space_remaining -$continue;
3161 0         0 $continue = 0;
3162             }
3163              
3164             # Write the CONTINUE block header
3165 0 0       0 if (@block_sizes) {
3166 0         0 $sst_block_start= $self->{_datasize}; # Reset EXTSST offset.
3167              
3168 0         0 $record = 0x003C;
3169 0         0 $length = shift @block_sizes;
3170              
3171 0         0 $header = pack("vv", $record, $length);
3172 0 0       0 $header .= pack("C", $encoding) if $continue;
3173              
3174 0         0 $self->_append($header);
3175             }
3176              
3177             # If the string (or substr) is small enough we can write it in the
3178             # new CONTINUE block. Else, go through the loop again to write it in
3179             # one or more CONTINUE blocks
3180             #
3181 0 0       0 if ($block_length < $continue_limit) {
3182              
3183             # Store location of EXTSST bucket string.
3184 0 0       0 if ($bucket_string) {
3185 0         0 my $global_offset = $self->{_datasize};
3186 0         0 my $local_offset = $self->{_datasize} - $sst_block_start;
3187              
3188 0         0 push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
  0         0  
3189              
3190 0         0 $bucket_string = 0;
3191             }
3192 0         0 $self->_append($string);
3193              
3194 0         0 $written = $block_length;
3195             }
3196             else {
3197 0         0 $written = 0;
3198             }
3199             }
3200             }
3201             }
3202              
3203              
3204             ###############################################################################
3205             #
3206             # _calculate_extsst_size
3207             #
3208             # The number of buckets used in the EXTSST is between 0 and 128. The number of
3209             # strings per bucket (bucket size) has a minimum value of 8 and a theoretical
3210             # maximum of 2^16. For "number of strings" < 1024 there is a constant bucket
3211             # size of 8. The following algorithm generates the same size/bucket ratio
3212             # as Excel.
3213             #
3214             sub _calculate_extsst_size {
3215              
3216 89     89   34861 my $self = shift;
3217              
3218 89         195 my $unique_strings = $self->{_str_unique};
3219              
3220 89         153 my $bucket_size;
3221             my $buckets;
3222              
3223 89 100       283 if ($unique_strings < 1024) {
3224 75         133 $bucket_size = 8;
3225             }
3226             else {
3227 14         35 $bucket_size = 1 + int($unique_strings / 128);
3228             }
3229              
3230 89         665 $buckets = int(($unique_strings + $bucket_size -1) / $bucket_size);
3231              
3232              
3233 89         191 $self->{_extsst_buckets} = $buckets ;
3234 89         204 $self->{_extsst_bucket_size} = $bucket_size;
3235              
3236              
3237 89         252 return 6 + 8 * $buckets;
3238             }
3239              
3240              
3241             ###############################################################################
3242             #
3243             # _store_extsst
3244             #
3245             # Write EXTSST table using the offsets calculated in _store_shared_strings().
3246             #
3247             sub _store_extsst {
3248              
3249 61     61   214 my $self = shift;
3250              
3251 61         109 my @offsets = @{$self->{_extsst_offsets}};
  61         197  
3252 61         139 my $bucket_size = $self->{_extsst_bucket_size};
3253              
3254 61         98 my $record = 0x00FF; # Record identifier
3255 61         135 my $length = 2 + 8 * @offsets; # Bytes to follow
3256              
3257 61         165 my $header = pack 'vv', $record, $length;
3258 61         155 my $data = pack 'v', $bucket_size,;
3259              
3260 61         178 for my $offset (@offsets) {
3261 3         13 $data .= pack 'Vvv', $offset->[0], $offset->[1], 0;
3262             }
3263              
3264 61         178 $self->_append($header, $data);
3265              
3266             }
3267              
3268              
3269              
3270              
3271             #
3272             # Methods related to comments and MSO objects.
3273             #
3274              
3275             ###############################################################################
3276             #
3277             # _add_mso_drawing_group()
3278             #
3279             # Write the MSODRAWINGGROUP record that keeps track of the Escher drawing
3280             # objects in the file such as images, comments and filters.
3281             #
3282             sub _add_mso_drawing_group {
3283              
3284 78     78   891 my $self = shift;
3285              
3286 78 100       342 return unless $self->{_mso_size};
3287              
3288 20         36 my $record = 0x00EB; # Record identifier
3289 20         38 my $length = 0x0000; # Number of bytes to follow
3290              
3291 20         98 my $data = $self->_store_mso_dgg_container();
3292 20         40 $data .= $self->_store_mso_dgg(@{$self->{_mso_clusters}});
  20         116  
3293 20         103 $data .= $self->_store_mso_bstore_container();
3294 20         61 $data .= $self->_store_mso_images(@$_) for @{$self->{_images_data}};
  20         91  
3295 20         109 $data .= $self->_store_mso_opt();
3296 20         92 $data .= $self->_store_mso_split_menu_colors();
3297              
3298 20         42 $length = length $data;
3299 20         63 my $header = pack("vv", $record, $length);
3300              
3301 20         119 $self->_add_mso_drawing_group_continue($header . $data);
3302              
3303 20         152 return $header . $data; # For testing only.
3304             }
3305              
3306              
3307             ###############################################################################
3308             #
3309             # _add_mso_drawing_group_continue()
3310             #
3311             # See first the Spreadsheet::WriteExcel::BIFFwriter::_add_continue() method.
3312             #
3313             # Add specialised CONTINUE headers to large MSODRAWINGGROUP data block.
3314             # We use the Excel 97 max block size of 8228 - 4 bytes for the header = 8224.
3315             #
3316             # The structure depends on the size of the data block:
3317             #
3318             # Case 1: <= 8224 bytes 1 MSODRAWINGGROUP
3319             # Case 2: <= 2*8224 bytes 1 MSODRAWINGGROUP + 1 CONTINUE
3320             # Case 3: > 2*8224 bytes 2 MSODRAWINGGROUP + n CONTINUE
3321             #
3322             sub _add_mso_drawing_group_continue {
3323              
3324 20     20   55 my $self = shift;
3325              
3326 20         39 my $data = $_[0];
3327 20         31 my $limit = 8228 -4;
3328 20         33 my $mso_group = 0x00EB; # Record identifier
3329 20         34 my $continue = 0x003C; # Record identifier
3330 20         34 my $block_count = 1;
3331 20         32 my $header;
3332             my $tmp;
3333              
3334             # Ignore the base class _add_continue() method.
3335 20         58 $self->{_ignore_continue} = 1;
3336              
3337             # Case 1 above. Just return the data as it is.
3338 20 50       69 if (length $data <= $limit) {
3339 20         92 $self->_append($data);
3340 20         48 return;
3341             }
3342              
3343             # Change length field of the first MSODRAWINGGROUP block. Case 2 and 3.
3344 0         0 $tmp = substr($data, 0, $limit +4, "");
3345 0         0 substr($tmp, 2, 2, pack("v", $limit));
3346 0         0 $self->_append($tmp);
3347              
3348              
3349             # Add MSODRAWINGGROUP and CONTINUE blocks for Case 3 above.
3350 0         0 while (length($data) > $limit) {
3351 0 0       0 if ($block_count == 1) {
3352             # Add extra MSODRAWINGGROUP block header.
3353 0         0 $header = pack("vv", $mso_group, $limit);
3354 0         0 $block_count++;
3355             }
3356             else {
3357             # Add normal CONTINUE header.
3358 0         0 $header = pack("vv", $continue, $limit);
3359             }
3360              
3361 0         0 $tmp = substr($data, 0, $limit, "");
3362 0         0 $self->_append($header, $tmp);
3363             }
3364              
3365              
3366             # Last CONTINUE block for remaining data. Case 2 and 3 above.
3367 0         0 $header = pack("vv", $continue, length($data));
3368 0         0 $self->_append($header, $data);
3369              
3370              
3371             # Turn the base class _add_continue() method back on.
3372 0         0 $self->{_ignore_continue} = 0;
3373             }
3374              
3375              
3376             ###############################################################################
3377             #
3378             # _store_mso_dgg_container()
3379             #
3380             # Write the Escher DggContainer record that is part of MSODRAWINGGROUP.
3381             #
3382             sub _store_mso_dgg_container {
3383              
3384 21     21   631 my $self = shift;
3385              
3386 21         35 my $type = 0xF000;
3387 21         44 my $version = 15;
3388 21         34 my $instance = 0;
3389 21         39 my $data = '';
3390 21         64 my $length = $self->{_mso_size} -12; # -4 (biff header) -8 (for this).
3391              
3392              
3393 21         172 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3394             }
3395              
3396              
3397             ###############################################################################
3398             #
3399             # _store_mso_dgg()
3400             #
3401             # Write the Escher Dgg record that is part of MSODRAWINGGROUP.
3402             #
3403             sub _store_mso_dgg {
3404              
3405 21     21   647 my $self = shift;
3406              
3407 21         40 my $type = 0xF006;
3408 21         30 my $version = 0;
3409 21         39 my $instance = 0;
3410 21         31 my $data = '';
3411 21         42 my $length = undef; # Calculate automatically.
3412              
3413 21         36 my $max_spid = $_[0];
3414 21         38 my $num_clusters = $_[1];
3415 21         36 my $shapes_saved = $_[2];
3416 21         48 my $drawings_saved = $_[3];
3417 21         33 my $clusters = $_[4];
3418              
3419 21         82 $data = pack "VVVV", $max_spid, $num_clusters,
3420             $shapes_saved, $drawings_saved;
3421              
3422 21         51 for my $aref (@$clusters) {
3423 50         85 my $drawing_id = $aref->[0];
3424 50         112 my $shape_ids_used = $aref->[1];
3425              
3426 50         142 $data .= pack "VV", $drawing_id, $shape_ids_used;
3427             }
3428              
3429              
3430 21         111 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3431             }
3432              
3433              
3434             ###############################################################################
3435             #
3436             # _store_mso_bstore_container()
3437             #
3438             # Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
3439             #
3440             sub _store_mso_bstore_container {
3441              
3442 20     20   57 my $self = shift;
3443              
3444 20 50       124 return '' unless $self->{_images_size};
3445              
3446 0         0 my $type = 0xF001;
3447 0         0 my $version = 15;
3448 0         0 my $instance = @{$self->{_images_data}}; # Number of images.
  0         0  
3449 0         0 my $data = '';
3450 0         0 my $length = $self->{_images_size} +8 *$instance;
3451              
3452 0         0 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3453             }
3454              
3455              
3456              
3457             ###############################################################################
3458             #
3459             # _store_mso_images()
3460             #
3461             # Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
3462             #
3463             sub _store_mso_images {
3464              
3465 0     0   0 my $self = shift;
3466              
3467 0         0 my $ref_count = $_[0];
3468 0         0 my $image_type = $_[1];
3469 0         0 my $image = $_[2];
3470 0         0 my $size = $_[3];
3471 0         0 my $checksum1 = $_[4];
3472 0         0 my $checksum2 = $_[5];
3473              
3474 0         0 my $blip_store_entry = $self->_store_mso_blip_store_entry($ref_count,
3475             $image_type,
3476             $size,
3477             $checksum1);
3478              
3479 0         0 my $blip = $self->_store_mso_blip($image_type,
3480             $image,
3481             $size,
3482             $checksum1,
3483             $checksum2);
3484              
3485 0         0 return $blip_store_entry . $blip;
3486             }
3487              
3488              
3489              
3490             ###############################################################################
3491             #
3492             # _store_mso_blip_store_entry()
3493             #
3494             # Write the Escher BlipStoreEntry record that is part of MSODRAWINGGROUP.
3495             #
3496             sub _store_mso_blip_store_entry {
3497              
3498 0     0   0 my $self = shift;
3499              
3500 0         0 my $ref_count = $_[0];
3501 0         0 my $image_type = $_[1];
3502 0         0 my $size = $_[2];
3503 0         0 my $checksum1 = $_[3];
3504              
3505              
3506 0         0 my $type = 0xF007;
3507 0         0 my $version = 2;
3508 0         0 my $instance = $image_type;
3509 0         0 my $length = $size +61;
3510 0         0 my $data = pack('C', $image_type) # Win32
3511             . pack('C', $image_type) # Mac
3512             . pack('H*', $checksum1) # Uid checksum
3513             . pack('v', 0xFF) # Tag
3514             . pack('V', $size +25) # Next Blip size
3515             . pack('V', $ref_count) # Image ref count
3516             . pack('V', 0x00000000) # File offset
3517             . pack('C', 0x00) # Usage
3518             . pack('C', 0x00) # Name length
3519             . pack('C', 0x00) # Unused
3520             . pack('C', 0x00) # Unused
3521             ;
3522              
3523 0         0 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3524             }
3525              
3526              
3527             ###############################################################################
3528             #
3529             # _store_mso_blip()
3530             #
3531             # Write the Escher Blip record that is part of MSODRAWINGGROUP.
3532             #
3533             sub _store_mso_blip {
3534              
3535 0     0   0 my $self = shift;
3536              
3537 0         0 my $image_type = $_[0];
3538 0         0 my $image_data = $_[1];
3539 0         0 my $size = $_[2];
3540 0         0 my $checksum1 = $_[3];
3541 0         0 my $checksum2 = $_[4];
3542 0         0 my $instance;
3543              
3544 0 0       0 $instance = 0x046A if $image_type == 5; # JPG
3545 0 0       0 $instance = 0x06E0 if $image_type == 6; # PNG
3546 0 0       0 $instance = 0x07A9 if $image_type == 7; # BMP
3547              
3548             # BMPs contain an extra checksum for the stripped data.
3549 0 0       0 if ( $image_type == 7) {
3550 0         0 $checksum1 = $checksum2 . $checksum1;
3551             }
3552              
3553 0         0 my $type = 0xF018 + $image_type;
3554 0         0 my $version = 0x0000;
3555 0         0 my $length = $size +17;
3556 0         0 my $data = pack('H*', $checksum1) # Uid checksum
3557             . pack('C', 0xFF) # Tag
3558             . $image_data # Image
3559             ;
3560              
3561 0         0 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3562             }
3563              
3564              
3565              
3566             ###############################################################################
3567             #
3568             # _store_mso_opt()
3569             #
3570             # Write the Escher Opt record that is part of MSODRAWINGGROUP.
3571             #
3572             sub _store_mso_opt {
3573              
3574 21     21   696 my $self = shift;
3575              
3576 21         49 my $type = 0xF00B;
3577 21         42 my $version = 3;
3578 21         62 my $instance = 3;
3579 21         36 my $data = '';
3580 21         36 my $length = 18;
3581              
3582 21         53 $data = pack "H*", 'BF0008000800810109000008C0014000' .
3583             '0008';
3584              
3585              
3586 21         87 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3587             }
3588              
3589              
3590             ###############################################################################
3591             #
3592             # _store_mso_split_menu_colors()
3593             #
3594             # Write the Escher SplitMenuColors record that is part of MSODRAWINGGROUP.
3595             #
3596             sub _store_mso_split_menu_colors {
3597              
3598 21     21   654 my $self = shift;
3599              
3600 21         46 my $type = 0xF11E;
3601 21         35 my $version = 0;
3602 21         39 my $instance = 4;
3603 21         35 my $data = '';
3604 21         33 my $length = 16;
3605              
3606 21         38 $data = pack "H*", '0D0000080C00000817000008F7000010';
3607              
3608 21         80 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3609             }
3610              
3611              
3612             1;
3613              
3614              
3615             __END__