[Feature]Upload Modem source code
Change-Id: Id4294f30faced84d3e6fd6d5e61e1111bf287a37
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Workbook.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Workbook.pm
new file mode 100644
index 0000000..0276bb2
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Workbook.pm
@@ -0,0 +1,3638 @@
+package Spreadsheet::WriteExcel::Workbook;
+
+###############################################################################
+#
+# Workbook - A writer class for Excel Workbooks.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+use Exporter;
+use strict;
+use Carp;
+use Spreadsheet::WriteExcel::BIFFwriter;
+use Spreadsheet::WriteExcel::OLEwriter;
+use Spreadsheet::WriteExcel::Worksheet;
+use Spreadsheet::WriteExcel::Format;
+use Spreadsheet::WriteExcel::Chart;
+use Spreadsheet::WriteExcel::Properties ':property_sets';
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::BIFFwriter Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+# Constructor. Creates a new Workbook object from a BIFFwriter object.
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
+ my $byte_order = $self->{_byte_order};
+ my $parser = Spreadsheet::WriteExcel::Formula->new($byte_order);
+
+ $self->{_filename} = $_[0] || '';
+ $self->{_parser} = $parser;
+ $self->{_tempdir} = undef;
+ $self->{_1904} = 0;
+ $self->{_activesheet} = 0;
+ $self->{_firstsheet} = 0;
+ $self->{_selected} = 0;
+ $self->{_xf_index} = 0;
+ $self->{_fileclosed} = 0;
+ $self->{_biffsize} = 0;
+ $self->{_sheet_name} = 'Sheet';
+ $self->{_chart_name} = 'Chart';
+ $self->{_sheet_count} = 0;
+ $self->{_chart_count} = 0;
+ $self->{_url_format} = '';
+ $self->{_codepage} = 0x04E4;
+ $self->{_country} = 1;
+ $self->{_worksheets} = [];
+ $self->{_sheetnames} = [];
+ $self->{_formats} = [];
+ $self->{_palette} = [];
+
+ $self->{_using_tmpfile} = 1;
+ $self->{_filehandle} = "";
+ $self->{_temp_file} = "";
+ $self->{_internal_fh} = 0;
+ $self->{_fh_out} = "";
+
+ $self->{_str_total} = 0;
+ $self->{_str_unique} = 0;
+ $self->{_str_table} = {};
+ $self->{_str_array} = [];
+ $self->{_str_block_sizes} = [];
+ $self->{_extsst_offsets} = [];
+ $self->{_extsst_buckets} = 0;
+ $self->{_extsst_bucket_size} = 0;
+
+ $self->{_ext_ref_count} = 0;
+ $self->{_ext_refs} = {};
+
+ $self->{_mso_clusters} = [];
+ $self->{_mso_size} = 0;
+
+ $self->{_hideobj} = 0;
+ $self->{_compatibility} = 0;
+
+ $self->{_add_doc_properties} = 0;
+ $self->{_localtime} = [localtime()];
+
+ $self->{_defined_names} = [];
+
+ bless $self, $class;
+
+
+ # Add the in-built style formats and the default cell format.
+ $self->add_format(type => 1); # 0 Normal
+ $self->add_format(type => 1); # 1 RowLevel 1
+ $self->add_format(type => 1); # 2 RowLevel 2
+ $self->add_format(type => 1); # 3 RowLevel 3
+ $self->add_format(type => 1); # 4 RowLevel 4
+ $self->add_format(type => 1); # 5 RowLevel 5
+ $self->add_format(type => 1); # 6 RowLevel 6
+ $self->add_format(type => 1); # 7 RowLevel 7
+ $self->add_format(type => 1); # 8 ColLevel 1
+ $self->add_format(type => 1); # 9 ColLevel 2
+ $self->add_format(type => 1); # 10 ColLevel 3
+ $self->add_format(type => 1); # 11 ColLevel 4
+ $self->add_format(type => 1); # 12 ColLevel 5
+ $self->add_format(type => 1); # 13 ColLevel 6
+ $self->add_format(type => 1); # 14 ColLevel 7
+ $self->add_format(); # 15 Cell XF
+ $self->add_format(type => 1, num_format => 0x2B); # 16 Comma
+ $self->add_format(type => 1, num_format => 0x29); # 17 Comma[0]
+ $self->add_format(type => 1, num_format => 0x2C); # 18 Currency
+ $self->add_format(type => 1, num_format => 0x2A); # 19 Currency[0]
+ $self->add_format(type => 1, num_format => 0x09); # 20 Percent
+
+
+ # Add the default format for hyperlinks
+ $self->{_url_format} = $self->add_format(color => 'blue', underline => 1);
+
+
+ # Check for a filename unless it is an existing filehandle
+ if (not ref $self->{_filename} and $self->{_filename} eq '') {
+ carp 'Filename required by Spreadsheet::WriteExcel->new()';
+ return undef;
+ }
+
+
+ # Convert the filename to a filehandle to pass to the OLE writer when the
+ # file is closed. If the filename is a reference it is assumed that it is
+ # a valid filehandle.
+ #
+ if (not ref $self->{_filename}) {
+
+ my $fh = FileHandle->new('>'. $self->{_filename});
+
+ if (not defined $fh) {
+ carp "Can't open " .
+ $self->{_filename} .
+ ". It may be in use or protected";
+ return undef;
+ }
+
+ # binmode file whether platform requires it or not
+ binmode($fh);
+ $self->{_internal_fh} = 1;
+ $self->{_fh_out} = $fh;
+ }
+ else {
+ $self->{_internal_fh} = 0;
+ $self->{_fh_out} = $self->{_filename};
+
+ }
+
+
+ # Set colour palette.
+ $self->set_palette_xl97();
+
+ # Load Encode if we can.
+ require Encode if $] >= 5.008;
+
+ $self->_initialize();
+ $self->_get_checksum_method();
+ return $self;
+}
+
+
+###############################################################################
+#
+# _initialize()
+#
+# Open a tmp file to store the majority of the Worksheet data. If this fails,
+# for example due to write permissions, store the data in memory. This can be
+# slow for large files.
+#
+# TODO: Move this and other methods shared with Worksheet up into BIFFwriter.
+#
+sub _initialize {
+
+ my $self = shift;
+ my $fh;
+ my $tmp_dir;
+
+ # The following code is complicated by Windows limitations. Porters can
+ # choose a more direct method.
+
+
+
+ # In the default case we use IO::File->new_tmpfile(). This may fail, in
+ # particular with IIS on Windows, so we allow the user to specify a temp
+ # directory via File::Temp.
+ #
+ if (defined $self->{_tempdir}) {
+
+ # Delay loading File:Temp to reduce the module dependencies.
+ eval { require File::Temp };
+ die "The File::Temp module must be installed in order ".
+ "to call set_tempdir().\n" if $@;
+
+
+ # Trap but ignore File::Temp errors.
+ eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
+
+ # Store the failed tmp dir in case of errors.
+ $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
+ }
+ else {
+
+ $fh = IO::File->new_tmpfile();
+
+ # Store the failed tmp dir in case of errors.
+ $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
+ }
+
+
+ # Check if the temp file creation was successful. Else store data in memory.
+ if ($fh) {
+
+ # binmode file whether platform requires it or not.
+ binmode($fh);
+
+ # Store filehandle
+ $self->{_filehandle} = $fh;
+ }
+ else {
+
+ # Set flag to store data in memory if XX::tempfile() failed.
+ $self->{_using_tmpfile} = 0;
+
+ if ($^W) {
+ my $dir = $self->{_tempdir} || File::Spec->tmpdir();
+
+ warn "Unable to create temp files in $tmp_dir. Data will be ".
+ "stored in memory. Refer to set_tempdir() in the ".
+ "Spreadsheet::WriteExcel documentation.\n" ;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _get_checksum_method.
+#
+# Check for modules available to calculate image checksum. Excel uses MD4 but
+# MD5 will also work.
+#
+sub _get_checksum_method {
+
+ my $self = shift;
+
+ eval { require Digest::MD4};
+ if (not $@) {
+ $self->{_checksum_method} = 1;
+ return;
+ }
+
+
+ eval { require Digest::Perl::MD4};
+ if (not $@) {
+ $self->{_checksum_method} = 2;
+ return;
+ }
+
+
+ eval { require Digest::MD5};
+ if (not $@) {
+ $self->{_checksum_method} = 3;
+ return;
+ }
+
+ # Default.
+ $self->{_checksum_method} = 0;
+}
+
+
+###############################################################################
+#
+# _append(), overridden.
+#
+# Store Worksheet data in memory using the base class _append() or to a
+# temporary file, the default.
+#
+sub _append {
+
+ my $self = shift;
+ my $data = '';
+
+ if ($self->{_using_tmpfile}) {
+ $data = join('', @_);
+
+ # Add CONTINUE records if necessary
+ $data = $self->_add_continue($data) if length($data) > $self->{_limit};
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ print {$self->{_filehandle}} $data;
+ $self->{_datasize} += length($data);
+ }
+ else {
+ $data = $self->SUPER::_append(@_);
+ }
+
+ return $data;
+}
+
+
+###############################################################################
+#
+# get_data().
+#
+# Retrieves data from memory in one chunk, or from disk in $buffer
+# sized chunks.
+#
+sub get_data {
+
+ my $self = shift;
+ my $buffer = 4096;
+ my $tmp;
+
+ # Return data stored in memory
+ if (defined $self->{_data}) {
+ $tmp = $self->{_data};
+ $self->{_data} = undef;
+ my $fh = $self->{_filehandle};
+ seek($fh, 0, 0) if $self->{_using_tmpfile};
+ return $tmp;
+ }
+
+ # Return data stored on disk
+ if ($self->{_using_tmpfile}) {
+ return $tmp if read($self->{_filehandle}, $tmp, $buffer);
+ }
+
+ # No data to return
+ return undef;
+}
+
+
+###############################################################################
+#
+# close()
+#
+# Calls finalization methods and explicitly close the OLEwriter file
+# handle.
+#
+sub close {
+
+ my $self = shift;
+
+ return if $self->{_fileclosed}; # Prevent close() from being called twice.
+
+ $self->{_fileclosed} = 1;
+
+ return $self->_store_workbook();
+}
+
+
+###############################################################################
+#
+# DESTROY()
+#
+# Close the workbook if it hasn't already been explicitly closed.
+#
+sub DESTROY {
+
+ my $self = shift;
+
+ local ($@, $!, $^E, $?);
+
+ $self->close() if not $self->{_fileclosed};
+}
+
+
+###############################################################################
+#
+# sheets(slice,...)
+#
+# An accessor for the _worksheets[] array
+#
+# Returns: an optionally sliced list of the worksheet objects in a workbook.
+#
+sub sheets {
+
+ my $self = shift;
+
+ if (@_) {
+ # Return a slice of the array
+ return @{$self->{_worksheets}}[@_];
+ }
+ else {
+ # Return the entire list
+ return @{$self->{_worksheets}};
+ }
+}
+
+
+###############################################################################
+#
+# worksheets()
+#
+# An accessor for the _worksheets[] array.
+# This method is now deprecated. Use the sheets() method instead.
+#
+# Returns: an array reference
+#
+sub worksheets {
+
+ my $self = shift;
+
+ return $self->{_worksheets};
+}
+
+
+###############################################################################
+#
+# add_worksheet($name, $encoding)
+#
+# Add a new worksheet to the Excel workbook.
+#
+# Returns: reference to a worksheet object
+#
+sub add_worksheet {
+
+ my $self = shift;
+ my $index = @{$self->{_worksheets}};
+
+ my ($name, $encoding) = $self->_check_sheetname($_[0], $_[1]);
+
+
+ # Porters take note, the following scheme of passing references to Workbook
+ # data (in the \$self->{_foo} cases) instead of a reference to the Workbook
+ # itself is a workaround to avoid circular references between Workbook and
+ # Worksheet objects. Feel free to implement this in any way the suits your
+ # language.
+ #
+ my @init_data = (
+ $name,
+ $index,
+ $encoding,
+ \$self->{_activesheet},
+ \$self->{_firstsheet},
+ $self->{_url_format},
+ $self->{_parser},
+ $self->{_tempdir},
+ \$self->{_str_total},
+ \$self->{_str_unique},
+ \$self->{_str_table},
+ $self->{_1904},
+ $self->{_compatibility},
+ undef, # Palette. Not used yet. See add_chart().
+ );
+
+ my $worksheet = Spreadsheet::WriteExcel::Worksheet->new(@init_data);
+ $self->{_worksheets}->[$index] = $worksheet; # Store ref for iterator
+ $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
+ $self->{_parser}->set_ext_sheets($name, $index); # Store names in Formula.pm
+ return $worksheet;
+}
+
+# Older method name for backwards compatibility.
+*addworksheet = *add_worksheet;
+
+
+###############################################################################
+#
+# add_chart(%args)
+#
+# Create a chart for embedding or as as new sheet.
+#
+#
+sub add_chart {
+
+ my $self = shift;
+ my %arg = @_;
+ my $name = '';
+ my $encoding = 0;
+ my $index = @{ $self->{_worksheets} };
+
+ # Type must be specified so we can create the required chart instance.
+ my $type = $arg{type};
+ if ( !defined $type ) {
+ croak "Must define chart type in add_chart()";
+ }
+
+ # Ensure that the chart defaults to non embedded.
+ my $embedded = $arg{embedded} ||= 0;
+
+ # Check the worksheet name for non-embedded charts.
+ if ( !$embedded ) {
+ ( $name, $encoding ) =
+ $self->_check_sheetname( $arg{name}, $arg{name_encoding}, 1 );
+ }
+
+ my @init_data = (
+ $name,
+ $index,
+ $encoding,
+ \$self->{_activesheet},
+ \$self->{_firstsheet},
+ $self->{_url_format},
+ $self->{_parser},
+ $self->{_tempdir},
+ \$self->{_str_total},
+ \$self->{_str_unique},
+ \$self->{_str_table},
+ $self->{_1904},
+ $self->{_compatibility},
+ $self->{_palette},
+ );
+
+ my $chart = Spreadsheet::WriteExcel::Chart->factory( $type, @init_data );
+
+ # If the chart isn't embedded let the workbook control it.
+ if ( !$embedded ) {
+ $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
+ $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
+ }
+ else {
+ # Set index to 0 so that the activate() and set_first_sheet() methods
+ # point back to the first worksheet if used for embedded charts.
+ $chart->{_index} = 0;
+
+ $chart->_set_embedded_config_data();
+ }
+
+ return $chart;
+}
+
+
+###############################################################################
+#
+# add_chart_ext($filename, $name)
+#
+# Add an externally created chart.
+#
+#
+sub add_chart_ext {
+
+ my $self = shift;
+ my $filename = $_[0];
+ my $index = @{$self->{_worksheets}};
+ my $type = 'external';
+
+ my ($name, $encoding) = $self->_check_sheetname($_[1], $_[2]);
+
+
+ my @init_data = (
+ $filename,
+ $name,
+ $index,
+ $encoding,
+ \$self->{_activesheet},
+ \$self->{_firstsheet},
+ );
+
+ my $chart = Spreadsheet::WriteExcel::Chart->factory($type, @init_data);
+ $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
+ $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
+
+ return $chart;
+}
+
+
+###############################################################################
+#
+# _check_sheetname($name, $encoding)
+#
+# Check for valid worksheet names. We check the length, if it contains any
+# invalid characters and if the name is unique in the workbook.
+#
+sub _check_sheetname {
+
+ my $self = shift;
+ my $name = $_[0] || "";
+ my $encoding = $_[1] || 0;
+ my $chart = $_[2] || 0;
+ my $limit = $encoding ? 62 : 31;
+ my $invalid_char = qr([\[\]:*?/\\]);
+
+ # Increment the Sheet/Chart number used for default sheet names below.
+ if ( $chart ) {
+ $self->{_chart_count}++;
+ }
+ else {
+ $self->{_sheet_count}++;
+ }
+
+ # Supply default Sheet/Chart name if none has been defined.
+ if ( $name eq "" ) {
+ $encoding = 0;
+
+ if ( $chart ) {
+ $name = $self->{_chart_name} . $self->{_chart_count};
+ }
+ else {
+ $name = $self->{_sheet_name} . $self->{_sheet_count};
+ }
+ }
+
+
+ # Check that sheetname is <= 31 (1 or 2 byte chars). Excel limit.
+ croak "Sheetname $name must be <= 31 chars" if length $name > $limit;
+
+ # Check that Unicode sheetname has an even number of bytes
+ croak 'Odd number of bytes in Unicode worksheet name:' . $name
+ if $encoding == 1 and length($name) % 2;
+
+
+ # Check that sheetname doesn't contain any invalid characters
+ if ($encoding != 1 and $name =~ $invalid_char) {
+ # Check ASCII names
+ croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
+ }
+ else {
+ # Extract any 8bit clean chars from the UTF16 name and validate them.
+ for my $wchar ($name =~ /../sg) {
+ my ($hi, $lo) = unpack "aa", $wchar;
+ if ($hi eq "\0" and $lo =~ $invalid_char) {
+ croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
+ }
+ }
+ }
+
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($name)) {
+ $name = Encode::encode("UTF-16BE", $name);
+ $encoding = 1;
+ }
+ }
+
+
+ # Check that the worksheet name doesn't already exist since this is a fatal
+ # error in Excel 97. The check must also exclude case insensitive matches
+ # since the names 'Sheet1' and 'sheet1' are equivalent. The tests also have
+ # to take the encoding into account.
+ #
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+ my $name_a = $name;
+ my $encd_a = $encoding;
+ my $name_b = $worksheet->{_name};
+ my $encd_b = $worksheet->{_encoding};
+ my $error = 0;
+
+ if ($encd_a == 0 and $encd_b == 0) {
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ elsif ($encd_a == 0 and $encd_b == 1) {
+ $name_a = pack "n*", unpack "C*", $name_a;
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ elsif ($encd_a == 1 and $encd_b == 0) {
+ $name_b = pack "n*", unpack "C*", $name_b;
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ elsif ($encd_a == 1 and $encd_b == 1) {
+ # We can do a true case insensitive test with Perl 5.8 and utf8.
+ if ($] >= 5.008) {
+ $name_a = Encode::decode("UTF-16BE", $name_a);
+ $name_b = Encode::decode("UTF-16BE", $name_b);
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ else {
+ # We can't easily do a case insensitive test of the UTF16 names.
+ # As a special case we check if all of the high bytes are nulls and
+ # then do an ASCII style case insensitive test.
+
+ # Strip out the high bytes (funkily).
+ my $hi_a = grep {ord} $name_a =~ /(.)./sg;
+ my $hi_b = grep {ord} $name_b =~ /(.)./sg;
+
+ if ($hi_a or $hi_b) {
+ $error = 1 if $name_a eq $name_b;
+ }
+ else {
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ }
+ }
+
+ # If any of the cases failed we throw the error here.
+ if ($error) {
+ croak "Worksheet name '$name', with case ignored, " .
+ "is already in use";
+ }
+ }
+
+ return ($name, $encoding);
+}
+
+
+###############################################################################
+#
+# add_format(%properties)
+#
+# Add a new format to the Excel workbook. This adds an XF record and
+# a FONT record. Also, pass any properties to the Format::new().
+#
+sub add_format {
+
+ my $self = shift;
+
+ my $format = Spreadsheet::WriteExcel::Format->new($self->{_xf_index}, @_);
+
+ $self->{_xf_index} += 1;
+ push @{$self->{_formats}}, $format; # Store format reference
+
+ return $format;
+}
+
+# Older method name for backwards compatibility.
+*addformat = *add_format;
+
+
+###############################################################################
+#
+# compatibility_mode()
+#
+# Set the compatibility mode.
+#
+# Excel doesn't require every possible Biff record to be present in a file.
+# In particular if the indexing records INDEX, ROW and DBCELL aren't present
+# it just ignores the fact and reads the cells anyway. This is also true of
+# the EXTSST record. Gnumeric and OOo also take this approach. This allows
+# WriteExcel to ignore these records in order to minimise the amount of data
+# stored in memory. However, other third party applications that read Excel
+# files often expect these records to be present. In "compatibility mode"
+# WriteExcel writes these records and tries to be as close to an Excel
+# generated file as possible.
+#
+# This requires additional data to be stored in memory until the file is
+# about to be written. This incurs a memory and speed penalty and may not be
+# suitable for very large files.
+#
+sub compatibility_mode {
+
+ my $self = shift;
+
+ croak "compatibility_mode() must be called before add_worksheet()"
+ if $self->sheets();
+
+ if (defined($_[0])) {
+ $self->{_compatibility} = $_[0];
+ }
+ else {
+ $self->{_compatibility} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# set_1904()
+#
+# Set the date system: 0 = 1900 (the default), 1 = 1904
+#
+sub set_1904 {
+
+ my $self = shift;
+
+ croak "set_1904() must be called before add_worksheet()"
+ if $self->sheets();
+
+
+ if (defined($_[0])) {
+ $self->{_1904} = $_[0];
+ }
+ else {
+ $self->{_1904} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# get_1904()
+#
+# Return the date system: 0 = 1900, 1 = 1904
+#
+sub get_1904 {
+
+ my $self = shift;
+
+ return $self->{_1904};
+}
+
+
+###############################################################################
+#
+# set_custom_color()
+#
+# Change the RGB components of the elements in the colour palette.
+#
+sub set_custom_color {
+
+ my $self = shift;
+
+
+ # Match a HTML #xxyyzz style parameter
+ if (defined $_[1] and $_[1] =~ /^#(\w\w)(\w\w)(\w\w)/ ) {
+ @_ = ($_[0], hex $1, hex $2, hex $3);
+ }
+
+
+ my $index = $_[0] || 0;
+ my $red = $_[1] || 0;
+ my $green = $_[2] || 0;
+ my $blue = $_[3] || 0;
+
+ my $aref = $self->{_palette};
+
+ # Check that the colour index is the right range
+ if ($index < 8 or $index > 64) {
+ carp "Color index $index outside range: 8 <= index <= 64";
+ return 0;
+ }
+
+ # Check that the colour components are in the right range
+ if ( ($red < 0 or $red > 255) ||
+ ($green < 0 or $green > 255) ||
+ ($blue < 0 or $blue > 255) )
+ {
+ carp "Color component outside range: 0 <= color <= 255";
+ return 0;
+ }
+
+ $index -=8; # Adjust colour index (wingless dragonfly)
+
+ # Set the RGB value
+ $aref->[$index] = [$red, $green, $blue, 0];
+
+ return $index +8;
+}
+
+
+###############################################################################
+#
+# set_palette_xl97()
+#
+# Sets the colour palette to the Excel 97+ default.
+#
+sub set_palette_xl97 {
+
+ my $self = shift;
+
+ $self->{_palette} = [
+ [0x00, 0x00, 0x00, 0x00], # 8
+ [0xff, 0xff, 0xff, 0x00], # 9
+ [0xff, 0x00, 0x00, 0x00], # 10
+ [0x00, 0xff, 0x00, 0x00], # 11
+ [0x00, 0x00, 0xff, 0x00], # 12
+ [0xff, 0xff, 0x00, 0x00], # 13
+ [0xff, 0x00, 0xff, 0x00], # 14
+ [0x00, 0xff, 0xff, 0x00], # 15
+ [0x80, 0x00, 0x00, 0x00], # 16
+ [0x00, 0x80, 0x00, 0x00], # 17
+ [0x00, 0x00, 0x80, 0x00], # 18
+ [0x80, 0x80, 0x00, 0x00], # 19
+ [0x80, 0x00, 0x80, 0x00], # 20
+ [0x00, 0x80, 0x80, 0x00], # 21
+ [0xc0, 0xc0, 0xc0, 0x00], # 22
+ [0x80, 0x80, 0x80, 0x00], # 23
+ [0x99, 0x99, 0xff, 0x00], # 24
+ [0x99, 0x33, 0x66, 0x00], # 25
+ [0xff, 0xff, 0xcc, 0x00], # 26
+ [0xcc, 0xff, 0xff, 0x00], # 27
+ [0x66, 0x00, 0x66, 0x00], # 28
+ [0xff, 0x80, 0x80, 0x00], # 29
+ [0x00, 0x66, 0xcc, 0x00], # 30
+ [0xcc, 0xcc, 0xff, 0x00], # 31
+ [0x00, 0x00, 0x80, 0x00], # 32
+ [0xff, 0x00, 0xff, 0x00], # 33
+ [0xff, 0xff, 0x00, 0x00], # 34
+ [0x00, 0xff, 0xff, 0x00], # 35
+ [0x80, 0x00, 0x80, 0x00], # 36
+ [0x80, 0x00, 0x00, 0x00], # 37
+ [0x00, 0x80, 0x80, 0x00], # 38
+ [0x00, 0x00, 0xff, 0x00], # 39
+ [0x00, 0xcc, 0xff, 0x00], # 40
+ [0xcc, 0xff, 0xff, 0x00], # 41
+ [0xcc, 0xff, 0xcc, 0x00], # 42
+ [0xff, 0xff, 0x99, 0x00], # 43
+ [0x99, 0xcc, 0xff, 0x00], # 44
+ [0xff, 0x99, 0xcc, 0x00], # 45
+ [0xcc, 0x99, 0xff, 0x00], # 46
+ [0xff, 0xcc, 0x99, 0x00], # 47
+ [0x33, 0x66, 0xff, 0x00], # 48
+ [0x33, 0xcc, 0xcc, 0x00], # 49
+ [0x99, 0xcc, 0x00, 0x00], # 50
+ [0xff, 0xcc, 0x00, 0x00], # 51
+ [0xff, 0x99, 0x00, 0x00], # 52
+ [0xff, 0x66, 0x00, 0x00], # 53
+ [0x66, 0x66, 0x99, 0x00], # 54
+ [0x96, 0x96, 0x96, 0x00], # 55
+ [0x00, 0x33, 0x66, 0x00], # 56
+ [0x33, 0x99, 0x66, 0x00], # 57
+ [0x00, 0x33, 0x00, 0x00], # 58
+ [0x33, 0x33, 0x00, 0x00], # 59
+ [0x99, 0x33, 0x00, 0x00], # 60
+ [0x99, 0x33, 0x66, 0x00], # 61
+ [0x33, 0x33, 0x99, 0x00], # 62
+ [0x33, 0x33, 0x33, 0x00], # 63
+ ];
+
+ return 0;
+}
+
+
+###############################################################################
+#
+# set_tempdir()
+#
+# Change the default temp directory used by _initialize() in Worksheet.pm.
+#
+sub set_tempdir {
+
+ my $self = shift;
+
+ # Windows workaround. See Worksheet::_initialize()
+ my $dir = shift || '';
+
+ croak "$dir is not a valid directory" if $dir ne '' and not -d $dir;
+ croak "set_tempdir must be called before add_worksheet" if $self->sheets();
+
+ $self->{_tempdir} = $dir ;
+}
+
+
+###############################################################################
+#
+# set_codepage()
+#
+# See also the _store_codepage method. This is used to store the code page, i.e.
+# the character set used in the workbook.
+#
+sub set_codepage {
+
+ my $self = shift;
+
+ my $codepage = $_[0] || 1;
+ $codepage = 0x04E4 if $codepage == 1;
+ $codepage = 0x8000 if $codepage == 2;
+
+ $self->{_codepage} = $codepage;
+}
+
+
+###############################################################################
+#
+# set_country()
+#
+# See also the _store_country method. This is used to store the country code.
+# Some non-english versions of Excel may need this set to some value other
+# than 1 = "United States". In general the country code is equal to the
+# international dialling code.
+#
+sub set_country {
+
+ my $self = shift;
+
+ $self->{_country} = $_[0] || 1;
+}
+
+
+
+
+
+
+
+###############################################################################
+#
+# define_name()
+#
+# TODO.
+#
+sub define_name {
+
+ my $self = shift;
+ my $name = shift;
+ my $formula = shift;
+ my $encoding = shift || 0;
+ my $sheet_index = 0;
+ my @tokens;
+
+ my $full_name = $name;
+
+ if ($name =~ /^(.*)!(.*)$/) {
+ my $sheetname = $1;
+ $name = $2;
+ $sheet_index = 1 + $self->{_parser}->_get_sheet_index($sheetname);
+ }
+
+
+
+ # Strip the = sign at the beginning of the formula string
+ $formula =~ s(^=)();
+
+ # Parse the formula using the parser in Formula.pm
+ my $parser = $self->{_parser};
+
+ # In order to raise formula errors from the point of view of the calling
+ # program we use an eval block and re-raise the error from here.
+ #
+ eval { @tokens = $parser->parse_formula($formula) };
+
+ if ($@) {
+ $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
+ croak $@; # Re-raise the error
+ }
+
+ # Force 2d ranges to be a reference class.
+ s/_ref3d/_ref3dR/ for @tokens;
+ s/_range3d/_range3dR/ for @tokens;
+
+
+ # Parse the tokens into a formula string.
+ $formula = $parser->parse_tokens(@tokens);
+
+
+
+ $full_name = lc $full_name;
+
+ push @{$self->{_defined_names}}, {
+ name => $name,
+ encoding => $encoding,
+ sheet_index => $sheet_index,
+ formula => $formula,
+ };
+
+ my $index = scalar @{$self->{_defined_names}};
+
+ $parser->set_ext_name($name, $index);
+}
+
+
+
+
+
+
+
+
+
+###############################################################################
+#
+# set_properties()
+#
+# Set the document properties such as Title, Author etc. These are written to
+# property sets in the OLE container.
+#
+sub set_properties {
+
+ my $self = shift;
+ my %param;
+
+ # Ignore if no args were passed.
+ return -1 unless @_;
+
+
+ # Allow the parameters to be passed as a hash or hash ref.
+ if (ref $_[0] eq 'HASH') {
+ %param = %{$_[0]};
+ }
+ else {
+ %param = @_;
+ }
+
+
+ # List of valid input parameters.
+ my %properties = (
+ codepage => [0x0001, 'VT_I2' ],
+ title => [0x0002, 'VT_LPSTR' ],
+ subject => [0x0003, 'VT_LPSTR' ],
+ author => [0x0004, 'VT_LPSTR' ],
+ keywords => [0x0005, 'VT_LPSTR' ],
+ comments => [0x0006, 'VT_LPSTR' ],
+ last_author => [0x0008, 'VT_LPSTR' ],
+ created => [0x000C, 'VT_FILETIME'],
+ category => [0x0002, 'VT_LPSTR' ],
+ manager => [0x000E, 'VT_LPSTR' ],
+ company => [0x000F, 'VT_LPSTR' ],
+ utf8 => 1,
+ );
+
+ # Check for valid input parameters.
+ for my $parameter (keys %param) {
+ if (not exists $properties{$parameter}) {
+ carp "Unknown parameter '$parameter' in set_properties()";
+ return -1;
+ }
+ }
+
+
+ # Set the creation time unless specified by the user.
+ if (!exists $param{created}){
+ $param{created} = $self->{_localtime};
+ }
+
+
+ #
+ # Create the SummaryInformation property set.
+ #
+
+ # Get the codepage of the strings in the property set.
+ my @strings = qw(title subject author keywords comments last_author);
+ $param{codepage} = $self->_get_property_set_codepage(\%param,
+ \@strings);
+
+ # Create an array of property set values.
+ my @property_sets;
+
+ for my $property (qw(codepage title subject author
+ keywords comments last_author created))
+ {
+ if (exists $param{$property} && defined $param{$property}) {
+ push @property_sets, [
+ $properties{$property}->[0],
+ $properties{$property}->[1],
+ $param{$property}
+ ];
+ }
+ }
+
+ # Pack the property sets.
+ $self->{summary} = create_summary_property_set(\@property_sets);
+
+
+ #
+ # Create the DocSummaryInformation property set.
+ #
+
+ # Get the codepage of the strings in the property set.
+ @strings = qw(category manager company);
+ $param{codepage} = $self->_get_property_set_codepage(\%param,
+ \@strings);
+
+ # Create an array of property set values.
+ @property_sets = ();
+
+ for my $property (qw(codepage category manager company))
+ {
+ if (exists $param{$property} && defined $param{$property}) {
+ push @property_sets, [
+ $properties{$property}->[0],
+ $properties{$property}->[1],
+ $param{$property}
+ ];
+ }
+ }
+
+ # Pack the property sets.
+ $self->{doc_summary} = create_doc_summary_property_set(\@property_sets);
+
+ # Set a flag for when the files is written.
+ $self->{_add_doc_properties} = 1;
+}
+
+
+###############################################################################
+#
+# _get_property_set_codepage()
+#
+# Get the character codepage used by the strings in a property set. If one of
+# the strings used is utf8 then the codepage is marked as utf8. Otherwise
+# Latin 1 is used (although in our case this is limited to 7bit ASCII).
+#
+sub _get_property_set_codepage {
+
+ my $self = shift;
+
+ my $params = $_[0];
+ my $strings = $_[1];
+
+ # Allow for manually marked utf8 strings.
+ return 0xFDE9 if defined $params->{utf8};
+
+ # Check for utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+ for my $string (@{$strings }) {
+ next unless exists $params->{$string};
+ return 0xFDE9 if Encode::is_utf8($params->{$string});
+ }
+ }
+
+ return 0x04E4; # Default codepage, Latin 1.
+}
+
+
+###############################################################################
+#
+# _store_workbook()
+#
+# Assemble worksheets into a workbook and send the BIFF data to an OLE
+# storage.
+#
+sub _store_workbook {
+
+ my $self = shift;
+
+ # Add a default worksheet if non have been added.
+ $self->add_worksheet() if not @{$self->{_worksheets}};
+
+ # Calculate size required for MSO records and update worksheets.
+ $self->_calc_mso_sizes();
+
+ # Ensure that at least one worksheet has been selected.
+ if ($self->{_activesheet} == 0) {
+ @{$self->{_worksheets}}[0]->{_selected} = 1;
+ @{$self->{_worksheets}}[0]->{_hidden} = 0;
+ }
+
+ # Calculate the number of selected sheet tabs and set the active sheet.
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $self->{_selected}++ if $sheet->{_selected};
+ $sheet->{_active} = 1 if $sheet->{_index} == $self->{_activesheet};
+ }
+
+ # Add Workbook globals
+ $self->_store_bof(0x0005);
+ $self->_store_codepage();
+ $self->_store_window1();
+ $self->_store_hideobj();
+ $self->_store_1904();
+ $self->_store_all_fonts();
+ $self->_store_all_num_formats();
+ $self->_store_all_xfs();
+ $self->_store_all_styles();
+ $self->_store_palette();
+
+ # Calculate the offsets required by the BOUNDSHEET records
+ $self->_calc_sheet_offsets();
+
+ # Add BOUNDSHEET records.
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $self->_store_boundsheet($sheet->{_name},
+ $sheet->{_offset},
+ $sheet->{_sheet_type},
+ $sheet->{_hidden},
+ $sheet->{_encoding});
+ }
+
+ # NOTE: If any records are added between here and EOF the
+ # _calc_sheet_offsets() should be updated to include the new length.
+ $self->_store_country();
+ if ($self->{_ext_ref_count}) {
+ $self->_store_supbook();
+ $self->_store_externsheet();
+ $self->_store_names();
+ }
+ $self->_add_mso_drawing_group();
+ $self->_store_shared_strings();
+ $self->_store_extsst();
+
+ # End Workbook globals
+ $self->_store_eof();
+
+ # Store the workbook in an OLE container
+ return $self->_store_OLE_file();
+}
+
+
+###############################################################################
+#
+# _store_OLE_file()
+#
+# Store the workbook in an OLE container using the default handler or using
+# OLE::Storage_Lite if the workbook data is > ~ 7MB.
+#
+sub _store_OLE_file {
+
+ my $self = shift;
+ my $maxsize = 7_087_104;
+
+ if (!$self->{_add_doc_properties} && $self->{_biffsize} <= $maxsize) {
+ # Write the OLE file using OLEwriter if data <= 7MB
+ my $OLE = Spreadsheet::WriteExcel::OLEwriter->new($self->{_fh_out});
+
+ # Write the BIFF data without the OLE container for testing.
+ $OLE->{_biff_only} = $self->{_biff_only};
+
+ # Indicate that we created the filehandle and want to close it.
+ $OLE->{_internal_fh} = $self->{_internal_fh};
+
+ $OLE->set_size($self->{_biffsize});
+ $OLE->write_header();
+
+ while (my $tmp = $self->get_data()) {
+ $OLE->write($tmp);
+ }
+
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+ while (my $tmp = $worksheet->get_data()) {
+ $OLE->write($tmp);
+ }
+ }
+
+ return $OLE->close();
+ }
+ else {
+ # Write the OLE file using OLE::Storage_Lite if data > 7MB
+ eval { require OLE::Storage_Lite };
+
+ if (not $@) {
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ my @streams;
+
+ # Create the Workbook stream.
+ my $stream = pack 'v*', unpack 'C*', 'Workbook';
+ my $workbook = OLE::Storage_Lite::PPS::File->newFile($stream);
+
+ while (my $tmp = $self->get_data()) {
+ $workbook->append($tmp);
+ }
+
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+ while (my $tmp = $worksheet->get_data()) {
+ $workbook->append($tmp);
+ }
+ }
+
+ push @streams, $workbook;
+
+
+ # Create the properties streams, if any.
+ if ($self->{_add_doc_properties}) {
+ my $stream;
+ my $summary;
+
+ $stream = pack 'v*', unpack 'C*', "\5SummaryInformation";
+ $summary = $self->{summary};
+ $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
+ push @streams, $summary;
+
+ $stream = pack 'v*', unpack 'C*', "\5DocumentSummaryInformation";
+ $summary = $self->{doc_summary};
+ $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
+ push @streams, $summary;
+ }
+
+ # Create the OLE root document and add the substreams.
+ my @localtime = @{ $self->{_localtime} };
+ splice(@localtime, 6);
+
+ my $ole_root = OLE::Storage_Lite::PPS::Root->new(\@localtime,
+ \@localtime,
+ \@streams);
+ $ole_root->save($self->{_filename});
+
+
+ # Close the filehandle if it was created internally.
+ return CORE::close($self->{_fh_out}) if $self->{_internal_fh};
+ }
+ else {
+ # File in greater than limit, set $! to "File too large"
+ $! = 27; # Perl error code "File too large"
+
+ croak "Maximum Spreadsheet::WriteExcel filesize, $maxsize bytes, ".
+ "exceeded. To create files bigger than this limit please " .
+ "install OLE::Storage_Lite\n";
+
+ # return 0;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _calc_sheet_offsets()
+#
+# Calculate Worksheet BOF offsets records for use in the BOUNDSHEET records.
+#
+sub _calc_sheet_offsets {
+
+ my $self = shift;
+ my $BOF = 12;
+ my $EOF = 4;
+ my $offset = $self->{_datasize};
+
+ # Add the length of the COUNTRY record
+ $offset += 8;
+
+ # Add the length of the SST and associated CONTINUEs
+ $offset += $self->_calculate_shared_string_sizes();
+
+ # Add the length of the EXTSST record.
+ $offset += $self->_calculate_extsst_size();
+
+ # Add the length of the SUPBOOK, EXTERNSHEET and NAME records
+ $offset += $self->_calculate_extern_sizes();
+
+ # Add the length of the MSODRAWINGGROUP records including an extra 4 bytes
+ # for any CONTINUE headers. See _add_mso_drawing_group_continue().
+ my $mso_size = $self->{_mso_size};
+ $mso_size += 4 * int(($mso_size -1) / $self->{_limit});
+ $offset += $mso_size ;
+
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $offset += $BOF + length($sheet->{_name});
+ }
+
+ $offset += $EOF;
+
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $sheet->{_offset} = $offset;
+ $sheet->_close();
+ $offset += $sheet->{_datasize};
+ }
+
+ $self->{_biffsize} = $offset;
+}
+
+
+###############################################################################
+#
+# _calc_mso_sizes()
+#
+# Calculate the MSODRAWINGGROUP sizes and the indexes of the Worksheet
+# MSODRAWING records.
+#
+# In the following SPID is shape id, according to Escher nomenclature.
+#
+sub _calc_mso_sizes {
+
+ my $self = shift;
+
+ my $mso_size = 0; # Size of the MSODRAWINGGROUP record
+ my $start_spid = 1024; # Initial spid for each sheet
+ my $max_spid = 1024; # spidMax
+ my $num_clusters = 1; # cidcl
+ my $shapes_saved = 0; # cspSaved
+ my $drawings_saved = 0; # cdgSaved
+ my @clusters = ();
+
+
+ $self->_process_images();
+
+ # Add Bstore container size if there are images.
+ $mso_size += 8 if @{$self->{_images_data}};
+
+
+ # Iterate through the worksheets, calculate the MSODRAWINGGROUP parameters
+ # and space required to store the record and the MSODRAWING parameters
+ # required by each worksheet.
+ #
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
+
+ my $num_images = $sheet->{_num_images} || 0;
+ my $image_mso_size = $sheet->{_image_mso_size} || 0;
+ my $num_comments = $sheet->_prepare_comments();
+ my $num_charts = $sheet->_prepare_charts();
+ my $num_filters = $sheet->{_filter_count};
+
+ next unless $num_images + $num_comments + $num_charts +$num_filters;
+
+
+ # Include 1 parent MSODRAWING shape, per sheet, in the shape count.
+ my $num_shapes += 1 + $num_images
+ + $num_comments
+ + $num_charts
+ + $num_filters;
+ $shapes_saved += $num_shapes;
+ $mso_size += $image_mso_size;
+
+
+ # Add a drawing object for each sheet with comments.
+ $drawings_saved++;
+
+
+ # For each sheet start the spids at the next 1024 interval.
+ $max_spid = 1024 * (1 + int(($max_spid -1)/1024));
+ $start_spid = $max_spid;
+
+
+ # Max spid for each sheet and eventually for the workbook.
+ $max_spid += $num_shapes;
+
+
+ # Store the cluster ids
+ for (my $i = $num_shapes; $i > 0; $i -= 1024) {
+ $num_clusters += 1;
+ $mso_size += 8;
+ my $size = $i > 1024 ? 1024 : $i;
+
+ push @clusters, [$drawings_saved, $size];
+ }
+
+
+ # Pass calculated values back to the worksheet
+ $sheet->{_object_ids} = [$start_spid, $drawings_saved,
+ $num_shapes, $max_spid -1];
+ }
+
+
+ # Calculate the MSODRAWINGGROUP size if we have stored some shapes.
+ $mso_size += 86 if $mso_size; # Smallest size is 86+8=94
+
+
+ $self->{_mso_size} = $mso_size;
+ $self->{_mso_clusters} = [
+ $max_spid, $num_clusters, $shapes_saved,
+ $drawings_saved, [@clusters]
+ ];
+}
+
+
+
+###############################################################################
+#
+# _process_images()
+#
+# We need to process each image in each worksheet and extract information.
+# Some of this information is stored and used in the Workbook and some is
+# passed back into each Worksheet. The overall size for the image related
+# BIFF structures in the Workbook is calculated here.
+#
+# MSO size = 8 bytes for bstore_container +
+# 44 bytes for blip_store_entry +
+# 25 bytes for blip
+# = 77 + image size.
+#
+sub _process_images {
+
+ my $self = shift;
+
+ my %images_seen;
+ my @image_data;
+ my @previous_images;
+ my $image_id = 1;
+ my $images_size = 0;
+
+
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
+ next unless $sheet->_prepare_images();
+
+ my $num_images = 0;
+ my $image_mso_size = 0;
+
+
+ for my $image_ref (@{$sheet->{_images_array}}) {
+ my $filename = $image_ref->[2];
+ $num_images++;
+
+ #
+ # For each Worksheet image we get a structure like this
+ # [
+ # $row,
+ # $col,
+ # $name,
+ # $x_offset,
+ # $y_offset,
+ # $scale_x,
+ # $scale_y,
+ # ]
+ #
+ # And we add additional information:
+ #
+ # $image_id,
+ # $type,
+ # $width,
+ # $height;
+
+ if (not exists $images_seen{$filename}) {
+ # TODO should also match seen images based on checksum.
+
+ # Open the image file and import the data.
+ my $fh = FileHandle->new($filename);
+ croak "Couldn't import $filename: $!" unless defined $fh;
+ binmode $fh;
+
+ # Slurp the file into a string and do some size calcs.
+ my $data = do {local $/; <$fh>};
+ my $size = length $data;
+ my $checksum1 = $self->_image_checksum($data, $image_id);
+ my $checksum2 = $checksum1;
+ my $ref_count = 1;
+
+
+ # Process the image and extract dimensions.
+ my ($type, $width, $height);
+
+ # Test for PNGs...
+ if (unpack('x A3', $data) eq 'PNG') {
+ ($type, $width, $height) = $self->_process_png($data);
+ }
+ # Test for JFIF and Exif JPEGs...
+ elsif ( (unpack('n', $data) == 0xFFD8) &&
+ ( (unpack('x6 A4', $data) eq 'JFIF') ||
+ (unpack('x6 A4', $data) eq 'Exif')
+ )
+ )
+ {
+ ($type, $width, $height) = $self->_process_jpg($data, $filename);
+ }
+ # Test for BMPs...
+ elsif (unpack('A2', $data) eq 'BM') {
+ ($type, $width, $height) = $self->_process_bmp($data,
+ $filename);
+ # The 14 byte header of the BMP is stripped off.
+ $data = substr $data, 14;
+
+ # A checksum of the new image data is also required.
+ $checksum2 = $self->_image_checksum($data,
+ $image_id,
+ $image_id
+ );
+
+ # Adjust size -14 (header) + 16 (extra checksum).
+ $size += 2;
+ }
+ else {
+ croak "Unsupported image format for file: $filename\n";
+ }
+
+
+ # Push the new data back into the Worksheet array;
+ push @$image_ref, $image_id, $type, $width, $height;
+
+ # Also store new data for use in duplicate images.
+ push @previous_images, [$image_id, $type, $width, $height];
+
+
+ # Store information required by the Workbook.
+ push @image_data, [$ref_count, $type, $data, $size,
+ $checksum1, $checksum2];
+
+ # Keep track of overall data size.
+ $images_size += $size +61; # Size for bstore container.
+ $image_mso_size += $size +69; # Size for dgg container.
+
+ $images_seen{$filename} = $image_id++;
+ $fh->close;
+ }
+ else {
+ # We've processed this file already.
+ my $index = $images_seen{$filename} -1;
+
+ # Increase image reference count.
+ $image_data[$index]->[0]++;
+
+ # Add previously calculated data back onto the Worksheet array.
+ # $image_id, $type, $width, $height
+ my $a_ref = $sheet->{_images_array}->[$index];
+ push @$image_ref, @{$previous_images[$index]};
+ }
+ }
+
+ # Store information required by the Worksheet.
+ $sheet->{_num_images} = $num_images;
+ $sheet->{_image_mso_size} = $image_mso_size;
+
+ }
+
+
+ # Store information required by the Workbook.
+ $self->{_images_size} = $images_size;
+ $self->{_images_data} = \@image_data; # Store the data for MSODRAWINGGROUP.
+
+}
+
+
+###############################################################################
+#
+# _image_checksum()
+#
+# Generate a checksum for the image using whichever module is available..The
+# available modules are checked in _get_checksum_method(). Excel uses an MD4
+# checksum but any other will do. In the event of no checksum module being
+# available we simulate a checksum using the image index.
+#
+sub _image_checksum {
+
+ my $self = shift;
+
+ my $data = $_[0];
+ my $index1 = $_[1];
+ my $index2 = $_[2] || 0;
+
+ if ($self->{_checksum_method} == 1) {
+ # Digest::MD4
+ return Digest::MD4::md4_hex($data);
+ }
+ elsif ($self->{_checksum_method} == 2) {
+ # Digest::Perl::MD4
+ return Digest::Perl::MD4::md4_hex($data);
+ }
+ elsif ($self->{_checksum_method} == 3) {
+ # Digest::MD5
+ return Digest::MD5::md5_hex($data);
+ }
+ else {
+ # Default
+ return sprintf '%016X%016X', $index2, $index1;
+ }
+}
+
+
+###############################################################################
+#
+# _process_png()
+#
+# Extract width and height information from a PNG file.
+#
+sub _process_png {
+
+ my $self = shift;
+
+ my $type = 6; # Excel Blip type (MSOBLIPTYPE).
+ my $width = unpack "N", substr $_[0], 16, 4;
+ my $height = unpack "N", substr $_[0], 20, 4;
+
+ return ($type, $width, $height);
+}
+
+
+###############################################################################
+#
+# _process_bmp()
+#
+# Extract width and height information from a BMP file.
+#
+# Most of these checks came from the old Worksheet::_process_bitmap() method.
+#
+sub _process_bmp {
+
+ my $self = shift;
+ my $data = $_[0];
+ my $filename = $_[1];
+ my $type = 7; # Excel Blip type (MSOBLIPTYPE).
+
+
+ # Check that the file is big enough to be a bitmap.
+ if (length $data <= 0x36) {
+ croak "$filename doesn't contain enough data.";
+ }
+
+
+ # Read the bitmap width and height. Verify the sizes.
+ my ($width, $height) = unpack "x18 V2", $data;
+
+ if ($width > 0xFFFF) {
+ croak "$filename: largest image width $width supported is 65k.";
+ }
+
+ if ($height > 0xFFFF) {
+ croak "$filename: largest image height supported is 65k.";
+ }
+
+ # Read the bitmap planes and bpp data. Verify them.
+ my ($planes, $bitcount) = unpack "x26 v2", $data;
+
+ if ($bitcount != 24) {
+ croak "$filename isn't a 24bit true color bitmap.";
+ }
+
+ if ($planes != 1) {
+ croak "$filename: only 1 plane supported in bitmap image.";
+ }
+
+
+ # Read the bitmap compression. Verify compression.
+ my $compression = unpack "x30 V", $data;
+
+ if ($compression != 0) {
+ croak "$filename: compression not supported in bitmap image.";
+ }
+
+ return ($type, $width, $height);
+}
+
+
+###############################################################################
+#
+# _process_jpg()
+#
+# Extract width and height information from a JPEG file.
+#
+sub _process_jpg {
+
+ my $self = shift;
+ my $data = $_[0];
+ my $filename = $_[1];
+ my $type = 5; # Excel Blip type (MSOBLIPTYPE).
+ my $width;
+ my $height;
+
+ my $offset = 2;
+ my $data_length = length $data;
+
+ # Search through the image data to find the 0xFFC0 marker. The height and
+ # width are contained in the data for that sub element.
+ while ($offset < $data_length) {
+
+ my $marker = unpack "n", substr $data, $offset, 2;
+ my $length = unpack "n", substr $data, $offset +2, 2;
+
+ if ($marker == 0xFFC0 || $marker == 0xFFC2) {
+ $height = unpack "n", substr $data, $offset +5, 2;
+ $width = unpack "n", substr $data, $offset +7, 2;
+ last;
+ }
+
+ $offset = $offset + $length + 2;
+ last if $marker == 0xFFDA;
+ }
+
+ if (not defined $height) {
+ croak "$filename: no size data found in jpeg image.\n";
+ }
+
+ return ($type, $width, $height);
+}
+
+
+###############################################################################
+#
+# _store_all_fonts()
+#
+# Store the Excel FONT records.
+#
+sub _store_all_fonts {
+
+ my $self = shift;
+
+ my $format = $self->{_formats}->[15]; # The default cell format.
+ my $font = $format->get_font();
+
+ # Fonts are 0-indexed. According to the SDK there is no index 4,
+ for (0..3) {
+ $self->_append($font);
+ }
+
+
+ # Add the default fonts for charts and comments. This aren't connected
+ # to XF formats. Note, the font size, and some other properties of
+ # chart fonts are set in the FBI record of the chart.
+ my $tmp_format;
+
+ # Index 5. Axis numbers.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 6. Series names.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 7. Title.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ bold => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 8. Axes.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ bold => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 9. Comments.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ font => 'Tahoma',
+ size => 8,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+
+ # Iterate through the XF objects and write a FONT record if it isn't the
+ # same as the default FONT and if it hasn't already been used.
+ #
+ my %fonts;
+ my $key;
+ my $index = 10; # The first user defined FONT
+
+ $key = $format->get_font_key(); # The default font for cell formats.
+ $fonts{$key} = 0; # Index of the default font
+
+ # Fonts that are marked as '_font_only' are always stored. These are used
+ # mainly for charts and may not have an associated XF record.
+
+ foreach $format (@{$self->{_formats}}) {
+ $key = $format->get_font_key();
+
+ if (not $format->{_font_only} and exists $fonts{$key}) {
+ # FONT has already been used
+ $format->{_font_index} = $fonts{$key};
+ }
+ else {
+ # Add a new FONT record
+
+ if (not $format->{_font_only}) {
+ $fonts{$key} = $index;
+ }
+
+ $format->{_font_index} = $index;
+ $index++;
+ $font = $format->get_font();
+ $self->_append($font);
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _store_all_num_formats()
+#
+# Store user defined numerical formats i.e. FORMAT records
+#
+sub _store_all_num_formats {
+
+ my $self = shift;
+
+ my %num_formats;
+ my @num_formats;
+ my $num_format;
+ my $index = 164; # User defined FORMAT records start from 0xA4
+
+
+ # Iterate through the XF objects and write a FORMAT record if it isn't a
+ # built-in format type and if the FORMAT string hasn't already been used.
+ #
+ foreach my $format (@{$self->{_formats}}) {
+ my $num_format = $format->{_num_format};
+ my $encoding = $format->{_num_format_enc};
+
+ # Check if $num_format is an index to a built-in format.
+ # Also check for a string of zeros, which is a valid format string
+ # but would evaluate to zero.
+ #
+ if ($num_format !~ m/^0+\d/) {
+ next if $num_format =~ m/^\d+$/; # built-in
+ }
+
+ if (exists($num_formats{$num_format})) {
+ # FORMAT has already been used
+ $format->{_num_format} = $num_formats{$num_format};
+ }
+ else{
+ # Add a new FORMAT
+ $num_formats{$num_format} = $index;
+ $format->{_num_format} = $index;
+ $self->_store_num_format($num_format, $index, $encoding);
+ $index++;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _store_all_xfs()
+#
+# Write all XF records.
+#
+sub _store_all_xfs {
+
+ my $self = shift;
+
+ foreach my $format (@{$self->{_formats}}) {
+ my $xf = $format->get_xf();
+ $self->_append($xf);
+ }
+}
+
+
+###############################################################################
+#
+# _store_all_styles()
+#
+# Write all STYLE records.
+#
+sub _store_all_styles {
+
+ my $self = shift;
+
+ # Excel adds the built-in styles in alphabetical order.
+ my @built_ins = (
+ [0x03, 16], # Comma
+ [0x06, 17], # Comma[0]
+ [0x04, 18], # Currency
+ [0x07, 19], # Currency[0]
+ [0x00, 0], # Normal
+ [0x05, 20], # Percent
+
+ # We don't deal with these styles yet.
+ #[0x08, 21], # Hyperlink
+ #[0x02, 8], # ColLevel_n
+ #[0x01, 1], # RowLevel_n
+ );
+
+
+ for my $aref (@built_ins) {
+ my $type = $aref->[0];
+ my $xf_index = $aref->[1];
+
+ $self->_store_style($type, $xf_index);
+ }
+}
+
+
+###############################################################################
+#
+# _store_names()
+#
+# Write the NAME record to define the print area and the repeat rows and cols.
+#
+sub _store_names {
+
+ my $self = shift;
+ my $index;
+ my %ext_refs = %{$self->{_ext_refs}};
+
+
+ # Create the user defined names.
+ for my $defined_name (@{$self->{_defined_names}}) {
+
+ $self->_store_name(
+ $defined_name->{name},
+ $defined_name->{encoding},
+ $defined_name->{sheet_index},
+ $defined_name->{formula},
+ );
+ }
+
+ # Sort the worksheets into alphabetical order by name. This is a
+ # requirement for some non-English language Excel patch levels.
+ my @worksheets = @{$self->{_worksheets}};
+ @worksheets = sort { $a->{_name} cmp $b->{_name} } @worksheets;
+
+ # Create the autofilter NAME records
+ foreach my $worksheet (@worksheets) {
+ $index = $worksheet->{_index};
+ my $key = "$index:$index";
+ my $ref = $ext_refs{$key};
+
+ # Write a Name record if Autofilter has been defined
+ if ($worksheet->{_filter_count}) {
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x0D, # NAME type = Filter Database
+ $ref,
+ $worksheet->{_filter_area}->[0],
+ $worksheet->{_filter_area}->[1],
+ $worksheet->{_filter_area}->[2],
+ $worksheet->{_filter_area}->[3],
+ 1, # Hidden
+ );
+ }
+ }
+
+ # Create the print area NAME records
+ foreach my $worksheet (@worksheets) {
+ $index = $worksheet->{_index};
+ my $key = "$index:$index";
+ my $ref = $ext_refs{$key};
+
+ # Write a Name record if the print area has been defined
+ if (defined $worksheet->{_print_rowmin}) {
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x06, # NAME type = Print_Area
+ $ref,
+ $worksheet->{_print_rowmin},
+ $worksheet->{_print_rowmax},
+ $worksheet->{_print_colmin},
+ $worksheet->{_print_colmax}
+ );
+ }
+ }
+
+ # Create the print title NAME records
+ foreach my $worksheet (@worksheets) {
+ $index = $worksheet->{_index};
+
+ my $rowmin = $worksheet->{_title_rowmin};
+ my $rowmax = $worksheet->{_title_rowmax};
+ my $colmin = $worksheet->{_title_colmin};
+ my $colmax = $worksheet->{_title_colmax};
+ my $key = "$index:$index";
+ my $ref = $ext_refs{$key};
+
+ # Determine if row + col, row, col or nothing has been defined
+ # and write the appropriate record
+ #
+ if (defined $rowmin && defined $colmin) {
+ # Row and column titles have been defined.
+ # Row title has been defined.
+ $self->_store_name_long(
+ $worksheet->{_index},
+ 0x07, # NAME type = Print_Titles
+ $ref,
+ $rowmin,
+ $rowmax,
+ $colmin,
+ $colmax
+ );
+ }
+ elsif (defined $rowmin) {
+ # Row title has been defined.
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x07, # NAME type = Print_Titles
+ $ref,
+ $rowmin,
+ $rowmax,
+ 0x00,
+ 0xff
+ );
+ }
+ elsif (defined $colmin) {
+ # Column title has been defined.
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x07, # NAME type = Print_Titles
+ $ref,
+ 0x0000,
+ 0xffff,
+ $colmin,
+ $colmax
+ );
+ }
+ else {
+ # Nothing left to do
+ }
+ }
+}
+
+
+
+
+###############################################################################
+###############################################################################
+#
+# BIFF RECORDS
+#
+
+
+###############################################################################
+#
+# _store_window1()
+#
+# Write Excel BIFF WINDOW1 record.
+#
+sub _store_window1 {
+
+ my $self = shift;
+
+ my $record = 0x003D; # Record identifier
+ my $length = 0x0012; # Number of bytes to follow
+
+ my $xWn = 0x0000; # Horizontal position of window
+ my $yWn = 0x0000; # Vertical position of window
+ my $dxWn = 0x355C; # Width of window
+ my $dyWn = 0x30ED; # Height of window
+
+ my $grbit = 0x0038; # Option flags
+ my $ctabsel = $self->{_selected}; # Number of workbook tabs selected
+ my $wTabRatio = 0x0258; # Tab to scrollbar ratio
+
+ my $itabFirst = $self->{_firstsheet}; # 1st displayed worksheet
+ my $itabCur = $self->{_activesheet}; # Active worksheet
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvvvvv", $xWn, $yWn, $dxWn, $dyWn,
+ $grbit,
+ $itabCur, $itabFirst,
+ $ctabsel, $wTabRatio);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_boundsheet()
+#
+# Writes Excel BIFF BOUNDSHEET record.
+#
+sub _store_boundsheet {
+
+ my $self = shift;
+
+ my $record = 0x0085; # Record identifier
+ my $length = 0x08 + length($_[0]); # Number of bytes to follow
+
+ my $sheetname = $_[0]; # Worksheet name
+ my $offset = $_[1]; # Location of worksheet BOF
+ my $type = $_[2]; # Worksheet type
+ my $hidden = $_[3]; # Worksheet hidden flag
+ my $encoding = $_[4]; # Sheet name encoding
+ my $cch = length($sheetname); # Length of sheet name
+
+ my $grbit = $type | $hidden;
+
+ # Character length is num of chars not num of bytes
+ $cch /= 2 if $encoding;
+
+ # Change the UTF-16 name from BE to LE
+ $sheetname = pack 'n*', unpack 'v*', $sheetname if $encoding;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("VvCC", $offset, $grbit, $cch, $encoding);
+
+ $self->_append($header, $data, $sheetname);
+}
+
+
+###############################################################################
+#
+# _store_style()
+#
+# Write Excel BIFF STYLE records.
+#
+sub _store_style {
+
+ my $self = shift;
+
+ my $record = 0x0293; # Record identifier
+ my $length = 0x0004; # Bytes to follow
+
+ my $type = $_[0]; # Built-in style
+ my $xf_index = $_[1]; # Index to style XF
+ my $level = 0xff; # Outline style level
+
+ $xf_index |= 0x8000; # Add flag to indicate built-in style.
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vCC", $xf_index, $type, $level);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_num_format()
+#
+# Writes Excel FORMAT record for non "built-in" numerical formats.
+#
+sub _store_num_format {
+
+ my $self = shift;
+
+ my $record = 0x041E; # Record identifier
+ my $length; # Number of bytes to follow
+
+ my $format = $_[0]; # Custom format string
+ my $ifmt = $_[1]; # Format index code
+ my $encoding = $_[2]; # Char encoding for format string
+
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($format)) {
+ $format = Encode::encode("UTF-16BE", $format);
+ $encoding = 1;
+ }
+ }
+
+
+ # Char length of format string
+ my $cch = length $format;
+
+
+ # Handle Unicode format strings.
+ if ($encoding == 1) {
+ croak "Uneven number of bytes in Unicode font name" if $cch % 2;
+ $cch /= 2 if $encoding;
+ $format = pack 'v*', unpack 'n*', $format;
+ }
+
+
+ # Special case to handle Euro symbol, 0x80, in non-Unicode strings.
+ if ($encoding == 0 and $format =~ /\x80/) {
+ $format = pack 'v*', unpack 'C*', $format;
+ $format =~ s/\x80\x00/\xAC\x20/g;
+ $encoding = 1;
+ }
+
+ $length = 0x05 + length $format;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvC", $ifmt, $cch, $encoding);
+
+ $self->_append($header, $data, $format);
+}
+
+
+###############################################################################
+#
+# _store_1904()
+#
+# Write Excel 1904 record to indicate the date system in use.
+#
+sub _store_1904 {
+
+ my $self = shift;
+
+ my $record = 0x0022; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $f1904 = $self->{_1904}; # Flag for 1904 date system
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $f1904);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_supbook()
+#
+# Write BIFF record SUPBOOK to indicate that the workbook contains external
+# references, in our case, formula, print area and print title refs.
+#
+sub _store_supbook {
+
+ my $self = shift;
+
+ my $record = 0x01AE; # Record identifier
+ my $length = 0x0004; # Number of bytes to follow
+
+ my $ctabs = @{$self->{_worksheets}}; # Number of worksheets
+ my $StVirtPath = 0x0401; # Encoded workbook filename
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vv", $ctabs, $StVirtPath);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_externsheet()
+#
+# Writes the Excel BIFF EXTERNSHEET record. These references are used by
+# formulas. TODO NAME record is required to define the print area and the
+# repeat rows and columns.
+#
+sub _store_externsheet {
+
+ my $self = shift;
+
+ my $record = 0x0017; # Record identifier
+ my $length; # Number of bytes to follow
+
+
+ # Get the external refs
+ my %ext_refs = %{$self->{_ext_refs}};
+ my @ext_refs = sort {$ext_refs{$a} <=> $ext_refs{$b}} keys %ext_refs;
+
+ # Change the external refs from stringified "1:1" to [1, 1]
+ foreach my $ref (@ext_refs) {
+ $ref = [split /:/, $ref];
+ }
+
+
+ my $cxti = scalar @ext_refs; # Number of Excel XTI structures
+ my $rgxti = ''; # Array of XTI structures
+
+ # Write the XTI structs
+ foreach my $ext_ref (@ext_refs) {
+ $rgxti .= pack("vvv", 0, $ext_ref->[0], $ext_ref->[1])
+ }
+
+
+ my $data = pack("v", $cxti) . $rgxti;
+ my $header = pack("vv", $record, length $data);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_name()
+#
+#
+# Store the NAME record used for storing the print area, repeat rows, repeat
+# columns, autofilters and defined names.
+#
+# TODO. This is a more generic version that will replace _store_name_short()
+# and _store_name_long().
+#
+sub _store_name {
+
+ my $self = shift;
+
+ my $record = 0x0018; # Record identifier
+ my $length; # Number of bytes to follow
+
+ my $name = shift;
+ my $encoding = shift;
+ my $sheet_index = shift;
+ my $formula = shift;
+
+ my $text_length = length $name;
+ my $formula_length = length $formula;
+
+ # UTF-16 string length is in characters not bytes.
+ $text_length /= 2 if $encoding;
+
+
+ my $grbit = 0x0000; # Option flags
+ my $shortcut = 0x00; # Keyboard shortcut
+ my $ixals = 0x0000; # Unused index.
+ my $menu_length = 0x00; # Length of cust menu text
+ my $desc_length = 0x00; # Length of description text
+ my $help_length = 0x00; # Length of help topic text
+ my $status_length = 0x00; # Length of status bar text
+
+ # Set grbit built-in flag and the hidden flag for autofilters.
+ if ($text_length == 1) {
+ $grbit = 0x0020 if ord $name == 0x06; # Print area
+ $grbit = 0x0020 if ord $name == 0x07; # Print titles
+ $grbit = 0x0021 if ord $name == 0x0D; # Autofilter
+ }
+
+ my $data = pack "v", $grbit;
+ $data .= pack "C", $shortcut;
+ $data .= pack "C", $text_length;
+ $data .= pack "v", $formula_length;
+ $data .= pack "v", $ixals;
+ $data .= pack "v", $sheet_index;
+ $data .= pack "C", $menu_length;
+ $data .= pack "C", $desc_length;
+ $data .= pack "C", $help_length;
+ $data .= pack "C", $status_length;
+ $data .= pack "C", $encoding;
+ $data .= $name;
+ $data .= $formula;
+
+ my $header = pack "vv", $record, length $data;
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_name_short()
+#
+#
+# Store the NAME record in the short format that is used for storing the print
+# area, repeat rows only and repeat columns only.
+#
+sub _store_name_short {
+
+ my $self = shift;
+
+ my $record = 0x0018; # Record identifier
+ my $length = 0x001b; # Number of bytes to follow
+
+ my $index = shift; # Sheet index
+ my $type = shift;
+ my $ext_ref = shift; # TODO
+
+ my $grbit = 0x0020; # Option flags
+ my $chKey = 0x00; # Keyboard shortcut
+ my $cch = 0x01; # Length of text name
+ my $cce = 0x000b; # Length of text definition
+ my $unknown01 = 0x0000; #
+ my $ixals = $index +1; # Sheet index
+ my $unknown02 = 0x00; #
+ my $cchCustMenu = 0x00; # Length of cust menu text
+ my $cchDescription = 0x00; # Length of description text
+ my $cchHelptopic = 0x00; # Length of help topic text
+ my $cchStatustext = 0x00; # Length of status bar text
+ my $rgch = $type; # Built-in name type
+ my $unknown03 = 0x3b; #
+
+ my $rowmin = $_[0]; # Start row
+ my $rowmax = $_[1]; # End row
+ my $colmin = $_[2]; # Start column
+ my $colmax = $_[3]; # end column
+
+ my $hidden = $_[4]; # Name is hidden
+ $grbit = 0x0021 if $hidden;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $grbit);
+ $data .= pack("C", $chKey);
+ $data .= pack("C", $cch);
+ $data .= pack("v", $cce);
+ $data .= pack("v", $unknown01);
+ $data .= pack("v", $ixals);
+ $data .= pack("C", $unknown02);
+ $data .= pack("C", $cchCustMenu);
+ $data .= pack("C", $cchDescription);
+ $data .= pack("C", $cchHelptopic);
+ $data .= pack("C", $cchStatustext);
+ $data .= pack("C", $rgch);
+ $data .= pack("C", $unknown03);
+ $data .= pack("v", $ext_ref);
+
+ $data .= pack("v", $rowmin);
+ $data .= pack("v", $rowmax);
+ $data .= pack("v", $colmin);
+ $data .= pack("v", $colmax);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_name_long()
+#
+#
+# Store the NAME record in the long format that is used for storing the repeat
+# rows and columns when both are specified. This share a lot of code with
+# _store_name_short() but we use a separate method to keep the code clean.
+# Code abstraction for reuse can be carried too far, and I should know. ;-)
+#
+sub _store_name_long {
+
+ my $self = shift;
+
+ my $record = 0x0018; # Record identifier
+ my $length = 0x002a; # Number of bytes to follow
+
+ my $index = shift; # Sheet index
+ my $type = shift;
+ my $ext_ref = shift; # TODO
+
+ my $grbit = 0x0020; # Option flags
+ my $chKey = 0x00; # Keyboard shortcut
+ my $cch = 0x01; # Length of text name
+ my $cce = 0x001a; # Length of text definition
+ my $unknown01 = 0x0000; #
+ my $ixals = $index +1; # Sheet index
+ my $unknown02 = 0x00; #
+ my $cchCustMenu = 0x00; # Length of cust menu text
+ my $cchDescription = 0x00; # Length of description text
+ my $cchHelptopic = 0x00; # Length of help topic text
+ my $cchStatustext = 0x00; # Length of status bar text
+ my $rgch = $type; # Built-in name type
+
+ my $unknown03 = 0x29;
+ my $unknown04 = 0x0017;
+ my $unknown05 = 0x3b;
+
+ my $rowmin = $_[0]; # Start row
+ my $rowmax = $_[1]; # End row
+ my $colmin = $_[2]; # Start column
+ my $colmax = $_[3]; # end column
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $grbit);
+ $data .= pack("C", $chKey);
+ $data .= pack("C", $cch);
+ $data .= pack("v", $cce);
+ $data .= pack("v", $unknown01);
+ $data .= pack("v", $ixals);
+ $data .= pack("C", $unknown02);
+ $data .= pack("C", $cchCustMenu);
+ $data .= pack("C", $cchDescription);
+ $data .= pack("C", $cchHelptopic);
+ $data .= pack("C", $cchStatustext);
+ $data .= pack("C", $rgch);
+
+ # Column definition
+ $data .= pack("C", $unknown03);
+ $data .= pack("v", $unknown04);
+ $data .= pack("C", $unknown05);
+ $data .= pack("v", $ext_ref);
+ $data .= pack("v", 0x0000);
+ $data .= pack("v", 0xffff);
+ $data .= pack("v", $colmin);
+ $data .= pack("v", $colmax);
+
+ # Row definition
+ $data .= pack("C", $unknown05);
+ $data .= pack("v", $ext_ref);
+ $data .= pack("v", $rowmin);
+ $data .= pack("v", $rowmax);
+ $data .= pack("v", 0x00);
+ $data .= pack("v", 0xff);
+ # End of data
+ $data .= pack("C", 0x10);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_palette()
+#
+# Stores the PALETTE biff record.
+#
+sub _store_palette {
+
+ my $self = shift;
+
+ my $aref = $self->{_palette};
+
+ my $record = 0x0092; # Record identifier
+ my $length = 2 + 4 * @$aref; # Number of bytes to follow
+ my $ccv = @$aref; # Number of RGB values to follow
+ my $data; # The RGB data
+
+ # Pack the RGB data
+ $data .= pack "CCCC", @$_ for @$aref;
+
+ my $header = pack("vvv", $record, $length, $ccv);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_codepage()
+#
+# Stores the CODEPAGE biff record.
+#
+sub _store_codepage {
+
+ my $self = shift;
+
+ my $record = 0x0042; # Record identifier
+ my $length = 0x0002; # Number of bytes to follow
+ my $cv = $self->{_codepage}; # The code page
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $cv);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_country()
+#
+# Stores the COUNTRY biff record.
+#
+sub _store_country {
+
+ my $self = shift;
+
+ my $record = 0x008C; # Record identifier
+ my $length = 0x0004; # Number of bytes to follow
+ my $country_default = $self->{_country};
+ my $country_win_ini = $self->{_country};
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vv", $country_default, $country_win_ini);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_hideobj()
+#
+# Stores the HIDEOBJ biff record.
+#
+sub _store_hideobj {
+
+ my $self = shift;
+
+ my $record = 0x008D; # Record identifier
+ my $length = 0x0002; # Number of bytes to follow
+ my $hide = $self->{_hideobj}; # Option to hide objects
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $hide);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+###############################################################################
+###############################################################################
+
+
+
+###############################################################################
+#
+# _calculate_extern_sizes()
+#
+# We need to calculate the space required by the SUPBOOK, EXTERNSHEET and NAME
+# records so that it can be added to the BOUNDSHEET offsets.
+#
+sub _calculate_extern_sizes {
+
+ my $self = shift;
+
+
+ my %ext_refs = $self->{_parser}->get_ext_sheets();
+ my $ext_ref_count = scalar keys %ext_refs;
+ my $length = 0;
+ my $index = 0;
+
+
+ if (@{$self->{_defined_names}}) {
+ my $index = 0;
+ my $key = "$index:$index";
+
+ if (not exists $ext_refs{$key}) {
+ $ext_refs{$key} = $ext_ref_count++;
+ }
+ }
+
+ for my $defined_name (@{$self->{_defined_names}}) {
+ $length += 19
+ + length($defined_name->{name})
+ + length($defined_name->{formula});
+ }
+
+
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+
+ my $rowmin = $worksheet->{_title_rowmin};
+ my $colmin = $worksheet->{_title_colmin};
+ my $filter = $worksheet->{_filter_count};
+ my $key = "$index:$index";
+ $index++;
+
+
+ # Add area NAME records
+ #
+ if (defined $worksheet->{_print_rowmin}) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 31 ;
+ }
+
+
+ # Add title NAME records
+ #
+ if (defined $rowmin and defined $colmin) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 46;
+ }
+ elsif (defined $rowmin or defined $colmin) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 31;
+ }
+ else {
+ # TODO, may need this later.
+ }
+
+
+ # Add Autofilter NAME records
+ #
+ if ($filter) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 31;
+ }
+ }
+
+
+ # Update the ref counts.
+ $self->{_ext_ref_count} = $ext_ref_count;
+ $self->{_ext_refs} = {%ext_refs};
+
+
+ # If there are no external refs then we don't write, SUPBOOK, EXTERNSHEET
+ # and NAME. Therefore the length is 0.
+
+ return $length = 0 if $ext_ref_count == 0;
+
+
+ # The SUPBOOK record is 8 bytes
+ $length += 8;
+
+ # The EXTERNSHEET record is 6 bytes + 6 bytes for each external ref
+ $length += 6 * (1 + $ext_ref_count);
+
+ return $length;
+}
+
+
+###############################################################################
+#
+# _calculate_shared_string_sizes()
+#
+# Handling of the SST continue blocks is complicated by the need to include an
+# additional continuation byte depending on whether the string is split between
+# blocks or whether it starts at the beginning of the block. (There are also
+# additional complications that will arise later when/if Rich Strings are
+# supported). As such we cannot use the simple CONTINUE mechanism provided by
+# the _add_continue() method in BIFFwriter.pm. Thus we have to make two passes
+# through the strings data. The first is to calculate the required block sizes
+# and the second, in _store_shared_strings(), is to write the actual strings.
+# The first pass through the data is also used to calculate the size of the SST
+# and CONTINUE records for use in setting the BOUNDSHEET record offsets. The
+# downside of this is that the same algorithm repeated in _store_shared_strings.
+#
+sub _calculate_shared_string_sizes {
+
+ my $self = shift;
+
+ my @strings;
+ $#strings = $self->{_str_unique} -1; # Pre-extend array
+
+ while (my $key = each %{$self->{_str_table}}) {
+ $strings[$self->{_str_table}->{$key}] = $key;
+ }
+
+ # The SST data could be very large, free some memory (maybe).
+ $self->{_str_table} = undef;
+ $self->{_str_array} = [@strings];
+
+
+ # Iterate through the strings to calculate the CONTINUE block sizes.
+ #
+ # The SST blocks requires a specialised CONTINUE block, so we have to
+ # ensure that the maximum data block size is less than the limit used by
+ # _add_continue() in BIFFwriter.pm. For simplicity we use the same size
+ # for the SST and CONTINUE records:
+ # 8228 : Maximum Excel97 block size
+ # -4 : Length of block header
+ # -8 : Length of additional SST header information
+ # -8 : Arbitrary number to keep within _add_continue() limit
+ # = 8208
+ #
+ my $continue_limit = 8208;
+ my $block_length = 0;
+ my $written = 0;
+ my @block_sizes;
+ my $continue = 0;
+
+ for my $string (@strings) {
+
+ my $string_length = length $string;
+ my $encoding = unpack "xx C", $string;
+ my $split_string = 0;
+
+
+ # Block length is the total length of the strings that will be
+ # written out in a single SST or CONTINUE block.
+ #
+ $block_length += $string_length;
+
+
+ # We can write the string if it doesn't cross a CONTINUE boundary
+ if ($block_length < $continue_limit) {
+ $written += $string_length;
+ next;
+ }
+
+
+ # Deal with the cases where the next string to be written will exceed
+ # the CONTINUE boundary. If the string is very long it may need to be
+ # written in more than one CONTINUE record.
+ #
+ while ($block_length >= $continue_limit) {
+
+ # We need to avoid the case where a string is continued in the first
+ # n bytes that contain the string header information.
+ #
+ my $header_length = 3; # Min string + header size -1
+ my $space_remaining = $continue_limit -$written -$continue;
+
+
+ # Unicode data should only be split on char (2 byte) boundaries.
+ # Therefore, in some cases we need to reduce the amount of available
+ # space by 1 byte to ensure the correct alignment.
+ my $align = 0;
+
+ # Only applies to Unicode strings
+ if ($encoding == 1) {
+ # Min string + header size -1
+ $header_length = 4;
+
+ if ($space_remaining > $header_length) {
+ # String contains 3 byte header => split on odd boundary
+ if (not $split_string and $space_remaining % 2 != 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+ # Split section without header => split on even boundary
+ elsif ($split_string and $space_remaining % 2 == 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+
+ $split_string = 1;
+ }
+ }
+
+
+ if ($space_remaining > $header_length) {
+ # Write as much as possible of the string in the current block
+ $written += $space_remaining;
+
+ # Reduce the current block length by the amount written
+ $block_length -= $continue_limit -$continue -$align;
+
+ # Store the max size for this block
+ push @block_sizes, $continue_limit -$align;
+
+ # If the current string was split then the next CONTINUE block
+ # should have the string continue flag (grbit) set unless the
+ # split string fits exactly into the remaining space.
+ #
+ if ($block_length > 0) {
+ $continue = 1;
+ }
+ else {
+ $continue = 0;
+ }
+
+ }
+ else {
+ # Store the max size for this block
+ push @block_sizes, $written +$continue;
+
+ # Not enough space to start the string in the current block
+ $block_length -= $continue_limit -$space_remaining -$continue;
+ $continue = 0;
+
+ }
+
+ # If the string (or substr) is small enough we can write it in the
+ # new CONTINUE block. Else, go through the loop again to write it in
+ # one or more CONTINUE blocks
+ #
+ if ($block_length < $continue_limit) {
+ $written = $block_length;
+ }
+ else {
+ $written = 0;
+ }
+ }
+ }
+
+ # Store the max size for the last block unless it is empty
+ push @block_sizes, $written +$continue if $written +$continue;
+
+
+ $self->{_str_block_sizes} = [@block_sizes];
+
+
+ # Calculate the total length of the SST and associated CONTINUEs (if any).
+ # The SST record will have a length even if it contains no strings.
+ # This length is required to set the offsets in the BOUNDSHEET records since
+ # they must be written before the SST records
+ #
+ my $length = 12;
+ $length += shift @block_sizes if @block_sizes; # SST
+ $length += 4 + shift @block_sizes while @block_sizes; # CONTINUEs
+
+ return $length;
+}
+
+
+###############################################################################
+#
+# _store_shared_strings()
+#
+# Write all of the workbooks strings into an indexed array.
+#
+# See the comments in _calculate_shared_string_sizes() for more information.
+#
+# We also use this routine to record the offsets required by the EXTSST table.
+# In order to do this we first identify the first string in an EXTSST bucket
+# and then store its global and local offset within the SST table. The offset
+# occurs wherever the start of the bucket string is written out via append().
+#
+sub _store_shared_strings {
+
+ my $self = shift;
+
+ my @strings = @{$self->{_str_array}};
+
+
+ my $record = 0x00FC; # Record identifier
+ my $length = 0x0008; # Number of bytes to follow
+ my $total = 0x0000;
+
+ # Iterate through the strings to calculate the CONTINUE block sizes
+ my $continue_limit = 8208;
+ my $block_length = 0;
+ my $written = 0;
+ my $continue = 0;
+
+ # The SST and CONTINUE block sizes have been pre-calculated by
+ # _calculate_shared_string_sizes()
+ my @block_sizes = @{$self->{_str_block_sizes}};
+
+
+ # The SST record is required even if it contains no strings. Thus we will
+ # always have a length
+ #
+ if (@block_sizes) {
+ $length = 8 + shift @block_sizes;
+ }
+ else {
+ # No strings
+ $length = 8;
+ }
+
+
+ # Initialise variables used to track EXTSST bucket offsets.
+ my $extsst_str_num = -1;
+ my $sst_block_start = $self->{_datasize};
+
+
+ # Write the SST block header information
+ my $header = pack("vv", $record, $length);
+ my $data = pack("VV", $self->{_str_total}, $self->{_str_unique});
+ $self->_append($header, $data);
+
+
+ # Iterate through the strings and write them out
+ for my $string (@strings) {
+
+ my $string_length = length $string;
+ my $encoding = unpack "xx C", $string;
+ my $split_string = 0;
+ my $bucket_string = 0; # Used to track EXTSST bucket offsets.
+
+
+ # Check if the string is at the start of a EXTSST bucket.
+ if (++$extsst_str_num % $self->{_extsst_bucket_size} == 0) {
+ $bucket_string = 1;
+ }
+
+
+ # Block length is the total length of the strings that will be
+ # written out in a single SST or CONTINUE block.
+ #
+ $block_length += $string_length;
+
+
+ # We can write the string if it doesn't cross a CONTINUE boundary
+ if ($block_length < $continue_limit) {
+
+ # Store location of EXTSST bucket string.
+ if ($bucket_string) {
+ my $global_offset = $self->{_datasize};
+ my $local_offset = $self->{_datasize} - $sst_block_start;
+
+ push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
+ $bucket_string = 0;
+ }
+
+ $self->_append($string);
+ $written += $string_length;
+ next;
+ }
+
+
+ # Deal with the cases where the next string to be written will exceed
+ # the CONTINUE boundary. If the string is very long it may need to be
+ # written in more than one CONTINUE record.
+ #
+ while ($block_length >= $continue_limit) {
+
+ # We need to avoid the case where a string is continued in the first
+ # n bytes that contain the string header information.
+ #
+ my $header_length = 3; # Min string + header size -1
+ my $space_remaining = $continue_limit -$written -$continue;
+
+
+ # Unicode data should only be split on char (2 byte) boundaries.
+ # Therefore, in some cases we need to reduce the amount of available
+ # space by 1 byte to ensure the correct alignment.
+ my $align = 0;
+
+ # Only applies to Unicode strings
+ if ($encoding == 1) {
+ # Min string + header size -1
+ $header_length = 4;
+
+ if ($space_remaining > $header_length) {
+ # String contains 3 byte header => split on odd boundary
+ if (not $split_string and $space_remaining % 2 != 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+ # Split section without header => split on even boundary
+ elsif ($split_string and $space_remaining % 2 == 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+
+ $split_string = 1;
+ }
+ }
+
+
+ if ($space_remaining > $header_length) {
+ # Write as much as possible of the string in the current block
+ my $tmp = substr $string, 0, $space_remaining;
+
+ # Store location of EXTSST bucket string.
+ if ($bucket_string) {
+ my $global_offset = $self->{_datasize};
+ my $local_offset = $self->{_datasize} - $sst_block_start;
+
+ push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
+ $bucket_string = 0;
+ }
+
+ $self->_append($tmp);
+
+
+ # The remainder will be written in the next block(s)
+ $string = substr $string, $space_remaining;
+
+ # Reduce the current block length by the amount written
+ $block_length -= $continue_limit -$continue -$align;
+
+ # If the current string was split then the next CONTINUE block
+ # should have the string continue flag (grbit) set unless the
+ # split string fits exactly into the remaining space.
+ #
+ if ($block_length > 0) {
+ $continue = 1;
+ }
+ else {
+ $continue = 0;
+ }
+ }
+ else {
+ # Not enough space to start the string in the current block
+ $block_length -= $continue_limit -$space_remaining -$continue;
+ $continue = 0;
+ }
+
+ # Write the CONTINUE block header
+ if (@block_sizes) {
+ $sst_block_start= $self->{_datasize}; # Reset EXTSST offset.
+
+ $record = 0x003C;
+ $length = shift @block_sizes;
+
+ $header = pack("vv", $record, $length);
+ $header .= pack("C", $encoding) if $continue;
+
+ $self->_append($header);
+ }
+
+ # If the string (or substr) is small enough we can write it in the
+ # new CONTINUE block. Else, go through the loop again to write it in
+ # one or more CONTINUE blocks
+ #
+ if ($block_length < $continue_limit) {
+
+ # Store location of EXTSST bucket string.
+ if ($bucket_string) {
+ my $global_offset = $self->{_datasize};
+ my $local_offset = $self->{_datasize} - $sst_block_start;
+
+ push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
+
+ $bucket_string = 0;
+ }
+ $self->_append($string);
+
+ $written = $block_length;
+ }
+ else {
+ $written = 0;
+ }
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _calculate_extsst_size
+#
+# The number of buckets used in the EXTSST is between 0 and 128. The number of
+# strings per bucket (bucket size) has a minimum value of 8 and a theoretical
+# maximum of 2^16. For "number of strings" < 1024 there is a constant bucket
+# size of 8. The following algorithm generates the same size/bucket ratio
+# as Excel.
+#
+sub _calculate_extsst_size {
+
+ my $self = shift;
+
+ my $unique_strings = $self->{_str_unique};
+
+ my $bucket_size;
+ my $buckets;
+
+ if ($unique_strings < 1024) {
+ $bucket_size = 8;
+ }
+ else {
+ $bucket_size = 1 + int($unique_strings / 128);
+ }
+
+ $buckets = int(($unique_strings + $bucket_size -1) / $bucket_size);
+
+
+ $self->{_extsst_buckets} = $buckets ;
+ $self->{_extsst_bucket_size} = $bucket_size;
+
+
+ return 6 + 8 * $buckets;
+}
+
+
+###############################################################################
+#
+# _store_extsst
+#
+# Write EXTSST table using the offsets calculated in _store_shared_strings().
+#
+sub _store_extsst {
+
+ my $self = shift;
+
+ my @offsets = @{$self->{_extsst_offsets}};
+ my $bucket_size = $self->{_extsst_bucket_size};
+
+ my $record = 0x00FF; # Record identifier
+ my $length = 2 + 8 * @offsets; # Bytes to follow
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $bucket_size,;
+
+ for my $offset (@offsets) {
+ $data .= pack 'Vvv', $offset->[0], $offset->[1], 0;
+ }
+
+ $self->_append($header, $data);
+
+}
+
+
+
+
+#
+# Methods related to comments and MSO objects.
+#
+
+###############################################################################
+#
+# _add_mso_drawing_group()
+#
+# Write the MSODRAWINGGROUP record that keeps track of the Escher drawing
+# objects in the file such as images, comments and filters.
+#
+sub _add_mso_drawing_group {
+
+ my $self = shift;
+
+ return unless $self->{_mso_size};
+
+ my $record = 0x00EB; # Record identifier
+ my $length = 0x0000; # Number of bytes to follow
+
+ my $data = $self->_store_mso_dgg_container();
+ $data .= $self->_store_mso_dgg(@{$self->{_mso_clusters}});
+ $data .= $self->_store_mso_bstore_container();
+ $data .= $self->_store_mso_images(@$_) for @{$self->{_images_data}};
+ $data .= $self->_store_mso_opt();
+ $data .= $self->_store_mso_split_menu_colors();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+
+ $self->_add_mso_drawing_group_continue($header . $data);
+
+ return $header . $data; # For testing only.
+}
+
+
+###############################################################################
+#
+# _add_mso_drawing_group_continue()
+#
+# See first the Spreadsheet::WriteExcel::BIFFwriter::_add_continue() method.
+#
+# Add specialised CONTINUE headers to large MSODRAWINGGROUP data block.
+# We use the Excel 97 max block size of 8228 - 4 bytes for the header = 8224.
+#
+# The structure depends on the size of the data block:
+#
+# Case 1: <= 8224 bytes 1 MSODRAWINGGROUP
+# Case 2: <= 2*8224 bytes 1 MSODRAWINGGROUP + 1 CONTINUE
+# Case 3: > 2*8224 bytes 2 MSODRAWINGGROUP + n CONTINUE
+#
+sub _add_mso_drawing_group_continue {
+
+ my $self = shift;
+
+ my $data = $_[0];
+ my $limit = 8228 -4;
+ my $mso_group = 0x00EB; # Record identifier
+ my $continue = 0x003C; # Record identifier
+ my $block_count = 1;
+ my $header;
+ my $tmp;
+
+ # Ignore the base class _add_continue() method.
+ $self->{_ignore_continue} = 1;
+
+ # Case 1 above. Just return the data as it is.
+ if (length $data <= $limit) {
+ $self->_append($data);
+ return;
+ }
+
+ # Change length field of the first MSODRAWINGGROUP block. Case 2 and 3.
+ $tmp = substr($data, 0, $limit +4, "");
+ substr($tmp, 2, 2, pack("v", $limit));
+ $self->_append($tmp);
+
+
+ # Add MSODRAWINGGROUP and CONTINUE blocks for Case 3 above.
+ while (length($data) > $limit) {
+ if ($block_count == 1) {
+ # Add extra MSODRAWINGGROUP block header.
+ $header = pack("vv", $mso_group, $limit);
+ $block_count++;
+ }
+ else {
+ # Add normal CONTINUE header.
+ $header = pack("vv", $continue, $limit);
+ }
+
+ $tmp = substr($data, 0, $limit, "");
+ $self->_append($header, $tmp);
+ }
+
+
+ # Last CONTINUE block for remaining data. Case 2 and 3 above.
+ $header = pack("vv", $continue, length($data));
+ $self->_append($header, $data);
+
+
+ # Turn the base class _add_continue() method back on.
+ $self->{_ignore_continue} = 0;
+}
+
+
+###############################################################################
+#
+# _store_mso_dgg_container()
+#
+# Write the Escher DggContainer record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_dgg_container {
+
+ my $self = shift;
+
+ my $type = 0xF000;
+ my $version = 15;
+ my $instance = 0;
+ my $data = '';
+ my $length = $self->{_mso_size} -12; # -4 (biff header) -8 (for this).
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_dgg()
+#
+# Write the Escher Dgg record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_dgg {
+
+ my $self = shift;
+
+ my $type = 0xF006;
+ my $version = 0;
+ my $instance = 0;
+ my $data = '';
+ my $length = undef; # Calculate automatically.
+
+ my $max_spid = $_[0];
+ my $num_clusters = $_[1];
+ my $shapes_saved = $_[2];
+ my $drawings_saved = $_[3];
+ my $clusters = $_[4];
+
+ $data = pack "VVVV", $max_spid, $num_clusters,
+ $shapes_saved, $drawings_saved;
+
+ for my $aref (@$clusters) {
+ my $drawing_id = $aref->[0];
+ my $shape_ids_used = $aref->[1];
+
+ $data .= pack "VV", $drawing_id, $shape_ids_used;
+ }
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_bstore_container()
+#
+# Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_bstore_container {
+
+ my $self = shift;
+
+ return '' unless $self->{_images_size};
+
+ my $type = 0xF001;
+ my $version = 15;
+ my $instance = @{$self->{_images_data}}; # Number of images.
+ my $data = '';
+ my $length = $self->{_images_size} +8 *$instance;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+
+###############################################################################
+#
+# _store_mso_images()
+#
+# Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_images {
+
+ my $self = shift;
+
+ my $ref_count = $_[0];
+ my $image_type = $_[1];
+ my $image = $_[2];
+ my $size = $_[3];
+ my $checksum1 = $_[4];
+ my $checksum2 = $_[5];
+
+ my $blip_store_entry = $self->_store_mso_blip_store_entry($ref_count,
+ $image_type,
+ $size,
+ $checksum1);
+
+ my $blip = $self->_store_mso_blip($image_type,
+ $image,
+ $size,
+ $checksum1,
+ $checksum2);
+
+ return $blip_store_entry . $blip;
+}
+
+
+
+###############################################################################
+#
+# _store_mso_blip_store_entry()
+#
+# Write the Escher BlipStoreEntry record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_blip_store_entry {
+
+ my $self = shift;
+
+ my $ref_count = $_[0];
+ my $image_type = $_[1];
+ my $size = $_[2];
+ my $checksum1 = $_[3];
+
+
+ my $type = 0xF007;
+ my $version = 2;
+ my $instance = $image_type;
+ my $length = $size +61;
+ my $data = pack('C', $image_type) # Win32
+ . pack('C', $image_type) # Mac
+ . pack('H*', $checksum1) # Uid checksum
+ . pack('v', 0xFF) # Tag
+ . pack('V', $size +25) # Next Blip size
+ . pack('V', $ref_count) # Image ref count
+ . pack('V', 0x00000000) # File offset
+ . pack('C', 0x00) # Usage
+ . pack('C', 0x00) # Name length
+ . pack('C', 0x00) # Unused
+ . pack('C', 0x00) # Unused
+ ;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_blip()
+#
+# Write the Escher Blip record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_blip {
+
+ my $self = shift;
+
+ my $image_type = $_[0];
+ my $image_data = $_[1];
+ my $size = $_[2];
+ my $checksum1 = $_[3];
+ my $checksum2 = $_[4];
+ my $instance;
+
+ $instance = 0x046A if $image_type == 5; # JPG
+ $instance = 0x06E0 if $image_type == 6; # PNG
+ $instance = 0x07A9 if $image_type == 7; # BMP
+
+ # BMPs contain an extra checksum for the stripped data.
+ if ( $image_type == 7) {
+ $checksum1 = $checksum2 . $checksum1;
+ }
+
+ my $type = 0xF018 + $image_type;
+ my $version = 0x0000;
+ my $length = $size +17;
+ my $data = pack('H*', $checksum1) # Uid checksum
+ . pack('C', 0xFF) # Tag
+ . $image_data # Image
+ ;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+
+###############################################################################
+#
+# _store_mso_opt()
+#
+# Write the Escher Opt record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_opt {
+
+ my $self = shift;
+
+ my $type = 0xF00B;
+ my $version = 3;
+ my $instance = 3;
+ my $data = '';
+ my $length = 18;
+
+ $data = pack "H*", 'BF0008000800810109000008C0014000' .
+ '0008';
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_split_menu_colors()
+#
+# Write the Escher SplitMenuColors record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_split_menu_colors {
+
+ my $self = shift;
+
+ my $type = 0xF11E;
+ my $version = 0;
+ my $instance = 4;
+ my $data = '';
+ my $length = 16;
+
+ $data = pack "H*", '0D0000080C00000817000008F7000010';
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Workbook - A writer class for Excel Workbooks.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::WriteExcel
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::WriteExcel.
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.