Gitiles
Code Review Sign In
192.168.1.100 / T800_MD / b0f5b85a5b9d69cbfa1dd990d559a4a9c7d8f2a6 / . / mcu / tools / perl / Spreadsheet / WriteExcel / Workbook.pm
blob: 0276bb2c57d552c59acf9bebdf261261a88e502b [file] [log] [blame]
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.