Dashboard

Editing: Worksheet.pm

package Spreadsheet::WriteExcel::Worksheet;

###############################################################################
#
# Worksheet - A writer class for Excel Worksheets.
#
#
# 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::Format;
use Spreadsheet::WriteExcel::Formula;

use vars qw($VERSION @ISA);
@ISA = qw(Spreadsheet::WriteExcel::BIFFwriter);

$VERSION = '2.40';

###############################################################################
#
# new()
#
# Constructor. Creates a new Worksheet object from a BIFFwriter object
#
sub new {

my $class                     = shift;
    my $self                      = Spreadsheet::WriteExcel::BIFFwriter->new();
    my $rowmax                    = 65536;
    my $colmax                    = 256;
    my $strmax                    = 0;

$self->{_name}                = $_[0];
    $self->{_index}               = $_[1];
    $self->{_encoding}            = $_[2];
    $self->{_activesheet}         = $_[3];
    $self->{_firstsheet}          = $_[4];
    $self->{_url_format}          = $_[5];
    $self->{_parser}              = $_[6];
    $self->{_tempdir}             = $_[7];

$self->{_str_total}           = $_[8];
    $self->{_str_unique}          = $_[9];
    $self->{_str_table}           = $_[10];
    $self->{_1904}                = $_[11];
    $self->{_compatibility}       = $_[12];
    $self->{_palette}             = $_[13];

$self->{_sheet_type}          = 0x0000;
    $self->{_ext_sheets}          = [];
    $self->{_using_tmpfile}       = 1;
    $self->{_filehandle}          = "";
    $self->{_fileclosed}          = 0;
    $self->{_offset}              = 0;
    $self->{_xls_rowmax}          = $rowmax;
    $self->{_xls_colmax}          = $colmax;
    $self->{_xls_strmax}          = $strmax;
    $self->{_dim_rowmin}          = undef;
    $self->{_dim_rowmax}          = undef;
    $self->{_dim_colmin}          = undef;
    $self->{_dim_colmax}          = undef;
    $self->{_colinfo}             = [];
    $self->{_selection}           = [0, 0];
    $self->{_panes}               = [];
    $self->{_active_pane}         = 3;
    $self->{_frozen}              = 0;
    $self->{_frozen_no_split}     = 1;
    $self->{_selected}            = 0;
    $self->{_hidden}              = 0;
    $self->{_active}              = 0;
    $self->{_tab_color}           = 0;

$self->{_first_row}           = 0;
    $self->{_first_col}           = 0;
    $self->{_display_formulas}    = 0;
    $self->{_display_headers}     = 1;
    $self->{_display_zeros}       = 1;
    $self->{_display_arabic}      = 0;

$self->{_paper_size}          = 0x0;
    $self->{_orientation}         = 0x1;
    $self->{_header}              = '';
    $self->{_footer}              = '';
    $self->{_header_encoding}     = 0;
    $self->{_footer_encoding}     = 0;
    $self->{_hcenter}             = 0;
    $self->{_vcenter}             = 0;
    $self->{_margin_header}       = 0.50;
    $self->{_margin_footer}       = 0.50;
    $self->{_margin_left}         = 0.75;
    $self->{_margin_right}        = 0.75;
    $self->{_margin_top}          = 1.00;
    $self->{_margin_bottom}       = 1.00;

$self->{_title_rowmin}        = undef;
    $self->{_title_rowmax}        = undef;
    $self->{_title_colmin}        = undef;
    $self->{_title_colmax}        = undef;
    $self->{_print_rowmin}        = undef;
    $self->{_print_rowmax}        = undef;
    $self->{_print_colmin}        = undef;
    $self->{_print_colmax}        = undef;

$self->{_print_gridlines}     = 1;
    $self->{_screen_gridlines}    = 1;
    $self->{_print_headers}       = 0;

$self->{_page_order}          = 0;
    $self->{_black_white}         = 0;
    $self->{_draft_quality}       = 0;
    $self->{_print_comments}      = 0;
    $self->{_page_start}          = 1;
    $self->{_custom_start}        = 0;

$self->{_fit_page}            = 0;
    $self->{_fit_width}           = 0;
    $self->{_fit_height}          = 0;

$self->{_hbreaks}             = [];
    $self->{_vbreaks}             = [];

$self->{_protect}             = 0;
    $self->{_password}            = undef;

$self->{_col_sizes}           = {};
    $self->{_row_sizes}           = {};

$self->{_col_formats}         = {};
    $self->{_row_formats}         = {};

$self->{_zoom}                = 100;
    $self->{_print_scale}         = 100;
    $self->{_page_view}           = 0;

$self->{_leading_zeros}       = 0;

$self->{_outline_row_level}   = 0;
    $self->{_outline_style}       = 0;
    $self->{_outline_below}       = 1;
    $self->{_outline_right}       = 1;
    $self->{_outline_on}          = 1;

$self->{_write_match}         = [];

$self->{_object_ids}          = [];
    $self->{_images}              = {};
    $self->{_images_array}        = [];
    $self->{_charts}              = {};
    $self->{_charts_array}        = [];
    $self->{_comments}            = {};
    $self->{_comments_array}      = [];
    $self->{_comments_author}     = '';
    $self->{_comments_author_enc} = 0;
    $self->{_comments_visible}    = 0;

$self->{_filter_area}         = [];
    $self->{_filter_count}        = 0;
    $self->{_filter_on}           = 0;

$self->{_writing_url}         = 0;

$self->{_db_indices}          = [];

$self->{_validations}         = [];

bless $self, $class;
    $self->_initialize();
    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.
#
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 ($self->{_index} == 0 && $^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" ;
        }
    }
}

###############################################################################
#
# _close()
#
# Add data to the beginning of the workbook (note the reverse order)
# and to the end of the workbook.
#
sub _close {

my $self = shift;

################################################
    # Prepend in reverse order!!
    #

# Prepend the sheet dimensions
    $self->_store_dimensions();

# Prepend the autofilter filters.
    $self->_store_autofilters;

# Prepend the sheet autofilter info.
    $self->_store_autofilterinfo();

# Prepend the sheet filtermode record.
    $self->_store_filtermode();

# Prepend the COLINFO records if they exist
    if (@{$self->{_colinfo}}){
        my @colinfo = @{$self->{_colinfo}};
        while (@colinfo) {
            my $arrayref = pop @colinfo;
            $self->_store_colinfo(@$arrayref);
        }
    }

# Prepend the DEFCOLWIDTH record
    $self->_store_defcol();

# Prepend the sheet password
    $self->_store_password();

# Prepend the sheet protection
    $self->_store_protect();
    $self->_store_obj_protect();

# Prepend the page setup
    $self->_store_setup();

# Prepend the bottom margin
    $self->_store_margin_bottom();

# Prepend the top margin
    $self->_store_margin_top();

# Prepend the right margin
    $self->_store_margin_right();

# Prepend the left margin
    $self->_store_margin_left();

# Prepend the page vertical centering
    $self->_store_vcenter();

# Prepend the page horizontal centering
    $self->_store_hcenter();

# Prepend the page footer
    $self->_store_footer();

# Prepend the page header
    $self->_store_header();

# Prepend the vertical page breaks
    $self->_store_vbreak();

# Prepend the horizontal page breaks
    $self->_store_hbreak();

# Prepend WSBOOL
    $self->_store_wsbool();

# Prepend the default row height.
    $self->_store_defrow();

# Prepend GUTS
    $self->_store_guts();

# Prepend GRIDSET
    $self->_store_gridset();

# Prepend PRINTGRIDLINES
    $self->_store_print_gridlines();

# Prepend PRINTHEADERS
    $self->_store_print_headers();

#
    # End of prepend. Read upwards from here.
    ################################################

# Append
    $self->_store_table();
    $self->_store_images();
    $self->_store_charts();
    $self->_store_filters();
    $self->_store_comments();
    $self->_store_window2();
    $self->_store_page_view();
    $self->_store_zoom();
    $self->_store_panes(@{$self->{_panes}}) if @{$self->{_panes}};
    $self->_store_selection(@{$self->{_selection}});
    $self->_store_validation_count();
    $self->_store_validations();
    $self->_store_tab_color();
    $self->_store_eof();

# Prepend the BOF and INDEX records
    $self->_store_index();
    $self->_store_bof(0x0010);
}

###############################################################################
#
# _compatibility_mode()
#
# Set the compatibility mode.
#
# See the explanation in Workbook::compatibility_mode(). This private method
# is mainly used for test purposes.
#
sub _compatibility_mode {

my $self      = shift;

if (defined($_[0])) {
        $self->{_compatibility} = $_[0];
    }
    else {
        $self->{_compatibility} = 1;
    }
}

###############################################################################
#
# get_name().
#
# Retrieve the worksheet name.
#
# Note, there is no set_name() method because names are used in formulas and
# converted to internal indices. Allowing the user to change sheet names
# after they have been set in add_worksheet() is asking for trouble.
#
sub get_name {

my $self    = shift;

return $self->{_name};
}

###############################################################################
#
# 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;
}

###############################################################################
#
# select()
#
# Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
# highlighted.
#
sub select {

my $self = shift;

$self->{_hidden}         = 0; # Selected worksheet can't be hidden.
    $self->{_selected}       = 1;
}

###############################################################################
#
# activate()
#
# Set this worksheet as the active worksheet, i.e. the worksheet that is
# displayed when the workbook is opened. Also set it as selected.
#
sub activate {

my $self = shift;

$self->{_hidden}         = 0; # Active worksheet can't be hidden.
    $self->{_selected}       = 1;
    ${$self->{_activesheet}} = $self->{_index};
}

###############################################################################
#
# hide()
#
# Hide this worksheet.
#
sub hide {

my $self = shift;

$self->{_hidden}         = 1;

# A hidden worksheet shouldn't be active or selected.
    $self->{_selected}       = 0;
    ${$self->{_activesheet}} = 0;
    ${$self->{_firstsheet}}  = 0;
}

###############################################################################
#
# set_first_sheet()
#
# Set this worksheet as the first visible sheet. This is necessary
# when there are a large number of worksheets and the activated
# worksheet is not visible on the screen.
#
sub set_first_sheet {

my $self = shift;

$self->{_hidden}         = 0; # Active worksheet can't be hidden.
    ${$self->{_firstsheet}}  = $self->{_index};
}

###############################################################################
#
# protect($password)
#
# Set the worksheet protection flag to prevent accidental modification and to
# hide formulas if the locked and hidden format properties have been set.
#
sub protect {

my $self = shift;

$self->{_protect}   = 1;
    $self->{_password}  = $self->_encode_password($_[0]) if defined $_[0];

}

###############################################################################
#
# set_column($firstcol, $lastcol, $width, $format, $hidden, $level)
#
# Set the width of a single column or a range of columns.
# See also: _store_colinfo
#
sub set_column {

my $self = shift;
    my @data = @_;
    my $cell = $data[0];

# Check for a cell reference in A1 notation and substitute row and column
    if ($cell =~ /^\D/) {
        @data = $self->_substitute_cellref(@_);

# Returned values $row1 and $row2 aren't required here. Remove them.
        shift  @data;       # $row1
        splice @data, 1, 1; # $row2
    }

return if @data < 3; # Ensure at least $firstcol, $lastcol and $width
    return if not defined $data[0]; # Columns must be defined.
    return if not defined $data[1];

# Assume second column is the same as first if 0. Avoids KB918419 bug.
    $data[1] = $data[0] if $data[1] == 0;

# Ensure 2nd col is larger than first. Also for KB918419 bug.
    ($data[0], $data[1]) = ($data[1], $data[0]) if $data[0] > $data[1];

# Limit columns to Excel max of 255.
    $data[0] = 255 if $data[0] > 255;
    $data[1] = 255 if $data[1] > 255;

push @{$self->{_colinfo}}, [ @data ];

# Store the col sizes for use when calculating image vertices taking
    # hidden columns into account. Also store the column formats.
    #
    my $width  = $data[4] ? 0 : $data[2]; # Set width to zero if col is hidden
       $width  ||= 0;                     # Ensure width isn't undef.
    my $format = $data[3];

my ($firstcol, $lastcol) = @data;

foreach my $col ($firstcol .. $lastcol) {
        $self->{_col_sizes}->{$col}   = $width;
        $self->{_col_formats}->{$col} = $format if defined $format;
    }
}

###############################################################################
#
# set_selection()
#
# Set which cell or cells are selected in a worksheet: see also the
# sub _store_selection
#
sub set_selection {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

$self->{_selection} = [ @_ ];
}

###############################################################################
#
# freeze_panes()
#
# Set panes and mark them as frozen. See also _store_panes().
#
sub freeze_panes {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

# Extra flag indicated a split and freeze.
    $self->{_frozen_no_split} = 0 if $_[4];

$self->{_frozen} = 1;
    $self->{_panes}  = [ @_ ];
}

###############################################################################
#
# split_panes()
#
# Set panes and mark them as split. See also _store_panes().
#
sub split_panes {

my $self = shift;

$self->{_frozen}            = 0;
    $self->{_frozen_no_split}   = 0;
    $self->{_panes}             = [ @_ ];
}

# Older method name for backwards compatibility.
*thaw_panes = *split_panes;

###############################################################################
#
# set_portrait()
#
# Set the page orientation as portrait.
#
sub set_portrait {

my $self = shift;

$self->{_orientation} = 1;
}

###############################################################################
#
# set_landscape()
#
# Set the page orientation as landscape.
#
sub set_landscape {

my $self = shift;

$self->{_orientation} = 0;
}

###############################################################################
#
# set_page_view()
#
# Set the page view mode for Mac Excel.
#
sub set_page_view {

my $self = shift;

$self->{_page_view} = defined $_[0] ? $_[0] : 1;
}

###############################################################################
#
# set_tab_color()
#
# Set the colour of the worksheet colour.
#
sub set_tab_color {

my $self  = shift;

my $color = &Spreadsheet::WriteExcel::Format::_get_color($_[0]);
       $color = 0 if $color == 0x7FFF; # Default color.

$self->{_tab_color} = $color;
}

###############################################################################
#
# set_paper()
#
# Set the paper type. Ex. 1 = US Letter, 9 = A4
#
sub set_paper {

my $self = shift;

$self->{_paper_size} = $_[0] || 0;
}

###############################################################################
#
# set_header()
#
# Set the page header caption and optional margin.
#
sub set_header {

my $self     = shift;
    my $string   = $_[0] || '';
    my $margin   = $_[1] || 0.50;
    my $encoding = $_[2] || 0;

# Handle utf8 strings in perl 5.8.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($string)) {
            $string = Encode::encode("UTF-16BE", $string);
            $encoding = 1;
        }
    }

my $limit    = $encoding ? 255 *2 : 255;

if (length $string >= $limit) {
        carp 'Header string must be less than 255 characters';
        return;
    }

$self->{_header}          = $string;
    $self->{_margin_header}   = $margin;
    $self->{_header_encoding} = $encoding;
}

###############################################################################
#
# set_footer()
#
# Set the page footer caption and optional margin.
#
sub set_footer {

my $self     = shift;
    my $string   = $_[0] || '';
    my $margin   = $_[1] || 0.50;
    my $encoding = $_[2] || 0;

# Handle utf8 strings in perl 5.8.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($string)) {
            $string = Encode::encode("UTF-16BE", $string);
            $encoding = 1;
        }
    }

my $limit    = $encoding ? 255 *2 : 255;

if (length $string >= $limit) {
        carp 'Footer string must be less than 255 characters';
        return;
    }

$self->{_footer}          = $string;
    $self->{_margin_footer}   = $margin;
    $self->{_footer_encoding} = $encoding;
}

###############################################################################
#
# center_horizontally()
#
# Center the page horizontally.
#
sub center_horizontally {

my $self = shift;

if (defined $_[0]) {
        $self->{_hcenter} = $_[0];
    }
    else {
        $self->{_hcenter} = 1;
    }
}

###############################################################################
#
# center_vertically()
#
# Center the page horizontally.
#
sub center_vertically {

my $self = shift;

if (defined $_[0]) {
        $self->{_vcenter} = $_[0];
    }
    else {
        $self->{_vcenter} = 1;
    }
}

###############################################################################
#
# set_margins()
#
# Set all the page margins to the same value in inches.
#
sub set_margins {

my $self = shift;

$self->set_margin_left($_[0]);
    $self->set_margin_right($_[0]);
    $self->set_margin_top($_[0]);
    $self->set_margin_bottom($_[0]);
}

###############################################################################
#
# set_margins_LR()
#
# Set the left and right margins to the same value in inches.
#
sub set_margins_LR {

my $self = shift;

$self->set_margin_left($_[0]);
    $self->set_margin_right($_[0]);
}

###############################################################################
#
# set_margins_TB()
#
# Set the top and bottom margins to the same value in inches.
#
sub set_margins_TB {

my $self = shift;

$self->set_margin_top($_[0]);
    $self->set_margin_bottom($_[0]);
}

###############################################################################
#
# set_margin_left()
#
# Set the left margin in inches.
#
sub set_margin_left {

my $self = shift;

$self->{_margin_left} = defined $_[0] ? $_[0] : 0.75;
}

###############################################################################
#
# set_margin_right()
#
# Set the right margin in inches.
#
sub set_margin_right {

my $self = shift;

$self->{_margin_right} = defined $_[0] ? $_[0] : 0.75;
}

###############################################################################
#
# set_margin_top()
#
# Set the top margin in inches.
#
sub set_margin_top {

my $self = shift;

$self->{_margin_top} = defined $_[0] ? $_[0] : 1.00;
}

###############################################################################
#
# set_margin_bottom()
#
# Set the bottom margin in inches.
#
sub set_margin_bottom {

my $self = shift;

$self->{_margin_bottom} = defined $_[0] ? $_[0] : 1.00;
}

###############################################################################
#
# repeat_rows($first_row, $last_row)
#
# Set the rows to repeat at the top of each printed page. See also the
# _store_name_xxxx() methods in Workbook.pm.
#
sub repeat_rows {

my $self = shift;

$self->{_title_rowmin}  = $_[0];
    $self->{_title_rowmax}  = $_[1] || $_[0]; # Second row is optional
}

###############################################################################
#
# repeat_columns($first_col, $last_col)
#
# Set the columns to repeat at the left hand side of each printed page.
# See also the _store_names() methods in Workbook.pm.
#
sub repeat_columns {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);

# Returned values $row1 and $row2 aren't required here. Remove them.
        shift  @_;       # $row1
        splice @_, 1, 1; # $row2
    }

$self->{_title_colmin}  = $_[0];
    $self->{_title_colmax}  = $_[1] || $_[0]; # Second col is optional
}

###############################################################################
#
# print_area($first_row, $first_col, $last_row, $last_col)
#
# Set the area of each worksheet that will be printed. See also the
# _store_names() methods in Workbook.pm.
#
sub print_area {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

return if @_ != 4; # Require 4 parameters

$self->{_print_rowmin} = $_[0];
    $self->{_print_colmin} = $_[1];
    $self->{_print_rowmax} = $_[2];
    $self->{_print_colmax} = $_[3];
}

###############################################################################
#
# autofilter($first_row, $first_col, $last_row, $last_col)
#
# Set the autofilter area in the worksheet.
#
sub autofilter {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

return if @_ != 4; # Require 4 parameters

my ($row1, $col1, $row2, $col2) = @_;

# Reverse max and min values if necessary.
    ($row1, $row2) = ($row2, $row1) if $row2 < $row1;
    ($col1, $col2) = ($col2, $col1) if $col2 < $col1;

# Store the Autofilter information
    $self->{_filter_area}  = [$row1, $row2, $col1, $col2];
    $self->{_filter_count} = 1+ $col2 -$col1;
}

###############################################################################
#
# filter_column($column, $criteria, ...)
#
# Set the column filter criteria.
#
sub filter_column {

my $self        = shift;
    my $col         = $_[0];
    my $expression  = $_[1];

croak "Must call autofilter() before filter_column()"
                                                 unless $self->{_filter_count};
    croak "Incorrect number of arguments to filter_column()" unless @_ == 2;

# Check for a column reference in A1 notation and substitute.
    if ($col =~ /^\D/) {
        # Convert col ref to a cell ref and then to a col number.
        (undef, $col) = $self->_substitute_cellref($col . '1');
    }

my (undef, undef, $col_first, $col_last) = @{$self->{_filter_area}};

# Reject column if it is outside filter range.
    if ($col < $col_first or $col > $col_last) {
        croak "Column '$col' outside autofilter() column range " .
              "($col_first .. $col_last)";
    }

my @tokens = $self->_extract_filter_tokens($expression);

croak "Incorrect number of tokens in expression '$expression'"
          unless (@tokens == 3 or @tokens == 7);

@tokens = $self->_parse_filter_expression($expression, @tokens);

$self->{_filter_cols}->{$col} = [@tokens];
    $self->{_filter_on}           = 1;
}

###############################################################################
#
# _extract_filter_tokens($expression)
#
# Extract the tokens from the filter expression. The tokens are mainly non-
# whitespace groups. The only tricky part is to extract string tokens that
# contain whitespace and/or quoted double quotes (Excel's escaped quotes).
#
# Examples: 'x <  2000'
#           'x >  2000 and x <  5000'
#           'x = "foo"'
#           'x = "foo bar"'
#           'x = "foo "" bar"'
#
sub _extract_filter_tokens {

my $self        = shift;
    my $expression  = $_[0];

return unless $expression;

my @tokens = ($expression  =~ /"(?:[^"]|"")*"|\S+/g); #"

# Remove leading and trailing quotes and unescape other quotes
    for (@tokens) {
        s/^"//;     #"
        s/"$//;     #"
        s/""/"/g;   #"
    }

return @tokens;
}

