One Hat Cyber Team
Your IP :
172.16.0.254
Server IP :
58.26.163.33
Server :
Windows NT DGPENSV2LPKMN 10.0 build 14393 (Windows Server 2016) AMD64
Server Software :
Apache/2.4.46 (Win64) OpenSSL/1.1.1h PHP/7.3.25
PHP Version :
7.3.25
Buat File
|
Buat Folder
Eksekusi
Dir :
C:
/
xampp7
/
perl
/
vendor
/
lib
/
Excel
/
Writer
/
XLSX
/
View File Name :
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.