Windows NT DGPENSV2LPKMN 10.0 build 14393 (Windows Server 2016) AMD64
Apache/2.4.46 (Win64) OpenSSL/1.1.1h PHP/7.3.25
: 172.16.0.66 | : 172.16.0.254
Cant Read [ /etc/named.conf ]
7.3.25
SYSTEM
www.github.com/MadExploits
Terminal
AUTO ROOT
Adminer
Backdoor Destroyer
Linux Exploit
Lock Shell
Lock File
Create User
CREATE RDP
PHP Mailer
BACKCONNECT
UNLOCK SHELL
HASH IDENTIFIER
CPANEL RESET
CREATE WP USER
BLACK DEFEND!
README
+ Create Folder
+ Create File
[ A ]
[ C ]
[ D ]
C: /
xampp7 /
perl /
vendor /
lib /
Excel /
Writer /
XLSX /
[ HOME SHELL ]
Name
Size
Permission
Action
Chart
[ DIR ]
drwxrwxrwx
Package
[ DIR ]
drwxrwxrwx
Chart.pm
217.55
KB
-rw-rw-rw-
Chartsheet.pm
7.93
KB
-rw-rw-rw-
Drawing.pm
32.68
KB
-rw-rw-rw-
Examples.pm
342.2
KB
-rw-rw-rw-
Format.pm
19.87
KB
-rw-rw-rw-
Shape.pm
19.7
KB
-rw-rw-rw-
Utility.pm
28.8
KB
-rw-rw-rw-
Workbook.pm
72.41
KB
-rw-rw-rw-
Worksheet.pm
276.22
KB
-rw-rw-rw-
Delete
Unzip
Zip
${this.title}
Close
Code Editor : Worksheet.pm
package Excel::Writer::XLSX::Worksheet; ############################################################################### # # Worksheet - A class for writing Excel Worksheets. # # # Used in conjunction with Excel::Writer::XLSX # # Copyright 2000-2020, John McNamara, jmcnamara@cpan.org # # Documentation after __END__ # # perltidy with the following options: -mbl=2 -pt=0 -nola use 5.008002; use strict; use warnings; use Carp; use File::Temp 'tempfile'; use List::Util qw(max min); use Excel::Writer::XLSX::Format; use Excel::Writer::XLSX::Drawing; use Excel::Writer::XLSX::Package::XMLwriter; use Excel::Writer::XLSX::Utility qw(xl_cell_to_rowcol xl_rowcol_to_cell xl_col_to_name xl_range quote_sheetname); our @ISA = qw(Excel::Writer::XLSX::Package::XMLwriter); our $VERSION = '1.05'; ############################################################################### # # Public and private API methods. # ############################################################################### ############################################################################### # # new() # # Constructor. # sub new { my $class = shift; my $fh = shift; my $self = Excel::Writer::XLSX::Package::XMLwriter->new( $fh ); my $rowmax = 1_048_576; my $colmax = 16_384; my $strmax = 32767; $self->{_name} = $_[0]; $self->{_index} = $_[1]; $self->{_activesheet} = $_[2]; $self->{_firstsheet} = $_[3]; $self->{_str_total} = $_[4]; $self->{_str_unique} = $_[5]; $self->{_str_table} = $_[6]; $self->{_date_1904} = $_[7]; $self->{_palette} = $_[8]; $self->{_optimization} = $_[9] || 0; $self->{_tempdir} = $_[10]; $self->{_excel2003_style} = $_[11]; $self->{_default_url_format} = $_[12]; $self->{_max_url_length} = $_[13] || 2079; $self->{_ext_sheets} = []; $self->{_fileclosed} = 0; $self->{_excel_version} = 2007; $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->{_selections} = []; $self->{_hidden} = 0; $self->{_active} = 0; $self->{_tab_color} = 0; $self->{_panes} = []; $self->{_active_pane} = 3; $self->{_selected} = 0; $self->{_hide_row_col_headers} = 0; $self->{_page_setup_changed} = 0; $self->{_paper_size} = 0; $self->{_orientation} = 1; $self->{_print_options_changed} = 0; $self->{_hcenter} = 0; $self->{_vcenter} = 0; $self->{_print_gridlines} = 0; $self->{_screen_gridlines} = 1; $self->{_print_headers} = 0; $self->{_header_footer_changed} = 0; $self->{_header} = ''; $self->{_footer} = ''; $self->{_header_footer_aligns} = 1; $self->{_header_footer_scales} = 1; $self->{_header_images} = []; $self->{_footer_images} = []; $self->{_margin_left} = 0.7; $self->{_margin_right} = 0.7; $self->{_margin_top} = 0.75; $self->{_margin_bottom} = 0.75; $self->{_margin_header} = 0.3; $self->{_margin_footer} = 0.3; $self->{_repeat_rows} = ''; $self->{_repeat_cols} = ''; $self->{_print_area} = ''; $self->{_page_order} = 0; $self->{_black_white} = 0; $self->{_draft_quality} = 0; $self->{_print_comments} = 0; $self->{_page_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->{_set_cols} = {}; $self->{_set_rows} = {}; $self->{_zoom} = 100; $self->{_zoom_scale_normal} = 1; $self->{_print_scale} = 100; $self->{_right_to_left} = 0; $self->{_show_zeros} = 1; $self->{_leading_zeros} = 0; $self->{_outline_row_level} = 0; $self->{_outline_col_level} = 0; $self->{_outline_style} = 0; $self->{_outline_below} = 1; $self->{_outline_right} = 1; $self->{_outline_on} = 1; $self->{_outline_changed} = 0; $self->{_original_row_height} = 15; $self->{_default_row_height} = 15; $self->{_default_row_pixels} = 20; $self->{_default_col_width} = 8.43; $self->{_default_col_pixels} = 64; $self->{_default_row_zeroed} = 0; $self->{_names} = {}; $self->{_write_match} = []; $self->{_table} = {}; $self->{_merge} = []; $self->{_has_vml} = 0; $self->{_has_header_vml} = 0; $self->{_has_comments} = 0; $self->{_comments} = {}; $self->{_comments_array} = []; $self->{_comments_author} = ''; $self->{_comments_visible} = 0; $self->{_vml_shape_id} = 1024; $self->{_buttons_array} = []; $self->{_header_images_array} = []; $self->{_autofilter} = ''; $self->{_filter_on} = 0; $self->{_filter_range} = []; $self->{_filter_cols} = {}; $self->{_col_sizes} = {}; $self->{_row_sizes} = {}; $self->{_col_formats} = {}; $self->{_col_size_changed} = 0; $self->{_row_size_changed} = 0; $self->{_last_shape_id} = 1; $self->{_rel_count} = 0; $self->{_hlink_count} = 0; $self->{_hlink_refs} = []; $self->{_external_hyper_links} = []; $self->{_external_drawing_links} = []; $self->{_external_comment_links} = []; $self->{_external_vml_links} = []; $self->{_external_table_links} = []; $self->{_drawing_links} = []; $self->{_vml_drawing_links} = []; $self->{_charts} = []; $self->{_images} = []; $self->{_tables} = []; $self->{_sparklines} = []; $self->{_shapes} = []; $self->{_shape_hash} = {}; $self->{_has_shapes} = 0; $self->{_drawing} = 0; $self->{_drawing_rels} = {}; $self->{_drawing_rels_id} = 0; $self->{_vml_drawing_rels} = {}; $self->{_vml_drawing_rels_id} = 0; $self->{_horizontal_dpi} = 0; $self->{_vertical_dpi} = 0; $self->{_rstring} = ''; $self->{_previous_row} = 0; if ( $self->{_optimization} == 1 ) { my $fh = tempfile( DIR => $self->{_tempdir} ); binmode $fh, ':utf8'; $self->{_cell_data_fh} = $fh; $self->{_fh} = $fh; } $self->{_validations} = []; $self->{_cond_formats} = {}; $self->{_data_bars_2010} = []; $self->{_use_data_bars_2010} = 0; $self->{_dxf_priority} = 1; if ( $self->{_excel2003_style} ) { $self->{_original_row_height} = 12.75; $self->{_default_row_height} = 12.75; $self->{_default_row_pixels} = 17; $self->{_margin_left} = 0.75; $self->{_margin_right} = 0.75; $self->{_margin_top} = 1; $self->{_margin_bottom} = 1; $self->{_margin_header} = 0.5; $self->{_margin_footer} = 0.5; $self->{_header_footer_aligns} = 0; } bless $self, $class; return $self; } ############################################################################### # # _set_xml_writer() # # Over-ridden to ensure that write_single_row() is called for the final row # when optimisation mode is on. # sub _set_xml_writer { my $self = shift; my $filename = shift; if ( $self->{_optimization} == 1 ) { $self->_write_single_row(); } $self->SUPER::_set_xml_writer( $filename ); } ############################################################################### # # _assemble_xml_file() # # Assemble and write the XML file. # sub _assemble_xml_file { my $self = shift; $self->xml_declaration(); # Write the root worksheet element. $self->_write_worksheet(); # Write the worksheet properties. $self->_write_sheet_pr(); # Write the worksheet dimensions. $self->_write_dimension(); # Write the sheet view properties. $self->_write_sheet_views(); # Write the sheet format properties. $self->_write_sheet_format_pr(); # Write the sheet column info. $self->_write_cols(); # Write the worksheet data such as rows columns and cells. if ( $self->{_optimization} == 0 ) { $self->_write_sheet_data(); } else { $self->_write_optimized_sheet_data(); } # Write the sheetProtection element. $self->_write_sheet_protection(); # Write the worksheet calculation properties. #$self->_write_sheet_calc_pr(); # Write the worksheet phonetic properties. if ($self->{_excel2003_style}) { $self->_write_phonetic_pr(); } # Write the autoFilter element. $self->_write_auto_filter(); # Write the mergeCells element. $self->_write_merge_cells(); # Write the conditional formats. $self->_write_conditional_formats(); # Write the dataValidations element. $self->_write_data_validations(); # Write the hyperlink element. $self->_write_hyperlinks(); # Write the printOptions element. $self->_write_print_options(); # Write the worksheet page_margins. $self->_write_page_margins(); # Write the worksheet page setup. $self->_write_page_setup(); # Write the headerFooter element. $self->_write_header_footer(); # Write the rowBreaks element. $self->_write_row_breaks(); # Write the colBreaks element. $self->_write_col_breaks(); # Write the drawing element. $self->_write_drawings(); # Write the legacyDrawing element. $self->_write_legacy_drawing(); # Write the legacyDrawingHF element. $self->_write_legacy_drawing_hf(); # Write the tableParts element. $self->_write_table_parts(); # Write the extLst elements. $self->_write_ext_list(); # Close the worksheet tag. $self->xml_end_tag( 'worksheet' ); # Close the XML writer filehandle. $self->xml_get_fh()->close(); } ############################################################################### # # _close() # # Write the worksheet elements. # sub _close { # TODO. Unused. Remove after refactoring. my $self = shift; my $sheetnames = shift; my $num_sheets = scalar @$sheetnames; } ############################################################################### # # get_name(). # # Retrieve the worksheet name. # sub get_name { my $self = shift; return $self->{_name}; } ############################################################################### # # 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 flags to prevent modification of worksheet # objects. # sub protect { my $self = shift; my $password = shift || ''; my $options = shift || {}; if ( $password ne '' ) { $password = $self->_encode_password( $password ); } # Default values for objects that can be protected. my %defaults = ( sheet => 1, content => 0, objects => 0, scenarios => 0, format_cells => 0, format_columns => 0, format_rows => 0, insert_columns => 0, insert_rows => 0, insert_hyperlinks => 0, delete_columns => 0, delete_rows => 0, select_locked_cells => 1, sort => 0, autofilter => 0, pivot_tables => 0, select_unlocked_cells => 1, ); # Overwrite the defaults with user specified values. for my $key ( keys %{$options} ) { if ( exists $defaults{$key} ) { $defaults{$key} = $options->{$key}; } else { carp "Unknown protection object: $key\n"; } } # Set the password after the user defined values. $defaults{password} = $password; $self->{_protect} = \%defaults; } ############################################################################### # # _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 sprintf "%X", $password; } ############################################################################### # # set_column($firstcol, $lastcol, $width, $format, $hidden, $level) # # Set the width of a single column or a range of columns. # See also: _write_col_info # 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]; # Check that cols are valid and store max and min values with default row. # NOTE: The check shouldn't modify the row dimensions and should only modify # the column dimensions in certain cases. my $ignore_row = 1; my $ignore_col = 1; $ignore_col = 0 if ref $data[3]; # Column has a format. $ignore_col = 0 if $data[2] && $data[4]; # Column has a width but is hidden return -2 if $self->_check_dimensions( 0, $data[0], $ignore_row, $ignore_col ); return -2 if $self->_check_dimensions( 0, $data[1], $ignore_row, $ignore_col ); # Set the limits for the outline levels (0 <= x <= 7). $data[5] = 0 unless defined $data[5]; $data[5] = 0 if $data[5] < 0; $data[5] = 7 if $data[5] > 7; if ( $data[5] > $self->{_outline_col_level} ) { $self->{_outline_col_level} = $data[5]; } # Store the column data based on the first column. Padded for sorting. $self->{_colinfo}->{ sprintf "%05d", $data[0] } = [@data]; # Store the column change to allow optimisations. $self->{_col_size_changed} = 1; # Store the col sizes for use when calculating image vertices taking # hidden columns into account. Also store the column formats. my $width = $data[2]; my $format = $data[3]; my $hidden = $data[4] || 0; $width = $self->{_default_col_width} if !defined $width; my ( $firstcol, $lastcol ) = @data; foreach my $col ( $firstcol .. $lastcol ) { $self->{_col_sizes}->{$col} = [$width, $hidden]; $self->{_col_formats}->{$col} = $format if $format; } } ############################################################################### # # set_selection() # # Set which cell or cells are selected in a worksheet. # sub set_selection { my $self = shift; my $pane; my $active_cell; my $sqref; return unless @_; # Check for a cell reference in A1 notation and substitute row and column. if ( $_[0] =~ /^\D/ ) { @_ = $self->_substitute_cellref( @_ ); } # There should be either 2 or 4 arguments. if ( @_ == 2 ) { # Single cell selection. $active_cell = xl_rowcol_to_cell( $_[0], $_[1] ); $sqref = $active_cell; } elsif ( @_ == 4 ) { # Range selection. $active_cell = xl_rowcol_to_cell( $_[0], $_[1] ); my ( $row_first, $col_first, $row_last, $col_last ) = @_; # Swap last row/col for first row/col as necessary if ( $row_first > $row_last ) { ( $row_first, $row_last ) = ( $row_last, $row_first ); } if ( $col_first > $col_last ) { ( $col_first, $col_last ) = ( $col_last, $col_first ); } # If the first and last cell are the same write a single cell. if ( ( $row_first == $row_last ) && ( $col_first == $col_last ) ) { $sqref = $active_cell; } else { $sqref = xl_range( $row_first, $row_last, $col_first, $col_last ); } } else { # User supplied wrong number or arguments. return; } # Selection isn't set for cell A1. return if $sqref eq 'A1'; $self->{_selections} = [ [ $pane, $active_cell, $sqref ] ]; } ############################################################################### # # freeze_panes( $row, $col, $top_row, $left_col ) # # Set panes and mark them as frozen. # sub freeze_panes { my $self = shift; return unless @_; # Check for a cell reference in A1 notation and substitute row and column. if ( $_[0] =~ /^\D/ ) { @_ = $self->_substitute_cellref( @_ ); } my $row = shift; my $col = shift || 0; my $top_row = shift || $row; my $left_col = shift || $col; my $type = shift || 0; $self->{_panes} = [ $row, $col, $top_row, $left_col, $type ]; } ############################################################################### # # split_panes( $y, $x, $top_row, $left_col ) # # Set panes and mark them as split. # # Implementers note. The API for this method doesn't map well from the XLS # file format and isn't sufficient to describe all cases of split panes. # It should probably be something like: # # split_panes( $y, $x, $top_row, $left_col, $offset_row, $offset_col ) # # I'll look at changing this if it becomes an issue. # sub split_panes { my $self = shift; # Call freeze panes but add the type flag for split panes. $self->freeze_panes( @_[ 0 .. 3 ], 2 ); } # 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; $self->{_page_setup_changed} = 1; } ############################################################################### # # set_landscape() # # Set the page orientation as landscape. # sub set_landscape { my $self = shift; $self->{_orientation} = 0; $self->{_page_setup_changed} = 1; } ############################################################################### # # 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 tab. # sub set_tab_color { my $self = shift; my $color = &Excel::Writer::XLSX::Format::_get_color( $_[0] ); $self->{_tab_color} = $color; } ############################################################################### # # set_paper() # # Set the paper type. Ex. 1 = US Letter, 9 = A4 # sub set_paper { my $self = shift; my $paper_size = shift; if ( $paper_size ) { $self->{_paper_size} = $paper_size; $self->{_page_setup_changed} = 1; } } ############################################################################### # # set_header() # # Set the page header caption and optional margin. # sub set_header { my $self = shift; my $string = $_[0] || ''; my $margin = $_[1] || 0.3; my $options = $_[2] || {}; # Replace the Excel placeholder &[Picture] with the internal &G. $string =~ s/&\[Picture\]/&G/g; if ( length $string >= 255 ) { carp 'Header string must be less than 255 characters'; return; } if ( defined $options->{align_with_margins} ) { $self->{_header_footer_aligns} = $options->{align_with_margins}; } if ( defined $options->{scale_with_doc} ) { $self->{_header_footer_scales} = $options->{scale_with_doc}; } # Reset the array in case the function is called more than once. $self->{_header_images} = []; if ( $options->{image_left} ) { push @{ $self->{_header_images} }, [ $options->{image_left}, 'LH' ]; } if ( $options->{image_center} ) { push @{ $self->{_header_images} }, [ $options->{image_center}, 'CH' ]; } if ( $options->{image_right} ) { push @{ $self->{_header_images} }, [ $options->{image_right}, 'RH' ]; } my $placeholder_count = () = $string =~ /&G/g; my $image_count = @{ $self->{_header_images} }; if ( $image_count != $placeholder_count ) { warn "Number of header images ($image_count) doesn't match placeholder " . "count ($placeholder_count) in string: $string\n"; $self->{_header_images} = []; return; } if ( $image_count ) { $self->{_has_header_vml} = 1; } $self->{_header} = $string; $self->{_margin_header} = $margin; $self->{_header_footer_changed} = 1; } ############################################################################### # # set_footer() # # Set the page footer caption and optional margin. # sub set_footer { my $self = shift; my $string = $_[0] || ''; my $margin = $_[1] || 0.3; my $options = $_[2] || {}; # Replace the Excel placeholder &[Picture] with the internal &G. $string =~ s/&\[Picture\]/&G/g; if ( length $string >= 255 ) { carp 'Footer string must be less than 255 characters'; return; } if ( defined $options->{align_with_margins} ) { $self->{_header_footer_aligns} = $options->{align_with_margins}; } if ( defined $options->{scale_with_doc} ) { $self->{_header_footer_scales} = $options->{scale_with_doc}; } # Reset the array in case the function is called more than once. $self->{_footer_images} = []; if ( $options->{image_left} ) { push @{ $self->{_footer_images} }, [ $options->{image_left}, 'LF' ]; } if ( $options->{image_center} ) { push @{ $self->{_footer_images} }, [ $options->{image_center}, 'CF' ]; } if ( $options->{image_right} ) { push @{ $self->{_footer_images} }, [ $options->{image_right}, 'RF' ]; } my $placeholder_count = () = $string =~ /&G/g; my $image_count = @{ $self->{_footer_images} }; if ( $image_count != $placeholder_count ) { warn "Number of footer images ($image_count) doesn't match placeholder " . "count ($placeholder_count) in string: $string\n"; $self->{_footer_images} = []; return; } if ( $image_count ) { $self->{_has_header_vml} = 1; } $self->{_footer} = $string; $self->{_margin_footer} = $margin; $self->{_header_footer_changed} = 1; } ############################################################################### # # center_horizontally() # # Center the page horizontally. # sub center_horizontally { my $self = shift; $self->{_print_options_changed} = 1; $self->{_hcenter} = 1; } ############################################################################### # # center_vertically() # # Center the page horizontally. # sub center_vertically { my $self = shift; $self->{_print_options_changed} = 1; $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; my $margin = shift; my $default = 0.7; # Add 0 to ensure the argument is numeric. if ( defined $margin ) { $margin = 0 + $margin } else { $margin = $default } $self->{_margin_left} = $margin; } ############################################################################### # # set_margin_right() # # Set the right margin in inches. # sub set_margin_right { my $self = shift; my $margin = shift; my $default = 0.7; # Add 0 to ensure the argument is numeric. if ( defined $margin ) { $margin = 0 + $margin } else { $margin = $default } $self->{_margin_right} = $margin; } ############################################################################### # # set_margin_top() # # Set the top margin in inches. # sub set_margin_top { my $self = shift; my $margin = shift; my $default = 0.75; # Add 0 to ensure the argument is numeric. if ( defined $margin ) { $margin = 0 + $margin } else { $margin = $default } $self->{_margin_top} = $margin; } ############################################################################### # # set_margin_bottom() # # Set the bottom margin in inches. # sub set_margin_bottom { my $self = shift; my $margin = shift; my $default = 0.75; # Add 0 to ensure the argument is numeric. if ( defined $margin ) { $margin = 0 + $margin } else { $margin = $default } $self->{_margin_bottom} = $margin; } ############################################################################### # # repeat_rows($first_row, $last_row) # # Set the rows to repeat at the top of each printed page. # sub repeat_rows { my $self = shift; my $row_min = $_[0]; my $row_max = $_[1] || $_[0]; # Second row is optional # Convert to 1 based. $row_min++; $row_max++; my $area = '$' . $row_min . ':' . '$' . $row_max; # Build up the print titles "Sheet1!$1:$2" my $sheetname = quote_sheetname( $self->{_name} ); $area = $sheetname . "!" . $area; $self->{_repeat_rows} = $area; } ############################################################################### # # repeat_columns($first_col, $last_col) # # Set the columns to repeat at the left hand side of each printed page. This is # stored as a <NamedRange> element. # 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 } my $col_min = $_[0]; my $col_max = $_[1] || $_[0]; # Second col is optional # Convert to A notation. $col_min = xl_col_to_name( $_[0], 1 ); $col_max = xl_col_to_name( $_[1], 1 ); my $area = $col_min . ':' . $col_max; # Build up the print area range "=Sheet2!C1:C2" my $sheetname = quote_sheetname( $self->{_name} ); $area = $sheetname . "!" . $area; $self->{_repeat_cols} = $area; } ############################################################################### # # print_area($first_row, $first_col, $last_row, $last_col) # # Set the print area in the current worksheet. This is stored as a <NamedRange> # element. # 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 my ( $row1, $col1, $row2, $col2 ) = @_; # Ignore max print area since this is the same as no print area for Excel. if ( $row1 == 0 and $col1 == 0 and $row2 == $self->{_xls_rowmax} - 1 and $col2 == $self->{_xls_colmax} - 1 ) { return; } # Build up the print area range "=Sheet2!R1C1:R2C1" my $area = $self->_convert_name_area( $row1, $col1, $row2, $col2 ); $self->{_print_area} = $area; } ############################################################################### # # 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; # Build up the print area range "Sheet1!$A$1:$C$13". my $area = $self->_convert_name_area( $row1, $col1, $row2, $col2 ); my $ref = xl_range( $row1, $row2, $col1, $col2 ); $self->{_autofilter} = $area; $self->{_autofilter_ref} = $ref; $self->{_filter_range} = [ $col1, $col2 ]; } ############################################################################### # # 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->{_autofilter}; croak "Incorrect number of arguments to filter_column()" unless @_ == 2; # Check for a column reference in A1 notation and substitute. if ( $col =~ /^\D/ ) { my $col_letter = $col; # Convert col ref to a cell ref and then to a col number. ( undef, $col ) = $self->_substitute_cellref( $col . '1' ); croak "Invalid column '$col_letter'" if $col >= $self->{_xls_colmax}; } my ( $col_first, $col_last ) = @{ $self->{_filter_range} }; # 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 ); # Excel handles single or double custom filters as default filters. We need # to check for them and handle them accordingly. if ( @tokens == 2 && $tokens[0] == 2 ) { # Single equality. $self->filter_column_list( $col, $tokens[1] ); } elsif (@tokens == 5 && $tokens[0] == 2 && $tokens[2] == 1 && $tokens[3] == 2 ) { # Double equality with "or" operator. $self->filter_column_list( $col, $tokens[1], $tokens[4] ); } else { # Non default custom filter. $self->{_filter_cols}->{$col} = [@tokens]; $self->{_filter_type}->{$col} = 0; } $self->{_filter_on} = 1; } ############################################################################### # # filter_column_list($column, @matches ) # # Set the column filter criteria in Excel 2007 list style. # sub filter_column_list { my $self = shift; my $col = shift; my @tokens = @_; croak "Must call autofilter() before filter_column_list()" unless $self->{_autofilter}; croak "Incorrect number of arguments to filter_column_list()" unless @tokens; # Check for a column reference in A1 notation and substitute. if ( $col =~ /^\D/ ) { my $col_letter = $col; # Convert col ref to a cell ref and then to a col number. ( undef, $col ) = $self->_substitute_cellref( $col . '1' ); croak "Invalid column '$col_letter'" if $col >= $self->{_xls_colmax}; } my ( $col_first, $col_last ) = @{ $self->{_filter_range} }; # 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)"; } $self->{_filter_cols}->{$col} = [@tokens]; $self->{_filter_type}->{$col} = 1; # Default style. $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 ) { $token = ' '; } } else { if ( $operator == 5 ) { $operator = 2; $token = 'blanks'; } else { $operator = 5; $token = ' '; } } } # 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 ); } ############################################################################### # # _convert_name_area($first_row, $first_col, $last_row, $last_col) # # Convert zero indexed rows and columns to the format required by worksheet # named ranges, eg, "Sheet1!$A$1:$C$13". # sub _convert_name_area { my $self = shift; my $row_num_1 = $_[0]; my $col_num_1 = $_[1]; my $row_num_2 = $_[2]; my $col_num_2 = $_[3]; my $range1 = ''; my $range2 = ''; my $row_col_only = 0; my $area; # Convert to A1 notation. my $col_char_1 = xl_col_to_name( $col_num_1, 1 ); my $col_char_2 = xl_col_to_name( $col_num_2, 1 ); my $row_char_1 = '$' . ( $row_num_1 + 1 ); my $row_char_2 = '$' . ( $row_num_2 + 1 ); # We need to handle some special cases that refer to rows or columns only. if ( $row_num_1 == 0 and $row_num_2 == $self->{_xls_rowmax} - 1 ) { $range1 = $col_char_1; $range2 = $col_char_2; $row_col_only = 1; } elsif ( $col_num_1 == 0 and $col_num_2 == $self->{_xls_colmax} - 1 ) { $range1 = $row_char_1; $range2 = $row_char_2; $row_col_only = 1; } else { $range1 = $col_char_1 . $row_char_1; $range2 = $col_char_2 . $row_char_2; } # A repeated range is only written once (if it isn't a special case). if ( $range1 eq $range2 && !$row_col_only ) { $area = $range1; } else { $area = $range1 . ':' . $range2; } # Build up the print area range "Sheet1!$A$1:$C$13". my $sheetname = quote_sheetname( $self->{_name} ); $area = $sheetname . "!" . $area; return $area; } ############################################################################### # # hide_gridlines() # # Set the option to hide gridlines on the screen and the printed page. # # This was mainly useful for Excel 5 where printed gridlines were on by # default. # sub hide_gridlines { my $self = shift; my $option = defined $_[0] ? $_[0] : 1; # Default to hiding printed gridlines if ( $option == 0 ) { $self->{_print_gridlines} = 1; # 1 = display, 0 = hide $self->{_screen_gridlines} = 1; $self->{_print_options_changed} = 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; my $headers = defined $_[0] ? $_[0] : 1; if ( $headers ) { $self->{_print_headers} = 1; $self->{_print_options_changed} = 1; } else { $self->{_print_headers} = 0; } } ############################################################################### # # hide_row_col_headers() # # Set the option to hide the row and column headers in Excel. # sub hide_row_col_headers { my $self = shift; $self->{_hide_row_col_headers} = 1; } ############################################################################### # # fit_to_pages($width, $height) # # Store the vertical and horizontal number of pages that will define the # maximum area printed. # sub fit_to_pages { my $self = shift; $self->{_fit_page} = 1; $self->{_fit_width} = defined $_[0] ? $_[0] : 1; $self->{_fit_height} = defined $_[1] ? $_[1] : 1; $self->{_page_setup_changed} = 1; } ############################################################################### # # 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; $self->{_page_setup_changed} = 1; } ############################################################################### # # print_black_and_white() # # Set the option to print the worksheet in black and white. # sub print_black_and_white { my $self = shift; $self->{_black_white} = 1; } ############################################################################### # # 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} = $_[0] if defined $_[0]; } ############################################################################### # # right_to_left() # # Display the worksheet right to left for some eastern versions of Excel. # sub right_to_left { my $self = shift; $self->{_right_to_left} = defined $_[0] ? $_[0] : 1; } ############################################################################### # # hide_zero() # # Hide cell zero values. # sub hide_zero { my $self = shift; $self->{_show_zeros} = defined $_[0] ? not $_[0] : 0; } ############################################################################### # # print_across() # # Set the order in which pages are printed. # sub print_across { my $self = shift; my $page_order = defined $_[0] ? $_[0] : 1; if ( $page_order ) { $self->{_page_order} = 1; $self->{_page_setup_changed} = 1; } else { $self->{_page_order} = 0; } } ############################################################################### # # set_start_page() # # Set the start page number. # sub set_start_page { my $self = shift; return unless defined $_[0]; $self->{_page_start} = $_[0]; } ############################################################################### # # 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 = $self->{_xls_rowmax} if $row > $self->{_xls_rowmax}; $col = $self->{_xls_colmax} if $col > $self->{_xls_colmax}; $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. # # 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 =~ /^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/ ) { return $self->write_number( @_ ); } # Match http, https or ftp URL elsif ( $token =~ m|^[fh]tt?ps?://| ) { return $self->write_url( @_ ); } # Match mailto: elsif ( $token =~ m/^mailto:/ ) { return $self->write_url( @_ ); } # Match internal or external sheet link elsif ( $token =~ m[^(?:in|ex)ternal:] ) { return $self->write_url( @_ ); } # Match formula elsif ( $token =~ /^=/ ) { return $self->write_formula( @_ ); } # Match array 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( @_ ); } # Default: match string 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; for 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; for 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 ); $self->{_has_vml} = 1; $self->{_has_comments} = 1; # Process the properties of the cell comment. $self->{_comments}->{$row}->{$col} = [ @_ ]; } ############################################################################### # # 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 $row = $_[0]; # Zero indexed row my $col = $_[1]; # Zero indexed column my $num = $_[2] + 0; my $xf = $_[3]; # The cell format my $type = 'n'; # The data type # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row}->{$col} = [ $type, $num, $xf ]; 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 32767 chars # -4 : Ignore undef strings # 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 $row = $_[0]; # Zero indexed row my $col = $_[1]; # Zero indexed column my $str = $_[2]; my $xf = $_[3]; # The cell format my $type = 's'; # The data type my $index; my $str_error = 0; # Ignore undef strings. return -4 if !defined $str; # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); # Check that the string is < 32767 chars if ( length $str > $self->{_xls_strmax} ) { $str = substr( $str, 0, $self->{_xls_strmax} ); $str_error = -3; } # Write a shared string or an in-line string based on optimisation level. if ( $self->{_optimization} == 0 ) { $index = $self->_get_shared_string_index( $str ); } else { $index = $str; } # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row}->{$col} = [ $type, $index, $xf ]; return $str_error; } ############################################################################### # # write_rich_string( $row, $column, $format, $string, ..., $cell_format ) # # The write_rich_string() method is used to write strings with multiple formats. # The method receives string fragments prefixed by format objects. The final # format object is used as the cell format. # # Returns 0 : normal termination. # -1 : insufficient number of arguments. # -2 : row or column out of range. # -3 : long string truncated to 32767 chars. # -4 : 2 consecutive formats used. # sub write_rich_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 $row = shift; # Zero indexed row. my $col = shift; # Zero indexed column. my $str = ''; my $xf = undef; my $type = 's'; # The data type. my $length = 0; # String length. my $index; my $str_error = 0; # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); # If the last arg is a format we use it as the cell format. if ( ref $_[-1] ) { $xf = pop @_; } # Create a temp XML::Writer object and use it to write the rich string # XML to a string. open my $str_fh, '>', \$str or die "Failed to open filehandle: $!"; binmode $str_fh, ':utf8'; my $writer = Excel::Writer::XLSX::Package::XMLwriter->new( $str_fh ); $self->{_rstring} = $writer; # Create a temp format with the default font for unformatted fragments. my $default = Excel::Writer::XLSX::Format->new(); # Convert the list of $format, $string tokens to pairs of ($format, $string) # except for the first $string fragment which doesn't require a default # formatting run. Use the default for strings without a leading format. my @fragments; my $last = 'format'; my $pos = 0; for my $token ( @_ ) { if ( !ref $token ) { # Token is a string. if ( $last ne 'format' ) { # If previous token wasn't a format add one before the string. push @fragments, ( $default, $token ); } else { # If previous token was a format just add the string. push @fragments, $token; } $length += length $token; # Keep track of actual string length. $last = 'string'; } else { # Can't allow 2 formats in a row. if ( $last eq 'format' && $pos > 0 ) { return -4; } # Token is a format object. Add it to the fragment list. push @fragments, $token; $last = 'format'; } $pos++; } # If the first token is a string start the <r> element. if ( !ref $fragments[0] ) { $self->{_rstring}->xml_start_tag( 'r' ); } # Write the XML elements for the $format $string fragments. for my $token ( @fragments ) { if ( ref $token ) { # Write the font run. $self->{_rstring}->xml_start_tag( 'r' ); $self->_write_font( $token ); } else { # Write the string fragment part, with whitespace handling. my @attributes = (); if ( $token =~ /^\s/ || $token =~ /\s$/ ) { push @attributes, ( 'xml:space' => 'preserve' ); } $self->{_rstring}->xml_data_element( 't', $token, @attributes ); $self->{_rstring}->xml_end_tag( 'r' ); } } # Check that the string is < 32767 chars. if ( $length > $self->{_xls_strmax} ) { return -3; } # Write a shared string or an in-line string based on optimisation level. if ( $self->{_optimization} == 0 ) { $index = $self->_get_shared_string_index( $str ); } else { $index = $str; } # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row}->{$col} = [ $type, $index, $xf ]; return 0; } ############################################################################### # # 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 $row = $_[0]; # Zero indexed row my $col = $_[1]; # Zero indexed column my $xf = $_[2]; # The cell format my $type = 'b'; # The data type # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row}->{$col} = [ $type, undef, $xf ]; return 0; } ############################################################################### # # write_formula($row, $col, $formula, $format) # # Write a formula 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 # 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 my $row = $_[0]; # Zero indexed row my $col = $_[1]; # Zero indexed column my $formula = $_[2]; # The formula text string my $xf = $_[3]; # The format object. my $value = $_[4]; # Optional formula value. my $type = 'f'; # The data type # Hand off array formulas. if ( $formula =~ /^{=.*}$/ ) { return $self->write_array_formula( $row, $col, $row, $col, $formula, $xf, $value ); } # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); # Remove the = sign if it exists. $formula =~ s/^=//; # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row}->{$col} = [ $type, $formula, $xf, $value ]; return 0; } ############################################################################### # # write_array_formula($row1, $col1, $row2, $col2, $formula, $format) # # Write an array formula 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 # sub write_array_formula { my $self = shift; # Check for a cell reference in A1 notation and substitute row and column if ( $_[0] =~ /^\D/ ) { @_ = $self->_substitute_cellref( @_ ); } if ( @_ < 5 ) { return -1 } # Check the number of args my $row1 = $_[0]; # First row my $col1 = $_[1]; # First column my $row2 = $_[2]; # Last row my $col2 = $_[3]; # Last column my $formula = $_[4]; # The formula text string my $xf = $_[5]; # The format object. my $value = $_[6]; # Optional formula value. my $type = 'a'; # The data type # Swap last row/col with first row/col as necessary ( $row1, $row2 ) = ( $row2, $row1 ) if $row1 > $row2; ( $col1, $col2 ) = ( $col1, $col2 ) if $col1 > $col2; # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row2, $col2 ); # Define array range my $range; if ( $row1 == $row2 and $col1 == $col2 ) { $range = xl_rowcol_to_cell( $row1, $col1 ); } else { $range = xl_rowcol_to_cell( $row1, $col1 ) . ':' . xl_rowcol_to_cell( $row2, $col2 ); } # Remove array formula braces and the leading =. $formula =~ s/^{(.*)}$/$1/; $formula =~ s/^=//; # Write previous row if in in-line string optimization mode. my $row = $row1; if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row1}->{$col1} = [ $type, $formula, $xf, $range, $value ]; # Pad out the rest of the area with formatted zeroes. if ( !$self->{_optimization} ) { for my $row ( $row1 .. $row2 ) { for my $col ( $col1 .. $col2 ) { next if $row == $row1 and $col == $col1; $self->write_number( $row, $col, 0, $xf ); } } } return 0; } ############################################################################### # # write_blank($row, $col, $format) # # Write a boolean value to the specified row and column (zero indexed). # # Returns 0 : normal termination (including no format) # -2 : row or column out of range # sub write_boolean { 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]; # Zero indexed row my $col = $_[1]; # Zero indexed column my $val = $_[2] ? 1 : 0; # Boolean value. my $xf = $_[3]; # The cell format my $type = 'l'; # The data type # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row}->{$col} = [ $type, $val, $xf ]; return 0; } ############################################################################### # # 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; $self->{_outline_changed} = 1; } ############################################################################### # # Escape urls like Excel. # sub _escape_url { my $url = shift; # Don't escape URL if it looks already escaped. return $url if $url =~ /%[0-9a-fA-F]{2}/; # Escape the URL escape symbol. $url =~ s/%/%25/g; # Escape whitespace in URL. $url =~ s/[\s\x00]/%20/g; # Escape other special characters in URL. $url =~ s/(["<>[\]`^{}])/sprintf '%%%x', ord $1/eg; return $url; } ############################################################################### # # write_url($row, $col, $url, format, $string) # # 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 label is written using the # write_string() method. Therefore the max characters string limit applies. # $string and $format are optional and their order is interchangeable. # # 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 32767 chars # -4 : URL longer than 255 characters # -5 : Exceeds limit of 65_530 urls per worksheet # 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( @_ ); } if ( @_ < 3 ) { return -1 } # Check the number of args # Reverse the order of $string and $format if necessary, for backward # compatibility. We work on a copy in order to protect the callers # args. We don't use "local @_" in case of perl50005 threads. my @args = @_; if (defined $args[3] and !ref $args[3]) { ( $args[3], $args[4] ) = ( $args[4], $args[3] ); } my $row = $args[0]; # Zero indexed row my $col = $args[1]; # Zero indexed column my $url = $args[2]; # URL string my $xf = $args[3]; # Cell format my $str = $args[4]; # Alternative label my $tip = $args[5]; # Tool tip my $type = 'l'; # XML data type my $link_type = 1; my $external = 0; # The displayed string defaults to the url string. $str = $url unless defined $str; # Remove the URI scheme from internal links. if ( $url =~ s/^internal:// ) { $str =~ s/^internal://; $link_type = 2; } # Remove the URI scheme from external links and change the directory # separator from Unix to Dos. if ( $url =~ s/^external:// ) { $str =~ s/^external://; $url =~ s[/][\\]g; $str =~ s[/][\\]g; $external = 1; } # Strip the mailto header. $str =~ s/^mailto://; # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); # Check that the string is < 32767 chars my $str_error = 0; if ( length $str > $self->{_xls_strmax} ) { $str = substr( $str, 0, $self->{_xls_strmax} ); $str_error = -3; } # Copy string for use in hyperlink elements. my $url_str = $str; # External links to URLs and to other Excel workbooks have slightly # different characteristics that we have to account for. if ( $link_type == 1 ) { # Split url into the link and optional anchor/location. ( $url, $url_str ) = split /#/, $url, 2; $url = _escape_url( $url ); # Escape the anchor for hyperlink style urls only. if ( $url_str && !$external ) { $url_str = _escape_url( $url_str ); } # Add the file:/// URI to the url for Windows style "C:/" link and # Network shares. if ( $url =~ m{^\w:} || $url =~ m{^\\\\} ) { $url = 'file:///' . $url; } # Convert a ./dir/file.xlsx link to dir/file.xlsx. $url =~ s{^.\\}{}; } # Excel limits the escaped URL and location/anchor to 255 characters. my $tmp_url_str = $url_str || ''; my $max_url = $self->{_max_url_length}; if ( length $url > $max_url || length $tmp_url_str > $max_url ) { carp "Ignoring URL '$url' where link or anchor > $max_url characters " . "since it exceeds Excel's limit for URLS. See LIMITATIONS " . "section of the Excel::Writer::XLSX documentation."; return -4; } # Check the limit of URLS per worksheet. $self->{_hlink_count}++; if ( $self->{_hlink_count} > 65_530 ) { carp "Ignoring URL '$url' since it exceeds Excel's limit of 65,530 " . "URLs per worksheet. See LIMITATIONS section of the " . "Excel::Writer::XLSX documentation."; return -5; } # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } # Add the default URL format. if ( !defined $xf ) { $xf = $self->{_default_url_format}; } # Write the hyperlink string. $self->write_string( $row, $col, $str, $xf ); # Store the hyperlink data in a separate structure. $self->{_hyperlinks}->{$row}->{$col} = { _link_type => $link_type, _url => $url, _str => $url_str, _tip => $tip }; return $str_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]; my $xf = $_[3]; # The cell format my $type = 'n'; # The data type # Check that row and col are valid and store max and min values return -2 if $self->_check_dimensions( $row, $col ); my $str_error = 0; my $date_time = $self->convert_date_time( $str ); # If the date isn't valid then write it as a string. if ( !defined $date_time ) { return $self->write_string( @_ ); } # Write previous row if in in-line string optimization mode. if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) { $self->_write_single_row( $row ); } $self->{_table}->{$row}->{$col} = [ $type, $date_time, $xf ]; return $str_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->{_date_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, $collapsed) # # This method is used to set the height and XF format for a row. # sub set_row { my $self = shift; my $row = shift; # Row Number. my $height = shift; # Row height. my $xf = shift; # Format object. my $hidden = shift || 0; # Hidden flag. my $level = shift || 0; # Outline level. my $collapsed = shift || 0; # Collapsed row. my $min_col = 0; return unless defined $row; # Ensure at least $row is specified. # Get the default row height. my $default_height = $self->{_default_row_height}; # Use min col in _check_dimensions(). Default to 0 if undefined. if ( defined $self->{_dim_colmin} ) { $min_col = $self->{_dim_colmin}; } # Check that row is valid. return -2 if $self->_check_dimensions( $row, $min_col ); $height = $default_height if !defined $height; # If the height is 0 the row is hidden and the height is the default. if ( $height == 0 ) { $hidden = 1; $height = $default_height; } # Set the limits for the outline levels (0 <= x <= 7). $level = 0 if $level < 0; $level = 7 if $level > 7; if ( $level > $self->{_outline_row_level} ) { $self->{_outline_row_level} = $level; } # Store the row properties. $self->{_set_rows}->{$row} = [ $height, $xf, $hidden, $level, $collapsed ]; # Store the row change to allow optimisations. $self->{_row_size_changed} = 1; # Store the row sizes for use when calculating image vertices. $self->{_row_sizes}->{$row} = [$height, $hidden]; } ############################################################################### # # set_default_row() # # Set the default row properties # sub set_default_row { my $self = shift; my $height = shift || $self->{_original_row_height}; my $zero_height = shift || 0; if ( $height != $self->{_original_row_height} ) { $self->{_default_row_height} = $height; # Store the row change to allow optimisations. $self->{_row_size_changed} = 1; } if ( $zero_height ) { $self->{_default_row_zeroed} = 1; } } ############################################################################### # # merge_range($first_row, $first_col, $last_row, $last_col, $string, $format) # # Merge a range of cells. The first cell should contain the data and the others # should be blank. All cells should contain the same format. # 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; croak "Fifth parameter must be a format object" unless ref $_[5]; my $row_first = shift; my $col_first = shift; my $row_last = shift; my $col_last = shift; my $string = shift; my $format = shift; my @extra_args = @_; # For write_url(). # Excel doesn't allow a single cell to be merged if ( $row_first == $row_last and $col_first == $col_last ) { croak "Can't merge single cell"; } # Swap last row/col with first row/col as necessary ( $row_first, $row_last ) = ( $row_last, $row_first ) if $row_first > $row_last; ( $col_first, $col_last ) = ( $col_last, $col_first ) if $col_first > $col_last; # Check that column number is valid and store the max value return if $self->_check_dimensions( $row_last, $col_last ); # Store the merge range. push @{ $self->{_merge} }, [ $row_first, $col_first, $row_last, $col_last ]; # Write the first cell $self->write( $row_first, $col_first, $string, $format, @extra_args ); # Pad out the rest of the area with formatted blank cells. for my $row ( $row_first .. $row_last ) { for my $col ( $col_first .. $col_last ) { next if $row == $row_first and $col == $col_first; $self->write_blank( $row, $col, $format ); } } } ############################################################################### # # merge_range_type() # # Same as merge_range() above except the type of write() is specified. # sub merge_range_type { my $self = shift; my $type = shift; # Check for a cell reference in A1 notation and substitute row and column if ( $_[0] =~ /^\D/ ) { @_ = $self->_substitute_cellref( @_ ); } my $row_first = shift; my $col_first = shift; my $row_last = shift; my $col_last = shift; my $format; # Get the format. It can be in different positions for the different types. if ( $type eq 'array_formula' || $type eq 'blank' || $type eq 'rich_string' ) { # The format is the last element. $format = $_[-1]; } else { # Or else it is after the token. $format = $_[1]; } # Check that there is a format object. croak "Format object missing or in an incorrect position" unless ref $format; # Excel doesn't allow a single cell to be merged if ( $row_first == $row_last and $col_first == $col_last ) { croak "Can't merge single cell"; } # Swap last row/col with first row/col as necessary ( $row_first, $row_last ) = ( $row_last, $row_first ) if $row_first > $row_last; ( $col_first, $col_last ) = ( $col_last, $col_first ) if $col_first > $col_last; # Check that column number is valid and store the max value return if $self->_check_dimensions( $row_last, $col_last ); # Store the merge range. push @{ $self->{_merge} }, [ $row_first, $col_first, $row_last, $col_last ]; # Write the first cell if ( $type eq 'string' ) { $self->write_string( $row_first, $col_first, @_ ); } elsif ( $type eq 'number' ) { $self->write_number( $row_first, $col_first, @_ ); } elsif ( $type eq 'blank' ) { $self->write_blank( $row_first, $col_first, @_ ); } elsif ( $type eq 'date_time' ) { $self->write_date_time( $row_first, $col_first, @_ ); } elsif ( $type eq 'rich_string' ) { $self->write_rich_string( $row_first, $col_first, @_ ); } elsif ( $type eq 'url' ) { $self->write_url( $row_first, $col_first, @_ ); } elsif ( $type eq 'formula' ) { $self->write_formula( $row_first, $col_first, @_ ); } elsif ( $type eq 'array_formula' ) { $self->write_formula_array( $row_first, $col_first, @_ ); } else { croak "Unknown type '$type'"; } # Pad out the rest of the area with formatted blank cells. for my $row ( $row_first .. $row_last ) { for my $col ( $col_first .. $col_last ) { next if $row == $row_first and $col == $col_first; $self->write_blank( $row, $col, $format ); } } } ############################################################################### # # data_validation($row, $col, {...}) # # This method handles the interface to Excel data validation. # Somewhat ironically 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' => 'none', 'any value' => 'none', 'whole number' => 'whole', 'whole' => 'whole', 'integer' => 'whole', 'decimal' => 'decimal', 'list' => 'list', 'date' => 'date', 'time' => 'time', 'text length' => 'textLength', 'length' => 'textLength', 'custom' => 'custom', ); # 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' # unless there are input messages. if ( $param->{validate} eq 'none' && !defined $param->{input_message} && !defined $param->{input_title} ) { return 0; } # The any, list and custom validations don't have a criteria # so we use a default of 'between'. if ( $param->{validate} eq 'none' || $param->{validate} eq 'list' || $param->{validate} eq 'custom' ) { $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' => 'between', 'not between' => 'notBetween', 'equal to' => 'equal', '=' => 'equal', '==' => 'equal', 'not equal to' => 'notEqual', '!=' => 'notEqual', '<>' => 'notEqual', 'greater than' => 'greaterThan', '>' => 'greaterThan', 'less than' => 'lessThan', '<' => 'lessThan', 'greater than or equal to' => 'greaterThanOrEqual', '>=' => 'greaterThanOrEqual', 'less than or equal to' => 'lessThanOrEqual', '<=' => 'lessThanOrEqual', ); # 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} eq 'between' || $param->{criteria} eq 'notBetween' ) { 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} eq 'date' || $param->{validate} eq 'time' ) { my $date_time = $self->convert_date_time( $param->{value} ); if ( defined $date_time ) { $param->{value} = $date_time; } if ( defined $param->{maximum} ) { my $date_time = $self->convert_date_time( $param->{maximum} ); if ( defined $date_time ) { $param->{maximum} = $date_time; } } } # Check that the input title doesn't exceed the maximum length. if ( $param->{input_title} and length $param->{input_title} > 32 ) { carp "Length of input title '$param->{input_title}'" . " exceeds Excel's limit of 32"; return -3; } # Check that the error title don't exceed the maximum length. if ( $param->{error_title} and length $param->{error_title} > 32 ) { carp "Length of error title '$param->{error_title}'" . " exceeds Excel's limit of 32"; return -3; } # Check that the input message don't exceed the maximum length. if ( $param->{input_message} and length $param->{input_message} > 255 ) { carp "Length of input message '$param->{input_message}'" . " exceeds Excel's limit of 255"; return -3; } # Check that the error message don't exceed the maximum length. if ( $param->{error_message} and length $param->{error_message} > 255 ) { carp "Length of error message '$param->{error_message}'" . " exceeds Excel's limit of 255"; return -3; } # Check that the input list don't exceed the maximum length. if ( $param->{validate} eq 'list' ) { if ( ref $param->{value} eq 'ARRAY' ) { my $formula = join ',', @{ $param->{value} }; if ( length $formula > 255 ) { carp "Length of list items '$formula' exceeds Excel's " . "limit of 255, use a formula range instead"; return -3; } } } # 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; } ############################################################################### # # conditional_formatting($row, $col, {...}) # # This method handles the interface to Excel conditional formatting. # # We allow the format to be called on one cell or a range of cells. The # hashref contains the formatting parameters and must be the last param: # conditional_formatting($row, $col, {...}) # conditional_formatting($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 conditional_formatting { my $self = shift; my $user_range = ''; # Check for a cell reference in A1 notation and substitute row and column if ( $_[0] =~ /^\D/ ) { # Check for a user defined multiple range like B3:K6,B8:K11. if ( $_[0] =~ /,/ ) { $user_range = $_[0]; $user_range =~ s/^=//; $user_range =~ s/\s*,\s*/ /g; $user_range =~ s/\$//g; } @_ = $self->_substitute_cellref( @_ ); } # The final hashref contains the validation parameters. my $options = 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 $options ne 'HASH' ) { carp "Last parameter in conditional_formatting() " . "must be a hash ref"; return -3; } # Copy the user params. my $param = {%$options}; # List of valid input parameters. my %valid_parameter = ( type => 1, format => 1, criteria => 1, value => 1, minimum => 1, maximum => 1, stop_if_true => 1, min_type => 1, mid_type => 1, max_type => 1, min_value => 1, mid_value => 1, max_value => 1, min_color => 1, mid_color => 1, max_color => 1, bar_color => 1, bar_negative_color => 1, bar_negative_color_same => 1, bar_solid => 1, bar_border_color => 1, bar_negative_border_color => 1, bar_negative_border_color_same => 1, bar_no_border => 1, bar_direction => 1, bar_axis_position => 1, bar_axis_color => 1, bar_only => 1, icon_style => 1, reverse_icons => 1, icons_only => 1, icons => 1, data_bar_2010 => 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 conditional_formatting()"; return -3; } } # 'type' is a required parameter. if ( not exists $param->{type} ) { carp "Parameter 'type' is required in conditional_formatting()"; return -3; } # List of valid validation types. my %valid_type = ( 'cell' => 'cellIs', 'date' => 'date', 'time' => 'time', 'average' => 'aboveAverage', 'duplicate' => 'duplicateValues', 'unique' => 'uniqueValues', 'top' => 'top10', 'bottom' => 'top10', 'text' => 'text', 'time_period' => 'timePeriod', 'blanks' => 'containsBlanks', 'no_blanks' => 'notContainsBlanks', 'errors' => 'containsErrors', 'no_errors' => 'notContainsErrors', '2_color_scale' => '2_color_scale', '3_color_scale' => '3_color_scale', 'data_bar' => 'dataBar', 'formula' => 'expression', 'icon_set' => 'iconSet', ); # Check for valid validation types. if ( not exists $valid_type{ lc( $param->{type} ) } ) { carp "Unknown validation type '$param->{type}' for parameter " . "'type' in conditional_formatting()"; return -3; } else { $param->{direction} = 'bottom' if $param->{type} eq 'bottom'; $param->{type} = $valid_type{ lc( $param->{type} ) }; } # List of valid criteria types. my %criteria_type = ( 'between' => 'between', 'not between' => 'notBetween', 'equal to' => 'equal', '=' => 'equal', '==' => 'equal', 'not equal to' => 'notEqual', '!=' => 'notEqual', '<>' => 'notEqual', 'greater than' => 'greaterThan', '>' => 'greaterThan', 'less than' => 'lessThan', '<' => 'lessThan', 'greater than or equal to' => 'greaterThanOrEqual', '>=' => 'greaterThanOrEqual', 'less than or equal to' => 'lessThanOrEqual', '<=' => 'lessThanOrEqual', 'containing' => 'containsText', 'not containing' => 'notContains', 'begins with' => 'beginsWith', 'ends with' => 'endsWith', 'yesterday' => 'yesterday', 'today' => 'today', 'last 7 days' => 'last7Days', 'last week' => 'lastWeek', 'this week' => 'thisWeek', 'next week' => 'nextWeek', 'last month' => 'lastMonth', 'this month' => 'thisMonth', 'next month' => 'nextMonth', ); # Check for valid criteria types. if ( defined $param->{criteria} && exists $criteria_type{ lc( $param->{criteria} ) } ) { $param->{criteria} = $criteria_type{ lc( $param->{criteria} ) }; } # Convert date/times value if required. if ( $param->{type} eq 'date' || $param->{type} eq 'time' ) { $param->{type} = 'cellIs'; if ( defined $param->{value} && $param->{value} =~ /T/ ) { my $date_time = $self->convert_date_time( $param->{value} ); if ( !defined $date_time ) { carp "Invalid date/time value '$param->{value}' " . "in conditional_formatting()"; return -3; } else { $param->{value} = $date_time; } } if ( defined $param->{minimum} && $param->{minimum} =~ /T/ ) { my $date_time = $self->convert_date_time( $param->{minimum} ); if ( !defined $date_time ) { carp "Invalid date/time value '$param->{minimum}' " . "in conditional_formatting()"; return -3; } else { $param->{minimum} = $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 conditional_formatting()"; return -3; } else { $param->{maximum} = $date_time; } } } # List of valid icon styles. my %icon_set_styles = ( "3_arrows" => "3Arrows", # 1 "3_flags" => "3Flags", # 2 "3_traffic_lights_rimmed" => "3TrafficLights2", # 3 "3_symbols_circled" => "3Symbols", # 4 "4_arrows" => "4Arrows", # 5 "4_red_to_black" => "4RedToBlack", # 6 "4_traffic_lights" => "4TrafficLights", # 7 "5_arrows_gray" => "5ArrowsGray", # 8 "5_quarters" => "5Quarters", # 9 "3_arrows_gray" => "3ArrowsGray", # 10 "3_traffic_lights" => "3TrafficLights", # 11 "3_signs" => "3Signs", # 12 "3_symbols" => "3Symbols2", # 13 "4_arrows_gray" => "4ArrowsGray", # 14 "4_ratings" => "4Rating", # 15 "5_arrows" => "5Arrows", # 16 "5_ratings" => "5Rating", # 17 ); # Set properties for icon sets. if ( $param->{type} eq 'iconSet' ) { if ( !defined $param->{icon_style} ) { carp "The 'icon_style' parameter must be specified when " . "'type' == 'icon_set' in conditional_formatting()"; return -3; } # Check for valid icon styles. if ( not exists $icon_set_styles{ $param->{icon_style} } ) { carp "Unknown icon style '$param->{icon_style}' for parameter " . "'icon_style' in conditional_formatting()"; return -3; } else { $param->{icon_style} = $icon_set_styles{ $param->{icon_style} }; } # Set the number of icons for the icon style. $param->{total_icons} = 3; if ( $param->{icon_style} =~ /^4/ ) { $param->{total_icons} = 4; } elsif ( $param->{icon_style} =~ /^5/ ) { $param->{total_icons} = 5; } $param->{icons} = $self->_set_icon_properties( $param->{total_icons}, $param->{icons} ); } # Set the formatting range. my $range = ''; my $start_cell = ''; # Use for formulas. # Swap last row/col for first row/col as necessary if ( $row1 > $row2 ) { ( $row1, $row2 ) = ( $row2, $row1 ); } if ( $col1 > $col2 ) { ( $col1, $col2 ) = ( $col2, $col1 ); } # If the first and last cell are the same write a single cell. if ( ( $row1 == $row2 ) && ( $col1 == $col2 ) ) { $range = xl_rowcol_to_cell( $row1, $col1 ); $start_cell = $range; } else { $range = xl_range( $row1, $row2, $col1, $col2 ); $start_cell = xl_rowcol_to_cell( $row1, $col1 ); } # Override with user defined multiple range if provided. if ( $user_range ) { $range = $user_range; } # Get the dxf format index. if ( defined $param->{format} && ref $param->{format} ) { $param->{format} = $param->{format}->get_dxf_index(); } # Set the priority based on the order of adding. $param->{priority} = $self->{_dxf_priority}++; # Check for 2010 style data_bar parameters. if ( $self->{_use_data_bars_2010} || $param->{data_bar_2010} || $param->{bar_solid} || $param->{bar_border_color} || $param->{bar_negative_color} || $param->{bar_negative_color_same} || $param->{bar_negative_border_color} || $param->{bar_negative_border_color_same} || $param->{bar_no_border} || $param->{bar_axis_position} || $param->{bar_axis_color} || $param->{bar_direction} ) { $param->{_is_data_bar_2010} = 1; } # Special handling of text criteria. if ( $param->{type} eq 'text' ) { if ( $param->{criteria} eq 'containsText' ) { $param->{type} = 'containsText'; $param->{formula} = sprintf 'NOT(ISERROR(SEARCH("%s",%s)))', $param->{value}, $start_cell; } elsif ( $param->{criteria} eq 'notContains' ) { $param->{type} = 'notContainsText'; $param->{formula} = sprintf 'ISERROR(SEARCH("%s",%s))', $param->{value}, $start_cell; } elsif ( $param->{criteria} eq 'beginsWith' ) { $param->{type} = 'beginsWith'; $param->{formula} = sprintf 'LEFT(%s,%d)="%s"', $start_cell, length( $param->{value} ), $param->{value}; } elsif ( $param->{criteria} eq 'endsWith' ) { $param->{type} = 'endsWith'; $param->{formula} = sprintf 'RIGHT(%s,%d)="%s"', $start_cell, length( $param->{value} ), $param->{value}; } else { carp "Invalid text criteria '$param->{criteria}' " . "in conditional_formatting()"; } } # Special handling of time time_period criteria. if ( $param->{type} eq 'timePeriod' ) { if ( $param->{criteria} eq 'yesterday' ) { $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()-1', $start_cell; } elsif ( $param->{criteria} eq 'today' ) { $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()', $start_cell; } elsif ( $param->{criteria} eq 'tomorrow' ) { $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()+1', $start_cell; } elsif ( $param->{criteria} eq 'last7Days' ) { $param->{formula} = sprintf 'AND(TODAY()-FLOOR(%s,1)<=6,FLOOR(%s,1)<=TODAY())', $start_cell, $start_cell; } elsif ( $param->{criteria} eq 'lastWeek' ) { $param->{formula} = sprintf 'AND(TODAY()-ROUNDDOWN(%s,0)>=(WEEKDAY(TODAY())),' . 'TODAY()-ROUNDDOWN(%s,0)<(WEEKDAY(TODAY())+7))', $start_cell, $start_cell; } elsif ( $param->{criteria} eq 'thisWeek' ) { $param->{formula} = sprintf 'AND(TODAY()-ROUNDDOWN(%s,0)<=WEEKDAY(TODAY())-1,' . 'ROUNDDOWN(%s,0)-TODAY()<=7-WEEKDAY(TODAY()))', $start_cell, $start_cell; } elsif ( $param->{criteria} eq 'nextWeek' ) { $param->{formula} = sprintf 'AND(ROUNDDOWN(%s,0)-TODAY()>(7-WEEKDAY(TODAY())),' . 'ROUNDDOWN(%s,0)-TODAY()<(15-WEEKDAY(TODAY())))', $start_cell, $start_cell; } elsif ( $param->{criteria} eq 'lastMonth' ) { $param->{formula} = sprintf 'AND(MONTH(%s)=MONTH(TODAY())-1,OR(YEAR(%s)=YEAR(TODAY()),' . 'AND(MONTH(%s)=1,YEAR(A1)=YEAR(TODAY())-1)))', $start_cell, $start_cell, $start_cell; } elsif ( $param->{criteria} eq 'thisMonth' ) { $param->{formula} = sprintf 'AND(MONTH(%s)=MONTH(TODAY()),YEAR(%s)=YEAR(TODAY()))', $start_cell, $start_cell; } elsif ( $param->{criteria} eq 'nextMonth' ) { $param->{formula} = sprintf 'AND(MONTH(%s)=MONTH(TODAY())+1,OR(YEAR(%s)=YEAR(TODAY()),' . 'AND(MONTH(%s)=12,YEAR(%s)=YEAR(TODAY())+1)))', $start_cell, $start_cell, $start_cell, $start_cell; } else { carp "Invalid time_period criteria '$param->{criteria}' " . "in conditional_formatting()"; } } # Special handling of blanks/error types. if ( $param->{type} eq 'containsBlanks' ) { $param->{formula} = sprintf 'LEN(TRIM(%s))=0', $start_cell; } if ( $param->{type} eq 'notContainsBlanks' ) { $param->{formula} = sprintf 'LEN(TRIM(%s))>0', $start_cell; } if ( $param->{type} eq 'containsErrors' ) { $param->{formula} = sprintf 'ISERROR(%s)', $start_cell; } if ( $param->{type} eq 'notContainsErrors' ) { $param->{formula} = sprintf 'NOT(ISERROR(%s))', $start_cell; } # Special handling for 2 color scale. if ( $param->{type} eq '2_color_scale' ) { $param->{type} = 'colorScale'; # Color scales don't use any additional formatting. $param->{format} = undef; # Turn off 3 color parameters. $param->{mid_type} = undef; $param->{mid_color} = undef; $param->{min_type} ||= 'min'; $param->{max_type} ||= 'max'; $param->{min_value} ||= 0; $param->{max_value} ||= 0; $param->{min_color} ||= '#FF7128'; $param->{max_color} ||= '#FFEF9C'; $param->{max_color} = $self->_get_palette_color( $param->{max_color} ); $param->{min_color} = $self->_get_palette_color( $param->{min_color} ); } # Special handling for 3 color scale. if ( $param->{type} eq '3_color_scale' ) { $param->{type} = 'colorScale'; # Color scales don't use any additional formatting. $param->{format} = undef; $param->{min_type} ||= 'min'; $param->{mid_type} ||= 'percentile'; $param->{max_type} ||= 'max'; $param->{min_value} ||= 0; $param->{mid_value} = 50 unless defined $param->{mid_value}; $param->{max_value} ||= 0; $param->{min_color} ||= '#F8696B'; $param->{mid_color} ||= '#FFEB84'; $param->{max_color} ||= '#63BE7B'; $param->{max_color} = $self->_get_palette_color( $param->{max_color} ); $param->{mid_color} = $self->_get_palette_color( $param->{mid_color} ); $param->{min_color} = $self->_get_palette_color( $param->{min_color} ); } # Special handling for data bar. if ( $param->{type} eq 'dataBar' ) { # Excel 2007 data bars don't use any additional formatting. $param->{format} = undef; if ( !defined $param->{min_type} ) { $param->{min_type} = 'min'; $param->{_x14_min_type} = 'autoMin'; } else { $param->{_x14_min_type} = $param->{min_type}; } if ( !defined $param->{max_type} ) { $param->{max_type} = 'max'; $param->{_x14_max_type} = 'autoMax'; } else { $param->{_x14_max_type} = $param->{max_type}; } $param->{min_value} ||= 0; $param->{max_value} ||= 0; $param->{bar_color} ||= '#638EC6'; $param->{bar_border_color} ||= $param->{bar_color}; $param->{bar_only} ||= 0; $param->{bar_no_border} ||= 0; $param->{bar_solid} ||= 0; $param->{bar_direction} ||= ''; $param->{bar_negative_color} ||= '#FF0000'; $param->{bar_negative_border_color} ||= '#FF0000'; $param->{bar_negative_color_same} ||= 0; $param->{bar_negative_border_color_same} ||= 0; $param->{bar_axis_position} ||= ''; $param->{bar_axis_color} ||= '#000000'; $param->{bar_color} = $self->_get_palette_color( $param->{bar_color} ); $param->{bar_border_color} = $self->_get_palette_color( $param->{bar_border_color} ); $param->{bar_negative_color} = $self->_get_palette_color( $param->{bar_negative_color} ); $param->{bar_negative_border_color} = $self->_get_palette_color( $param->{bar_negative_border_color} ); $param->{bar_axis_color} = $self->_get_palette_color( $param->{bar_axis_color} ); } # Adjust for 2010 style data_bar parameters. if ( $param->{_is_data_bar_2010} ) { $self->{_excel_version} = 2010; if ( $param->{min_type} eq 'min' && $param->{min_value} == 0 ) { $param->{min_value} = undef; } if ( $param->{max_type} eq 'max' && $param->{max_value} == 0 ) { $param->{max_value} = undef; } # Store range for Excel 2010 data bars. $param->{_range} = $range; } # Strip the leading = from formulas. $param->{min_value} =~ s/^=// if defined $param->{min_value}; $param->{mid_value} =~ s/^=// if defined $param->{mid_value}; $param->{max_value} =~ s/^=// if defined $param->{max_value}; # Store the validation information until we close the worksheet. push @{ $self->{_cond_formats}->{$range} }, $param; } ############################################################################### # # Set the sub-properties for icons. # sub _set_icon_properties { my $self = shift; my $total_icons = shift; my $user_props = shift; my $props = []; # Set the default icon properties. for ( 0 .. $total_icons - 1 ) { push @$props, { criteria => 0, value => 0, type => 'percent' }; } # Set the default icon values based on the number of icons. if ( $total_icons == 3 ) { $props->[0]->{value} = 67; $props->[1]->{value} = 33; } if ( $total_icons == 4 ) { $props->[0]->{value} = 75; $props->[1]->{value} = 50; $props->[2]->{value} = 25; } if ( $total_icons == 5 ) { $props->[0]->{value} = 80; $props->[1]->{value} = 60; $props->[2]->{value} = 40; $props->[3]->{value} = 20; } # Overwrite default properties with user defined properties. if ( defined $user_props ) { # Ensure we don't set user properties for lowest icon. my $max_data = @$user_props; if ( $max_data >= $total_icons ) { $max_data = $total_icons -1; } for my $i ( 0 .. $max_data - 1 ) { # Set the user defined 'value' property. if ( defined $user_props->[$i]->{value} ) { $props->[$i]->{value} = $user_props->[$i]->{value}; $props->[$i]->{value} =~ s/^=//; } # Set the user defined 'type' property. if ( defined $user_props->[$i]->{type} ) { my $type = $user_props->[$i]->{type}; if ( $type ne 'percent' && $type ne 'percentile' && $type ne 'number' && $type ne 'formula' ) { carp "Unknown icon property type '$props->{type}' for sub-" . "property 'type' in conditional_formatting()"; } else { $props->[$i]->{type} = $type; if ( $props->[$i]->{type} eq 'number' ) { $props->[$i]->{type} = 'num'; } } } # Set the user defined 'criteria' property. if ( defined $user_props->[$i]->{criteria} && $user_props->[$i]->{criteria} eq '>' ) { $props->[$i]->{criteria} = 1; } } } return $props; } ############################################################################### # # add_table() # # Add an Excel table to a worksheet. # sub add_table { my $self = shift; my $user_range = ''; my %table; my @col_formats; # We would need to order the write statements very carefully within this # function to support optimisation mode. Disable add_table() when it is # on for now. if ( $self->{_optimization} == 1 ) { carp "add_table() isn't supported when set_optimization() is on"; return -1; } # 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 ( @_ < 4 ) { carp "Not enough parameters to add_table()"; return -1; } my ( $row1, $col1, $row2, $col2 ) = @_; # 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 ); # The final hashref contains the validation parameters. my $param = $_[4] || {}; # Check that the last parameter is a hash list. if ( ref $param ne 'HASH' ) { carp "Last parameter '$param' in add_table() must be a hash ref"; return -3; } # List of valid input parameters. my %valid_parameter = ( autofilter => 1, banded_columns => 1, banded_rows => 1, columns => 1, data => 1, first_column => 1, header_row => 1, last_column => 1, name => 1, style => 1, total_row => 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 add_table()"; return -3; } } # Turn on Excel's defaults. $param->{banded_rows} = 1 if !defined $param->{banded_rows}; $param->{header_row} = 1 if !defined $param->{header_row}; $param->{autofilter} = 1 if !defined $param->{autofilter}; # Set the table options. $table{_show_first_col} = $param->{first_column} ? 1 : 0; $table{_show_last_col} = $param->{last_column} ? 1 : 0; $table{_show_row_stripes} = $param->{banded_rows} ? 1 : 0; $table{_show_col_stripes} = $param->{banded_columns} ? 1 : 0; $table{_header_row_count} = $param->{header_row} ? 1 : 0; $table{_totals_row_shown} = $param->{total_row} ? 1 : 0; # Set the table name. if ( defined $param->{name} ) { my $name = $param->{name}; # Warn if the name contains invalid chars as defined by Excel help. if ( $name !~ m/^[\w\\][\w\\.]*$/ || $name =~ m/^\d/ ) { carp "Invalid character in name '$name' used in add_table()"; return -3; } # Warn if the name looks like a cell name. if ( $name =~ m/^[a-zA-Z][a-zA-Z]?[a-dA-D]?[0-9]+$/ ) { carp "Invalid name '$name' looks like a cell name in add_table()"; return -3; } # Warn if the name looks like a R1C1. if ( $name =~ m/^[rcRC]$/ || $name =~ m/^[rcRC]\d+[rcRC]\d+$/ ) { carp "Invalid name '$name' like a RC cell ref in add_table()"; return -3; } $table{_name} = $param->{name}; } # Set the table style. if ( defined $param->{style} ) { $table{_style} = $param->{style}; # Remove whitespace from style name. $table{_style} =~ s/\s//g; } else { $table{_style} = "TableStyleMedium9"; } # Swap last row/col for first row/col as necessary. if ( $row1 > $row2 ) { ( $row1, $row2 ) = ( $row2, $row1 ); } if ( $col1 > $col2 ) { ( $col1, $col2 ) = ( $col2, $col1 ); } # Set the data range rows (without the header and footer). my $first_data_row = $row1; my $last_data_row = $row2; $first_data_row++ if $param->{header_row}; $last_data_row-- if $param->{total_row}; # Set the table and autofilter ranges. $table{_range} = xl_range( $row1, $row2, $col1, $col2 ); $table{_a_range} = xl_range( $row1, $last_data_row, $col1, $col2 ); # If the header row if off the default is to turn autofilter off. if ( !$param->{header_row} ) { $param->{autofilter} = 0; } # Set the autofilter range. if ( $param->{autofilter} ) { $table{_autofilter} = $table{_a_range}; } # Add the table columns. my %seen_names; my $col_id = 1; for my $col_num ( $col1 .. $col2 ) { # Set up the default column data. my $col_data = { _id => $col_id, _name => 'Column' . $col_id, _total_string => '', _total_function => '', _formula => '', _format => undef, _name_format => undef, }; # Overwrite the defaults with any use defined values. if ( $param->{columns} ) { # Check if there are user defined values for this column. if ( my $user_data = $param->{columns}->[ $col_id - 1 ] ) { # Map user defined values to internal values. $col_data->{_name} = $user_data->{header} if $user_data->{header}; # Excel requires unique case insensitive header names. my $name = $col_data->{_name}; my $key = lc $name; if (exists $seen_names{$key}) { carp "add_table() contains duplicate name: '$name'"; return -1; } else { $seen_names{$key} = 1; } # Get the header format if defined. $col_data->{_name_format} = $user_data->{header_format}; # Handle the column formula. if ( $user_data->{formula} ) { my $formula = $user_data->{formula}; # Remove the leading = from formula. $formula =~ s/^=//; # Covert Excel 2010 "@" ref to 2007 "#This Row". $formula =~ s/@/[#This Row],/g; $col_data->{_formula} = $formula; for my $row ( $first_data_row .. $last_data_row ) { $self->write_formula( $row, $col_num, $formula, $user_data->{format} ); } } # Handle the function for the total row. if ( $user_data->{total_function} ) { my $function = $user_data->{total_function}; # Massage the function name. $function = lc $function; $function =~ s/_//g; $function =~ s/\s//g; $function = 'countNums' if $function eq 'countnums'; $function = 'stdDev' if $function eq 'stddev'; $col_data->{_total_function} = $function; my $formula = _table_function_to_formula( $function, $col_data->{_name} ); my $value = $user_data->{total_value} || 0; $self->write_formula( $row2, $col_num, $formula, $user_data->{format}, $value ); } elsif ( $user_data->{total_string} ) { # Total label only (not a function). my $total_string = $user_data->{total_string}; $col_data->{_total_string} = $total_string; $self->write_string( $row2, $col_num, $total_string, $user_data->{format} ); } # Get the dxf format index. if ( defined $user_data->{format} && ref $user_data->{format} ) { $col_data->{_format} = $user_data->{format}->get_dxf_index(); } # Store the column format for writing the cell data. # It doesn't matter if it is undefined. $col_formats[ $col_id - 1 ] = $user_data->{format}; } } # Store the column data. push @{ $table{_columns} }, $col_data; # Write the column headers to the worksheet. if ( $param->{header_row} ) { $self->write_string( $row1, $col_num, $col_data->{_name}, $col_data->{_name_format} ); } $col_id++; } # Table columns. # Write the cell data if supplied. if ( my $data = $param->{data} ) { my $i = 0; # For indexing the row data. for my $row ( $first_data_row .. $last_data_row ) { my $j = 0; # For indexing the col data. for my $col ( $col1 .. $col2 ) { my $token = $data->[$i]->[$j]; if ( defined $token ) { $self->write( $row, $col, $token, $col_formats[$j] ); } $j++; } $i++; } } # Store the table data. push @{ $self->{_tables} }, \%table; return \%table; } ############################################################################### # # add_sparkline() # # Add sparklines to the worksheet. # sub add_sparkline { my $self = shift; my $param = shift; my $sparkline = {}; # Check that the last parameter is a hash list. if ( ref $param ne 'HASH' ) { carp "Parameter list in add_sparkline() must be a hash ref"; return -1; } # List of valid input parameters. my %valid_parameter = ( location => 1, range => 1, type => 1, high_point => 1, low_point => 1, negative_points => 1, first_point => 1, last_point => 1, markers => 1, style => 1, series_color => 1, negative_color => 1, markers_color => 1, first_color => 1, last_color => 1, high_color => 1, low_color => 1, max => 1, min => 1, axis => 1, reverse => 1, empty_cells => 1, show_hidden => 1, plot_hidden => 1, date_axis => 1, weight => 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 add_sparkline()"; return -2; } } # 'location' is a required parameter. if ( not exists $param->{location} ) { carp "Parameter 'location' is required in add_sparkline()"; return -3; } # 'range' is a required parameter. if ( not exists $param->{range} ) { carp "Parameter 'range' is required in add_sparkline()"; return -3; } # Handle the sparkline type. my $type = $param->{type} || 'line'; if ( $type ne 'line' && $type ne 'column' && $type ne 'win_loss' ) { carp "Parameter 'type' must be 'line', 'column' " . "or 'win_loss' in add_sparkline()"; return -4; } $type = 'stacked' if $type eq 'win_loss'; $sparkline->{_type} = $type; # We handle single location/range values or array refs of values. if ( ref $param->{location} ) { $sparkline->{_locations} = $param->{location}; $sparkline->{_ranges} = $param->{range}; } else { $sparkline->{_locations} = [ $param->{location} ]; $sparkline->{_ranges} = [ $param->{range} ]; } my $range_count = @{ $sparkline->{_ranges} }; my $location_count = @{ $sparkline->{_locations} }; # The ranges and locations must match. if ( $range_count != $location_count ) { carp "Must have the same number of location and range " . "parameters in add_sparkline()"; return -5; } # Store the count. $sparkline->{_count} = @{ $sparkline->{_locations} }; # Get the worksheet name for the range conversion below. my $sheetname = quote_sheetname( $self->{_name} ); # Cleanup the input ranges. for my $range ( @{ $sparkline->{_ranges} } ) { # Remove the absolute reference $ symbols. $range =~ s{\$}{}g; # Remove the = from xl_range_formula(. $range =~ s{^=}{}; # Convert a simple range into a full Sheet1!A1:D1 range. if ( $range !~ /!/ ) { $range = $sheetname . "!" . $range; } } # Cleanup the input locations. for my $location ( @{ $sparkline->{_locations} } ) { $location =~ s{\$}{}g; } # Map options. $sparkline->{_high} = $param->{high_point}; $sparkline->{_low} = $param->{low_point}; $sparkline->{_negative} = $param->{negative_points}; $sparkline->{_first} = $param->{first_point}; $sparkline->{_last} = $param->{last_point}; $sparkline->{_markers} = $param->{markers}; $sparkline->{_min} = $param->{min}; $sparkline->{_max} = $param->{max}; $sparkline->{_axis} = $param->{axis}; $sparkline->{_reverse} = $param->{reverse}; $sparkline->{_hidden} = $param->{show_hidden}; $sparkline->{_weight} = $param->{weight}; # Map empty cells options. my $empty = $param->{empty_cells} || ''; if ( $empty eq 'zero' ) { $sparkline->{_empty} = 0; } elsif ( $empty eq 'connect' ) { $sparkline->{_empty} = 'span'; } else { $sparkline->{_empty} = 'gap'; } # Map the date axis range. my $date_range = $param->{date_axis}; if ( $date_range && $date_range !~ /!/ ) { $date_range = $sheetname . "!" . $date_range; } $sparkline->{_date_axis} = $date_range; # Set the sparkline styles. my $style_id = $param->{style} || 0; my $style = $Excel::Writer::XLSX::Package::Theme::spark_styles[$style_id]; $sparkline->{_series_color} = $style->{series}; $sparkline->{_negative_color} = $style->{negative}; $sparkline->{_markers_color} = $style->{markers}; $sparkline->{_first_color} = $style->{first}; $sparkline->{_last_color} = $style->{last}; $sparkline->{_high_color} = $style->{high}; $sparkline->{_low_color} = $style->{low}; # Override the style colours with user defined colors. $self->_set_spark_color( $sparkline, $param, 'series_color' ); $self->_set_spark_color( $sparkline, $param, 'negative_color' ); $self->_set_spark_color( $sparkline, $param, 'markers_color' ); $self->_set_spark_color( $sparkline, $param, 'first_color' ); $self->_set_spark_color( $sparkline, $param, 'last_color' ); $self->_set_spark_color( $sparkline, $param, 'high_color' ); $self->_set_spark_color( $sparkline, $param, 'low_color' ); push @{ $self->{_sparklines} }, $sparkline; } ############################################################################### # # insert_button() # # Insert a button form object into the worksheet. # sub insert_button { 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. if ( @_ < 3 ) { return -1 } my $button = $self->_button_params( @_ ); push @{ $self->{_buttons_array} }, $button; $self->{_has_vml} = 1; } ############################################################################### # # set_vba_name() # # Set the VBA name for the worksheet. # sub set_vba_name { my $self = shift; my $vba_codename = shift; if ( $vba_codename ) { $self->{_vba_codename} = $vba_codename; } else { $self->{_vba_codename} = "Sheet" . ($self->{_index} + 1); } } ############################################################################### # # Internal methods. # ############################################################################### ############################################################################### # # _table_function_to_formula # # Convert a table total function to a worksheet formula. # sub _table_function_to_formula { my $function = shift; my $col_name = shift; my $formula = ''; # Escape special characters, as required by Excel. $col_name =~ s/'/''/g; $col_name =~ s/#/'#/g; $col_name =~ s/\[/'[/g; $col_name =~ s/]/']/g; my %subtotals = ( average => 101, countNums => 102, count => 103, max => 104, min => 105, stdDev => 107, sum => 109, var => 110, ); if ( exists $subtotals{$function} ) { my $func_num = $subtotals{$function}; $formula = qq{SUBTOTAL($func_num,[$col_name])}; } else { carp "Unsupported function '$function' in add_table()"; } return $formula; } ############################################################################### # # _set_spark_color() # # Set the sparkline colour. # sub _set_spark_color { my $self = shift; my $sparkline = shift; my $param = shift; my $user_color = shift; my $spark_color = '_' . $user_color; return unless $param->{$user_color}; $sparkline->{$spark_color} = { _rgb => $self->_get_palette_color( $param->{$user_color} ) }; } ############################################################################### # # _get_palette_color() # # Convert from an Excel internal colour index to a XML style #RRGGBB index # based on the default or user defined values in the Workbook palette. # sub _get_palette_color { my $self = shift; my $index = shift; my $palette = $self->{_palette}; # Handle colours in #XXXXXX RGB format. if ( $index =~ m/^#([0-9A-F]{6})$/i ) { return "FF" . uc( $1 ); } # Adjust the colour index. $index -= 8; # Palette is passed in from the Workbook class. my @rgb = @{ $palette->[$index] }; return sprintf "FF%02X%02X%02X", @rgb[0, 1, 2]; } ############################################################################### # # _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:Rowmax, so add rows as required if ( $cell =~ /\$?([A-Z]{1,3}):\$?([A-Z]{1,3})/ ) { my ( $row1, $col1 ) = $self->_cell_to_rowcol( $1 . '1' ); my ( $row2, $col2 ) = $self->_cell_to_rowcol( $2 . $self->{_xls_rowmax} ); return $row1, $col1, $row2, $col2, @_; } # Convert a cell range: 'A1:B7' if ( $cell =~ /\$?([A-Z]{1,3}\$?\d+):\$?([A-Z]{1,3}\$?\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-Z]{1,3}\$?\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). # # See also: http://www.perlmonks.org/index.pl?node_id=270352 # # Returns: ($row, $col, $row_absolute, $col_absolute) # # sub _cell_to_rowcol { my $self = shift; my $cell = $_[0]; $cell =~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/; my $col_abs = $1 eq "" ? 0 : 1; my $col = $2; my $row_abs = $3 eq "" ? 0 : 1; my $row = $4; # 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--; # TODO Check row and column range return $row, $col, $row_abs, $col_abs; } ############################################################################### # # _xl_rowcol_to_cell($row, $col) # # Optimised version of xl_rowcol_to_cell from Utility.pm for the inner loop # of _write_cell(). # our @col_names = ( 'A' .. 'XFD' ); sub _xl_rowcol_to_cell { return $col_names[ $_[1] ] . ( $_[0] + 1 ); } ############################################################################### # # _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; return () unless @_; 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 # The Excel 2007 specification says that the maximum number of page breaks # is 1026. However, in practice it is actually 1023. my $max_num_breaks = 1023; splice( @array, $max_num_breaks ) if @array > $max_num_breaks; return @array; } ############################################################################### # # _check_dimensions($row, $col, $ignore_row, $ignore_col) # # Check that $row and $col are valid and store max and min values for use in # other methods/elements. # # 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}; # In optimization mode we don't change dimensions for rows that are # already written. if ( !$ignore_row && !$ignore_col && $self->{_optimization} == 1 ) { return -2 if $row < $self->{_previous_row}; } if ( !$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 ( !$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; } ############################################################################### # # _position_object_pixels() # # Calculate the vertices that define the position of a graphical object within # the worksheet in pixels. # # +------------+------------+ # | A | B | # +-----+------------+------------+ # | |(x1,y1) | | # | 1 |(A1)._______|______ | # | | | | | # | | | | | # +-----+----| Object |-----+ # | | | | | # | 2 | |______________. | # | | | (B2)| # | | | (x2,y2)| # +---- +------------+------------+ # # Example of an object that covers some of the area from cell A1 to cell B2. # # Based on the width and height of the object we need to calculate 8 vars: # # $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2. # # We also calculate the absolute x and y position of the top left vertex of # the object. This is required for images. # # $x_abs, $y_abs # # The width and height of the cells that the object occupies can be 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 object from the width and height of the # underlying cells. # # The anchor/object position defines how images are scaled for hidden rows and # columns. For option 1 "Move and size with cells" the size of the hidden # row/column is subtracted from the image. # sub _position_object_pixels { 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 object frame. my $height; # Height of object frame. my $x_abs = 0; # Absolute distance to left side of object. my $y_abs = 0; # Absolute distance to top side of object. my $anchor; # The type of object positioning. ( $col_start, $row_start, $x1, $y1, $width, $height, $anchor ) = @_; # Adjust start column for negative offsets. while ( $x1 < 0 && $col_start > 0) { $x1 += $self->_size_col( $col_start - 1); $col_start--; } # Adjust start row for negative offsets. while ( $y1 < 0 && $row_start > 0) { $y1 += $self->_size_row( $row_start - 1); $row_start--; } # Ensure that the image isn't shifted off the page at top left. $x1 = 0 if $x1 < 0; $y1 = 0 if $y1 < 0; # Calculate the absolute x offset of the top-left vertex. if ( $self->{_col_size_changed} ) { for my $col_id ( 0 .. $col_start -1 ) { $x_abs += $self->_size_col( $col_id ); } } else { # Optimisation for when the column widths haven't changed. $x_abs += $self->{_default_col_pixels} * $col_start; } $x_abs += $x1; # Calculate the absolute y offset of the top-left vertex. # Store the column change to allow optimisations. if ( $self->{_row_size_changed} ) { for my $row_id ( 0 .. $row_start -1 ) { $y_abs += $self->_size_row( $row_id ); } } else { # Optimisation for when the row heights haven't changed. $y_abs += $self->{_default_row_pixels} * $row_start; } $y_abs += $y1; # Adjust start column for offsets that are greater than the col width. while ( $x1 >= $self->_size_col( $col_start, $anchor ) ) { $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, $anchor ) ) { $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; # Only offset the image in the cell if the row/col isn't hidden. if ($self->_size_col( $col_start, $anchor) > 0 ) { $width = $width + $x1; } if ( $self->_size_row( $row_start, $anchor ) > 0 ) { $height = $height + $y1; } # Subtract the underlying cell widths to find the end cell of the object. while ( $width >= $self->_size_col( $col_end, $anchor ) ) { $width -= $self->_size_col( $col_end, $anchor ); $col_end++; } # Subtract the underlying cell heights to find the end cell of the object. while ( $height >= $self->_size_row( $row_end, $anchor ) ) { $height -= $self->_size_row( $row_end, $anchor ); $row_end++; } # The end vertices are whatever is left from the width and height. $x2 = $width; $y2 = $height; return ( $col_start, $row_start, $x1, $y1, $col_end, $row_end, $x2, $y2, $x_abs, $y_abs ); } ############################################################################### # # _position_object_emus() # # Calculate the vertices that define the position of a graphical object within # the worksheet in EMUs. # # The vertices are expressed as English Metric Units (EMUs). There are 12,700 # EMUs per point. Therefore, 12,700 * 3 /4 = 9,525 EMUs per pixel. # sub _position_object_emus { my $self = shift; my ( $col_start, $row_start, $x1, $y1, $col_end, $row_end, $x2, $y2, $x_abs, $y_abs ) = $self->_position_object_pixels( @_ ); # Convert the pixel values to EMUs. See above. $x1 = int( 0.5 + 9_525 * $x1 ); $y1 = int( 0.5 + 9_525 * $y1 ); $x2 = int( 0.5 + 9_525 * $x2 ); $y2 = int( 0.5 + 9_525 * $y2 ); $x_abs = int( 0.5 + 9_525 * $x_abs ); $y_abs = int( 0.5 + 9_525 * $y_abs ); return ( $col_start, $row_start, $x1, $y1, $col_end, $row_end, $x2, $y2, $x_abs, $y_abs ); } ############################################################################### # # _position_shape_emus() # # Calculate the vertices that define the position of a shape object within # the worksheet in EMUs. Save the vertices with the object. # # The vertices are expressed as English Metric Units (EMUs). There are 12,700 # EMUs per point. Therefore, 12,700 * 3 /4 = 9,525 EMUs per pixel. # sub _position_shape_emus { my $self = shift; my $shape = shift; my ( $col_start, $row_start, $x1, $y1, $col_end, $row_end, $x2, $y2, $x_abs, $y_abs ) = $self->_position_object_pixels( $shape->{_column_start}, $shape->{_row_start}, $shape->{_x_offset}, $shape->{_y_offset}, $shape->{_width} * $shape->{_scale_x}, $shape->{_height} * $shape->{_scale_y}, $shape->{_drawing} ); # Now that x2/y2 have been calculated with a potentially negative # width/height we use the absolute value and convert to EMUs. $shape->{_width_emu} = int( abs( $shape->{_width} * 9_525 ) ); $shape->{_height_emu} = int( abs( $shape->{_height} * 9_525 ) ); $shape->{_column_start} = int( $col_start ); $shape->{_row_start} = int( $row_start ); $shape->{_column_end} = int( $col_end ); $shape->{_row_end} = int( $row_end ); # Convert the pixel values to EMUs. See above. $shape->{_x1} = int( $x1 * 9_525 ); $shape->{_y1} = int( $y1 * 9_525 ); $shape->{_x2} = int( $x2 * 9_525 ); $shape->{_y2} = int( $y2 * 9_525 ); $shape->{_x_abs} = int( $x_abs * 9_525 ); $shape->{_y_abs} = int( $y_abs * 9_525 ); } ############################################################################### # # _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. A hidden column is treated as having a width of # zero unless it has the special "object_position" of 4 (size with cells). # sub _size_col { my $self = shift; my $col = shift; my $anchor = shift || 0; my $max_digit_width = 7; # For Calabri 11. my $padding = 5; my $pixels; # Look up the cell value to see if it has been changed. if ( exists $self->{_col_sizes}->{$col} ) { my $width = $self->{_col_sizes}->{$col}[0]; my $hidden = $self->{_col_sizes}->{$col}[1]; # Convert to pixels. if ( $hidden == 1 && $anchor != 4 ) { $pixels = 0; } elsif ( $width < 1 ) { $pixels = int( $width * ( $max_digit_width + $padding ) + 0.5 ); } else { $pixels = int( $width * $max_digit_width + 0.5 ) + $padding; } } else { $pixels = $self->{_default_col_pixels}; } return $pixels; } ############################################################################### # # _size_row($row) # # Convert the height of a cell from user's units to pixels. If the height # hasn't been set by the user we use the default value. A hidden row is # treated as having a height of zero unless it has the special # "object_position" of 4 (size with cells). # sub _size_row { my $self = shift; my $row = shift; my $anchor = shift || 0; my $pixels; # Look up the cell value to see if it has been changed if ( exists $self->{_row_sizes}->{$row} ) { my $height = $self->{_row_sizes}->{$row}[0]; my $hidden = $self->{_row_sizes}->{$row}[1]; if ( $hidden == 1 && $anchor != 4 ) { $pixels = 0; } else { $pixels = int( 4 / 3 * $height ); } } else { $pixels = int( 4 / 3 * $self->{_default_row_height} ); } return $pixels; } ############################################################################### # # _get_shared_string_index() # # Add a string to the shared string table, if it isn't already there, and # return the string index. # sub _get_shared_string_index { my $self = shift; my $str = shift; # Add the string to the shared string table. if ( not exists ${ $self->{_str_table} }->{$str} ) { ${ $self->{_str_table} }->{$str} = ${ $self->{_str_unique} }++; } ${ $self->{_str_total} }++; my $index = ${ $self->{_str_table} }->{$str}; return $index; } ############################################################################### # # _get_drawing_rel_index() # # Get the index used to address a drawing rel link. # sub _get_drawing_rel_index { my $self = shift; my $target = shift; if ( ! defined $target ) { # Undefined values for drawings like charts will always be unique. return ++$self->{_drawing_rels_id}; } elsif ( exists $self->{_drawing_rels}->{$target} ) { return $self->{_drawing_rels}->{$target}; } else { $self->{_drawing_rels}->{$target} = ++$self->{_drawing_rels_id}; return $self->{_drawing_rels_id}; } } ############################################################################### # # _get_vml_drawing_rel_index() # # Get the index used to address a vml_drawing rel link. # sub _get_vml_drawing_rel_index { my $self = shift; my $target = shift; if ( exists $self->{_vml_drawing_rels}->{$target} ) { return $self->{_vml_drawing_rels}->{$target}; } else { $self->{_vml_drawing_rels}->{$target} = ++$self->{_vml_drawing_rels_id}; return $self->{_vml_drawing_rels_id}; } } ############################################################################### # # insert_chart( $row, $col, $chart, $x, $y, $x_scale, $y_scale ) # # 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; my $y_offset; my $x_scale; my $y_scale; my $anchor; 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( 'Excel::Writer::XLSX::Chart' ); # Check that the chart is an embedded style chart. croak "Not a embedded style Chart object in insert_chart()" unless $chart->{_embedded}; } if ( ref $_[3] eq 'HASH' ) { # Newer hashref bashed options. my $options = $_[3]; $x_offset = $options->{x_offset} || 0; $y_offset = $options->{y_offset} || 0; $x_scale = $options->{x_scale} || 1; $y_scale = $options->{y_scale} || 1; $anchor = $options->{object_position} || 1; } else { # Older parameter based options. $x_offset = $_[3] || 0; $y_offset = $_[4] || 0; $x_scale = $_[5] || 1; $y_scale = $_[6] || 1; $anchor = $_[7] || 1; } # Ensure a chart isn't inserted more than once. if ( $chart->{_already_inserted} || $chart->{_combined} && $chart->{_combined}->{_already_inserted} ) { carp "Chart cannot be inserted in a worksheet more than once"; return; } else { $chart->{_already_inserted} = 1; if ( $chart->{_combined} ) { $chart->{_combined}->{_already_inserted} = 1; } } # Use the values set with $chart->set_size(), if any. $x_scale = $chart->{_x_scale} if $chart->{_x_scale} != 1; $y_scale = $chart->{_y_scale} if $chart->{_y_scale} != 1; $x_offset = $chart->{_x_offset} if $chart->{_x_offset}; $y_offset = $chart->{_y_offset} if $chart->{_y_offset}; push @{ $self->{_charts} }, [ $row, $col, $chart, $x_offset, $y_offset, $x_scale, $y_scale, $anchor ]; } ############################################################################### # # _prepare_chart() # # Set up chart/drawings. # sub _prepare_chart { my $self = shift; my $index = shift; my $chart_id = shift; my $drawing_id = shift; my $drawing_type = 1; my $drawing; my ( $row, $col, $chart, $x_offset, $y_offset, $x_scale, $y_scale, $anchor ) = @{ $self->{_charts}->[$index] }; $chart->{_id} = $chart_id - 1; # Use user specified dimensions, if any. my $width = $chart->{_width} if $chart->{_width}; my $height = $chart->{_height} if $chart->{_height}; $width = int( 0.5 + ( $width * $x_scale ) ); $height = int( 0.5 + ( $height * $y_scale ) ); my @dimensions = $self->_position_object_emus( $col, $row, $x_offset, $y_offset, $width, $height, $anchor); # Set the chart name for the embedded object if it has been specified. my $name = $chart->{_chart_name}; # Create a Drawing object to use with worksheet unless one already exists. if ( !$self->{_drawing} ) { $drawing = Excel::Writer::XLSX::Drawing->new(); $drawing->{_embedded} = 1; $self->{_drawing} = $drawing; push @{ $self->{_external_drawing_links} }, [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ]; } else { $drawing = $self->{_drawing}; } my $drawing_object = $drawing->_add_drawing_object(); $drawing_object->{_type} = $drawing_type; $drawing_object->{_dimensions} = \@dimensions; $drawing_object->{_width} = 0; $drawing_object->{_height} = 0; $drawing_object->{_description} = $name; $drawing_object->{_shape} = undef; $drawing_object->{_anchor} = $anchor; $drawing_object->{_rel_index} = $self->_get_drawing_rel_index(); $drawing_object->{_url_rel_index} = 0; $drawing_object->{_tip} = undef; push @{ $self->{_drawing_links} }, [ '/chart', '../charts/chart' . $chart_id . '.xml' ]; } ############################################################################### # # _get_range_data # # Returns a range of data from the worksheet _table to be used in chart # cached data. Strings are returned as SST ids and decoded in the workbook. # Return undefs for data that doesn't exist since Excel can chart series # with data missing. # sub _get_range_data { my $self = shift; return () if $self->{_optimization}; my @data; my ( $row_start, $col_start, $row_end, $col_end ) = @_; # TODO. Check for worksheet limits. # Iterate through the table data. for my $row_num ( $row_start .. $row_end ) { # Store undef if row doesn't exist. if ( !exists $self->{_table}->{$row_num} ) { push @data, undef; next; } for my $col_num ( $col_start .. $col_end ) { if ( my $cell = $self->{_table}->{$row_num}->{$col_num} ) { my $type = $cell->[0]; my $token = $cell->[1]; if ( $type eq 'n' ) { # Store a number. push @data, $token; } elsif ( $type eq 's' ) { # Store a string. if ( $self->{_optimization} == 0 ) { push @data, { 'sst_id' => $token }; } else { push @data, $token; } } elsif ( $type eq 'f' ) { # Store a formula. push @data, $cell->[3] || 0; } elsif ( $type eq 'a' ) { # Store an array formula. push @data, $cell->[4] || 0; } elsif ( $type eq 'b' ) { # Store a empty cell. push @data, ''; } } else { # Store undef if col doesn't exist. push @data, undef; } } } return @data; } ############################################################################### # # insert_image( $row, $col, $filename, $options ) # # 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; my $y_offset; my $x_scale; my $y_scale; my $anchor; my $url; my $tip; if ( ref $_[3] eq 'HASH' ) { # Newer hashref bashed options. my $options = $_[3]; $x_offset = $options->{x_offset} || 0; $y_offset = $options->{y_offset} || 0; $x_scale = $options->{x_scale} || 1; $y_scale = $options->{y_scale} || 1; $anchor = $options->{object_position} || 2; $url = $options->{url}; $tip = $options->{tip}; } else { # Older parameter based options. $x_offset = $_[3] || 0; $y_offset = $_[4] || 0; $x_scale = $_[5] || 1; $y_scale = $_[6] || 1; $anchor = $_[7] || 2; } croak "Insufficient arguments in insert_image()" unless @_ >= 3; croak "Couldn't locate $image: $!" unless -e $image; push @{ $self->{_images} }, [ $row, $col, $image, $x_offset, $y_offset, $x_scale, $y_scale, $url, $tip, $anchor ]; } ############################################################################### # # _prepare_image() # # Set up image/drawings. # sub _prepare_image { my $self = shift; my $index = shift; my $image_id = shift; my $drawing_id = shift; my $width = shift; my $height = shift; my $name = shift; my $image_type = shift; my $x_dpi = shift; my $y_dpi = shift; my $md5 = shift; my $drawing_type = 2; my $drawing; my ( $row, $col, $image, $x_offset, $y_offset, $x_scale, $y_scale, $url, $tip, $anchor ) = @{ $self->{_images}->[$index] }; $width *= $x_scale; $height *= $y_scale; $width *= 96 / $x_dpi; $height *= 96 / $y_dpi; my @dimensions = $self->_position_object_emus( $col, $row, $x_offset, $y_offset, $width, $height, $anchor); # Convert from pixels to emus. $width = int( 0.5 + ( $width * 9_525 ) ); $height = int( 0.5 + ( $height * 9_525 ) ); # Create a Drawing object to use with worksheet unless one already exists. if ( !$self->{_drawing} ) { $drawing = Excel::Writer::XLSX::Drawing->new(); $drawing->{_embedded} = 1; $self->{_drawing} = $drawing; push @{ $self->{_external_drawing_links} }, [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ]; } else { $drawing = $self->{_drawing}; } my $drawing_object = $drawing->_add_drawing_object(); $drawing_object->{_type} = $drawing_type; $drawing_object->{_dimensions} = \@dimensions; $drawing_object->{_width} = $width; $drawing_object->{_height} = $height; $drawing_object->{_description} = $name; $drawing_object->{_shape} = undef; $drawing_object->{_anchor} = $anchor; $drawing_object->{_rel_index} = 0; $drawing_object->{_url_rel_index} = 0; $drawing_object->{_tip} = $tip; if ( $url ) { my $rel_type = '/hyperlink'; my $target_mode = 'External'; my $target; if ( $url =~ m{^[fh]tt?ps?://} || $url =~ m{^mailto:} ) { $target = _escape_url( $url ); } if ( $url =~ s{^external:}{file:///} ) { $target = _escape_url( $url ); # Additional escape not required in worksheet hyperlinks. $target =~ s/#/%23/g; } if ( $url =~ s/^internal:/#/ ) { $target = $url; $target_mode = undef; } my $max_url = $self->{_max_url_length}; if ( length $target > $max_url ) { carp "Ignoring URL '$url' where link or anchor > $max_url characters " . "since it exceeds Excel's limit for URLS. See LIMITATIONS " . "section of the Excel::Writer::XLSX documentation."; } else { if ( $target && !exists $self->{_drawing_rels}->{$url} ) { push @{ $self->{_drawing_links} }, [ $rel_type, $target, $target_mode ]; } $drawing_object->{_url_rel_index} = $self->_get_drawing_rel_index( $url ); } } if ( !exists $self->{_drawing_rels}->{$md5} ) { push @{ $self->{_drawing_links} }, [ '/image', '../media/image' . $image_id . '.' . $image_type ]; } $drawing_object->{_rel_index} = $self->_get_drawing_rel_index( $md5 ); } ############################################################################### # # _prepare_header_image() # # Set up an image without a drawing object for header/footer images. # sub _prepare_header_image { my $self = shift; my $image_id = shift; my $width = shift; my $height = shift; my $name = shift; my $image_type = shift; my $position = shift; my $x_dpi = shift; my $y_dpi = shift; my $md5 = shift; # Strip the extension from the filename. $name =~ s/\.[^\.]+$//; if ( !exists $self->{_vml_drawing_rels}->{$md5} ) { push @{ $self->{_vml_drawing_links} }, [ '/image', '../media/image' . $image_id . '.' . $image_type ]; } my $ref_id = $self->_get_vml_drawing_rel_index( $md5 ); push @{ $self->{_header_images_array} }, [ $width, $height, $name, $position, $x_dpi, $y_dpi, $ref_id ]; } ############################################################################### # # insert_shape( $row, $col, $shape, $x, $y, $x_scale, $y_scale ) # # Insert a shape into the worksheet. # sub insert_shape { 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 arguments. croak "Insufficient arguments in insert_shape()" unless @_ >= 3; my $shape = $_[2]; # Verify we are being asked to insert a "shape" object. croak "Not a Shape object in insert_shape()" unless $shape->isa( 'Excel::Writer::XLSX::Shape' ); # Set the shape properties. $shape->{_row_start} = $_[0]; $shape->{_column_start} = $_[1]; $shape->{_x_offset} = $_[3] || 0; $shape->{_y_offset} = $_[4] || 0; # Override shape scale if supplied as an argument. Otherwise, use the # existing shape scale factors. $shape->{_scale_x} = $_[5] if defined $_[5]; $shape->{_scale_y} = $_[6] if defined $_[6]; $shape->{_anchor} = $_[7] || 1; # Assign a shape ID. my $needs_id = 1; while ( $needs_id ) { my $id = $shape->{_id} || 0; my $used = exists $self->{_shape_hash}->{$id} ? 1 : 0; # Test if shape ID is already used. Otherwise assign a new one. if ( !$used && $id != 0 ) { $needs_id = 0; } else { $shape->{_id} = ++$self->{_last_shape_id}; } } $shape->{_element} = $#{ $self->{_shapes} } + 1; # Allow lookup of entry into shape array by shape ID. $self->{_shape_hash}->{ $shape->{_id} } = $shape->{_element}; # Create link to Worksheet color palette. $shape->{_palette} = $self->{_palette}; if ( $shape->{_stencil} ) { # Insert a copy of the shape, not a reference so that the shape is # used as a stencil. Previously stamped copies don't get modified # if the stencil is modified. my $insert = { %{$shape} }; # For connectors change x/y coords based on location of connected shapes. $self->_auto_locate_connectors( $insert ); # Bless the copy into this class, so AUTOLOADED _get, _set methods #still work on the child. bless $insert, ref $shape; push @{ $self->{_shapes} }, $insert; return $insert; } else { # For connectors change x/y coords based on location of connected shapes. $self->_auto_locate_connectors( $shape ); # Insert a link to the shape on the list of shapes. Connection to # the parent shape is maintained push @{ $self->{_shapes} }, $shape; return $shape; } } ############################################################################### # # _prepare_shape() # # Set up drawing shapes # sub _prepare_shape { my $self = shift; my $index = shift; my $drawing_id = shift; my $shape = $self->{_shapes}->[$index]; my $drawing; my $drawing_type = 3; # Create a Drawing object to use with worksheet unless one already exists. if ( !$self->{_drawing} ) { $drawing = Excel::Writer::XLSX::Drawing->new(); $drawing->{_embedded} = 1; $self->{_drawing} = $drawing; push @{ $self->{_external_drawing_links} }, [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ]; $self->{_has_shapes} = 1; } else { $drawing = $self->{_drawing}; } # Validate the he shape against various rules. $self->_validate_shape( $shape, $index ); $self->_position_shape_emus( $shape ); my @dimensions = ( $shape->{_column_start}, $shape->{_row_start}, $shape->{_x1}, $shape->{_y1}, $shape->{_column_end}, $shape->{_row_end}, $shape->{_x2}, $shape->{_y2}, $shape->{_x_abs}, $shape->{_y_abs}, ); my $drawing_object = $drawing->_add_drawing_object(); $drawing_object->{_type} = $drawing_type; $drawing_object->{_dimensions} = \@dimensions; $drawing_object->{_width} = $shape->{_width_emu}; $drawing_object->{_height} = $shape->{_height_emu}; $drawing_object->{_description} = $shape->{_name}; $drawing_object->{_shape} = $shape; $drawing_object->{_anchor} = $shape->{_anchor}; $drawing_object->{_rel_index} = $self->_get_drawing_rel_index(); $drawing_object->{_url_rel_index} = 0; $drawing_object->{_tip} = undef; } ############################################################################### # # _auto_locate_connectors() # # Re-size connector shapes if they are connected to other shapes. # sub _auto_locate_connectors { my $self = shift; my $shape = shift; # Valid connector shapes. my $connector_shapes = { straightConnector => 1, Connector => 1, bentConnector => 1, curvedConnector => 1, line => 1, }; my $shape_base = $shape->{_type}; # Remove the number of segments from end of type. chop $shape_base; $shape->{_connect} = $connector_shapes->{$shape_base} ? 1 : 0; return unless $shape->{_connect}; # Both ends have to be connected to size it. return unless ( $shape->{_start} and $shape->{_end} ); # Both ends need to provide info about where to connect. return unless ( $shape->{_start_side} and $shape->{_end_side} ); my $sid = $shape->{_start}; my $eid = $shape->{_end}; my $slink_id = $self->{_shape_hash}->{$sid}; my ( $sls, $els ); if ( defined $slink_id ) { $sls = $self->{_shapes}->[$slink_id]; # Start linked shape. } else { warn "missing start connection for '$shape->{_name}', id=$sid\n"; return; } my $elink_id = $self->{_shape_hash}->{$eid}; if ( defined $elink_id ) { $els = $self->{_shapes}->[$elink_id]; # Start linked shape. } else { warn "missing end connection for '$shape->{_name}', id=$eid\n"; return; } # Assume shape connections are to the middle of an object, and # not a corner (for now). my $connect_type = $shape->{_start_side} . $shape->{_end_side}; my $smidx = $sls->{_x_offset} + $sls->{_width} / 2; my $emidx = $els->{_x_offset} + $els->{_width} / 2; my $smidy = $sls->{_y_offset} + $sls->{_height} / 2; my $emidy = $els->{_y_offset} + $els->{_height} / 2; my $netx = abs( $smidx - $emidx ); my $nety = abs( $smidy - $emidy ); if ( $connect_type eq 'bt' ) { my $sy = $sls->{_y_offset} + $sls->{_height}; my $ey = $els->{_y_offset}; $shape->{_width} = abs( int( $emidx - $smidx ) ); $shape->{_x_offset} = int( min( $smidx, $emidx ) ); $shape->{_height} = abs( int( $els->{_y_offset} - ( $sls->{_y_offset} + $sls->{_height} ) ) ); $shape->{_y_offset} = int( min( ( $sls->{_y_offset} + $sls->{_height} ), $els->{_y_offset} ) ); $shape->{_flip_h} = ( $smidx < $emidx ) ? 1 : 0; $shape->{_rotation} = 90; if ( $sy > $ey ) { $shape->{_flip_v} = 1; # Create 3 adjustments for an end shape vertically above a # start shape. Adjustments count from the upper left object. if ( $#{ $shape->{_adjustments} } < 0 ) { $shape->{_adjustments} = [ -10, 50, 110 ]; } $shape->{_type} = 'bentConnector5'; } } elsif ( $connect_type eq 'rl' ) { $shape->{_width} = abs( int( $els->{_x_offset} - ( $sls->{_x_offset} + $sls->{_width} ) ) ); $shape->{_height} = abs( int( $emidy - $smidy ) ); $shape->{_x_offset} = min( $sls->{_x_offset} + $sls->{_width}, $els->{_x_offset} ); $shape->{_y_offset} = min( $smidy, $emidy ); $shape->{_flip_h} = 1 if ( $smidx < $emidx ) and ( $smidy > $emidy ); $shape->{_flip_h} = 1 if ( $smidx > $emidx ) and ( $smidy < $emidy ); if ( $smidx > $emidx ) { # Create 3 adjustments if end shape is left of start if ( $#{ $shape->{_adjustments} } < 0 ) { $shape->{_adjustments} = [ -10, 50, 110 ]; } $shape->{_type} = 'bentConnector5'; } } else { warn "Connection $connect_type not implemented yet\n"; } } ############################################################################### # # _validate_shape() # # Check shape attributes to ensure they are valid. # sub _validate_shape { my $self = shift; my $shape = shift; my $index = shift; if ( !grep ( /^$shape->{_align}$/, qw[l ctr r just] ) ) { croak "Shape $index ($shape->{_type}) alignment ($shape->{align}), " . "not in ('l', 'ctr', 'r', 'just')\n"; } if ( !grep ( /^$shape->{_valign}$/, qw[t ctr b] ) ) { croak "Shape $index ($shape->{_type}) vertical alignment " . "($shape->{valign}), not ('t', 'ctr', 'b')\n"; } } ############################################################################### # # _prepare_vml_objects() # # Turn the HoH that stores the comments into an array for easier handling # and set the external links for comments and buttons. # sub _prepare_vml_objects { my $self = shift; my $vml_data_id = shift; my $vml_shape_id = shift; my $vml_drawing_id = shift; my $comment_id = shift; 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 ) { my $user_options = $self->{_comments}->{$row}->{$col}; my $params = [ $self->_comment_params( @$user_options ) ]; $self->{_comments}->{$row}->{$col} = $params; # Set comment visibility if required and not already user defined. if ( $self->{_comments_visible} ) { if ( !defined $self->{_comments}->{$row}->{$col}->[4] ) { $self->{_comments}->{$row}->{$col}->[4] = 1; } } # Set comment author if not already user defined. if ( !defined $self->{_comments}->{$row}->{$col}->[3] ) { $self->{_comments}->{$row}->{$col}->[3] = $self->{_comments_author}; } push @comments, $self->{_comments}->{$row}->{$col}; } } push @{ $self->{_external_vml_links} }, [ '/vmlDrawing', '../drawings/vmlDrawing' . $vml_drawing_id . '.vml' ]; if ( $self->{_has_comments} ) { $self->{_comments_array} = \@comments; push @{ $self->{_external_comment_links} }, [ '/comments', '../comments' . $comment_id . '.xml' ]; } my $count = scalar @comments; my $start_data_id = $vml_data_id; # The VML o:idmap data id contains a comma separated range when there is # more than one 1024 block of comments, like this: data="1,2". for my $i ( 1 .. int( $count / 1024 ) ) { $vml_data_id = "$vml_data_id," . ( $start_data_id + $i ); } $self->{_vml_data_id} = $vml_data_id; $self->{_vml_shape_id} = $vml_shape_id; return $count; } ############################################################################### # # _prepare_header_vml_objects() # # Set up external linkage for VML header/footer images. # sub _prepare_header_vml_objects { my $self = shift; my $vml_header_id = shift; my $vml_drawing_id = shift; $self->{_vml_header_id} = $vml_header_id; push @{ $self->{_external_vml_links} }, [ '/vmlDrawing', '../drawings/vmlDrawing' . $vml_drawing_id . '.vml' ]; } ############################################################################### # # _prepare_tables() # # Set the table ids for the worksheet tables. # sub _prepare_tables { my $self = shift; my $table_id = shift; my $seen = shift; for my $table ( @{ $self->{_tables} } ) { $table-> {_id} = $table_id; # Set the table name unless defined by the user. if ( !defined $table->{_name} ) { # Set a default name. $table->{_name} = 'Table' . $table_id; } # Check for duplicate table names. my $name = lc $table->{_name}; if ( exists $seen->{$name} ) { die "error: invalid duplicate table name '$table->{_name}' found"; } else { $seen->{$name} = 1; } # Store the link used for the rels file. my $link = [ '/table', '../tables/table' . $table_id . '.xml' ]; push @{ $self->{_external_table_links} }, $link; $table_id++; } } ############################################################################### # # _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 => undef, color => 81, 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, font => 'Tahoma', font_size => 8, font_family => 2, ); # 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}; # Limit the string to the max number of chars. my $max_len = 32767; if ( length( $string ) > $max_len ) { $string = substr( $string, 0, $max_len ); } # Set the comment background colour. my $color = $params{color}; my $color_id = &Excel::Writer::XLSX::Format::_get_color( $color ); if ( $color_id =~ m/^#[0-9A-F]{6}$/i ) { $params{color} = $color_id; } elsif ( $color_id == 0 ) { $params{color} = '#ffffe1'; } else { my $palette = $self->{_palette}; # Get the RGB color from the palette. my @rgb = @{ $palette->[ $color_id - 8 ] }; my $rgb_color = sprintf "%02x%02x%02x", @rgb[0, 1, 2]; # Minor modification to allow comparison testing. Change RGB colors # from long format, ffcc00 to short format fc0 used by VML. $rgb_color =~ s/^([0-9a-f])\1([0-9a-f])\2([0-9a-f])\3$/$1$2$3/; $params{color} = sprintf "#%s [%d]", $rgb_color, $color_id; } # 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. # my $row_max = $self->{_xls_rowmax}; my $col_max = $self->{_xls_colmax}; if ( not defined $params{start_row} ) { if ( $row == 0 ) { $params{start_row} = 0 } elsif ( $row == $row_max - 3 ) { $params{start_row} = $row_max - 7 } elsif ( $row == $row_max - 2 ) { $params{start_row} = $row_max - 6 } elsif ( $row == $row_max - 1 ) { $params{start_row} = $row_max - 5 } else { $params{start_row} = $row - 1 } } if ( not defined $params{y_offset} ) { if ( $row == 0 ) { $params{y_offset} = 2 } elsif ( $row == $row_max - 3 ) { $params{y_offset} = 16 } elsif ( $row == $row_max - 2 ) { $params{y_offset} = 16 } elsif ( $row == $row_max - 1 ) { $params{y_offset} = 14 } else { $params{y_offset} = 10 } } if ( not defined $params{start_col} ) { if ( $col == $col_max - 3 ) { $params{start_col} = $col_max - 6 } elsif ( $col == $col_max - 2 ) { $params{start_col} = $col_max - 5 } elsif ( $col == $col_max - 1 ) { $params{start_col} = $col_max - 4 } else { $params{start_col} = $col + 1 } } if ( not defined $params{x_offset} ) { if ( $col == $col_max - 3 ) { $params{x_offset} = 49 } elsif ( $col == $col_max - 2 ) { $params{x_offset} = 49 } elsif ( $col == $col_max - 1 ) { $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}; } # Round the dimensions to the nearest pixel. $params{width} = int( 0.5 + $params{width} ); $params{height} = int( 0.5 + $params{height} ); # Calculate the positions of comment object. my @vertices = $self->_position_object_pixels( $params{start_col}, $params{start_row}, $params{x_offset}, $params{y_offset}, $params{width}, $params{height} ); # Add the width and height for VML. push @vertices, ( $params{width}, $params{height} ); return ( $row, $col, $string, $params{author}, $params{visible}, $params{color}, $params{font}, $params{font_size}, $params{font_family}, [@vertices], ); } ############################################################################### # # _button_params() # # This method handles the parameters passed to insert_button() as well as # calculating the button object position and vertices. # sub _button_params { my $self = shift; my $row = shift; my $col = shift; my $params = shift; my $button = { _row => $row, _col => $col }; my $button_number = 1 + @{ $self->{_buttons_array} }; # Set the button caption. my $caption = $params->{caption}; # Set a default caption if none was specified by user. if ( !defined $caption ) { $caption = 'Button ' . $button_number; } $button->{_font}->{_caption} = $caption; # Set the macro name. if ( $params->{macro} ) { $button->{_macro} = '[0]!' . $params->{macro}; } else { $button->{_macro} = '[0]!Button' . $button_number . '_Click'; } # Ensure that a width and height have been set. my $default_width = $self->{_default_col_pixels}; my $default_height = $self->{_default_row_pixels}; $params->{width} = $default_width if !$params->{width}; $params->{height} = $default_height if !$params->{height}; # Set the x/y offsets. $params->{x_offset} = 0 if !$params->{x_offset}; $params->{y_offset} = 0 if !$params->{y_offset}; # Scale the size of the button 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}; } # Round the dimensions to the nearest pixel. $params->{width} = int( 0.5 + $params->{width} ); $params->{height} = int( 0.5 + $params->{height} ); $params->{start_row} = $row; $params->{start_col} = $col; # Calculate the positions of button object. my @vertices = $self->_position_object_pixels( $params->{start_col}, $params->{start_row}, $params->{x_offset}, $params->{y_offset}, $params->{width}, $params->{height} ); # Add the width and height for VML. push @vertices, ( $params->{width}, $params->{height} ); $button->{_vertices} = \@vertices; return $button; } ############################################################################### # # Deprecated methods for backwards compatibility. # ############################################################################### # This method was mainly only required for Excel 5. sub write_url_range { } # Deprecated UTF-16 method required for the Excel 5 format. sub write_utf16be_string { my $self = shift; # Convert A1 notation if present. @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/; # Check the number of args. return -1 if @_ < 3; # Convert UTF16 string to UTF8. require Encode; my $utf8_string = Encode::decode( 'UTF-16BE', $_[2] ); return $self->write_string( $_[0], $_[1], $utf8_string, $_[3] ); } # Deprecated UTF-16 method required for the Excel 5 format. sub write_utf16le_string { my $self = shift; # Convert A1 notation if present. @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/; # Check the number of args. return -1 if @_ < 3; # Convert UTF16 string to UTF8. require Encode; my $utf8_string = Encode::decode( 'UTF-16LE', $_[2] ); return $self->write_string( $_[0], $_[1], $utf8_string, $_[3] ); } # No longer required. Was used to avoid slow formula parsing. sub store_formula { my $self = shift; my $string = shift; my @tokens = split /(\$?[A-I]?[A-Z]\$?\d+)/, $string; return \@tokens; } # No longer required. Was used to avoid slow formula parsing. sub repeat_formula { my $self = shift; # Convert A1 notation if present. @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/; if ( @_ < 2 ) { return -1 } # Check the number of args 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; # 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; } # Make the substitutions. while ( @pairs ) { my $pattern = shift @pairs; my $replace = shift @pairs; foreach my $token ( @tokens ) { last if $token =~ s/$pattern/$replace/; } } my $formula = join '', @tokens; return $self->write_formula( $row, $col, $formula, $format, $value ); } ############################################################################### # # XML writing methods. # ############################################################################### ############################################################################### # # _write_worksheet() # # Write the <worksheet> element. This is the root element of Worksheet. # sub _write_worksheet { my $self = shift; my $schema = 'http://schemas.openxmlformats.org/'; my $xmlns = $schema . 'spreadsheetml/2006/main'; my $xmlns_r = $schema . 'officeDocument/2006/relationships'; my $xmlns_mc = $schema . 'markup-compatibility/2006'; my @attributes = ( 'xmlns' => $xmlns, 'xmlns:r' => $xmlns_r, ); if ( $self->{_excel_version} == 2010 ) { push @attributes, ( 'xmlns:mc' => $xmlns_mc ); push @attributes, ( 'xmlns:x14ac' => 'http://schemas.microsoft.com/' . 'office/spreadsheetml/2009/9/ac' ); push @attributes, ( 'mc:Ignorable' => 'x14ac' ); } $self->xml_start_tag( 'worksheet', @attributes ); } ############################################################################### # # _write_sheet_pr() # # Write the <sheetPr> element for Sheet level properties. # sub _write_sheet_pr { my $self = shift; my @attributes = (); if ( !$self->{_fit_page} && !$self->{_filter_on} && !$self->{_tab_color} && !$self->{_outline_changed} && !$self->{_vba_codename} ) { return; } my $codename = $self->{_vba_codename}; push @attributes, ( 'codeName' => $codename ) if $codename; push @attributes, ( 'filterMode' => 1 ) if $self->{_filter_on}; if ( $self->{_fit_page} || $self->{_tab_color} || $self->{_outline_changed} ) { $self->xml_start_tag( 'sheetPr', @attributes ); $self->_write_tab_color(); $self->_write_outline_pr(); $self->_write_page_set_up_pr(); $self->xml_end_tag( 'sheetPr' ); } else { $self->xml_empty_tag( 'sheetPr', @attributes ); } } ############################################################################## # # _write_page_set_up_pr() # # Write the <pageSetUpPr> element. # sub _write_page_set_up_pr { my $self = shift; return unless $self->{_fit_page}; my @attributes = ( 'fitToPage' => 1 ); $self->xml_empty_tag( 'pageSetUpPr', @attributes ); } ############################################################################### # # _write_dimension() # # Write the <dimension> element. This specifies the range of cells in the # worksheet. As a special case, empty spreadsheets use 'A1' as a range. # sub _write_dimension { my $self = shift; my $ref; if ( !defined $self->{_dim_rowmin} && !defined $self->{_dim_colmin} ) { # If the min dims are undefined then no dimensions have been set # and we use the default 'A1'. $ref = 'A1'; } elsif ( !defined $self->{_dim_rowmin} && defined $self->{_dim_colmin} ) { # If the row dims aren't set but the column dims are then they # have been changed via set_column(). if ( $self->{_dim_colmin} == $self->{_dim_colmax} ) { # The dimensions are a single cell and not a range. $ref = xl_rowcol_to_cell( 0, $self->{_dim_colmin} ); } else { # The dimensions are a cell range. my $cell_1 = xl_rowcol_to_cell( 0, $self->{_dim_colmin} ); my $cell_2 = xl_rowcol_to_cell( 0, $self->{_dim_colmax} ); $ref = $cell_1 . ':' . $cell_2; } } elsif ($self->{_dim_rowmin} == $self->{_dim_rowmax} && $self->{_dim_colmin} == $self->{_dim_colmax} ) { # The dimensions are a single cell and not a range. $ref = xl_rowcol_to_cell( $self->{_dim_rowmin}, $self->{_dim_colmin} ); } else { # The dimensions are a cell range. my $cell_1 = xl_rowcol_to_cell( $self->{_dim_rowmin}, $self->{_dim_colmin} ); my $cell_2 = xl_rowcol_to_cell( $self->{_dim_rowmax}, $self->{_dim_colmax} ); $ref = $cell_1 . ':' . $cell_2; } my @attributes = ( 'ref' => $ref ); $self->xml_empty_tag( 'dimension', @attributes ); } ############################################################################### # # _write_sheet_views() # # Write the <sheetViews> element. # sub _write_sheet_views { my $self = shift; my @attributes = (); $self->xml_start_tag( 'sheetViews', @attributes ); $self->_write_sheet_view(); $self->xml_end_tag( 'sheetViews' ); } ############################################################################### # # _write_sheet_view() # # Write the <sheetView> element. # # Sample structure: # <sheetView # showGridLines="0" # showRowColHeaders="0" # showZeros="0" # rightToLeft="1" # tabSelected="1" # showRuler="0" # showOutlineSymbols="0" # view="pageLayout" # zoomScale="121" # zoomScaleNormal="121" # workbookViewId="0" # /> # sub _write_sheet_view { my $self = shift; my $gridlines = $self->{_screen_gridlines}; my $show_zeros = $self->{_show_zeros}; my $right_to_left = $self->{_right_to_left}; my $tab_selected = $self->{_selected}; my $view = $self->{_page_view}; my $zoom = $self->{_zoom}; my $row_col_headers = $self->{_hide_row_col_headers}; my $workbook_view_id = 0; my @attributes = (); # Hide screen gridlines if required. if ( !$gridlines ) { push @attributes, ( 'showGridLines' => 0 ); } # Hide the row/column headers. if ( $row_col_headers ) { push @attributes, ( 'showRowColHeaders' => 0 ); } # Hide zeroes in cells. if ( !$show_zeros ) { push @attributes, ( 'showZeros' => 0 ); } # Display worksheet right to left for Hebrew, Arabic and others. if ( $right_to_left ) { push @attributes, ( 'rightToLeft' => 1 ); } # Show that the sheet tab is selected. if ( $tab_selected ) { push @attributes, ( 'tabSelected' => 1 ); } # Turn outlines off. Also required in the outlinePr element. if ( !$self->{_outline_on} ) { push @attributes, ( "showOutlineSymbols" => 0 ); } # Set the page view/layout mode if required. # TODO. Add pageBreakPreview mode when requested. if ( $view ) { push @attributes, ( 'view' => 'pageLayout' ); } # Set the zoom level. if ( $zoom != 100 ) { push @attributes, ( 'zoomScale' => $zoom ) unless $view; push @attributes, ( 'zoomScaleNormal' => $zoom ) if $self->{_zoom_scale_normal}; } push @attributes, ( 'workbookViewId' => $workbook_view_id ); if ( @{ $self->{_panes} } || @{ $self->{_selections} } ) { $self->xml_start_tag( 'sheetView', @attributes ); $self->_write_panes(); $self->_write_selections(); $self->xml_end_tag( 'sheetView' ); } else { $self->xml_empty_tag( 'sheetView', @attributes ); } } ############################################################################### # # _write_selections() # # Write the <selection> elements. # sub _write_selections { my $self = shift; for my $selection ( @{ $self->{_selections} } ) { $self->_write_selection( @$selection ); } } ############################################################################### # # _write_selection() # # Write the <selection> element. # sub _write_selection { my $self = shift; my $pane = shift; my $active_cell = shift; my $sqref = shift; my @attributes = (); push @attributes, ( 'pane' => $pane ) if $pane; push @attributes, ( 'activeCell' => $active_cell ) if $active_cell; push @attributes, ( 'sqref' => $sqref ) if $sqref; $self->xml_empty_tag( 'selection', @attributes ); } ############################################################################### # # _write_sheet_format_pr() # # Write the <sheetFormatPr> element. # sub _write_sheet_format_pr { my $self = shift; my $base_col_width = 10; my $default_row_height = $self->{_default_row_height}; my $row_level = $self->{_outline_row_level}; my $col_level = $self->{_outline_col_level}; my $zero_height = $self->{_default_row_zeroed}; my @attributes = ( 'defaultRowHeight' => $default_row_height ); if ( $self->{_default_row_height} != $self->{_original_row_height} ) { push @attributes, ( 'customHeight' => 1 ); } if ( $self->{_default_row_zeroed} ) { push @attributes, ( 'zeroHeight' => 1 ); } push @attributes, ( 'outlineLevelRow' => $row_level ) if $row_level; push @attributes, ( 'outlineLevelCol' => $col_level ) if $col_level; if ( $self->{_excel_version} == 2010 ) { push @attributes, ( 'x14ac:dyDescent' => '0.25' ); } $self->xml_empty_tag( 'sheetFormatPr', @attributes ); } ############################################################################## # # _write_cols() # # Write the <cols> element and <col> sub elements. # sub _write_cols { my $self = shift; # Exit unless some column have been formatted. return unless %{ $self->{_colinfo} }; $self->xml_start_tag( 'cols' ); for my $col ( sort keys %{ $self->{_colinfo} } ) { $self->_write_col_info( @{ $self->{_colinfo}->{$col} } ); } $self->xml_end_tag( 'cols' ); } ############################################################################## # # _write_col_info() # # Write the <col> element. # sub _write_col_info { my $self = shift; my $min = $_[0] || 0; # First formatted column. my $max = $_[1] || 0; # Last formatted column. my $width = $_[2]; # Col width in user units. my $format = $_[3]; # Format index. my $hidden = $_[4] || 0; # Hidden flag. my $level = $_[5] || 0; # Outline level. my $collapsed = $_[6] || 0; # Outline level. my $custom_width = 1; my $xf_index = 0; # Get the format index. if ( ref( $format ) ) { $xf_index = $format->get_xf_index(); } # Set the Excel default col width. if ( !defined $width ) { if ( !$hidden ) { $width = 8.43; $custom_width = 0; } else { $width = 0; } } else { # Width is defined but same as default. if ( $width == 8.43 ) { $custom_width = 0; } } # Convert column width from user units to character width. my $max_digit_width = 7; # For Calabri 11. my $padding = 5; if ( $width > 0 ) { if ( $width < 1 ) { $width = int( ( int( $width * ($max_digit_width + $padding) + 0.5 ) ) / $max_digit_width * 256 ) / 256; } else { $width = int( ( int( $width * $max_digit_width + 0.5 ) + $padding ) / $max_digit_width * 256 ) / 256; } } my @attributes = ( 'min' => $min + 1, 'max' => $max + 1, 'width' => $width, ); push @attributes, ( 'style' => $xf_index ) if $xf_index; push @attributes, ( 'hidden' => 1 ) if $hidden; push @attributes, ( 'customWidth' => 1 ) if $custom_width; push @attributes, ( 'outlineLevel' => $level ) if $level; push @attributes, ( 'collapsed' => 1 ) if $collapsed; $self->xml_empty_tag( 'col', @attributes ); } ############################################################################### # # _write_sheet_data() # # Write the <sheetData> element. # sub _write_sheet_data { my $self = shift; if ( not defined $self->{_dim_rowmin} ) { # If the dimensions aren't defined then there is no data to write. $self->xml_empty_tag( 'sheetData' ); } else { $self->xml_start_tag( 'sheetData' ); $self->_write_rows(); $self->xml_end_tag( 'sheetData' ); } } ############################################################################### # # _write_optimized_sheet_data() # # Write the <sheetData> element when the memory optimisation is on. In which # case we read the data stored in the temp file and rewrite it to the XML # sheet file. # sub _write_optimized_sheet_data { my $self = shift; if ( not defined $self->{_dim_rowmin} ) { # If the dimensions aren't defined then there is no data to write. $self->xml_empty_tag( 'sheetData' ); } else { $self->xml_start_tag( 'sheetData' ); my $xlsx_fh = $self->xml_get_fh(); my $cell_fh = $self->{_cell_data_fh}; my $buffer; # Rewind the temp file. seek $cell_fh, 0, 0; while ( read( $cell_fh, $buffer, 4_096 ) ) { local $\ = undef; # Protect print from -l on commandline. print $xlsx_fh $buffer; } $self->xml_end_tag( 'sheetData' ); } } ############################################################################### # # _write_rows() # # Write out the worksheet data as a series of rows and cells. # sub _write_rows { my $self = shift; $self->_calculate_spans(); for my $row_num ( $self->{_dim_rowmin} .. $self->{_dim_rowmax} ) { # Skip row if it doesn't contain row formatting, cell data or a comment. if ( !$self->{_set_rows}->{$row_num} && !$self->{_table}->{$row_num} && !$self->{_comments}->{$row_num} ) { next; } my $span_index = int( $row_num / 16 ); my $span = $self->{_row_spans}->[$span_index]; # Write the cells if the row contains data. if ( my $row_ref = $self->{_table}->{$row_num} ) { if ( !$self->{_set_rows}->{$row_num} ) { $self->_write_row( $row_num, $span ); } else { $self->_write_row( $row_num, $span, @{ $self->{_set_rows}->{$row_num} } ); } for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) { if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) { $self->_write_cell( $row_num, $col_num, $col_ref ); } } $self->xml_end_tag( 'row' ); } elsif ( $self->{_comments}->{$row_num} ) { $self->_write_empty_row( $row_num, $span, @{ $self->{_set_rows}->{$row_num} } ); } else { # Row attributes only. $self->_write_empty_row( $row_num, $span, @{ $self->{_set_rows}->{$row_num} } ); } } } ############################################################################### # # _write_single_row() # # Write out the worksheet data as a single row with cells. This method is # used when memory optimisation is on. A single row is written and the data # table is reset. That way only one row of data is kept in memory at any one # time. We don't write span data in the optimised case since it is optional. # sub _write_single_row { my $self = shift; my $current_row = shift || 0; my $row_num = $self->{_previous_row}; # Set the new previous row as the current row. $self->{_previous_row} = $current_row; # Skip row if it doesn't contain row formatting, cell data or a comment. if ( !$self->{_set_rows}->{$row_num} && !$self->{_table}->{$row_num} && !$self->{_comments}->{$row_num} ) { return; } # Write the cells if the row contains data. if ( my $row_ref = $self->{_table}->{$row_num} ) { if ( !$self->{_set_rows}->{$row_num} ) { $self->_write_row( $row_num ); } else { $self->_write_row( $row_num, undef, @{ $self->{_set_rows}->{$row_num} } ); } for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) { if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) { $self->_write_cell( $row_num, $col_num, $col_ref ); } } $self->xml_end_tag( 'row' ); } else { # Row attributes or comments only. $self->_write_empty_row( $row_num, undef, @{ $self->{_set_rows}->{$row_num} } ); } # Reset table. $self->{_table} = {}; } ############################################################################### # # _calculate_spans() # # Calculate the "spans" attribute of the <row> tag. This is an XLSX # optimisation and isn't strictly required. However, it makes comparing # files easier. # # The span is the same for each block of 16 rows. # sub _calculate_spans { my $self = shift; my @spans; my $span_min; my $span_max; for my $row_num ( $self->{_dim_rowmin} .. $self->{_dim_rowmax} ) { # Calculate spans for cell data. if ( my $row_ref = $self->{_table}->{$row_num} ) { for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) { if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) { if ( !defined $span_min ) { $span_min = $col_num; $span_max = $col_num; } else { $span_min = $col_num if $col_num < $span_min; $span_max = $col_num if $col_num > $span_max; } } } } # Calculate spans for comments. if ( defined $self->{_comments}->{$row_num} ) { for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) { if ( defined $self->{_comments}->{$row_num}->{$col_num} ) { if ( !defined $span_min ) { $span_min = $col_num; $span_max = $col_num; } else { $span_min = $col_num if $col_num < $span_min; $span_max = $col_num if $col_num > $span_max; } } } } if ( ( ( $row_num + 1 ) % 16 == 0 ) || $row_num == $self->{_dim_rowmax} ) { my $span_index = int( $row_num / 16 ); if ( defined $span_min ) { $span_min++; $span_max++; $spans[$span_index] = "$span_min:$span_max"; $span_min = undef; } } } $self->{_row_spans} = \@spans; } ############################################################################### # # _write_row() # # Write the <row> element. # sub _write_row { my $self = shift; my $r = shift; my $spans = shift; my $height = shift; my $format = shift; my $hidden = shift || 0; my $level = shift || 0; my $collapsed = shift || 0; my $empty_row = shift || 0; my $xf_index = 0; $height = $self->{_default_row_height} if !defined $height; my @attributes = ( 'r' => $r + 1 ); # Get the format index. if ( ref( $format ) ) { $xf_index = $format->get_xf_index(); } push @attributes, ( 'spans' => $spans ) if defined $spans; push @attributes, ( 's' => $xf_index ) if $xf_index; push @attributes, ( 'customFormat' => 1 ) if $format; if ( $height != $self->{_original_row_height} ) { push @attributes, ( 'ht' => $height ); } push @attributes, ( 'hidden' => 1 ) if $hidden; if ( $height != $self->{_original_row_height} ) { push @attributes, ( 'customHeight' => 1 ); } push @attributes, ( 'outlineLevel' => $level ) if $level; push @attributes, ( 'collapsed' => 1 ) if $collapsed; if ( $self->{_excel_version} == 2010 ) { push @attributes, ( 'x14ac:dyDescent' => '0.25' ); } if ( $empty_row ) { $self->xml_empty_tag_unencoded( 'row', @attributes ); } else { $self->xml_start_tag_unencoded( 'row', @attributes ); } } ############################################################################### # # _write_empty_row() # # Write and empty <row> element, i.e., attributes only, no cell data. # sub _write_empty_row { my $self = shift; # Set the $empty_row parameter. $_[7] = 1; $self->_write_row( @_ ); } ############################################################################### # # _write_cell() # # Write the <cell> element. This is the innermost loop so efficiency is # important where possible. The basic methodology is that the data of every # cell type is passed in as follows: # # [ $row, $col, $aref] # # The aref, called $cell below, contains the following structure in all types: # # [ $type, $token, $xf, @args ] # # Where $type: represents the cell type, such as string, number, formula, etc. # $token: is the actual data for the string, number, formula, etc. # $xf: is the XF format object. # @args: additional args relevant to the specific data type. # sub _write_cell { my $self = shift; my $row = shift; my $col = shift; my $cell = shift; my $type = $cell->[0]; my $token = $cell->[1]; my $xf = $cell->[2]; my $xf_index = 0; my %error_codes = ( '#DIV/0!' => 1, '#N/A' => 1, '#NAME?' => 1, '#NULL!' => 1, '#NUM!' => 1, '#REF!' => 1, '#VALUE!' => 1, ); my %boolean = ( 'TRUE' => 1, 'FALSE' => 0 ); # Get the format index. if ( ref( $xf ) ) { $xf_index = $xf->get_xf_index(); } my $range = _xl_rowcol_to_cell( $row, $col ); my @attributes = ( 'r' => $range ); # Add the cell format index. if ( $xf_index ) { push @attributes, ( 's' => $xf_index ); } elsif ( $self->{_set_rows}->{$row} && $self->{_set_rows}->{$row}->[1] ) { my $row_xf = $self->{_set_rows}->{$row}->[1]; push @attributes, ( 's' => $row_xf->get_xf_index() ); } elsif ( $self->{_col_formats}->{$col} ) { my $col_xf = $self->{_col_formats}->{$col}; push @attributes, ( 's' => $col_xf->get_xf_index() ); } # Write the various cell types. if ( $type eq 'n' ) { # Write a number. $self->xml_number_element( $token, @attributes ); } elsif ( $type eq 's' ) { # Write a string. if ( $self->{_optimization} == 0 ) { $self->xml_string_element( $token, @attributes ); } else { my $string = $token; # Escape control characters. See SharedString.pm for details. $string =~ s/(_x[0-9a-fA-F]{4}_)/_x005F$1/g; $string =~ s/([\x00-\x08\x0B-\x1F])/sprintf "_x%04X_", ord($1)/eg; # Write any rich strings without further tags. if ( $string =~ m{^<r>} && $string =~ m{</r>$} ) { $self->xml_rich_inline_string( $string, @attributes ); } else { # Add attribute to preserve leading or trailing whitespace. my $preserve = 0; if ( $string =~ /^\s/ || $string =~ /\s$/ ) { $preserve = 1; } $self->xml_inline_string( $string, $preserve, @attributes ); } } } elsif ( $type eq 'f' ) { # Write a formula. my $value = $cell->[3]; $value = 0 if !defined $value; # Check if the formula value is a string. if ( $value && $value !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { if ( exists $boolean{$value} ) { push @attributes, ( 't' => 'b' ); $value = $boolean{$value}; } elsif ( exists $error_codes{$value} ) { push @attributes, ( 't' => 'e' ); } else { push @attributes, ( 't' => 'str' ); $value = Excel::Writer::XLSX::Package::XMLwriter::_escape_data( $value ); } } $self->xml_formula_element( $token, $value, @attributes ); } elsif ( $type eq 'a' ) { # Write an array formula. $self->xml_start_tag( 'c', @attributes ); $self->_write_cell_array_formula( $token, $cell->[3] ); $self->_write_cell_value( $cell->[4] ); $self->xml_end_tag( 'c' ); } elsif ( $type eq 'l' ) { # Write a boolean value. push @attributes, ( 't' => 'b' ); $self->xml_start_tag( 'c', @attributes ); $self->_write_cell_value( $cell->[1] ); $self->xml_end_tag( 'c' ); } elsif ( $type eq 'b' ) { # Write a empty cell. $self->xml_empty_tag( 'c', @attributes ); } } ############################################################################### # # _write_cell_value() # # Write the cell value <v> element. # sub _write_cell_value { my $self = shift; my $value = defined $_[0] ? $_[0] : ''; $self->xml_data_element( 'v', $value ); } ############################################################################### # # _write_cell_formula() # # Write the cell formula <f> element. # sub _write_cell_formula { my $self = shift; my $formula = defined $_[0] ? $_[0] : ''; $self->xml_data_element( 'f', $formula ); } ############################################################################### # # _write_cell_array_formula() # # Write the cell array formula <f> element. # sub _write_cell_array_formula { my $self = shift; my $formula = shift; my $range = shift; my @attributes = ( 't' => 'array', 'ref' => $range ); $self->xml_data_element( 'f', $formula, @attributes ); } ############################################################################## # # _write_sheet_calc_pr() # # Write the <sheetCalcPr> element for the worksheet calculation properties. # sub _write_sheet_calc_pr { my $self = shift; my $full_calc_on_load = 1; my @attributes = ( 'fullCalcOnLoad' => $full_calc_on_load ); $self->xml_empty_tag( 'sheetCalcPr', @attributes ); } ############################################################################### # # _write_phonetic_pr() # # Write the <phoneticPr> element. # sub _write_phonetic_pr { my $self = shift; my $font_id = 0; my $type = 'noConversion'; my @attributes = ( 'fontId' => $font_id, 'type' => $type, ); $self->xml_empty_tag( 'phoneticPr', @attributes ); } ############################################################################### # # _write_page_margins() # # Write the <pageMargins> element. # sub _write_page_margins { my $self = shift; my @attributes = ( 'left' => $self->{_margin_left}, 'right' => $self->{_margin_right}, 'top' => $self->{_margin_top}, 'bottom' => $self->{_margin_bottom}, 'header' => $self->{_margin_header}, 'footer' => $self->{_margin_footer}, ); $self->xml_empty_tag( 'pageMargins', @attributes ); } ############################################################################### # # _write_page_setup() # # Write the <pageSetup> element. # # The following is an example taken from Excel. # # <pageSetup # paperSize="9" # scale="110" # fitToWidth="2" # fitToHeight="2" # pageOrder="overThenDown" # orientation="portrait" # blackAndWhite="1" # draft="1" # horizontalDpi="200" # verticalDpi="200" # r:id="rId1" # /> # sub _write_page_setup { my $self = shift; my @attributes = (); return unless $self->{_page_setup_changed}; # Set paper size. if ( $self->{_paper_size} ) { push @attributes, ( 'paperSize' => $self->{_paper_size} ); } # Set the print_scale if ( $self->{_print_scale} != 100 ) { push @attributes, ( 'scale' => $self->{_print_scale} ); } # Set the "Fit to page" properties. if ( $self->{_fit_page} && $self->{_fit_width} != 1 ) { push @attributes, ( 'fitToWidth' => $self->{_fit_width} ); } if ( $self->{_fit_page} && $self->{_fit_height} != 1 ) { push @attributes, ( 'fitToHeight' => $self->{_fit_height} ); } # Set the page print direction. if ( $self->{_page_order} ) { push @attributes, ( 'pageOrder' => "overThenDown" ); } # Set start page. if ( $self->{_page_start} > 1 ) { push @attributes, ( 'firstPageNumber' => $self->{_page_start} ); } # Set page orientation. if ( $self->{_orientation} == 0 ) { push @attributes, ( 'orientation' => 'landscape' ); } else { push @attributes, ( 'orientation' => 'portrait' ); } # Set print in black and white option. if ( $self->{_black_white} ) { push @attributes, ( 'blackAndWhite' => 1 ); } # Set start page. if ( $self->{_page_start} != 0 ) { push @attributes, ( 'useFirstPageNumber' => 1 ); } # Set the DPI. Mainly only for testing. if ( $self->{_horizontal_dpi} ) { push @attributes, ( 'horizontalDpi' => $self->{_horizontal_dpi} ); } if ( $self->{_vertical_dpi} ) { push @attributes, ( 'verticalDpi' => $self->{_vertical_dpi} ); } $self->xml_empty_tag( 'pageSetup', @attributes ); } ############################################################################## # # _write_merge_cells() # # Write the <mergeCells> element. # sub _write_merge_cells { my $self = shift; my $merged_cells = $self->{_merge}; my $count = @$merged_cells; return unless $count; my @attributes = ( 'count' => $count ); $self->xml_start_tag( 'mergeCells', @attributes ); for my $merged_range ( @$merged_cells ) { # Write the mergeCell element. $self->_write_merge_cell( $merged_range ); } $self->xml_end_tag( 'mergeCells' ); } ############################################################################## # # _write_merge_cell() # # Write the <mergeCell> element. # sub _write_merge_cell { my $self = shift; my $merged_range = shift; my ( $row_min, $col_min, $row_max, $col_max ) = @$merged_range; # Convert the merge dimensions to a cell range. my $cell_1 = xl_rowcol_to_cell( $row_min, $col_min ); my $cell_2 = xl_rowcol_to_cell( $row_max, $col_max ); my $ref = $cell_1 . ':' . $cell_2; my @attributes = ( 'ref' => $ref ); $self->xml_empty_tag( 'mergeCell', @attributes ); } ############################################################################## # # _write_print_options() # # Write the <printOptions> element. # sub _write_print_options { my $self = shift; my @attributes = (); return unless $self->{_print_options_changed}; # Set horizontal centering. if ( $self->{_hcenter} ) { push @attributes, ( 'horizontalCentered' => 1 ); } # Set vertical centering. if ( $self->{_vcenter} ) { push @attributes, ( 'verticalCentered' => 1 ); } # Enable row and column headers. if ( $self->{_print_headers} ) { push @attributes, ( 'headings' => 1 ); } # Set printed gridlines. if ( $self->{_print_gridlines} ) { push @attributes, ( 'gridLines' => 1 ); } $self->xml_empty_tag( 'printOptions', @attributes ); } ############################################################################## # # _write_header_footer() # # Write the <headerFooter> element. # sub _write_header_footer { my $self = shift; my @attributes = (); if ( !$self->{_header_footer_scales} ) { push @attributes, ( 'scaleWithDoc' => 0 ); } if ( !$self->{_header_footer_aligns} ) { push @attributes, ( 'alignWithMargins' => 0 ); } if ( $self->{_header_footer_changed} ) { $self->xml_start_tag( 'headerFooter', @attributes ); $self->_write_odd_header() if $self->{_header}; $self->_write_odd_footer() if $self->{_footer}; $self->xml_end_tag( 'headerFooter' ); } elsif ( $self->{_excel2003_style} ) { $self->xml_empty_tag( 'headerFooter', @attributes ); } } ############################################################################## # # _write_odd_header() # # Write the <oddHeader> element. # sub _write_odd_header { my $self = shift; my $data = $self->{_header}; $self->xml_data_element( 'oddHeader', $data ); } ############################################################################## # # _write_odd_footer() # # Write the <oddFooter> element. # sub _write_odd_footer { my $self = shift; my $data = $self->{_footer}; $self->xml_data_element( 'oddFooter', $data ); } ############################################################################## # # _write_row_breaks() # # Write the <rowBreaks> element. # sub _write_row_breaks { my $self = shift; my @page_breaks = $self->_sort_pagebreaks( @{ $self->{_hbreaks} } ); my $count = scalar @page_breaks; return unless @page_breaks; my @attributes = ( 'count' => $count, 'manualBreakCount' => $count, ); $self->xml_start_tag( 'rowBreaks', @attributes ); for my $row_num ( @page_breaks ) { $self->_write_brk( $row_num, 16383 ); } $self->xml_end_tag( 'rowBreaks' ); } ############################################################################## # # _write_col_breaks() # # Write the <colBreaks> element. # sub _write_col_breaks { my $self = shift; my @page_breaks = $self->_sort_pagebreaks( @{ $self->{_vbreaks} } ); my $count = scalar @page_breaks; return unless @page_breaks; my @attributes = ( 'count' => $count, 'manualBreakCount' => $count, ); $self->xml_start_tag( 'colBreaks', @attributes ); for my $col_num ( @page_breaks ) { $self->_write_brk( $col_num, 1048575 ); } $self->xml_end_tag( 'colBreaks' ); } ############################################################################## # # _write_brk() # # Write the <brk> element. # sub _write_brk { my $self = shift; my $id = shift; my $max = shift; my $man = 1; my @attributes = ( 'id' => $id, 'max' => $max, 'man' => $man, ); $self->xml_empty_tag( 'brk', @attributes ); } ############################################################################## # # _write_auto_filter() # # Write the <autoFilter> element. # sub _write_auto_filter { my $self = shift; my $ref = $self->{_autofilter_ref}; return unless $ref; my @attributes = ( 'ref' => $ref ); if ( $self->{_filter_on} ) { # Autofilter defined active filters. $self->xml_start_tag( 'autoFilter', @attributes ); $self->_write_autofilters(); $self->xml_end_tag( 'autoFilter' ); } else { # Autofilter defined without active filters. $self->xml_empty_tag( 'autoFilter', @attributes ); } } ############################################################################### # # _write_autofilters() # # Function to iterate through the columns that form part of an autofilter # range and write the appropriate filters. # sub _write_autofilters { my $self = shift; my ( $col1, $col2 ) = @{ $self->{_filter_range} }; for my $col ( $col1 .. $col2 ) { # Skip if column doesn't have an active filter. next unless $self->{_filter_cols}->{$col}; # Retrieve the filter tokens and write the autofilter records. my @tokens = @{ $self->{_filter_cols}->{$col} }; my $type = $self->{_filter_type}->{$col}; # Filters are relative to first column in the autofilter. $self->_write_filter_column( $col - $col1, $type, \@tokens ); } } ############################################################################## # # _write_filter_column() # # Write the <filterColumn> element. # sub _write_filter_column { my $self = shift; my $col_id = shift; my $type = shift; my $filters = shift; my @attributes = ( 'colId' => $col_id ); $self->xml_start_tag( 'filterColumn', @attributes ); if ( $type == 1 ) { # Type == 1 is the new XLSX style filter. $self->_write_filters( @$filters ); } else { # Type == 0 is the classic "custom" filter. $self->_write_custom_filters( @$filters ); } $self->xml_end_tag( 'filterColumn' ); } ############################################################################## # # _write_filters() # # Write the <filters> element. # sub _write_filters { my $self = shift; my @filters = @_; my @non_blanks = grep { !/^blanks$/i } @filters; my @attributes = (); if ( @filters != @non_blanks ) { @attributes = ( 'blank' => 1 ); } if ( @filters == 1 && @non_blanks == 0 ) { # Special case for blank cells only. $self->xml_empty_tag( 'filters', @attributes ); } else { # General case. $self->xml_start_tag( 'filters', @attributes ); for my $filter ( sort @non_blanks ) { $self->_write_filter( $filter ); } $self->xml_end_tag( 'filters' ); } } ############################################################################## # # _write_filter() # # Write the <filter> element. # sub _write_filter { my $self = shift; my $val = shift; my @attributes = ( 'val' => $val ); $self->xml_empty_tag( 'filter', @attributes ); } ############################################################################## # # _write_custom_filters() # # Write the <customFilters> element. # sub _write_custom_filters { my $self = shift; my @tokens = @_; if ( @tokens == 2 ) { # One filter expression only. $self->xml_start_tag( 'customFilters' ); $self->_write_custom_filter( @tokens ); $self->xml_end_tag( 'customFilters' ); } else { # Two filter expressions. my @attributes; # Check if the "join" operand is "and" or "or". if ( $tokens[2] == 0 ) { @attributes = ( 'and' => 1 ); } else { @attributes = ( 'and' => 0 ); } # Write the two custom filters. $self->xml_start_tag( 'customFilters', @attributes ); $self->_write_custom_filter( $tokens[0], $tokens[1] ); $self->_write_custom_filter( $tokens[3], $tokens[4] ); $self->xml_end_tag( 'customFilters' ); } } ############################################################################## # # _write_custom_filter() # # Write the <customFilter> element. # sub _write_custom_filter { my $self = shift; my $operator = shift; my $val = shift; my @attributes = (); my %operators = ( 1 => 'lessThan', 2 => 'equal', 3 => 'lessThanOrEqual', 4 => 'greaterThan', 5 => 'notEqual', 6 => 'greaterThanOrEqual', 22 => 'equal', ); # Convert the operator from a number to a descriptive string. if ( defined $operators{$operator} ) { $operator = $operators{$operator}; } else { croak "Unknown operator = $operator\n"; } # The 'equal' operator is the default attribute and isn't stored. push @attributes, ( 'operator' => $operator ) unless $operator eq 'equal'; push @attributes, ( 'val' => $val ); $self->xml_empty_tag( 'customFilter', @attributes ); } ############################################################################## # # _write_hyperlinks() # # Process any stored hyperlinks in row/col order and write the <hyperlinks> # element. The attributes are different for internal and external links. # sub _write_hyperlinks { my $self = shift; my @hlink_refs; # Sort the hyperlinks into row order. my @row_nums = sort { $a <=> $b } keys %{ $self->{_hyperlinks} }; # Exit if there are no hyperlinks to process. return if !@row_nums; # Iterate over the rows. for my $row_num ( @row_nums ) { # Sort the hyperlinks into column order. my @col_nums = sort { $a <=> $b } keys %{ $self->{_hyperlinks}->{$row_num} }; # Iterate over the columns. for my $col_num ( @col_nums ) { # Get the link data for this cell. my $link = $self->{_hyperlinks}->{$row_num}->{$col_num}; my $link_type = $link->{_link_type}; # If the cell isn't a string then we have to add the url as # the string to display. my $display; if ( $self->{_table} && $self->{_table}->{$row_num} && $self->{_table}->{$row_num}->{$col_num} ) { my $cell = $self->{_table}->{$row_num}->{$col_num}; $display = $link->{_url} if $cell->[0] ne 's'; } if ( $link_type == 1 ) { # External link with rel file relationship. push @hlink_refs, [ $link_type, $row_num, $col_num, ++$self->{_rel_count}, $link->{_str}, $display, $link->{_tip} ]; # Links for use by the packager. push @{ $self->{_external_hyper_links} }, [ '/hyperlink', $link->{_url}, 'External' ]; } else { # Internal link with rel file relationship. push @hlink_refs, [ $link_type, $row_num, $col_num, $link->{_url}, $link->{_str}, $link->{_tip} ]; } } } # Write the hyperlink elements. $self->xml_start_tag( 'hyperlinks' ); for my $aref ( @hlink_refs ) { my ( $type, @args ) = @$aref; if ( $type == 1 ) { $self->_write_hyperlink_external( @args ); } elsif ( $type == 2 ) { $self->_write_hyperlink_internal( @args ); } } $self->xml_end_tag( 'hyperlinks' ); } ############################################################################## # # _write_hyperlink_external() # # Write the <hyperlink> element for external links. # sub _write_hyperlink_external { my $self = shift; my $row = shift; my $col = shift; my $id = shift; my $location = shift; my $display = shift; my $tooltip = shift; my $ref = xl_rowcol_to_cell( $row, $col ); my $r_id = 'rId' . $id; my @attributes = ( 'ref' => $ref, 'r:id' => $r_id, ); push @attributes, ( 'location' => $location ) if defined $location; push @attributes, ( 'display' => $display ) if defined $display; push @attributes, ( 'tooltip' => $tooltip ) if defined $tooltip; $self->xml_empty_tag( 'hyperlink', @attributes ); } ############################################################################## # # _write_hyperlink_internal() # # Write the <hyperlink> element for internal links. # sub _write_hyperlink_internal { my $self = shift; my $row = shift; my $col = shift; my $location = shift; my $display = shift; my $tooltip = shift; my $ref = xl_rowcol_to_cell( $row, $col ); my @attributes = ( 'ref' => $ref, 'location' => $location ); push @attributes, ( 'tooltip' => $tooltip ) if defined $tooltip; push @attributes, ( 'display' => $display ); $self->xml_empty_tag( 'hyperlink', @attributes ); } ############################################################################## # # _write_panes() # # Write the frozen or split <pane> elements. # sub _write_panes { my $self = shift; my @panes = @{ $self->{_panes} }; return unless @panes; if ( $panes[4] == 2 ) { $self->_write_split_panes( @panes ); } else { $self->_write_freeze_panes( @panes ); } } ############################################################################## # # _write_freeze_panes() # # Write the <pane> element for freeze panes. # sub _write_freeze_panes { my $self = shift; my @attributes; my ( $row, $col, $top_row, $left_col, $type ) = @_; my $y_split = $row; my $x_split = $col; my $top_left_cell = xl_rowcol_to_cell( $top_row, $left_col ); my $active_pane; my $state; my $active_cell; my $sqref; # Move user cell selection to the panes. if ( @{ $self->{_selections} } ) { ( undef, $active_cell, $sqref ) = @{ $self->{_selections}->[0] }; $self->{_selections} = []; } # Set the active pane. if ( $row && $col ) { $active_pane = 'bottomRight'; my $row_cell = xl_rowcol_to_cell( $row, 0 ); my $col_cell = xl_rowcol_to_cell( 0, $col ); push @{ $self->{_selections} }, ( [ 'topRight', $col_cell, $col_cell ], [ 'bottomLeft', $row_cell, $row_cell ], [ 'bottomRight', $active_cell, $sqref ] ); } elsif ( $col ) { $active_pane = 'topRight'; push @{ $self->{_selections} }, [ 'topRight', $active_cell, $sqref ]; } else { $active_pane = 'bottomLeft'; push @{ $self->{_selections} }, [ 'bottomLeft', $active_cell, $sqref ]; } # Set the pane type. if ( $type == 0 ) { $state = 'frozen'; } elsif ( $type == 1 ) { $state = 'frozenSplit'; } else { $state = 'split'; } push @attributes, ( 'xSplit' => $x_split ) if $x_split; push @attributes, ( 'ySplit' => $y_split ) if $y_split; push @attributes, ( 'topLeftCell' => $top_left_cell ); push @attributes, ( 'activePane' => $active_pane ); push @attributes, ( 'state' => $state ); $self->xml_empty_tag( 'pane', @attributes ); } ############################################################################## # # _write_split_panes() # # Write the <pane> element for split panes. # # See also, implementers note for split_panes(). # sub _write_split_panes { my $self = shift; my @attributes; my $y_split; my $x_split; my $has_selection = 0; my $active_pane; my $active_cell; my $sqref; my ( $row, $col, $top_row, $left_col, $type ) = @_; $y_split = $row; $x_split = $col; # Move user cell selection to the panes. if ( @{ $self->{_selections} } ) { ( undef, $active_cell, $sqref ) = @{ $self->{_selections}->[0] }; $self->{_selections} = []; $has_selection = 1; } # Convert the row and col to 1/20 twip units with padding. $y_split = int( 20 * $y_split + 300 ) if $y_split; $x_split = $self->_calculate_x_split_width( $x_split ) if $x_split; # For non-explicit topLeft definitions, estimate the cell offset based # on the pixels dimensions. This is only a workaround and doesn't take # adjusted cell dimensions into account. if ( $top_row == $row && $left_col == $col ) { $top_row = int( 0.5 + ( $y_split - 300 ) / 20 / 15 ); $left_col = int( 0.5 + ( $x_split - 390 ) / 20 / 3 * 4 / 64 ); } my $top_left_cell = xl_rowcol_to_cell( $top_row, $left_col ); # If there is no selection set the active cell to the top left cell. if ( !$has_selection ) { $active_cell = $top_left_cell; $sqref = $top_left_cell; } # Set the Cell selections. if ( $row && $col ) { $active_pane = 'bottomRight'; my $row_cell = xl_rowcol_to_cell( $top_row, 0 ); my $col_cell = xl_rowcol_to_cell( 0, $left_col ); push @{ $self->{_selections} }, ( [ 'topRight', $col_cell, $col_cell ], [ 'bottomLeft', $row_cell, $row_cell ], [ 'bottomRight', $active_cell, $sqref ] ); } elsif ( $col ) { $active_pane = 'topRight'; push @{ $self->{_selections} }, [ 'topRight', $active_cell, $sqref ]; } else { $active_pane = 'bottomLeft'; push @{ $self->{_selections} }, [ 'bottomLeft', $active_cell, $sqref ]; } push @attributes, ( 'xSplit' => $x_split ) if $x_split; push @attributes, ( 'ySplit' => $y_split ) if $y_split; push @attributes, ( 'topLeftCell' => $top_left_cell ); push @attributes, ( 'activePane' => $active_pane ) if $has_selection; $self->xml_empty_tag( 'pane', @attributes ); } ############################################################################## # # _calculate_x_split_width() # # Convert column width from user units to pane split width. # sub _calculate_x_split_width { my $self = shift; my $width = shift; my $max_digit_width = 7; # For Calabri 11. my $padding = 5; my $pixels; # Convert to pixels. if ( $width < 1 ) { $pixels = int( $width * ( $max_digit_width + $padding ) + 0.5 ); } else { $pixels = int( $width * $max_digit_width + 0.5 ) + $padding; } # Convert to points. my $points = $pixels * 3 / 4; # Convert to twips (twentieths of a point). my $twips = $points * 20; # Add offset/padding. $width = $twips + 390; return $width; } ############################################################################## # # _write_tab_color() # # Write the <tabColor> element. # sub _write_tab_color { my $self = shift; my $color_index = $self->{_tab_color}; return unless $color_index; my $rgb = $self->_get_palette_color( $color_index ); my @attributes = ( 'rgb' => $rgb ); $self->xml_empty_tag( 'tabColor', @attributes ); } ############################################################################## # # _write_outline_pr() # # Write the <outlinePr> element. # sub _write_outline_pr { my $self = shift; my @attributes = (); return unless $self->{_outline_changed}; push @attributes, ( "applyStyles" => 1 ) if $self->{_outline_style}; push @attributes, ( "summaryBelow" => 0 ) if !$self->{_outline_below}; push @attributes, ( "summaryRight" => 0 ) if !$self->{_outline_right}; push @attributes, ( "showOutlineSymbols" => 0 ) if !$self->{_outline_on}; $self->xml_empty_tag( 'outlinePr', @attributes ); } ############################################################################## # # _write_sheet_protection() # # Write the <sheetProtection> element. # sub _write_sheet_protection { my $self = shift; my @attributes; return unless $self->{_protect}; my %arg = %{ $self->{_protect} }; push @attributes, ( "password" => $arg{password} ) if $arg{password}; push @attributes, ( "sheet" => 1 ) if $arg{sheet}; push @attributes, ( "content" => 1 ) if $arg{content}; push @attributes, ( "objects" => 1 ) if !$arg{objects}; push @attributes, ( "scenarios" => 1 ) if !$arg{scenarios}; push @attributes, ( "formatCells" => 0 ) if $arg{format_cells}; push @attributes, ( "formatColumns" => 0 ) if $arg{format_columns}; push @attributes, ( "formatRows" => 0 ) if $arg{format_rows}; push @attributes, ( "insertColumns" => 0 ) if $arg{insert_columns}; push @attributes, ( "insertRows" => 0 ) if $arg{insert_rows}; push @attributes, ( "insertHyperlinks" => 0 ) if $arg{insert_hyperlinks}; push @attributes, ( "deleteColumns" => 0 ) if $arg{delete_columns}; push @attributes, ( "deleteRows" => 0 ) if $arg{delete_rows}; push @attributes, ( "selectLockedCells" => 1 ) if !$arg{select_locked_cells}; push @attributes, ( "sort" => 0 ) if $arg{sort}; push @attributes, ( "autoFilter" => 0 ) if $arg{autofilter}; push @attributes, ( "pivotTables" => 0 ) if $arg{pivot_tables}; push @attributes, ( "selectUnlockedCells" => 1 ) if !$arg{select_unlocked_cells}; $self->xml_empty_tag( 'sheetProtection', @attributes ); } ############################################################################## # # _write_drawings() # # Write the <drawing> elements. # sub _write_drawings { my $self = shift; return unless $self->{_drawing}; $self->_write_drawing( ++$self->{_rel_count} ); } ############################################################################## # # _write_drawing() # # Write the <drawing> element. # sub _write_drawing { my $self = shift; my $id = shift; my $r_id = 'rId' . $id; my @attributes = ( 'r:id' => $r_id ); $self->xml_empty_tag( 'drawing', @attributes ); } ############################################################################## # # _write_legacy_drawing() # # Write the <legacyDrawing> element. # sub _write_legacy_drawing { my $self = shift; my $id; return unless $self->{_has_vml}; # Increment the relationship id for any drawings or comments. $id = ++$self->{_rel_count}; my @attributes = ( 'r:id' => 'rId' . $id ); $self->xml_empty_tag( 'legacyDrawing', @attributes ); } ############################################################################## # # _write_legacy_drawing_hf() # # Write the <legacyDrawingHF> element. # sub _write_legacy_drawing_hf { my $self = shift; my $id; return unless $self->{_has_header_vml}; # Increment the relationship id for any drawings or comments. $id = ++$self->{_rel_count}; my @attributes = ( 'r:id' => 'rId' . $id ); $self->xml_empty_tag( 'legacyDrawingHF', @attributes ); } # # Note, the following font methods are, more or less, duplicated from the # Excel::Writer::XLSX::Package::Styles class. I will look at implementing # this is a cleaner encapsulated mode at a later stage. # ############################################################################## # # _write_font() # # Write the <font> element. # sub _write_font { my $self = shift; my $format = shift; $self->{_rstring}->xml_start_tag( 'rPr' ); $self->{_rstring}->xml_empty_tag( 'b' ) if $format->{_bold}; $self->{_rstring}->xml_empty_tag( 'i' ) if $format->{_italic}; $self->{_rstring}->xml_empty_tag( 'strike' ) if $format->{_font_strikeout}; $self->{_rstring}->xml_empty_tag( 'outline' ) if $format->{_font_outline}; $self->{_rstring}->xml_empty_tag( 'shadow' ) if $format->{_font_shadow}; # Handle the underline variants. $self->_write_underline( $format->{_underline} ) if $format->{_underline}; $self->_write_vert_align( 'superscript' ) if $format->{_font_script} == 1; $self->_write_vert_align( 'subscript' ) if $format->{_font_script} == 2; $self->{_rstring}->xml_empty_tag( 'sz', 'val', $format->{_size} ); if ( my $theme = $format->{_theme} ) { $self->_write_rstring_color( 'theme' => $theme ); } elsif ( my $color = $format->{_color} ) { $color = $self->_get_palette_color( $color ); $self->_write_rstring_color( 'rgb' => $color ); } else { $self->_write_rstring_color( 'theme' => 1 ); } $self->{_rstring}->xml_empty_tag( 'rFont', 'val', $format->{_font} ); $self->{_rstring} ->xml_empty_tag( 'family', 'val', $format->{_font_family} ); if ( $format->{_font} eq 'Calibri' && !$format->{_hyperlink} ) { $self->{_rstring} ->xml_empty_tag( 'scheme', 'val', $format->{_font_scheme} ); } $self->{_rstring}->xml_end_tag( 'rPr' ); } ############################################################################### # # _write_underline() # # Write the underline font element. # sub _write_underline { my $self = shift; my $underline = shift; my @attributes; # Handle the underline variants. if ( $underline == 2 ) { @attributes = ( val => 'double' ); } elsif ( $underline == 33 ) { @attributes = ( val => 'singleAccounting' ); } elsif ( $underline == 34 ) { @attributes = ( val => 'doubleAccounting' ); } else { @attributes = (); # Default to single underline. } $self->{_rstring}->xml_empty_tag( 'u', @attributes ); } ############################################################################## # # _write_vert_align() # # Write the <vertAlign> font sub-element. # sub _write_vert_align { my $self = shift; my $val = shift; my @attributes = ( 'val' => $val ); $self->{_rstring}->xml_empty_tag( 'vertAlign', @attributes ); } ############################################################################## # # _write_rstring_color() # # Write the <color> element. # sub _write_rstring_color { my $self = shift; my $name = shift; my $value = shift; my @attributes = ( $name => $value ); $self->{_rstring}->xml_empty_tag( 'color', @attributes ); } # # End font duplication code. # ############################################################################## # # _write_data_validations() # # Write the <dataValidations> element. # sub _write_data_validations { my $self = shift; my @validations = @{ $self->{_validations} }; my $count = @validations; return unless $count; my @attributes = ( 'count' => $count ); $self->xml_start_tag( 'dataValidations', @attributes ); for my $validation ( @validations ) { # Write the dataValidation element. $self->_write_data_validation( $validation ); } $self->xml_end_tag( 'dataValidations' ); } ############################################################################## # # _write_data_validation() # # Write the <dataValidation> element. # sub _write_data_validation { my $self = shift; my $param = shift; my $sqref = ''; my @attributes = (); # Set the cell range(s) for the data validation. for my $cells ( @{ $param->{cells} } ) { # Add a space between multiple cell ranges. $sqref .= ' ' if $sqref ne ''; my ( $row_first, $col_first, $row_last, $col_last ) = @$cells; # Swap last row/col for first row/col as necessary if ( $row_first > $row_last ) { ( $row_first, $row_last ) = ( $row_last, $row_first ); } if ( $col_first > $col_last ) { ( $col_first, $col_last ) = ( $col_last, $col_first ); } # If the first and last cell are the same write a single cell. if ( ( $row_first == $row_last ) && ( $col_first == $col_last ) ) { $sqref .= xl_rowcol_to_cell( $row_first, $col_first ); } else { $sqref .= xl_range( $row_first, $row_last, $col_first, $col_last ); } } if ( $param->{validate} ne 'none' ) { push @attributes, ( 'type' => $param->{validate} ); if ( $param->{criteria} ne 'between' ) { push @attributes, ( 'operator' => $param->{criteria} ); } } if ( $param->{error_type} ) { push @attributes, ( 'errorStyle' => 'warning' ) if $param->{error_type} == 1; push @attributes, ( 'errorStyle' => 'information' ) if $param->{error_type} == 2; } push @attributes, ( 'allowBlank' => 1 ) if $param->{ignore_blank}; push @attributes, ( 'showDropDown' => 1 ) if !$param->{dropdown}; push @attributes, ( 'showInputMessage' => 1 ) if $param->{show_input}; push @attributes, ( 'showErrorMessage' => 1 ) if $param->{show_error}; push @attributes, ( 'errorTitle' => $param->{error_title} ) if $param->{error_title}; push @attributes, ( 'error' => $param->{error_message} ) if $param->{error_message}; push @attributes, ( 'promptTitle' => $param->{input_title} ) if $param->{input_title}; push @attributes, ( 'prompt' => $param->{input_message} ) if $param->{input_message}; push @attributes, ( 'sqref' => $sqref ); if ( $param->{validate} eq 'none' ) { $self->xml_empty_tag( 'dataValidation', @attributes ); } else { $self->xml_start_tag( 'dataValidation', @attributes ); # Write the formula1 element. $self->_write_formula_1( $param->{value} ); # Write the formula2 element. $self->_write_formula_2( $param->{maximum} ) if defined $param->{maximum}; $self->xml_end_tag( 'dataValidation' ); } } ############################################################################## # # _write_formula_1() # # Write the <formula1> element. # sub _write_formula_1 { my $self = shift; my $formula = shift; # Convert a list array ref into a comma separated string. if ( ref $formula eq 'ARRAY' ) { $formula = join ',', @$formula; $formula = qq("$formula"); } $formula =~ s/^=//; # Remove formula symbol. $self->xml_data_element( 'formula1', $formula ); } ############################################################################## # # _write_formula_2() # # Write the <formula2> element. # sub _write_formula_2 { my $self = shift; my $formula = shift; $formula =~ s/^=//; # Remove formula symbol. $self->xml_data_element( 'formula2', $formula ); } ############################################################################## # # _write_conditional_formats() # # Write the Worksheet conditional formats. # sub _write_conditional_formats { my $self = shift; my @ranges = sort keys %{ $self->{_cond_formats} }; return unless scalar @ranges; for my $range ( @ranges ) { $self->_write_conditional_formatting( $range, $self->{_cond_formats}->{$range} ); } } ############################################################################## # # _write_conditional_formatting() # # Write the <conditionalFormatting> element. # sub _write_conditional_formatting { my $self = shift; my $range = shift; my $params = shift; my @attributes = ( 'sqref' => $range ); $self->xml_start_tag( 'conditionalFormatting', @attributes ); for my $param ( @$params ) { # Write the cfRule element. $self->_write_cf_rule( $param ); } $self->xml_end_tag( 'conditionalFormatting' ); } ############################################################################## # # _write_cf_rule() # # Write the <cfRule> element. # sub _write_cf_rule { my $self = shift; my $param = shift; my @attributes = ( 'type' => $param->{type} ); push @attributes, ( 'dxfId' => $param->{format} ) if defined $param->{format}; push @attributes, ( 'priority' => $param->{priority} ); push @attributes, ( 'stopIfTrue' => 1 ) if $param->{stop_if_true}; if ( $param->{type} eq 'cellIs' ) { push @attributes, ( 'operator' => $param->{criteria} ); $self->xml_start_tag( 'cfRule', @attributes ); if ( defined $param->{minimum} && defined $param->{maximum} ) { $self->_write_formula( $param->{minimum} ); $self->_write_formula( $param->{maximum} ); } else { my $value = $param->{value}; # String "Cell" values must be quoted, apart from ranges. if ( $value !~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/ && $value !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { if ( $value !~ /^".*"$/ ) { $value = qq("$value"); } } $self->_write_formula( $value ); } $self->xml_end_tag( 'cfRule' ); } elsif ( $param->{type} eq 'aboveAverage' ) { if ( $param->{criteria} =~ /below/ ) { push @attributes, ( 'aboveAverage' => 0 ); } if ( $param->{criteria} =~ /equal/ ) { push @attributes, ( 'equalAverage' => 1 ); } if ( $param->{criteria} =~ /([123]) std dev/ ) { push @attributes, ( 'stdDev' => $1 ); } $self->xml_empty_tag( 'cfRule', @attributes ); } elsif ( $param->{type} eq 'top10' ) { if ( defined $param->{criteria} && $param->{criteria} eq '%' ) { push @attributes, ( 'percent' => 1 ); } if ( $param->{direction} ) { push @attributes, ( 'bottom' => 1 ); } my $rank = $param->{value} || 10; push @attributes, ( 'rank' => $rank ); $self->xml_empty_tag( 'cfRule', @attributes ); } elsif ( $param->{type} eq 'duplicateValues' ) { $self->xml_empty_tag( 'cfRule', @attributes ); } elsif ( $param->{type} eq 'uniqueValues' ) { $self->xml_empty_tag( 'cfRule', @attributes ); } elsif ($param->{type} eq 'containsText' || $param->{type} eq 'notContainsText' || $param->{type} eq 'beginsWith' || $param->{type} eq 'endsWith' ) { push @attributes, ( 'operator' => $param->{criteria} ); push @attributes, ( 'text' => $param->{value} ); $self->xml_start_tag( 'cfRule', @attributes ); $self->_write_formula( $param->{formula} ); $self->xml_end_tag( 'cfRule' ); } elsif ( $param->{type} eq 'timePeriod' ) { push @attributes, ( 'timePeriod' => $param->{criteria} ); $self->xml_start_tag( 'cfRule', @attributes ); $self->_write_formula( $param->{formula} ); $self->xml_end_tag( 'cfRule' ); } elsif ($param->{type} eq 'containsBlanks' || $param->{type} eq 'notContainsBlanks' || $param->{type} eq 'containsErrors' || $param->{type} eq 'notContainsErrors' ) { $self->xml_start_tag( 'cfRule', @attributes ); $self->_write_formula( $param->{formula} ); $self->xml_end_tag( 'cfRule' ); } elsif ( $param->{type} eq 'colorScale' ) { $self->xml_start_tag( 'cfRule', @attributes ); $self->_write_color_scale( $param ); $self->xml_end_tag( 'cfRule' ); } elsif ( $param->{type} eq 'dataBar' ) { $self->xml_start_tag( 'cfRule', @attributes ); $self->_write_data_bar( $param ); if ($param->{_is_data_bar_2010}) { $self->_write_data_bar_ext( $param ); } $self->xml_end_tag( 'cfRule' ); } elsif ( $param->{type} eq 'expression' ) { $self->xml_start_tag( 'cfRule', @attributes ); $self->_write_formula( $param->{criteria} ); $self->xml_end_tag( 'cfRule' ); } elsif ( $param->{type} eq 'iconSet' ) { $self->xml_start_tag( 'cfRule', @attributes ); $self->_write_icon_set( $param ); $self->xml_end_tag( 'cfRule' ); } } ############################################################################## # # _write_icon_set() # # Write the <iconSet> element. # sub _write_icon_set { my $self = shift; my $param = shift; my $icon_style = $param->{icon_style}; my $total_icons = $param->{total_icons}; my $icons = $param->{icons}; my $i; my @attributes = (); # Don't set attribute for default style. if ( $icon_style ne '3TrafficLights' ) { @attributes = ( 'iconSet' => $icon_style ); } if ( exists $param->{'icons_only'} && $param->{'icons_only'} ) { push @attributes, ( 'showValue' => 0 ); } if ( exists $param->{'reverse_icons'} && $param->{'reverse_icons'} ) { push @attributes, ( 'reverse' => 1 ); } $self->xml_start_tag( 'iconSet', @attributes ); # Write the properties for different icon styles. for my $icon ( reverse @{ $param->{icons} } ) { $self->_write_cfvo( $icon->{'type'}, $icon->{'value'}, $icon->{'criteria'} ); } $self->xml_end_tag( 'iconSet' ); } ############################################################################## # # _write_formula() # # Write the <formula> element. # sub _write_formula { my $self = shift; my $data = shift; # Remove equality from formula. $data =~ s/^=//; $self->xml_data_element( 'formula', $data ); } ############################################################################## # # _write_color_scale() # # Write the <colorScale> element. # sub _write_color_scale { my $self = shift; my $param = shift; $self->xml_start_tag( 'colorScale' ); $self->_write_cfvo( $param->{min_type}, $param->{min_value} ); if ( defined $param->{mid_type} ) { $self->_write_cfvo( $param->{mid_type}, $param->{mid_value} ); } $self->_write_cfvo( $param->{max_type}, $param->{max_value} ); $self->_write_color( 'rgb' => $param->{min_color} ); if ( defined $param->{mid_color} ) { $self->_write_color( 'rgb' => $param->{mid_color} ); } $self->_write_color( 'rgb' => $param->{max_color} ); $self->xml_end_tag( 'colorScale' ); } ############################################################################## # # _write_data_bar() # # Write the <dataBar> element. # sub _write_data_bar { my $self = shift; my $data_bar = shift; my @attributes = (); if ( $data_bar->{bar_only} ) { push @attributes, ( 'showValue', 0 ); } $self->xml_start_tag( 'dataBar', @attributes ); $self->_write_cfvo( $data_bar->{min_type}, $data_bar->{min_value} ); $self->_write_cfvo( $data_bar->{max_type}, $data_bar->{max_value} ); $self->_write_color( 'rgb' => $data_bar->{bar_color} ); $self->xml_end_tag( 'dataBar' ); } ############################################################################## # # _write_data_bar_ext() # # Write the <extLst> dataBar extension element. # sub _write_data_bar_ext { my $self = shift; my $param = shift; # Create a pseudo GUID for each unique Excel 2010 data bar. my $worksheet_count = $self->{_index} + 1; my $data_bar_count = @{ $self->{_data_bars_2010} } + 1; my $guid = sprintf "{DA7ABA51-AAAA-BBBB-%04X-%012X}", $worksheet_count, $data_bar_count; # Store the 2010 data bar parameters to write the extLst elements. $param->{_guid} = $guid; push @{$self->{_data_bars_2010}}, $param; $self->xml_start_tag( 'extLst' ); $self->_write_ext('{B025F937-C7B1-47D3-B67F-A62EFF666E3E}'); $self->xml_data_element( 'x14:id', $guid); $self->xml_end_tag( 'ext' ); $self->xml_end_tag( 'extLst' ); } ############################################################################## # # _write_cfvo() # # Write the <cfvo> element. # sub _write_cfvo { my $self = shift; my $type = shift; my $value = shift; my $criteria = shift; my @attributes = ( 'type' => $type ); if ( defined $value ) { push @attributes, ( 'val', $value ); } if ( $criteria ) { push @attributes, ( 'gte', 0 ); } $self->xml_empty_tag( 'cfvo', @attributes ); } ############################################################################## # # _write_x14_cfvo() # # Write the <cfvo> element. # sub _write_x14_cfvo { my $self = shift; my $type = shift; my $value = shift; my @attributes = ( 'type' => $type ); if ( $type eq 'min' || $type eq 'max' || $type eq 'autoMin' || $type eq 'autoMax' ) { $self->xml_empty_tag( 'x14:cfvo', @attributes ); } else { $self->xml_start_tag( 'x14:cfvo', @attributes ); $self->xml_data_element( 'xm:f', $value ); $self->xml_end_tag( 'x14:cfvo' ); } } ############################################################################## # # _write_color() # # Write the <color> element. # sub _write_color { my $self = shift; my $name = shift; my $value = shift; my @attributes = ( $name => $value ); $self->xml_empty_tag( 'color', @attributes ); } ############################################################################## # # _write_table_parts() # # Write the <tableParts> element. # sub _write_table_parts { my $self = shift; my @tables = @{ $self->{_tables} }; my $count = scalar @tables; # Return if worksheet doesn't contain any tables. return unless $count; my @attributes = ( 'count' => $count, ); $self->xml_start_tag( 'tableParts', @attributes ); for my $table ( @tables ) { # Write the tablePart element. $self->_write_table_part( ++$self->{_rel_count} ); } $self->xml_end_tag( 'tableParts' ); } ############################################################################## # # _write_table_part() # # Write the <tablePart> element. # sub _write_table_part { my $self = shift; my $id = shift; my $r_id = 'rId' . $id; my @attributes = ( 'r:id' => $r_id, ); $self->xml_empty_tag( 'tablePart', @attributes ); } ############################################################################## # # _write_ext_list() # # Write the <extLst> element for data bars and sparklines. # sub _write_ext_list { my $self = shift; my $has_data_bars = scalar @{ $self->{_data_bars_2010} }; my $has_sparklines = scalar @{ $self->{_sparklines} }; if ( !$has_data_bars and !$has_sparklines ) { return; } # Write the extLst element. $self->xml_start_tag( 'extLst' ); if ( $has_data_bars ) { $self->_write_ext_list_data_bars(); } if ( $has_sparklines ) { $self->_write_ext_list_sparklines(); } $self->xml_end_tag( 'extLst' ); } ############################################################################## # # _write_ext_list_data_bars() # # Write the Excel 2010 data_bar subelements. # sub _write_ext_list_data_bars { my $self = shift; my @data_bars = @{ $self->{_data_bars_2010} }; # Write the ext element. $self->_write_ext('{78C0D931-6437-407d-A8EE-F0AAD7539E65}'); $self->xml_start_tag( 'x14:conditionalFormattings' ); # Write each of the Excel 2010 conditional formatting data bar elements. for my $data_bar (@data_bars) { # Write the x14:conditionalFormatting element. $self->_write_conditional_formatting_2010($data_bar); } $self->xml_end_tag( 'x14:conditionalFormattings' ); $self->xml_end_tag( 'ext' ); } ############################################################################## # # _write_conditional_formatting() # # Write the <x14:conditionalFormatting> element. # sub _write_conditional_formatting_2010 { my $self = shift; my $data_bar = shift; my $xmlns_xm = 'http://schemas.microsoft.com/office/excel/2006/main'; my @attributes = ( 'xmlns:xm' => $xmlns_xm ); $self->xml_start_tag( 'x14:conditionalFormatting', @attributes ); # Write the '<x14:cfRule element. $self->_write_x14_cf_rule( $data_bar ); # Write the x14:dataBar element. $self->_write_x14_data_bar( $data_bar ); # Write the x14 max and min data bars. $self->_write_x14_cfvo( $data_bar->{_x14_min_type}, $data_bar->{min_value} ); $self->_write_x14_cfvo( $data_bar->{_x14_max_type}, $data_bar->{max_value} ); # Write the x14:borderColor element. if ( !$data_bar->{bar_no_border} ) { $self->_write_x14_border_color( $data_bar->{bar_border_color} ); } # Write the x14:negativeFillColor element. if ( !$data_bar->{bar_negative_color_same} ) { $self->_write_x14_negative_fill_color( $data_bar->{bar_negative_color} ); } # Write the x14:negativeBorderColor element. if ( !$data_bar->{bar_no_border} && !$data_bar->{bar_negative_border_color_same} ) { $self->_write_x14_negative_border_color( $data_bar->{bar_negative_border_color} ); } # Write the x14:axisColor element. if ( $data_bar->{bar_axis_position} ne 'none') { $self->_write_x14_axis_color($data_bar->{bar_axis_color}); } # Write closing elements. $self->xml_end_tag( 'x14:dataBar' ); $self->xml_end_tag( 'x14:cfRule' ); # Add the conditional format range. $self->xml_data_element( 'xm:sqref', $data_bar->{_range} ); $self->xml_end_tag( 'x14:conditionalFormatting' ); } ############################################################################## # # _write_x14_cf_rule() # # Write the <'<x14:cfRule> element. # sub _write_x14_cf_rule { my $self = shift; my $data_bar = shift; my $type = 'dataBar'; my $id = $data_bar->{_guid}; my @attributes = ( 'type' => $type, 'id' => $id, ); $self->xml_start_tag( 'x14:cfRule', @attributes ); } ############################################################################## # # _write_x14_data_bar() # # Write the <x14:dataBar> element. # sub _write_x14_data_bar { my $self = shift; my $data_bar = shift; my $min_length = 0; my $max_length = 100; my @attributes = ( 'minLength' => $min_length, 'maxLength' => $max_length, ); if ( !$data_bar->{bar_no_border} ) { push @attributes, ( 'border', 1 ); } if ( $data_bar->{bar_solid} ) { push @attributes, ( 'gradient', 0 ); } if ( $data_bar->{bar_direction} eq 'left' ) { push @attributes, ( 'direction', 'leftToRight' ); } if ( $data_bar->{bar_direction} eq 'right' ) { push @attributes, ( 'direction', 'rightToLeft' ); } if ( $data_bar->{bar_negative_color_same} ) { push @attributes, ( 'negativeBarColorSameAsPositive', 1 ); } if ( !$data_bar->{bar_no_border} && !$data_bar->{bar_negative_border_color_same} ) { push @attributes, ( 'negativeBarBorderColorSameAsPositive', 0 ); } if ( $data_bar->{bar_axis_position} eq 'middle') { push @attributes, ( 'axisPosition', 'middle' ); } if ( $data_bar->{bar_axis_position} eq 'none') { push @attributes, ( 'axisPosition', 'none' ); } $self->xml_start_tag( 'x14:dataBar', @attributes ); } ############################################################################## # # _write_x14_border_color() # # Write the <x14:borderColor> element. # sub _write_x14_border_color { my $self = shift; my $rgb = shift; my @attributes = ( 'rgb' => $rgb ); $self->xml_empty_tag( 'x14:borderColor', @attributes ); } ############################################################################## # # _write_x14_negative_fill_color() # # Write the <x14:negativeFillColor> element. # sub _write_x14_negative_fill_color { my $self = shift; my $rgb = shift; my @attributes = ( 'rgb' => $rgb ); $self->xml_empty_tag( 'x14:negativeFillColor', @attributes ); } ############################################################################## # # _write_x14_negative_border_color() # # Write the <x14:negativeBorderColor> element. # sub _write_x14_negative_border_color { my $self = shift; my $rgb = shift; my @attributes = ( 'rgb' => $rgb ); $self->xml_empty_tag( 'x14:negativeBorderColor', @attributes ); } ############################################################################## # # _write_x14_axis_color() # # Write the <x14:axisColor> element. # sub _write_x14_axis_color { my $self = shift; my $rgb = shift; my @attributes = ( 'rgb' => $rgb ); $self->xml_empty_tag( 'x14:axisColor', @attributes ); } ############################################################################## # # _write_ext_list_sparklines() # # Write the sparkline subelements. # sub _write_ext_list_sparklines { my $self = shift; my @sparklines = @{ $self->{_sparklines} }; my $count = scalar @sparklines; # Write the ext element. $self->_write_ext('{05C60535-1F16-4fd2-B633-F4F36F0B64E0}'); # Write the x14:sparklineGroups element. $self->_write_sparkline_groups(); # Write the sparkline elements. for my $sparkline ( reverse @sparklines ) { # Write the x14:sparklineGroup element. $self->_write_sparkline_group( $sparkline ); # Write the x14:colorSeries element. $self->_write_color_series( $sparkline->{_series_color} ); # Write the x14:colorNegative element. $self->_write_color_negative( $sparkline->{_negative_color} ); # Write the x14:colorAxis element. $self->_write_color_axis(); # Write the x14:colorMarkers element. $self->_write_color_markers( $sparkline->{_markers_color} ); # Write the x14:colorFirst element. $self->_write_color_first( $sparkline->{_first_color} ); # Write the x14:colorLast element. $self->_write_color_last( $sparkline->{_last_color} ); # Write the x14:colorHigh element. $self->_write_color_high( $sparkline->{_high_color} ); # Write the x14:colorLow element. $self->_write_color_low( $sparkline->{_low_color} ); if ( $sparkline->{_date_axis} ) { $self->xml_data_element( 'xm:f', $sparkline->{_date_axis} ); } $self->_write_sparklines( $sparkline ); $self->xml_end_tag( 'x14:sparklineGroup' ); } $self->xml_end_tag( 'x14:sparklineGroups' ); $self->xml_end_tag( 'ext' ); } ############################################################################## # # _write_sparklines() # # Write the <x14:sparklines> element and <x14:sparkline> subelements. # sub _write_sparklines { my $self = shift; my $sparkline = shift; # Write the sparkline elements. $self->xml_start_tag( 'x14:sparklines' ); for my $i ( 0 .. $sparkline->{_count} - 1 ) { my $range = $sparkline->{_ranges}->[$i]; my $location = $sparkline->{_locations}->[$i]; $self->xml_start_tag( 'x14:sparkline' ); $self->xml_data_element( 'xm:f', $range ); $self->xml_data_element( 'xm:sqref', $location ); $self->xml_end_tag( 'x14:sparkline' ); } $self->xml_end_tag( 'x14:sparklines' ); } ############################################################################## # # _write_ext() # # Write the <ext> element for sparklines. # sub _write_ext { my $self = shift; my $uri = shift; my $schema = 'http://schemas.microsoft.com/office/'; my $xmlns_x14 = $schema . 'spreadsheetml/2009/9/main'; my @attributes = ( 'xmlns:x14' => $xmlns_x14, 'uri' => $uri, ); $self->xml_start_tag( 'ext', @attributes ); } ############################################################################## # # _write_sparkline_groups() # # Write the <x14:sparklineGroups> element. # sub _write_sparkline_groups { my $self = shift; my $xmlns_xm = 'http://schemas.microsoft.com/office/excel/2006/main'; my @attributes = ( 'xmlns:xm' => $xmlns_xm ); $self->xml_start_tag( 'x14:sparklineGroups', @attributes ); } ############################################################################## # # _write_sparkline_group() # # Write the <x14:sparklineGroup> element. # # Example for order. # # <x14:sparklineGroup # manualMax="0" # manualMin="0" # lineWeight="2.25" # type="column" # dateAxis="1" # displayEmptyCellsAs="span" # markers="1" # high="1" # low="1" # first="1" # last="1" # negative="1" # displayXAxis="1" # displayHidden="1" # minAxisType="custom" # maxAxisType="custom" # rightToLeft="1"> # sub _write_sparkline_group { my $self = shift; my $opts = shift; my $empty = $opts->{_empty}; my $user_max = 0; my $user_min = 0; my @a; if ( defined $opts->{_max} ) { if ( $opts->{_max} eq 'group' ) { $opts->{_cust_max} = 'group'; } else { push @a, ( 'manualMax' => $opts->{_max} ); $opts->{_cust_max} = 'custom'; } } if ( defined $opts->{_min} ) { if ( $opts->{_min} eq 'group' ) { $opts->{_cust_min} = 'group'; } else { push @a, ( 'manualMin' => $opts->{_min} ); $opts->{_cust_min} = 'custom'; } } # Ignore the default type attribute (line). if ( $opts->{_type} ne 'line' ) { push @a, ( 'type' => $opts->{_type} ); } push @a, ( 'lineWeight' => $opts->{_weight} ) if $opts->{_weight}; push @a, ( 'dateAxis' => 1 ) if $opts->{_date_axis}; push @a, ( 'displayEmptyCellsAs' => $empty ) if $empty; push @a, ( 'markers' => 1 ) if $opts->{_markers}; push @a, ( 'high' => 1 ) if $opts->{_high}; push @a, ( 'low' => 1 ) if $opts->{_low}; push @a, ( 'first' => 1 ) if $opts->{_first}; push @a, ( 'last' => 1 ) if $opts->{_last}; push @a, ( 'negative' => 1 ) if $opts->{_negative}; push @a, ( 'displayXAxis' => 1 ) if $opts->{_axis}; push @a, ( 'displayHidden' => 1 ) if $opts->{_hidden}; push @a, ( 'minAxisType' => $opts->{_cust_min} ) if $opts->{_cust_min}; push @a, ( 'maxAxisType' => $opts->{_cust_max} ) if $opts->{_cust_max}; push @a, ( 'rightToLeft' => 1 ) if $opts->{_reverse}; $self->xml_start_tag( 'x14:sparklineGroup', @a ); } ############################################################################## # # _write_spark_color() # # Helper function for the sparkline color functions below. # sub _write_spark_color { my $self = shift; my $element = shift; my $color = shift; my @attr; push @attr, ( 'rgb' => $color->{_rgb} ) if defined $color->{_rgb}; push @attr, ( 'theme' => $color->{_theme} ) if defined $color->{_theme}; push @attr, ( 'tint' => $color->{_tint} ) if defined $color->{_tint}; $self->xml_empty_tag( $element, @attr ); } ############################################################################## # # _write_color_series() # # Write the <x14:colorSeries> element. # sub _write_color_series { my $self = shift; $self->_write_spark_color( 'x14:colorSeries', @_ ); } ############################################################################## # # _write_color_negative() # # Write the <x14:colorNegative> element. # sub _write_color_negative { my $self = shift; $self->_write_spark_color( 'x14:colorNegative', @_ ); } ############################################################################## # # _write_color_axis() # # Write the <x14:colorAxis> element. # sub _write_color_axis { my $self = shift; $self->_write_spark_color( 'x14:colorAxis', { _rgb => 'FF000000' } ); } ############################################################################## # # _write_color_markers() # # Write the <x14:colorMarkers> element. # sub _write_color_markers { my $self = shift; $self->_write_spark_color( 'x14:colorMarkers', @_ ); } ############################################################################## # # _write_color_first() # # Write the <x14:colorFirst> element. # sub _write_color_first { my $self = shift; $self->_write_spark_color( 'x14:colorFirst', @_ ); } ############################################################################## # # _write_color_last() # # Write the <x14:colorLast> element. # sub _write_color_last { my $self = shift; $self->_write_spark_color( 'x14:colorLast', @_ ); } ############################################################################## # # _write_color_high() # # Write the <x14:colorHigh> element. # sub _write_color_high { my $self = shift; $self->_write_spark_color( 'x14:colorHigh', @_ ); } ############################################################################## # # _write_color_low() # # Write the <x14:colorLow> element. # sub _write_color_low { my $self = shift; $self->_write_spark_color( 'x14:colorLow', @_ ); } 1; __END__ =head1 NAME Worksheet - A class for writing Excel Worksheets. =head1 SYNOPSIS See the documentation for L<Excel::Writer::XLSX> =head1 DESCRIPTION This module is used in conjunction with L<Excel::Writer::XLSX>. =head1 AUTHOR John McNamara jmcnamara@cpan.org =head1 COPYRIGHT (c) MM-MMXX, John McNamara. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
Close