###############################################################################
#
# _parse_filter_expression(@token)
#
# Converts the tokens of a possibly conditional expression into 1 or 2
# sub expressions for further parsing.
#
# Examples:
#          ('x', '==', 2000) -> exp1
#          ('x', '>',  2000, 'and', 'x', '<', 5000) -> exp1 and exp2
#
sub _parse_filter_expression {

my $self        = shift;
    my $expression  = shift;
    my @tokens      = @_;

# The number of tokens will be either 3 (for 1 expression)
    # or 7 (for 2  expressions).
    #
    if (@tokens == 7) {

my $conditional = $tokens[3];

if    ($conditional =~ /^(and|&&)$/) {
            $conditional = 0;
        }
        elsif ($conditional =~ /^(or|\|\|)$/) {
            $conditional = 1;
        }
        else {
            croak "Token '$conditional' is not a valid conditional " .
                  "in filter expression '$expression'";
        }

my @expression_1 = $self->_parse_filter_tokens($expression,
                                                       @tokens[0, 1, 2]);
        my @expression_2 = $self->_parse_filter_tokens($expression,
                                                       @tokens[4, 5, 6]);

return (@expression_1, $conditional, @expression_2);
    }
    else {
        return $self->_parse_filter_tokens($expression, @tokens);
    }
}

###############################################################################
#
# _parse_filter_tokens(@token)
#
# Parse the 3 tokens of a filter expression and return the operator and token.
#
sub _parse_filter_tokens {

my $self        = shift;
    my $expression  = shift;
    my @tokens      = @_;

my %operators = (
                        '==' => 2,
                        '='  => 2,
                        '=~' => 2,
                        'eq' => 2,

'!=' => 5,
                        '!~' => 5,
                        'ne' => 5,
                        '<>' => 5,

'<'  => 1,
                        '<=' => 3,
                        '>'  => 4,
                        '>=' => 6,
                    );

my $operator = $operators{$tokens[1]};
    my $token    = $tokens[2];

# Special handling of "Top" filter expressions.
    if ($tokens[0] =~ /^top|bottom$/i) {

my $value = $tokens[1];

if ($value =~ /\D/ or
            $value < 1     or
            $value > 500)
        {
            croak "The value '$value' in expression '$expression' " .
                   "must be in the range 1 to 500";
        }

$token = lc $token;

if ($token ne 'items' and $token ne '%') {
            croak "The type '$token' in expression '$expression' " .
                   "must be either 'items' or '%'";
        }

if ($tokens[0] =~ /^top$/i) {
            $operator = 30;
        }
        else {
            $operator = 32;
        }

if ($tokens[2] eq '%') {
            $operator++;
        }

$token    = $value;
    }

if (not $operator and $tokens[0]) {
        croak "Token '$tokens[1]' is not a valid operator " .
              "in filter expression '$expression'";
    }

# Special handling for Blanks/NonBlanks.
    if ($token =~ /^blanks|nonblanks$/i) {

# Only allow Equals or NotEqual in this context.
        if ($operator != 2 and $operator != 5) {
            croak "The operator '$tokens[1]' in expression '$expression' " .
                   "is not valid in relation to Blanks/NonBlanks'";
        }

$token = lc $token;

# The operator should always be 2 (=) to flag a "simple" equality in
        # the binary record. Therefore we convert <> to =.
        if ($token eq 'blanks') {
            if ($operator == 5) {
                $operator = 2;
                $token    = 'nonblanks';
            }
        }
        else {
            if ($operator == 5) {
                $operator = 2;
                $token    = 'blanks';
            }
        }
    }

# if the string token contains an Excel match character then change the
    # operator type to indicate a non "simple" equality.
    if ($operator == 2 and $token =~ /[*?]/) {
        $operator = 22;
    }

return ($operator, $token);
}

###############################################################################
#
# hide_gridlines()
#
# Set the option to hide gridlines on the screen and the printed page.
# There are two ways of doing this in the Excel BIFF format: The first is by
# setting the DspGrid field of the WINDOW2 record, this turns off the screen
# and subsequently the print gridline. The second method is to via the
# PRINTGRIDLINES and GRIDSET records, this turns off the printed gridlines
# only. The first method is probably sufficient for most cases. The second
# method is supported for backwards compatibility. Porters take note.
#
sub hide_gridlines {

my $self   = shift;
    my $option = $_[0];

$option = 1 unless defined $option; # Default to hiding printed gridlines

if ($option == 0) {
        $self->{_print_gridlines}  = 1; # 1 = display, 0 = hide
        $self->{_screen_gridlines} = 1;
    }
    elsif ($option == 1) {
        $self->{_print_gridlines}  = 0;
        $self->{_screen_gridlines} = 1;
    }
    else {
        $self->{_print_gridlines}  = 0;
        $self->{_screen_gridlines} = 0;
    }
}

###############################################################################
#
# print_row_col_headers()
#
# Set the option to print the row and column headers on the printed page.
# See also the _store_print_headers() method below.
#
sub print_row_col_headers {

my $self = shift;

if (defined $_[0]) {
        $self->{_print_headers} = $_[0];
    }
    else {
        $self->{_print_headers} = 1;
    }
}

###############################################################################
#
# fit_to_pages($width, $height)
#
# Store the vertical and horizontal number of pages that will define the
# maximum area printed. See also _store_setup() and _store_wsbool() below.
#
sub fit_to_pages {

my $self = shift;

$self->{_fit_page}      = 1;
    $self->{_fit_width}     = $_[0] || 0;
    $self->{_fit_height}    = $_[1] || 0;
}

###############################################################################
#
# set_h_pagebreaks(@breaks)
#
# Store the horizontal page breaks on a worksheet.
#
sub set_h_pagebreaks {

my $self = shift;

push @{$self->{_hbreaks}}, @_;
}

###############################################################################
#
# set_v_pagebreaks(@breaks)
#
# Store the vertical page breaks on a worksheet.
#
sub set_v_pagebreaks {

my $self = shift;

push @{$self->{_vbreaks}}, @_;
}

###############################################################################
#
# set_zoom($scale)
#
# Set the worksheet zoom factor.
#
sub set_zoom {

my $self  = shift;
    my $scale = $_[0] || 100;

# Confine the scale to Excel's range
    if ($scale < 10 or $scale > 400) {
        carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
        $scale = 100;
    }

$self->{_zoom} = int $scale;
}

###############################################################################
#
# set_print_scale($scale)
#
# Set the scale factor for the printed page.
#
sub set_print_scale {

my $self  = shift;
    my $scale = $_[0] || 100;

# Confine the scale to Excel's range
    if ($scale < 10 or $scale > 400) {
        carp "Print scale $scale outside range: 10 <= zoom <= 400";
        $scale = 100;
    }

# Turn off "fit to page" option
    $self->{_fit_page}    = 0;

$self->{_print_scale} = int $scale;
}

###############################################################################
#
# keep_leading_zeros()
#
# Causes the write() method to treat integers with a leading zero as a string.
# This ensures that any leading zeros such, as in zip codes, are maintained.
#
sub keep_leading_zeros {

my $self = shift;

if (defined $_[0]) {
        $self->{_leading_zeros} = $_[0];
    }
    else {
        $self->{_leading_zeros} = 1;
    }
}

###############################################################################
#
# show_comments()
#
# Make any comments in the worksheet visible.
#
sub show_comments {

my $self = shift;

$self->{_comments_visible} = defined $_[0] ? $_[0] : 1;
}

###############################################################################
#
# set_comments_author()
#
# Set the default author of the cell comments.
#
sub set_comments_author {

my $self = shift;

$self->{_comments_author}     = defined $_[0] ? $_[0] : '';
    $self->{_comments_author_enc} =         $_[1] ? 1     : 0;
}

###############################################################################
#
# right_to_left()
#
# Display the worksheet right to left for some eastern versions of Excel.
#
sub right_to_left {

my $self = shift;

$self->{_display_arabic} = defined $_[0] ? $_[0] : 1;
}

###############################################################################
#
# hide_zero()
#
# Hide cell zero values.
#
sub hide_zero {

my $self = shift;

$self->{_display_zeros} = defined $_[0] ? not $_[0] : 0;
}

###############################################################################
#
# print_across()
#
# Set the order in which pages are printed.
#
sub print_across {

my $self = shift;

$self->{_page_order} = defined $_[0] ? $_[0] : 1;
}

###############################################################################
#
# set_start_page()
#
# Set the start page number.
#
sub set_start_page {

my $self = shift;
    return unless defined $_[0];

$self->{_page_start}    = $_[0];
    $self->{_custom_start}  = 1;
}

###############################################################################
#
# set_first_row_column()
#
# Set the topmost and leftmost visible row and column.
# TODO: Document this when tested fully for interaction with panes.
#
sub set_first_row_column {

my $self = shift;

my $row  = $_[0] || 0;
    my $col  = $_[1] || 0;

$row = 65535 if $row > 65535;
    $col = 255   if $col > 255;

$self->{_first_row} = $row;
    $self->{_first_col} = $col;
}

###############################################################################
#
# add_write_handler($re, $code_ref)
#
# Allow the user to add their own matches and handlers to the write() method.
#
sub add_write_handler {

my $self = shift;

return unless @_ == 2;
    return unless ref $_[1] eq 'CODE';

push @{$self->{_write_match}}, [ @_ ];
}

###############################################################################
#
# write($row, $col, $token, $format)
#
# Parse $token and call appropriate write method. $row and $column are zero
# indexed. $format is optional.
#
# The write_url() methods have a flag to prevent recursion when writing a
# string that looks like a url.
#
# Returns: return value of called subroutine
#
sub write {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

my $token = $_[2];

# Handle undefs as blanks
    $token = '' unless defined $token;

# First try user defined matches.
    for my $aref (@{$self->{_write_match}}) {
        my $re  = $aref->[0];
        my $sub = $aref->[1];

if ($token =~ /$re/) {
            my $match = &$sub($self, @_);
            return $match if defined $match;
        }
    }

# Match an array ref.
    if (ref $token eq "ARRAY") {
        return $self->write_row(@_);
    }
    # Match integer with leading zero(s)
    elsif ($self->{_leading_zeros} and $token =~ /^0\d+$/) {
        return $self->write_string(@_);
    }
    # Match number
    elsif ($token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
        return $self->write_number(@_);
    }
    # Match http, https or ftp URL
    elsif ($token =~ m|^[fh]tt?ps?://|    and not $self->{_writing_url}) {
        return $self->write_url(@_);
    }
    # Match mailto:
    elsif ($token =~ m/^mailto:/          and not $self->{_writing_url}) {
        return $self->write_url(@_);
    }
    # Match internal or external sheet link
    elsif ($token =~ m[^(?:in|ex)ternal:] and not $self->{_writing_url}) {
        return $self->write_url(@_);
    }
    # Match formula
    elsif ($token =~ /^=/) {
        return $self->write_formula(@_);
    }
    # Match blank
    elsif ($token eq '') {
        splice @_, 2, 1; # remove the empty string from the parameter list
        return $self->write_blank(@_);
    }
    else {
        return $self->write_string(@_);
    }
}

###############################################################################
#
# write_row($row, $col, $array_ref, $format)
#
# Write a row of data starting from ($row, $col). Call write_col() if any of
# the elements of the array ref are in turn array refs. This allows the writing
# of 1D or 2D arrays of data in one go.
#
# Returns: the first encountered error value or zero for no errors
#
sub write_row {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

# Catch non array refs passed by user.
    if (ref $_[2] ne 'ARRAY') {
        croak "Not an array ref in call to write_row()$!";
    }

my $row     = shift;
    my $col     = shift;
    my $tokens  = shift;
    my @options = @_;
    my $error   = 0;
    my $ret;

foreach my $token (@$tokens) {

# Check for nested arrays
        if (ref $token eq "ARRAY") {
            $ret = $self->write_col($row, $col, $token, @options);
        } else {
            $ret = $self->write    ($row, $col, $token, @options);
        }

# Return only the first error encountered, if any.
        $error ||= $ret;
        $col++;
    }

return $error;
}

###############################################################################
#
# write_col($row, $col, $array_ref, $format)
#
# Write a column of data starting from ($row, $col). Call write_row() if any of
# the elements of the array ref are in turn array refs. This allows the writing
# of 1D or 2D arrays of data in one go.
#
# Returns: the first encountered error value or zero for no errors
#
sub write_col {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

# Catch non array refs passed by user.
    if (ref $_[2] ne 'ARRAY') {
        croak "Not an array ref in call to write_col()$!";
    }

my $row     = shift;
    my $col     = shift;
    my $tokens  = shift;
    my @options = @_;
    my $error   = 0;
    my $ret;

foreach my $token (@$tokens) {

# write() will deal with any nested arrays
        $ret = $self->write($row, $col, $token, @options);

# Return only the first error encountered, if any.
        $error ||= $ret;
        $row++;
    }

return $error;
}

###############################################################################
#
# write_comment($row, $col, $comment)
#
# Write a comment to the specified row and column (zero indexed).
#
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#
sub write_comment {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 3) { return -1 } # Check the number of args

my $row = $_[0];
    my $col = $_[1];

# Check for pairs of optional arguments, i.e. an odd number of args.
    croak "Uneven number of additional arguments" unless @_ % 2;

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

# We have to avoid duplicate comments in cells or else Excel will complain.
    $self->{_comments}->{$row}->{$col} = [ $self->_comment_params(@_) ];

}

###############################################################################
#
# _XF()
#
# Returns an index to the XF record in the workbook.
#
# Note: this is a function, not a method.
#
sub _XF {

my $self   = $_[0];
    my $row    = $_[1];
    my $col    = $_[2];
    my $format = $_[3];

my $error = "Error: refer to merge_range() in the documentation. " .
                 "Can't use previously merged format in non-merged cell";

if (ref($format)) {
        # Temp code to prevent merged formats in non-merged cells.
        croak $error if $format->{_used_merge} == 1;
        $format->{_used_merge} = -1;

return $format->get_xf_index();
    }
    elsif (exists $self->{_row_formats}->{$row}) {
        # Temp code to prevent merged formats in non-merged cells.
        croak $error if $self->{_row_formats}->{$row}->{_used_merge} == 1;
        $self->{_row_formats}->{$row}->{_used_merge} = -1;

return $self->{_row_formats}->{$row}->get_xf_index();
    }
    elsif (exists $self->{_col_formats}->{$col}) {
        # Temp code to prevent merged formats in non-merged cells.
        croak $error if $self->{_col_formats}->{$col}->{_used_merge} == 1;
        $self->{_col_formats}->{$col}->{_used_merge} = -1;

return $self->{_col_formats}->{$col}->get_xf_index();
    }
    else {
        return 0x0F;
    }
}

###############################################################################
###############################################################################
#
# Internal methods
#

###############################################################################
#
# _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;
}

###############################################################################
#
# _substitute_cellref()
#
# Substitute an Excel cell reference in A1 notation for  zero based row and
# column values in an argument list.
#
# Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
#
sub _substitute_cellref {

my $self = shift;
    my $cell = uc(shift);

# Convert a column range: 'A:A' or 'B:G'.
    # A range such as A:A is equivalent to A1:65536, so add rows as required
    if ($cell =~ /\$?([A-I]?[A-Z]):\$?([A-I]?[A-Z])/) {
        my ($row1, $col1) =  $self->_cell_to_rowcol($1 .'1');
        my ($row2, $col2) =  $self->_cell_to_rowcol($2 .'65536');
        return $row1, $col1, $row2, $col2, @_;
    }

# Convert a cell range: 'A1:B7'
    if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+):\$?([A-I]?[A-Z]\$?\d+)/) {
        my ($row1, $col1) =  $self->_cell_to_rowcol($1);
        my ($row2, $col2) =  $self->_cell_to_rowcol($2);
        return $row1, $col1, $row2, $col2, @_;
    }

# Convert a cell reference: 'A1' or 'AD2000'
    if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+)/) {
        my ($row1, $col1) =  $self->_cell_to_rowcol($1);
        return $row1, $col1, @_;

}

croak("Unknown cell reference $cell");
}

###############################################################################
#
# _cell_to_rowcol($cell_ref)
#
# Convert an Excel cell reference in A1 notation to a zero based row and column
# reference; converts C1 to (0, 2).
#
# Returns: row, column
#
sub _cell_to_rowcol {

my $self = shift;
    my $cell = shift;

$cell =~ /\$?([A-I]?[A-Z])\$?(\d+)/;

my $col     = $1;
    my $row     = $2;

# Convert base26 column string to number
    # All your Base are belong to us.
    my @chars = split //, $col;
    my $expn  = 0;
    $col      = 0;

while (@chars) {
        my $char = pop(@chars); # LS char first
        $col += (ord($char) -ord('A') +1) * (26**$expn);
        $expn++;
    }

# Convert 1-index to zero-index
    $row--;
    $col--;

return $row, $col;
}

###############################################################################
#
# _sort_pagebreaks()
#
#
# This is an internal method that is used to filter elements of the array of
# pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
#   1. Removes duplicate entries from the list.
#   2. Sorts the list.
#   3. Removes 0 from the list if present.
#
sub _sort_pagebreaks {

my $self= shift;

my %hash;
    my @array;

@hash{@_} = undef;                       # Hash slice to remove duplicates
    @array    = sort {$a <=> $b} keys %hash; # Numerical sort
    shift @array if $array[0] == 0;          # Remove zero

# 1000 vertical pagebreaks appears to be an internal Excel 5 limit.
    # It is slightly higher in Excel 97/200, approx. 1026
    splice(@array, 1000) if (@array > 1000);

return @array
}

###############################################################################
#
# _encode_password($password)
#
# Based on the algorithm provided by Daniel Rentz of OpenOffice.
#
#
sub _encode_password {

use integer;

my $self      = shift;
    my $plaintext = $_[0];
    my $password;
    my $count;
    my @chars;
    my $i = 0;

$count = @chars = split //, $plaintext;

foreach my $char (@chars) {
        my $low_15;
        my $high_15;
        $char     = ord($char) << ++$i;
        $low_15   = $char & 0x7fff;
        $high_15  = $char & 0x7fff << 15;
        $high_15  = $high_15 >> 15;
        $char     = $low_15 | $high_15;
    }

$password  = 0x0000;
    $password ^= $_ for @chars;
    $password ^= $count;
    $password ^= 0xCE4B;

return $password;
}

###############################################################################
#
# outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
#
# This method sets the properties for outlining and grouping. The defaults
# correspond to Excel's defaults.
#
sub outline_settings {

my $self                = shift;

$self->{_outline_on}    = defined $_[0] ? $_[0] : 1;
    $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
    $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
    $self->{_outline_style} =         $_[3] || 0;

# Ensure this is a boolean vale for Window2
    $self->{_outline_on}    = 1 if $self->{_outline_on};
}

###############################################################################
###############################################################################
#
# BIFF RECORDS
#

###############################################################################
#
# write_number($row, $col, $num, $format)
#
# Write a double to the specified row and column (zero indexed).
# An integer can be written as a double. Excel will display an
# integer. $format is optional.
#
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#
sub write_number {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 3) { return -1 }                    # Check the number of args

my $record  = 0x0203;                        # Record identifier
    my $length  = 0x000E;                        # Number of bytes to follow

my $row     = $_[0];                         # Zero indexed row
    my $col     = $_[1];                         # Zero indexed column
    my $num     = $_[2];
    my $xf      = _XF($self, $row, $col, $_[3]); # The cell format

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

my $header    = pack("vv",  $record, $length);
    my $data      = pack("vvv", $row, $col, $xf);
    my $xl_double = pack("d",   $num);

if ($self->{_byte_order}) { $xl_double = reverse $xl_double }

# Store the data or write immediately depending on the compatibility mode.
    if ($self->{_compatibility}) {
        $self->{_table}->[$row]->[$col] = $header . $data . $xl_double;
    }
    else {
        $self->_append($header, $data, $xl_double);
    }

return 0;
}

###############################################################################
#
# write_string ($row, $col, $string, $format)
#
# Write a string to the specified row and column (zero indexed).
# $format is optional.
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#         -3 : long string truncated to max chars
#
sub write_string {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 3) { return -1 }                        # Check the number of args

my $record      = 0x00FD;                        # Record identifier
    my $length      = 0x000A;                        # Bytes to follow

my $row         = $_[0];                         # Zero indexed row
    my $col         = $_[1];                         # Zero indexed column
    my $strlen      = length($_[2]);
    my $str         = $_[2];
    my $xf          = _XF($self, $row, $col, $_[3]); # The cell format
    my $encoding    = 0x0;
    my $str_error   = 0;

# Handle utf8 strings in perl 5.8.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($str)) {
            my $tmp = Encode::encode("UTF-16LE", $str);
            return $self->write_utf16le_string($row, $col, $tmp, $_[3]);
        }
    }

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

# Limit the string to the max number of chars.
    if ($strlen > 32767) {
        $str       = substr($str, 0, 32767);
        $str_error = -3;
    }

# Prepend the string with the type.
    my $str_header  = pack("vC", length($str), $encoding);
    $str            = $str_header . $str;

if (not exists ${$self->{_str_table}}->{$str}) {
        ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
    }

${$self->{_str_total}}++;

my $header = pack("vv",   $record, $length);
    my $data   = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});

# Store the data or write immediately depending on the compatibility mode.
    if ($self->{_compatibility}) {
        $self->{_table}->[$row]->[$col] = $header . $data;
    }
    else {
        $self->_append($header, $data);
    }

return $str_error;
}

