blob: 0276bb2c57d552c59acf9bebdf261261a88e502b [file] [log] [blame]
rjw6c1fd8f2022-11-30 14:33:01 +08001package 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#
14use Exporter;
15use strict;
16use Carp;
17use Spreadsheet::WriteExcel::BIFFwriter;
18use Spreadsheet::WriteExcel::OLEwriter;
19use Spreadsheet::WriteExcel::Worksheet;
20use Spreadsheet::WriteExcel::Format;
21use Spreadsheet::WriteExcel::Chart;
22use Spreadsheet::WriteExcel::Properties ':property_sets';
23
24use vars qw($VERSION @ISA);
25@ISA = qw(Spreadsheet::WriteExcel::BIFFwriter Exporter);
26
27$VERSION = '2.37';
28
29###############################################################################
30#
31# new()
32#
33# Constructor. Creates a new Workbook object from a BIFFwriter object.
34#
35sub new {
36
37 my $class = shift;
38 my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
39 my $byte_order = $self->{_byte_order};
40 my $parser = Spreadsheet::WriteExcel::Formula->new($byte_order);
41
42 $self->{_filename} = $_[0] || '';
43 $self->{_parser} = $parser;
44 $self->{_tempdir} = undef;
45 $self->{_1904} = 0;
46 $self->{_activesheet} = 0;
47 $self->{_firstsheet} = 0;
48 $self->{_selected} = 0;
49 $self->{_xf_index} = 0;
50 $self->{_fileclosed} = 0;
51 $self->{_biffsize} = 0;
52 $self->{_sheet_name} = 'Sheet';
53 $self->{_chart_name} = 'Chart';
54 $self->{_sheet_count} = 0;
55 $self->{_chart_count} = 0;
56 $self->{_url_format} = '';
57 $self->{_codepage} = 0x04E4;
58 $self->{_country} = 1;
59 $self->{_worksheets} = [];
60 $self->{_sheetnames} = [];
61 $self->{_formats} = [];
62 $self->{_palette} = [];
63
64 $self->{_using_tmpfile} = 1;
65 $self->{_filehandle} = "";
66 $self->{_temp_file} = "";
67 $self->{_internal_fh} = 0;
68 $self->{_fh_out} = "";
69
70 $self->{_str_total} = 0;
71 $self->{_str_unique} = 0;
72 $self->{_str_table} = {};
73 $self->{_str_array} = [];
74 $self->{_str_block_sizes} = [];
75 $self->{_extsst_offsets} = [];
76 $self->{_extsst_buckets} = 0;
77 $self->{_extsst_bucket_size} = 0;
78
79 $self->{_ext_ref_count} = 0;
80 $self->{_ext_refs} = {};
81
82 $self->{_mso_clusters} = [];
83 $self->{_mso_size} = 0;
84
85 $self->{_hideobj} = 0;
86 $self->{_compatibility} = 0;
87
88 $self->{_add_doc_properties} = 0;
89 $self->{_localtime} = [localtime()];
90
91 $self->{_defined_names} = [];
92
93 bless $self, $class;
94
95
96 # Add the in-built style formats and the default cell format.
97 $self->add_format(type => 1); # 0 Normal
98 $self->add_format(type => 1); # 1 RowLevel 1
99 $self->add_format(type => 1); # 2 RowLevel 2
100 $self->add_format(type => 1); # 3 RowLevel 3
101 $self->add_format(type => 1); # 4 RowLevel 4
102 $self->add_format(type => 1); # 5 RowLevel 5
103 $self->add_format(type => 1); # 6 RowLevel 6
104 $self->add_format(type => 1); # 7 RowLevel 7
105 $self->add_format(type => 1); # 8 ColLevel 1
106 $self->add_format(type => 1); # 9 ColLevel 2
107 $self->add_format(type => 1); # 10 ColLevel 3
108 $self->add_format(type => 1); # 11 ColLevel 4
109 $self->add_format(type => 1); # 12 ColLevel 5
110 $self->add_format(type => 1); # 13 ColLevel 6
111 $self->add_format(type => 1); # 14 ColLevel 7
112 $self->add_format(); # 15 Cell XF
113 $self->add_format(type => 1, num_format => 0x2B); # 16 Comma
114 $self->add_format(type => 1, num_format => 0x29); # 17 Comma[0]
115 $self->add_format(type => 1, num_format => 0x2C); # 18 Currency
116 $self->add_format(type => 1, num_format => 0x2A); # 19 Currency[0]
117 $self->add_format(type => 1, num_format => 0x09); # 20 Percent
118
119
120 # Add the default format for hyperlinks
121 $self->{_url_format} = $self->add_format(color => 'blue', underline => 1);
122
123
124 # Check for a filename unless it is an existing filehandle
125 if (not ref $self->{_filename} and $self->{_filename} eq '') {
126 carp 'Filename required by Spreadsheet::WriteExcel->new()';
127 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 if (not ref $self->{_filename}) {
136
137 my $fh = FileHandle->new('>'. $self->{_filename});
138
139 if (not defined $fh) {
140 carp "Can't open " .
141 $self->{_filename} .
142 ". It may be in use or protected";
143 return undef;
144 }
145
146 # binmode file whether platform requires it or not
147 binmode($fh);
148 $self->{_internal_fh} = 1;
149 $self->{_fh_out} = $fh;
150 }
151 else {
152 $self->{_internal_fh} = 0;
153 $self->{_fh_out} = $self->{_filename};
154
155 }
156
157
158 # Set colour palette.
159 $self->set_palette_xl97();
160
161 # Load Encode if we can.
162 require Encode if $] >= 5.008;
163
164 $self->_initialize();
165 $self->_get_checksum_method();
166 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#
180sub _initialize {
181
182 my $self = shift;
183 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 if (defined $self->{_tempdir}) {
196
197 # Delay loading File:Temp to reduce the module dependencies.
198 eval { require File::Temp };
199 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 eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
205
206 # Store the failed tmp dir in case of errors.
207 $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
208 }
209 else {
210
211 $fh = IO::File->new_tmpfile();
212
213 # Store the failed tmp dir in case of errors.
214 $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 if ($fh) {
220
221 # binmode file whether platform requires it or not.
222 binmode($fh);
223
224 # Store filehandle
225 $self->{_filehandle} = $fh;
226 }
227 else {
228
229 # Set flag to store data in memory if XX::tempfile() failed.
230 $self->{_using_tmpfile} = 0;
231
232 if ($^W) {
233 my $dir = $self->{_tempdir} || File::Spec->tmpdir();
234
235 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#
250sub _get_checksum_method {
251
252 my $self = shift;
253
254 eval { require Digest::MD4};
255 if (not $@) {
256 $self->{_checksum_method} = 1;
257 return;
258 }
259
260
261 eval { require Digest::Perl::MD4};
262 if (not $@) {
263 $self->{_checksum_method} = 2;
264 return;
265 }
266
267
268 eval { require Digest::MD5};
269 if (not $@) {
270 $self->{_checksum_method} = 3;
271 return;
272 }
273
274 # Default.
275 $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#
286sub _append {
287
288 my $self = shift;
289 my $data = '';
290
291 if ($self->{_using_tmpfile}) {
292 $data = join('', @_);
293
294 # Add CONTINUE records if necessary
295 $data = $self->_add_continue($data) if length($data) > $self->{_limit};
296
297 # Protect print() from -l on the command line.
298 local $\ = undef;
299
300 print {$self->{_filehandle}} $data;
301 $self->{_datasize} += length($data);
302 }
303 else {
304 $data = $self->SUPER::_append(@_);
305 }
306
307 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#
318sub get_data {
319
320 my $self = shift;
321 my $buffer = 4096;
322 my $tmp;
323
324 # Return data stored in memory
325 if (defined $self->{_data}) {
326 $tmp = $self->{_data};
327 $self->{_data} = undef;
328 my $fh = $self->{_filehandle};
329 seek($fh, 0, 0) if $self->{_using_tmpfile};
330 return $tmp;
331 }
332
333 # Return data stored on disk
334 if ($self->{_using_tmpfile}) {
335 return $tmp if read($self->{_filehandle}, $tmp, $buffer);
336 }
337
338 # No data to return
339 return undef;
340}
341
342
343###############################################################################
344#
345# close()
346#
347# Calls finalization methods and explicitly close the OLEwriter file
348# handle.
349#
350sub close {
351
352 my $self = shift;
353
354 return if $self->{_fileclosed}; # Prevent close() from being called twice.
355
356 $self->{_fileclosed} = 1;
357
358 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#
368sub DESTROY {
369
370 my $self = shift;
371
372 local ($@, $!, $^E, $?);
373
374 $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#
386sub sheets {
387
388 my $self = shift;
389
390 if (@_) {
391 # Return a slice of the array
392 return @{$self->{_worksheets}}[@_];
393 }
394 else {
395 # Return the entire list
396 return @{$self->{_worksheets}};
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#
410sub worksheets {
411
412 my $self = shift;
413
414 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#
426sub add_worksheet {
427
428 my $self = shift;
429 my $index = @{$self->{_worksheets}};
430
431 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 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 my $worksheet = Spreadsheet::WriteExcel::Worksheet->new(@init_data);
458 $self->{_worksheets}->[$index] = $worksheet; # Store ref for iterator
459 $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
460 $self->{_parser}->set_ext_sheets($name, $index); # Store names in Formula.pm
461 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 as new sheet.
473#
474#
475sub add_chart {
476
477 my $self = shift;
478 my %arg = @_;
479 my $name = '';
480 my $encoding = 0;
481 my $index = @{ $self->{_worksheets} };
482
483 # Type must be specified so we can create the required chart instance.
484 my $type = $arg{type};
485 if ( !defined $type ) {
486 croak "Must define chart type in add_chart()";
487 }
488
489 # Ensure that the chart defaults to non embedded.
490 my $embedded = $arg{embedded} ||= 0;
491
492 # Check the worksheet name for non-embedded charts.
493 if ( !$embedded ) {
494 ( $name, $encoding ) =
495 $self->_check_sheetname( $arg{name}, $arg{name_encoding}, 1 );
496 }
497
498 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 my $chart = Spreadsheet::WriteExcel::Chart->factory( $type, @init_data );
516
517 # If the chart isn't embedded let the workbook control it.
518 if ( !$embedded ) {
519 $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
520 $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 $chart->{_index} = 0;
526
527 $chart->_set_embedded_config_data();
528 }
529
530 return $chart;
531}
532
533
534###############################################################################
535#
536# add_chart_ext($filename, $name)
537#
538# Add an externally created chart.
539#
540#
541sub add_chart_ext {
542
543 my $self = shift;
544 my $filename = $_[0];
545 my $index = @{$self->{_worksheets}};
546 my $type = 'external';
547
548 my ($name, $encoding) = $self->_check_sheetname($_[1], $_[2]);
549
550
551 my @init_data = (
552 $filename,
553 $name,
554 $index,
555 $encoding,
556 \$self->{_activesheet},
557 \$self->{_firstsheet},
558 );
559
560 my $chart = Spreadsheet::WriteExcel::Chart->factory($type, @init_data);
561 $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
562 $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
563
564 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#
575sub _check_sheetname {
576
577 my $self = shift;
578 my $name = $_[0] || "";
579 my $encoding = $_[1] || 0;
580 my $chart = $_[2] || 0;
581 my $limit = $encoding ? 62 : 31;
582 my $invalid_char = qr([\[\]:*?/\\]);
583
584 # Increment the Sheet/Chart number used for default sheet names below.
585 if ( $chart ) {
586 $self->{_chart_count}++;
587 }
588 else {
589 $self->{_sheet_count}++;
590 }
591
592 # Supply default Sheet/Chart name if none has been defined.
593 if ( $name eq "" ) {
594 $encoding = 0;
595
596 if ( $chart ) {
597 $name = $self->{_chart_name} . $self->{_chart_count};
598 }
599 else {
600 $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 croak "Sheetname $name must be <= 31 chars" if length $name > $limit;
607
608 # Check that Unicode sheetname has an even number of bytes
609 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 if ($encoding != 1 and $name =~ $invalid_char) {
615 # Check ASCII names
616 croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
617 }
618 else {
619 # Extract any 8bit clean chars from the UTF16 name and validate them.
620 for my $wchar ($name =~ /../sg) {
621 my ($hi, $lo) = unpack "aa", $wchar;
622 if ($hi eq "\0" and $lo =~ $invalid_char) {
623 croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
624 }
625 }
626 }
627
628
629 # Handle utf8 strings in perl 5.8.
630 if ($] >= 5.008) {
631 require Encode;
632
633 if (Encode::is_utf8($name)) {
634 $name = Encode::encode("UTF-16BE", $name);
635 $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 foreach my $worksheet (@{$self->{_worksheets}}) {
646 my $name_a = $name;
647 my $encd_a = $encoding;
648 my $name_b = $worksheet->{_name};
649 my $encd_b = $worksheet->{_encoding};
650 my $error = 0;
651
652 if ($encd_a == 0 and $encd_b == 0) {
653 $error = 1 if lc($name_a) eq lc($name_b);
654 }
655 elsif ($encd_a == 0 and $encd_b == 1) {
656 $name_a = pack "n*", unpack "C*", $name_a;
657 $error = 1 if lc($name_a) eq lc($name_b);
658 }
659 elsif ($encd_a == 1 and $encd_b == 0) {
660 $name_b = pack "n*", unpack "C*", $name_b;
661 $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 if ($] >= 5.008) {
666 $name_a = Encode::decode("UTF-16BE", $name_a);
667 $name_b = Encode::decode("UTF-16BE", $name_b);
668 $error = 1 if lc($name_a) eq lc($name_b);
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 my $hi_a = grep {ord} $name_a =~ /(.)./sg;
677 my $hi_b = grep {ord} $name_b =~ /(.)./sg;
678
679 if ($hi_a or $hi_b) {
680 $error = 1 if $name_a eq $name_b;
681 }
682 else {
683 $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 if ($error) {
690 croak "Worksheet name '$name', with case ignored, " .
691 "is already in use";
692 }
693 }
694
695 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#
706sub add_format {
707
708 my $self = shift;
709
710 my $format = Spreadsheet::WriteExcel::Format->new($self->{_xf_index}, @_);
711
712 $self->{_xf_index} += 1;
713 push @{$self->{_formats}}, $format; # Store format reference
714
715 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#
742sub compatibility_mode {
743
744 my $self = shift;
745
746 croak "compatibility_mode() must be called before add_worksheet()"
747 if $self->sheets();
748
749 if (defined($_[0])) {
750 $self->{_compatibility} = $_[0];
751 }
752 else {
753 $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#
764sub set_1904 {
765
766 my $self = shift;
767
768 croak "set_1904() must be called before add_worksheet()"
769 if $self->sheets();
770
771
772 if (defined($_[0])) {
773 $self->{_1904} = $_[0];
774 }
775 else {
776 $self->{_1904} = 1;
777 }
778}
779
780
781###############################################################################
782#
783# get_1904()
784#
785# Return the date system: 0 = 1900, 1 = 1904
786#
787sub get_1904 {
788
789 my $self = shift;
790
791 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#
801sub set_custom_color {
802
803 my $self = shift;
804
805
806 # Match a HTML #xxyyzz style parameter
807 if (defined $_[1] and $_[1] =~ /^#(\w\w)(\w\w)(\w\w)/ ) {
808 @_ = ($_[0], hex $1, hex $2, hex $3);
809 }
810
811
812 my $index = $_[0] || 0;
813 my $red = $_[1] || 0;
814 my $green = $_[2] || 0;
815 my $blue = $_[3] || 0;
816
817 my $aref = $self->{_palette};
818
819 # Check that the colour index is the right range
820 if ($index < 8 or $index > 64) {
821 carp "Color index $index outside range: 8 <= index <= 64";
822 return 0;
823 }
824
825 # Check that the colour components are in the right range
826 if ( ($red < 0 or $red > 255) ||
827 ($green < 0 or $green > 255) ||
828 ($blue < 0 or $blue > 255) )
829 {
830 carp "Color component outside range: 0 <= color <= 255";
831 return 0;
832 }
833
834 $index -=8; # Adjust colour index (wingless dragonfly)
835
836 # Set the RGB value
837 $aref->[$index] = [$red, $green, $blue, 0];
838
839 return $index +8;
840}
841
842
843###############################################################################
844#
845# set_palette_xl97()
846#
847# Sets the colour palette to the Excel 97+ default.
848#
849sub set_palette_xl97 {
850
851 my $self = shift;
852
853 $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 return 0;
913}
914
915
916###############################################################################
917#
918# set_tempdir()
919#
920# Change the default temp directory used by _initialize() in Worksheet.pm.
921#
922sub set_tempdir {
923
924 my $self = shift;
925
926 # Windows workaround. See Worksheet::_initialize()
927 my $dir = shift || '';
928
929 croak "$dir is not a valid directory" if $dir ne '' and not -d $dir;
930 croak "set_tempdir must be called before add_worksheet" if $self->sheets();
931
932 $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#
943sub set_codepage {
944
945 my $self = shift;
946
947 my $codepage = $_[0] || 1;
948 $codepage = 0x04E4 if $codepage == 1;
949 $codepage = 0x8000 if $codepage == 2;
950
951 $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#
964sub set_country {
965
966 my $self = shift;
967
968 $self->{_country} = $_[0] || 1;
969}
970
971
972
973
974
975
976
977###############################################################################
978#
979# define_name()
980#
981# TODO.
982#
983sub define_name {
984
985 my $self = shift;
986 my $name = shift;
987 my $formula = shift;
988 my $encoding = shift || 0;
989 my $sheet_index = 0;
990 my @tokens;
991
992 my $full_name = $name;
993
994 if ($name =~ /^(.*)!(.*)$/) {
995 my $sheetname = $1;
996 $name = $2;
997 $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 $formula =~ s(^=)();
1004
1005 # Parse the formula using the parser in Formula.pm
1006 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 eval { @tokens = $parser->parse_formula($formula) };
1012
1013 if ($@) {
1014 $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
1015 croak $@; # Re-raise the error
1016 }
1017
1018 # Force 2d ranges to be a reference class.
1019 s/_ref3d/_ref3dR/ for @tokens;
1020 s/_range3d/_range3dR/ for @tokens;
1021
1022
1023 # Parse the tokens into a formula string.
1024 $formula = $parser->parse_tokens(@tokens);
1025
1026
1027
1028 $full_name = lc $full_name;
1029
1030 push @{$self->{_defined_names}}, {
1031 name => $name,
1032 encoding => $encoding,
1033 sheet_index => $sheet_index,
1034 formula => $formula,
1035 };
1036
1037 my $index = scalar @{$self->{_defined_names}};
1038
1039 $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#
1057sub set_properties {
1058
1059 my $self = shift;
1060 my %param;
1061
1062 # Ignore if no args were passed.
1063 return -1 unless @_;
1064
1065
1066 # Allow the parameters to be passed as a hash or hash ref.
1067 if (ref $_[0] eq 'HASH') {
1068 %param = %{$_[0]};
1069 }
1070 else {
1071 %param = @_;
1072 }
1073
1074
1075 # List of valid input parameters.
1076 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 for my $parameter (keys %param) {
1093 if (not exists $properties{$parameter}) {
1094 carp "Unknown parameter '$parameter' in set_properties()";
1095 return -1;
1096 }
1097 }
1098
1099
1100 # Set the creation time unless specified by the user.
1101 if (!exists $param{created}){
1102 $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 my @strings = qw(title subject author keywords comments last_author);
1112 $param{codepage} = $self->_get_property_set_codepage(\%param,
1113 \@strings);
1114
1115 # Create an array of property set values.
1116 my @property_sets;
1117
1118 for my $property (qw(codepage title subject author
1119 keywords comments last_author created))
1120 {
1121 if (exists $param{$property} && defined $param{$property}) {
1122 push @property_sets, [
1123 $properties{$property}->[0],
1124 $properties{$property}->[1],
1125 $param{$property}
1126 ];
1127 }
1128 }
1129
1130 # Pack the property sets.
1131 $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 @strings = qw(category manager company);
1140 $param{codepage} = $self->_get_property_set_codepage(\%param,
1141 \@strings);
1142
1143 # Create an array of property set values.
1144 @property_sets = ();
1145
1146 for my $property (qw(codepage category manager company))
1147 {
1148 if (exists $param{$property} && defined $param{$property}) {
1149 push @property_sets, [
1150 $properties{$property}->[0],
1151 $properties{$property}->[1],
1152 $param{$property}
1153 ];
1154 }
1155 }
1156
1157 # Pack the property sets.
1158 $self->{doc_summary} = create_doc_summary_property_set(\@property_sets);
1159
1160 # Set a flag for when the files is written.
1161 $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#
1173sub _get_property_set_codepage {
1174
1175 my $self = shift;
1176
1177 my $params = $_[0];
1178 my $strings = $_[1];
1179
1180 # Allow for manually marked utf8 strings.
1181 return 0xFDE9 if defined $params->{utf8};
1182
1183 # Check for utf8 strings in perl 5.8.
1184 if ($] >= 5.008) {
1185 require Encode;
1186 for my $string (@{$strings }) {
1187 next unless exists $params->{$string};
1188 return 0xFDE9 if Encode::is_utf8($params->{$string});
1189 }
1190 }
1191
1192 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#
1203sub _store_workbook {
1204
1205 my $self = shift;
1206
1207 # Add a default worksheet if non have been added.
1208 $self->add_worksheet() if not @{$self->{_worksheets}};
1209
1210 # Calculate size required for MSO records and update worksheets.
1211 $self->_calc_mso_sizes();
1212
1213 # Ensure that at least one worksheet has been selected.
1214 if ($self->{_activesheet} == 0) {
1215 @{$self->{_worksheets}}[0]->{_selected} = 1;
1216 @{$self->{_worksheets}}[0]->{_hidden} = 0;
1217 }
1218
1219 # Calculate the number of selected sheet tabs and set the active sheet.
1220 foreach my $sheet (@{$self->{_worksheets}}) {
1221 $self->{_selected}++ if $sheet->{_selected};
1222 $sheet->{_active} = 1 if $sheet->{_index} == $self->{_activesheet};
1223 }
1224
1225 # Add Workbook globals
1226 $self->_store_bof(0x0005);
1227 $self->_store_codepage();
1228 $self->_store_window1();
1229 $self->_store_hideobj();
1230 $self->_store_1904();
1231 $self->_store_all_fonts();
1232 $self->_store_all_num_formats();
1233 $self->_store_all_xfs();
1234 $self->_store_all_styles();
1235 $self->_store_palette();
1236
1237 # Calculate the offsets required by the BOUNDSHEET records
1238 $self->_calc_sheet_offsets();
1239
1240 # Add BOUNDSHEET records.
1241 foreach my $sheet (@{$self->{_worksheets}}) {
1242 $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 $self->_store_country();
1252 if ($self->{_ext_ref_count}) {
1253 $self->_store_supbook();
1254 $self->_store_externsheet();
1255 $self->_store_names();
1256 }
1257 $self->_add_mso_drawing_group();
1258 $self->_store_shared_strings();
1259 $self->_store_extsst();
1260
1261 # End Workbook globals
1262 $self->_store_eof();
1263
1264 # Store the workbook in an OLE container
1265 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#
1276sub _store_OLE_file {
1277
1278 my $self = shift;
1279 my $maxsize = 7_087_104;
1280
1281 if (!$self->{_add_doc_properties} && $self->{_biffsize} <= $maxsize) {
1282 # Write the OLE file using OLEwriter if data <= 7MB
1283 my $OLE = Spreadsheet::WriteExcel::OLEwriter->new($self->{_fh_out});
1284
1285 # Write the BIFF data without the OLE container for testing.
1286 $OLE->{_biff_only} = $self->{_biff_only};
1287
1288 # Indicate that we created the filehandle and want to close it.
1289 $OLE->{_internal_fh} = $self->{_internal_fh};
1290
1291 $OLE->set_size($self->{_biffsize});
1292 $OLE->write_header();
1293
1294 while (my $tmp = $self->get_data()) {
1295 $OLE->write($tmp);
1296 }
1297
1298 foreach my $worksheet (@{$self->{_worksheets}}) {
1299 while (my $tmp = $worksheet->get_data()) {
1300 $OLE->write($tmp);
1301 }
1302 }
1303
1304 return $OLE->close();
1305 }
1306 else {
1307 # Write the OLE file using OLE::Storage_Lite if data > 7MB
1308 eval { require OLE::Storage_Lite };
1309
1310 if (not $@) {
1311
1312 # Protect print() from -l on the command line.
1313 local $\ = undef;
1314
1315 my @streams;
1316
1317 # Create the Workbook stream.
1318 my $stream = pack 'v*', unpack 'C*', 'Workbook';
1319 my $workbook = OLE::Storage_Lite::PPS::File->newFile($stream);
1320
1321 while (my $tmp = $self->get_data()) {
1322 $workbook->append($tmp);
1323 }
1324
1325 foreach my $worksheet (@{$self->{_worksheets}}) {
1326 while (my $tmp = $worksheet->get_data()) {
1327 $workbook->append($tmp);
1328 }
1329 }
1330
1331 push @streams, $workbook;
1332
1333
1334 # Create the properties streams, if any.
1335 if ($self->{_add_doc_properties}) {
1336 my $stream;
1337 my $summary;
1338
1339 $stream = pack 'v*', unpack 'C*', "\5SummaryInformation";
1340 $summary = $self->{summary};
1341 $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
1342 push @streams, $summary;
1343
1344 $stream = pack 'v*', unpack 'C*', "\5DocumentSummaryInformation";
1345 $summary = $self->{doc_summary};
1346 $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
1347 push @streams, $summary;
1348 }
1349
1350 # Create the OLE root document and add the substreams.
1351 my @localtime = @{ $self->{_localtime} };
1352 splice(@localtime, 6);
1353
1354 my $ole_root = OLE::Storage_Lite::PPS::Root->new(\@localtime,
1355 \@localtime,
1356 \@streams);
1357 $ole_root->save($self->{_filename});
1358
1359
1360 # Close the filehandle if it was created internally.
1361 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 $! = 27; # Perl error code "File too large"
1366
1367 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#
1383sub _calc_sheet_offsets {
1384
1385 my $self = shift;
1386 my $BOF = 12;
1387 my $EOF = 4;
1388 my $offset = $self->{_datasize};
1389
1390 # Add the length of the COUNTRY record
1391 $offset += 8;
1392
1393 # Add the length of the SST and associated CONTINUEs
1394 $offset += $self->_calculate_shared_string_sizes();
1395
1396 # Add the length of the EXTSST record.
1397 $offset += $self->_calculate_extsst_size();
1398
1399 # Add the length of the SUPBOOK, EXTERNSHEET and NAME records
1400 $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 my $mso_size = $self->{_mso_size};
1405 $mso_size += 4 * int(($mso_size -1) / $self->{_limit});
1406 $offset += $mso_size ;
1407
1408 foreach my $sheet (@{$self->{_worksheets}}) {
1409 $offset += $BOF + length($sheet->{_name});
1410 }
1411
1412 $offset += $EOF;
1413
1414 foreach my $sheet (@{$self->{_worksheets}}) {
1415 $sheet->{_offset} = $offset;
1416 $sheet->_close();
1417 $offset += $sheet->{_datasize};
1418 }
1419
1420 $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#
1433sub _calc_mso_sizes {
1434
1435 my $self = shift;
1436
1437 my $mso_size = 0; # Size of the MSODRAWINGGROUP record
1438 my $start_spid = 1024; # Initial spid for each sheet
1439 my $max_spid = 1024; # spidMax
1440 my $num_clusters = 1; # cidcl
1441 my $shapes_saved = 0; # cspSaved
1442 my $drawings_saved = 0; # cdgSaved
1443 my @clusters = ();
1444
1445
1446 $self->_process_images();
1447
1448 # Add Bstore container size if there are images.
1449 $mso_size += 8 if @{$self->{_images_data}};
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 foreach my $sheet (@{$self->{_worksheets}}) {
1457 next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
1458
1459 my $num_images = $sheet->{_num_images} || 0;
1460 my $image_mso_size = $sheet->{_image_mso_size} || 0;
1461 my $num_comments = $sheet->_prepare_comments();
1462 my $num_charts = $sheet->_prepare_charts();
1463 my $num_filters = $sheet->{_filter_count};
1464
1465 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 my $num_shapes += 1 + $num_images
1470 + $num_comments
1471 + $num_charts
1472 + $num_filters;
1473 $shapes_saved += $num_shapes;
1474 $mso_size += $image_mso_size;
1475
1476
1477 # Add a drawing object for each sheet with comments.
1478 $drawings_saved++;
1479
1480
1481 # For each sheet start the spids at the next 1024 interval.
1482 $max_spid = 1024 * (1 + int(($max_spid -1)/1024));
1483 $start_spid = $max_spid;
1484
1485
1486 # Max spid for each sheet and eventually for the workbook.
1487 $max_spid += $num_shapes;
1488
1489
1490 # Store the cluster ids
1491 for (my $i = $num_shapes; $i > 0; $i -= 1024) {
1492 $num_clusters += 1;
1493 $mso_size += 8;
1494 my $size = $i > 1024 ? 1024 : $i;
1495
1496 push @clusters, [$drawings_saved, $size];
1497 }
1498
1499
1500 # Pass calculated values back to the worksheet
1501 $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 $mso_size += 86 if $mso_size; # Smallest size is 86+8=94
1508
1509
1510 $self->{_mso_size} = $mso_size;
1511 $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#
1533sub _process_images {
1534
1535 my $self = shift;
1536
1537 my %images_seen;
1538 my @image_data;
1539 my @previous_images;
1540 my $image_id = 1;
1541 my $images_size = 0;
1542
1543
1544 foreach my $sheet (@{$self->{_worksheets}}) {
1545 next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
1546 next unless $sheet->_prepare_images();
1547
1548 my $num_images = 0;
1549 my $image_mso_size = 0;
1550
1551
1552 for my $image_ref (@{$sheet->{_images_array}}) {
1553 my $filename = $image_ref->[2];
1554 $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 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 my $fh = FileHandle->new($filename);
1580 croak "Couldn't import $filename: $!" unless defined $fh;
1581 binmode $fh;
1582
1583 # Slurp the file into a string and do some size calcs.
1584 my $data = do {local $/; <$fh>};
1585 my $size = length $data;
1586 my $checksum1 = $self->_image_checksum($data, $image_id);
1587 my $checksum2 = $checksum1;
1588 my $ref_count = 1;
1589
1590
1591 # Process the image and extract dimensions.
1592 my ($type, $width, $height);
1593
1594 # Test for PNGs...
1595 if (unpack('x A3', $data) eq 'PNG') {
1596 ($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 ($type, $width, $height) = $self->_process_jpg($data, $filename);
1606 }
1607 # Test for BMPs...
1608 elsif (unpack('A2', $data) eq 'BM') {
1609 ($type, $width, $height) = $self->_process_bmp($data,
1610 $filename);
1611 # The 14 byte header of the BMP is stripped off.
1612 $data = substr $data, 14;
1613
1614 # A checksum of the new image data is also required.
1615 $checksum2 = $self->_image_checksum($data,
1616 $image_id,
1617 $image_id
1618 );
1619
1620 # Adjust size -14 (header) + 16 (extra checksum).
1621 $size += 2;
1622 }
1623 else {
1624 croak "Unsupported image format for file: $filename\n";
1625 }
1626
1627
1628 # Push the new data back into the Worksheet array;
1629 push @$image_ref, $image_id, $type, $width, $height;
1630
1631 # Also store new data for use in duplicate images.
1632 push @previous_images, [$image_id, $type, $width, $height];
1633
1634
1635 # Store information required by the Workbook.
1636 push @image_data, [$ref_count, $type, $data, $size,
1637 $checksum1, $checksum2];
1638
1639 # Keep track of overall data size.
1640 $images_size += $size +61; # Size for bstore container.
1641 $image_mso_size += $size +69; # Size for dgg container.
1642
1643 $images_seen{$filename} = $image_id++;
1644 $fh->close;
1645 }
1646 else {
1647 # We've processed this file already.
1648 my $index = $images_seen{$filename} -1;
1649
1650 # Increase image reference count.
1651 $image_data[$index]->[0]++;
1652
1653 # Add previously calculated data back onto the Worksheet array.
1654 # $image_id, $type, $width, $height
1655 my $a_ref = $sheet->{_images_array}->[$index];
1656 push @$image_ref, @{$previous_images[$index]};
1657 }
1658 }
1659
1660 # Store information required by the Worksheet.
1661 $sheet->{_num_images} = $num_images;
1662 $sheet->{_image_mso_size} = $image_mso_size;
1663
1664 }
1665
1666
1667 # Store information required by the Workbook.
1668 $self->{_images_size} = $images_size;
1669 $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#
1683sub _image_checksum {
1684
1685 my $self = shift;
1686
1687 my $data = $_[0];
1688 my $index1 = $_[1];
1689 my $index2 = $_[2] || 0;
1690
1691 if ($self->{_checksum_method} == 1) {
1692 # Digest::MD4
1693 return Digest::MD4::md4_hex($data);
1694 }
1695 elsif ($self->{_checksum_method} == 2) {
1696 # Digest::Perl::MD4
1697 return Digest::Perl::MD4::md4_hex($data);
1698 }
1699 elsif ($self->{_checksum_method} == 3) {
1700 # Digest::MD5
1701 return Digest::MD5::md5_hex($data);
1702 }
1703 else {
1704 # Default
1705 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#
1716sub _process_png {
1717
1718 my $self = shift;
1719
1720 my $type = 6; # Excel Blip type (MSOBLIPTYPE).
1721 my $width = unpack "N", substr $_[0], 16, 4;
1722 my $height = unpack "N", substr $_[0], 20, 4;
1723
1724 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#
1736sub _process_bmp {
1737
1738 my $self = shift;
1739 my $data = $_[0];
1740 my $filename = $_[1];
1741 my $type = 7; # Excel Blip type (MSOBLIPTYPE).
1742
1743
1744 # Check that the file is big enough to be a bitmap.
1745 if (length $data <= 0x36) {
1746 croak "$filename doesn't contain enough data.";
1747 }
1748
1749
1750 # Read the bitmap width and height. Verify the sizes.
1751 my ($width, $height) = unpack "x18 V2", $data;
1752
1753 if ($width > 0xFFFF) {
1754 croak "$filename: largest image width $width supported is 65k.";
1755 }
1756
1757 if ($height > 0xFFFF) {
1758 croak "$filename: largest image height supported is 65k.";
1759 }
1760
1761 # Read the bitmap planes and bpp data. Verify them.
1762 my ($planes, $bitcount) = unpack "x26 v2", $data;
1763
1764 if ($bitcount != 24) {
1765 croak "$filename isn't a 24bit true color bitmap.";
1766 }
1767
1768 if ($planes != 1) {
1769 croak "$filename: only 1 plane supported in bitmap image.";
1770 }
1771
1772
1773 # Read the bitmap compression. Verify compression.
1774 my $compression = unpack "x30 V", $data;
1775
1776 if ($compression != 0) {
1777 croak "$filename: compression not supported in bitmap image.";
1778 }
1779
1780 return ($type, $width, $height);
1781}
1782
1783
1784###############################################################################
1785#
1786# _process_jpg()
1787#
1788# Extract width and height information from a JPEG file.
1789#
1790sub _process_jpg {
1791
1792 my $self = shift;
1793 my $data = $_[0];
1794 my $filename = $_[1];
1795 my $type = 5; # Excel Blip type (MSOBLIPTYPE).
1796 my $width;
1797 my $height;
1798
1799 my $offset = 2;
1800 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 while ($offset < $data_length) {
1805
1806 my $marker = unpack "n", substr $data, $offset, 2;
1807 my $length = unpack "n", substr $data, $offset +2, 2;
1808
1809 if ($marker == 0xFFC0 || $marker == 0xFFC2) {
1810 $height = unpack "n", substr $data, $offset +5, 2;
1811 $width = unpack "n", substr $data, $offset +7, 2;
1812 last;
1813 }
1814
1815 $offset = $offset + $length + 2;
1816 last if $marker == 0xFFDA;
1817 }
1818
1819 if (not defined $height) {
1820 croak "$filename: no size data found in jpeg image.\n";
1821 }
1822
1823 return ($type, $width, $height);
1824}
1825
1826
1827###############################################################################
1828#
1829# _store_all_fonts()
1830#
1831# Store the Excel FONT records.
1832#
1833sub _store_all_fonts {
1834
1835 my $self = shift;
1836
1837 my $format = $self->{_formats}->[15]; # The default cell format.
1838 my $font = $format->get_font();
1839
1840 # Fonts are 0-indexed. According to the SDK there is no index 4,
1841 for (0..3) {
1842 $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 my $tmp_format;
1850
1851 # Index 5. Axis numbers.
1852 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1853 undef,
1854 font_only => 1,
1855 );
1856 $self->_append( $tmp_format->get_font() );
1857
1858 # Index 6. Series names.
1859 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1860 undef,
1861 font_only => 1,
1862 );
1863 $self->_append( $tmp_format->get_font() );
1864
1865 # Index 7. Title.
1866 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1867 undef,
1868 font_only => 1,
1869 bold => 1,
1870 );
1871 $self->_append( $tmp_format->get_font() );
1872
1873 # Index 8. Axes.
1874 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1875 undef,
1876 font_only => 1,
1877 bold => 1,
1878 );
1879 $self->_append( $tmp_format->get_font() );
1880
1881 # Index 9. Comments.
1882 $tmp_format = Spreadsheet::WriteExcel::Format->new(
1883 undef,
1884 font_only => 1,
1885 font => 'Tahoma',
1886 size => 8,
1887 );
1888 $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 my %fonts;
1895 my $key;
1896 my $index = 10; # The first user defined FONT
1897
1898 $key = $format->get_font_key(); # The default font for cell formats.
1899 $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 foreach $format (@{$self->{_formats}}) {
1905 $key = $format->get_font_key();
1906
1907 if (not $format->{_font_only} and exists $fonts{$key}) {
1908 # FONT has already been used
1909 $format->{_font_index} = $fonts{$key};
1910 }
1911 else {
1912 # Add a new FONT record
1913
1914 if (not $format->{_font_only}) {
1915 $fonts{$key} = $index;
1916 }
1917
1918 $format->{_font_index} = $index;
1919 $index++;
1920 $font = $format->get_font();
1921 $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#
1933sub _store_all_num_formats {
1934
1935 my $self = shift;
1936
1937 my %num_formats;
1938 my @num_formats;
1939 my $num_format;
1940 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 foreach my $format (@{$self->{_formats}}) {
1947 my $num_format = $format->{_num_format};
1948 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 if ($num_format !~ m/^0+\d/) {
1955 next if $num_format =~ m/^\d+$/; # built-in
1956 }
1957
1958 if (exists($num_formats{$num_format})) {
1959 # FORMAT has already been used
1960 $format->{_num_format} = $num_formats{$num_format};
1961 }
1962 else{
1963 # Add a new FORMAT
1964 $num_formats{$num_format} = $index;
1965 $format->{_num_format} = $index;
1966 $self->_store_num_format($num_format, $index, $encoding);
1967 $index++;
1968 }
1969 }
1970}
1971
1972
1973###############################################################################
1974#
1975# _store_all_xfs()
1976#
1977# Write all XF records.
1978#
1979sub _store_all_xfs {
1980
1981 my $self = shift;
1982
1983 foreach my $format (@{$self->{_formats}}) {
1984 my $xf = $format->get_xf();
1985 $self->_append($xf);
1986 }
1987}
1988
1989
1990###############################################################################
1991#
1992# _store_all_styles()
1993#
1994# Write all STYLE records.
1995#
1996sub _store_all_styles {
1997
1998 my $self = shift;
1999
2000 # Excel adds the built-in styles in alphabetical order.
2001 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 for my $aref (@built_ins) {
2017 my $type = $aref->[0];
2018 my $xf_index = $aref->[1];
2019
2020 $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#
2031sub _store_names {
2032
2033 my $self = shift;
2034 my $index;
2035 my %ext_refs = %{$self->{_ext_refs}};
2036
2037
2038 # Create the user defined names.
2039 for my $defined_name (@{$self->{_defined_names}}) {
2040
2041 $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 my @worksheets = @{$self->{_worksheets}};
2052 @worksheets = sort { $a->{_name} cmp $b->{_name} } @worksheets;
2053
2054 # Create the autofilter NAME records
2055 foreach my $worksheet (@worksheets) {
2056 $index = $worksheet->{_index};
2057 my $key = "$index:$index";
2058 my $ref = $ext_refs{$key};
2059
2060 # Write a Name record if Autofilter has been defined
2061 if ($worksheet->{_filter_count}) {
2062 $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 foreach my $worksheet (@worksheets) {
2077 $index = $worksheet->{_index};
2078 my $key = "$index:$index";
2079 my $ref = $ext_refs{$key};
2080
2081 # Write a Name record if the print area has been defined
2082 if (defined $worksheet->{_print_rowmin}) {
2083 $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 foreach my $worksheet (@worksheets) {
2097 $index = $worksheet->{_index};
2098
2099 my $rowmin = $worksheet->{_title_rowmin};
2100 my $rowmax = $worksheet->{_title_rowmax};
2101 my $colmin = $worksheet->{_title_colmin};
2102 my $colmax = $worksheet->{_title_colmax};
2103 my $key = "$index:$index";
2104 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 if (defined $rowmin && defined $colmin) {
2110 # Row and column titles have been defined.
2111 # Row title has been defined.
2112 $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 $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 $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#
2168sub _store_window1 {
2169
2170 my $self = shift;
2171
2172 my $record = 0x003D; # Record identifier
2173 my $length = 0x0012; # Number of bytes to follow
2174
2175 my $xWn = 0x0000; # Horizontal position of window
2176 my $yWn = 0x0000; # Vertical position of window
2177 my $dxWn = 0x355C; # Width of window
2178 my $dyWn = 0x30ED; # Height of window
2179
2180 my $grbit = 0x0038; # Option flags
2181 my $ctabsel = $self->{_selected}; # Number of workbook tabs selected
2182 my $wTabRatio = 0x0258; # Tab to scrollbar ratio
2183
2184 my $itabFirst = $self->{_firstsheet}; # 1st displayed worksheet
2185 my $itabCur = $self->{_activesheet}; # Active worksheet
2186
2187 my $header = pack("vv", $record, $length);
2188 my $data = pack("vvvvvvvvv", $xWn, $yWn, $dxWn, $dyWn,
2189 $grbit,
2190 $itabCur, $itabFirst,
2191 $ctabsel, $wTabRatio);
2192
2193 $self->_append($header, $data);
2194}
2195
2196
2197###############################################################################
2198#
2199# _store_boundsheet()
2200#
2201# Writes Excel BIFF BOUNDSHEET record.
2202#
2203sub _store_boundsheet {
2204
2205 my $self = shift;
2206
2207 my $record = 0x0085; # Record identifier
2208 my $length = 0x08 + length($_[0]); # Number of bytes to follow
2209
2210 my $sheetname = $_[0]; # Worksheet name
2211 my $offset = $_[1]; # Location of worksheet BOF
2212 my $type = $_[2]; # Worksheet type
2213 my $hidden = $_[3]; # Worksheet hidden flag
2214 my $encoding = $_[4]; # Sheet name encoding
2215 my $cch = length($sheetname); # Length of sheet name
2216
2217 my $grbit = $type | $hidden;
2218
2219 # Character length is num of chars not num of bytes
2220 $cch /= 2 if $encoding;
2221
2222 # Change the UTF-16 name from BE to LE
2223 $sheetname = pack 'n*', unpack 'v*', $sheetname if $encoding;
2224
2225 my $header = pack("vv", $record, $length);
2226 my $data = pack("VvCC", $offset, $grbit, $cch, $encoding);
2227
2228 $self->_append($header, $data, $sheetname);
2229}
2230
2231
2232###############################################################################
2233#
2234# _store_style()
2235#
2236# Write Excel BIFF STYLE records.
2237#
2238sub _store_style {
2239
2240 my $self = shift;
2241
2242 my $record = 0x0293; # Record identifier
2243 my $length = 0x0004; # Bytes to follow
2244
2245 my $type = $_[0]; # Built-in style
2246 my $xf_index = $_[1]; # Index to style XF
2247 my $level = 0xff; # Outline style level
2248
2249 $xf_index |= 0x8000; # Add flag to indicate built-in style.
2250
2251
2252 my $header = pack("vv", $record, $length);
2253 my $data = pack("vCC", $xf_index, $type, $level);
2254
2255 $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#
2265sub _store_num_format {
2266
2267 my $self = shift;
2268
2269 my $record = 0x041E; # Record identifier
2270 my $length; # Number of bytes to follow
2271
2272 my $format = $_[0]; # Custom format string
2273 my $ifmt = $_[1]; # Format index code
2274 my $encoding = $_[2]; # Char encoding for format string
2275
2276
2277 # Handle utf8 strings in perl 5.8.
2278 if ($] >= 5.008) {
2279 require Encode;
2280
2281 if (Encode::is_utf8($format)) {
2282 $format = Encode::encode("UTF-16BE", $format);
2283 $encoding = 1;
2284 }
2285 }
2286
2287
2288 # Char length of format string
2289 my $cch = length $format;
2290
2291
2292 # Handle Unicode format strings.
2293 if ($encoding == 1) {
2294 croak "Uneven number of bytes in Unicode font name" if $cch % 2;
2295 $cch /= 2 if $encoding;
2296 $format = pack 'v*', unpack 'n*', $format;
2297 }
2298
2299
2300 # Special case to handle Euro symbol, 0x80, in non-Unicode strings.
2301 if ($encoding == 0 and $format =~ /\x80/) {
2302 $format = pack 'v*', unpack 'C*', $format;
2303 $format =~ s/\x80\x00/\xAC\x20/g;
2304 $encoding = 1;
2305 }
2306
2307 $length = 0x05 + length $format;
2308
2309 my $header = pack("vv", $record, $length);
2310 my $data = pack("vvC", $ifmt, $cch, $encoding);
2311
2312 $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#
2322sub _store_1904 {
2323
2324 my $self = shift;
2325
2326 my $record = 0x0022; # Record identifier
2327 my $length = 0x0002; # Bytes to follow
2328
2329 my $f1904 = $self->{_1904}; # Flag for 1904 date system
2330
2331 my $header = pack("vv", $record, $length);
2332 my $data = pack("v", $f1904);
2333
2334 $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#
2345sub _store_supbook {
2346
2347 my $self = shift;
2348
2349 my $record = 0x01AE; # Record identifier
2350 my $length = 0x0004; # Number of bytes to follow
2351
2352 my $ctabs = @{$self->{_worksheets}}; # Number of worksheets
2353 my $StVirtPath = 0x0401; # Encoded workbook filename
2354
2355 my $header = pack("vv", $record, $length);
2356 my $data = pack("vv", $ctabs, $StVirtPath);
2357
2358 $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#
2370sub _store_externsheet {
2371
2372 my $self = shift;
2373
2374 my $record = 0x0017; # Record identifier
2375 my $length; # Number of bytes to follow
2376
2377
2378 # Get the external refs
2379 my %ext_refs = %{$self->{_ext_refs}};
2380 my @ext_refs = sort {$ext_refs{$a} <=> $ext_refs{$b}} keys %ext_refs;
2381
2382 # Change the external refs from stringified "1:1" to [1, 1]
2383 foreach my $ref (@ext_refs) {
2384 $ref = [split /:/, $ref];
2385 }
2386
2387
2388 my $cxti = scalar @ext_refs; # Number of Excel XTI structures
2389 my $rgxti = ''; # Array of XTI structures
2390
2391 # Write the XTI structs
2392 foreach my $ext_ref (@ext_refs) {
2393 $rgxti .= pack("vvv", 0, $ext_ref->[0], $ext_ref->[1])
2394 }
2395
2396
2397 my $data = pack("v", $cxti) . $rgxti;
2398 my $header = pack("vv", $record, length $data);
2399
2400 $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#
2415sub _store_name {
2416
2417 my $self = shift;
2418
2419 my $record = 0x0018; # Record identifier
2420 my $length; # Number of bytes to follow
2421
2422 my $name = shift;
2423 my $encoding = shift;
2424 my $sheet_index = shift;
2425 my $formula = shift;
2426
2427 my $text_length = length $name;
2428 my $formula_length = length $formula;
2429
2430 # UTF-16 string length is in characters not bytes.
2431 $text_length /= 2 if $encoding;
2432
2433
2434 my $grbit = 0x0000; # Option flags
2435 my $shortcut = 0x00; # Keyboard shortcut
2436 my $ixals = 0x0000; # Unused index.
2437 my $menu_length = 0x00; # Length of cust menu text
2438 my $desc_length = 0x00; # Length of description text
2439 my $help_length = 0x00; # Length of help topic text
2440 my $status_length = 0x00; # Length of status bar text
2441
2442 # Set grbit built-in flag and the hidden flag for autofilters.
2443 if ($text_length == 1) {
2444 $grbit = 0x0020 if ord $name == 0x06; # Print area
2445 $grbit = 0x0020 if ord $name == 0x07; # Print titles
2446 $grbit = 0x0021 if ord $name == 0x0D; # Autofilter
2447 }
2448
2449 my $data = pack "v", $grbit;
2450 $data .= pack "C", $shortcut;
2451 $data .= pack "C", $text_length;
2452 $data .= pack "v", $formula_length;
2453 $data .= pack "v", $ixals;
2454 $data .= pack "v", $sheet_index;
2455 $data .= pack "C", $menu_length;
2456 $data .= pack "C", $desc_length;
2457 $data .= pack "C", $help_length;
2458 $data .= pack "C", $status_length;
2459 $data .= pack "C", $encoding;
2460 $data .= $name;
2461 $data .= $formula;
2462
2463 my $header = pack "vv", $record, length $data;
2464
2465 $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#
2477sub _store_name_short {
2478
2479 my $self = shift;
2480
2481 my $record = 0x0018; # Record identifier
2482 my $length = 0x001b; # Number of bytes to follow
2483
2484 my $index = shift; # Sheet index
2485 my $type = shift;
2486 my $ext_ref = shift; # TODO
2487
2488 my $grbit = 0x0020; # Option flags
2489 my $chKey = 0x00; # Keyboard shortcut
2490 my $cch = 0x01; # Length of text name
2491 my $cce = 0x000b; # Length of text definition
2492 my $unknown01 = 0x0000; #
2493 my $ixals = $index +1; # Sheet index
2494 my $unknown02 = 0x00; #
2495 my $cchCustMenu = 0x00; # Length of cust menu text
2496 my $cchDescription = 0x00; # Length of description text
2497 my $cchHelptopic = 0x00; # Length of help topic text
2498 my $cchStatustext = 0x00; # Length of status bar text
2499 my $rgch = $type; # Built-in name type
2500 my $unknown03 = 0x3b; #
2501
2502 my $rowmin = $_[0]; # Start row
2503 my $rowmax = $_[1]; # End row
2504 my $colmin = $_[2]; # Start column
2505 my $colmax = $_[3]; # end column
2506
2507 my $hidden = $_[4]; # Name is hidden
2508 $grbit = 0x0021 if $hidden;
2509
2510 my $header = pack("vv", $record, $length);
2511 my $data = pack("v", $grbit);
2512 $data .= pack("C", $chKey);
2513 $data .= pack("C", $cch);
2514 $data .= pack("v", $cce);
2515 $data .= pack("v", $unknown01);
2516 $data .= pack("v", $ixals);
2517 $data .= pack("C", $unknown02);
2518 $data .= pack("C", $cchCustMenu);
2519 $data .= pack("C", $cchDescription);
2520 $data .= pack("C", $cchHelptopic);
2521 $data .= pack("C", $cchStatustext);
2522 $data .= pack("C", $rgch);
2523 $data .= pack("C", $unknown03);
2524 $data .= pack("v", $ext_ref);
2525
2526 $data .= pack("v", $rowmin);
2527 $data .= pack("v", $rowmax);
2528 $data .= pack("v", $colmin);
2529 $data .= pack("v", $colmax);
2530
2531 $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#
2545sub _store_name_long {
2546
2547 my $self = shift;
2548
2549 my $record = 0x0018; # Record identifier
2550 my $length = 0x002a; # Number of bytes to follow
2551
2552 my $index = shift; # Sheet index
2553 my $type = shift;
2554 my $ext_ref = shift; # TODO
2555
2556 my $grbit = 0x0020; # Option flags
2557 my $chKey = 0x00; # Keyboard shortcut
2558 my $cch = 0x01; # Length of text name
2559 my $cce = 0x001a; # Length of text definition
2560 my $unknown01 = 0x0000; #
2561 my $ixals = $index +1; # Sheet index
2562 my $unknown02 = 0x00; #
2563 my $cchCustMenu = 0x00; # Length of cust menu text
2564 my $cchDescription = 0x00; # Length of description text
2565 my $cchHelptopic = 0x00; # Length of help topic text
2566 my $cchStatustext = 0x00; # Length of status bar text
2567 my $rgch = $type; # Built-in name type
2568
2569 my $unknown03 = 0x29;
2570 my $unknown04 = 0x0017;
2571 my $unknown05 = 0x3b;
2572
2573 my $rowmin = $_[0]; # Start row
2574 my $rowmax = $_[1]; # End row
2575 my $colmin = $_[2]; # Start column
2576 my $colmax = $_[3]; # end column
2577
2578
2579 my $header = pack("vv", $record, $length);
2580 my $data = pack("v", $grbit);
2581 $data .= pack("C", $chKey);
2582 $data .= pack("C", $cch);
2583 $data .= pack("v", $cce);
2584 $data .= pack("v", $unknown01);
2585 $data .= pack("v", $ixals);
2586 $data .= pack("C", $unknown02);
2587 $data .= pack("C", $cchCustMenu);
2588 $data .= pack("C", $cchDescription);
2589 $data .= pack("C", $cchHelptopic);
2590 $data .= pack("C", $cchStatustext);
2591 $data .= pack("C", $rgch);
2592
2593 # Column definition
2594 $data .= pack("C", $unknown03);
2595 $data .= pack("v", $unknown04);
2596 $data .= pack("C", $unknown05);
2597 $data .= pack("v", $ext_ref);
2598 $data .= pack("v", 0x0000);
2599 $data .= pack("v", 0xffff);
2600 $data .= pack("v", $colmin);
2601 $data .= pack("v", $colmax);
2602
2603 # Row definition
2604 $data .= pack("C", $unknown05);
2605 $data .= pack("v", $ext_ref);
2606 $data .= pack("v", $rowmin);
2607 $data .= pack("v", $rowmax);
2608 $data .= pack("v", 0x00);
2609 $data .= pack("v", 0xff);
2610 # End of data
2611 $data .= pack("C", 0x10);
2612
2613 $self->_append($header, $data);
2614}
2615
2616
2617###############################################################################
2618#
2619# _store_palette()
2620#
2621# Stores the PALETTE biff record.
2622#
2623sub _store_palette {
2624
2625 my $self = shift;
2626
2627 my $aref = $self->{_palette};
2628
2629 my $record = 0x0092; # Record identifier
2630 my $length = 2 + 4 * @$aref; # Number of bytes to follow
2631 my $ccv = @$aref; # Number of RGB values to follow
2632 my $data; # The RGB data
2633
2634 # Pack the RGB data
2635 $data .= pack "CCCC", @$_ for @$aref;
2636
2637 my $header = pack("vvv", $record, $length, $ccv);
2638
2639 $self->_append($header, $data);
2640}
2641
2642
2643###############################################################################
2644#
2645# _store_codepage()
2646#
2647# Stores the CODEPAGE biff record.
2648#
2649sub _store_codepage {
2650
2651 my $self = shift;
2652
2653 my $record = 0x0042; # Record identifier
2654 my $length = 0x0002; # Number of bytes to follow
2655 my $cv = $self->{_codepage}; # The code page
2656
2657 my $header = pack("vv", $record, $length);
2658 my $data = pack("v", $cv);
2659
2660 $self->_append($header, $data);
2661}
2662
2663
2664###############################################################################
2665#
2666# _store_country()
2667#
2668# Stores the COUNTRY biff record.
2669#
2670sub _store_country {
2671
2672 my $self = shift;
2673
2674 my $record = 0x008C; # Record identifier
2675 my $length = 0x0004; # Number of bytes to follow
2676 my $country_default = $self->{_country};
2677 my $country_win_ini = $self->{_country};
2678
2679 my $header = pack("vv", $record, $length);
2680 my $data = pack("vv", $country_default, $country_win_ini);
2681
2682 $self->_append($header, $data);
2683}
2684
2685
2686###############################################################################
2687#
2688# _store_hideobj()
2689#
2690# Stores the HIDEOBJ biff record.
2691#
2692sub _store_hideobj {
2693
2694 my $self = shift;
2695
2696 my $record = 0x008D; # Record identifier
2697 my $length = 0x0002; # Number of bytes to follow
2698 my $hide = $self->{_hideobj}; # Option to hide objects
2699
2700 my $header = pack("vv", $record, $length);
2701 my $data = pack("v", $hide);
2702
2703 $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#
2720sub _calculate_extern_sizes {
2721
2722 my $self = shift;
2723
2724
2725 my %ext_refs = $self->{_parser}->get_ext_sheets();
2726 my $ext_ref_count = scalar keys %ext_refs;
2727 my $length = 0;
2728 my $index = 0;
2729
2730
2731 if (@{$self->{_defined_names}}) {
2732 my $index = 0;
2733 my $key = "$index:$index";
2734
2735 if (not exists $ext_refs{$key}) {
2736 $ext_refs{$key} = $ext_ref_count++;
2737 }
2738 }
2739
2740 for my $defined_name (@{$self->{_defined_names}}) {
2741 $length += 19
2742 + length($defined_name->{name})
2743 + length($defined_name->{formula});
2744 }
2745
2746
2747 foreach my $worksheet (@{$self->{_worksheets}}) {
2748
2749 my $rowmin = $worksheet->{_title_rowmin};
2750 my $colmin = $worksheet->{_title_colmin};
2751 my $filter = $worksheet->{_filter_count};
2752 my $key = "$index:$index";
2753 $index++;
2754
2755
2756 # Add area NAME records
2757 #
2758 if (defined $worksheet->{_print_rowmin}) {
2759 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2760
2761 $length += 31 ;
2762 }
2763
2764
2765 # Add title NAME records
2766 #
2767 if (defined $rowmin and defined $colmin) {
2768 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2769
2770 $length += 46;
2771 }
2772 elsif (defined $rowmin or defined $colmin) {
2773 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2774
2775 $length += 31;
2776 }
2777 else {
2778 # TODO, may need this later.
2779 }
2780
2781
2782 # Add Autofilter NAME records
2783 #
2784 if ($filter) {
2785 $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
2786
2787 $length += 31;
2788 }
2789 }
2790
2791
2792 # Update the ref counts.
2793 $self->{_ext_ref_count} = $ext_ref_count;
2794 $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 return $length = 0 if $ext_ref_count == 0;
2801
2802
2803 # The SUPBOOK record is 8 bytes
2804 $length += 8;
2805
2806 # The EXTERNSHEET record is 6 bytes + 6 bytes for each external ref
2807 $length += 6 * (1 + $ext_ref_count);
2808
2809 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#
2829sub _calculate_shared_string_sizes {
2830
2831 my $self = shift;
2832
2833 my @strings;
2834 $#strings = $self->{_str_unique} -1; # Pre-extend array
2835
2836 while (my $key = each %{$self->{_str_table}}) {
2837 $strings[$self->{_str_table}->{$key}] = $key;
2838 }
2839
2840 # The SST data could be very large, free some memory (maybe).
2841 $self->{_str_table} = undef;
2842 $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 my $continue_limit = 8208;
2858 my $block_length = 0;
2859 my $written = 0;
2860 my @block_sizes;
2861 my $continue = 0;
2862
2863 for my $string (@strings) {
2864
2865 my $string_length = length $string;
2866 my $encoding = unpack "xx C", $string;
2867 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 $block_length += $string_length;
2874
2875
2876 # We can write the string if it doesn't cross a CONTINUE boundary
2877 if ($block_length < $continue_limit) {
2878 $written += $string_length;
2879 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 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 my $header_length = 3; # Min string + header size -1
2893 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 my $align = 0;
2900
2901 # Only applies to Unicode strings
2902 if ($encoding == 1) {
2903 # Min string + header size -1
2904 $header_length = 4;
2905
2906 if ($space_remaining > $header_length) {
2907 # String contains 3 byte header => split on odd boundary
2908 if (not $split_string and $space_remaining % 2 != 1) {
2909 $space_remaining--;
2910 $align = 1;
2911 }
2912 # Split section without header => split on even boundary
2913 elsif ($split_string and $space_remaining % 2 == 1) {
2914 $space_remaining--;
2915 $align = 1;
2916 }
2917
2918 $split_string = 1;
2919 }
2920 }
2921
2922
2923 if ($space_remaining > $header_length) {
2924 # Write as much as possible of the string in the current block
2925 $written += $space_remaining;
2926
2927 # Reduce the current block length by the amount written
2928 $block_length -= $continue_limit -$continue -$align;
2929
2930 # Store the max size for this block
2931 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 if ($block_length > 0) {
2938 $continue = 1;
2939 }
2940 else {
2941 $continue = 0;
2942 }
2943
2944 }
2945 else {
2946 # Store the max size for this block
2947 push @block_sizes, $written +$continue;
2948
2949 # Not enough space to start the string in the current block
2950 $block_length -= $continue_limit -$space_remaining -$continue;
2951 $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 if ($block_length < $continue_limit) {
2960 $written = $block_length;
2961 }
2962 else {
2963 $written = 0;
2964 }
2965 }
2966 }
2967
2968 # Store the max size for the last block unless it is empty
2969 push @block_sizes, $written +$continue if $written +$continue;
2970
2971
2972 $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 my $length = 12;
2981 $length += shift @block_sizes if @block_sizes; # SST
2982 $length += 4 + shift @block_sizes while @block_sizes; # CONTINUEs
2983
2984 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#
3001sub _store_shared_strings {
3002
3003 my $self = shift;
3004
3005 my @strings = @{$self->{_str_array}};
3006
3007
3008 my $record = 0x00FC; # Record identifier
3009 my $length = 0x0008; # Number of bytes to follow
3010 my $total = 0x0000;
3011
3012 # Iterate through the strings to calculate the CONTINUE block sizes
3013 my $continue_limit = 8208;
3014 my $block_length = 0;
3015 my $written = 0;
3016 my $continue = 0;
3017
3018 # The SST and CONTINUE block sizes have been pre-calculated by
3019 # _calculate_shared_string_sizes()
3020 my @block_sizes = @{$self->{_str_block_sizes}};
3021
3022
3023 # The SST record is required even if it contains no strings. Thus we will
3024 # always have a length
3025 #
3026 if (@block_sizes) {
3027 $length = 8 + shift @block_sizes;
3028 }
3029 else {
3030 # No strings
3031 $length = 8;
3032 }
3033
3034
3035 # Initialise variables used to track EXTSST bucket offsets.
3036 my $extsst_str_num = -1;
3037 my $sst_block_start = $self->{_datasize};
3038
3039
3040 # Write the SST block header information
3041 my $header = pack("vv", $record, $length);
3042 my $data = pack("VV", $self->{_str_total}, $self->{_str_unique});
3043 $self->_append($header, $data);
3044
3045
3046 # Iterate through the strings and write them out
3047 for my $string (@strings) {
3048
3049 my $string_length = length $string;
3050 my $encoding = unpack "xx C", $string;
3051 my $split_string = 0;
3052 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 if (++$extsst_str_num % $self->{_extsst_bucket_size} == 0) {
3057 $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 $block_length += $string_length;
3065
3066
3067 # We can write the string if it doesn't cross a CONTINUE boundary
3068 if ($block_length < $continue_limit) {
3069
3070 # Store location of EXTSST bucket string.
3071 if ($bucket_string) {
3072 my $global_offset = $self->{_datasize};
3073 my $local_offset = $self->{_datasize} - $sst_block_start;
3074
3075 push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
3076 $bucket_string = 0;
3077 }
3078
3079 $self->_append($string);
3080 $written += $string_length;
3081 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 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 my $header_length = 3; # Min string + header size -1
3095 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 my $align = 0;
3102
3103 # Only applies to Unicode strings
3104 if ($encoding == 1) {
3105 # Min string + header size -1
3106 $header_length = 4;
3107
3108 if ($space_remaining > $header_length) {
3109 # String contains 3 byte header => split on odd boundary
3110 if (not $split_string and $space_remaining % 2 != 1) {
3111 $space_remaining--;
3112 $align = 1;
3113 }
3114 # Split section without header => split on even boundary
3115 elsif ($split_string and $space_remaining % 2 == 1) {
3116 $space_remaining--;
3117 $align = 1;
3118 }
3119
3120 $split_string = 1;
3121 }
3122 }
3123
3124
3125 if ($space_remaining > $header_length) {
3126 # Write as much as possible of the string in the current block
3127 my $tmp = substr $string, 0, $space_remaining;
3128
3129 # Store location of EXTSST bucket string.
3130 if ($bucket_string) {
3131 my $global_offset = $self->{_datasize};
3132 my $local_offset = $self->{_datasize} - $sst_block_start;
3133
3134 push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
3135 $bucket_string = 0;
3136 }
3137
3138 $self->_append($tmp);
3139
3140
3141 # The remainder will be written in the next block(s)
3142 $string = substr $string, $space_remaining;
3143
3144 # Reduce the current block length by the amount written
3145 $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 if ($block_length > 0) {
3152 $continue = 1;
3153 }
3154 else {
3155 $continue = 0;
3156 }
3157 }
3158 else {
3159 # Not enough space to start the string in the current block
3160 $block_length -= $continue_limit -$space_remaining -$continue;
3161 $continue = 0;
3162 }
3163
3164 # Write the CONTINUE block header
3165 if (@block_sizes) {
3166 $sst_block_start= $self->{_datasize}; # Reset EXTSST offset.
3167
3168 $record = 0x003C;
3169 $length = shift @block_sizes;
3170
3171 $header = pack("vv", $record, $length);
3172 $header .= pack("C", $encoding) if $continue;
3173
3174 $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 if ($block_length < $continue_limit) {
3182
3183 # Store location of EXTSST bucket string.
3184 if ($bucket_string) {
3185 my $global_offset = $self->{_datasize};
3186 my $local_offset = $self->{_datasize} - $sst_block_start;
3187
3188 push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
3189
3190 $bucket_string = 0;
3191 }
3192 $self->_append($string);
3193
3194 $written = $block_length;
3195 }
3196 else {
3197 $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#
3214sub _calculate_extsst_size {
3215
3216 my $self = shift;
3217
3218 my $unique_strings = $self->{_str_unique};
3219
3220 my $bucket_size;
3221 my $buckets;
3222
3223 if ($unique_strings < 1024) {
3224 $bucket_size = 8;
3225 }
3226 else {
3227 $bucket_size = 1 + int($unique_strings / 128);
3228 }
3229
3230 $buckets = int(($unique_strings + $bucket_size -1) / $bucket_size);
3231
3232
3233 $self->{_extsst_buckets} = $buckets ;
3234 $self->{_extsst_bucket_size} = $bucket_size;
3235
3236
3237 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#
3247sub _store_extsst {
3248
3249 my $self = shift;
3250
3251 my @offsets = @{$self->{_extsst_offsets}};
3252 my $bucket_size = $self->{_extsst_bucket_size};
3253
3254 my $record = 0x00FF; # Record identifier
3255 my $length = 2 + 8 * @offsets; # Bytes to follow
3256
3257 my $header = pack 'vv', $record, $length;
3258 my $data = pack 'v', $bucket_size,;
3259
3260 for my $offset (@offsets) {
3261 $data .= pack 'Vvv', $offset->[0], $offset->[1], 0;
3262 }
3263
3264 $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#
3282sub _add_mso_drawing_group {
3283
3284 my $self = shift;
3285
3286 return unless $self->{_mso_size};
3287
3288 my $record = 0x00EB; # Record identifier
3289 my $length = 0x0000; # Number of bytes to follow
3290
3291 my $data = $self->_store_mso_dgg_container();
3292 $data .= $self->_store_mso_dgg(@{$self->{_mso_clusters}});
3293 $data .= $self->_store_mso_bstore_container();
3294 $data .= $self->_store_mso_images(@$_) for @{$self->{_images_data}};
3295 $data .= $self->_store_mso_opt();
3296 $data .= $self->_store_mso_split_menu_colors();
3297
3298 $length = length $data;
3299 my $header = pack("vv", $record, $length);
3300
3301 $self->_add_mso_drawing_group_continue($header . $data);
3302
3303 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#
3322sub _add_mso_drawing_group_continue {
3323
3324 my $self = shift;
3325
3326 my $data = $_[0];
3327 my $limit = 8228 -4;
3328 my $mso_group = 0x00EB; # Record identifier
3329 my $continue = 0x003C; # Record identifier
3330 my $block_count = 1;
3331 my $header;
3332 my $tmp;
3333
3334 # Ignore the base class _add_continue() method.
3335 $self->{_ignore_continue} = 1;
3336
3337 # Case 1 above. Just return the data as it is.
3338 if (length $data <= $limit) {
3339 $self->_append($data);
3340 return;
3341 }
3342
3343 # Change length field of the first MSODRAWINGGROUP block. Case 2 and 3.
3344 $tmp = substr($data, 0, $limit +4, "");
3345 substr($tmp, 2, 2, pack("v", $limit));
3346 $self->_append($tmp);
3347
3348
3349 # Add MSODRAWINGGROUP and CONTINUE blocks for Case 3 above.
3350 while (length($data) > $limit) {
3351 if ($block_count == 1) {
3352 # Add extra MSODRAWINGGROUP block header.
3353 $header = pack("vv", $mso_group, $limit);
3354 $block_count++;
3355 }
3356 else {
3357 # Add normal CONTINUE header.
3358 $header = pack("vv", $continue, $limit);
3359 }
3360
3361 $tmp = substr($data, 0, $limit, "");
3362 $self->_append($header, $tmp);
3363 }
3364
3365
3366 # Last CONTINUE block for remaining data. Case 2 and 3 above.
3367 $header = pack("vv", $continue, length($data));
3368 $self->_append($header, $data);
3369
3370
3371 # Turn the base class _add_continue() method back on.
3372 $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#
3382sub _store_mso_dgg_container {
3383
3384 my $self = shift;
3385
3386 my $type = 0xF000;
3387 my $version = 15;
3388 my $instance = 0;
3389 my $data = '';
3390 my $length = $self->{_mso_size} -12; # -4 (biff header) -8 (for this).
3391
3392
3393 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#
3403sub _store_mso_dgg {
3404
3405 my $self = shift;
3406
3407 my $type = 0xF006;
3408 my $version = 0;
3409 my $instance = 0;
3410 my $data = '';
3411 my $length = undef; # Calculate automatically.
3412
3413 my $max_spid = $_[0];
3414 my $num_clusters = $_[1];
3415 my $shapes_saved = $_[2];
3416 my $drawings_saved = $_[3];
3417 my $clusters = $_[4];
3418
3419 $data = pack "VVVV", $max_spid, $num_clusters,
3420 $shapes_saved, $drawings_saved;
3421
3422 for my $aref (@$clusters) {
3423 my $drawing_id = $aref->[0];
3424 my $shape_ids_used = $aref->[1];
3425
3426 $data .= pack "VV", $drawing_id, $shape_ids_used;
3427 }
3428
3429
3430 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#
3440sub _store_mso_bstore_container {
3441
3442 my $self = shift;
3443
3444 return '' unless $self->{_images_size};
3445
3446 my $type = 0xF001;
3447 my $version = 15;
3448 my $instance = @{$self->{_images_data}}; # Number of images.
3449 my $data = '';
3450 my $length = $self->{_images_size} +8 *$instance;
3451
3452 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#
3463sub _store_mso_images {
3464
3465 my $self = shift;
3466
3467 my $ref_count = $_[0];
3468 my $image_type = $_[1];
3469 my $image = $_[2];
3470 my $size = $_[3];
3471 my $checksum1 = $_[4];
3472 my $checksum2 = $_[5];
3473
3474 my $blip_store_entry = $self->_store_mso_blip_store_entry($ref_count,
3475 $image_type,
3476 $size,
3477 $checksum1);
3478
3479 my $blip = $self->_store_mso_blip($image_type,
3480 $image,
3481 $size,
3482 $checksum1,
3483 $checksum2);
3484
3485 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#
3496sub _store_mso_blip_store_entry {
3497
3498 my $self = shift;
3499
3500 my $ref_count = $_[0];
3501 my $image_type = $_[1];
3502 my $size = $_[2];
3503 my $checksum1 = $_[3];
3504
3505
3506 my $type = 0xF007;
3507 my $version = 2;
3508 my $instance = $image_type;
3509 my $length = $size +61;
3510 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 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#
3533sub _store_mso_blip {
3534
3535 my $self = shift;
3536
3537 my $image_type = $_[0];
3538 my $image_data = $_[1];
3539 my $size = $_[2];
3540 my $checksum1 = $_[3];
3541 my $checksum2 = $_[4];
3542 my $instance;
3543
3544 $instance = 0x046A if $image_type == 5; # JPG
3545 $instance = 0x06E0 if $image_type == 6; # PNG
3546 $instance = 0x07A9 if $image_type == 7; # BMP
3547
3548 # BMPs contain an extra checksum for the stripped data.
3549 if ( $image_type == 7) {
3550 $checksum1 = $checksum2 . $checksum1;
3551 }
3552
3553 my $type = 0xF018 + $image_type;
3554 my $version = 0x0000;
3555 my $length = $size +17;
3556 my $data = pack('H*', $checksum1) # Uid checksum
3557 . pack('C', 0xFF) # Tag
3558 . $image_data # Image
3559 ;
3560
3561 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#
3572sub _store_mso_opt {
3573
3574 my $self = shift;
3575
3576 my $type = 0xF00B;
3577 my $version = 3;
3578 my $instance = 3;
3579 my $data = '';
3580 my $length = 18;
3581
3582 $data = pack "H*", 'BF0008000800810109000008C0014000' .
3583 '0008';
3584
3585
3586 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#
3596sub _store_mso_split_menu_colors {
3597
3598 my $self = shift;
3599
3600 my $type = 0xF11E;
3601 my $version = 0;
3602 my $instance = 4;
3603 my $data = '';
3604 my $length = 16;
3605
3606 $data = pack "H*", '0D0000080C00000817000008F7000010';
3607
3608 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
3609}
3610
3611
36121;
3613
3614
3615__END__
3616
3617
3618=head1 NAME
3619
3620Workbook - A writer class for Excel Workbooks.
3621
3622=head1 SYNOPSIS
3623
3624See the documentation for Spreadsheet::WriteExcel
3625
3626=head1 DESCRIPTION
3627
3628This module is used in conjunction with Spreadsheet::WriteExcel.
3629
3630=head1 AUTHOR
3631
3632John McNamara jmcnamara@cpan.org
3633
3634=head1 COPYRIGHT
3635
3636© MM-MMX, John McNamara.
3637
3638All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.