###############################################################################
#
# write_blank($row, $col, $format)
#
# Write a blank cell to the specified row and column (zero indexed).
# A blank cell is used to specify formatting without adding a string
# or a number.
#
# A blank cell without a format serves no purpose. Therefore, we don't write
# a BLANK record unless a format is specified. This is mainly an optimisation
# for the write_row() and write_col() methods.
#
# Returns  0 : normal termination (including no format)
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#
sub write_blank {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

# Check the number of args
    return -1 if @_ < 2;

# Don't write a blank cell unless it has a format
    return 0 if not defined $_[2];

my $record  = 0x0201;                        # Record identifier
    my $length  = 0x0006;                        # Number of bytes to follow

my $row     = $_[0];                         # Zero indexed row
    my $col     = $_[1];                         # Zero indexed column
    my $xf      = _XF($self, $row, $col, $_[2]); # The cell format

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

my $header    = pack("vv",  $record, $length);
    my $data      = pack("vvv", $row, $col, $xf);

return 0;
}

###############################################################################
#
# write_formula($row, $col, $formula, $format, $value)
#
# Write a formula to the specified row and column (zero indexed).
# The textual representation of the formula is passed to the parser in
# Formula.pm which returns a packed binary string.
#
# $format is optional.
#
# $value is an optional result of the formula that can be supplied by the user.
#
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#
sub write_formula {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 3) { return -1 }   # Check the number of args

return if ! defined $_[2];

my $record    = 0x0006;     # Record identifier
    my $length;                 # Bytes to follow

my $row       = $_[0];      # Zero indexed row
    my $col       = $_[1];      # Zero indexed column
    my $formula   = $_[2];      # The formula text string
    my $value     = $_[4];      # The formula value.

my $xf        = _XF($self, $row, $col, $_[3]);  # The cell format
    my $chn       = 0x0000;                         # Must be zero
    my $is_string = 0;                              # Formula evaluates to str
    my $num;                                        # Current value of formula
    my $grbit;                                      # Option flags

# Excel normally stores the last calculated value of the formula in $num.
    # Clearly we are not in a position to calculate this "a priori". Instead
    # we set $num to zero and set the option flags in $grbit to ensure
    # automatic calculation of the formula when the file is opened.
    # As a workaround for some non-Excel apps we also allow the user to
    # specify the result of the formula.
    #
    ($num, $grbit, $is_string) = $self->_encode_formula_result($value);

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

# Strip the = sign at the beginning of the formula string
    $formula    =~ s(^=)();

my $tmp     = $formula;

# 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 { $formula = $parser->parse_formula($formula) };

if ($@) {
        $@ =~ s/\n$//;  # Strip the \n used in the Formula.pm die()
        croak $@;       # Re-raise the error
    }

my $formlen = length($formula); # Length of the binary string
       $length  = 0x16 + $formlen;  # Length of the record data

my $header  = pack("vv",    $record, $length);
    my $data    = pack("vvv",   $row, $col, $xf);
       $data   .= $num;
       $data   .= pack("vVv",   $grbit, $chn, $formlen);

# The STRING record if the formula evaluates to a string.
    my $string  = '';
       $string  = $self->_get_formula_string($value) if $is_string;

# Store the data or write immediately depending on the compatibility mode.
    if ($self->{_compatibility}) {
        $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
    }
    else {
        $self->_append($header, $data, $formula, $string);
    }

return 0;
}

###############################################################################
#
# _encode_formula_result()
#
# Encode the user supplied result for a formula.
#
sub _encode_formula_result {

my $self = shift;

my $value     = $_[0];      # Result to be encoded.
    my $is_string = 0;          # Formula evaluates to str.
    my $num;                    # Current value of formula.
    my $grbit;                  # Option flags.

if (not defined $value) {
        $grbit  = 0x03;
        $num    = pack "d", 0;
    }
    else {
        # The user specified the result of the formula. We turn off the recalc
        # flag and check the result type.
        $grbit  = 0x00;

if ($value =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
            # Value is a number.
            $num = pack "d", $value;
        }
        else {

my %bools = (
                            'TRUE'    => [1,  1],
                            'FALSE'   => [1,  0],
                            '#NULL!'  => [2,  0],
                            '#DIV/0!' => [2,  7],
                            '#VALUE!' => [2, 15],
                            '#REF!'   => [2, 23],
                            '#NAME?'  => [2, 29],
                            '#NUM!'   => [2, 36],
                            '#N/A'    => [2, 42],
                        );

if (exists $bools{$value}) {
                # Value is a boolean.
                $num = pack "vvvv", $bools{$value}->[0],
                                    $bools{$value}->[1],
                                    0,
                                    0xFFFF;
            }
            else {
                # Value is a string.
                $num = pack "vvvv", 0,
                                    0,
                                    0,
                                    0xFFFF;
                $is_string = 1;
            }
        }
    }

return ($num, $grbit, $is_string);
}

###############################################################################
#
# _get_formula_string()
#
# Pack the string value when a formula evaluates to a string. The value cannot
# be calculated by the module and thus must be supplied by the user.
#
sub _get_formula_string {

my $self = shift;

my $record    = 0x0207;         # Record identifier
    my $length    = 0x00;           # Bytes to follow
    my $string    = $_[0];          # Formula string.
    my $strlen    = length $_[0];   # Length of the formula string (chars).
    my $encoding  = 0;              # String encoding.

# Handle utf8 strings in perl 5.8.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($string)) {
            $string = Encode::encode("UTF-16BE", $string);
            $encoding = 1;
        }
    }

$length       = 0x03 + length $string;  # Length of the record data

my $header    = pack("vv", $record, $length);
    my $data      = pack("vC", $strlen, $encoding);

return $header . $data . $string;
}

###############################################################################
#
# store_formula($formula)
#
# Pre-parse a formula. This is used in conjunction with repeat_formula()
# to repetitively rewrite a formula without re-parsing it.
#
sub store_formula {

my $self    = shift;
    my $formula = $_[0];      # The formula text string

# 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.
    #
    my @tokens;
    eval { @tokens = $parser->parse_formula($formula) };

if ($@) {
        $@ =~ s/\n$//;  # Strip the \n used in the Formula.pm die()
        croak $@;       # Re-raise the error
    }

# Return the parsed tokens in an anonymous array
    return [@tokens];
}

###############################################################################
#
# repeat_formula($row, $col, $formula, $format, ($pattern => $replacement,...))
#
# Write a formula to the specified row and column (zero indexed) by
# substituting $pattern $replacement pairs in the $formula created via
# store_formula(). This allows the user to repetitively rewrite a formula
# without the significant overhead of parsing.
#
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#
sub repeat_formula {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 2) { return -1 }   # Check the number of args

my $record      = 0x0006;   # Record identifier
    my $length;                 # Bytes to follow

my $row         = shift;    # Zero indexed row
    my $col         = shift;    # Zero indexed column
    my $formula_ref = shift;    # Array ref with formula tokens
    my $format      = shift;    # XF format
    my @pairs       = @_;       # Pattern/replacement pairs

# Enforce an even number of arguments in the pattern/replacement list
    croak "Odd number of elements in pattern/replacement list" if @pairs %2;

# Check that $formula is an array ref
    croak "Not a valid formula" if ref $formula_ref ne 'ARRAY';

my @tokens  = @$formula_ref;

# Ensure that there are tokens to substitute
    croak "No tokens in formula" unless @tokens;

# As a temporary and undocumented measure we allow the user to specify the
    # result of the formula by appending a result => $value pair to the end
    # of the arguments.
    my $value = undef;
    if (@pairs && $pairs[-2] eq 'result') {
        $value = pop @pairs;
                 pop @pairs;
    }

while (@pairs) {
        my $pattern = shift @pairs;
        my $replace = shift @pairs;

foreach my $token (@tokens) {
            last if $token =~ s/$pattern/$replace/;
        }
    }

# Change the parameters in the formula cached by the Formula.pm object
    my $parser    = $self->{_parser};
    my $formula   = $parser->parse_tokens(@tokens);

croak "Unrecognised token in formula" unless defined $formula;

my $xf        = _XF($self, $row, $col, $format); # The cell format
    my $chn       = 0x0000;                          # Must be zero
    my $is_string = 0;                               # Formula evaluates to str
    my $num;                                         # Current value of formula
    my $grbit;                                       # Option flags

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

my $formlen   = length($formula); # Length of the binary string
    $length       = 0x16 + $formlen;  # Length of the record data

my $header    = pack("vv",    $record, $length);
    my $data      = pack("vvv",   $row, $col, $xf);
       $data     .= $num;
       $data     .= pack("vVv",   $grbit, $chn, $formlen);

# The STRING record if the formula evaluates to a string.
    my $string  = '';
       $string  = $self->_get_formula_string($value) if $is_string;

return 0;
}

###############################################################################
#
# write_url($row, $col, $url, $string, $format)
#
# Write a hyperlink. This is comprised of two elements: the visible label and
# the invisible link. The visible label is the same as the link unless an
# alternative string is specified.
#
# The parameters $string and $format are optional and their order is
# interchangeable for backward compatibility reasons.
#
# The hyperlink can be to a http, ftp, mail, internal sheet, or external
# directory url.
#
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#         -3 : long string truncated to 255 chars
#
sub write_url {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

# Check the number of args
    return -1 if @_ < 3;

# Add start row and col to arg list
    return $self->write_url_range($_[0], $_[1], @_);
}

###############################################################################
#
# write_url_range($row1, $col1, $row2, $col2, $url, $string, $format)
#
# This is the more general form of write_url(). It allows a hyperlink to be
# written to a range of cells. This function also decides the type of hyperlink
# to be written. These are either, Web (http, ftp, mailto), Internal
# (Sheet1!A1) or external ('c:\temp\foo.xls#Sheet1!A1').
#
# See also write_url() above for a general description and return values.
#
sub write_url_range {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

# Check the number of args
    return -1 if @_ < 5;

# Reverse the order of $string and $format if necessary. We work on a copy
    # in order to protect the callers args. We don't use "local @_" in case of
    # perl50005 threads.
    #
    my @args = @_;

($args[5], $args[6]) = ($args[6], $args[5]) if ref $args[5];

my $url = $args[4];

# Check for internal/external sheet links or default to web link
    return $self->_write_url_internal(@args) if $url =~ m[^internal:];
    return $self->_write_url_external(@args) if $url =~ m[^external:];
    return $self->_write_url_web(@args);
}

###############################################################################
#
# _write_url_web($row1, $col1, $row2, $col2, $url, $string, $format)
#
# Used to write http, ftp and mailto hyperlinks.
# The link type ($options) is 0x03 is the same as absolute dir ref without
# sheet. However it is differentiated by the $unknown2 data stream.
#
# See also write_url() above for a general description and return values.
#
sub _write_url_web {

my $self    = shift;

my $record      = 0x01B8;                       # Record identifier
    my $length      = 0x00000;                      # Bytes to follow

my $row1        = $_[0];                        # Start row
    my $col1        = $_[1];                        # Start column
    my $row2        = $_[2];                        # End row
    my $col2        = $_[3];                        # End column
    my $url         = $_[4];                        # URL string
    my $str         = $_[5];                        # Alternative label
    my $xf          = $_[6] || $self->{_url_format};# The cell format

# Write the visible label but protect against url recursion in write().
    $str                  = $url unless defined $str;
    $self->{_writing_url} = 1;
    my $error             = $self->write($row1, $col1, $str, $xf);
    $self->{_writing_url} = 0;
    return $error         if $error == -2;

# Pack the undocumented parts of the hyperlink stream
    my $unknown1    = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
    my $unknown2    = pack("H*", "E0C9EA79F9BACE118C8200AA004BA90B");

# Pack the option flags
    my $options     = pack("V", 0x03);

# URL encoding.
    my $encoding    = 0;

# Convert an Utf8 URL type and to a null terminated wchar string.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($url)) {
            $url      = Encode::encode("UTF-16LE", $url);
            $url     .= "\0\0"; # URL is null terminated.
            $encoding = 1;
        }
    }

# Convert an Ascii URL type and to a null terminated wchar string.
    if ($encoding == 0) {
        $url       .= "\0";
        $url        = pack 'v*', unpack 'c*', $url;
    }

# Pack the length of the URL
    my $url_len     = pack("V", length($url));

# Calculate the data length
    $length         = 0x34 + length($url);

# Pack the header data
    my $header      = pack("vv",   $record, $length);
    my $data        = pack("vvvv", $row1, $row2, $col1, $col2);

# Write the packed data
    $self->_append( $header,
                    $data,
                    $unknown1,
                    $options,
                    $unknown2,
                    $url_len,
                    $url);

return $error;
}

###############################################################################
#
# _write_url_internal($row1, $col1, $row2, $col2, $url, $string, $format)
#
# Used to write internal reference hyperlinks such as "Sheet1!A1".
#
# See also write_url() above for a general description and return values.
#
sub _write_url_internal {

my $self    = shift;

my $record      = 0x01B8;                       # Record identifier
    my $length      = 0x00000;                      # Bytes to follow

# Strip URL type
    $url            =~ s[^internal:][];

# Pack the undocumented parts of the hyperlink stream
    my $unknown1    = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");

# Pack the option flags
    my $options     = pack("V", 0x08);

# URL encoding.
    my $encoding    = 0;

# Convert an Utf8 URL type and to a null terminated wchar string.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($url)) {
            # Quote sheet name if not already, i.e., Sheet!A1 to 'Sheet!A1'.
            $url      =~ s/^(.+)!/'$1'!/ if not $url =~ /^'/;

$url      = Encode::encode("UTF-16LE", $url);
            $url     .= "\0\0"; # URL is null terminated.
            $encoding = 1;
        }
    }

# Convert an Ascii URL type and to a null terminated wchar string.
    if ($encoding == 0) {
        $url       .= "\0";
        $url        = pack 'v*', unpack 'c*', $url;
    }

# Pack the length of the URL as chars (not wchars)
    my $url_len     = pack("V", int(length($url)/2));

# Calculate the data length
    $length         = 0x24 + length($url);

# Pack the header data
    my $header      = pack("vv",   $record, $length);
    my $data        = pack("vvvv", $row1, $row2, $col1, $col2);

# Write the packed data
    $self->_append( $header,
                    $data,
                    $unknown1,
                    $options,
                    $url_len,
                    $url);

return $error;
}

###############################################################################
#
# _write_url_external($row1, $col1, $row2, $col2, $url, $string, $format)
#
# Write links to external directory names such as 'c:\foo.xls',
# c:\foo.xls#Sheet1!A1', '../../foo.xls'. and '../../foo.xls#Sheet1!A1'.
#
# Note: Excel writes some relative links with the $dir_long string. We ignore
# these cases for the sake of simpler code.
#
# See also write_url() above for a general description and return values.
#
sub _write_url_external {

my $self    = shift;

# Network drives are different. We will handle them separately
    # MS/Novell network drives and shares start with \\
    return $self->_write_url_external_net(@_) if $_[4] =~ m[^external:\\\\];

my $record      = 0x01B8;                       # Record identifier
    my $length      = 0x00000;                      # Bytes to follow

# Strip URL type and change Unix dir separator to Dos style (if needed)
    #
    $url            =~ s[^external:][];
    $url            =~ s[/][\\]g;

# Write the visible label but protect against url recursion in write().
    ($str = $url)         =~ s[\#][ - ] unless defined $str;
    $self->{_writing_url} = 1;
    my $error             = $self->write($row1, $col1, $str, $xf);
    $self->{_writing_url} = 0;
    return $error         if $error == -2;

# Determine if the link is relative or absolute:
    # Absolute if link starts with DOS drive specifier like C:
    # Otherwise default to 0x00 for relative link.
    #
    my $absolute    = 0x00;
       $absolute    = 0x02  if $url =~ m/^[A-Za-z]:/;

# Determine if the link contains a sheet reference and change some of the
    # parameters accordingly.
    # Split the dir name and sheet name (if it exists)
    #
    my ($dir_long , $sheet) = split /\#/, $url;
    my $link_type           = 0x01 | $absolute;
    my $sheet_len;

if (defined $sheet) {
        $link_type |= 0x08;
        $sheet_len  = pack("V", length($sheet) + 0x01);
        $sheet      = join("\0", split('', $sheet));
        $sheet     .= "\0\0\0";
    }
    else {
        $sheet_len  = '';
        $sheet      = '';
    }

# Pack the link type
    $link_type      = pack("V", $link_type);

# Calculate the up-level dir count e.g. (..\..\..\ == 3)
    my $up_count    = 0;
    $up_count++       while $dir_long =~ s[^\.\.\\][];
    $up_count       = pack("v", $up_count);

# Store the short dos dir name (null terminated)
    my $dir_short   = $dir_long . "\0";

# Store the long dir name as a wchar string (non-null terminated)
    $dir_long       = join("\0", split('', $dir_long));
    $dir_long       = $dir_long . "\0";

# Pack the lengths of the dir strings
    my $dir_short_len = pack("V", length $dir_short      );
    my $dir_long_len  = pack("V", length $dir_long       );
    my $stream_len    = pack("V", length($dir_long) + 0x06);

# Pack the undocumented parts of the hyperlink stream
    my $unknown1 =pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000'       );
    my $unknown2 =pack("H*",'0303000000000000C000000000000046'               );
    my $unknown3 =pack("H*",'FFFFADDE000000000000000000000000000000000000000');
    my $unknown4 =pack("v",  0x03                                            );

# Pack the main data stream
    my $data        = pack("vvvv", $row1, $row2, $col1, $col2) .
                      $unknown1     .
                      $link_type    .
                      $unknown2     .
                      $up_count     .
                      $dir_short_len.
                      $dir_short    .
                      $unknown3     .
                      $stream_len   .
                      $dir_long_len .
                      $unknown4     .
                      $dir_long     .
                      $sheet_len    .
                      $sheet        ;

# Pack the header data
    $length         = length $data;
    my $header      = pack("vv",   $record, $length);

# Write the packed data
    $self->_append($header, $data);

return $error;
}

###############################################################################
#
# _write_url_external_net($row1, $col1, $row2, $col2, $url, $string, $format)
#
# Write links to external MS/Novell network drives and shares such as
# '//NETWORK/share/foo.xls' and '//NETWORK/share/foo.xls#Sheet1!A1'.
#
# See also write_url() above for a general description and return values.
#
sub _write_url_external_net {

my $self    = shift;

my $record      = 0x01B8;                       # Record identifier
    my $length      = 0x00000;                      # Bytes to follow

# Strip URL type and change Unix dir separator to Dos style (if needed)
    #
    $url            =~ s[^external:][];
    $url            =~ s[/][\\]g;

# Pack the link type
    $link_type      = pack("V", $link_type);

# Make the string null terminated
    $dir_long       = $dir_long . "\0";

# Pack the lengths of the dir string
    my $dir_long_len  = pack("V", length $dir_long);

# Store the long dir name as a wchar string (non-null terminated)
    $dir_long       = join("\0", split('', $dir_long));
    $dir_long       = $dir_long . "\0";

# Pack the undocumented part of the hyperlink stream
    my $unknown1    = pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000');

# Pack the main data stream
    my $data        = pack("vvvv", $row1, $row2, $col1, $col2) .
                      $unknown1     .
                      $link_type    .
                      $dir_long_len .
                      $dir_long     .
                      $sheet_len    .
                      $sheet        ;

# Pack the header data
    $length         = length $data;
    my $header      = pack("vv",   $record, $length);

# Write the packed data
    $self->_append($header, $data);

return $error;
}

###############################################################################
#
# write_date_time ($row, $col, $string, $format)
#
# Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
# number representing an Excel date. $format is optional.
#
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#         -3 : Invalid date_time, written as string
#
sub write_date_time {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 3) { return -1 }                        # Check the number of args

my $row       = $_[0];                           # Zero indexed row
    my $col       = $_[1];                           # Zero indexed column
    my $str       = $_[2];

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

my $error     = 0;
    my $date_time = $self->convert_date_time($str);

if (defined $date_time) {
        $error = $self->write_number($row, $col, $date_time, $_[3]);
    }
    else {
        # The date isn't valid so write it as a string.
        $self->write_string($row, $col, $str, $_[3]);
        $error = -3;
    }
    return $error;
}

###############################################################################
#
# convert_date_time($date_time_string)
#
# The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
# and converts it to a decimal number representing a valid Excel date.
#
# Dates and times in Excel are represented by real numbers. The integer part of
# the number stores the number of days since the epoch and the fractional part
# stores the percentage of the day in seconds. The epoch can be either 1900 or
# 1904.
#
# Parameter: Date and time string in one of the following formats:
#               yyyy-mm-ddThh:mm:ss.ss  # Standard
#               yyyy-mm-ddT             # Date only
#                         Thh:mm:ss.ss  # Time only
#
# Returns:
#            A decimal number representing a valid Excel date, or
#            undef if the date is invalid.
#
sub convert_date_time {

my $self      = shift;
    my $date_time = $_[0];

my $days      = 0; # Number of days since epoch
    my $seconds   = 0; # Time expressed as fraction of 24h hours in seconds

my ($year, $month, $day);
    my ($hour, $min, $sec);

# Strip leading and trailing whitespace.
    $date_time =~ s/^\s+//;
    $date_time =~ s/\s+$//;

# Check for invalid date char.
    return if     $date_time =~ /[^0-9T:\-\.Z]/;

# Check for "T" after date or before time.
    return unless $date_time =~ /\dT|T\d/;

# Strip trailing Z in ISO8601 date.
    $date_time =~ s/Z$//;

# Split into date and time.
    my ($date, $time) = split /T/, $date_time;

# We allow the time portion of the input DateTime to be optional.
    if ($time ne '') {
        # Match hh:mm:ss.sss+ where the seconds are optional
        if ($time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/) {
            $hour   = $1;
            $min    = $2;
            $sec    = $4 || 0;
        }
        else {
            return undef; # Not a valid time format.
        }

# Some boundary checks
        return if $hour >= 24;
        return if $min  >= 60;
        return if $sec  >= 60;

# Excel expresses seconds as a fraction of the number in 24 hours.
        $seconds = ($hour *60*60 + $min *60 + $sec) / (24 *60 *60);
    }

# We allow the date portion of the input DateTime to be optional.
    return $seconds if $date eq '';

# Match date as yyyy-mm-dd.
    if ($date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
        $year   = $1;
        $month  = $2;
        $day    = $3;
    }
    else {
        return undef; # Not a valid date format.
    }

# Set the epoch as 1900 or 1904. Defaults to 1900.
    my $date_1904 = $self->{_1904};

# Special cases for Excel.
    if (not $date_1904) {
        return      $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
        return      $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
        return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
    }

# We calculate the date by calculating the number of days since the epoch
    # and adjust for the number of leap days. We calculate the number of leap
    # days by normalising the year in relation to the epoch. Thus the year 2000
    # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
    #
    my $epoch   = $date_1904 ? 1904 : 1900;
    my $offset  = $date_1904 ?    4 :    0;
    my $norm    = 300;
    my $range   = $year -$epoch;

# Set month days and check for leap year.
    my @mdays   = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
    my $leap    = 0;
       $leap    = 1  if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
    $mdays[1]   = 29 if $leap;

# Some boundary checks
    return if $year  < $epoch or $year  > 9999;
    return if $month < 1      or $month > 12;
    return if $day   < 1      or $day   > $mdays[$month -1];

# Accumulate the number of days since the epoch.
    $days  = $day;                              # Add days for current month
    $days += $mdays[$_] for 0 .. $month -2;     # Add days for past months
    $days += $range *365;                       # Add days for past years
    $days += int(($range)                /  4); # Add leapdays
    $days -= int(($range +$offset)       /100); # Subtract 100 year leapdays
    $days += int(($range +$offset +$norm)/400); # Add 400 year leapdays
    $days -= $leap;                             # Already counted above

# Adjust for Excel erroneously treating 1900 as a leap year.
    $days++ if $date_1904 == 0 and $days > 59;

return $days + $seconds;
}

###############################################################################
#
# set_row($row, $height, $XF, $hidden, $level)
#
# This method is used to set the height and XF format for a row.
# Writes the  BIFF record ROW.
#
sub set_row {

my $self        = shift;
    my $record      = 0x0208;               # Record identifier
    my $length      = 0x0010;               # Number of bytes to follow

my $row         = $_[0];                # Row Number
    my $colMic      = 0x0000;               # First defined column
    my $colMac      = 0x0000;               # Last defined column
    my $miyRw;                              # Row height
    my $irwMac      = 0x0000;               # Used by Excel to optimise loading
    my $reserved    = 0x0000;               # Reserved
    my $grbit       = 0x0000;               # Option flags
    my $ixfe;                               # XF index
    my $height      = $_[1];                # Row height
    my $format      = $_[2];                # Format object
    my $hidden      = $_[3] || 0;           # Hidden flag
    my $level       = $_[4] || 0;           # Outline level
    my $collapsed   = $_[5] || 0;           # Collapsed row

return unless defined $row;  # Ensure at least $row is specified.

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, 0, 0, 1);

# Check for a format object
    if (ref $format) {
        $ixfe = $format->get_xf_index();
    }
    else {
        $ixfe = 0x0F;
    }

# Set the row height in units of 1/20 of a point. Note, some heights may
    # not be obtained exactly due to rounding in Excel.
    #
    if (defined $height) {
        $miyRw = $height *20;
    }
    else {
        $miyRw = 0xff; # The default row height
        $height = 0;
    }

# Set the limits for the outline levels (0 <= x <= 7).
    $level = 0 if $level < 0;
    $level = 7 if $level > 7;

$self->{_outline_row_level} = $level if $level >$self->{_outline_row_level};

# Set the options flags.
    # 0x10: The fCollapsed flag indicates that the row contains the "+"
    #       when an outline group is collapsed.
    # 0x20: The fDyZero height flag indicates a collapsed or hidden row.
    # 0x40: The fUnsynced flag is used to show that the font and row heights
    #       are not compatible. This is usually the case for WriteExcel.
    # 0x80: The fGhostDirty flag indicates that the row has been formatted.
    #
    $grbit |= $level;
    $grbit |= 0x0010 if $collapsed;
    $grbit |= 0x0020 if $hidden;
    $grbit |= 0x0040;
    $grbit |= 0x0080 if $format;
    $grbit |= 0x0100;

my $header   = pack("vv",       $record, $length);
    my $data     = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
                                    $irwMac,$reserved, $grbit, $ixfe);

# Store the data or write immediately depending on the compatibility mode.
    if ($self->{_compatibility}) {
        $self->{_row_data}->{$_[0]} = $header . $data;
    }
    else {
        $self->_append($header, $data);
    }

# Store the row sizes for use when calculating image vertices.
    # Also store the row formats.
    $self->{_row_sizes}->{$_[0]}   = $height;
    $self->{_row_formats}->{$_[0]} = $format if defined $format;
}

###############################################################################
#
# _write_row_default()
#
# Write a default row record, in compatibility mode, for rows that don't have
# user specified values..
#
sub _write_row_default {

my $self        = shift;
    my $record      = 0x0208;               # Record identifier
    my $length      = 0x0010;               # Number of bytes to follow

my $row         = $_[0];                # Row Number
    my $colMic      = $_[1];                # First defined column
    my $colMac      = $_[2];                # Last defined column
    my $miyRw       = 0xFF;                 # Row height
    my $irwMac      = 0x0000;               # Used by Excel to optimise loading
    my $reserved    = 0x0000;               # Reserved
    my $grbit       = 0x0100;               # Option flags
    my $ixfe        = 0x0F;                 # XF index

my $header   = pack("vv",       $record, $length);
    my $data     = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
                                    $irwMac,$reserved, $grbit, $ixfe);

$self->_append($header, $data);
}

###############################################################################
#
# _check_dimensions($row, $col, $ignore_row, $ignore_col)
#
# Check that $row and $col are valid and store max and min values for use in
# DIMENSIONS record. See, _store_dimensions().
#
# The $ignore_row/$ignore_col flags is used to indicate that we wish to
# perform the dimension check without storing the value.
#
# The ignore flags are use by set_row() and data_validate.
#
sub _check_dimensions {

my $self        = shift;
    my $row         = $_[0];
    my $col         = $_[1];
    my $ignore_row  = $_[2];
    my $ignore_col  = $_[3];

return -2 if not defined $row;
    return -2 if $row >= $self->{_xls_rowmax};

return -2 if not defined $col;
    return -2 if $col >= $self->{_xls_colmax};

if (not $ignore_row) {

if (not defined $self->{_dim_rowmin} or $row < $self->{_dim_rowmin}) {
            $self->{_dim_rowmin} = $row;
        }

if (not defined $self->{_dim_rowmax} or $row > $self->{_dim_rowmax}) {
            $self->{_dim_rowmax} = $row;
        }
    }

if (not $ignore_col) {

if (not defined $self->{_dim_colmin} or $col < $self->{_dim_colmin}) {
            $self->{_dim_colmin} = $col;
        }

if (not defined $self->{_dim_colmax} or $col > $self->{_dim_colmax}) {
            $self->{_dim_colmax} = $col;
        }
    }

return 0;
}

###############################################################################
#
# _store_dimensions()
#
# Writes Excel DIMENSIONS to define the area in which there is cell data.
#
# Notes:
#   Excel stores the max row/col as row/col +1.
#   Max and min values of 0 are used to indicate that no cell data.
#   We set the undef member data to 0 since it is used by _store_table().
#   Inserting images or charts doesn't change the DIMENSION data.
#
sub _store_dimensions {

my $self      = shift;
    my $record    = 0x0200;         # Record identifier
    my $length    = 0x000E;         # Number of bytes to follow
    my $row_min;                    # First row
    my $row_max;                    # Last row plus 1
    my $col_min;                    # First column
    my $col_max;                    # Last column plus 1
    my $reserved  = 0x0000;         # Reserved by Excel

if (defined $self->{_dim_rowmin}) {$row_min = $self->{_dim_rowmin}    }
    else                              {$row_min = 0                       }

if (defined $self->{_dim_rowmax}) {$row_max = $self->{_dim_rowmax} + 1}
    else                              {$row_max = 0                       }

if (defined $self->{_dim_colmin}) {$col_min = $self->{_dim_colmin}    }
    else                              {$col_min = 0                       }

if (defined $self->{_dim_colmax}) {$col_max = $self->{_dim_colmax} + 1}
    else                              {$col_max = 0                       }

# Set member data to the new max/min value for use by _store_table().
    $self->{_dim_rowmin} = $row_min;
    $self->{_dim_rowmax} = $row_max;
    $self->{_dim_colmin} = $col_min;
    $self->{_dim_colmax} = $col_max;

my $header    = pack("vv",    $record, $length);
    my $data      = pack("VVvvv", $row_min, $row_max,
                                  $col_min, $col_max, $reserved);
    $self->_prepend($header, $data);
}

###############################################################################
#
# _store_window2()
#
# Write BIFF record Window2.
#
sub _store_window2 {

use integer;    # Avoid << shift bug in Perl 5.6.0 on HP-UX

my $self           = shift;
    my $record         = 0x023E;     # Record identifier
    my $length         = 0x0012;     # Number of bytes to follow

my $grbit          = 0x00B6;     # Option flags
    my $rwTop          = $self->{_first_row};   # Top visible row
    my $colLeft        = $self->{_first_col};   # Leftmost visible column
    my $rgbHdr         = 0x00000040;            # Row/col heading, grid color

my $wScaleSLV      = 0x0000;                # Zoom in page break preview
    my $wScaleNormal   = 0x0000;                # Zoom in normal view
    my $reserved       = 0x00000000;

# The options flags that comprise $grbit
    my $fDspFmla       = $self->{_display_formulas}; # 0 - bit
    my $fDspGrid       = $self->{_screen_gridlines}; # 1
    my $fDspRwCol      = $self->{_display_headers};  # 2
    my $fFrozen        = $self->{_frozen};           # 3
    my $fDspZeros      = $self->{_display_zeros};    # 4
    my $fDefaultHdr    = 1;                          # 5
    my $fArabic        = $self->{_display_arabic};   # 6
    my $fDspGuts       = $self->{_outline_on};       # 7
    my $fFrozenNoSplit = $self->{_frozen_no_split};  # 0 - bit
    my $fSelected      = $self->{_selected};         # 1
    my $fPaged         = $self->{_active};           # 2
    my $fBreakPreview  = 0;                          # 3

my $header  = pack("vv",      $record, $length);
    my $data    = pack("vvvVvvV", $grbit, $rwTop, $colLeft, $rgbHdr,
                                  $wScaleSLV, $wScaleNormal, $reserved );

$self->_append($header, $data);
}

###############################################################################
#
# _store_page_view()
#
# Set page view mode. Only applicable to Mac Excel.
#
sub _store_page_view {

my $self    = shift;

return unless $self->{_page_view};

my $data    = pack "H*", 'C8081100C808000000000040000000000900000000';

$self->_append($data);
}

###############################################################################
#
# _store_tab_color()
#
# Write the Tab Color BIFF record.
#
sub _store_tab_color {

my $self    = shift;
    my $color   = $self->{_tab_color};

return unless $color;

my $record  = 0x0862;      # Record identifier
    my $length  = 0x0014;      # Number of bytes to follow

my $zero    = 0x0000;
    my $unknown = 0x0014;

my $header  = pack("vv", $record, $length);
    my $data    = pack("vvvvvvvvvv", $record, $zero, $zero, $zero, $zero,
                                     $zero, $unknown, $zero, $color, $zero);

$self->_append($header, $data);
}

###############################################################################
#
# _store_defrow()
#
# Write BIFF record DEFROWHEIGHT.
#
sub _store_defrow {

my $self     = shift;
    my $record   = 0x0225;      # Record identifier
    my $length   = 0x0004;      # Number of bytes to follow

my $grbit    = 0x0000;      # Options.
    my $height   = 0x00FF;      # Default row height

my $header   = pack("vv", $record, $length);
    my $data     = pack("vv", $grbit,  $height);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_defcol()
#
# Write BIFF record DEFCOLWIDTH.
#
sub _store_defcol {

my $self     = shift;
    my $record   = 0x0055;      # Record identifier
    my $length   = 0x0002;      # Number of bytes to follow

my $colwidth = 0x0008;      # Default column width

my $header   = pack("vv", $record, $length);
    my $data     = pack("v",  $colwidth);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_colinfo($firstcol, $lastcol, $width, $format, $hidden)
#
# Write BIFF record COLINFO to define column widths
#
# Note: The SDK says the record length is 0x0B but Excel writes a 0x0C
# length record.
#
sub _store_colinfo {

my $self     = shift;
    my $record   = 0x007D;          # Record identifier
    my $length   = 0x000B;          # Number of bytes to follow

my $colFirst = $_[0] || 0;      # First formatted column
    my $colLast  = $_[1] || 0;      # Last formatted column
    my $width    = $_[2] || 8.43;   # Col width in user units, 8.43 is default
    my $coldx;                      # Col width in internal units
    my $pixels;                     # Col width in pixels

# Excel rounds the column width to the nearest pixel. Therefore we first
    # convert to pixels and then to the internal units. The pixel to users-units
    # relationship is different for values less than 1.
    #
    if ($width < 1) {
        $pixels = int($width *12);
    }
    else {
        $pixels = int($width *7 ) +5;
    }

$coldx = int($pixels *256/7);

my $ixfe;                          # XF index
    my $grbit       = 0x0000;          # Option flags
    my $reserved    = 0x00;            # Reserved
    my $format      = $_[3];           # Format object
    my $hidden      = $_[4] || 0;      # Hidden flag
    my $level       = $_[5] || 0;      # Outline level
    my $collapsed   = $_[6] || 0;      # Outline level

# Check for a format object
    if (ref $format) {
        $ixfe = $format->get_xf_index();
    }
    else {
        $ixfe = 0x0F;
    }

# Set the limits for the outline levels (0 <= x <= 7).
    $level = 0 if $level < 0;
    $level = 7 if $level > 7;

# Set the options flags. (See set_row() for more details).
    $grbit |= 0x0001 if $hidden;
    $grbit |= $level << 8;
    $grbit |= 0x1000 if $collapsed;

my $header   = pack("vv",     $record, $length);
    my $data     = pack("vvvvvC", $colFirst, $colLast, $coldx,
                                  $ixfe, $grbit, $reserved);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_filtermode()
#
# Write BIFF record FILTERMODE to indicate that the worksheet contains
# AUTOFILTER record, ie. autofilters with a filter set.
#
sub _store_filtermode {

my $self        = shift;

my $record      = 0x009B;      # Record identifier
    my $length      = 0x0000;      # Number of bytes to follow

# Only write the record if the worksheet contains a filtered autofilter.
    return unless $self->{_filter_on};

my $header   = pack("vv", $record, $length);

$self->_prepend($header);
}

###############################################################################
#
# _store_autofilterinfo()
#
# Write BIFF record AUTOFILTERINFO.
#
sub _store_autofilterinfo {

my $self        = shift;

my $record      = 0x009D;      # Record identifier
    my $length      = 0x0002;      # Number of bytes to follow
    my $num_filters = $self->{_filter_count};

# Only write the record if the worksheet contains an autofilter.
    return unless $self->{_filter_count};

my $header   = pack("vv", $record, $length);
    my $data     = pack("v",  $num_filters);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_selection($first_row, $first_col, $last_row, $last_col)
#
# Write BIFF record SELECTION.
#
sub _store_selection {

my $self     = shift;
    my $record   = 0x001D;                  # Record identifier
    my $length   = 0x000F;                  # Number of bytes to follow

my $pnn      = $self->{_active_pane};   # Pane position
    my $rwAct    = $_[0];                   # Active row
    my $colAct   = $_[1];                   # Active column
    my $irefAct  = 0;                       # Active cell ref
    my $cref     = 1;                       # Number of refs

my $rwFirst  = $_[0];                   # First row in reference
    my $colFirst = $_[1];                   # First col in reference
    my $rwLast   = $_[2] || $rwFirst;       # Last  row in reference
    my $colLast  = $_[3] || $colFirst;      # Last  col in reference

# Swap last row/col for first row/col as necessary
    if ($rwFirst > $rwLast) {
        ($rwFirst, $rwLast) = ($rwLast, $rwFirst);
    }

if ($colFirst > $colLast) {
        ($colFirst, $colLast) = ($colLast, $colFirst);
    }

my $header   = pack("vv",           $record, $length);
    my $data     = pack("CvvvvvvCC",    $pnn, $rwAct, $colAct,
                                        $irefAct, $cref,
                                        $rwFirst, $rwLast,
                                        $colFirst, $colLast);

$self->_append($header, $data);
}

###############################################################################
#
# _store_externcount($count)
#
# Write BIFF record EXTERNCOUNT to indicate the number of external sheet
# references in a worksheet.
#
# Excel only stores references to external sheets that are used in formulas.
# For simplicity we store references to all the sheets in the workbook
# regardless of whether they are used or not. This reduces the overall
# complexity and eliminates the need for a two way dialogue between the formula
# parser the worksheet objects.
#
sub _store_externcount {

my $self     = shift;
    my $record   = 0x0016;          # Record identifier
    my $length   = 0x0002;          # Number of bytes to follow

my $cxals    = $_[0];           # Number of external references

my $header   = pack("vv", $record, $length);
    my $data     = pack("v",  $cxals);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_externsheet($sheetname)
#
#
# Writes the Excel BIFF EXTERNSHEET record. These references are used by
# formulas. A formula references a sheet name via an index. Since we store a
# reference to all of the external worksheets the EXTERNSHEET index is the same
# as the worksheet index.
#
sub _store_externsheet {

my $self      = shift;

my $record    = 0x0017;         # Record identifier
    my $length;                     # Number of bytes to follow

my $sheetname = $_[0];          # Worksheet name
    my $cch;                        # Length of sheet name
    my $rgch;                       # Filename encoding

# References to the current sheet are encoded differently to references to
    # external sheets.
    #
    if ($self->{_name} eq $sheetname) {
        $sheetname = '';
        $length    = 0x02;  # The following 2 bytes
        $cch       = 1;     # The following byte
        $rgch      = 0x02;  # Self reference
    }
    else {
        $length    = 0x02 + length($_[0]);
        $cch       = length($sheetname);
        $rgch      = 0x03;  # Reference to a sheet in the current workbook
    }

my $header     = pack("vv",  $record, $length);
    my $data       = pack("CC", $cch, $rgch);

$self->_prepend($header, $data, $sheetname);
}

###############################################################################
#
# _store_panes()
#
#
# Writes the Excel BIFF PANE record.
# The panes can either be frozen or thawed (unfrozen).
# Frozen panes are specified in terms of a integer number of rows and columns.
# Thawed panes are specified in terms of Excel's units for rows and columns.
#
sub _store_panes {

my $self        = shift;
    my $record      = 0x0041;       # Record identifier
    my $length      = 0x000A;       # Number of bytes to follow

my $y           = $_[0] || 0;   # Vertical split position
    my $x           = $_[1] || 0;   # Horizontal split position
    my $rwTop       = $_[2];        # Top row visible
    my $colLeft     = $_[3];        # Leftmost column visible
    my $no_split    = $_[4];        # No used here.
    my $pnnAct      = $_[5];        # Active pane

# Code specific to frozen or thawed panes.
    if ($self->{_frozen}) {
        # Set default values for $rwTop and $colLeft
        $rwTop   = $y unless defined $rwTop;
        $colLeft = $x unless defined $colLeft;
    }
    else {
        # Set default values for $rwTop and $colLeft
        $rwTop   = 0  unless defined $rwTop;
        $colLeft = 0  unless defined $colLeft;

# Convert Excel's row and column units to the internal units.
        # The default row height is 12.75
        # The default column width is 8.43
        # The following slope and intersection values were interpolated.
        #
        $y = 20*$y      + 255;
        $x = 113.879*$x + 390;
    }

# Determine which pane should be active. There is also the undocumented
    # option to override this should it be necessary: may be removed later.
    #
    if (not defined $pnnAct) {
        $pnnAct = 0 if ($x != 0 && $y != 0); # Bottom right
        $pnnAct = 1 if ($x != 0 && $y == 0); # Top right
        $pnnAct = 2 if ($x == 0 && $y != 0); # Bottom left
        $pnnAct = 3 if ($x == 0 && $y == 0); # Top left
    }

$self->{_active_pane} = $pnnAct; # Used in _store_selection

my $header     = pack("vv",    $record, $length);
    my $data       = pack("vvvvv", $x, $y, $rwTop, $colLeft, $pnnAct);

$self->_append($header, $data);
}

###############################################################################
#
# _store_setup()
#
# Store the page setup SETUP BIFF record.
#
sub _store_setup {

use integer;    # Avoid << shift bug in Perl 5.6.0 on HP-UX

my $self         = shift;
    my $record       = 0x00A1;                  # Record identifier
    my $length       = 0x0022;                  # Number of bytes to follow

my $iPaperSize   = $self->{_paper_size};    # Paper size
    my $iScale       = $self->{_print_scale};   # Print scaling factor
    my $iPageStart   = $self->{_page_start};    # Starting page number
    my $iFitWidth    = $self->{_fit_width};     # Fit to number of pages wide
    my $iFitHeight   = $self->{_fit_height};    # Fit to number of pages high
    my $grbit        = 0x00;                    # Option flags
    my $iRes         = 0x0258;                  # Print resolution
    my $iVRes        = 0x0258;                  # Vertical print resolution
    my $numHdr       = $self->{_margin_header}; # Header Margin
    my $numFtr       = $self->{_margin_footer}; # Footer Margin
    my $iCopies      = 0x01;                    # Number of copies

my $fLeftToRight = $self->{_page_order};    # Print over then down
    my $fLandscape   = $self->{_orientation};   # Page orientation
    my $fNoPls       = 0x0;                     # Setup not read from printer
    my $fNoColor     = $self->{_black_white};   # Print black and white
    my $fDraft       = $self->{_draft_quality}; # Print draft quality
    my $fNotes       = $self->{_print_comments};# Print notes
    my $fNoOrient    = 0x0;                     # Orientation not set
    my $fUsePage     = $self->{_custom_start};  # Use custom starting page

$numHdr = pack("d", $numHdr);
    $numFtr = pack("d", $numFtr);

if ($self->{_byte_order}) {
        $numHdr = reverse $numHdr;
        $numFtr = reverse $numFtr;
    }

my $header = pack("vv",         $record, $length);
    my $data1  = pack("vvvvvvvv",   $iPaperSize,
                                    $iScale,
                                    $iPageStart,
                                    $iFitWidth,
                                    $iFitHeight,
                                    $grbit,
                                    $iRes,
                                    $iVRes);
    my $data2  = $numHdr .$numFtr;
    my $data3  = pack("v", $iCopies);

$self->_prepend($header, $data1, $data2, $data3);

}

###############################################################################
#
# _store_header()
#
# Store the header caption BIFF record.
#
sub _store_header {

my $self        = shift;

my $record      = 0x0014;                       # Record identifier
    my $length;                                     # Bytes to follow

my $str         = $self->{_header};             # header string
    my $cch         = length($str);                 # Length of header string
    my $encoding    = $self->{_header_encoding};    # Character encoding

# Character length is num of chars not num of bytes
    $cch           /= 2 if $encoding;

# Change the UTF-16 name from BE to LE
    $str            = pack 'n*', unpack 'v*', $str if $encoding;

$length         = 3 + length($str);

my $header      = pack("vv",  $record, $length);
    my $data        = pack("vC",  $cch, $encoding);

$self->_prepend($header, $data, $str);
}

###############################################################################
#
# _store_footer()
#
# Store the footer caption BIFF record.
#
sub _store_footer {

my $self        = shift;

my $record      = 0x0015;                       # Record identifier
    my $length;                                     # Bytes to follow

my $str         = $self->{_footer};             # footer string
    my $cch         = length($str);                 # Length of footer string
    my $encoding    = $self->{_footer_encoding};    # Character encoding

# Character length is num of chars not num of bytes
    $cch           /= 2 if $encoding;

# Change the UTF-16 name from BE to LE
    $str            = pack 'n*', unpack 'v*', $str if $encoding;

$length         = 3 + length($str);

my $header      = pack("vv",  $record, $length);
    my $data        = pack("vC",  $cch, $encoding);

$self->_prepend($header, $data, $str);
}

###############################################################################
#
# _store_hcenter()
#
# Store the horizontal centering HCENTER BIFF record.
#
sub _store_hcenter {

my $self     = shift;

my $record   = 0x0083;              # Record identifier
    my $length   = 0x0002;              # Bytes to follow

my $fHCenter = $self->{_hcenter};   # Horizontal centering

my $header    = pack("vv",  $record, $length);
    my $data      = pack("v",   $fHCenter);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_vcenter()
#
# Store the vertical centering VCENTER BIFF record.
#
sub _store_vcenter {

my $self     = shift;

my $record   = 0x0084;              # Record identifier
    my $length   = 0x0002;              # Bytes to follow

my $fVCenter = $self->{_vcenter};   # Horizontal centering

my $header    = pack("vv",  $record, $length);
    my $data      = pack("v",   $fVCenter);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_margin_left()
#
# Store the LEFTMARGIN BIFF record.
#
sub _store_margin_left {

my $self    = shift;

my $record  = 0x0026;                   # Record identifier
    my $length  = 0x0008;                   # Bytes to follow

my $margin  = $self->{_margin_left};    # Margin in inches

my $header    = pack("vv",  $record, $length);
    my $data      = pack("d",   $margin);

if ($self->{_byte_order}) { $data = reverse $data }

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_margin_right()
#
# Store the RIGHTMARGIN BIFF record.
#
sub _store_margin_right {

my $self    = shift;

my $record  = 0x0027;                   # Record identifier
    my $length  = 0x0008;                   # Bytes to follow

my $margin  = $self->{_margin_right};   # Margin in inches

my $header    = pack("vv",  $record, $length);
    my $data      = pack("d",   $margin);

if ($self->{_byte_order}) { $data = reverse $data }

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_margin_top()
#
# Store the TOPMARGIN BIFF record.
#
sub _store_margin_top {

my $self    = shift;

my $record  = 0x0028;                   # Record identifier
    my $length  = 0x0008;                   # Bytes to follow

my $margin  = $self->{_margin_top};     # Margin in inches

my $header    = pack("vv",  $record, $length);
    my $data      = pack("d",   $margin);

if ($self->{_byte_order}) { $data = reverse $data }

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_margin_bottom()
#
# Store the BOTTOMMARGIN BIFF record.
#
sub _store_margin_bottom {

my $self    = shift;

my $record  = 0x0029;                   # Record identifier
    my $length  = 0x0008;                   # Bytes to follow

my $margin  = $self->{_margin_bottom};  # Margin in inches

my $header    = pack("vv",  $record, $length);
    my $data      = pack("d",   $margin);

if ($self->{_byte_order}) { $data = reverse $data }

$self->_prepend($header, $data);
}

###############################################################################
#
# merge_cells($first_row, $first_col, $last_row, $last_col)
#
# This is an Excel97/2000 method. It is required to perform more complicated
# merging than the normal align merge in Format.pm
#
sub merge_cells {

my $self    = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

my $record  = 0x00E5;                   # Record identifier
    my $length  = 0x000A;                   # Bytes to follow

my $cref     = 1;                       # Number of refs
    my $rwFirst  = $_[0];                   # First row in reference
    my $colFirst = $_[1];                   # First col in reference
    my $rwLast   = $_[2] || $rwFirst;       # Last  row in reference
    my $colLast  = $_[3] || $colFirst;      # Last  col in reference

# Excel doesn't allow a single cell to be merged
    return if $rwFirst == $rwLast and $colFirst == $colLast;

# Swap last row/col with first row/col as necessary
    ($rwFirst,  $rwLast ) = ($rwLast,  $rwFirst ) if $rwFirst  > $rwLast;
    ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;

my $header   = pack("vv",       $record, $length);
    my $data     = pack("vvvvv",    $cref,
                                    $rwFirst, $rwLast,
                                    $colFirst, $colLast);

$self->_append($header, $data);
}

###############################################################################
#
# merge_range($row1, $col1, $row2, $col2, $string, $format, $encoding)
#
# This is a wrapper to ensure correct use of the merge_cells method, i.e., write
# the first cell of the range, write the formatted blank cells in the range and
# then call the merge_cells record. Failing to do the steps in this order will
# cause Excel 97 to crash.
#
sub merge_range {

my $self    = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }
    croak "Incorrect number of arguments" if @_ != 6 and @_ != 7;
    croak "Format argument is not a format object" unless ref $_[5];

my $rwFirst  = $_[0];
    my $colFirst = $_[1];
    my $rwLast   = $_[2];
    my $colLast  = $_[3];
    my $string   = $_[4];
    my $format   = $_[5];
    my $encoding = $_[6] ? 1 : 0;

# Temp code to prevent merged formats in non-merged cells.
    my $error = "Error: refer to merge_range() in the documentation. " .
                "Can't use previously non-merged format in merged cells";

croak $error if $format->{_used_merge} == -1;
    $format->{_used_merge} = 0; # Until the end of this function.

# Set the merge_range property of the format object. For BIFF8+.
    $format->set_merge_range();

# Excel doesn't allow a single cell to be merged
    croak "Can't merge single cell" if $rwFirst  == $rwLast and
                                       $colFirst == $colLast;

# Write the first cell
    if ($encoding) {
        $self->write_utf16be_string($rwFirst, $colFirst, $string, $format);
    }
    else {
        $self->write               ($rwFirst, $colFirst, $string, $format);
    }

# Pad out the rest of the area with formatted blank cells.
    for my $row ($rwFirst .. $rwLast) {
        for my $col ($colFirst .. $colLast) {
            next if $row == $rwFirst and $col == $colFirst;
            $self->write_blank($row, $col, $format);
        }
    }

$self->merge_cells($rwFirst, $colFirst, $rwLast, $colLast);

# Temp code to prevent merged formats in non-merged cells.
    $format->{_used_merge} = 1;

}

###############################################################################
#
# _store_print_headers()
#
# Write the PRINTHEADERS BIFF record.
#
sub _store_print_headers {

my $self        = shift;

my $record      = 0x002a;                   # Record identifier
    my $length      = 0x0002;                   # Bytes to follow

my $fPrintRwCol = $self->{_print_headers};  # Boolean flag

my $header      = pack("vv",  $record, $length);
    my $data        = pack("v",   $fPrintRwCol);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_print_gridlines()
#
# Write the PRINTGRIDLINES BIFF record. Must be used in conjunction with the
# GRIDSET record.
#
sub _store_print_gridlines {

my $self        = shift;

my $record      = 0x002b;                    # Record identifier
    my $length      = 0x0002;                    # Bytes to follow

my $fPrintGrid  = $self->{_print_gridlines}; # Boolean flag

my $header      = pack("vv",  $record, $length);
    my $data        = pack("v",   $fPrintGrid);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_gridset()
#
# Write the GRIDSET BIFF record. Must be used in conjunction with the
# PRINTGRIDLINES record.
#
sub _store_gridset {

my $self        = shift;

my $record      = 0x0082;                        # Record identifier
    my $length      = 0x0002;                        # Bytes to follow

my $fGridSet    = not $self->{_print_gridlines}; # Boolean flag

my $header      = pack("vv",  $record, $length);
    my $data        = pack("v",   $fGridSet);

$self->_prepend($header, $data);

}

###############################################################################
#
# _store_guts()
#
# Write the GUTS BIFF record. This is used to configure the gutter margins
# where Excel outline symbols are displayed. The visibility of the gutters is
# controlled by a flag in WSBOOL. See also _store_wsbool().
#
# We are all in the gutter but some of us are looking at the stars.
#
sub _store_guts {

my $self        = shift;

my $record      = 0x0080;   # Record identifier
    my $length      = 0x0008;   # Bytes to follow

my $dxRwGut     = 0x0000;   # Size of row gutter
    my $dxColGut    = 0x0000;   # Size of col gutter

my $row_level   = $self->{_outline_row_level};
    my $col_level   = 0;

# Calculate the maximum column outline level. The equivalent calculation
    # for the row outline level is carried out in set_row().
    #
    foreach my $colinfo (@{$self->{_colinfo}}) {
        # Skip cols without outline level info.
        next if @{$colinfo} < 6;
        $col_level = @{$colinfo}[5] if @{$colinfo}[5] > $col_level;
    }

# Set the limits for the outline levels (0 <= x <= 7).
    $col_level = 0 if $col_level < 0;
    $col_level = 7 if $col_level > 7;

# The displayed level is one greater than the max outline levels
    $row_level++ if $row_level > 0;
    $col_level++ if $col_level > 0;

my $header      = pack("vv",   $record, $length);
    my $data        = pack("vvvv", $dxRwGut, $dxColGut, $row_level, $col_level);

$self->_prepend($header, $data);

}

###############################################################################
#
# _store_wsbool()
#
# Write the WSBOOL BIFF record, mainly for fit-to-page. Used in conjunction
# with the SETUP record.
#
sub _store_wsbool {

my $self        = shift;

my $record      = 0x0081;   # Record identifier
    my $length      = 0x0002;   # Bytes to follow

my $grbit       = 0x0000;   # Option flags

# Set the option flags
    $grbit |= 0x0001;                            # Auto page breaks visible
    $grbit |= 0x0020 if $self->{_outline_style}; # Auto outline styles
    $grbit |= 0x0040 if $self->{_outline_below}; # Outline summary below
    $grbit |= 0x0080 if $self->{_outline_right}; # Outline summary right
    $grbit |= 0x0100 if $self->{_fit_page};      # Page setup fit to page
    $grbit |= 0x0400 if $self->{_outline_on};    # Outline symbols displayed

my $header      = pack("vv",  $record, $length);
    my $data        = pack("v",   $grbit);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_hbreak()
#
# Write the HORIZONTALPAGEBREAKS BIFF record.
#
sub _store_hbreak {

my $self    = shift;

# Return if the user hasn't specified pagebreaks
    return unless @{$self->{_hbreaks}};

# Sort and filter array of page breaks
    my @breaks  = $self->_sort_pagebreaks(@{$self->{_hbreaks}});

my $record  = 0x001b;               # Record identifier
    my $cbrk    = scalar @breaks;       # Number of page breaks
    my $length  = 2 + 6*$cbrk;          # Bytes to follow

my $header  = pack("vv",  $record, $length);
    my $data    = pack("v",   $cbrk);

# Append each page break
    foreach my $break (@breaks) {
        $data .= pack("vvv", $break, 0x0000, 0x00ff);
    }

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_vbreak()
#
# Write the VERTICALPAGEBREAKS BIFF record.
#
sub _store_vbreak {

my $self    = shift;

# Return if the user hasn't specified pagebreaks
    return unless @{$self->{_vbreaks}};

# Sort and filter array of page breaks
    my @breaks  = $self->_sort_pagebreaks(@{$self->{_vbreaks}});

my $record  = 0x001a;               # Record identifier
    my $cbrk    = scalar @breaks;       # Number of page breaks
    my $length  = 2 + 6*$cbrk;          # Bytes to follow

my $header  = pack("vv",  $record, $length);
    my $data    = pack("v",   $cbrk);

# Append each page break
    foreach my $break (@breaks) {
        $data .= pack("vvv", $break, 0x0000, 0xffff);
    }

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_protect()
#
# Set the Biff PROTECT record to indicate that the worksheet is protected.
#
sub _store_protect {

my $self        = shift;

# Exit unless sheet protection has been specified
    return unless $self->{_protect};

my $record      = 0x0012;               # Record identifier
    my $length      = 0x0002;               # Bytes to follow

my $fLock       = $self->{_protect};    # Worksheet is protected

my $header      = pack("vv", $record, $length);
    my $data        = pack("v",  $fLock);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_obj_protect()
#
# Set the Biff OBJPROTECT record to indicate that objects are protected.
#
sub _store_obj_protect {

my $self        = shift;

# Exit unless sheet protection has been specified
    return unless $self->{_protect};

my $record      = 0x0063;               # Record identifier
    my $length      = 0x0002;               # Bytes to follow

my $fLock       = $self->{_protect};    # Worksheet is protected

my $header      = pack("vv", $record, $length);
    my $data        = pack("v",  $fLock);

$self->_prepend($header, $data);
}

###############################################################################
#
# _store_password()
#
# Write the worksheet PASSWORD record.
#
sub _store_password {

my $self        = shift;

# Exit unless sheet protection and password have been specified
    return unless $self->{_protect} and defined $self->{_password};

my $record      = 0x0013;               # Record identifier
    my $length      = 0x0002;               # Bytes to follow

my $wPassword   = $self->{_password};   # Encoded password

my $header      = pack("vv", $record, $length);
    my $data        = pack("v",  $wPassword);

$self->_prepend($header, $data);
}

#
# Note about 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.
#

###############################################################################
#
# _store_table()
#
# Write cell data stored in the worksheet row/col table.
#
# This is only used when compatibity_mode() is in operation.
#
# This method writes ROW data, then cell data (NUMBER, LABELSST, etc) and then
# DBCELL records in blocks of 32 rows. This is explained in detail (for a
# change) in the Excel SDK and in the OOo Excel file format doc.
#
sub _store_table {

my $self = shift;

return unless $self->{_compatibility};

# Offset from the DBCELL record back to the first ROW of the 32 row block.
    my $row_offset = 0;

# Track rows that have cell data or modified by set_row().
    my @written_rows;

# Write the ROW records with updated max/min col fields.
    #
    for my $row (0 .. $self->{_dim_rowmax} -1) {
        # Skip unless there is cell data in row or the row has been modified.
        next unless $self->{_table}->[$row] or $self->{_row_data}->{$row};

# Store the rows with data.
        push @written_rows, $row;

# Increase the row offset by the length of a ROW record;
        $row_offset += 20;

# The max/min cols in the ROW records are the same as in DIMENSIONS.
        my $col_min = $self->{_dim_colmin};
        my $col_max = $self->{_dim_colmax};

# Write a user specified ROW record (modified by set_row()).
        if ($self->{_row_data}->{$row}) {
            # Rewrite the min and max cols for user defined row record.
            my $packed_row = $self->{_row_data}->{$row};
            substr $packed_row, 6, 4, pack('vv', $col_min, $col_max);
            $self->_append($packed_row);
        }
        else {
            # Write a default Row record if there isn't a  user defined ROW.
            $self->_write_row_default($row, $col_min, $col_max);
        }

# If 32 rows have been written or we are at the last row in the
        # worksheet then write the cell data and the DBCELL record.
        #
        if (@written_rows == 32 or $row == $self->{_dim_rowmax} -1) {

# Offsets to the first cell of each row.
            my @cell_offsets;
            push @cell_offsets, $row_offset - 20;

# Write the cell data in each row and sum their lengths for the
            # cell offsets.
            #
            for my $row (@written_rows) {
                my $cell_offset = 0;

for my $col (@{$self->{_table}->[$row]}) {
                    next unless $col;
                    $self->_append($col);
                    my $length = length $col;
                    $row_offset  += $length;
                    $cell_offset += $length;
                }
                push @cell_offsets, $cell_offset;
            }

# The last offset isn't required.
            pop @cell_offsets;

# Stores the DBCELL offset for use in the INDEX record.
            push @{$self->{_db_indices}}, $self->{_datasize};

# Write the DBCELL record.
            $self->_store_dbcell($row_offset, @cell_offsets);

# Clear the variable for the next block of rows.
            @written_rows   = ();
            @cell_offsets   = ();
            $row_offset     = 0;
        }
    }
}

###############################################################################
#
# _store_dbcell()
#
# Store the DBCELL record using the offset calculated in _store_table().
#
# This is only used when compatibity_mode() is in operation.
#
sub _store_dbcell {

my $self            = shift;
    my $row_offset      = shift;
    my @cell_offsets    = @_;

my $record          = 0x00D7;                 # Record identifier
    my $length          = 4 + 2 * @cell_offsets;  # Bytes to follow

my $header          = pack 'vv', $record, $length;
    my $data            = pack 'V',  $row_offset;
       $data           .= pack 'v', $_ for @cell_offsets;

$self->_append($header, $data);
}

###############################################################################
#
# _store_index()
#
# Store the INDEX record using the DBCELL offsets calculated in _store_table().
#
# This is only used when compatibity_mode() is in operation.
#
sub _store_index {

my $self = shift;

return unless $self->{_compatibility};

my @indices     = @{$self->{_db_indices}};
    my $reserved    = 0x00000000;
    my $row_min     = $self->{_dim_rowmin};
    my $row_max     = $self->{_dim_rowmax};

my $record      = 0x020B;             # Record identifier
    my $length      = 16 + 4 * @indices;  # Bytes to follow

my $header      = pack 'vv',   $record, $length;
    my $data        = pack 'VVVV', $reserved,
                                   $row_min,
                                   $row_max,
                                   $reserved;

for my $index (@indices) {
       $data .= pack 'V', $index + $self->{_offset} + 20 + $length +4;
    }

$self->_prepend($header, $data);

}

###############################################################################
#
# insert_chart($row, $col, $chart, $x, $y, $scale_x, $scale_y)
#
# Insert a chart into a worksheet. The $chart argument should be a Chart
# object or else it is assumed to be a filename of an external binary file.
# The latter is for backwards compatibility.
#
sub insert_chart {

my $self        = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

my $row         = $_[0];
    my $col         = $_[1];
    my $chart       = $_[2];
    my $x_offset    = $_[3] || 0;
    my $y_offset    = $_[4] || 0;
    my $scale_x     = $_[5] || 1;
    my $scale_y     = $_[6] || 1;

croak "Insufficient arguments in insert_chart()" unless @_ >= 3;

if ( ref $chart ) {
        # Check for a Chart object.
        croak "Not a Chart object in insert_chart()"
          unless $chart->isa( 'Spreadsheet::WriteExcel::Chart' );

# Check that the chart is an embedded style chart.
        croak "Not a embedded style Chart object in insert_chart()"
          unless $chart->{_embedded};

}
    else {

# Assume an external bin filename.
        croak "Couldn't locate $chart in insert_chart(): $!" unless -e $chart;
    }

$self->{_charts}->{$row}->{$col} =  [
                                           $row,
                                           $col,
                                           $chart,
                                           $x_offset,
                                           $y_offset,
                                           $scale_x,
                                           $scale_y,
                                        ];

}

# Older method name for backwards compatibility.
*embed_chart = *insert_chart;

###############################################################################
#
# insert_image($row, $col, $filename, $x, $y, $scale_x, $scale_y)
#
# Insert an image into the worksheet.
#
sub insert_image {

my $self        = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

my $row         = $_[0];
    my $col         = $_[1];
    my $image       = $_[2];
    my $x_offset    = $_[3] || 0;
    my $y_offset    = $_[4] || 0;
    my $scale_x     = $_[5] || 1;
    my $scale_y     = $_[6] || 1;

croak "Insufficient arguments in insert_image()" unless @_ >= 3;
    croak "Couldn't locate $image: $!"               unless -e $image;

$self->{_images}->{$row}->{$col} = [
                                           $row,
                                           $col,
                                           $image,
                                           $x_offset,
                                           $y_offset,
                                           $scale_x,
                                           $scale_y,
                                        ];

}

# Older method name for backwards compatibility.
*insert_bitmap = *insert_image;

###############################################################################
#
#  _position_object()
#
# Calculate the vertices that define the position of a graphical object within
# the worksheet.
#
#         +------------+------------+
#         |     A      |      B     |
#   +-----+------------+------------+
#   |     |(x1,y1)     |            |
#   |  1  |(A1)._______|______      |
#   |     |    |              |     |
#   |     |    |              |     |
#   +-----+----|    BITMAP    |-----+
#   |     |    |              |     |
#   |  2  |    |______________.     |
#   |     |            |        (B2)|
#   |     |            |     (x2,y2)|
#   +---- +------------+------------+
#
# Example of a bitmap that covers some of the area from cell A1 to cell B2.
#
# Based on the width and height of the bitmap we need to calculate 8 vars:
#     $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2.
# The width and height of the cells are also variable and have to be taken into
# account.
# The values of $col_start and $row_start are passed in from the calling
# function. The values of $col_end and $row_end are calculated by subtracting
# the width and height of the bitmap from the width and height of the
# underlying cells.
# The vertices are expressed as a percentage of the underlying cell width as
# follows (rhs values are in pixels):
#
#       x1 = X / W *1024
#       y1 = Y / H *256
#       x2 = (X-1) / W *1024
#       y2 = (Y-1) / H *256
#
#       Where:  X is distance from the left side of the underlying cell
#               Y is distance from the top of the underlying cell
#               W is the width of the cell
#               H is the height of the cell
#
# Note: the SDK incorrectly states that the height should be expressed as a
# percentage of 1024.
#
sub _position_object {

my $self = shift;

my $col_start;  # Col containing upper left corner of object
    my $x1;         # Distance to left side of object

my $row_start;  # Row containing top left corner of object
    my $y1;         # Distance to top of object

my $col_end;    # Col containing lower right corner of object
    my $x2;         # Distance to right side of object

my $row_end;    # Row containing bottom right corner of object
    my $y2;         # Distance to bottom of object

my $width;      # Width of image frame
    my $height;     # Height of image frame

($col_start, $row_start, $x1, $y1, $width, $height) = @_;

# Adjust start column for offsets that are greater than the col width
    while ($x1 >= $self->_size_col($col_start)) {
        $x1 -= $self->_size_col($col_start);
        $col_start++;
    }

# Adjust start row for offsets that are greater than the row height
    while ($y1 >= $self->_size_row($row_start)) {
        $y1 -= $self->_size_row($row_start);
        $row_start++;
    }

# Initialise end cell to the same as the start cell
    $col_end    = $col_start;
    $row_end    = $row_start;

$width      = $width  + $x1;
    $height     = $height + $y1;

# Subtract the underlying cell widths to find the end cell of the image
    while ($width >= $self->_size_col($col_end)) {
        $width -= $self->_size_col($col_end);
        $col_end++;
    }

# Subtract the underlying cell heights to find the end cell of the image
    while ($height >= $self->_size_row($row_end)) {
        $height -= $self->_size_row($row_end);
        $row_end++;
    }

# Bitmap isn't allowed to start or finish in a hidden cell, i.e. a cell
    # with zero eight or width.
    #
    return if $self->_size_col($col_start) == 0;
    return if $self->_size_col($col_end)   == 0;
    return if $self->_size_row($row_start) == 0;
    return if $self->_size_row($row_end)   == 0;

# Convert the pixel values to the percentage value expected by Excel
    $x1 = $x1     / $self->_size_col($col_start)   * 1024;
    $y1 = $y1     / $self->_size_row($row_start)   *  256;
    $x2 = $width  / $self->_size_col($col_end)     * 1024;
    $y2 = $height / $self->_size_row($row_end)     *  256;

# Simulate ceil() without calling POSIX::ceil().
    $x1 = int($x1 +0.5);
    $y1 = int($y1 +0.5);
    $x2 = int($x2 +0.5);
    $y2 = int($y2 +0.5);

return( $col_start, $x1,
            $row_start, $y1,
            $col_end,   $x2,
            $row_end,   $y2
          );
}

###############################################################################
#
# _size_col($col)
#
# Convert the width of a cell from user's units to pixels. Excel rounds the
# column width to the nearest pixel. If the width hasn't been set by the user
# we use the default value. If the column is hidden we use a value of zero.
#
sub _size_col {

my $self = shift;
    my $col  = $_[0];

# Look up the cell value to see if it has been changed
    if (exists $self->{_col_sizes}->{$col}) {
        my $width = $self->{_col_sizes}->{$col};

# The relationship is different for user units less than 1.
        if ($width < 1) {
            return int($width *12);
        }
        else {
            return int($width *7 ) +5;
        }
    }
    else {
        return 64;
    }
}

###############################################################################
#
# _size_row($row)
#
# Convert the height of a cell from user's units to pixels. By interpolation
# the relationship is: y = 4/3x. If the height hasn't been set by the user we
# use the default value. If the row is hidden we use a value of zero. (Not
# possible to hide row yet).
#
sub _size_row {

my $self = shift;
    my $row  = $_[0];

# Look up the cell value to see if it has been changed
    if (exists $self->{_row_sizes}->{$row}) {
        if ($self->{_row_sizes}->{$row} == 0) {
            return 0;
        }
        else {
            return int (4/3 * $self->{_row_sizes}->{$row});
        }
    }
    else {
        return 17;
    }
}

###############################################################################
#
# _store_zoom($zoom)
#
#
# Store the window zoom factor. This should be a reduced fraction but for
# simplicity we will store all fractions with a numerator of 100.
#
sub _store_zoom {

my $self        = shift;

# If scale is 100 we don't need to write a record
    return if $self->{_zoom} == 100;

my $record      = 0x00A0;               # Record identifier
    my $length      = 0x0004;               # Bytes to follow

my $header      = pack("vv", $record, $length   );
    my $data        = pack("vv", $self->{_zoom}, 100);

$self->_append($header, $data);
}

###############################################################################
#
# write_utf16be_string($row, $col, $string, $format)
#
# Write a Unicode string to the specified row and column (zero indexed).
# $format is optional.
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#         -3 : long string truncated to 255 chars
#
sub write_utf16be_string {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 3) { return -1 }                        # Check the number of args

my $record      = 0x00FD;                        # Record identifier
    my $length      = 0x000A;                        # Bytes to follow

# Check that row and col are valid and store max and min values
    return -2 if $self->_check_dimensions($row, $col);

# Limit the utf16 string to the max number of chars (not bytes).
    if ($strlen > 32767* 2) {
        $str       = substr($str, 0, 32767*2);
        $str_error = -3;
    }

my $num_bytes = length $str;
    my $num_chars = int($num_bytes / 2);

# Check for a valid 2-byte char string.
    croak "Uneven number of bytes in Unicode string" if $num_bytes % 2;

# Change from UTF16 big-endian to little endian
    $str = pack "v*", unpack "n*", $str;

# Add the encoding and length header to the string.
    my $str_header  = pack("vC", $num_chars, $encoding);
    $str            = $str_header . $str;

if (not exists ${$self->{_str_table}}->{$str}) {
        ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
    }

${$self->{_str_total}}++;

my $header = pack("vv",   $record, $length);
    my $data   = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});

return $str_error;
}

###############################################################################
#
# write_utf16le_string($row, $col, $string, $format)
#
# Write a UTF-16LE string to the specified row and column (zero indexed).
# $format is optional.
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#         -3 : long string truncated to 255 chars
#
sub write_utf16le_string {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

if (@_ < 3) { return -1 }                        # Check the number of args

my $record      = 0x00FD;                        # Record identifier
    my $length      = 0x000A;                        # Bytes to follow

my $row         = $_[0];                         # Zero indexed row
    my $col         = $_[1];                         # Zero indexed column
    my $str         = $_[2];
    my $format      = $_[3];                         # The cell format

# Change from UTF16 big-endian to little endian
    $str = pack "v*", unpack "n*", $str;

return $self->write_utf16be_string($row, $col, $str, $format);
}

# Older method name for backwards compatibility.
*write_unicode    = *write_utf16be_string;
*write_unicode_le = *write_utf16le_string;

###############################################################################
#
# _store_autofilters()
#
# Function to iterate through the columns that form part of an autofilter
# range and write Biff AUTOFILTER records if a filter expression has been set.
#
sub _store_autofilters {

my $self = shift;

# Skip all columns if no filter have been set.
    return unless $self->{_filter_on};

my (undef, undef, $col1, $col2) = @{$self->{_filter_area}};

for my $i ($col1 .. $col2) {
        # Reverse order since records are being pre-pended.
        my $col = $col2 -$i;

# Skip if column doesn't have an active filter.
        next unless $self->{_filter_cols}->{$col};

# Retrieve the filter tokens
        my @tokens =  @{$self->{_filter_cols}->{$col}};

# Filter columns are relative to the first column in the filter.
        my $filter_col = $col - $col1;

# Write the autofilter records.
        $self->_store_autofilter($filter_col, @tokens);
    }
}

###############################################################################
#
# _store_autofilter()
#
# Function to write worksheet AUTOFILTER records. These contain 2 Biff Doper
# structures to represent the 2 possible filter conditions.
#
sub _store_autofilter {

my $self            = shift;

my $record          = 0x009E;
    my $length          = 0x0000;

my $index           = $_[0];
    my $operator_1      = $_[1];
    my $token_1         = $_[2];
    my $join            = $_[3]; # And/Or
    my $operator_2      = $_[4];
    my $token_2         = $_[5];

my $top10_active    = 0;
    my $top10_direction = 0;
    my $top10_percent   = 0;
    my $top10_value     = 101;

my $grbit       = $join;
    my $optimised_1 = 0;
    my $optimised_2 = 0;
    my $doper_1     = '';
    my $doper_2     = '';
    my $string_1    = '';
    my $string_2    = '';

# Excel used an optimisation in the case of a simple equality.
    $optimised_1 = 1 if                         $operator_1 == 2;
    $optimised_2 = 1 if defined $operator_2 and $operator_2 == 2;

# Convert non-simple equalities back to type 2. See  _parse_filter_tokens().
    $operator_1 = 2 if                         $operator_1 == 22;
    $operator_2 = 2 if defined $operator_2 and $operator_2 == 22;

# Handle a "Top" style expression.
    if ($operator_1 >= 30) {
        # Remove the second expression if present.
        $operator_2 = undef;
        $token_2    = undef;

# Set the active flag.
        $top10_active    = 1;

if ($operator_1 == 30 or $operator_1 == 31) {
            $top10_direction = 1;
        }

if ($operator_1 == 31 or $operator_1 == 33) {
            $top10_percent = 1;
        }

if ($top10_direction == 1) {
            $operator_1 = 6
        }
        else {
            $operator_1 = 3
        }

$top10_value     = $token_1;
        $token_1         = 0;
    }

($doper_1, $string_1) = $self->_pack_doper($operator_1, $token_1);
    ($doper_2, $string_2) = $self->_pack_doper($operator_2, $token_2);

my $data    = pack 'v', $index;
       $data   .= pack 'v', $grbit;
       $data   .= $doper_1;
       $data   .= $doper_2;
       $data   .= $string_1;
       $data   .= $string_2;

$length  = length $data;
    my $header  = pack('vv',  $record, $length);

$self->_prepend($header, $data);
}

###############################################################################
#
# _pack_doper()
#
# Create a Biff Doper structure that represents a filter expression. Depending
# on the type of the token we pack an Empty, String or Number doper.
#
sub _pack_doper {

my $self        = shift;

my $operator    = $_[0];
    my $token       = $_[1];

my $doper       = '';
    my $string      = '';

# Return default doper for non-defined filters.
    if (not defined $operator) {
        return ($self->_pack_unused_doper, $string);
    }

if ($token =~ /^blanks|nonblanks$/i) {
        $doper  = $self->_pack_blanks_doper($operator, $token);
    }
    elsif ($operator == 2 or
        $token    !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
    {
        # Excel treats all tokens as strings if the operator is equality, =.

$string = $token;

my $encoding = 0;
        my $length   = length $string;

# Handle utf8 strings in perl 5.8.
        if ($] >= 5.008) {
            require Encode;

if (Encode::is_utf8($string)) {
                $string = Encode::encode("UTF-16BE", $string);
                $encoding = 1;
            }
        }

$string = pack('C', $encoding) . $string;
        $doper  = $self->_pack_string_doper($operator, $length);
    }
    else {
        $string = '';
        $doper  = $self->_pack_number_doper($operator, $token);
    }

return ($doper, $string);
}

###############################################################################
#
# _pack_unused_doper()
#
# Pack an empty Doper structure.
#
sub _pack_unused_doper {

my $self        = shift;

return pack 'C10', (0x0) x 10;
}

###############################################################################
#
# _pack_blanks_doper()
#
# Pack an Blanks/NonBlanks Doper structure.
#
sub _pack_blanks_doper {

my $self        = shift;

my $operator    = $_[0];
    my $token       = $_[1];
    my $type;

if ($token eq 'blanks') {
        $type     = 0x0C;
        $operator = 2;

}
    else {
        $type     = 0x0E;
        $operator = 5;
    }

my $doper       = pack 'CCVV',    $type,         # Data type
                                      $operator,     #
                                      0x0000,        # Reserved
                                      0x0000;        # Reserved
    return $doper;
}

###############################################################################
#
# _pack_string_doper()
#
# Pack an string Doper structure.
#
sub _pack_string_doper {

my $self        = shift;

my $operator    = $_[0];
    my $length      = $_[1];
    my $doper       = pack 'CCVCCCC', 0x06,          # Data type
                                      $operator,     #
                                      0x0000,        # Reserved
                                      $length,       # String char length.
                                      0x0, 0x0, 0x0; # Reserved
    return $doper;
}

###############################################################################
#
# _pack_number_doper()
#
# Pack an IEEE double number Doper structure.
#
sub _pack_number_doper {

my $self        = shift;

my $operator    = $_[0];
    my $number      = $_[1];
       $number      = pack 'd', $number;
       $number      = reverse $number if $self->{_byte_order};

my $doper       = pack 'CC', 0x04, $operator;
       $doper      .= $number;

return $doper;
}

#
# Methods related to comments and MSO objects.
#

###############################################################################
#
# _prepare_images()
#
# Turn the HoH that stores the images into an array for easier handling.
#
sub _prepare_images {

my $self    = shift;

my $count   = 0;
    my @images;

# We sort the images by row and column but that isn't strictly required.
    #
    my @rows = sort {$a <=> $b} keys %{$self->{_images}};

for my $row (@rows) {
        my @cols = sort {$a <=> $b} keys %{$self->{_images}->{$row}};

for my $col (@cols) {
            push @images, $self->{_images}->{$row}->{$col};
            $count++;
        }
    }

$self->{_images}       = {};
    $self->{_images_array} = \@images;

return $count;
}

###############################################################################
#
# _prepare_comments()
#
# Turn the HoH that stores the comments into an array for easier handling.
#
sub _prepare_comments {

my $self    = shift;

my $count   = 0;
    my @comments;

# We sort the comments by row and column but that isn't strictly required.
    #
    my @rows = sort {$a <=> $b} keys %{$self->{_comments}};

for my $row (@rows) {
        my @cols = sort {$a <=> $b} keys %{$self->{_comments}->{$row}};

for my $col (@cols) {
            push @comments, $self->{_comments}->{$row}->{$col};
            $count++;
        }
    }

$self->{_comments}       = {};
    $self->{_comments_array} = \@comments;

return $count;
}

###############################################################################
#
# _prepare_charts()
#
# Turn the HoH that stores the charts into an array for easier handling.
#
sub _prepare_charts {

my $self    = shift;

my $count   = 0;
    my @charts;

# We sort the charts by row and column but that isn't strictly required.
    #
    my @rows = sort {$a <=> $b} keys %{$self->{_charts}};

for my $row (@rows) {
        my @cols = sort {$a <=> $b} keys %{$self->{_charts}->{$row}};

for my $col (@cols) {
            push @charts, $self->{_charts}->{$row}->{$col};
            $count++;
        }
    }

$self->{_charts}       = {};
    $self->{_charts_array} = \@charts;

return $count;
}

###############################################################################
#
# _store_images()
#
# Store the collections of records that make up images.
#
sub _store_images {

my $self            = shift;

my $record          = 0x00EC;           # Record identifier
    my $length          = 0x0000;           # Bytes to follow

my @ids             = @{$self->{_object_ids  }};
    my $spid            = shift @ids;

my @images          = @{$self->{_images_array}};
    my $num_images      = scalar @images;

my $num_filters     = $self->{_filter_count};
    my $num_comments    = @{$self->{_comments_array}};
    my $num_charts      = @{$self->{_charts_array  }};

# Skip this if there aren't any images.
    return unless $num_images;

for my $i (0 .. $num_images-1) {
        my $row         =   $images[$i]->[0];
        my $col         =   $images[$i]->[1];
        my $name        =   $images[$i]->[2];
        my $x_offset    =   $images[$i]->[3];
        my $y_offset    =   $images[$i]->[4];
        my $scale_x     =   $images[$i]->[5];
        my $scale_y     =   $images[$i]->[6];
        my $image_id    =   $images[$i]->[7];
        my $type        =   $images[$i]->[8];
        my $width       =   $images[$i]->[9];
        my $height      =   $images[$i]->[10];

$width  *= $scale_x if $scale_x;
        $height *= $scale_y if $scale_y;

# Calculate the positions of image object.
        my @vertices = $self->_position_object( $col,
                                                $row,
                                                $x_offset,
                                                $y_offset,
                                                $width,
                                                $height
                                              );

if ($i == 0) {
            # Write the parent MSODRAWIING record.
            my $dg_length    = 156 + 84*($num_images -1);
            my $spgr_length  = 132 + 84*($num_images -1);

$dg_length   += 120 *$num_charts;
               $spgr_length += 120 *$num_charts;

$dg_length   +=  96 *$num_filters;
               $spgr_length +=  96 *$num_filters;

$dg_length   += 128 *$num_comments;
               $spgr_length += 128 *$num_comments;

my $data        = $self->_store_mso_dg_container($dg_length);
               $data       .= $self->_store_mso_dg(@ids);
               $data       .= $self->_store_mso_spgr_container($spgr_length);
               $data       .= $self->_store_mso_sp_container(40);
               $data       .= $self->_store_mso_spgr();
               $data       .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
               $data       .= $self->_store_mso_sp_container(76);
               $data       .= $self->_store_mso_sp(75, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_image($image_id);
               $data       .= $self->_store_mso_client_anchor(2, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}
        else {
            # Write the child MSODRAWIING record.
            my $data        = $self->_store_mso_sp_container(76);
               $data       .= $self->_store_mso_sp(75, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_image($image_id);
               $data       .= $self->_store_mso_client_anchor(2, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}

$self->_store_obj_image($i+1);
    }

$self->{_object_ids}->[0] = $spid;
}

###############################################################################
#
# _store_charts()
#
# Store the collections of records that make up charts.
#
sub _store_charts {

my $self            = shift;

my $record          = 0x00EC;           # Record identifier
    my $length          = 0x0000;           # Bytes to follow

my @ids             = @{$self->{_object_ids}};
    my $spid            = shift @ids;

my @charts          = @{$self->{_charts_array}};
    my $num_charts      = scalar @charts;

my $num_filters     = $self->{_filter_count};
    my $num_comments    = @{$self->{_comments_array}};

# Number of objects written so far.
    my $num_objects     = @{$self->{_images_array}};

# Skip this if there aren't any charts.
    return unless $num_charts;

for my $i (0 .. $num_charts-1 ) {
        my $row         =   $charts[$i]->[0];
        my $col         =   $charts[$i]->[1];
        my $chart        =   $charts[$i]->[2];
        my $x_offset    =   $charts[$i]->[3];
        my $y_offset    =   $charts[$i]->[4];
        my $scale_x     =   $charts[$i]->[5];
        my $scale_y     =   $charts[$i]->[6];
        my $width       =   526;
        my $height      =   319;

$width  *= $scale_x if $scale_x;
        $height *= $scale_y if $scale_y;

# Calculate the positions of chart object.
        my @vertices = $self->_position_object( $col,
                                                $row,
                                                $x_offset,
                                                $y_offset,
                                                $width,
                                                $height
                                              );

if ($i == 0 and not $num_objects) {
            # Write the parent MSODRAWIING record.
            my $dg_length    = 192 + 120*($num_charts -1);
            my $spgr_length  = 168 + 120*($num_charts -1);

$dg_length   +=  96 *$num_filters;
               $spgr_length +=  96 *$num_filters;

$dg_length   += 128 *$num_comments;
               $spgr_length += 128 *$num_comments;

my $data        = $self->_store_mso_dg_container($dg_length);
               $data       .= $self->_store_mso_dg(@ids);
               $data       .= $self->_store_mso_spgr_container($spgr_length);
               $data       .= $self->_store_mso_sp_container(40);
               $data       .= $self->_store_mso_spgr();
               $data       .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
               $data       .= $self->_store_mso_sp_container(112);
               $data       .= $self->_store_mso_sp(201, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_chart();
               $data       .= $self->_store_mso_client_anchor(0, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}
        else {
            # Write the child MSODRAWIING record.
            my $data        = $self->_store_mso_sp_container(112);
               $data       .= $self->_store_mso_sp(201, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_chart();
               $data       .= $self->_store_mso_client_anchor(0, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}

$self->_store_obj_chart($num_objects+$i+1);
        $self->_store_chart_binary($chart);
    }

# Simulate the EXTERNSHEET link between the chart and data using a formula
    # such as '=Sheet1!A1'.
    # TODO. Won't work for external data refs. Also should use a more direct
    #       method.
    #
    my $name = $self->{_name};
    if ($self->{_encoding} && $] >= 5.008) {
        require Encode;
        $name = Encode::decode('UTF-16BE', $name);
    }
    $self->store_formula("='$name'!A1");

$self->{_object_ids}->[0] = $spid;
}

###############################################################################
#
# _store_chart_binary
#
# Add the binary data for a chart. This could either be from a Chart object
# or from an external binary file (for backwards compatibility).
#
sub _store_chart_binary {

my $self  = shift;
    my $chart = $_[0];
    my $tmp;

if ( ref $chart ) {
        $chart->_close();
        my $tmp = $chart->get_data();
        $self->_append( $tmp );
    }
    else {

my $filehandle = FileHandle->new( $chart )
          or die "Couldn't open $chart in insert_chart(): $!.\n";

binmode( $filehandle );

while ( read( $filehandle, $tmp, 4096 ) ) {
            $self->_append( $tmp );
        }
    }
}

###############################################################################
#
# _store_filters()
#
# Store the collections of records that make up filters.
#
sub _store_filters {

my $self            = shift;

my $record          = 0x00EC;           # Record identifier
    my $length          = 0x0000;           # Bytes to follow

my @ids             = @{$self->{_object_ids}};
    my $spid            = shift @ids;

my $filter_area     = $self->{_filter_area};
    my $num_filters     = $self->{_filter_count};

my $num_comments    = @{$self->{_comments_array}};

# Number of objects written so far.
    my $num_objects     = @{$self->{_images_array}}
                        + @{$self->{_charts_array}};

# Skip this if there aren't any filters.
    return unless $num_filters;

my ($row1, $row2, $col1, $col2) = @$filter_area;

for my $i (0 .. $num_filters-1 ) {

my @vertices = ( $col1 +$i,
                         0,
                         $row1,
                         0,
                         $col1 +$i +1,
                         0,
                         $row1 +1,
                         0);

if ($i == 0 and not $num_objects) {
            # Write the parent MSODRAWIING record.
            my $dg_length    = 168 + 96*($num_filters -1);
            my $spgr_length  = 144 + 96*($num_filters -1);

$dg_length   += 128 *$num_comments;
               $spgr_length += 128 *$num_comments;

my $data        = $self->_store_mso_dg_container($dg_length);
               $data       .= $self->_store_mso_dg(@ids);
               $data       .= $self->_store_mso_spgr_container($spgr_length);
               $data       .= $self->_store_mso_sp_container(40);
               $data       .= $self->_store_mso_spgr();
               $data       .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
               $data       .= $self->_store_mso_sp_container(88);
               $data       .= $self->_store_mso_sp(201, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_filter();
               $data       .= $self->_store_mso_client_anchor(1, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}
        else {
            # Write the child MSODRAWIING record.
            my $data        = $self->_store_mso_sp_container(88);
               $data       .= $self->_store_mso_sp(201, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_filter();
               $data       .= $self->_store_mso_client_anchor(1, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}

$self->_store_obj_filter($num_objects+$i+1, $col1 +$i);
    }

# Simulate the EXTERNSHEET link between the filter and data using a formula
    # such as '=Sheet1!A1'.
    # TODO. Won't work for external data refs. Also should use a more direct
    #       method.
    #
    my $formula = "='$self->{_name}'!A1";
    $self->store_formula($formula);

$self->{_object_ids}->[0] = $spid;
}

###############################################################################
#
# _store_comments()
#
# Store the collections of records that make up cell comments.
#
# NOTE: We write the comment objects last since that makes it a little easier
# to write the NOTE records directly after the MSODRAWIING records.
#
sub _store_comments {

my $self            = shift;

my $record          = 0x00EC;           # Record identifier
    my $length          = 0x0000;           # Bytes to follow

my @ids             = @{$self->{_object_ids}};
    my $spid            = shift @ids;

my @comments        = @{$self->{_comments_array}};
    my $num_comments    = scalar @comments;

# Number of objects written so far.
    my $num_objects     = @{$self->{_images_array}}
                        +   $self->{_filter_count}
                        + @{$self->{_charts_array}};

# Skip this if there aren't any comments.
    return unless $num_comments;

for my $i (0 .. $num_comments-1) {

my $row         =   $comments[$i]->[0];
        my $col         =   $comments[$i]->[1];
        my $str         =   $comments[$i]->[2];
        my $encoding    =   $comments[$i]->[3];
        my $visible     =   $comments[$i]->[6];
        my $color       =   $comments[$i]->[7];
        my @vertices    = @{$comments[$i]->[8]};
        my $str_len     = length $str;
           $str_len    /= 2 if $encoding; # Num of chars not bytes.
        my $formats     = [[0, 9], [$str_len, 0]];

if ($i == 0 and not $num_objects) {
            # Write the parent MSODRAWIING record.
            my $dg_length   = 200 + 128*($num_comments -1);
            my $spgr_length = 176 + 128*($num_comments -1);

my $data        = $self->_store_mso_dg_container($dg_length);
               $data       .= $self->_store_mso_dg(@ids);
               $data       .= $self->_store_mso_spgr_container($spgr_length);
               $data       .= $self->_store_mso_sp_container(40);
               $data       .= $self->_store_mso_spgr();
               $data       .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
               $data       .= $self->_store_mso_sp_container(120);
               $data       .= $self->_store_mso_sp(202, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_comment(0x80, $visible, $color);
               $data       .= $self->_store_mso_client_anchor(3, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}
        else {
            # Write the child MSODRAWIING record.
            my $data        = $self->_store_mso_sp_container(120);
               $data       .= $self->_store_mso_sp(202, $spid++, 0x0A00);
               $data       .= $self->_store_mso_opt_comment(0x80, $visible, $color);
               $data       .= $self->_store_mso_client_anchor(3, @vertices);
               $data       .= $self->_store_mso_client_data();

$length         = length $data;
            my $header      = pack("vv", $record, $length);
            $self->_append($header, $data);

}

$self->_store_obj_comment($num_objects+$i+1);
        $self->_store_mso_drawing_text_box();
        $self->_store_txo($str_len);
        $self->_store_txo_continue_1($str, $encoding);
        $self->_store_txo_continue_2($formats);
    }

# Write the NOTE records after MSODRAWIING records.
    for my $i (0 .. $num_comments-1) {

my $row         = $comments[$i]->[0];
        my $col         = $comments[$i]->[1];
        my $author      = $comments[$i]->[4];
        my $author_enc  = $comments[$i]->[5];
        my $visible     = $comments[$i]->[6];

$self->_store_note($row, $col, $num_objects+$i+1,
                           $author, $author_enc, $visible);
    }
}

###############################################################################
#
# _store_mso_dg_container()
#
# Write the Escher DgContainer record that is part of MSODRAWING.
#
sub _store_mso_dg_container {

my $self        = shift;

my $type        = 0xF002;
    my $version     = 15;
    my $instance    = 0;
    my $data        = '';
    my $length      = $_[0];

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_dg()
#
# Write the Escher Dg record that is part of MSODRAWING.
#
sub _store_mso_dg {

my $self        = shift;

my $type        = 0xF008;
    my $version     = 0;
    my $instance    = $_[0];
    my $data        = '';
    my $length      = 8;

my $num_shapes  = $_[1];
    my $max_spid    = $_[2];

$data           = pack "VV", $num_shapes, $max_spid;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_spgr_container()
#
# Write the Escher SpgrContainer record that is part of MSODRAWING.
#
sub _store_mso_spgr_container {

my $self        = shift;

my $type        = 0xF003;
    my $version     = 15;
    my $instance    = 0;
    my $data        = '';
    my $length      = $_[0];

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_sp_container()
#
# Write the Escher SpContainer record that is part of MSODRAWING.
#
sub _store_mso_sp_container {

my $self        = shift;

my $type        = 0xF004;
    my $version     = 15;
    my $instance    = 0;
    my $data        = '';
    my $length      = $_[0];

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_spgr()
#
# Write the Escher Spgr record that is part of MSODRAWING.
#
sub _store_mso_spgr {

my $self        = shift;

my $type        = 0xF009;
    my $version     = 1;
    my $instance    = 0;
    my $data        = pack "VVVV", 0, 0, 0, 0;
    my $length      = 16;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_sp()
#
# Write the Escher Sp record that is part of MSODRAWING.
#
sub _store_mso_sp {

my $self        = shift;

my $type        = 0xF00A;
    my $version     = 2;
    my $instance    = $_[0];
    my $data        = '';
    my $length      = 8;

my $spid        = $_[1];
    my $options     = $_[2];

$data           = pack "VV", $spid, $options;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_opt_comment()
#
# Write the Escher Opt record that is part of MSODRAWING.
#
sub _store_mso_opt_comment {

my $self        = shift;

my $type        = 0xF00B;
    my $version     = 3;
    my $instance    = 9;
    my $data        = '';
    my $length      = 54;

my $spid        = $_[0];
    my $visible     = $_[1];
    my $colour      = $_[2] || 0x50;

# Use the visible flag if set by the user or else use the worksheet value.
    # Note that the value used is the opposite of _store_note().
    #
    if (defined $visible) {
        $visible = $visible                   ? 0x0000 : 0x0002;
    }
    else {
        $visible = $self->{_comments_visible} ? 0x0000 : 0x0002;
    }

$data    = pack "V",  $spid;
    $data   .= pack "H*", '0000BF00080008005801000000008101' ;
    $data   .= pack "C",  $colour;
    $data   .= pack "H*", '000008830150000008BF011000110001' .
                          '02000000003F0203000300BF03';
    $data   .= pack "v",  $visible;
    $data   .= pack "H*", '0A00';

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_opt_image()
#
# Write the Escher Opt record that is part of MSODRAWING.
#
sub _store_mso_opt_image {

my $self        = shift;

my $type        = 0xF00B;
    my $version     = 3;
    my $instance    = 3;
    my $data        = '';
    my $length      = undef;
    my $spid        = $_[0];

$data    = pack 'v', 0x4104;        # Blip -> pib
    $data   .= pack 'V', $spid;
    $data   .= pack 'v', 0x01BF;        # Fill Style -> fNoFillHitTest
    $data   .= pack 'V', 0x00010000;
    $data   .= pack 'v', 0x03BF;        # Group Shape -> fPrint
    $data   .= pack 'V', 0x00080000;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_opt_chart()
#
# Write the Escher Opt record that is part of MSODRAWING.
#
sub _store_mso_opt_chart {

my $self        = shift;

my $type        = 0xF00B;
    my $version     = 3;
    my $instance    = 9;
    my $data        = '';
    my $length      = undef;

$data    = pack 'v', 0x007F;        # Protection -> fLockAgainstGrouping
    $data   .= pack 'V', 0x01040104;

$data   .= pack 'v', 0x00BF;        # Text -> fFitTextToShape
    $data   .= pack 'V', 0x00080008;

$data   .= pack 'v', 0x0181;        # Fill Style -> fillColor
    $data   .= pack 'V', 0x0800004E ;

$data   .= pack 'v', 0x0183;        # Fill Style -> fillBackColor
    $data   .= pack 'V', 0x0800004D;

$data   .= pack 'v', 0x01BF;        # Fill Style -> fNoFillHitTest
    $data   .= pack 'V', 0x00110010;

$data   .= pack 'v', 0x01C0;        # Line Style -> lineColor
    $data   .= pack 'V', 0x0800004D;

$data   .= pack 'v', 0x01FF;        # Line Style -> fNoLineDrawDash
    $data   .= pack 'V', 0x00080008;

$data   .= pack 'v', 0x023F;        # Shadow Style -> fshadowObscured
    $data   .= pack 'V', 0x00020000;

$data   .= pack 'v', 0x03BF;        # Group Shape -> fPrint
    $data   .= pack 'V', 0x00080000;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_opt_filter()
#
# Write the Escher Opt record that is part of MSODRAWING.
#
sub _store_mso_opt_filter {

my $self        = shift;

my $type        = 0xF00B;
    my $version     = 3;
    my $instance    = 5;
    my $data        = '';
    my $length      = undef;

$data    = pack 'v', 0x007F;        # Protection -> fLockAgainstGrouping
    $data   .= pack 'V', 0x01040104;

$data   .= pack 'v', 0x00BF;        # Text -> fFitTextToShape
    $data   .= pack 'V', 0x00080008;

$data   .= pack 'v', 0x01BF;        # Fill Style -> fNoFillHitTest
    $data   .= pack 'V', 0x00010000;

$data   .= pack 'v', 0x01FF;        # Line Style -> fNoLineDrawDash
    $data   .= pack 'V', 0x00080000;

$data   .= pack 'v', 0x03BF;        # Group Shape -> fPrint
    $data   .= pack 'V', 0x000A0000;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_client_anchor()
#
# Write the Escher ClientAnchor record that is part of MSODRAWING.
#
sub _store_mso_client_anchor {

my $self        = shift;

my $type        = 0xF010;
    my $version     = 0;
    my $instance    = 0;
    my $data        = '';
    my $length      = 18;

my $flag        = shift;

my $col_start   = $_[0];    # Col containing upper left corner of object
    my $x1          = $_[1];    # Distance to left side of object

my $row_start   = $_[2];    # Row containing top left corner of object
    my $y1          = $_[3];    # Distance to top of object

my $col_end     = $_[4];    # Col containing lower right corner of object
    my $x2          = $_[5];    # Distance to right side of object

my $row_end     = $_[6];    # Row containing bottom right corner of object
    my $y2          = $_[7];    # Distance to bottom of object

$data   = pack "v9",    $flag,
                            $col_start, $x1,
                            $row_start, $y1,
                            $col_end,   $x2,
                            $row_end,   $y2;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_mso_client_data()
#
# Write the Escher ClientData record that is part of MSODRAWING.
#
sub _store_mso_client_data {

my $self        = shift;

my $type        = 0xF011;
    my $version     = 0;
    my $instance    = 0;
    my $data        = '';
    my $length      = 0;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_obj_comment()
#
# Write the OBJ record that is part of cell comments.
#
sub _store_obj_comment {

my $self        = shift;

my $record      = 0x005D;   # Record identifier
    my $length      = 0x0034;   # Bytes to follow

my $obj_id      = $_[0];    # Object ID number.
    my $obj_type    = 0x0019;   # Object type (comment).
    my $data        = '';       # Record data.

my $sub_record  = 0x0000;   # Sub-record identifier.
    my $sub_length  = 0x0000;   # Length of sub-record.
    my $sub_data    = '';       # Data of sub-record.
    my $options     = 0x4011;
    my $reserved    = 0x0000;

# Add ftCmo (common object data) subobject
    $sub_record     = 0x0015;   # ftCmo
    $sub_length     = 0x0012;
    $sub_data       = pack "vvvVVV", $obj_type, $obj_id,   $options,
                                     $reserved, $reserved, $reserved;
    $data           = pack("vv",     $sub_record, $sub_length);
    $data          .= $sub_data;

# Add ftNts (note structure) subobject
    $sub_record     = 0x000D;   # ftNts
    $sub_length     = 0x0016;
    $sub_data       = pack "VVVVVv", ($reserved) x 6;
    $data          .= pack("vv",     $sub_record, $sub_length);
    $data          .= $sub_data;

# Add ftEnd (end of object) subobject
    $sub_record     = 0x0000;   # ftNts
    $sub_length     = 0x0000;
    $data          .= pack("vv",     $sub_record, $sub_length);

# Pack the record.
    my $header  = pack("vv",        $record, $length);

$self->_append($header, $data);

}

###############################################################################
#
# _store_obj_image()
#
# Write the OBJ record that is part of image records.
#
sub _store_obj_image {

my $self        = shift;

my $record      = 0x005D;   # Record identifier
    my $length      = 0x0026;   # Bytes to follow

my $obj_id      = $_[0];    # Object ID number.
    my $obj_type    = 0x0008;   # Object type (Picture).
    my $data        = '';       # Record data.

my $sub_record  = 0x0000;   # Sub-record identifier.
    my $sub_length  = 0x0000;   # Length of sub-record.
    my $sub_data    = '';       # Data of sub-record.
    my $options     = 0x6011;
    my $reserved    = 0x0000;

# Add ftCmo (common object data) subobject
    $sub_record     = 0x0015;   # ftCmo
    $sub_length     = 0x0012;
    $sub_data       = pack 'vvvVVV', $obj_type, $obj_id,   $options,
                                     $reserved, $reserved, $reserved;
    $data           = pack 'vv',     $sub_record, $sub_length;
    $data          .= $sub_data;

# Add ftCf (Clipboard format) subobject
    $sub_record     = 0x0007;   # ftCf
    $sub_length     = 0x0002;
    $sub_data       = pack 'v',      0xFFFF;
    $data          .= pack 'vv',     $sub_record, $sub_length;
    $data          .= $sub_data;

# Add ftPioGrbit (Picture option flags) subobject
    $sub_record     = 0x0008;   # ftPioGrbit
    $sub_length     = 0x0002;
    $sub_data       = pack 'v',      0x0001;
    $data          .= pack 'vv',     $sub_record, $sub_length;
    $data          .= $sub_data;

# Add ftEnd (end of object) subobject
    $sub_record     = 0x0000;   # ftNts
    $sub_length     = 0x0000;
    $data          .= pack 'vv',     $sub_record, $sub_length;

# Pack the record.
    my $header  = pack('vv',        $record, $length);

$self->_append($header, $data);

}

###############################################################################
#
# _store_obj_chart()
#
# Write the OBJ record that is part of chart records.
#
sub _store_obj_chart {

my $self        = shift;

my $record      = 0x005D;   # Record identifier
    my $length      = 0x001A;   # Bytes to follow

my $obj_id      = $_[0];    # Object ID number.
    my $obj_type    = 0x0005;   # Object type (chart).
    my $data        = '';       # Record data.

# Add ftEnd (end of object) subobject
    $sub_record     = 0x0000;   # ftNts
    $sub_length     = 0x0000;
    $data          .= pack 'vv',     $sub_record, $sub_length;

# Pack the record.
    my $header  = pack('vv',        $record, $length);

$self->_append($header, $data);

}

###############################################################################
#
# _store_obj_filter()
#
# Write the OBJ record that is part of filter records.
#
sub _store_obj_filter {

my $self        = shift;

my $record      = 0x005D;   # Record identifier
    my $length      = 0x0046;   # Bytes to follow

my $obj_id      = $_[0];    # Object ID number.
    my $obj_type    = 0x0014;   # Object type (combo box).
    my $data        = '';       # Record data.

my $sub_record  = 0x0000;   # Sub-record identifier.
    my $sub_length  = 0x0000;   # Length of sub-record.
    my $sub_data    = '';       # Data of sub-record.
    my $options     = 0x2101;
    my $reserved    = 0x0000;

# Add ftSbs Scroll bar subobject
    $sub_record     = 0x000C;   # ftSbs
    $sub_length     = 0x0014;
    $sub_data       = pack 'H*', '0000000000000000640001000A00000010000100';
    $data          .= pack 'vv',     $sub_record, $sub_length;
    $data          .= $sub_data;

# Add ftLbsData (List box data) subobject
    $sub_record     = 0x0013;   # ftLbsData
    $sub_length     = 0x1FEE;   # Special case (undocumented).

# If the filter is active we set one of the undocumented flags.
    my $col         = $_[1];

if ($self->{_filter_cols}->{$col}) {
        $sub_data       = pack 'H*', '000000000100010300000A0008005700';
    }
    else {
        $sub_data       = pack 'H*', '00000000010001030000020008005700';
    }

$data          .= pack 'vv',     $sub_record, $sub_length;
    $data          .= $sub_data;

# Add ftEnd (end of object) subobject
    $sub_record     = 0x0000;   # ftNts
    $sub_length     = 0x0000;
    $data          .= pack 'vv', $sub_record, $sub_length;

# Pack the record.
    my $header  = pack('vv',        $record, $length);

$self->_append($header, $data);
}

###############################################################################
#
# _store_mso_drawing_text_box()
#
# Write the MSODRAWING ClientTextbox record that is part of comments.
#
sub _store_mso_drawing_text_box {

my $self        = shift;

my $record      = 0x00EC;           # Record identifier
    my $length      = 0x0008;           # Bytes to follow

my $data        = $self->_store_mso_client_text_box();
    my $header      = pack("vv", $record, $length);

$self->_append($header, $data);
}

###############################################################################
#
# _store_mso_client_text_box()
#
# Write the Escher ClientTextbox record that is part of MSODRAWING.
#
sub _store_mso_client_text_box {

my $self        = shift;

my $type        = 0xF00D;
    my $version     = 0;
    my $instance    = 0;
    my $data        = '';
    my $length      = 0;

return $self->_add_mso_generic($type, $version, $instance, $data, $length);
}

###############################################################################
#
# _store_txo()
#
# Write the worksheet TXO record that is part of cell comments.
#
sub _store_txo {

my $self        = shift;

my $record      = 0x01B6;               # Record identifier
    my $length      = 0x0012;               # Bytes to follow

my $string_len  = $_[0];                # Length of the note text.
    my $format_len  = $_[1] || 16;          # Length of the format runs.
    my $rotation    = $_[2] || 0;           # Options
    my $grbit       = 0x0212;               # Options
    my $reserved    = 0x0000;               # Options

# Pack the record.
    my $header  = pack("vv",        $record, $length);
    my $data    = pack("vvVvvvV",   $grbit, $rotation, $reserved, $reserved,
                                    $string_len, $format_len, $reserved);

$self->_append($header, $data);

}

###############################################################################
#
# _store_txo_continue_1()
#
# Write the first CONTINUE record to follow the TXO record. It contains the
# text data.
#
sub _store_txo_continue_1 {

my $self        = shift;

my $record      = 0x003C;               # Record identifier
    my $string      = $_[0];                # Comment string.
    my $encoding    = $_[1] || 0;           # Encoding of the string.

# Split long comment strings into smaller continue blocks if necessary.
    # We can't let BIFFwriter::_add_continue() handled this since an extra
    # encoding byte has to be added similar to the SST block.
    #
    # We make the limit size smaller than the _add_continue() size and even
    # so that UTF16 chars occur in the same block.
    #
    my $limit = 8218;
    while (length($string) > $limit) {
        my $tmp_str = substr($string, 0, $limit, "");

my $data    = pack("C", $encoding) . $tmp_str;
        my $length  = length $data;
        my $header  = pack("vv", $record, $length);

$self->_append($header, $data);
    }

# Pack the record.
    my $data    = pack("C", $encoding) . $string;
    my $length  = length $data;
    my $header  = pack("vv", $record, $length);

$self->_append($header, $data);

}

###############################################################################
#
# _store_txo_continue_2()
#
# Write the second CONTINUE record to follow the TXO record. It contains the
# formatting information for the string.
#
sub _store_txo_continue_2 {

my $self        = shift;

my $record      = 0x003C;               # Record identifier
    my $length      = 0x0000;               # Bytes to follow
    my $formats     = $_[0];                # Formatting information

# Pack the record.
    my $data = '';

for my $a_ref (@$formats) {
        $data .= pack "vvV", $a_ref->[0], $a_ref->[1], 0x0;
    }

$length     = length $data;
    my $header  = pack("vv", $record, $length);

$self->_append($header, $data);

}

###############################################################################
#
# _store_note()
#
# Write the worksheet NOTE record that is part of cell comments.
#
sub _store_note {

my $self        = shift;

my $record      = 0x001C;               # Record identifier
    my $length      = 0x000C;               # Bytes to follow

my $row         = $_[0];
    my $col         = $_[1];
    my $obj_id      = $_[2];
    my $author      = $_[3] || $self->{_comments_author};
    my $author_enc  = $_[4] || $self->{_comments_author_enc};
    my $visible     = $_[5];

# Use the visible flag if set by the user or else use the worksheet value.
    # The flag is also set in _store_mso_opt_comment() but with the opposite
    # value.
    if (defined $visible) {
        $visible = $visible                   ? 0x0002 : 0x0000;
    }
    else {
        $visible = $self->{_comments_visible} ? 0x0002 : 0x0000;
    }

# Get the number of chars in the author string (not bytes).
    my $num_chars  = length $author;
       $num_chars /= 2 if $author_enc;

# Null terminate the author string.
    $author .= "\0";

# Pack the record.
    my $data    = pack("vvvvvC", $row, $col, $visible, $obj_id,
                                 $num_chars, $author_enc);

$length     = length($data) + length($author);
    my $header  = pack("vv", $record, $length);

$self->_append($header, $data, $author);
}

###############################################################################
#
# _comment_params()
#
# This method handles the additional optional parameters to write_comment() as
# well as calculating the comment object position and vertices.
#
sub _comment_params {

my $self            = shift;

my $row             = shift;
    my $col             = shift;
    my $string          = shift;

my $default_width   = 128;
    my $default_height  = 74;

my %params  = (
                    author          => '',
                    author_encoding => 0,
                    encoding        => 0,
                    color           => undef,
                    start_cell      => undef,
                    start_col       => undef,
                    start_row       => undef,
                    visible         => undef,
                    width           => $default_width,
                    height          => $default_height,
                    x_offset        => undef,
                    x_scale         => 1,
                    y_offset        => undef,
                    y_scale         => 1,
                  );

# Overwrite the defaults with any user supplied values. Incorrect or
    # misspelled parameters are silently ignored.
    %params     = (%params, @_);

# Ensure that a width and height have been set.
    $params{width}  = $default_width  if not $params{width};
    $params{height} = $default_height if not $params{height};

# Check that utf16 strings have an even number of bytes.
    if ($params{encoding}) {
        croak "Uneven number of bytes in comment string"
               if length($string) % 2;

# Change from UTF-16BE to UTF-16LE
        $string = pack 'v*', unpack 'n*', $string;
    }

if ($params{author_encoding}) {
        croak "Uneven number of bytes in author string"
                if length($params{author}) % 2;

# Change from UTF-16BE to UTF-16LE
        $params{author} = pack 'v*', unpack 'n*', $params{author};
    }

# Handle utf8 strings in perl 5.8.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($string)) {
            $string = Encode::encode("UTF-16LE", $string);
            $params{encoding} = 1;
        }

if (Encode::is_utf8($params{author})) {
            $params{author} = Encode::encode("UTF-16LE", $params{author});
            $params{author_encoding} = 1;
        }
    }

# Limit the string to the max number of chars (not bytes).
    my $max_len  = 32767;
       $max_len *= 2 if $params{encoding};

if (length($string) > $max_len) {
        $string       = substr($string, 0, $max_len);
    }

# Set the comment background colour.
    my $color       = $params{color};
       $color       = &Spreadsheet::WriteExcel::Format::_get_color($color);
       $color       = 0x50 if $color == 0x7FFF; # Default color.
    $params{color}  = $color;

# Convert a cell reference to a row and column.
    if (defined $params{start_cell}) {
        my ($row, $col)    = $self->_substitute_cellref($params{start_cell});
        $params{start_row} = $row;
        $params{start_col} = $col;
    }

# Set the default start cell and offsets for the comment. These are
    # generally fixed in relation to the parent cell. However there are
    # some edge cases for cells at the, er, edges.
    #
    if (not defined $params{start_row}) {

if    ($row == 0    ) {$params{start_row} = 0      }
        elsif ($row == 65533) {$params{start_row} = 65529  }
        elsif ($row == 65534) {$params{start_row} = 65530  }
        elsif ($row == 65535) {$params{start_row} = 65531  }
        else                  {$params{start_row} = $row -1}
    }

if (not defined $params{y_offset}) {

if    ($row == 0    ) {$params{y_offset}  = 2      }
        elsif ($row == 65533) {$params{y_offset}  = 4      }
        elsif ($row == 65534) {$params{y_offset}  = 4      }
        elsif ($row == 65535) {$params{y_offset}  = 2      }
        else                  {$params{y_offset}  = 7      }
    }

if (not defined $params{start_col}) {

if    ($col == 253  ) {$params{start_col} = 250    }
        elsif ($col == 254  ) {$params{start_col} = 251    }
        elsif ($col == 255  ) {$params{start_col} = 252    }
        else                  {$params{start_col} = $col +1}
    }

if (not defined $params{x_offset}) {

if    ($col == 253  ) {$params{x_offset}  = 49     }
        elsif ($col == 254  ) {$params{x_offset}  = 49     }
        elsif ($col == 255  ) {$params{x_offset}  = 49     }
        else                  {$params{x_offset}  = 15     }
    }

# Scale the size of the comment box if required.
    if ($params{x_scale}) {
        $params{width}  = $params{width}  * $params{x_scale};
    }

if ($params{y_scale}) {
        $params{height} = $params{height} * $params{y_scale};
    }

# Calculate the positions of comment object.
    my @vertices = $self->_position_object( $params{start_col},
                                            $params{start_row},
                                            $params{x_offset},
                                            $params{y_offset},
                                            $params{width},
                                            $params{height}
                                          );

return(
           $row,
           $col,
           $string,
           $params{encoding},
           $params{author},
           $params{author_encoding},
           $params{visible},
           $params{color},
           [@vertices]
          );
}

#
# DATA VALIDATION
#

###############################################################################
#
# data_validation($row, $col, {...})
#
# This method handles the interface to Excel data validation.
# Somewhat ironically the this requires a lot of validation code since the
# interface is flexible and covers a several types of data validation.
#
# We allow data validation to be called on one cell or a range of cells. The
# hashref contains the validation parameters and must be the last param:
#    data_validation($row, $col, {...})
#    data_validation($first_row, $first_col, $last_row, $last_col, {...})
#
# Returns  0 : normal termination
#         -1 : insufficient number of arguments
#         -2 : row or column out of range
#         -3 : incorrect parameter.
#
sub data_validation {

my $self = shift;

# Check for a cell reference in A1 notation and substitute row and column
    if ($_[0] =~ /^\D/) {
        @_ = $self->_substitute_cellref(@_);
    }

# Check for a valid number of args.
    if (@_ != 5 && @_ != 3) { return -1 }

# The final hashref contains the validation parameters.
    my $param = pop;

# Make the last row/col the same as the first if not defined.
    my ($row1, $col1, $row2, $col2) = @_;
    if (!defined $row2) {
        $row2 = $row1;
        $col2 = $col1;
    }

# Check that row and col are valid without storing the values.
    return -2 if $self->_check_dimensions($row1, $col1, 1, 1);
    return -2 if $self->_check_dimensions($row2, $col2, 1, 1);

# Check that the last parameter is a hash list.
    if (ref $param ne 'HASH') {
        carp "Last parameter '$param' in data_validation() must be a hash ref";
        return -3;
    }

# List of valid input parameters.
    my %valid_parameter = (
                              validate          => 1,
                              criteria          => 1,
                              value             => 1,
                              source            => 1,
                              minimum           => 1,
                              maximum           => 1,
                              ignore_blank      => 1,
                              dropdown          => 1,
                              show_input        => 1,
                              input_title       => 1,
                              input_message     => 1,
                              show_error        => 1,
                              error_title       => 1,
                              error_message     => 1,
                              error_type        => 1,
                              other_cells       => 1,
                          );

# Check for valid input parameters.
    for my $param_key (keys %$param) {
        if (not exists $valid_parameter{$param_key}) {
            carp "Unknown parameter '$param_key' in data_validation()";
            return -3;
        }
    }

# Map alternative parameter names 'source' or 'minimum' to 'value'.
    $param->{value} = $param->{source}  if defined $param->{source};
    $param->{value} = $param->{minimum} if defined $param->{minimum};

# 'validate' is a required parameter.
    if (not exists $param->{validate}) {
        carp "Parameter 'validate' is required in data_validation()";
        return -3;
    }

# List of  valid validation types.
    my %valid_type = (
                              'any'             => 0,
                              'any value'       => 0,
                              'whole number'    => 1,
                              'whole'           => 1,
                              'integer'         => 1,
                              'decimal'         => 2,
                              'list'            => 3,
                              'date'            => 4,
                              'time'            => 5,
                              'text length'     => 6,
                              'length'          => 6,
                              'custom'          => 7,
                      );

# Check for valid validation types.
    if (not exists $valid_type{lc($param->{validate})}) {
        carp "Unknown validation type '$param->{validate}' for parameter " .
             "'validate' in data_validation()";
        return -3;
    }
    else {
        $param->{validate} = $valid_type{lc($param->{validate})};
    }

# No action is required for validation type 'any'.
    # TODO: we should perhaps store 'any' for message only validations.
    return 0 if $param->{validate} == 0;

# The list and custom validations don't have a criteria so we use a default
    # of 'between'.
    if ($param->{validate} == 3 || $param->{validate} == 7) {
        $param->{criteria}  = 'between';
        $param->{maximum}   = undef;
    }

# 'criteria' is a required parameter.
    if (not exists $param->{criteria}) {
        carp "Parameter 'criteria' is required in data_validation()";
        return -3;
    }

# List of valid criteria types.
    my %criteria_type = (
                              'between'                     => 0,
                              'not between'                 => 1,
                              'equal to'                    => 2,
                              '='                           => 2,
                              '=='                          => 2,
                              'not equal to'                => 3,
                              '!='                          => 3,
                              '<>'                          => 3,
                              'greater than'                => 4,
                              '>'                           => 4,
                              'less than'                   => 5,
                              '<'                           => 5,
                              'greater than or equal to'    => 6,
                              '>='                          => 6,
                              'less than or equal to'       => 7,
                              '<='                          => 7,
                      );

# Check for valid criteria types.
    if (not exists $criteria_type{lc($param->{criteria})}) {
        carp "Unknown criteria type '$param->{criteria}' for parameter " .
             "'criteria' in data_validation()";
        return -3;
    }
    else {
        $param->{criteria} = $criteria_type{lc($param->{criteria})};
    }

# 'Between' and 'Not between' criteria require 2 values.
    if ($param->{criteria} == 0 || $param->{criteria} == 1) {
        if (not exists $param->{maximum}) {
            carp "Parameter 'maximum' is required in data_validation() " .
                 "when using 'between' or 'not between' criteria";
            return -3;
        }
    }
    else {
        $param->{maximum} = undef;
    }

# List of valid error dialog types.
    my %error_type = (
                              'stop'        => 0,
                              'warning'     => 1,
                              'information' => 2,
                     );

# Check for valid error dialog types.
    if (not exists $param->{error_type}) {
        $param->{error_type} = 0;
    }
    elsif (not exists $error_type{lc($param->{error_type})}) {
        carp "Unknown criteria type '$param->{error_type}' for parameter " .
             "'error_type' in data_validation()";
        return -3;
    }
    else {
        $param->{error_type} = $error_type{lc($param->{error_type})};
    }

# Convert date/times value if required.
    if ($param->{validate} == 4 || $param->{validate} == 5) {
        if ($param->{value} =~ /T/) {
            my $date_time = $self->convert_date_time($param->{value});

if (!defined $date_time) {
                carp "Invalid date/time value '$param->{value}' " .
                     "in data_validation()";
                return -3;
            }
            else {
                $param->{value} = $date_time;
            }
        }
        if (defined $param->{maximum} && $param->{maximum} =~ /T/) {
            my $date_time = $self->convert_date_time($param->{maximum});

if (!defined $date_time) {
                carp "Invalid date/time value '$param->{maximum}' " .
                     "in data_validation()";
                return -3;
            }
            else {
                $param->{maximum} = $date_time;
            }
        }
    }

# Set some defaults if they haven't been defined by the user.
    $param->{ignore_blank}  = 1 if !defined $param->{ignore_blank};
    $param->{dropdown}      = 1 if !defined $param->{dropdown};
    $param->{show_input}    = 1 if !defined $param->{show_input};
    $param->{show_error}    = 1 if !defined $param->{show_error};

# These are the cells to which the validation is applied.
    $param->{cells} = [[$row1, $col1, $row2, $col2]];

# A (for now) undocumented parameter to pass additional cell ranges.
    if (exists $param->{other_cells}) {

push @{$param->{cells}}, @{$param->{other_cells}};
    }

# Store the validation information until we close the worksheet.
    push @{$self->{_validations}}, $param;
}

###############################################################################
#
# _store_validation_count()
#
# Store the count of the DV records to follow.
#
# Note, this could be wrapped into _store_dv() but we may require separate
# handling of the object id at a later stage.
#
sub _store_validation_count {

my $self = shift;

my $dv_count = @{$self->{_validations}};
    my $obj_id   = -1;

return unless $dv_count;

$self->_store_dval($obj_id , $dv_count);
}

###############################################################################
#
# _store_validations()
#
# Store the data_validation records.
#
sub _store_validations {

my $self = shift;

return unless scalar @{$self->{_validations}};

for my $param (@{$self->{_validations}}) {
        $self->_store_dv(   $param->{cells},
                            $param->{validate},
                            $param->{criteria},
                            $param->{value},
                            $param->{maximum},
                            $param->{input_title},
                            $param->{input_message},
                            $param->{error_title},
                            $param->{error_message},
                            $param->{error_type},
                            $param->{ignore_blank},
                            $param->{dropdown},
                            $param->{show_input},
                            $param->{show_error},
                            );
    }
}

###############################################################################
#
# _store_dval()
#
# Store the DV record which contains the number of and information common to
# all DV structures.
#
sub _store_dval {

my $self        = shift;

my $record      = 0x01B2;       # Record identifier
    my $length      = 0x0012;       # Bytes to follow

my $obj_id      = $_[0];        # Object ID number.
    my $dv_count    = $_[1];        # Count of DV structs to follow.

my $flags       = 0x0004;       # Option flags.
    my $x_coord     = 0x00000000;   # X coord of input box.
    my $y_coord     = 0x00000000;   # Y coord of input box.

# Pack the record.
    my $header = pack('vv', $record, $length);
    my $data   = pack('vVVVV', $flags, $x_coord, $y_coord, $obj_id, $dv_count);

$self->_append($header, $data);
}

###############################################################################
#
# _store_dv()
#
# Store the DV record that specifies the data validation criteria and options
# for a range of cells..
#
sub _store_dv {

my $self            = shift;

my $record          = 0x01BE;       # Record identifier
    my $length          = 0x0000;       # Bytes to follow

my $flags           = 0x00000000;   # DV option flags.

my $cells           = $_[0];        # Aref of cells to which DV applies.
    my $validation_type = $_[1];        # Type of data validation.
    my $criteria_type   = $_[2];        # Validation criteria.
    my $formula_1       = $_[3];        # Value/Source/Minimum formula.
    my $formula_2       = $_[4];        # Maximum formula.
    my $input_title     = $_[5];        # Title of input message.
    my $input_message   = $_[6];        # Text of input message.
    my $error_title     = $_[7];        # Title of error message.
    my $error_message   = $_[8];        # Text of input message.
    my $error_type      = $_[9];        # Error dialog type.
    my $ignore_blank    = $_[10];       # Ignore blank cells.
    my $dropdown        = $_[11];       # Display dropdown with list.
    my $input_box       = $_[12];       # Display input box.
    my $error_box       = $_[13];       # Display error box.
    my $ime_mode        = 0;            # IME input mode for far east fonts.
    my $str_lookup      = 0;            # See below.

# Set the string lookup flag for 'list' validations with a string array.
    if ($validation_type == 3 && ref $formula_1 eq 'ARRAY')  {
        $str_lookup = 1;
    }

# The dropdown flag is stored as a negated value.
    my $no_dropdown = not $dropdown;

# Pack the validation formulas.
    $formula_1 = $self->_pack_dv_formula($formula_1);
    $formula_2 = $self->_pack_dv_formula($formula_2);

# Pack the input and error dialog strings.
    $input_title   = $self->_pack_dv_string($input_title,   32 );
    $error_title   = $self->_pack_dv_string($error_title,   32 );
    $input_message = $self->_pack_dv_string($input_message, 255);
    $error_message = $self->_pack_dv_string($error_message, 255);

# Pack the DV cell data.
    my $dv_count = scalar @$cells;
    my $dv_data  = pack 'v', $dv_count;
    for my $range (@$cells) {
        $dv_data .= pack 'vvvv', $range->[0],
                                 $range->[2],
                                 $range->[1],
                                 $range->[3];
    }

# Pack the record.
    my $data   = pack 'V', $flags;
       $data  .= $input_title;
       $data  .= $error_title;
       $data  .= $input_message;
       $data  .= $error_message;
       $data  .= $formula_1;
       $data  .= $formula_2;
       $data  .= $dv_data;

my $header = pack('vv', $record, length $data);

$self->_append($header, $data);
}

###############################################################################
#
# _pack_dv_string()
#
# Pack the strings used in the input and error dialog captions and messages.
# Captions are limited to 32 characters. Messages are limited to 255 chars.
#
sub _pack_dv_string {

my $self        = shift;

my $string      = $_[0];
    my $max_length  = $_[1];

my $str_length  = 0;
    my $encoding    = 0;

# The default empty string is "\0".
    if (!defined $string || $string eq '') {
        $string = "\0";
    }

# Excel limits DV captions to 32 chars and messages to 255.
    if (length $string > $max_length) {
        $string = substr($string, 0, $max_length);
    }

$str_length = length $string;

# Handle utf8 strings in perl 5.8.
    if ($] >= 5.008) {
        require Encode;

if (Encode::is_utf8($string)) {
            $string = Encode::encode("UTF-16LE", $string);
            $encoding = 1;
        }
    }

return pack('vC', $str_length, $encoding) . $string;
}

###############################################################################
#
# _pack_dv_formula()
#
# Pack the formula used in the DV record. This is the same as an cell formula
# with some additional header information. Note, DV formulas in Excel use
# relative addressing (R1C1 and ptgXxxN) however we use the Formula.pm's
# default absolute addressing (A1 and ptgXxx).
#
sub _pack_dv_formula {

my $self        = shift;

my $formula     = $_[0];
    my $encoding    = 0;
    my $length      = 0;
    my $unused      = 0x0000;
    my @tokens;

# Return a default structure for unused formulas.
    if (!defined $formula || $formula eq '') {
        return pack('vv', 0, $unused);
    }

# Pack a list array ref as a null separated string.
    if (ref $formula eq 'ARRAY') {
        $formula   = join "\0", @$formula;
        $formula   = qq("$formula");
    }

# 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
    }
    else {
        # TODO test for non valid ptgs such as Sheet2!A1
    }
    # Force 2d ranges to be a reference class.
    s/_range2d/_range2dR/ for @tokens;
    s/_name/_nameR/       for @tokens;

# Parse the tokens into a formula string.
    $formula = $parser->parse_tokens(@tokens);

return pack('vv', length $formula, $unused) . $formula;
}

__END__

=encoding latin1

=head1 NAME

Worksheet - A writer class for Excel Worksheets.

=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

Cancel

Page 6 – Orso Voyage

VIP Cresus Casino : guide complet de l’inscription et de la vérification de compte

Guide complet du VIP Cresus Casino : tout ce qu’il faut savoir Après la mise en avant du hero image, plongez directement dans l’univers du VIP Cresus Casino. Que vous soyez déjà joueur ou que vous envisagiez de rejoindre la plateforme, cet article vous donne les clefs pour tirer le meilleur parti du statut VIP, […]

Dashboard

Archives