File Coverage

blib/lib/Excel/Writer/XLSX/Worksheet.pm
Criterion Covered Total %
statement 3458 3680 93.9
branch 1473 1752 84.0
condition 577 697 82.7
subroutine 226 234 96.5
pod 0 84 0.0
total 5734 6447 88.9


sub elements. element.
line stmt bran cond sub pod time code
1             package Excel::Writer::XLSX::Worksheet;
2              
3             ###############################################################################
4             #
5             # Worksheet - A class for writing Excel Worksheets.
6             #
7             #
8             # Used in conjunction with Excel::Writer::XLSX
9             #
10             # Copyright 2000-2020, John McNamara, jmcnamara@cpan.org
11             #
12             # Documentation after __END__
13             #
14              
15             # perltidy with the following options: -mbl=2 -pt=0 -nola
16              
17 1082     1082   27736 use 5.008002;
  1082         4062  
18 1082     1082   5714 use strict;
  1082         2145  
  1082         20614  
19 1082     1082   4972 use warnings;
  1082         2161  
  1082         31103  
20 1082     1082   5409 use Carp;
  1082         2521  
  1082         69631  
21 1082     1082   7512 use File::Temp 'tempfile';
  1082         20215  
  1082         53312  
22 1082     1082   6672 use List::Util qw(max min);
  1082         2428  
  1082         109961  
23 1082     1082   506134 use Excel::Writer::XLSX::Format;
  1082         2650  
  1082         49307  
24 1082     1082   526390 use Excel::Writer::XLSX::Drawing;
  1082         3188  
  1082         54569  
25 1082     1082   7947 use Excel::Writer::XLSX::Package::XMLwriter;
  1082         2367  
  1082         39038  
26 1082         1661284 use Excel::Writer::XLSX::Utility qw(xl_cell_to_rowcol
27             xl_rowcol_to_cell
28             xl_col_to_name
29             xl_range
30 1082     1082   541349 quote_sheetname);
  1082         2871  
31              
32             our @ISA = qw(Excel::Writer::XLSX::Package::XMLwriter);
33             our $VERSION = '1.07';
34              
35              
36             ###############################################################################
37             #
38             # Public and private API methods.
39             #
40             ###############################################################################
41              
42              
43             ###############################################################################
44             #
45             # new()
46             #
47             # Constructor.
48             #
49             sub new {
50              
51 1373     1373 0 238984 my $class = shift;
52 1373         2885 my $fh = shift;
53 1373         6636 my $self = Excel::Writer::XLSX::Package::XMLwriter->new( $fh );
54 1373         3039 my $rowmax = 1_048_576;
55 1373         2877 my $colmax = 16_384;
56 1373         2522 my $strmax = 32767;
57              
58 1373         4455 $self->{_name} = $_[0];
59 1373         17979 $self->{_index} = $_[1];
60 1373         2978 $self->{_activesheet} = $_[2];
61 1373         3148 $self->{_firstsheet} = $_[3];
62 1373         2809 $self->{_str_total} = $_[4];
63 1373         2802 $self->{_str_unique} = $_[5];
64 1373         4328 $self->{_str_table} = $_[6];
65 1373         2965 $self->{_date_1904} = $_[7];
66 1373         2905 $self->{_palette} = $_[8];
67 1373   100     7018 $self->{_optimization} = $_[9] || 0;
68 1373         3140 $self->{_tempdir} = $_[10];
69 1373         2893 $self->{_excel2003_style} = $_[11];
70 1373         2898 $self->{_default_url_format} = $_[12];
71 1373   100     4959 $self->{_max_url_length} = $_[13] || 2079;
72              
73 1373         4956 $self->{_ext_sheets} = [];
74 1373         3209 $self->{_fileclosed} = 0;
75 1373         3412 $self->{_excel_version} = 2007;
76              
77 1373         3026 $self->{_xls_rowmax} = $rowmax;
78 1373         2991 $self->{_xls_colmax} = $colmax;
79 1373         3059 $self->{_xls_strmax} = $strmax;
80 1373         3033 $self->{_dim_rowmin} = undef;
81 1373         2994 $self->{_dim_rowmax} = undef;
82 1373         3097 $self->{_dim_colmin} = undef;
83 1373         2992 $self->{_dim_colmax} = undef;
84              
85 1373         3290 $self->{_colinfo} = {};
86 1373         3211 $self->{_selections} = [];
87 1373         2962 $self->{_hidden} = 0;
88 1373         3025 $self->{_active} = 0;
89 1373         2906 $self->{_tab_color} = 0;
90              
91 1373         2910 $self->{_panes} = [];
92 1373         5092 $self->{_active_pane} = 3;
93 1373         2888 $self->{_selected} = 0;
94 1373         2719 $self->{_hide_row_col_headers} = 0;
95              
96 1373         2941 $self->{_page_setup_changed} = 0;
97 1373         2829 $self->{_paper_size} = 0;
98 1373         3059 $self->{_orientation} = 1;
99              
100 1373         2858 $self->{_print_options_changed} = 0;
101 1373         2832 $self->{_hcenter} = 0;
102 1373         2818 $self->{_vcenter} = 0;
103 1373         2843 $self->{_print_gridlines} = 0;
104 1373         2877 $self->{_screen_gridlines} = 1;
105 1373         2854 $self->{_print_headers} = 0;
106              
107 1373         2819 $self->{_header_footer_changed} = 0;
108 1373         3094 $self->{_header} = '';
109 1373         2928 $self->{_footer} = '';
110 1373         2872 $self->{_header_footer_aligns} = 1;
111 1373         2896 $self->{_header_footer_scales} = 1;
112 1373         3157 $self->{_header_images} = [];
113 1373         3035 $self->{_footer_images} = [];
114              
115 1373         3005 $self->{_margin_left} = 0.7;
116 1373         2832 $self->{_margin_right} = 0.7;
117 1373         2969 $self->{_margin_top} = 0.75;
118 1373         2948 $self->{_margin_bottom} = 0.75;
119 1373         2928 $self->{_margin_header} = 0.3;
120 1373         3095 $self->{_margin_footer} = 0.3;
121              
122 1373         3034 $self->{_repeat_rows} = '';
123 1373         2989 $self->{_repeat_cols} = '';
124 1373         2960 $self->{_print_area} = '';
125              
126 1373         2797 $self->{_page_order} = 0;
127 1373         2950 $self->{_black_white} = 0;
128 1373         2837 $self->{_draft_quality} = 0;
129 1373         2815 $self->{_print_comments} = 0;
130 1373         7653 $self->{_page_start} = 0;
131              
132 1373         3078 $self->{_fit_page} = 0;
133 1373         2729 $self->{_fit_width} = 0;
134 1373         2698 $self->{_fit_height} = 0;
135              
136 1373         2943 $self->{_hbreaks} = [];
137 1373         3136 $self->{_vbreaks} = [];
138              
139 1373         3065 $self->{_protect} = 0;
140 1373         2921 $self->{_password} = undef;
141              
142 1373         3002 $self->{_set_cols} = {};
143 1373         3135 $self->{_set_rows} = {};
144              
145 1373         3013 $self->{_zoom} = 100;
146 1373         2784 $self->{_zoom_scale_normal} = 1;
147 1373         2815 $self->{_print_scale} = 100;
148 1373         2774 $self->{_right_to_left} = 0;
149 1373         2704 $self->{_show_zeros} = 1;
150 1373         2775 $self->{_leading_zeros} = 0;
151              
152 1373         2780 $self->{_outline_row_level} = 0;
153 1373         2741 $self->{_outline_col_level} = 0;
154 1373         2646 $self->{_outline_style} = 0;
155 1373         2690 $self->{_outline_below} = 1;
156 1373         2690 $self->{_outline_right} = 1;
157 1373         2833 $self->{_outline_on} = 1;
158 1373         3276 $self->{_outline_changed} = 0;
159              
160 1373         2891 $self->{_original_row_height} = 15;
161 1373         2946 $self->{_default_row_height} = 15;
162 1373         2704 $self->{_default_row_pixels} = 20;
163 1373         2852 $self->{_default_col_width} = 8.43;
164 1373         2744 $self->{_default_col_pixels} = 64;
165 1373         2688 $self->{_default_row_zeroed} = 0;
166              
167 1373         2877 $self->{_names} = {};
168              
169 1373         3027 $self->{_write_match} = [];
170              
171              
172 1373         3014 $self->{_table} = {};
173 1373         3047 $self->{_merge} = [];
174              
175 1373         2901 $self->{_has_vml} = 0;
176 1373         2780 $self->{_has_header_vml} = 0;
177 1373         2633 $self->{_has_comments} = 0;
178 1373         2849 $self->{_comments} = {};
179 1373         3576 $self->{_comments_array} = [];
180 1373         3110 $self->{_comments_author} = '';
181 1373         2804 $self->{_comments_visible} = 0;
182 1373         2800 $self->{_vml_shape_id} = 1024;
183 1373         3022 $self->{_buttons_array} = [];
184 1373         3031 $self->{_header_images_array} = [];
185              
186 1373         2959 $self->{_autofilter} = '';
187 1373         2875 $self->{_filter_on} = 0;
188 1373         3008 $self->{_filter_range} = [];
189 1373         3087 $self->{_filter_cols} = {};
190              
191 1373         2991 $self->{_col_sizes} = {};
192 1373         2968 $self->{_row_sizes} = {};
193 1373         3006 $self->{_col_formats} = {};
194 1373         2873 $self->{_col_size_changed} = 0;
195 1373         3139 $self->{_row_size_changed} = 0;
196              
197 1373         2843 $self->{_last_shape_id} = 1;
198 1373         2862 $self->{_rel_count} = 0;
199 1373         2712 $self->{_hlink_count} = 0;
200 1373         2966 $self->{_hlink_refs} = [];
201 1373         3070 $self->{_external_hyper_links} = [];
202 1373         3006 $self->{_external_drawing_links} = [];
203 1373         3048 $self->{_external_comment_links} = [];
204 1373         2992 $self->{_external_vml_links} = [];
205 1373         3013 $self->{_external_table_links} = [];
206 1373         3029 $self->{_drawing_links} = [];
207 1373         3040 $self->{_vml_drawing_links} = [];
208 1373         3093 $self->{_charts} = [];
209 1373         11351 $self->{_images} = [];
210 1373         3883 $self->{_tables} = [];
211 1373         2969 $self->{_sparklines} = [];
212 1373         2922 $self->{_shapes} = [];
213 1373         2899 $self->{_shape_hash} = {};
214 1373         2689 $self->{_has_shapes} = 0;
215 1373         2577 $self->{_drawing} = 0;
216 1373         2821 $self->{_drawing_rels} = {};
217 1373         2634 $self->{_drawing_rels_id} = 0;
218 1373         2788 $self->{_vml_drawing_rels} = {};
219 1373         2923 $self->{_vml_drawing_rels_id} = 0;
220              
221 1373         2798 $self->{_horizontal_dpi} = 0;
222 1373         2839 $self->{_vertical_dpi} = 0;
223              
224 1373         2983 $self->{_rstring} = '';
225 1373         2835 $self->{_previous_row} = 0;
226              
227 1373 100       5242 if ( $self->{_optimization} == 1 ) {
228 10         72 my $fh = tempfile( DIR => $self->{_tempdir} );
229 10         7362 binmode $fh, ':utf8';
230              
231 10         32 $self->{_cell_data_fh} = $fh;
232 10         25 $self->{_fh} = $fh;
233             }
234              
235 1373         3324 $self->{_validations} = [];
236 1373         3212 $self->{_cond_formats} = {};
237 1373         3163 $self->{_data_bars_2010} = [];
238 1373         3068 $self->{_use_data_bars_2010} = 0;
239 1373         2926 $self->{_dxf_priority} = 1;
240              
241 1373 100       4412 if ( $self->{_excel2003_style} ) {
242 8         22 $self->{_original_row_height} = 12.75;
243 8         30 $self->{_default_row_height} = 12.75;
244 8         16 $self->{_default_row_pixels} = 17;
245 8         23 $self->{_margin_left} = 0.75;
246 8         15 $self->{_margin_right} = 0.75;
247 8         22 $self->{_margin_top} = 1;
248 8         16 $self->{_margin_bottom} = 1;
249 8         13 $self->{_margin_header} = 0.5;
250 8         15 $self->{_margin_footer} = 0.5;
251 8         15 $self->{_header_footer_aligns} = 0;
252             }
253              
254 1373         3505 bless $self, $class;
255 1373         5555 return $self;
256             }
257              
258             ###############################################################################
259             #
260             # _set_xml_writer()
261             #
262             # Over-ridden to ensure that write_single_row() is called for the final row
263             # when optimisation mode is on.
264             #
265             sub _set_xml_writer {
266              
267 996     996   13131 my $self = shift;
268 996         2243 my $filename = shift;
269              
270 996 100       4225 if ( $self->{_optimization} == 1 ) {
271 10         54 $self->_write_single_row();
272             }
273              
274 996         8382 $self->SUPER::_set_xml_writer( $filename );
275             }
276              
277              
278             ###############################################################################
279             #
280             # _assemble_xml_file()
281             #
282             # Assemble and write the XML file.
283             #
284             sub _assemble_xml_file {
285              
286 1033     1033   2927 my $self = shift;
287              
288 1033         9828 $self->xml_declaration();
289              
290             # Write the root worksheet element.
291 1033         6594 $self->_write_worksheet();
292              
293             # Write the worksheet properties.
294 1033         4753 $self->_write_sheet_pr();
295              
296             # Write the worksheet dimensions.
297 1033         4590 $self->_write_dimension();
298              
299             # Write the sheet view properties.
300 1033         4477 $self->_write_sheet_views();
301              
302             # Write the sheet format properties.
303 1033         5155 $self->_write_sheet_format_pr();
304              
305             # Write the sheet column info.
306 1033         4420 $self->_write_cols();
307              
308             # Write the worksheet data such as rows columns and cells.
309 1033 100       4250 if ( $self->{_optimization} == 0 ) {
310 1023         4909 $self->_write_sheet_data();
311             }
312             else {
313 10         50 $self->_write_optimized_sheet_data();
314             }
315              
316             # Write the sheetProtection element.
317 1033         5713 $self->_write_sheet_protection();
318              
319             # Write the worksheet calculation properties.
320             #$self->_write_sheet_calc_pr();
321              
322             # Write the worksheet phonetic properties.
323 1033 100       4561 if ($self->{_excel2003_style}) {
324 8         34 $self->_write_phonetic_pr();
325             }
326              
327             # Write the autoFilter element.
328 1033         5658 $self->_write_auto_filter();
329              
330             # Write the mergeCells element.
331 1033         4904 $self->_write_merge_cells();
332              
333             # Write the conditional formats.
334 1033         4849 $self->_write_conditional_formats();
335              
336             # Write the dataValidations element.
337 1033         4959 $self->_write_data_validations();
338              
339             # Write the hyperlink element.
340 1033         5242 $self->_write_hyperlinks();
341              
342             # Write the printOptions element.
343 1033         4802 $self->_write_print_options();
344              
345             # Write the worksheet page_margins.
346 1033         4557 $self->_write_page_margins();
347              
348             # Write the worksheet page setup.
349 1033         4713 $self->_write_page_setup();
350              
351             # Write the headerFooter element.
352 1033         4369 $self->_write_header_footer();
353              
354             # Write the rowBreaks element.
355 1033         4524 $self->_write_row_breaks();
356              
357             # Write the colBreaks element.
358 1033         4645 $self->_write_col_breaks();
359              
360             # Write the drawing element.
361 1033         4923 $self->_write_drawings();
362              
363             # Write the legacyDrawing element.
364 1033         4642 $self->_write_legacy_drawing();
365              
366             # Write the legacyDrawingHF element.
367 1033         4506 $self->_write_legacy_drawing_hf();
368              
369             # Write the tableParts element.
370 1033         5196 $self->_write_table_parts();
371              
372             # Write the extLst elements.
373 1033         4655 $self->_write_ext_list();
374              
375             # Close the worksheet tag.
376 1033         5100 $self->xml_end_tag( 'worksheet' );
377              
378             # Close the XML writer filehandle.
379 1033         8385 $self->xml_get_fh()->close();
380             }
381              
382              
383             ###############################################################################
384             #
385             # _close()
386             #
387             # Write the worksheet elements.
388             #
389             sub _close {
390              
391             # TODO. Unused. Remove after refactoring.
392 0     0   0 my $self = shift;
393 0         0 my $sheetnames = shift;
394 0         0 my $num_sheets = scalar @$sheetnames;
395             }
396              
397              
398             ###############################################################################
399             #
400             # get_name().
401             #
402             # Retrieve the worksheet name.
403             #
404             sub get_name {
405              
406 996     996 0 2355 my $self = shift;
407              
408 996         4692 return $self->{_name};
409             }
410              
411              
412             ###############################################################################
413             #
414             # select()
415             #
416             # Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
417             # highlighted.
418             #
419             sub select {
420              
421 118     118 0 1823 my $self = shift;
422              
423 118         464 $self->{_hidden} = 0; # Selected worksheet can't be hidden.
424 118         279 $self->{_selected} = 1;
425             }
426              
427              
428             ###############################################################################
429             #
430             # activate()
431             #
432             # Set this worksheet as the active worksheet, i.e. the worksheet that is
433             # displayed when the workbook is opened. Also set it as selected.
434             #
435             sub activate {
436              
437 8     8 0 65 my $self = shift;
438              
439 8         22 $self->{_hidden} = 0; # Active worksheet can't be hidden.
440 8         16 $self->{_selected} = 1;
441 8         14 ${ $self->{_activesheet} } = $self->{_index};
  8         48  
442             }
443              
444              
445             ###############################################################################
446             #
447             # hide()
448             #
449             # Hide this worksheet.
450             #
451             sub hide {
452              
453 2     2 0 15 my $self = shift;
454              
455 2         5 $self->{_hidden} = 1;
456              
457             # A hidden worksheet shouldn't be active or selected.
458 2         4 $self->{_selected} = 0;
459 2         4 ${ $self->{_activesheet} } = 0;
  2         4  
460 2         4 ${ $self->{_firstsheet} } = 0;
  2         5  
461             }
462              
463              
464             ###############################################################################
465             #
466             # set_first_sheet()
467             #
468             # Set this worksheet as the first visible sheet. This is necessary
469             # when there are a large number of worksheets and the activated
470             # worksheet is not visible on the screen.
471             #
472             sub set_first_sheet {
473              
474 1     1 0 7 my $self = shift;
475              
476 1         2 $self->{_hidden} = 0; # Active worksheet can't be hidden.
477 1         3 ${ $self->{_firstsheet} } = $self->{_index};
  1         2  
478             }
479              
480              
481             ###############################################################################
482             #
483             # protect( $password )
484             #
485             # Set the worksheet protection flags to prevent modification of worksheet
486             # objects.
487             #
488             sub protect {
489              
490 27     27 0 428 my $self = shift;
491 27   100     101 my $password = shift || '';
492 27   100     61 my $options = shift || {};
493              
494 27 100       59 if ( $password ne '' ) {
495 6         20 $password = $self->_encode_password( $password );
496             }
497              
498             # Default values for objects that can be protected.
499 27         281 my %defaults = (
500             sheet => 1,
501             content => 0,
502             objects => 0,
503             scenarios => 0,
504             format_cells => 0,
505             format_columns => 0,
506             format_rows => 0,
507             insert_columns => 0,
508             insert_rows => 0,
509             insert_hyperlinks => 0,
510             delete_columns => 0,
511             delete_rows => 0,
512             select_locked_cells => 1,
513             sort => 0,
514             autofilter => 0,
515             pivot_tables => 0,
516             select_unlocked_cells => 1,
517             );
518              
519              
520             # Overwrite the defaults with user specified values.
521 27         39 for my $key ( keys %{$options} ) {
  27         81  
522              
523 60 50       94 if ( exists $defaults{$key} ) {
524 60         91 $defaults{$key} = $options->{$key};
525             }
526             else {
527 0         0 carp "Unknown protection object: $key\n";
528             }
529             }
530              
531             # Set the password after the user defined values.
532 27         60 $defaults{password} = $password;
533              
534 27         92 $self->{_protect} = \%defaults;
535             }
536              
537              
538             ###############################################################################
539             #
540             # _encode_password($password)
541             #
542             # Based on the algorithm provided by Daniel Rentz of OpenOffice.
543             #
544             sub _encode_password {
545              
546 1082     1082   9938 use integer;
  1082         2593  
  1082         8801  
547              
548 6     6   10 my $self = shift;
549 6         11 my $plaintext = $_[0];
550 6         16 my $password;
551             my $count;
552 6         0 my @chars;
553 6         9 my $i = 0;
554              
555 6         28 $count = @chars = split //, $plaintext;
556              
557 6         14 foreach my $char ( @chars ) {
558 48         57 my $low_15;
559             my $high_15;
560 48         63 $char = ord( $char ) << ++$i;
561 48         54 $low_15 = $char & 0x7fff;
562 48         59 $high_15 = $char & 0x7fff << 15;
563 48         54 $high_15 = $high_15 >> 15;
564 48         79 $char = $low_15 | $high_15;
565             }
566              
567 6         10 $password = 0x0000;
568 6         20 $password ^= $_ for @chars;
569 6         12 $password ^= $count;
570 6         9 $password ^= 0xCE4B;
571              
572 6         32 return sprintf "%X", $password;
573             }
574              
575              
576             ###############################################################################
577             #
578             # set_column($firstcol, $lastcol, $width, $format, $hidden, $level)
579             #
580             # Set the width of a single column or a range of columns.
581             # See also: _write_col_info
582             #
583             sub set_column {
584              
585 200     200 0 2675 my $self = shift;
586 200         570 my @data = @_;
587 200         355 my $cell = $data[0];
588              
589             # Check for a cell reference in A1 notation and substitute row and column
590 200 100       937 if ( $cell =~ /^\D/ ) {
591 188         758 @data = $self->_substitute_cellref( @_ );
592              
593             # Returned values $row1 and $row2 aren't required here. Remove them.
594 188         375 shift @data; # $row1
595 188         450 splice @data, 1, 1; # $row2
596             }
597              
598 200 50       630 return if @data < 3; # Ensure at least $firstcol, $lastcol and $width
599 200 50       581 return if not defined $data[0]; # Columns must be defined.
600 200 50       573 return if not defined $data[1];
601              
602             # Assume second column is the same as first if 0. Avoids KB918419 bug.
603 200 100       552 $data[1] = $data[0] if $data[1] == 0;
604              
605             # Ensure 2nd col is larger than first. Also for KB918419 bug.
606 200 100       566 ( $data[0], $data[1] ) = ( $data[1], $data[0] ) if $data[0] > $data[1];
607              
608              
609             # Check that cols are valid and store max and min values with default row.
610             # NOTE: The check shouldn't modify the row dimensions and should only modify
611             # the column dimensions in certain cases.
612 200         372 my $ignore_row = 1;
613 200         348 my $ignore_col = 1;
614 200 100       614 $ignore_col = 0 if ref $data[3]; # Column has a format.
615 200 100 100     1045 $ignore_col = 0 if $data[2] && $data[4]; # Column has a width but is hidden
616              
617 200 50       851 return -2
618             if $self->_check_dimensions( 0, $data[0], $ignore_row, $ignore_col );
619 200 100       590 return -2
620             if $self->_check_dimensions( 0, $data[1], $ignore_row, $ignore_col );
621              
622             # Set the limits for the outline levels (0 <= x <= 7).
623 198 100       775 $data[5] = 0 unless defined $data[5];
624 198 50       578 $data[5] = 0 if $data[5] < 0;
625 198 50       985 $data[5] = 7 if $data[5] > 7;
626              
627 198 100       818 if ( $data[5] > $self->{_outline_col_level} ) {
628 1         3 $self->{_outline_col_level} = $data[5];
629             }
630              
631             # Store the column data based on the first column. Padded for sorting.
632 198         1483 $self->{_colinfo}->{ sprintf "%05d", $data[0] } = [@data];
633              
634             # Store the column change to allow optimisations.
635 198         1025 $self->{_col_size_changed} = 1;
636              
637             # Store the col sizes for use when calculating image vertices taking
638             # hidden columns into account. Also store the column formats.
639 198         653 my $width = $data[2];
640 198         456 my $format = $data[3];
641 198   100     899 my $hidden = $data[4] || 0;
642              
643 198 100       574 $width = $self->{_default_col_width} if !defined $width;
644              
645 198         456 my ( $firstcol, $lastcol ) = @data;
646              
647 198         556 foreach my $col ( $firstcol .. $lastcol ) {
648 379         1014 $self->{_col_sizes}->{$col} = [$width, $hidden];
649 379 100       1398 $self->{_col_formats}->{$col} = $format if $format;
650             }
651             }
652              
653              
654             ###############################################################################
655             #
656             # set_selection()
657             #
658             # Set which cell or cells are selected in a worksheet.
659             #
660             sub set_selection {
661              
662 36     36 0 167 my $self = shift;
663 36         100 my $pane;
664             my $active_cell;
665 36         0 my $sqref;
666              
667 36 50       103 return unless @_;
668              
669             # Check for a cell reference in A1 notation and substitute row and column.
670 36 100       175 if ( $_[0] =~ /^\D/ ) {
671 33         118 @_ = $self->_substitute_cellref( @_ );
672             }
673              
674              
675             # There should be either 2 or 4 arguments.
676 36 100       112 if ( @_ == 2 ) {
    50          
677              
678             # Single cell selection.
679 28         121 $active_cell = xl_rowcol_to_cell( $_[0], $_[1] );
680 28         76 $sqref = $active_cell;
681             }
682             elsif ( @_ == 4 ) {
683              
684             # Range selection.
685 8         31 $active_cell = xl_rowcol_to_cell( $_[0], $_[1] );
686              
687 8         24 my ( $row_first, $col_first, $row_last, $col_last ) = @_;
688              
689             # Swap last row/col for first row/col as necessary
690 8 100       25 if ( $row_first > $row_last ) {
691 3         9 ( $row_first, $row_last ) = ( $row_last, $row_first );
692             }
693              
694 8 100       22 if ( $col_first > $col_last ) {
695 3         7 ( $col_first, $col_last ) = ( $col_last, $col_first );
696             }
697              
698             # If the first and last cell are the same write a single cell.
699 8 100 66     29 if ( ( $row_first == $row_last ) && ( $col_first == $col_last ) ) {
700 1         4 $sqref = $active_cell;
701             }
702             else {
703 7         23 $sqref = xl_range( $row_first, $row_last, $col_first, $col_last );
704             }
705              
706             }
707             else {
708              
709             # User supplied wrong number or arguments.
710 0         0 return;
711             }
712              
713             # Selection isn't set for cell A1.
714 36 100       115 return if $sqref eq 'A1';
715              
716 32         483 $self->{_selections} = [ [ $pane, $active_cell, $sqref ] ];
717             }
718              
719              
720             ###############################################################################
721             #
722             # freeze_panes( $row, $col, $top_row, $left_col )
723             #
724             # Set panes and mark them as frozen.
725             #
726             sub freeze_panes {
727              
728 66     66 0 357 my $self = shift;
729              
730 66 50       191 return unless @_;
731              
732             # Check for a cell reference in A1 notation and substitute row and column.
733 66 100       244 if ( $_[0] =~ /^\D/ ) {
734 10         30 @_ = $self->_substitute_cellref( @_ );
735             }
736              
737 66         114 my $row = shift;
738 66   100     185 my $col = shift || 0;
739 66   100     185 my $top_row = shift || $row;
740 66   100     161 my $left_col = shift || $col;
741 66   100     161 my $type = shift || 0;
742              
743 66         268 $self->{_panes} = [ $row, $col, $top_row, $left_col, $type ];
744             }
745              
746              
747             ###############################################################################
748             #
749             # split_panes( $y, $x, $top_row, $left_col )
750             #
751             # Set panes and mark them as split.
752             #
753             # Implementers note. The API for this method doesn't map well from the XLS
754             # file format and isn't sufficient to describe all cases of split panes.
755             # It should probably be something like:
756             #
757             # split_panes( $y, $x, $top_row, $left_col, $offset_row, $offset_col )
758             #
759             # I'll look at changing this if it becomes an issue.
760             #
761             sub split_panes {
762              
763 38     38 0 272 my $self = shift;
764              
765             # Call freeze panes but add the type flag for split panes.
766 38         112 $self->freeze_panes( @_[ 0 .. 3 ], 2 );
767             }
768              
769             # Older method name for backwards compatibility.
770             *thaw_panes = *split_panes;
771              
772              
773             ###############################################################################
774             #
775             # set_portrait()
776             #
777             # Set the page orientation as portrait.
778             #
779             sub set_portrait {
780              
781 2     2 0 24 my $self = shift;
782              
783 2         4 $self->{_orientation} = 1;
784 2         4 $self->{_page_setup_changed} = 1;
785             }
786              
787              
788             ###############################################################################
789             #
790             # set_landscape()
791             #
792             # Set the page orientation as landscape.
793             #
794             sub set_landscape {
795              
796 2     2 0 32 my $self = shift;
797              
798 2         4 $self->{_orientation} = 0;
799 2         5 $self->{_page_setup_changed} = 1;
800             }
801              
802              
803             ###############################################################################
804             #
805             # set_page_view()
806             #
807             # Set the page view mode for Mac Excel.
808             #
809             sub set_page_view {
810              
811 2     2 0 11 my $self = shift;
812              
813 2 50       14 $self->{_page_view} = defined $_[0] ? $_[0] : 1;
814             }
815              
816              
817             ###############################################################################
818             #
819             # set_tab_color()
820             #
821             # Set the colour of the worksheet tab.
822             #
823             sub set_tab_color {
824              
825 4     4 0 79 my $self = shift;
826 4         20 my $color = &Excel::Writer::XLSX::Format::_get_color( $_[0] );
827              
828 4         14 $self->{_tab_color} = $color;
829             }
830              
831              
832             ###############################################################################
833             #
834             # set_paper()
835             #
836             # Set the paper type. Ex. 1 = US Letter, 9 = A4
837             #
838             sub set_paper {
839              
840 19     19 0 133 my $self = shift;
841 19         39 my $paper_size = shift;
842              
843 19 50       67 if ( $paper_size ) {
844 19         54 $self->{_paper_size} = $paper_size;
845 19         54 $self->{_page_setup_changed} = 1;
846             }
847             }
848              
849              
850             ###############################################################################
851             #
852             # set_header()
853             #
854             # Set the page header caption and optional margin.
855             #
856             sub set_header {
857              
858 31     31 0 312 my $self = shift;
859 31   100     113 my $string = $_[0] || '';
860 31   100     153 my $margin = $_[1] || 0.3;
861 31   100     222 my $options = $_[2] || {};
862              
863              
864             # Replace the Excel placeholder &[Picture] with the internal &G.
865 31         159 $string =~ s/&\[Picture\]/&G/g;
866              
867 31 50       121 if ( length $string >= 255 ) {
868 0         0 carp 'Header string must be less than 255 characters';
869 0         0 return;
870             }
871              
872 31 100       113 if ( defined $options->{align_with_margins} ) {
873 1         7 $self->{_header_footer_aligns} = $options->{align_with_margins};
874             }
875              
876 31 100       104 if ( defined $options->{scale_with_doc} ) {
877 1         6 $self->{_header_footer_scales} = $options->{scale_with_doc};
878             }
879              
880             # Reset the array in case the function is called more than once.
881 31         152 $self->{_header_images} = [];
882              
883 31 100       99 if ( $options->{image_left} ) {
884 21         46 push @{ $self->{_header_images} }, [ $options->{image_left}, 'LH' ];
  21         98  
885             }
886              
887 31 100       94 if ( $options->{image_center} ) {
888 6         11 push @{ $self->{_header_images} }, [ $options->{image_center}, 'CH' ];
  6         26  
889             }
890              
891 31 100       128 if ( $options->{image_right} ) {
892 5         10 push @{ $self->{_header_images} }, [ $options->{image_right}, 'RH' ];
  5         29  
893             }
894              
895 31         142 my $placeholder_count = () = $string =~ /&G/g;
896 31         59 my $image_count = @{ $self->{_header_images} };
  31         75  
897              
898 31 50       137 if ( $image_count != $placeholder_count ) {
899 0         0 warn "Number of header images ($image_count) doesn't match placeholder "
900             . "count ($placeholder_count) in string: $string\n";
901 0         0 $self->{_header_images} = [];
902 0         0 return;
903             }
904              
905 31 100       93 if ( $image_count ) {
906 21         50 $self->{_has_header_vml} = 1;
907             }
908              
909 31         62 $self->{_header} = $string;
910 31         66 $self->{_margin_header} = $margin;
911 31         90 $self->{_header_footer_changed} = 1;
912             }
913              
914              
915             ###############################################################################
916             #
917             # set_footer()
918             #
919             # Set the page footer caption and optional margin.
920             #
921             sub set_footer {
922              
923 15     15 0 200 my $self = shift;
924 15   100     81 my $string = $_[0] || '';
925 15   100     76 my $margin = $_[1] || 0.3;
926 15   100     63 my $options = $_[2] || {};
927              
928              
929             # Replace the Excel placeholder &[Picture] with the internal &G.
930 15         43 $string =~ s/&\[Picture\]/&G/g;
931              
932 15 50       49 if ( length $string >= 255 ) {
933 0         0 carp 'Footer string must be less than 255 characters';
934 0         0 return;
935             }
936              
937 15 100       50 if ( defined $options->{align_with_margins} ) {
938 1         7 $self->{_header_footer_aligns} = $options->{align_with_margins};
939             }
940              
941 15 100       61 if ( defined $options->{scale_with_doc} ) {
942 1         4 $self->{_header_footer_scales} = $options->{scale_with_doc};
943             }
944              
945             # Reset the array in case the function is called more than once.
946 15         45 $self->{_footer_images} = [];
947              
948 15 100       53 if ( $options->{image_left} ) {
949 4         7 push @{ $self->{_footer_images} }, [ $options->{image_left}, 'LF' ];
  4         14  
950             }
951              
952 15 100       44 if ( $options->{image_center} ) {
953 3         17 push @{ $self->{_footer_images} }, [ $options->{image_center}, 'CF' ];
  3         86  
954             }
955              
956 15 100       44 if ( $options->{image_right} ) {
957 5         9 push @{ $self->{_footer_images} }, [ $options->{image_right}, 'RF' ];
  5         16  
958             }
959              
960 15         55 my $placeholder_count = () = $string =~ /&G/g;
961 15         35 my $image_count = @{ $self->{_footer_images} };
  15         99  
962              
963 15 50       50 if ( $image_count != $placeholder_count ) {
964 0         0 warn "Number of footer images ($image_count) doesn't match placeholder "
965             . "count ($placeholder_count) in string: $string\n";
966 0         0 $self->{_footer_images} = [];
967 0         0 return;
968             }
969              
970 15 100       65 if ( $image_count ) {
971 6         15 $self->{_has_header_vml} = 1;
972             }
973              
974 15         31 $self->{_footer} = $string;
975 15         29 $self->{_margin_footer} = $margin;
976 15         44 $self->{_header_footer_changed} = 1;
977             }
978              
979              
980             ###############################################################################
981             #
982             # center_horizontally()
983             #
984             # Center the page horizontally.
985             #
986             sub center_horizontally {
987              
988 4     4 0 63 my $self = shift;
989              
990 4         12 $self->{_print_options_changed} = 1;
991 4         10 $self->{_hcenter} = 1;
992             }
993              
994              
995             ###############################################################################
996             #
997             # center_vertically()
998             #
999             # Center the page horizontally.
1000             #
1001             sub center_vertically {
1002              
1003 4     4 0 34 my $self = shift;
1004              
1005 4         12 $self->{_print_options_changed} = 1;
1006 4         8 $self->{_vcenter} = 1;
1007             }
1008              
1009              
1010             ###############################################################################
1011             #
1012             # set_margins()
1013             #
1014             # Set all the page margins to the same value in inches.
1015             #
1016             sub set_margins {
1017              
1018 2     2 0 44 my $self = shift;
1019              
1020 2         11 $self->set_margin_left( $_[0] );
1021 2         6 $self->set_margin_right( $_[0] );
1022 2         7 $self->set_margin_top( $_[0] );
1023 2         6 $self->set_margin_bottom( $_[0] );
1024             }
1025              
1026              
1027             ###############################################################################
1028             #
1029             # set_margins_LR()
1030             #
1031             # Set the left and right margins to the same value in inches.
1032             #
1033             sub set_margins_LR {
1034              
1035 1     1 0 19 my $self = shift;
1036              
1037 1         4 $self->set_margin_left( $_[0] );
1038 1         3 $self->set_margin_right( $_[0] );
1039             }
1040              
1041              
1042             ###############################################################################
1043             #
1044             # set_margins_TB()
1045             #
1046             # Set the top and bottom margins to the same value in inches.
1047             #
1048             sub set_margins_TB {
1049              
1050 1     1 0 19 my $self = shift;
1051              
1052 1         3 $self->set_margin_top( $_[0] );
1053 1         3 $self->set_margin_bottom( $_[0] );
1054             }
1055              
1056              
1057             ###############################################################################
1058             #
1059             # set_margin_left()
1060             #
1061             # Set the left margin in inches.
1062             #
1063             sub set_margin_left {
1064              
1065 5     5 0 29 my $self = shift;
1066 5         8 my $margin = shift;
1067 5         8 my $default = 0.7;
1068              
1069             # Add 0 to ensure the argument is numeric.
1070 5 50       13 if ( defined $margin ) { $margin = 0 + $margin }
  5         24  
1071 0         0 else { $margin = $default }
1072              
1073 5         14 $self->{_margin_left} = $margin;
1074             }
1075              
1076              
1077             ###############################################################################
1078             #
1079             # set_margin_right()
1080             #
1081             # Set the right margin in inches.
1082             #
1083             sub set_margin_right {
1084              
1085 5     5 0 27 my $self = shift;
1086 5         8 my $margin = shift;
1087 5         6 my $default = 0.7;
1088              
1089             # Add 0 to ensure the argument is numeric.
1090 5 50       12 if ( defined $margin ) { $margin = 0 + $margin }
  5         10  
1091 0         0 else { $margin = $default }
1092              
1093 5         9 $self->{_margin_right} = $margin;
1094             }
1095              
1096              
1097             ###############################################################################
1098             #
1099             # set_margin_top()
1100             #
1101             # Set the top margin in inches.
1102             #
1103             sub set_margin_top {
1104              
1105 5     5 0 29 my $self = shift;
1106 5         10 my $margin = shift;
1107 5         6 my $default = 0.75;
1108              
1109             # Add 0 to ensure the argument is numeric.
1110 5 50       11 if ( defined $margin ) { $margin = 0 + $margin }
  5         10  
1111 0         0 else { $margin = $default }
1112              
1113 5         12 $self->{_margin_top} = $margin;
1114             }
1115              
1116              
1117             ###############################################################################
1118             #
1119             # set_margin_bottom()
1120             #
1121             # Set the bottom margin in inches.
1122             #
1123             sub set_margin_bottom {
1124              
1125              
1126 5     5 0 60 my $self = shift;
1127 5         10 my $margin = shift;
1128 5         7 my $default = 0.75;
1129              
1130             # Add 0 to ensure the argument is numeric.
1131 5 50       12 if ( defined $margin ) { $margin = 0 + $margin }
  5         10  
1132 0         0 else { $margin = $default }
1133              
1134 5         19 $self->{_margin_bottom} = $margin;
1135             }
1136              
1137              
1138             ###############################################################################
1139             #
1140             # repeat_rows($first_row, $last_row)
1141             #
1142             # Set the rows to repeat at the top of each printed page.
1143             #
1144             sub repeat_rows {
1145              
1146 6     6 0 33 my $self = shift;
1147              
1148 6         12 my $row_min = $_[0];
1149 6   66     31 my $row_max = $_[1] || $_[0]; # Second row is optional
1150              
1151              
1152             # Convert to 1 based.
1153 6         11 $row_min++;
1154 6         10 $row_max++;
1155              
1156 6         20 my $area = '$' . $row_min . ':' . '$' . $row_max;
1157              
1158             # Build up the print titles "Sheet1!$1:$2"
1159 6         39 my $sheetname = quote_sheetname( $self->{_name} );
1160 6         18 $area = $sheetname . "!" . $area;
1161              
1162 6         23 $self->{_repeat_rows} = $area;
1163             }
1164              
1165              
1166             ###############################################################################
1167             #
1168             # repeat_columns($first_col, $last_col)
1169             #
1170             # Set the columns to repeat at the left hand side of each printed page. This is
1171             # stored as a element.
1172             #
1173             sub repeat_columns {
1174              
1175 3     3 0 18 my $self = shift;
1176              
1177             # Check for a cell reference in A1 notation and substitute row and column
1178 3 50       18 if ( $_[0] =~ /^\D/ ) {
1179 3         15 @_ = $self->_substitute_cellref( @_ );
1180              
1181             # Returned values $row1 and $row2 aren't required here. Remove them.
1182 3         23 shift @_; # $row1
1183 3         10 splice @_, 1, 1; # $row2
1184             }
1185              
1186 3         7 my $col_min = $_[0];
1187 3   66     16 my $col_max = $_[1] || $_[0]; # Second col is optional
1188              
1189             # Convert to A notation.
1190 3         15 $col_min = xl_col_to_name( $_[0], 1 );
1191 3         11 $col_max = xl_col_to_name( $_[1], 1 );
1192              
1193 3         9 my $area = $col_min . ':' . $col_max;
1194              
1195             # Build up the print area range "=Sheet2!C1:C2"
1196 3         14 my $sheetname = quote_sheetname( $self->{_name} );
1197 3         20 $area = $sheetname . "!" . $area;
1198              
1199 3         11 $self->{_repeat_cols} = $area;
1200             }
1201              
1202              
1203             ###############################################################################
1204             #
1205             # print_area($first_row, $first_col, $last_row, $last_col)
1206             #
1207             # Set the print area in the current worksheet. This is stored as a
1208             # element.
1209             #
1210             sub print_area {
1211              
1212 9     9 0 65 my $self = shift;
1213              
1214             # Check for a cell reference in A1 notation and substitute row and column
1215 9 50       65 if ( $_[0] =~ /^\D/ ) {
1216 9         54 @_ = $self->_substitute_cellref( @_ );
1217             }
1218              
1219 9 50       49 return if @_ != 4; # Require 4 parameters
1220              
1221 9         34 my ( $row1, $col1, $row2, $col2 ) = @_;
1222              
1223             # Ignore max print area since this is the same as no print area for Excel.
1224 9 100 33     162 if ( $row1 == 0
      66        
      100        
1225             and $col1 == 0
1226             and $row2 == $self->{_xls_rowmax} - 1
1227             and $col2 == $self->{_xls_colmax} - 1 )
1228             {
1229 1         3 return;
1230             }
1231              
1232             # Build up the print area range "=Sheet2!R1C1:R2C1"
1233 8         47 my $area = $self->_convert_name_area( $row1, $col1, $row2, $col2 );
1234              
1235 8         30 $self->{_print_area} = $area;
1236             }
1237              
1238              
1239             ###############################################################################
1240             #
1241             # autofilter($first_row, $first_col, $last_row, $last_col)
1242             #
1243             # Set the autofilter area in the worksheet.
1244             #
1245             sub autofilter {
1246              
1247 32     32 0 637 my $self = shift;
1248              
1249             # Check for a cell reference in A1 notation and substitute row and column
1250 32 100       145 if ( $_[0] =~ /^\D/ ) {
1251 30         99 @_ = $self->_substitute_cellref( @_ );
1252             }
1253              
1254 32 50       86 return if @_ != 4; # Require 4 parameters
1255              
1256 32         69 my ( $row1, $col1, $row2, $col2 ) = @_;
1257              
1258             # Reverse max and min values if necessary.
1259 32 50       88 ( $row1, $row2 ) = ( $row2, $row1 ) if $row2 < $row1;
1260 32 50       65 ( $col1, $col2 ) = ( $col2, $col1 ) if $col2 < $col1;
1261              
1262             # Build up the print area range "Sheet1!$A$1:$C$13".
1263 32         98 my $area = $self->_convert_name_area( $row1, $col1, $row2, $col2 );
1264 32         84 my $ref = xl_range( $row1, $row2, $col1, $col2 );
1265              
1266 32         75 $self->{_autofilter} = $area;
1267 32         54 $self->{_autofilter_ref} = $ref;
1268 32         106 $self->{_filter_range} = [ $col1, $col2 ];
1269             }
1270              
1271              
1272             ###############################################################################
1273             #
1274             # filter_column($column, $criteria, ...)
1275             #
1276             # Set the column filter criteria.
1277             #
1278             sub filter_column {
1279              
1280 25     25 0 104 my $self = shift;
1281 25         45 my $col = $_[0];
1282 25         43 my $expression = $_[1];
1283              
1284             croak "Must call autofilter() before filter_column()"
1285 25 50       58 unless $self->{_autofilter};
1286 25 50       68 croak "Incorrect number of arguments to filter_column()"
1287             unless @_ == 2;
1288              
1289              
1290             # Check for a column reference in A1 notation and substitute.
1291 25 100       81 if ( $col =~ /^\D/ ) {
1292 24         39 my $col_letter = $col;
1293              
1294             # Convert col ref to a cell ref and then to a col number.
1295 24         66 ( undef, $col ) = $self->_substitute_cellref( $col . '1' );
1296              
1297 24 50       85 croak "Invalid column '$col_letter'" if $col >= $self->{_xls_colmax};
1298             }
1299              
1300 25         38 my ( $col_first, $col_last ) = @{ $self->{_filter_range} };
  25         51  
1301              
1302             # Reject column if it is outside filter range.
1303 25 50 33     126 if ( $col < $col_first or $col > $col_last ) {
1304 0         0 croak "Column '$col' outside autofilter() column range "
1305             . "($col_first .. $col_last)";
1306             }
1307              
1308              
1309 25         77 my @tokens = $self->_extract_filter_tokens( $expression );
1310              
1311 25 50 66     80 croak "Incorrect number of tokens in expression '$expression'"
1312             unless ( @tokens == 3 or @tokens == 7 );
1313              
1314              
1315 25         71 @tokens = $self->_parse_filter_expression( $expression, @tokens );
1316              
1317             # Excel handles single or double custom filters as default filters. We need
1318             # to check for them and handle them accordingly.
1319 25 100 100     145 if ( @tokens == 2 && $tokens[0] == 2 ) {
    100 100        
      100        
      66        
1320              
1321             # Single equality.
1322 6         28 $self->filter_column_list( $col, $tokens[1] );
1323             }
1324             elsif (@tokens == 5
1325             && $tokens[0] == 2
1326             && $tokens[2] == 1
1327             && $tokens[3] == 2 )
1328             {
1329              
1330             # Double equality with "or" operator.
1331 3         13 $self->filter_column_list( $col, $tokens[1], $tokens[4] );
1332             }
1333             else {
1334              
1335             # Non default custom filter.
1336 16         43 $self->{_filter_cols}->{$col} = [@tokens];
1337 16         36 $self->{_filter_type}->{$col} = 0;
1338              
1339             }
1340              
1341 25         75 $self->{_filter_on} = 1;
1342             }
1343              
1344              
1345             ###############################################################################
1346             #
1347             # filter_column_list($column, @matches )
1348             #
1349             # Set the column filter criteria in Excel 2007 list style.
1350             #
1351             sub filter_column_list {
1352              
1353 14     14 0 49 my $self = shift;
1354 14         37 my $col = shift;
1355 14         46 my @tokens = @_;
1356              
1357             croak "Must call autofilter() before filter_column_list()"
1358 14 50       45 unless $self->{_autofilter};
1359 14 50       40 croak "Incorrect number of arguments to filter_column_list()"
1360             unless @tokens;
1361              
1362             # Check for a column reference in A1 notation and substitute.
1363 14 100       65 if ( $col =~ /^\D/ ) {
1364 5         21 my $col_letter = $col;
1365              
1366             # Convert col ref to a cell ref and then to a col number.
1367 5         19 ( undef, $col ) = $self->_substitute_cellref( $col . '1' );
1368              
1369 5 50       19 croak "Invalid column '$col_letter'" if $col >= $self->{_xls_colmax};
1370             }
1371              
1372 14         25 my ( $col_first, $col_last ) = @{ $self->{_filter_range} };
  14         43  
1373              
1374             # Reject column if it is outside filter range.
1375 14 50 33     84 if ( $col < $col_first or $col > $col_last ) {
1376 0         0 croak "Column '$col' outside autofilter() column range "
1377             . "($col_first .. $col_last)";
1378             }
1379              
1380 14         46 $self->{_filter_cols}->{$col} = [@tokens];
1381 14         38 $self->{_filter_type}->{$col} = 1; # Default style.
1382 14         36 $self->{_filter_on} = 1;
1383             }
1384              
1385              
1386             ###############################################################################
1387             #
1388             # _extract_filter_tokens($expression)
1389             #
1390             # Extract the tokens from the filter expression. The tokens are mainly non-
1391             # whitespace groups. The only tricky part is to extract string tokens that
1392             # contain whitespace and/or quoted double quotes (Excel's escaped quotes).
1393             #
1394             # Examples: 'x < 2000'
1395             # 'x > 2000 and x < 5000'
1396             # 'x = "foo"'
1397             # 'x = "foo bar"'
1398             # 'x = "foo "" bar"'
1399             #
1400             sub _extract_filter_tokens {
1401              
1402 67     67   20769 my $self = shift;
1403 67         105 my $expression = $_[0];
1404              
1405 67 100       136 return unless $expression;
1406              
1407 65         422 my @tokens = ( $expression =~ /"(?:[^"]|"")*"|\S+/g ); #"
1408              
1409             # Remove leading and trailing quotes and unescape other quotes
1410 65         139 for ( @tokens ) {
1411 247         319 s/^"//; #"
1412 247         306 s/"$//; #"
1413 247         327 s/""/"/g; #"
1414             }
1415              
1416 65         225 return @tokens;
1417             }
1418              
1419              
1420             ###############################################################################
1421             #
1422             # _parse_filter_expression(@token)
1423             #
1424             # Converts the tokens of a possibly conditional expression into 1 or 2
1425             # sub expressions for further parsing.
1426             #
1427             # Examples:
1428             # ('x', '==', 2000) -> exp1
1429             # ('x', '>', 2000, 'and', 'x', '<', 5000) -> exp1 and exp2
1430             #
1431             sub _parse_filter_expression {
1432              
1433 49     49   107 my $self = shift;
1434 49         74 my $expression = shift;
1435 49         112 my @tokens = @_;
1436              
1437             # The number of tokens will be either 3 (for 1 expression)
1438             # or 7 (for 2 expressions).
1439             #
1440 49 100       106 if ( @tokens == 7 ) {
1441              
1442 10         17 my $conditional = $tokens[3];
1443              
1444 10 100       60 if ( $conditional =~ /^(and|&&)$/ ) {
    50          
1445 5         12 $conditional = 0;
1446             }
1447             elsif ( $conditional =~ /^(or|\|\|)$/ ) {
1448 5         11 $conditional = 1;
1449             }
1450             else {
1451 0         0 croak "Token '$conditional' is not a valid conditional "
1452             . "in filter expression '$expression'";
1453             }
1454              
1455 10         32 my @expression_1 =
1456             $self->_parse_filter_tokens( $expression, @tokens[ 0, 1, 2 ] );
1457 10         27 my @expression_2 =
1458             $self->_parse_filter_tokens( $expression, @tokens[ 4, 5, 6 ] );
1459              
1460 10         41 return ( @expression_1, $conditional, @expression_2 );
1461             }
1462             else {
1463 39         105 return $self->_parse_filter_tokens( $expression, @tokens );
1464             }
1465             }
1466              
1467              
1468             ###############################################################################
1469             #
1470             # _parse_filter_tokens(@token)
1471             #
1472             # Parse the 3 tokens of a filter expression and return the operator and token.
1473             #
1474             sub _parse_filter_tokens {
1475              
1476 59     59   81 my $self = shift;
1477 59         88 my $expression = shift;
1478 59         115 my @tokens = @_;
1479              
1480 59         286 my %operators = (
1481             '==' => 2,
1482             '=' => 2,
1483             '=~' => 2,
1484             'eq' => 2,
1485              
1486             '!=' => 5,
1487             '!~' => 5,
1488             'ne' => 5,
1489             '<>' => 5,
1490              
1491             '<' => 1,
1492             '<=' => 3,
1493             '>' => 4,
1494             '>=' => 6,
1495             );
1496              
1497 59         106 my $operator = $operators{ $tokens[1] };
1498 59         83 my $token = $tokens[2];
1499              
1500              
1501             # Special handling of "Top" filter expressions.
1502 59 100       131 if ( $tokens[0] =~ /^top|bottom$/i ) {
1503              
1504 4         6 my $value = $tokens[1];
1505              
1506 4 50 33     25 if ( $value =~ /\D/
      33        
1507             or $value < 1
1508             or $value > 500 )
1509             {
1510 0         0 croak "The value '$value' in expression '$expression' "
1511             . "must be in the range 1 to 500";
1512             }
1513              
1514 4         9 $token = lc $token;
1515              
1516 4 50 66     15 if ( $token ne 'items' and $token ne '%' ) {
1517 0         0 croak "The type '$token' in expression '$expression' "
1518             . "must be either 'items' or '%'";
1519             }
1520              
1521 4 100       10 if ( $tokens[0] =~ /^top$/i ) {
1522 2         3 $operator = 30;
1523             }
1524             else {
1525 2         4 $operator = 32;
1526             }
1527              
1528 4 100       9 if ( $tokens[2] eq '%' ) {
1529 2         4 $operator++;
1530             }
1531              
1532 4         4 $token = $value;
1533             }
1534              
1535              
1536 59 0 33     118 if ( not $operator and $tokens[0] ) {
1537 0         0 croak "Token '$tokens[1]' is not a valid operator "
1538             . "in filter expression '$expression'";
1539             }
1540              
1541              
1542             # Special handling for Blanks/NonBlanks.
1543 59 100       116 if ( $token =~ /^blanks|nonblanks$/i ) {
1544              
1545             # Only allow Equals or NotEqual in this context.
1546 7 50 66     35 if ( $operator != 2 and $operator != 5 ) {
1547 0         0 croak "The operator '$tokens[1]' in expression '$expression' "
1548             . "is not valid in relation to Blanks/NonBlanks'";
1549             }
1550              
1551 7         18 $token = lc $token;
1552              
1553             # The operator should always be 2 (=) to flag a "simple" equality in
1554             # the binary record. Therefore we convert <> to =.
1555 7 100       18 if ( $token eq 'blanks' ) {
1556 4 100       20 if ( $operator == 5 ) {
1557 1         4 $token = ' ';
1558             }
1559             }
1560             else {
1561 3 100       9 if ( $operator == 5 ) {
1562 1         2 $operator = 2;
1563 1         1 $token = 'blanks';
1564             }
1565             else {
1566 2         8 $operator = 5;
1567 2         7 $token = ' ';
1568             }
1569             }
1570             }
1571              
1572              
1573             # if the string token contains an Excel match character then change the
1574             # operator type to indicate a non "simple" equality.
1575 59 100 100     205 if ( $operator == 2 and $token =~ /[*?]/ ) {
1576 3         4 $operator = 22;
1577             }
1578              
1579              
1580 59         240 return ( $operator, $token );
1581             }
1582              
1583              
1584             ###############################################################################
1585             #
1586             # _convert_name_area($first_row, $first_col, $last_row, $last_col)
1587             #
1588             # Convert zero indexed rows and columns to the format required by worksheet
1589             # named ranges, eg, "Sheet1!$A$1:$C$13".
1590             #
1591             sub _convert_name_area {
1592              
1593 40     40   80 my $self = shift;
1594              
1595 40         66 my $row_num_1 = $_[0];
1596 40         63 my $col_num_1 = $_[1];
1597 40         59 my $row_num_2 = $_[2];
1598 40         68 my $col_num_2 = $_[3];
1599              
1600 40         67 my $range1 = '';
1601 40         65 my $range2 = '';
1602 40         53 my $row_col_only = 0;
1603 40         71 my $area;
1604              
1605             # Convert to A1 notation.
1606 40         151 my $col_char_1 = xl_col_to_name( $col_num_1, 1 );
1607 40         117 my $col_char_2 = xl_col_to_name( $col_num_2, 1 );
1608 40         112 my $row_char_1 = '$' . ( $row_num_1 + 1 );
1609 40         91 my $row_char_2 = '$' . ( $row_num_2 + 1 );
1610              
1611             # We need to handle some special cases that refer to rows or columns only.
1612 40 100 100     323 if ( $row_num_1 == 0 and $row_num_2 == $self->{_xls_rowmax} - 1 ) {
    100 100        
1613 1         2 $range1 = $col_char_1;
1614 1         2 $range2 = $col_char_2;
1615 1         2 $row_col_only = 1;
1616             }
1617             elsif ( $col_num_1 == 0 and $col_num_2 == $self->{_xls_colmax} - 1 ) {
1618 1         8 $range1 = $row_char_1;
1619 1         3 $range2 = $row_char_2;
1620 1         2 $row_col_only = 1;
1621             }
1622             else {
1623 38         69 $range1 = $col_char_1 . $row_char_1;
1624 38         74 $range2 = $col_char_2 . $row_char_2;
1625             }
1626              
1627             # A repeated range is only written once (if it isn't a special case).
1628 40 100 100     134 if ( $range1 eq $range2 && !$row_col_only ) {
1629 1         2 $area = $range1;
1630             }
1631             else {
1632 39         90 $area = $range1 . ':' . $range2;
1633             }
1634              
1635             # Build up the print area range "Sheet1!$A$1:$C$13".
1636 40         136 my $sheetname = quote_sheetname( $self->{_name} );
1637 40         93 $area = $sheetname . "!" . $area;
1638              
1639 40         84 return $area;
1640             }
1641              
1642              
1643             ###############################################################################
1644             #
1645             # hide_gridlines()
1646             #
1647             # Set the option to hide gridlines on the screen and the printed page.
1648             #
1649             # This was mainly useful for Excel 5 where printed gridlines were on by
1650             # default.
1651             #
1652             sub hide_gridlines {
1653              
1654 12     12 0 122 my $self = shift;
1655 12 100       41 my $option =
1656             defined $_[0] ? $_[0] : 1; # Default to hiding printed gridlines
1657              
1658 12 100       49 if ( $option == 0 ) {
    100          
1659 5         20 $self->{_print_gridlines} = 1; # 1 = display, 0 = hide
1660 5         11 $self->{_screen_gridlines} = 1;
1661 5         18 $self->{_print_options_changed} = 1;
1662             }
1663             elsif ( $option == 1 ) {
1664 4         8 $self->{_print_gridlines} = 0;
1665 4         7 $self->{_screen_gridlines} = 1;
1666             }
1667             else {
1668 3         16 $self->{_print_gridlines} = 0;
1669 3         8 $self->{_screen_gridlines} = 0;
1670             }
1671             }
1672              
1673              
1674             ###############################################################################
1675             #
1676             # print_row_col_headers()
1677             #
1678             # Set the option to print the row and column headers on the printed page.
1679             # See also the _store_print_headers() method below.
1680             #
1681             sub print_row_col_headers {
1682              
1683 2     2 0 12 my $self = shift;
1684 2 50       7 my $headers = defined $_[0] ? $_[0] : 1;
1685              
1686 2 50       11 if ( $headers ) {
1687 2         10 $self->{_print_headers} = 1;
1688 2         8 $self->{_print_options_changed} = 1;
1689             }
1690             else {
1691 0         0 $self->{_print_headers} = 0;
1692             }
1693             }
1694              
1695              
1696             ###############################################################################
1697             #
1698             # hide_row_col_headers()
1699             #
1700             # Set the option to hide the row and column headers in Excel.
1701             #
1702             sub hide_row_col_headers {
1703              
1704 1     1 0 5 my $self = shift;
1705 1         2 $self->{_hide_row_col_headers} = 1;
1706             }
1707              
1708              
1709             ###############################################################################
1710             #
1711             # fit_to_pages($width, $height)
1712             #
1713             # Store the vertical and horizontal number of pages that will define the
1714             # maximum area printed.
1715             #
1716             sub fit_to_pages {
1717              
1718 6     6 0 41 my $self = shift;
1719              
1720 6         42 $self->{_fit_page} = 1;
1721 6 100       28 $self->{_fit_width} = defined $_[0] ? $_[0] : 1;
1722 6 100       25 $self->{_fit_height} = defined $_[1] ? $_[1] : 1;
1723 6         16 $self->{_page_setup_changed} = 1;
1724             }
1725              
1726              
1727             ###############################################################################
1728             #
1729             # set_h_pagebreaks(@breaks)
1730             #
1731             # Store the horizontal page breaks on a worksheet.
1732             #
1733             sub set_h_pagebreaks {
1734              
1735 4     4 0 67 my $self = shift;
1736              
1737 4         7 push @{ $self->{_hbreaks} }, @_;
  4         81  
1738             }
1739              
1740              
1741             ###############################################################################
1742             #
1743             # set_v_pagebreaks(@breaks)
1744             #
1745             # Store the vertical page breaks on a worksheet.
1746             #
1747             sub set_v_pagebreaks {
1748              
1749 3     3 0 18 my $self = shift;
1750              
1751 3         4 push @{ $self->{_vbreaks} }, @_;
  3         21  
1752             }
1753              
1754              
1755             ###############################################################################
1756             #
1757             # set_zoom( $scale )
1758             #
1759             # Set the worksheet zoom factor.
1760             #
1761             sub set_zoom {
1762              
1763 3     3 0 19 my $self = shift;
1764 3   50     9 my $scale = $_[0] || 100;
1765              
1766             # Confine the scale to Excel's range
1767 3 50 33     17 if ( $scale < 10 or $scale > 400 ) {
1768 0         0 carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
1769 0         0 $scale = 100;
1770             }
1771              
1772 3         10 $self->{_zoom} = int $scale;
1773             }
1774              
1775              
1776             ###############################################################################
1777             #
1778             # set_print_scale($scale)
1779             #
1780             # Set the scale factor for the printed page.
1781             #
1782             sub set_print_scale {
1783              
1784 3     3 0 19 my $self = shift;
1785 3   50     16 my $scale = $_[0] || 100;
1786              
1787             # Confine the scale to Excel's range
1788 3 50 33     32 if ( $scale < 10 or $scale > 400 ) {
1789 0         0 carp "Print scale $scale outside range: 10 <= zoom <= 400";
1790 0         0 $scale = 100;
1791             }
1792              
1793             # Turn off "fit to page" option.
1794 3         25 $self->{_fit_page} = 0;
1795              
1796 3         8 $self->{_print_scale} = int $scale;
1797 3         36 $self->{_page_setup_changed} = 1;
1798             }
1799              
1800              
1801             ###############################################################################
1802             #
1803             # print_black_and_white()
1804             #
1805             # Set the option to print the worksheet in black and white.
1806             #
1807             sub print_black_and_white {
1808              
1809 1     1 0 6 my $self = shift;
1810              
1811 1         2 $self->{_black_white} = 1;
1812             }
1813              
1814              
1815             ###############################################################################
1816             #
1817             # keep_leading_zeros()
1818             #
1819             # Causes the write() method to treat integers with a leading zero as a string.
1820             # This ensures that any leading zeros such, as in zip codes, are maintained.
1821             #
1822             sub keep_leading_zeros {
1823              
1824 0     0 0 0 my $self = shift;
1825              
1826 0 0       0 if ( defined $_[0] ) {
1827 0         0 $self->{_leading_zeros} = $_[0];
1828             }
1829             else {
1830 0         0 $self->{_leading_zeros} = 1;
1831             }
1832             }
1833              
1834              
1835             ###############################################################################
1836             #
1837             # show_comments()
1838             #
1839             # Make any comments in the worksheet visible.
1840             #
1841             sub show_comments {
1842              
1843 2     2 0 12 my $self = shift;
1844              
1845 2 50       8 $self->{_comments_visible} = defined $_[0] ? $_[0] : 1;
1846             }
1847              
1848              
1849             ###############################################################################
1850             #
1851             # set_comments_author()
1852             #
1853             # Set the default author of the cell comments.
1854             #
1855             sub set_comments_author {
1856              
1857 43     43 0 243 my $self = shift;
1858              
1859 43 50       180 $self->{_comments_author} = $_[0] if defined $_[0];
1860             }
1861              
1862              
1863             ###############################################################################
1864             #
1865             # right_to_left()
1866             #
1867             # Display the worksheet right to left for some eastern versions of Excel.
1868             #
1869             sub right_to_left {
1870              
1871 1     1 0 7 my $self = shift;
1872              
1873 1 50       4 $self->{_right_to_left} = defined $_[0] ? $_[0] : 1;
1874             }
1875              
1876              
1877             ###############################################################################
1878             #
1879             # hide_zero()
1880             #
1881             # Hide cell zero values.
1882             #
1883             sub hide_zero {
1884              
1885 1     1 0 6 my $self = shift;
1886              
1887 1 50       4 $self->{_show_zeros} = defined $_[0] ? not $_[0] : 0;
1888             }
1889              
1890              
1891             ###############################################################################
1892             #
1893             # print_across()
1894             #
1895             # Set the order in which pages are printed.
1896             #
1897             sub print_across {
1898              
1899 2     2 0 25 my $self = shift;
1900 2 50       7 my $page_order = defined $_[0] ? $_[0] : 1;
1901              
1902 2 50       7 if ( $page_order ) {
1903 2         7 $self->{_page_order} = 1;
1904 2         6 $self->{_page_setup_changed} = 1;
1905             }
1906             else {
1907 0         0 $self->{_page_order} = 0;
1908             }
1909             }
1910              
1911              
1912             ###############################################################################
1913             #
1914             # set_start_page()
1915             #
1916             # Set the start page number.
1917             #
1918             sub set_start_page {
1919              
1920 3     3 0 22 my $self = shift;
1921 3 50       9 return unless defined $_[0];
1922              
1923 3         23 $self->{_page_start} = $_[0];
1924             }
1925              
1926              
1927             ###############################################################################
1928             #
1929             # set_first_row_column()
1930             #
1931             # Set the topmost and leftmost visible row and column.
1932             # TODO: Document this when tested fully for interaction with panes.
1933             #
1934             sub set_first_row_column {
1935              
1936 0     0 0 0 my $self = shift;
1937              
1938 0   0     0 my $row = $_[0] || 0;
1939 0   0     0 my $col = $_[1] || 0;
1940              
1941 0 0       0 $row = $self->{_xls_rowmax} if $row > $self->{_xls_rowmax};
1942 0 0       0 $col = $self->{_xls_colmax} if $col > $self->{_xls_colmax};
1943              
1944 0         0 $self->{_first_row} = $row;
1945 0         0 $self->{_first_col} = $col;
1946             }
1947              
1948              
1949             ###############################################################################
1950             #
1951             # add_write_handler($re, $code_ref)
1952             #
1953             # Allow the user to add their own matches and handlers to the write() method.
1954             #
1955             sub add_write_handler {
1956              
1957 0     0 0 0 my $self = shift;
1958              
1959 0 0       0 return unless @_ == 2;
1960 0 0       0 return unless ref $_[1] eq 'CODE';
1961              
1962 0         0 push @{ $self->{_write_match} }, [@_];
  0         0  
1963             }
1964              
1965              
1966             ###############################################################################
1967             #
1968             # write($row, $col, $token, $format)
1969             #
1970             # Parse $token and call appropriate write method. $row and $column are zero
1971             # indexed. $format is optional.
1972             #
1973             # Returns: return value of called subroutine
1974             #
1975             sub write {
1976              
1977 10843     10843 0 25084 my $self = shift;
1978              
1979             # Check for a cell reference in A1 notation and substitute row and column
1980 10843 100       30829 if ( $_[0] =~ /^\D/ ) {
1981 1087         4501 @_ = $self->_substitute_cellref( @_ );
1982             }
1983              
1984 10843         15408 my $token = $_[2];
1985              
1986             # Handle undefs as blanks
1987 10843 100       18496 $token = '' unless defined $token;
1988              
1989              
1990             # First try user defined matches.
1991 10843         13396 for my $aref ( @{ $self->{_write_match} } ) {
  10843         22653  
1992 0         0 my $re = $aref->[0];
1993 0         0 my $sub = $aref->[1];
1994              
1995 0 0       0 if ( $token =~ /$re/ ) {
1996 0         0 my $match = &$sub( $self, @_ );
1997 0 0       0 return $match if defined $match;
1998             }
1999             }
2000              
2001              
2002             # Match an array ref.
2003 10843 100 33     62351 if ( ref $token eq "ARRAY" ) {
    50          
    100          
    100          
    50          
    50          
    100          
    100          
    100          
2004 1036         3355 return $self->write_row( @_ );
2005             }
2006              
2007             # Match integer with leading zero(s)
2008             elsif ( $self->{_leading_zeros} and $token =~ /^0\d+$/ ) {
2009 0         0 return $self->write_string( @_ );
2010             }
2011              
2012             # Match number
2013             elsif ( $token =~ /^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/ ) {
2014 7607         16581 return $self->write_number( @_ );
2015             }
2016              
2017             # Match http, https or ftp URL
2018             elsif ( $token =~ m|^[fh]tt?ps?://| ) {
2019 14         143 return $self->write_url( @_ );
2020             }
2021              
2022             # Match mailto:
2023             elsif ( $token =~ m/^mailto:/ ) {
2024 0         0 return $self->write_url( @_ );
2025             }
2026              
2027             # Match internal or external sheet link
2028             elsif ( $token =~ m[^(?:in|ex)ternal:] ) {
2029 0         0 return $self->write_url( @_ );
2030             }
2031              
2032             # Match formula
2033             elsif ( $token =~ /^=/ ) {
2034 21         82 return $self->write_formula( @_ );
2035             }
2036              
2037             # Match array formula
2038             elsif ( $token =~ /^{=.*}$/ ) {
2039 2         12 return $self->write_formula( @_ );
2040             }
2041              
2042             # Match blank
2043             elsif ( $token eq '' ) {
2044 29         71 splice @_, 2, 1; # remove the empty string from the parameter list
2045 29         109 return $self->write_blank( @_ );
2046             }
2047              
2048             # Default: match string
2049             else {
2050 2134         4858 return $self->write_string( @_ );
2051             }
2052             }
2053              
2054              
2055             ###############################################################################
2056             #
2057             # write_row($row, $col, $array_ref, $format)
2058             #
2059             # Write a row of data starting from ($row, $col). Call write_col() if any of
2060             # the elements of the array ref are in turn array refs. This allows the writing
2061             # of 1D or 2D arrays of data in one go.
2062             #
2063             # Returns: the first encountered error value or zero for no errors
2064             #
2065             sub write_row {
2066              
2067 1043     1043 0 1976 my $self = shift;
2068              
2069              
2070             # Check for a cell reference in A1 notation and substitute row and column
2071 1043 100       3550 if ( $_[0] =~ /^\D/ ) {
2072 7         20 @_ = $self->_substitute_cellref( @_ );
2073             }
2074              
2075             # Catch non array refs passed by user.
2076 1043 50       2961 if ( ref $_[2] ne 'ARRAY' ) {
2077 0         0 croak "Not an array ref in call to write_row()$!";
2078             }
2079              
2080 1043         1932 my $row = shift;
2081 1043         1583 my $col = shift;
2082 1043         1546 my $tokens = shift;
2083 1043         1983 my @options = @_;
2084 1043         1709 my $error = 0;
2085 1043         1648 my $ret;
2086              
2087 1043         2183 for my $token ( @$tokens ) {
2088              
2089             # Check for nested arrays
2090 3952 100       7417 if ( ref $token eq "ARRAY" ) {
2091 1174         3397 $ret = $self->write_col( $row, $col, $token, @options );
2092             }
2093             else {
2094 2778         4839 $ret = $self->write( $row, $col, $token, @options );
2095             }
2096              
2097             # Return only the first error encountered, if any.
2098 3952   33     12846 $error ||= $ret;
2099 3952         5745 $col++;
2100             }
2101              
2102 1043         3247 return $error;
2103             }
2104              
2105              
2106             ###############################################################################
2107             #
2108             # write_col($row, $col, $array_ref, $format)
2109             #
2110             # Write a column of data starting from ($row, $col). Call write_row() if any of
2111             # the elements of the array ref are in turn array refs. This allows the writing
2112             # of 1D or 2D arrays of data in one go.
2113             #
2114             # Returns: the first encountered error value or zero for no errors
2115             #
2116             sub write_col {
2117              
2118 1195     1195 0 2055 my $self = shift;
2119              
2120              
2121             # Check for a cell reference in A1 notation and substitute row and column
2122 1195 100       3762 if ( $_[0] =~ /^\D/ ) {
2123 19         114 @_ = $self->_substitute_cellref( @_ );
2124             }
2125              
2126             # Catch non array refs passed by user.
2127 1195 50       3198 if ( ref $_[2] ne 'ARRAY' ) {
2128 0         0 croak "Not an array ref in call to write_col()$!";
2129             }
2130              
2131 1195         2410 my $row = shift;
2132 1195         1810 my $col = shift;
2133 1195         1719 my $tokens = shift;
2134 1195         2231 my @options = @_;
2135 1195         1794 my $error = 0;
2136 1195         1776 my $ret;
2137              
2138 1195         2340 for my $token ( @$tokens ) {
2139              
2140             # write() will deal with any nested arrays
2141 5835         12269 $ret = $self->write( $row, $col, $token, @options );
2142              
2143             # Return only the first error encountered, if any.
2144 5835   33     18781 $error ||= $ret;
2145 5835         8814 $row++;
2146             }
2147              
2148 1195         2569 return $error;
2149             }
2150              
2151              
2152             ###############################################################################
2153             #
2154             # write_comment($row, $col, $comment)
2155             #
2156             # Write a comment to the specified row and column (zero indexed).
2157             #
2158             # Returns 0 : normal termination
2159             # -1 : insufficient number of arguments
2160             # -2 : row or column out of range
2161             #
2162             sub write_comment {
2163              
2164 4165     4165 0 11806 my $self = shift;
2165              
2166             # Check for a cell reference in A1 notation and substitute row and column
2167 4165 100       8718 if ( $_[0] =~ /^\D/ ) {
2168 69         256 @_ = $self->_substitute_cellref( @_ );
2169             }
2170              
2171 4165 50       7159 if ( @_ < 3 ) { return -1 } # Check the number of args
  0         0  
2172              
2173 4165         5484 my $row = $_[0];
2174 4165         4694 my $col = $_[1];
2175              
2176             # Check for pairs of optional arguments, i.e. an odd number of args.
2177 4165 50       6052 croak "Uneven number of additional arguments" unless @_ % 2;
2178              
2179             # Check that row and col are valid and store max and min values
2180 4165 100       6057 return -2 if $self->_check_dimensions( $row, $col );
2181              
2182 4161         5019 $self->{_has_vml} = 1;
2183 4161         4636 $self->{_has_comments} = 1;
2184              
2185             # Process the properties of the cell comment.
2186 4161         13935 $self->{_comments}->{$row}->{$col} = [ @_ ];
2187             }
2188              
2189              
2190             ###############################################################################
2191             #
2192             # write_number($row, $col, $num, $format)
2193             #
2194             # Write a double to the specified row and column (zero indexed).
2195             # An integer can be written as a double. Excel will display an
2196             # integer. $format is optional.
2197             #
2198             # Returns 0 : normal termination
2199             # -1 : insufficient number of arguments
2200             # -2 : row or column out of range
2201             #
2202             sub write_number {
2203              
2204 7623     7623 0 12820 my $self = shift;
2205              
2206             # Check for a cell reference in A1 notation and substitute row and column
2207 7623 50       16247 if ( $_[0] =~ /^\D/ ) {
2208 0         0 @_ = $self->_substitute_cellref( @_ );
2209             }
2210              
2211 7623 50       13844 if ( @_ < 3 ) { return -1 } # Check the number of args
  0         0  
2212              
2213              
2214 7623         10982 my $row = $_[0]; # Zero indexed row
2215 7623         9843 my $col = $_[1]; # Zero indexed column
2216 7623         10649 my $num = $_[2] + 0;
2217 7623         11488 my $xf = $_[3]; # The cell format
2218 7623         9896 my $type = 'n'; # The data type
2219              
2220             # Check that row and col are valid and store max and min values
2221 7623 100       13487 return -2 if $self->_check_dimensions( $row, $col );
2222              
2223             # Write previous row if in in-line string optimization mode.
2224 7620 100 100     16259 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2225 2         9 $self->_write_single_row( $row );
2226             }
2227              
2228 7620         20612 $self->{_table}->{$row}->{$col} = [ $type, $num, $xf ];
2229              
2230 7620         15294 return 0;
2231             }
2232              
2233              
2234             ###############################################################################
2235             #
2236             # write_string ($row, $col, $string, $format)
2237             #
2238             # Write a string to the specified row and column (zero indexed).
2239             # $format is optional.
2240             # Returns 0 : normal termination
2241             # -1 : insufficient number of arguments
2242             # -2 : row or column out of range
2243             # -3 : long string truncated to 32767 chars
2244             # -4 : Ignore undef strings
2245             #
2246             sub write_string {
2247              
2248 2998     2998 0 8015 my $self = shift;
2249              
2250             # Check for a cell reference in A1 notation and substitute row and column
2251 2998 100       7142 if ( $_[0] =~ /^\D/ ) {
2252 45         93 @_ = $self->_substitute_cellref( @_ );
2253             }
2254              
2255 2998 50       5638 if ( @_ < 3 ) { return -1 } # Check the number of args
  0         0  
2256              
2257 2998         4481 my $row = $_[0]; # Zero indexed row
2258 2998         4026 my $col = $_[1]; # Zero indexed column
2259 2998         3997 my $str = $_[2];
2260 2998         3776 my $xf = $_[3]; # The cell format
2261 2998         3775 my $type = 's'; # The data type
2262 2998         3705 my $index;
2263 2998         4086 my $str_error = 0;
2264              
2265             # Ignore undef strings.
2266 2998 50       5315 return -4 if !defined $str;
2267              
2268             # Check that row and col are valid and store max and min values
2269 2998 100       5670 return -2 if $self->_check_dimensions( $row, $col );
2270              
2271             # Check that the string is < 32767 chars
2272 2994 50       6631 if ( length $str > $self->{_xls_strmax} ) {
2273 0         0 $str = substr( $str, 0, $self->{_xls_strmax} );
2274 0         0 $str_error = -3;
2275             }
2276              
2277             # Write a shared string or an in-line string based on optimisation level.
2278 2994 100       5494 if ( $self->{_optimization} == 0 ) {
2279 2700         5770 $index = $self->_get_shared_string_index( $str );
2280             }
2281             else {
2282 294         371 $index = $str;
2283             }
2284              
2285             # Write previous row if in in-line string optimization mode.
2286 2994 100 100     7603 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2287 280         679 $self->_write_single_row( $row );
2288             }
2289              
2290 2994         10436 $self->{_table}->{$row}->{$col} = [ $type, $index, $xf ];
2291              
2292 2994         7300 return $str_error;
2293             }
2294              
2295              
2296             ###############################################################################
2297             #
2298             # write_rich_string( $row, $column, $format, $string, ..., $cell_format )
2299             #
2300             # The write_rich_string() method is used to write strings with multiple formats.
2301             # The method receives string fragments prefixed by format objects. The final
2302             # format object is used as the cell format.
2303             #
2304             # Returns 0 : normal termination.
2305             # -1 : insufficient number of arguments.
2306             # -2 : row or column out of range.
2307             # -3 : long string truncated to 32767 chars.
2308             # -4 : 2 consecutive formats used.
2309             #
2310             sub write_rich_string {
2311              
2312 29     29 0 938 my $self = shift;
2313              
2314             # Check for a cell reference in A1 notation and substitute row and column
2315 29 100       716 if ( $_[0] =~ /^\D/ ) {
2316 28         123 @_ = $self->_substitute_cellref( @_ );
2317             }
2318              
2319 29 50       96 if ( @_ < 3 ) { return -1 } # Check the number of args
  0         0  
2320              
2321 29         58 my $row = shift; # Zero indexed row.
2322 29         51 my $col = shift; # Zero indexed column.
2323 29         53 my $str = '';
2324 29         48 my $xf = undef;
2325 29         48 my $type = 's'; # The data type.
2326 29         46 my $length = 0; # String length.
2327 29         42 my $index;
2328 29         45 my $str_error = 0;
2329              
2330             # Check that row and col are valid and store max and min values
2331 29 50       71 return -2 if $self->_check_dimensions( $row, $col );
2332              
2333              
2334             # If the last arg is a format we use it as the cell format.
2335 29 100       82 if ( ref $_[-1] ) {
2336 3         6 $xf = pop @_;
2337             }
2338              
2339              
2340             # Create a temp XML::Writer object and use it to write the rich string
2341             # XML to a string.
2342 29 50   17   765 open my $str_fh, '>', \$str or die "Failed to open filehandle: $!";
  17         117  
  17         28  
  17         109  
2343 29         11694 binmode $str_fh, ':utf8';
2344              
2345 29         199 my $writer = Excel::Writer::XLSX::Package::XMLwriter->new( $str_fh );
2346              
2347 29         175 $self->{_rstring} = $writer;
2348              
2349             # Create a temp format with the default font for unformatted fragments.
2350 29         292 my $default = Excel::Writer::XLSX::Format->new();
2351              
2352             # Convert the list of $format, $string tokens to pairs of ($format, $string)
2353             # except for the first $string fragment which doesn't require a default
2354             # formatting run. Use the default for strings without a leading format.
2355 29         67 my @fragments;
2356 29         58 my $last = 'format';
2357 29         110 my $pos = 0;
2358              
2359 29         80 for my $token ( @_ ) {
2360 114 100       228 if ( !ref $token ) {
2361              
2362             # Token is a string.
2363 81 100       152 if ( $last ne 'format' ) {
2364              
2365             # If previous token wasn't a format add one before the string.
2366 25         49 push @fragments, ( $default, $token );
2367             }
2368             else {
2369              
2370             # If previous token was a format just add the string.
2371 56         103 push @fragments, $token;
2372             }
2373              
2374 81         114 $length += length $token; # Keep track of actual string length.
2375 81         108 $last = 'string';
2376             }
2377             else {
2378              
2379             # Can't allow 2 formats in a row.
2380 33 100 100     120 if ( $last eq 'format' && $pos > 0 ) {
2381 1         7 return -4;
2382             }
2383              
2384             # Token is a format object. Add it to the fragment list.
2385 32         51 push @fragments, $token;
2386 32         53 $last = 'format';
2387             }
2388              
2389 113         170 $pos++;
2390             }
2391              
2392              
2393             # If the first token is a string start the element.
2394 28 100       84 if ( !ref $fragments[0] ) {
2395 24         111 $self->{_rstring}->xml_start_tag( 'r' );
2396             }
2397              
2398             # Write the XML elements for the $format $string fragments.
2399 28         69 for my $token ( @fragments ) {
2400 136 100       313 if ( ref $token ) {
2401              
2402             # Write the font run.
2403 56         157 $self->{_rstring}->xml_start_tag( 'r' );
2404 56         161 $self->_write_font( $token );
2405             }
2406             else {
2407              
2408             # Write the string fragment part, with whitespace handling.
2409 80         130 my @attributes = ();
2410              
2411 80 100 100     420 if ( $token =~ /^\s/ || $token =~ /\s$/ ) {
2412 10         27 push @attributes, ( 'xml:space' => 'preserve' );
2413             }
2414              
2415 80         271 $self->{_rstring}->xml_data_element( 't', $token, @attributes );
2416 80         225 $self->{_rstring}->xml_end_tag( 'r' );
2417             }
2418             }
2419              
2420             # Check that the string is < 32767 chars.
2421 28 50       114 if ( $length > $self->{_xls_strmax} ) {
2422 0         0 return -3;
2423             }
2424              
2425              
2426             # Write a shared string or an in-line string based on optimisation level.
2427 28 100       86 if ( $self->{_optimization} == 0 ) {
2428 20         75 $index = $self->_get_shared_string_index( $str );
2429             }
2430             else {
2431 8         16 $index = $str;
2432             }
2433              
2434             # Write previous row if in in-line string optimization mode.
2435 28 100 66     140 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2436 8         21 $self->_write_single_row( $row );
2437             }
2438              
2439 28         143 $self->{_table}->{$row}->{$col} = [ $type, $index, $xf ];
2440              
2441 28         245 return 0;
2442             }
2443              
2444              
2445             ###############################################################################
2446             #
2447             # write_blank($row, $col, $format)
2448             #
2449             # Write a blank cell to the specified row and column (zero indexed).
2450             # A blank cell is used to specify formatting without adding a string
2451             # or a number.
2452             #
2453             # A blank cell without a format serves no purpose. Therefore, we don't write
2454             # a BLANK record unless a format is specified. This is mainly an optimisation
2455             # for the write_row() and write_col() methods.
2456             #
2457             # Returns 0 : normal termination (including no format)
2458             # -1 : insufficient number of arguments
2459             # -2 : row or column out of range
2460             #
2461             sub write_blank {
2462              
2463 88     88 0 2366 my $self = shift;
2464              
2465             # Check for a cell reference in A1 notation and substitute row and column
2466 88 50       288 if ( $_[0] =~ /^\D/ ) {
2467 0         0 @_ = $self->_substitute_cellref( @_ );
2468             }
2469              
2470             # Check the number of args
2471 88 50       224 return -1 if @_ < 2;
2472              
2473             # Don't write a blank cell unless it has a format
2474 88 100       247 return 0 if not defined $_[2];
2475              
2476 64         97 my $row = $_[0]; # Zero indexed row
2477 64         89 my $col = $_[1]; # Zero indexed column
2478 64         83 my $xf = $_[2]; # The cell format
2479 64         112 my $type = 'b'; # The data type
2480              
2481             # Check that row and col are valid and store max and min values
2482 64 100       126 return -2 if $self->_check_dimensions( $row, $col );
2483              
2484             # Write previous row if in in-line string optimization mode.
2485 61 50 66     166 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2486 0         0 $self->_write_single_row( $row );
2487             }
2488              
2489 61         170 $self->{_table}->{$row}->{$col} = [ $type, undef, $xf ];
2490              
2491 61         167 return 0;
2492             }
2493              
2494              
2495             ###############################################################################
2496             #
2497             # write_formula($row, $col, $formula, $format)
2498             #
2499             # Write a formula to the specified row and column (zero indexed).
2500             #
2501             # $format is optional.
2502             #
2503             # Returns 0 : normal termination
2504             # -1 : insufficient number of arguments
2505             # -2 : row or column out of range
2506             #
2507             sub write_formula {
2508              
2509 117     117 0 2333 my $self = shift;
2510              
2511             # Check for a cell reference in A1 notation and substitute row and column
2512 117 100       387 if ( $_[0] =~ /^\D/ ) {
2513 21         59 @_ = $self->_substitute_cellref( @_ );
2514             }
2515              
2516 117 50       270 if ( @_ < 3 ) { return -1 } # Check the number of args
  0         0  
2517              
2518 117         203 my $row = $_[0]; # Zero indexed row
2519 117         158 my $col = $_[1]; # Zero indexed column
2520 117         248 my $formula = $_[2]; # The formula text string
2521 117         252 my $xf = $_[3]; # The format object.
2522 117         209 my $value = $_[4]; # Optional formula value.
2523 117         162 my $type = 'f'; # The data type
2524              
2525             # Hand off array formulas.
2526 117 100       277 if ( $formula =~ /^{=.*}$/ ) {
2527 3         24 return $self->write_array_formula( $row, $col, $row, $col, $formula,
2528             $xf, $value );
2529             }
2530              
2531             # Check that row and col are valid and store max and min values
2532 114 100       264 return -2 if $self->_check_dimensions( $row, $col );
2533              
2534             # Remove the = sign if it exists.
2535 111         264 $formula =~ s/^=//;
2536              
2537             # Write previous row if in in-line string optimization mode.
2538 111 50 66     286 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2539 0         0 $self->_write_single_row( $row );
2540             }
2541              
2542 111         427 $self->{_table}->{$row}->{$col} = [ $type, $formula, $xf, $value ];
2543              
2544 111         358 return 0;
2545             }
2546              
2547              
2548             ###############################################################################
2549             #
2550             # write_array_formula($row1, $col1, $row2, $col2, $formula, $format)
2551             #
2552             # Write an array formula to the specified row and column (zero indexed).
2553             #
2554             # $format is optional.
2555             #
2556             # Returns 0 : normal termination
2557             # -1 : insufficient number of arguments
2558             # -2 : row or column out of range
2559             #
2560             sub write_array_formula {
2561              
2562 13     13 0 3760 my $self = shift;
2563              
2564             # Check for a cell reference in A1 notation and substitute row and column
2565 13 100       60 if ( $_[0] =~ /^\D/ ) {
2566 5         18 @_ = $self->_substitute_cellref( @_ );
2567             }
2568              
2569 13 50       43 if ( @_ < 5 ) { return -1 } # Check the number of args
  0         0  
2570              
2571 13         102 my $row1 = $_[0]; # First row
2572 13         83 my $col1 = $_[1]; # First column
2573 13         24 my $row2 = $_[2]; # Last row
2574 13         23 my $col2 = $_[3]; # Last column
2575 13         22 my $formula = $_[4]; # The formula text string
2576 13         24 my $xf = $_[5]; # The format object.
2577 13         19 my $value = $_[6]; # Optional formula value.
2578 13         28 my $type = 'a'; # The data type
2579              
2580             # Swap last row/col with first row/col as necessary
2581 13 100       44 ( $row1, $row2 ) = ( $row2, $row1 ) if $row1 > $row2;
2582 13 100       35 ( $col1, $col2 ) = ( $col1, $col2 ) if $col1 > $col2;
2583              
2584             # Check that row and col are valid and store max and min values.
2585 13 100       42 return -2 if $self->_check_dimensions( $row1, $col1 );
2586 11 100       35 return -2 if $self->_check_dimensions( $row2, $col2 );
2587              
2588             # Define array range
2589 8         15 my $range;
2590              
2591 8 100 66     38 if ( $row1 == $row2 and $col1 == $col2 ) {
2592 4         20 $range = xl_rowcol_to_cell( $row1, $col1 );
2593              
2594             }
2595             else {
2596 4         28 $range =
2597             xl_rowcol_to_cell( $row1, $col1 ) . ':'
2598             . xl_rowcol_to_cell( $row2, $col2 );
2599             }
2600              
2601             # Remove array formula braces and the leading =.
2602 8         56 $formula =~ s/^{(.*)}$/$1/;
2603 8         31 $formula =~ s/^=//;
2604              
2605             # Write previous row if in in-line string optimization mode.
2606 8         18 my $row = $row1;
2607 8 50 33     34 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2608 0         0 $self->_write_single_row( $row );
2609             }
2610              
2611 8         36 $self->{_table}->{$row1}->{$col1} =
2612             [ $type, $formula, $xf, $range, $value ];
2613              
2614              
2615             # Pad out the rest of the area with formatted zeroes.
2616 8 50       25 if ( !$self->{_optimization} ) {
2617 8         24 for my $row ( $row1 .. $row2 ) {
2618 16         105 for my $col ( $col1 .. $col2 ) {
2619 16 100 66     118 next if $row == $row1 and $col == $col1;
2620 8         20 $self->write_number( $row, $col, 0, $xf );
2621             }
2622             }
2623             }
2624              
2625 8         28 return 0;
2626             }
2627              
2628              
2629             ###############################################################################
2630             #
2631             # write_blank($row, $col, $format)
2632             #
2633             # Write a boolean value to the specified row and column (zero indexed).
2634             #
2635             # Returns 0 : normal termination (including no format)
2636             # -2 : row or column out of range
2637             #
2638             sub write_boolean {
2639              
2640 4     4 0 20 my $self = shift;
2641              
2642             # Check for a cell reference in A1 notation and substitute row and column
2643 4 50       23 if ( $_[0] =~ /^\D/ ) {
2644 4         15 @_ = $self->_substitute_cellref( @_ );
2645             }
2646              
2647 4         7 my $row = $_[0]; # Zero indexed row
2648 4         12 my $col = $_[1]; # Zero indexed column
2649 4 100       9 my $val = $_[2] ? 1 : 0; # Boolean value.
2650 4         5 my $xf = $_[3]; # The cell format
2651 4         6 my $type = 'l'; # The data type
2652              
2653             # Check that row and col are valid and store max and min values
2654 4 50       11 return -2 if $self->_check_dimensions( $row, $col );
2655              
2656             # Write previous row if in in-line string optimization mode.
2657 4 50 33     24 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2658 0         0 $self->_write_single_row( $row );
2659             }
2660              
2661 4         15 $self->{_table}->{$row}->{$col} = [ $type, $val, $xf ];
2662              
2663 4         10 return 0;
2664             }
2665              
2666              
2667             ###############################################################################
2668             #
2669             # outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
2670             #
2671             # This method sets the properties for outlining and grouping. The defaults
2672             # correspond to Excel's defaults.
2673             #
2674             sub outline_settings {
2675              
2676 1     1 0 6 my $self = shift;
2677              
2678 1 50       9 $self->{_outline_on} = defined $_[0] ? $_[0] : 1;
2679 1 50       4 $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
2680 1 50       4 $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
2681 1   50     11 $self->{_outline_style} = $_[3] || 0;
2682              
2683 1         4 $self->{_outline_changed} = 1;
2684             }
2685              
2686              
2687             ###############################################################################
2688             #
2689             # Escape urls like Excel.
2690             #
2691             sub _escape_url {
2692              
2693 100     100   212 my $url = shift;
2694              
2695             # Don't escape URL if it looks already escaped.
2696 100 100       362 return $url if $url =~ /%[0-9a-fA-F]{2}/;
2697              
2698             # Escape the URL escape symbol.
2699 99         258 $url =~ s/%/%25/g;
2700              
2701             # Escape whitespace in URL.
2702 99         507 $url =~ s/[\s\x00]/%20/g;
2703              
2704             # Escape other special characters in URL.
2705 99         372 $url =~ s/(["<>[\]`^{}])/sprintf '%%%x', ord $1/eg;
  11         47  
2706              
2707 99         577 return $url;
2708             }
2709              
2710              
2711             ###############################################################################
2712             #
2713             # write_url($row, $col, $url, format, $string)
2714             #
2715             # Write a hyperlink. This is comprised of two elements: the visible label and
2716             # the invisible link. The visible label is the same as the link unless an
2717             # alternative string is specified. The label is written using the
2718             # write_string() method. Therefore the max characters string limit applies.
2719             # $string and $format are optional and their order is interchangeable.
2720             #
2721             # The hyperlink can be to a http, ftp, mail, internal sheet, or external
2722             # directory url.
2723             #
2724             # Returns 0 : normal termination
2725             # -1 : insufficient number of arguments
2726             # -2 : row or column out of range
2727             # -3 : long string truncated to 32767 chars
2728             # -4 : URL longer than 255 characters
2729             # -5 : Exceeds limit of 65_530 urls per worksheet
2730             #
2731             sub write_url {
2732              
2733 83     83 0 637 my $self = shift;
2734              
2735             # Check for a cell reference in A1 notation and substitute row and column
2736 83 100       485 if ( $_[0] =~ /^\D/ ) {
2737 68         339 @_ = $self->_substitute_cellref( @_ );
2738             }
2739              
2740 83 50       316 if ( @_ < 3 ) { return -1 } # Check the number of args
  0         0  
2741              
2742              
2743             # Reverse the order of $string and $format if necessary, for backward
2744             # compatibility. We work on a copy in order to protect the callers
2745             # args. We don't use "local @_" in case of perl50005 threads.
2746 83         276 my @args = @_;
2747 83 100 100     399 if (defined $args[3] and !ref $args[3]) {
2748 13         40 ( $args[3], $args[4] ) = ( $args[4], $args[3] );
2749             }
2750              
2751 83         186 my $row = $args[0]; # Zero indexed row
2752 83         160 my $col = $args[1]; # Zero indexed column
2753 83         158 my $url = $args[2]; # URL string
2754 83         149 my $xf = $args[3]; # Cell format
2755 83         143 my $str = $args[4]; # Alternative label
2756 83         140 my $tip = $args[5]; # Tool tip
2757 83         177 my $type = 'l'; # XML data type
2758 83         139 my $link_type = 1;
2759 83         141 my $external = 0;
2760              
2761             # The displayed string defaults to the url string.
2762 83 100       231 $str = $url unless defined $str;
2763              
2764             # Remove the URI scheme from internal links.
2765 83 100       295 if ( $url =~ s/^internal:// ) {
2766 8         16 $str =~ s/^internal://;
2767 8         11 $link_type = 2;
2768             }
2769              
2770             # Remove the URI scheme from external links and change the directory
2771             # separator from Unix to Dos.
2772 83 100       300 if ( $url =~ s/^external:// ) {
2773 15         46 $str =~ s/^external://;
2774 15         40 $url =~ s[/][\\]g;
2775 15         33 $str =~ s[/][\\]g;
2776 15         23 $external = 1;
2777             }
2778              
2779             # Strip the mailto header.
2780 83         190 $str =~ s/^mailto://;
2781              
2782             # Check that row and col are valid and store max and min values
2783 83 50       310 return -2 if $self->_check_dimensions( $row, $col );
2784              
2785             # Check that the string is < 32767 chars
2786 83         169 my $str_error = 0;
2787 83 50       277 if ( length $str > $self->{_xls_strmax} ) {
2788 0         0 $str = substr( $str, 0, $self->{_xls_strmax} );
2789 0         0 $str_error = -3;
2790             }
2791              
2792             # Copy string for use in hyperlink elements.
2793 83         177 my $url_str = $str;
2794              
2795             # External links to URLs and to other Excel workbooks have slightly
2796             # different characteristics that we have to account for.
2797 83 100       241 if ( $link_type == 1 ) {
2798              
2799             # Split url into the link and optional anchor/location.
2800 75         301 ( $url, $url_str ) = split /#/, $url, 2;
2801              
2802 75         271 $url = _escape_url( $url );
2803              
2804             # Escape the anchor for hyperlink style urls only.
2805 75 100 100     529 if ( $url_str && !$external ) {
2806 4         11 $url_str = _escape_url( $url_str );
2807             }
2808              
2809             # Add the file:/// URI to the url for Windows style "C:/" link and
2810             # Network shares.
2811 75 100 100     483 if ( $url =~ m{^\w:} || $url =~ m{^\\\\} ) {
2812 9         37 $url = 'file:///' . $url;
2813             }
2814              
2815             # Convert a ./dir/file.xlsx link to dir/file.xlsx.
2816 75         190 $url =~ s{^.\\}{};
2817             }
2818              
2819             # Excel limits the escaped URL and location/anchor to 255 characters.
2820 83   100     378 my $tmp_url_str = $url_str || '';
2821 83         333 my $max_url = $self->{_max_url_length};
2822              
2823 83 100 66     898 if ( length $url > $max_url || length $tmp_url_str > $max_url ) {
2824 1         216 carp "Ignoring URL '$url' where link or anchor > $max_url characters "
2825             . "since it exceeds Excel's limit for URLS. See LIMITATIONS "
2826             . "section of the Excel::Writer::XLSX documentation.";
2827 1         7 return -4;
2828             }
2829              
2830             # Check the limit of URLS per worksheet.
2831 82         755 $self->{_hlink_count}++;
2832              
2833 82 50       597 if ( $self->{_hlink_count} > 65_530 ) {
2834 0         0 carp "Ignoring URL '$url' since it exceeds Excel's limit of 65,530 "
2835             . "URLs per worksheet. See LIMITATIONS section of the "
2836             . "Excel::Writer::XLSX documentation.";
2837 0         0 return -5;
2838             }
2839              
2840             # Write previous row if in in-line string optimization mode.
2841 82 50 66     746 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2842 0         0 $self->_write_single_row( $row );
2843             }
2844              
2845             # Add the default URL format.
2846 82 100       622 if ( !defined $xf ) {
2847 65         1067 $xf = $self->{_default_url_format};
2848             }
2849              
2850             # Write the hyperlink string.
2851 82         908 $self->write_string( $row, $col, $str, $xf );
2852              
2853             # Store the hyperlink data in a separate structure.
2854 82         710 $self->{_hyperlinks}->{$row}->{$col} = {
2855             _link_type => $link_type,
2856             _url => $url,
2857             _str => $url_str,
2858             _tip => $tip
2859             };
2860              
2861 82         289 return $str_error;
2862             }
2863              
2864              
2865             ###############################################################################
2866             #
2867             # write_date_time ($row, $col, $string, $format)
2868             #
2869             # Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
2870             # number representing an Excel date. $format is optional.
2871             #
2872             # Returns 0 : normal termination
2873             # -1 : insufficient number of arguments
2874             # -2 : row or column out of range
2875             # -3 : Invalid date_time, written as string
2876             #
2877             sub write_date_time {
2878              
2879 129     129 0 734 my $self = shift;
2880              
2881             # Check for a cell reference in A1 notation and substitute row and column
2882 129 100       374 if ( $_[0] =~ /^\D/ ) {
2883 12         25 @_ = $self->_substitute_cellref( @_ );
2884             }
2885              
2886 129 50       274 if ( @_ < 3 ) { return -1 } # Check the number of args
  0         0  
2887              
2888 129         194 my $row = $_[0]; # Zero indexed row
2889 129         182 my $col = $_[1]; # Zero indexed column
2890 129         181 my $str = $_[2];
2891 129         158 my $xf = $_[3]; # The cell format
2892 129         176 my $type = 'n'; # The data type
2893              
2894              
2895             # Check that row and col are valid and store max and min values
2896 129 50       254 return -2 if $self->_check_dimensions( $row, $col );
2897              
2898 129         186 my $str_error = 0;
2899 129         266 my $date_time = $self->convert_date_time( $str );
2900              
2901             # If the date isn't valid then write it as a string.
2902 129 50       339 if ( !defined $date_time ) {
2903 0         0 return $self->write_string( @_ );
2904             }
2905              
2906             # Write previous row if in in-line string optimization mode.
2907 129 50 33     303 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2908 0         0 $self->_write_single_row( $row );
2909             }
2910              
2911 129         490 $self->{_table}->{$row}->{$col} = [ $type, $date_time, $xf ];
2912              
2913 129         291 return $str_error;
2914             }
2915              
2916              
2917             ###############################################################################
2918             #
2919             # convert_date_time($date_time_string)
2920             #
2921             # The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
2922             # and converts it to a decimal number representing a valid Excel date.
2923             #
2924             # Dates and times in Excel are represented by real numbers. The integer part of
2925             # the number stores the number of days since the epoch and the fractional part
2926             # stores the percentage of the day in seconds. The epoch can be either 1900 or
2927             # 1904.
2928             #
2929             # Parameter: Date and time string in one of the following formats:
2930             # yyyy-mm-ddThh:mm:ss.ss # Standard
2931             # yyyy-mm-ddT # Date only
2932             # Thh:mm:ss.ss # Time only
2933             #
2934             # Returns:
2935             # A decimal number representing a valid Excel date, or
2936             # undef if the date is invalid.
2937             #
2938             sub convert_date_time {
2939              
2940 768     768 0 247559 my $self = shift;
2941 768         1135 my $date_time = $_[0];
2942              
2943 768         1054 my $days = 0; # Number of days since epoch
2944 768         953 my $seconds = 0; # Time expressed as fraction of 24h hours in seconds
2945              
2946 768         1589 my ( $year, $month, $day );
2947 768         0 my ( $hour, $min, $sec );
2948              
2949              
2950             # Strip leading and trailing whitespace.
2951 768         1627 $date_time =~ s/^\s+//;
2952 768         1319 $date_time =~ s/\s+$//;
2953              
2954             # Check for invalid date char.
2955 768 100       1870 return if $date_time =~ /[^0-9T:\-\.Z]/;
2956              
2957             # Check for "T" after date or before time.
2958 767 100       2574 return unless $date_time =~ /\dT|T\d/;
2959              
2960             # Strip trailing Z in ISO8601 date.
2961 765         1087 $date_time =~ s/Z$//;
2962              
2963              
2964             # Split into date and time.
2965 765         2062 my ( $date, $time ) = split /T/, $date_time;
2966              
2967              
2968             # We allow the time portion of the input DateTime to be optional.
2969 765 100       1669 if ( $time ne '' ) {
2970              
2971             # Match hh:mm:ss.sss+ where the seconds are optional
2972 206 50       801 if ( $time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/ ) {
2973 206         363 $hour = $1;
2974 206         295 $min = $2;
2975 206   100     479 $sec = $4 || 0;
2976             }
2977             else {
2978 0         0 return undef; # Not a valid time format.
2979             }
2980              
2981             # Some boundary checks
2982 206 100       430 return if $hour >= 24;
2983 205 100       314 return if $min >= 60;
2984 204 100       413 return if $sec >= 60;
2985              
2986             # Excel expresses seconds as a fraction of the number in 24 hours.
2987 202         392 $seconds = ( $hour * 60 * 60 + $min * 60 + $sec ) / ( 24 * 60 * 60 );
2988             }
2989              
2990              
2991             # We allow the date portion of the input DateTime to be optional.
2992 761 100       1341 return $seconds if $date eq '';
2993              
2994              
2995             # Match date as yyyy-mm-dd.
2996 759 100       2257 if ( $date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/ ) {
2997 757         1441 $year = $1;
2998 757         1071 $month = $2;
2999 757         1151 $day = $3;
3000             }
3001             else {
3002 2         7 return undef; # Not a valid date format.
3003             }
3004              
3005             # Set the epoch as 1900 or 1904. Defaults to 1900.
3006 757         1220 my $date_1904 = $self->{_date_1904};
3007              
3008              
3009             # Special cases for Excel.
3010 757 100       1378 if ( not $date_1904 ) {
3011 542 100       1045 return $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
3012 438 100       754 return $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
3013 437 100       760 return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
3014             }
3015              
3016              
3017             # We calculate the date by calculating the number of days since the epoch
3018             # and adjust for the number of leap days. We calculate the number of leap
3019             # days by normalising the year in relation to the epoch. Thus the year 2000
3020             # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
3021             #
3022 651 100       1009 my $epoch = $date_1904 ? 1904 : 1900;
3023 651 100       972 my $offset = $date_1904 ? 4 : 0;
3024 651         823 my $norm = 300;
3025 651         1270 my $range = $year - $epoch;
3026              
3027              
3028             # Set month days and check for leap year.
3029 651         1388 my @mdays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
3030 651         816 my $leap = 0;
3031 651 100 100     2712 $leap = 1 if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
      100        
3032 651 100       1149 $mdays[1] = 29 if $leap;
3033              
3034              
3035             # Some boundary checks
3036 651 100 66     1813 return if $year < $epoch or $year > 9999;
3037 645 100 100     1790 return if $month < 1 or $month > 12;
3038 639 100 100     1942 return if $day < 1 or $day > $mdays[ $month - 1 ];
3039              
3040             # Accumulate the number of days since the epoch.
3041 633         846 $days = $day; # Add days for current month
3042 633         1867 $days += $mdays[$_] for 0 .. $month - 2; # Add days for past months
3043 633         1059 $days += $range * 365; # Add days for past years
3044 633         1075 $days += int( ( $range ) / 4 ); # Add leapdays
3045 633         936 $days -= int( ( $range + $offset ) / 100 ); # Subtract 100 year leapdays
3046 633         920 $days += int( ( $range + $offset + $norm ) / 400 ); # Add 400 year leapdays
3047 633         777 $days -= $leap; # Already counted above
3048              
3049              
3050             # Adjust for Excel erroneously treating 1900 as a leap year.
3051 633 100 100     1647 $days++ if $date_1904 == 0 and $days > 59;
3052              
3053 633         1639 return $days + $seconds;
3054             }
3055              
3056              
3057             ###############################################################################
3058             #
3059             # set_row($row, $height, $XF, $hidden, $level, $collapsed)
3060             #
3061             # This method is used to set the height and XF format for a row.
3062             #
3063             sub set_row {
3064              
3065 382     382 0 2051 my $self = shift;
3066 382         597 my $row = shift; # Row Number.
3067 382         549 my $height = shift; # Row height.
3068 382         535 my $xf = shift; # Format object.
3069 382   100     1142 my $hidden = shift || 0; # Hidden flag.
3070 382   100     947 my $level = shift || 0; # Outline level.
3071 382   100     891 my $collapsed = shift || 0; # Collapsed row.
3072 382         504 my $min_col = 0;
3073              
3074 382 50       730 return unless defined $row; # Ensure at least $row is specified.
3075              
3076             # Get the default row height.
3077 382         632 my $default_height = $self->{_default_row_height};
3078              
3079             # Use min col in _check_dimensions(). Default to 0 if undefined.
3080 382 100       751 if ( defined $self->{_dim_colmin} ) {
3081 349         481 $min_col = $self->{_dim_colmin};
3082             }
3083              
3084             # Check that row is valid.
3085 382 50       848 return -2 if $self->_check_dimensions( $row, $min_col );
3086              
3087 382 100       977 $height = $default_height if !defined $height;
3088              
3089             # If the height is 0 the row is hidden and the height is the default.
3090 382 100       816 if ( $height == 0 ) {
3091 1         2 $hidden = 1;
3092 1         1 $height = $default_height;
3093             }
3094              
3095             # Set the limits for the outline levels (0 <= x <= 7).
3096 382 50       697 $level = 0 if $level < 0;
3097 382 50       698 $level = 7 if $level > 7;
3098              
3099 382 100       717 if ( $level > $self->{_outline_row_level} ) {
3100 11         20 $self->{_outline_row_level} = $level;
3101             }
3102              
3103             # Store the row properties.
3104 382         1312 $self->{_set_rows}->{$row} = [ $height, $xf, $hidden, $level, $collapsed ];
3105              
3106             # Store the row change to allow optimisations.
3107 382         628 $self->{_row_size_changed} = 1;
3108              
3109             # Store the row sizes for use when calculating image vertices.
3110 382         1036 $self->{_row_sizes}->{$row} = [$height, $hidden];
3111             }
3112              
3113              
3114             ###############################################################################
3115             #
3116             # set_default_row()
3117             #
3118             # Set the default row properties
3119             #
3120             sub set_default_row {
3121              
3122 6     6 0 49 my $self = shift;
3123 6   66     32 my $height = shift || $self->{_original_row_height};
3124 6   100     38 my $zero_height = shift || 0;
3125              
3126 6 100       53 if ( $height != $self->{_original_row_height} ) {
3127 5         13 $self->{_default_row_height} = $height;
3128              
3129             # Store the row change to allow optimisations.
3130 5         14 $self->{_row_size_changed} = 1;
3131             }
3132              
3133 6 100       22 if ( $zero_height ) {
3134 3         10 $self->{_default_row_zeroed} = 1;
3135             }
3136             }
3137              
3138              
3139             ###############################################################################
3140             #
3141             # merge_range($first_row, $first_col, $last_row, $last_col, $string, $format)
3142             #
3143             # Merge a range of cells. The first cell should contain the data and the others
3144             # should be blank. All cells should contain the same format.
3145             #
3146             sub merge_range {
3147              
3148 24     24 0 3263 my $self = shift;
3149              
3150             # Check for a cell reference in A1 notation and substitute row and column
3151 24 100       117 if ( $_[0] =~ /^\D/ ) {
3152 12         41 @_ = $self->_substitute_cellref( @_ );
3153             }
3154 24 50       96 croak "Incorrect number of arguments" if @_ < 6;
3155 24 50       126 croak "Fifth parameter must be a format object" unless ref $_[5];
3156              
3157 24         50 my $row_first = shift;
3158 24         39 my $col_first = shift;
3159 24         37 my $row_last = shift;
3160 24         110 my $col_last = shift;
3161 24         76 my $string = shift;
3162 24         99 my $format = shift;
3163 24         53 my @extra_args = @_; # For write_url().
3164              
3165             # Excel doesn't allow a single cell to be merged
3166 24 50 66     105 if ( $row_first == $row_last and $col_first == $col_last ) {
3167 0         0 croak "Can't merge single cell";
3168             }
3169              
3170             # Swap last row/col with first row/col as necessary
3171 24 100       62 ( $row_first, $row_last ) = ( $row_last, $row_first )
3172             if $row_first > $row_last;
3173 24 100       65 ( $col_first, $col_last ) = ( $col_last, $col_first )
3174             if $col_first > $col_last;
3175              
3176             # Check that the data range is valid and store the max and min values.
3177 24 50       83 return -2 if $self->_check_dimensions( $row_first, $col_first );
3178 24 100       63 return -2 if $self->_check_dimensions( $row_last, $col_last );
3179              
3180             # Store the merge range.
3181 20         189 push @{ $self->{_merge} }, [ $row_first, $col_first, $row_last, $col_last ];
  20         177  
3182              
3183             # Write the first cell
3184 20         86 $self->write( $row_first, $col_first, $string, $format, @extra_args );
3185              
3186             # Pad out the rest of the area with formatted blank cells.
3187 20         59 for my $row ( $row_first .. $row_last ) {
3188 30         54 for my $col ( $col_first .. $col_last ) {
3189 68 100 100     284 next if $row == $row_first and $col == $col_first;
3190 48         202 $self->write_blank( $row, $col, $format );
3191             }
3192             }
3193             }
3194              
3195              
3196             ###############################################################################
3197             #
3198             # merge_range_type()
3199             #
3200             # Same as merge_range() above except the type of write() is specified.
3201             #
3202             sub merge_range_type {
3203              
3204 7     7 0 35 my $self = shift;
3205 7         11 my $type = shift;
3206              
3207             # Check for a cell reference in A1 notation and substitute row and column
3208 7 50       25 if ( $_[0] =~ /^\D/ ) {
3209 7         20 @_ = $self->_substitute_cellref( @_ );
3210             }
3211              
3212 7         15 my $row_first = shift;
3213 7         12 my $col_first = shift;
3214 7         10 my $row_last = shift;
3215 7         14 my $col_last = shift;
3216 7         9 my $format;
3217              
3218             # Get the format. It can be in different positions for the different types.
3219 7 100 66     39 if ( $type eq 'array_formula'
      100        
3220             || $type eq 'blank'
3221             || $type eq 'rich_string' )
3222             {
3223              
3224             # The format is the last element.
3225 2         5 $format = $_[-1];
3226             }
3227             else {
3228              
3229             # Or else it is after the token.
3230 5         9 $format = $_[1];
3231             }
3232              
3233             # Check that there is a format object.
3234 7 50       19 croak "Format object missing or in an incorrect position"
3235             unless ref $format;
3236              
3237             # Excel doesn't allow a single cell to be merged
3238 7 50 33     36 if ( $row_first == $row_last and $col_first == $col_last ) {
3239 0         0 croak "Can't merge single cell";
3240             }
3241              
3242             # Swap last row/col with first row/col as necessary
3243 7 50       17 ( $row_first, $row_last ) = ( $row_last, $row_first )
3244             if $row_first > $row_last;
3245 7 50       14 ( $col_first, $col_last ) = ( $col_last, $col_first )
3246             if $col_first > $col_last;
3247              
3248             # Check that the data range is valid and store the max and min values.
3249 7 50       16 return -2 if $self->_check_dimensions( $row_first, $col_first );
3250 7 50       16 return -2 if $self->_check_dimensions( $row_last, $col_last );
3251              
3252             # Store the merge range.
3253 7         9 push @{ $self->{_merge} }, [ $row_first, $col_first, $row_last, $col_last ];
  7         26  
3254              
3255             # Write the first cell
3256 7 100       44 if ( $type eq 'string' ) {
    100          
    100          
    100          
    100          
    100          
    50          
    0          
3257 1         5 $self->write_string( $row_first, $col_first, @_ );
3258             }
3259             elsif ( $type eq 'number' ) {
3260 1         14 $self->write_number( $row_first, $col_first, @_ );
3261             }
3262             elsif ( $type eq 'blank' ) {
3263 1         4 $self->write_blank( $row_first, $col_first, @_ );
3264             }
3265             elsif ( $type eq 'date_time' ) {
3266 1         5 $self->write_date_time( $row_first, $col_first, @_ );
3267             }
3268             elsif ( $type eq 'rich_string' ) {
3269 1         5 $self->write_rich_string( $row_first, $col_first, @_ );
3270             }
3271             elsif ( $type eq 'url' ) {
3272 1         5 $self->write_url( $row_first, $col_first, @_ );
3273             }
3274             elsif ( $type eq 'formula' ) {
3275 1         7 $self->write_formula( $row_first, $col_first, @_ );
3276             }
3277             elsif ( $type eq 'array_formula' ) {
3278 0         0 $self->write_formula_array( $row_first, $col_first, @_ );
3279             }
3280             else {
3281 0         0 croak "Unknown type '$type'";
3282             }
3283              
3284             # Pad out the rest of the area with formatted blank cells.
3285 7         23 for my $row ( $row_first .. $row_last ) {
3286 7         13 for my $col ( $col_first .. $col_last ) {
3287 14 100 66     48 next if $row == $row_first and $col == $col_first;
3288 7         29 $self->write_blank( $row, $col, $format );
3289             }
3290             }
3291             }
3292              
3293              
3294             ###############################################################################
3295             #
3296             # data_validation($row, $col, {...})
3297             #
3298             # This method handles the interface to Excel data validation.
3299             # Somewhat ironically this requires a lot of validation code since the
3300             # interface is flexible and covers a several types of data validation.
3301             #
3302             # We allow data validation to be called on one cell or a range of cells. The
3303             # hashref contains the validation parameters and must be the last param:
3304             # data_validation($row, $col, {...})
3305             # data_validation($first_row, $first_col, $last_row, $last_col, {...})
3306             #
3307             # Returns 0 : normal termination
3308             # -1 : insufficient number of arguments
3309             # -2 : row or column out of range
3310             # -3 : incorrect parameter.
3311             #
3312             sub data_validation {
3313              
3314 68     68 0 1413 my $self = shift;
3315              
3316             # Check for a cell reference in A1 notation and substitute row and column
3317 68 100       298 if ( $_[0] =~ /^\D/ ) {
3318 63         193 @_ = $self->_substitute_cellref( @_ );
3319             }
3320              
3321             # Check for a valid number of args.
3322 68 50 66     280 if ( @_ != 5 && @_ != 3 ) { return -1 }
  0         0  
3323              
3324             # The final hashref contains the validation parameters.
3325 68         118 my $param = pop;
3326              
3327             # Make the last row/col the same as the first if not defined.
3328 68         137 my ( $row1, $col1, $row2, $col2 ) = @_;
3329 68 100       154 if ( !defined $row2 ) {
3330 63         98 $row2 = $row1;
3331 63         82 $col2 = $col1;
3332             }
3333              
3334             # Check that row and col are valid without storing the values.
3335 68 50       187 return -2 if $self->_check_dimensions( $row1, $col1, 1, 1 );
3336 68 50       129 return -2 if $self->_check_dimensions( $row2, $col2, 1, 1 );
3337              
3338              
3339             # Check that the last parameter is a hash list.
3340 68 50       189 if ( ref $param ne 'HASH' ) {
3341 0         0 carp "Last parameter '$param' in data_validation() must be a hash ref";
3342 0         0 return -3;
3343             }
3344              
3345             # List of valid input parameters.
3346 68         435 my %valid_parameter = (
3347             validate => 1,
3348             criteria => 1,
3349             value => 1,
3350             source => 1,
3351             minimum => 1,
3352             maximum => 1,
3353             ignore_blank => 1,
3354             dropdown => 1,
3355             show_input => 1,
3356             input_title => 1,
3357             input_message => 1,
3358             show_error => 1,
3359             error_title => 1,
3360             error_message => 1,
3361             error_type => 1,
3362             other_cells => 1,
3363             );
3364              
3365             # Check for valid input parameters.
3366 68         280 for my $param_key ( keys %$param ) {
3367 262 50       465 if ( not exists $valid_parameter{$param_key} ) {
3368 0         0 carp "Unknown parameter '$param_key' in data_validation()";
3369 0         0 return -3;
3370             }
3371             }
3372              
3373             # Map alternative parameter names 'source' or 'minimum' to 'value'.
3374 68 100       166 $param->{value} = $param->{source} if defined $param->{source};
3375 68 100       155 $param->{value} = $param->{minimum} if defined $param->{minimum};
3376              
3377             # 'validate' is a required parameter.
3378 68 50       150 if ( not exists $param->{validate} ) {
3379 0         0 carp "Parameter 'validate' is required in data_validation()";
3380 0         0 return -3;
3381             }
3382              
3383              
3384             # List of valid validation types.
3385 68         444 my %valid_type = (
3386             'any' => 'none',
3387             'any value' => 'none',
3388             'whole number' => 'whole',
3389             'whole' => 'whole',
3390             'integer' => 'whole',
3391             'decimal' => 'decimal',
3392             'list' => 'list',
3393             'date' => 'date',
3394             'time' => 'time',
3395             'text length' => 'textLength',
3396             'length' => 'textLength',
3397             'custom' => 'custom',
3398             );
3399              
3400              
3401             # Check for valid validation types.
3402 68 50       188 if ( not exists $valid_type{ lc( $param->{validate} ) } ) {
3403 0         0 carp "Unknown validation type '$param->{validate}' for parameter "
3404             . "'validate' in data_validation()";
3405 0         0 return -3;
3406             }
3407             else {
3408 68         135 $param->{validate} = $valid_type{ lc( $param->{validate} ) };
3409             }
3410              
3411             # No action is required for validation type 'any'
3412             # unless there are input messages.
3413 68 100 100     208 if ( $param->{validate} eq 'none'
      66        
3414             && !defined $param->{input_message}
3415             && !defined $param->{input_title} )
3416             {
3417 1         6 return 0;
3418             }
3419              
3420             # The any, list and custom validations don't have a criteria
3421             # so we use a default of 'between'.
3422 67 100 100     325 if ( $param->{validate} eq 'none'
      100        
3423             || $param->{validate} eq 'list'
3424             || $param->{validate} eq 'custom' )
3425             {
3426 18         37 $param->{criteria} = 'between';
3427 18         36 $param->{maximum} = undef;
3428             }
3429              
3430             # 'criteria' is a required parameter.
3431 67 50       123 if ( not exists $param->{criteria} ) {
3432 0         0 carp "Parameter 'criteria' is required in data_validation()";
3433 0         0 return -3;
3434             }
3435              
3436              
3437             # List of valid criteria types.
3438 67         497 my %criteria_type = (
3439             'between' => 'between',
3440             'not between' => 'notBetween',
3441             'equal to' => 'equal',
3442             '=' => 'equal',
3443             '==' => 'equal',
3444             'not equal to' => 'notEqual',
3445             '!=' => 'notEqual',
3446             '<>' => 'notEqual',
3447             'greater than' => 'greaterThan',
3448             '>' => 'greaterThan',
3449             'less than' => 'lessThan',
3450             '<' => 'lessThan',
3451             'greater than or equal to' => 'greaterThanOrEqual',
3452             '>=' => 'greaterThanOrEqual',
3453             'less than or equal to' => 'lessThanOrEqual',
3454             '<=' => 'lessThanOrEqual',
3455             );
3456              
3457             # Check for valid criteria types.
3458 67 50       179 if ( not exists $criteria_type{ lc( $param->{criteria} ) } ) {
3459 0         0 carp "Unknown criteria type '$param->{criteria}' for parameter "
3460             . "'criteria' in data_validation()";
3461 0         0 return -3;
3462             }
3463             else {
3464 67         127 $param->{criteria} = $criteria_type{ lc( $param->{criteria} ) };
3465             }
3466              
3467              
3468             # 'Between' and 'Not between' criteria require 2 values.
3469 67 100 100     190 if ( $param->{criteria} eq 'between' || $param->{criteria} eq 'notBetween' )
3470             {
3471 42 50       99 if ( not exists $param->{maximum} ) {
3472 0         0 carp "Parameter 'maximum' is required in data_validation() "
3473             . "when using 'between' or 'not between' criteria";
3474 0         0 return -3;
3475             }
3476             }
3477             else {
3478 25         38 $param->{maximum} = undef;
3479             }
3480              
3481              
3482             # List of valid error dialog types.
3483 67         191 my %error_type = (
3484             'stop' => 0,
3485             'warning' => 1,
3486             'information' => 2,
3487             );
3488              
3489             # Check for valid error dialog types.
3490 67 100       140 if ( not exists $param->{error_type} ) {
    50          
3491 65         105 $param->{error_type} = 0;
3492             }
3493             elsif ( not exists $error_type{ lc( $param->{error_type} ) } ) {
3494 0         0 carp "Unknown criteria type '$param->{error_type}' for parameter "
3495             . "'error_type' in data_validation()";
3496 0         0 return -3;
3497             }
3498             else {
3499 2         5 $param->{error_type} = $error_type{ lc( $param->{error_type} ) };
3500             }
3501              
3502              
3503             # Convert date/times value if required.
3504 67 100 100     236 if ( $param->{validate} eq 'date' || $param->{validate} eq 'time' ) {
3505 7         26 my $date_time = $self->convert_date_time( $param->{value} );
3506              
3507 7 100       19 if ( defined $date_time ) {
3508 5         10 $param->{value} = $date_time;
3509             }
3510              
3511 7 100       92 if ( defined $param->{maximum} ) {
3512 3         15 my $date_time = $self->convert_date_time( $param->{maximum} );
3513              
3514 3 100       10 if ( defined $date_time ) {
3515 2         5 $param->{maximum} = $date_time;
3516             }
3517             }
3518             }
3519              
3520             # Check that the input title doesn't exceed the maximum length.
3521 67 100 100     184 if ( $param->{input_title} and length $param->{input_title} > 32 ) {
3522 1         255 carp "Length of input title '$param->{input_title}'"
3523             . " exceeds Excel's limit of 32";
3524 1         13 return -3;
3525             }
3526              
3527             # Check that the error title don't exceed the maximum length.
3528 66 50 66     152 if ( $param->{error_title} and length $param->{error_title} > 32 ) {
3529 0         0 carp "Length of error title '$param->{error_title}'"
3530             . " exceeds Excel's limit of 32";
3531 0         0 return -3;
3532             }
3533              
3534             # Check that the input message don't exceed the maximum length.
3535 66 100 100     172 if ( $param->{input_message} and length $param->{input_message} > 255 ) {
3536 1         216 carp "Length of input message '$param->{input_message}'"
3537             . " exceeds Excel's limit of 255";
3538 1         13 return -3;
3539             }
3540              
3541             # Check that the error message don't exceed the maximum length.
3542 65 50 66     137 if ( $param->{error_message} and length $param->{error_message} > 255 ) {
3543 0         0 carp "Length of error message '$param->{error_message}'"
3544             . " exceeds Excel's limit of 255";
3545 0         0 return -3;
3546             }
3547              
3548             # Check that the input list don't exceed the maximum length.
3549 65 100       133 if ( $param->{validate} eq 'list' ) {
3550              
3551 13 100       45 if ( ref $param->{value} eq 'ARRAY' ) {
3552              
3553 11         21 my $formula = join ',', @{ $param->{value} };
  11         44  
3554 11 100       39 if ( length $formula > 255 ) {
3555 1         205 carp "Length of list items '$formula' exceeds Excel's "
3556             . "limit of 255, use a formula range instead";
3557 1         13 return -3;
3558             }
3559             }
3560             }
3561              
3562             # Set some defaults if they haven't been defined by the user.
3563 64 100       157 $param->{ignore_blank} = 1 if !defined $param->{ignore_blank};
3564 64 100       170 $param->{dropdown} = 1 if !defined $param->{dropdown};
3565 64 100       184 $param->{show_input} = 1 if !defined $param->{show_input};
3566 64 100       160 $param->{show_error} = 1 if !defined $param->{show_error};
3567              
3568              
3569             # These are the cells to which the validation is applied.
3570 64         216 $param->{cells} = [ [ $row1, $col1, $row2, $col2 ] ];
3571              
3572             # A (for now) undocumented parameter to pass additional cell ranges.
3573 64 100       142 if ( exists $param->{other_cells} ) {
3574              
3575 3         5 push @{ $param->{cells} }, @{ $param->{other_cells} };
  3         6  
  3         7  
3576             }
3577              
3578             # Store the validation information until we close the worksheet.
3579 64         618 push @{ $self->{_validations} }, $param;
  64         848  
3580             }
3581              
3582              
3583             ###############################################################################
3584             #
3585             # conditional_formatting($row, $col, {...})
3586             #
3587             # This method handles the interface to Excel conditional formatting.
3588             #
3589             # We allow the format to be called on one cell or a range of cells. The
3590             # hashref contains the formatting parameters and must be the last param:
3591             # conditional_formatting($row, $col, {...})
3592             # conditional_formatting($first_row, $first_col, $last_row, $last_col, {...})
3593             #
3594             # Returns 0 : normal termination
3595             # -1 : insufficient number of arguments
3596             # -2 : row or column out of range
3597             # -3 : incorrect parameter.
3598             #
3599             sub conditional_formatting {
3600              
3601 149     149 0 1381 my $self = shift;
3602 149         313 my $user_range = '';
3603              
3604             # Check for a cell reference in A1 notation and substitute row and column
3605 149 50       623 if ( $_[0] =~ /^\D/ ) {
3606              
3607             # Check for a user defined multiple range like B3:K6,B8:K11.
3608 149 100       471 if ( $_[0] =~ /,/ ) {
3609 1         11 $user_range = $_[0];
3610 1         6 $user_range =~ s/^=//;
3611 1         8 $user_range =~ s/\s*,\s*/ /g;
3612 1         5 $user_range =~ s/\$//g;
3613             }
3614              
3615 149         470 @_ = $self->_substitute_cellref( @_ );
3616             }
3617              
3618             # The final hashref contains the validation parameters.
3619 149         315 my $options = pop;
3620              
3621             # Make the last row/col the same as the first if not defined.
3622 149         374 my ( $row1, $col1, $row2, $col2 ) = @_;
3623 149 100       392 if ( !defined $row2 ) {
3624 74         129 $row2 = $row1;
3625 74         137 $col2 = $col1;
3626             }
3627              
3628             # Check that row and col are valid without storing the values.
3629 149 50       457 return -2 if $self->_check_dimensions( $row1, $col1, 1, 1 );
3630 149 50       554 return -2 if $self->_check_dimensions( $row2, $col2, 1, 1 );
3631              
3632              
3633             # Check that the last parameter is a hash list.
3634 149 50       638 if ( ref $options ne 'HASH' ) {
3635 0         0 carp "Last parameter in conditional_formatting() "
3636             . "must be a hash ref";
3637 0         0 return -3;
3638             }
3639              
3640             # Copy the user params.
3641 149         824 my $param = {%$options};
3642              
3643             # List of valid input parameters.
3644 149         2674 my %valid_parameter = (
3645             type => 1,
3646             format => 1,
3647             criteria => 1,
3648             value => 1,
3649             minimum => 1,
3650             maximum => 1,
3651             stop_if_true => 1,
3652             min_type => 1,
3653             mid_type => 1,
3654             max_type => 1,
3655             min_value => 1,
3656             mid_value => 1,
3657             max_value => 1,
3658             min_color => 1,
3659             mid_color => 1,
3660             max_color => 1,
3661             bar_color => 1,
3662             bar_negative_color => 1,
3663             bar_negative_color_same => 1,
3664             bar_solid => 1,
3665             bar_border_color => 1,
3666             bar_negative_border_color => 1,
3667             bar_negative_border_color_same => 1,
3668             bar_no_border => 1,
3669             bar_direction => 1,
3670             bar_axis_position => 1,
3671             bar_axis_color => 1,
3672             bar_only => 1,
3673             icon_style => 1,
3674             reverse_icons => 1,
3675             icons_only => 1,
3676             icons => 1,
3677             data_bar_2010 => 1,
3678             );
3679              
3680             # Check for valid input parameters.
3681 149         966 for my $param_key ( keys %$param ) {
3682 492 50       1102 if ( not exists $valid_parameter{$param_key} ) {
3683 0         0 carp "Unknown parameter '$param_key' in conditional_formatting()";
3684 0         0 return -3;
3685             }
3686             }
3687              
3688             # 'type' is a required parameter.
3689 149 50       732 if ( not exists $param->{type} ) {
3690 0         0 carp "Parameter 'type' is required in conditional_formatting()";
3691 0         0 return -3;
3692             }
3693              
3694             # List of valid validation types.
3695 149         1820 my %valid_type = (
3696             'cell' => 'cellIs',
3697             'date' => 'date',
3698             'time' => 'time',
3699             'average' => 'aboveAverage',
3700             'duplicate' => 'duplicateValues',
3701             'unique' => 'uniqueValues',
3702             'top' => 'top10',
3703             'bottom' => 'top10',
3704             'text' => 'text',
3705             'time_period' => 'timePeriod',
3706             'blanks' => 'containsBlanks',
3707             'no_blanks' => 'notContainsBlanks',
3708             'errors' => 'containsErrors',
3709             'no_errors' => 'notContainsErrors',
3710             '2_color_scale' => '2_color_scale',
3711             '3_color_scale' => '3_color_scale',
3712             'data_bar' => 'dataBar',
3713             'formula' => 'expression',
3714             'icon_set' => 'iconSet',
3715             );
3716              
3717              
3718             # Check for valid validation types.
3719 149 50       571 if ( not exists $valid_type{ lc( $param->{type} ) } ) {
3720 0         0 carp "Unknown validation type '$param->{type}' for parameter "
3721             . "'type' in conditional_formatting()";
3722 0         0 return -3;
3723             }
3724             else {
3725 149 100       599 $param->{direction} = 'bottom' if $param->{type} eq 'bottom';
3726 149         688 $param->{type} = $valid_type{ lc( $param->{type} ) };
3727             }
3728              
3729              
3730             # List of valid criteria types.
3731 149         2223 my %criteria_type = (
3732             'between' => 'between',
3733             'not between' => 'notBetween',
3734             'equal to' => 'equal',
3735             '=' => 'equal',
3736             '==' => 'equal',
3737             'not equal to' => 'notEqual',
3738             '!=' => 'notEqual',
3739             '<>' => 'notEqual',
3740             'greater than' => 'greaterThan',
3741             '>' => 'greaterThan',
3742             'less than' => 'lessThan',
3743             '<' => 'lessThan',
3744             'greater than or equal to' => 'greaterThanOrEqual',
3745             '>=' => 'greaterThanOrEqual',
3746             'less than or equal to' => 'lessThanOrEqual',
3747             '<=' => 'lessThanOrEqual',
3748             'containing' => 'containsText',
3749             'not containing' => 'notContains',
3750             'begins with' => 'beginsWith',
3751             'ends with' => 'endsWith',
3752             'yesterday' => 'yesterday',
3753             'today' => 'today',
3754             'last 7 days' => 'last7Days',
3755             'last week' => 'lastWeek',
3756             'this week' => 'thisWeek',
3757             'next week' => 'nextWeek',
3758             'last month' => 'lastMonth',
3759             'this month' => 'thisMonth',
3760             'next month' => 'nextMonth',
3761             );
3762              
3763             # Check for valid criteria types.
3764 149 100 100     636 if ( defined $param->{criteria}
3765             && exists $criteria_type{ lc( $param->{criteria} ) } )
3766             {
3767 53         139 $param->{criteria} = $criteria_type{ lc( $param->{criteria} ) };
3768             }
3769              
3770             # Convert date/times value if required.
3771 149 100 66     718 if ( $param->{type} eq 'date' || $param->{type} eq 'time' ) {
3772 2         5 $param->{type} = 'cellIs';
3773              
3774 2 100 66     12 if ( defined $param->{value} && $param->{value} =~ /T/ ) {
3775 1         5 my $date_time = $self->convert_date_time( $param->{value} );
3776              
3777 1 50       4 if ( !defined $date_time ) {
3778 0         0 carp "Invalid date/time value '$param->{value}' "
3779             . "in conditional_formatting()";
3780 0         0 return -3;
3781             }
3782             else {
3783 1         9 $param->{value} = $date_time;
3784             }
3785             }
3786              
3787 2 100 66     13 if ( defined $param->{minimum} && $param->{minimum} =~ /T/ ) {
3788 1         6 my $date_time = $self->convert_date_time( $param->{minimum} );
3789              
3790 1 50       4 if ( !defined $date_time ) {
3791 0         0 carp "Invalid date/time value '$param->{minimum}' "
3792             . "in conditional_formatting()";
3793 0         0 return -3;
3794             }
3795             else {
3796 1         3 $param->{minimum} = $date_time;
3797             }
3798             }
3799              
3800 2 100 66     14 if ( defined $param->{maximum} && $param->{maximum} =~ /T/ ) {
3801 1         5 my $date_time = $self->convert_date_time( $param->{maximum} );
3802              
3803 1 50       4 if ( !defined $date_time ) {
3804 0         0 carp "Invalid date/time value '$param->{maximum}' "
3805             . "in conditional_formatting()";
3806 0         0 return -3;
3807             }
3808             else {
3809 1         4 $param->{maximum} = $date_time;
3810             }
3811             }
3812             }
3813              
3814              
3815             # List of valid icon styles.
3816 149         1753 my %icon_set_styles = (
3817             "3_arrows" => "3Arrows", # 1
3818             "3_flags" => "3Flags", # 2
3819             "3_traffic_lights_rimmed" => "3TrafficLights2", # 3
3820             "3_symbols_circled" => "3Symbols", # 4
3821             "4_arrows" => "4Arrows", # 5
3822             "4_red_to_black" => "4RedToBlack", # 6
3823             "4_traffic_lights" => "4TrafficLights", # 7
3824             "5_arrows_gray" => "5ArrowsGray", # 8
3825             "5_quarters" => "5Quarters", # 9
3826             "3_arrows_gray" => "3ArrowsGray", # 10
3827             "3_traffic_lights" => "3TrafficLights", # 11
3828             "3_signs" => "3Signs", # 12
3829             "3_symbols" => "3Symbols2", # 13
3830             "4_arrows_gray" => "4ArrowsGray", # 14
3831             "4_ratings" => "4Rating", # 15
3832             "5_arrows" => "5Arrows", # 16
3833             "5_ratings" => "5Rating", # 17
3834             );
3835              
3836              
3837             # Set properties for icon sets.
3838 149 100       430 if ( $param->{type} eq 'iconSet' ) {
3839              
3840 37 50       76 if ( !defined $param->{icon_style} ) {
3841 0         0 carp "The 'icon_style' parameter must be specified when "
3842             . "'type' == 'icon_set' in conditional_formatting()";
3843 0         0 return -3;
3844             }
3845              
3846             # Check for valid icon styles.
3847 37 50       82 if ( not exists $icon_set_styles{ $param->{icon_style} } ) {
3848 0         0 carp "Unknown icon style '$param->{icon_style}' for parameter "
3849             . "'icon_style' in conditional_formatting()";
3850 0         0 return -3;
3851             }
3852             else {
3853 37         73 $param->{icon_style} = $icon_set_styles{ $param->{icon_style} };
3854             }
3855              
3856             # Set the number of icons for the icon style.
3857 37         58 $param->{total_icons} = 3;
3858 37 100       135 if ( $param->{icon_style} =~ /^4/ ) {
    100          
3859 11         16 $param->{total_icons} = 4;
3860             }
3861             elsif ( $param->{icon_style} =~ /^5/ ) {
3862 8         26 $param->{total_icons} = 5;
3863             }
3864              
3865             $param->{icons} =
3866 37         114 $self->_set_icon_properties( $param->{total_icons}, $param->{icons} );
3867             }
3868              
3869              
3870             # Set the formatting range.
3871 149         300 my $range = '';
3872 149         280 my $start_cell = ''; # Use for formulas.
3873              
3874             # Swap last row/col for first row/col as necessary
3875 149 50       347 if ( $row1 > $row2 ) {
3876 0         0 ( $row1, $row2 ) = ( $row2, $row1 );
3877             }
3878              
3879 149 50       376 if ( $col1 > $col2 ) {
3880 0         0 ( $col1, $col2 ) = ( $col2, $col1 );
3881             }
3882              
3883             # If the first and last cell are the same write a single cell.
3884 149 100 100     567 if ( ( $row1 == $row2 ) && ( $col1 == $col2 ) ) {
3885 74         312 $range = xl_rowcol_to_cell( $row1, $col1 );
3886 74         150 $start_cell = $range;
3887             }
3888             else {
3889 75         294 $range = xl_range( $row1, $row2, $col1, $col2 );
3890 75         188 $start_cell = xl_rowcol_to_cell( $row1, $col1 );
3891             }
3892              
3893             # Override with user defined multiple range if provided.
3894 149 100       361 if ( $user_range ) {
3895 1         2 $range = $user_range;
3896             }
3897              
3898             # Get the dxf format index.
3899 149 100 66     634 if ( defined $param->{format} && ref $param->{format} ) {
3900 27         117 $param->{format} = $param->{format}->get_dxf_index();
3901             }
3902              
3903             # Set the priority based on the order of adding.
3904 149         357 $param->{priority} = $self->{_dxf_priority}++;
3905              
3906             # Check for 2010 style data_bar parameters.
3907 149 100 100     2455 if ( $self->{_use_data_bars_2010}
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
3908             || $param->{data_bar_2010}
3909             || $param->{bar_solid}
3910             || $param->{bar_border_color}
3911             || $param->{bar_negative_color}
3912             || $param->{bar_negative_color_same}
3913             || $param->{bar_negative_border_color}
3914             || $param->{bar_negative_border_color_same}
3915             || $param->{bar_no_border}
3916             || $param->{bar_axis_position}
3917             || $param->{bar_axis_color}
3918             || $param->{bar_direction} )
3919             {
3920 25         52 $param->{_is_data_bar_2010} = 1;
3921             }
3922              
3923             # Special handling of text criteria.
3924 149 100       436 if ( $param->{type} eq 'text' ) {
3925              
3926 8 100       28 if ( $param->{criteria} eq 'containsText' ) {
    100          
    100          
    50          
3927 1         2 $param->{type} = 'containsText';
3928             $param->{formula} = sprintf 'NOT(ISERROR(SEARCH("%s",%s)))',
3929 1         7 $param->{value}, $start_cell;
3930             }
3931             elsif ( $param->{criteria} eq 'notContains' ) {
3932 1         3 $param->{type} = 'notContainsText';
3933             $param->{formula} = sprintf 'ISERROR(SEARCH("%s",%s))',
3934 1         5 $param->{value}, $start_cell;
3935             }
3936             elsif ( $param->{criteria} eq 'beginsWith' ) {
3937 3         6 $param->{type} = 'beginsWith';
3938             $param->{formula} = sprintf 'LEFT(%s,%d)="%s"',
3939 3         16 $start_cell, length( $param->{value} ), $param->{value};
3940             }
3941             elsif ( $param->{criteria} eq 'endsWith' ) {
3942 3         6 $param->{type} = 'endsWith';
3943             $param->{formula} = sprintf 'RIGHT(%s,%d)="%s"',
3944 3         13 $start_cell, length( $param->{value} ), $param->{value};
3945             }
3946             else {
3947 0         0 carp "Invalid text criteria '$param->{criteria}' "
3948             . "in conditional_formatting()";
3949             }
3950             }
3951              
3952             # Special handling of time time_period criteria.
3953 149 100       397 if ( $param->{type} eq 'timePeriod' ) {
3954              
3955 10 100       44 if ( $param->{criteria} eq 'yesterday' ) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
3956 1         5 $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()-1', $start_cell;
3957             }
3958             elsif ( $param->{criteria} eq 'today' ) {
3959 1         4 $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()', $start_cell;
3960             }
3961             elsif ( $param->{criteria} eq 'tomorrow' ) {
3962 1         4 $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()+1', $start_cell;
3963             }
3964             elsif ( $param->{criteria} eq 'last7Days' ) {
3965             $param->{formula} =
3966 1         5 sprintf 'AND(TODAY()-FLOOR(%s,1)<=6,FLOOR(%s,1)<=TODAY())',
3967             $start_cell, $start_cell;
3968             }
3969             elsif ( $param->{criteria} eq 'lastWeek' ) {
3970             $param->{formula} =
3971 1         5 sprintf 'AND(TODAY()-ROUNDDOWN(%s,0)>=(WEEKDAY(TODAY())),'
3972             . 'TODAY()-ROUNDDOWN(%s,0)<(WEEKDAY(TODAY())+7))',
3973             $start_cell, $start_cell;
3974             }
3975             elsif ( $param->{criteria} eq 'thisWeek' ) {
3976             $param->{formula} =
3977 1         4 sprintf 'AND(TODAY()-ROUNDDOWN(%s,0)<=WEEKDAY(TODAY())-1,'
3978             . 'ROUNDDOWN(%s,0)-TODAY()<=7-WEEKDAY(TODAY()))',
3979             $start_cell, $start_cell;
3980             }
3981             elsif ( $param->{criteria} eq 'nextWeek' ) {
3982             $param->{formula} =
3983 1         14 sprintf 'AND(ROUNDDOWN(%s,0)-TODAY()>(7-WEEKDAY(TODAY())),'
3984             . 'ROUNDDOWN(%s,0)-TODAY()<(15-WEEKDAY(TODAY())))',
3985             $start_cell, $start_cell;
3986             }
3987             elsif ( $param->{criteria} eq 'lastMonth' ) {
3988             $param->{formula} =
3989 1         5 sprintf
3990             'AND(MONTH(%s)=MONTH(TODAY())-1,OR(YEAR(%s)=YEAR(TODAY()),'
3991             . 'AND(MONTH(%s)=1,YEAR(A1)=YEAR(TODAY())-1)))',
3992             $start_cell, $start_cell, $start_cell;
3993             }
3994             elsif ( $param->{criteria} eq 'thisMonth' ) {
3995             $param->{formula} =
3996 1         4 sprintf 'AND(MONTH(%s)=MONTH(TODAY()),YEAR(%s)=YEAR(TODAY()))',
3997             $start_cell, $start_cell;
3998             }
3999             elsif ( $param->{criteria} eq 'nextMonth' ) {
4000             $param->{formula} =
4001 1         5 sprintf
4002             'AND(MONTH(%s)=MONTH(TODAY())+1,OR(YEAR(%s)=YEAR(TODAY()),'
4003             . 'AND(MONTH(%s)=12,YEAR(%s)=YEAR(TODAY())+1)))',
4004             $start_cell, $start_cell, $start_cell, $start_cell;
4005             }
4006             else {
4007 0         0 carp "Invalid time_period criteria '$param->{criteria}' "
4008             . "in conditional_formatting()";
4009             }
4010             }
4011              
4012              
4013             # Special handling of blanks/error types.
4014 149 100       371 if ( $param->{type} eq 'containsBlanks' ) {
4015 1         5 $param->{formula} = sprintf 'LEN(TRIM(%s))=0', $start_cell;
4016             }
4017              
4018 149 100       350 if ( $param->{type} eq 'notContainsBlanks' ) {
4019 1         4 $param->{formula} = sprintf 'LEN(TRIM(%s))>0', $start_cell;
4020             }
4021              
4022 149 100       402 if ( $param->{type} eq 'containsErrors' ) {
4023 1         4 $param->{formula} = sprintf 'ISERROR(%s)', $start_cell;
4024             }
4025              
4026 149 100       435 if ( $param->{type} eq 'notContainsErrors' ) {
4027 1         5 $param->{formula} = sprintf 'NOT(ISERROR(%s))', $start_cell;
4028             }
4029              
4030              
4031             # Special handling for 2 color scale.
4032 149 100       418 if ( $param->{type} eq '2_color_scale' ) {
4033 1         3 $param->{type} = 'colorScale';
4034              
4035             # Color scales don't use any additional formatting.
4036 1         2 $param->{format} = undef;
4037              
4038             # Turn off 3 color parameters.
4039 1         2 $param->{mid_type} = undef;
4040 1         2 $param->{mid_color} = undef;
4041              
4042 1   50     6 $param->{min_type} ||= 'min';
4043 1   50     5 $param->{max_type} ||= 'max';
4044 1   50     6 $param->{min_value} ||= 0;
4045 1   50     4 $param->{max_value} ||= 0;
4046 1   50     11 $param->{min_color} ||= '#FF7128';
4047 1   50     6 $param->{max_color} ||= '#FFEF9C';
4048              
4049 1         4 $param->{max_color} = $self->_get_palette_color( $param->{max_color} );
4050 1         3 $param->{min_color} = $self->_get_palette_color( $param->{min_color} );
4051             }
4052              
4053              
4054             # Special handling for 3 color scale.
4055 149 100       416 if ( $param->{type} eq '3_color_scale' ) {
4056 4         11 $param->{type} = 'colorScale';
4057              
4058             # Color scales don't use any additional formatting.
4059 4         7 $param->{format} = undef;
4060              
4061 4   100     28 $param->{min_type} ||= 'min';
4062 4   100     18 $param->{mid_type} ||= 'percentile';
4063 4   100     17 $param->{max_type} ||= 'max';
4064 4   100     26 $param->{min_value} ||= 0;
4065 4 100       16 $param->{mid_value} = 50 unless defined $param->{mid_value};
4066 4   100     19 $param->{max_value} ||= 0;
4067 4   100     17 $param->{min_color} ||= '#F8696B';
4068 4   100     19 $param->{mid_color} ||= '#FFEB84';
4069 4   100     18 $param->{max_color} ||= '#63BE7B';
4070              
4071 4         17 $param->{max_color} = $self->_get_palette_color( $param->{max_color} );
4072 4         14 $param->{mid_color} = $self->_get_palette_color( $param->{mid_color} );
4073 4         19 $param->{min_color} = $self->_get_palette_color( $param->{min_color} );
4074             }
4075              
4076              
4077             # Special handling for data bar.
4078 149 100       387 if ( $param->{type} eq 'dataBar' ) {
4079              
4080             # Excel 2007 data bars don't use any additional formatting.
4081 29         56 $param->{format} = undef;
4082              
4083 29 100       91 if ( !defined $param->{min_type} ) {
4084 22         49 $param->{min_type} = 'min';
4085 22         58 $param->{_x14_min_type} = 'autoMin';
4086             }
4087             else {
4088 7         16 $param->{_x14_min_type} = $param->{min_type};
4089             }
4090              
4091 29 100       69 if ( !defined $param->{max_type} ) {
4092 23         51 $param->{max_type} = 'max';
4093 23         55 $param->{_x14_max_type} = 'autoMax';
4094             }
4095             else {
4096 6         11 $param->{_x14_max_type} = $param->{max_type};
4097             }
4098              
4099 29   100     143 $param->{min_value} ||= 0;
4100 29   100     117 $param->{max_value} ||= 0;
4101 29   100     93 $param->{bar_color} ||= '#638EC6';
4102 29   66     118 $param->{bar_border_color} ||= $param->{bar_color};
4103 29   100     134 $param->{bar_only} ||= 0;
4104 29   100     122 $param->{bar_no_border} ||= 0;
4105 29   100     138 $param->{bar_solid} ||= 0;
4106 29   100     115 $param->{bar_direction} ||= '';
4107 29   100     124 $param->{bar_negative_color} ||= '#FF0000';
4108 29   100     127 $param->{bar_negative_border_color} ||= '#FF0000';
4109 29   100     126 $param->{bar_negative_color_same} ||= 0;
4110 29   100     107 $param->{bar_negative_border_color_same} ||= 0;
4111 29   100     114 $param->{bar_axis_position} ||= '';
4112 29   100     119 $param->{bar_axis_color} ||= '#000000';
4113              
4114             $param->{bar_color} =
4115 29         110 $self->_get_palette_color( $param->{bar_color} );
4116              
4117             $param->{bar_border_color} =
4118 29         77 $self->_get_palette_color( $param->{bar_border_color} );
4119              
4120             $param->{bar_negative_color} =
4121 29         91 $self->_get_palette_color( $param->{bar_negative_color} );
4122              
4123             $param->{bar_negative_border_color} =
4124 29         88 $self->_get_palette_color( $param->{bar_negative_border_color} );
4125              
4126             $param->{bar_axis_color} =
4127 29         79 $self->_get_palette_color( $param->{bar_axis_color} );
4128              
4129             }
4130              
4131             # Adjust for 2010 style data_bar parameters.
4132 149 100       381 if ( $param->{_is_data_bar_2010} ) {
4133              
4134 25         52 $self->{_excel_version} = 2010;
4135              
4136 25 100 66     110 if ( $param->{min_type} eq 'min' && $param->{min_value} == 0 ) {
4137 20         37 $param->{min_value} = undef;
4138             }
4139              
4140 25 100 66     98 if ( $param->{max_type} eq 'max' && $param->{max_value} == 0 ) {
4141 21         47 $param->{max_value} = undef;
4142             }
4143              
4144             # Store range for Excel 2010 data bars.
4145 25         50 $param->{_range} = $range;
4146             }
4147              
4148             # Strip the leading = from formulas.
4149 149 100       396 $param->{min_value} =~ s/^=// if defined $param->{min_value};
4150 149 100       375 $param->{mid_value} =~ s/^=// if defined $param->{mid_value};
4151 149 100       362 $param->{max_value} =~ s/^=// if defined $param->{max_value};
4152              
4153             # Store the validation information until we close the worksheet.
4154 149         235 push @{ $self->{_cond_formats}->{$range} }, $param;
  149         2088  
4155             }
4156              
4157              
4158             ###############################################################################
4159             #
4160             # Set the sub-properties for icons.
4161             #
4162             sub _set_icon_properties {
4163              
4164 37     37   55 my $self = shift;
4165 37         53 my $total_icons = shift;
4166 37         66 my $user_props = shift;
4167 37         58 my $props = [];
4168              
4169             # Set the default icon properties.
4170 37         97 for ( 0 .. $total_icons - 1 ) {
4171 138         351 push @$props,
4172             {
4173             criteria => 0,
4174             value => 0,
4175             type => 'percent'
4176             };
4177             }
4178              
4179             # Set the default icon values based on the number of icons.
4180 37 100       82 if ( $total_icons == 3 ) {
4181 18         31 $props->[0]->{value} = 67;
4182 18         28 $props->[1]->{value} = 33;
4183             }
4184              
4185 37 100       76 if ( $total_icons == 4 ) {
4186 11         30 $props->[0]->{value} = 75;
4187 11         19 $props->[1]->{value} = 50;
4188 11         16 $props->[2]->{value} = 25;
4189             }
4190              
4191 37 100       75 if ( $total_icons == 5 ) {
4192 8         13 $props->[0]->{value} = 80;
4193 8         22 $props->[1]->{value} = 60;
4194 8         16 $props->[2]->{value} = 40;
4195 8         14 $props->[3]->{value} = 20;
4196             }
4197              
4198             # Overwrite default properties with user defined properties.
4199 37 100       70 if ( defined $user_props ) {
4200              
4201             # Ensure we don't set user properties for lowest icon.
4202 13         35 my $max_data = @$user_props;
4203 13 100       30 if ( $max_data >= $total_icons ) {
4204 2         2 $max_data = $total_icons -1;
4205             }
4206              
4207 13         29 for my $i ( 0 .. $max_data - 1 ) {
4208              
4209             # Set the user defined 'value' property.
4210 30 100       61 if ( defined $user_props->[$i]->{value} ) {
4211 24         47 $props->[$i]->{value} = $user_props->[$i]->{value};
4212 24         56 $props->[$i]->{value} =~ s/^=//;
4213             }
4214              
4215             # Set the user defined 'type' property.
4216 30 100       54 if ( defined $user_props->[$i]->{type} ) {
4217              
4218 14         21 my $type = $user_props->[$i]->{type};
4219              
4220 14 50 100     66 if ( $type ne 'percent'
      100        
      66        
4221             && $type ne 'percentile'
4222             && $type ne 'number'
4223             && $type ne 'formula' )
4224             {
4225 0         0 carp "Unknown icon property type '$props->{type}' for sub-"
4226             . "property 'type' in conditional_formatting()";
4227             }
4228             else {
4229 14         23 $props->[$i]->{type} = $type;
4230              
4231 14 100       31 if ( $props->[$i]->{type} eq 'number' ) {
4232 2         4 $props->[$i]->{type} = 'num';
4233             }
4234             }
4235             }
4236              
4237             # Set the user defined 'criteria' property.
4238 30 100 100     100 if ( defined $user_props->[$i]->{criteria}
4239             && $user_props->[$i]->{criteria} eq '>' )
4240             {
4241 7         14 $props->[$i]->{criteria} = 1;
4242             }
4243              
4244             }
4245              
4246             }
4247              
4248 37         79 return $props;
4249             }
4250              
4251              
4252             ###############################################################################
4253             #
4254             # add_table()
4255             #
4256             # Add an Excel table to a worksheet.
4257             #
4258             sub add_table {
4259              
4260 48     48 0 448 my $self = shift;
4261 48         109 my $user_range = '';
4262 48         100 my %table;
4263             my @col_formats;
4264              
4265             # We would need to order the write statements very carefully within this
4266             # function to support optimisation mode. Disable add_table() when it is
4267             # on for now.
4268 48 50       227 if ( $self->{_optimization} == 1 ) {
4269 0         0 carp "add_table() isn't supported when set_optimization() is on";
4270 0         0 return -1;
4271             }
4272              
4273             # Check for a cell reference in A1 notation and substitute row and column
4274 48 50 33     382 if ( @_ && $_[0] =~ /^\D/ ) {
4275 48         195 @_ = $self->_substitute_cellref( @_ );
4276             }
4277              
4278             # Check for a valid number of args.
4279 48 50       184 if ( @_ < 4 ) {
4280 0         0 carp "Not enough parameters to add_table()";
4281 0         0 return -1;
4282             }
4283              
4284 48         184 my ( $row1, $col1, $row2, $col2 ) = @_;
4285              
4286             # Check that row and col are valid without storing the values.
4287 48 50       188 return -2 if $self->_check_dimensions( $row1, $col1, 1, 1 );
4288 48 50       166 return -2 if $self->_check_dimensions( $row2, $col2, 1, 1 );
4289              
4290              
4291             # The final hashref contains the validation parameters.
4292 48   100     238 my $param = $_[4] || {};
4293              
4294             # Check that the last parameter is a hash list.
4295 48 50       360 if ( ref $param ne 'HASH' ) {
4296 0         0 carp "Last parameter '$param' in add_table() must be a hash ref";
4297 0         0 return -3;
4298             }
4299              
4300              
4301             # List of valid input parameters.
4302 48         733 my %valid_parameter = (
4303             autofilter => 1,
4304             banded_columns => 1,
4305             banded_rows => 1,
4306             columns => 1,
4307             data => 1,
4308             first_column => 1,
4309             header_row => 1,
4310             last_column => 1,
4311             name => 1,
4312             style => 1,
4313             total_row => 1,
4314             );
4315              
4316             # Check for valid input parameters.
4317 48         315 for my $param_key ( keys %$param ) {
4318 44 50       143 if ( not exists $valid_parameter{$param_key} ) {
4319 0         0 carp "Unknown parameter '$param_key' in add_table()";
4320 0         0 return -3;
4321             }
4322             }
4323              
4324             # Turn on Excel's defaults.
4325 48 100       828 $param->{banded_rows} = 1 if !defined $param->{banded_rows};
4326 48 100       1078 $param->{header_row} = 1 if !defined $param->{header_row};
4327 48 100       542 $param->{autofilter} = 1 if !defined $param->{autofilter};
4328              
4329             # Set the table options.
4330 48 100       196 $table{_show_first_col} = $param->{first_column} ? 1 : 0;
4331 48 100       178 $table{_show_last_col} = $param->{last_column} ? 1 : 0;
4332 48 100       151 $table{_show_row_stripes} = $param->{banded_rows} ? 1 : 0;
4333 48 100       123 $table{_show_col_stripes} = $param->{banded_columns} ? 1 : 0;
4334 48 100       154 $table{_header_row_count} = $param->{header_row} ? 1 : 0;
4335 48 100       139 $table{_totals_row_shown} = $param->{total_row} ? 1 : 0;
4336              
4337              
4338             # Set the table name.
4339 48 100       163 if ( defined $param->{name} ) {
4340 1         2 my $name = $param->{name};
4341              
4342             # Warn if the name contains invalid chars as defined by Excel help.
4343 1 50 33     10 if ( $name !~ m/^[\w\\][\w\\.]*$/ || $name =~ m/^\d/ ) {
4344 0         0 carp "Invalid character in name '$name' used in add_table()";
4345 0         0 return -3;
4346             }
4347              
4348             # Warn if the name looks like a cell name.
4349 1 50       5 if ( $name =~ m/^[a-zA-Z][a-zA-Z]?[a-dA-D]?[0-9]+$/ ) {
4350 0         0 carp "Invalid name '$name' looks like a cell name in add_table()";
4351 0         0 return -3;
4352             }
4353              
4354             # Warn if the name looks like a R1C1.
4355 1 50 33     7 if ( $name =~ m/^[rcRC]$/ || $name =~ m/^[rcRC]\d+[rcRC]\d+$/ ) {
4356 0         0 carp "Invalid name '$name' like a RC cell ref in add_table()";
4357 0         0 return -3;
4358             }
4359              
4360 1         3 $table{_name} = $param->{name};
4361             }
4362              
4363             # Set the table style.
4364 48 100       147 if ( defined $param->{style} ) {
4365 3         10 $table{_style} = $param->{style};
4366              
4367             # Remove whitespace from style name.
4368 3         20 $table{_style} =~ s/\s//g;
4369             }
4370             else {
4371 45         106 $table{_style} = "TableStyleMedium9";
4372             }
4373              
4374              
4375             # Swap last row/col for first row/col as necessary.
4376 48 50       145 if ( $row1 > $row2 ) {
4377 0         0 ( $row1, $row2 ) = ( $row2, $row1 );
4378             }
4379              
4380 48 50       143 if ( $col1 > $col2 ) {
4381 0         0 ( $col1, $col2 ) = ( $col2, $col1 );
4382             }
4383              
4384              
4385             # Set the data range rows (without the header and footer).
4386 48         88 my $first_data_row = $row1;
4387 48         83 my $last_data_row = $row2;
4388 48 100       138 $first_data_row++ if $param->{header_row};
4389 48 100       145 $last_data_row-- if $param->{total_row};
4390              
4391              
4392             # Set the table and autofilter ranges.
4393 48         269 $table{_range} = xl_range( $row1, $row2, $col1, $col2 );
4394 48         147 $table{_a_range} = xl_range( $row1, $last_data_row, $col1, $col2 );
4395              
4396              
4397             # If the header row if off the default is to turn autofilter off.
4398 48 100       156 if ( !$param->{header_row} ) {
4399 3         7 $param->{autofilter} = 0;
4400             }
4401              
4402             # Set the autofilter range.
4403 48 100       137 if ( $param->{autofilter} ) {
4404 44         112 $table{_autofilter} = $table{_a_range};
4405             }
4406              
4407             # Add the table columns.
4408 48         76 my %seen_names;
4409 48         85 my $col_id = 1;
4410 48         134 for my $col_num ( $col1 .. $col2 ) {
4411              
4412             # Set up the default column data.
4413 212         1083 my $col_data = {
4414             _id => $col_id,
4415             _name => 'Column' . $col_id,
4416             _total_string => '',
4417             _total_function => '',
4418             _formula => '',
4419             _format => undef,
4420             _name_format => undef,
4421             };
4422              
4423             # Overwrite the defaults with any use defined values.
4424 212 100       519 if ( $param->{columns} ) {
4425              
4426             # Check if there are user defined values for this column.
4427 85 100       215 if ( my $user_data = $param->{columns}->[ $col_id - 1 ] ) {
4428              
4429             # Map user defined values to internal values.
4430             $col_data->{_name} = $user_data->{header}
4431 84 100       180 if $user_data->{header};
4432              
4433             # Excel requires unique case insensitive header names.
4434 84         133 my $name = $col_data->{_name};
4435 84         151 my $key = lc $name;
4436 84 100       168 if (exists $seen_names{$key}) {
4437 1         222 carp "add_table() contains duplicate name: '$name'";
4438 1         38 return -1;
4439             }
4440             else {
4441 83         164 $seen_names{$key} = 1;
4442             }
4443              
4444             # Get the header format if defined.
4445 83         145 $col_data->{_name_format} = $user_data->{header_format};
4446              
4447             # Handle the column formula.
4448 83 100       172 if ( $user_data->{formula} ) {
4449 3         7 my $formula = $user_data->{formula};
4450              
4451             # Remove the leading = from formula.
4452 3         10 $formula =~ s/^=//;
4453              
4454             # Covert Excel 2010 "@" ref to 2007 "#This Row".
4455 3         10 $formula =~ s/@/[#This Row],/g;
4456              
4457 3         7 $col_data->{_formula} = $formula;
4458              
4459 3         9 for my $row ( $first_data_row .. $last_data_row ) {
4460             $self->write_formula( $row, $col_num, $formula,
4461 24         47 $user_data->{format} );
4462             }
4463             }
4464              
4465             # Handle the function for the total row.
4466 83 100       225 if ( $user_data->{total_function} ) {
    100          
4467 40         84 my $function = $user_data->{total_function};
4468              
4469             # Massage the function name.
4470 40         72 $function = lc $function;
4471 40         96 $function =~ s/_//g;
4472 40         107 $function =~ s/\s//g;
4473              
4474 40 100       100 $function = 'countNums' if $function eq 'countnums';
4475 40 100       82 $function = 'stdDev' if $function eq 'stddev';
4476              
4477 40         69 $col_data->{_total_function} = $function;
4478              
4479             my $formula = _table_function_to_formula(
4480             $function,
4481             $col_data->{_name}
4482              
4483 40         104 );
4484              
4485 40   100     308 my $value = $user_data->{total_value} || 0;
4486              
4487             $self->write_formula( $row2, $col_num, $formula,
4488 40         134 $user_data->{format}, $value );
4489              
4490             }
4491             elsif ( $user_data->{total_string} ) {
4492              
4493             # Total label only (not a function).
4494 9         28 my $total_string = $user_data->{total_string};
4495 9         23 $col_data->{_total_string} = $total_string;
4496              
4497             $self->write_string( $row2, $col_num, $total_string,
4498 9         72 $user_data->{format} );
4499             }
4500              
4501             # Get the dxf format index.
4502 83 100 66     290 if ( defined $user_data->{format} && ref $user_data->{format} )
4503             {
4504             $col_data->{_format} =
4505 9         148 $user_data->{format}->get_dxf_index();
4506             }
4507              
4508             # Store the column format for writing the cell data.
4509             # It doesn't matter if it is undefined.
4510 83         209 $col_formats[ $col_id - 1 ] = $user_data->{format};
4511             }
4512             }
4513              
4514             # Store the column data.
4515 211         286 push @{ $table{_columns} }, $col_data;
  211         412  
4516              
4517             # Write the column headers to the worksheet.
4518 211 100       447 if ( $param->{header_row} ) {
4519             $self->write_string( $row1, $col_num, $col_data->{_name},
4520 201         535 $col_data->{_name_format} );
4521             }
4522              
4523 211         366 $col_id++;
4524             } # Table columns.
4525              
4526              
4527             # Write the cell data if supplied.
4528 47 100       175 if ( my $data = $param->{data} ) {
4529              
4530 6         14 my $i = 0; # For indexing the row data.
4531 6         19 for my $row ( $first_data_row .. $last_data_row ) {
4532 22         31 my $j = 0; # For indexing the col data.
4533              
4534 22         36 for my $col ( $col1 .. $col2 ) {
4535              
4536 84         140 my $token = $data->[$i]->[$j];
4537              
4538 84 100       145 if ( defined $token ) {
4539 77         158 $self->write( $row, $col, $token, $col_formats[$j] );
4540             }
4541              
4542 84         152 $j++;
4543             }
4544 22         39 $i++;
4545             }
4546             }
4547              
4548              
4549             # Store the table data.
4550 47         94 push @{ $self->{_tables} }, \%table;
  47         155  
4551              
4552 47         277 return \%table;
4553             }
4554              
4555              
4556             ###############################################################################
4557             #
4558             # add_sparkline()
4559             #
4560             # Add sparklines to the worksheet.
4561             #
4562             sub add_sparkline {
4563              
4564 58     58 0 444 my $self = shift;
4565 58         98 my $param = shift;
4566 58         93 my $sparkline = {};
4567              
4568             # Check that the last parameter is a hash list.
4569 58 50       176 if ( ref $param ne 'HASH' ) {
4570 0         0 carp "Parameter list in add_sparkline() must be a hash ref";
4571 0         0 return -1;
4572             }
4573              
4574             # List of valid input parameters.
4575 58         662 my %valid_parameter = (
4576             location => 1,
4577             range => 1,
4578             type => 1,
4579             high_point => 1,
4580             low_point => 1,
4581             negative_points => 1,
4582             first_point => 1,
4583             last_point => 1,
4584             markers => 1,
4585             style => 1,
4586             series_color => 1,
4587             negative_color => 1,
4588             markers_color => 1,
4589             first_color => 1,
4590             last_color => 1,
4591             high_color => 1,
4592             low_color => 1,
4593             max => 1,
4594             min => 1,
4595             axis => 1,
4596             reverse => 1,
4597             empty_cells => 1,
4598             show_hidden => 1,
4599             plot_hidden => 1,
4600             date_axis => 1,
4601             weight => 1,
4602             );
4603              
4604             # Check for valid input parameters.
4605 58         209 for my $param_key ( keys %$param ) {
4606 212 50       425 if ( not exists $valid_parameter{$param_key} ) {
4607 0         0 carp "Unknown parameter '$param_key' in add_sparkline()";
4608 0         0 return -2;
4609             }
4610             }
4611              
4612             # 'location' is a required parameter.
4613 58 50       157 if ( not exists $param->{location} ) {
4614 0         0 carp "Parameter 'location' is required in add_sparkline()";
4615 0         0 return -3;
4616             }
4617              
4618             # 'range' is a required parameter.
4619 58 50       134 if ( not exists $param->{range} ) {
4620 0         0 carp "Parameter 'range' is required in add_sparkline()";
4621 0         0 return -3;
4622             }
4623              
4624              
4625             # Handle the sparkline type.
4626 58   100     185 my $type = $param->{type} || 'line';
4627              
4628 58 50 100     234 if ( $type ne 'line' && $type ne 'column' && $type ne 'win_loss' ) {
      66        
4629 0         0 carp "Parameter 'type' must be 'line', 'column' "
4630             . "or 'win_loss' in add_sparkline()";
4631 0         0 return -4;
4632             }
4633              
4634 58 100       130 $type = 'stacked' if $type eq 'win_loss';
4635 58         139 $sparkline->{_type} = $type;
4636              
4637              
4638             # We handle single location/range values or array refs of values.
4639 58 100       139 if ( ref $param->{location} ) {
4640 2         6 $sparkline->{_locations} = $param->{location};
4641 2         5 $sparkline->{_ranges} = $param->{range};
4642             }
4643             else {
4644 56         135 $sparkline->{_locations} = [ $param->{location} ];
4645 56         135 $sparkline->{_ranges} = [ $param->{range} ];
4646             }
4647              
4648 58         80 my $range_count = @{ $sparkline->{_ranges} };
  58         115  
4649 58         81 my $location_count = @{ $sparkline->{_locations} };
  58         102  
4650              
4651             # The ranges and locations must match.
4652 58 50       124 if ( $range_count != $location_count ) {
4653 0         0 carp "Must have the same number of location and range "
4654             . "parameters in add_sparkline()";
4655 0         0 return -5;
4656             }
4657              
4658             # Store the count.
4659 58         82 $sparkline->{_count} = @{ $sparkline->{_locations} };
  58         114  
4660              
4661             # Get the worksheet name for the range conversion below.
4662 58         203 my $sheetname = quote_sheetname( $self->{_name} );
4663              
4664             # Cleanup the input ranges.
4665 58         106 for my $range ( @{ $sparkline->{_ranges} } ) {
  58         130  
4666              
4667             # Remove the absolute reference $ symbols.
4668 59         141 $range =~ s{\$}{}g;
4669              
4670             # Remove the = from xl_range_formula(.
4671 59         90 $range =~ s{^=}{};
4672              
4673             # Convert a simple range into a full Sheet1!A1:D1 range.
4674 59 100       153 if ( $range !~ /!/ ) {
4675 54         152 $range = $sheetname . "!" . $range;
4676             }
4677             }
4678              
4679             # Cleanup the input locations.
4680 58         99 for my $location ( @{ $sparkline->{_locations} } ) {
  58         153  
4681 59         114 $location =~ s{\$}{}g;
4682             }
4683              
4684             # Map options.
4685 58         121 $sparkline->{_high} = $param->{high_point};
4686 58         113 $sparkline->{_low} = $param->{low_point};
4687 58         94 $sparkline->{_negative} = $param->{negative_points};
4688 58         184 $sparkline->{_first} = $param->{first_point};
4689 58         106 $sparkline->{_last} = $param->{last_point};
4690 58         103 $sparkline->{_markers} = $param->{markers};
4691 58         116 $sparkline->{_min} = $param->{min};
4692 58         116 $sparkline->{_max} = $param->{max};
4693 58         94 $sparkline->{_axis} = $param->{axis};
4694 58         94 $sparkline->{_reverse} = $param->{reverse};
4695 58         99 $sparkline->{_hidden} = $param->{show_hidden};
4696 58         155 $sparkline->{_weight} = $param->{weight};
4697              
4698             # Map empty cells options.
4699 58   100     209 my $empty = $param->{empty_cells} || '';
4700              
4701 58 100       168 if ( $empty eq 'zero' ) {
    100          
4702 1         12 $sparkline->{_empty} = 0;
4703             }
4704             elsif ( $empty eq 'connect' ) {
4705 1         9 $sparkline->{_empty} = 'span';
4706             }
4707             else {
4708 56         113 $sparkline->{_empty} = 'gap';
4709             }
4710              
4711              
4712             # Map the date axis range.
4713 58         99 my $date_range = $param->{date_axis};
4714              
4715 58 100 66     175 if ( $date_range && $date_range !~ /!/ ) {
4716 1         3 $date_range = $sheetname . "!" . $date_range;
4717             }
4718 58         102 $sparkline->{_date_axis} = $date_range;
4719              
4720              
4721             # Set the sparkline styles.
4722 58   100     155 my $style_id = $param->{style} || 0;
4723 58         114 my $style = $Excel::Writer::XLSX::Package::Theme::spark_styles[$style_id];
4724              
4725 58         135 $sparkline->{_series_color} = $style->{series};
4726 58         113 $sparkline->{_negative_color} = $style->{negative};
4727 58         113 $sparkline->{_markers_color} = $style->{markers};
4728 58         118 $sparkline->{_first_color} = $style->{first};
4729 58         112 $sparkline->{_last_color} = $style->{last};
4730 58         102 $sparkline->{_high_color} = $style->{high};
4731 58         101 $sparkline->{_low_color} = $style->{low};
4732              
4733             # Override the style colours with user defined colors.
4734 58         226 $self->_set_spark_color( $sparkline, $param, 'series_color' );
4735 58         142 $self->_set_spark_color( $sparkline, $param, 'negative_color' );
4736 58         132 $self->_set_spark_color( $sparkline, $param, 'markers_color' );
4737 58         133 $self->_set_spark_color( $sparkline, $param, 'first_color' );
4738 58         136 $self->_set_spark_color( $sparkline, $param, 'last_color' );
4739 58         142 $self->_set_spark_color( $sparkline, $param, 'high_color' );
4740 58         136 $self->_set_spark_color( $sparkline, $param, 'low_color' );
4741              
4742 58         82 push @{ $self->{_sparklines} }, $sparkline;
  58         358  
4743             }
4744              
4745              
4746             ###############################################################################
4747             #
4748             # insert_button()
4749             #
4750             # Insert a button form object into the worksheet.
4751             #
4752             sub insert_button {
4753              
4754 28     28 0 183 my $self = shift;
4755              
4756             # Check for a cell reference in A1 notation and substitute row and column
4757 28 50       127 if ( $_[0] =~ /^\D/ ) {
4758 28         107 @_ = $self->_substitute_cellref( @_ );
4759             }
4760              
4761             # Check the number of args.
4762 28 50       108 if ( @_ < 3 ) { return -1 }
  0         0  
4763              
4764 28         114 my $button = $self->_button_params( @_ );
4765              
4766 28         45 push @{ $self->{_buttons_array} }, $button;
  28         64  
4767              
4768 28         101 $self->{_has_vml} = 1;
4769             }
4770              
4771              
4772             ###############################################################################
4773             #
4774             # set_vba_name()
4775             #
4776             # Set the VBA name for the worksheet.
4777             #
4778             sub set_vba_name {
4779              
4780 7     7 0 26 my $self = shift;
4781 7         10 my $vba_codename = shift;
4782              
4783 7 100       25 if ( $vba_codename ) {
4784 2         16 $self->{_vba_codename} = $vba_codename;
4785             }
4786             else {
4787 5         28 $self->{_vba_codename} = "Sheet" . ($self->{_index} + 1);
4788             }
4789             }
4790              
4791              
4792             ###############################################################################
4793             #
4794             # Internal methods.
4795             #
4796             ###############################################################################
4797              
4798              
4799             ###############################################################################
4800             #
4801             # _table_function_to_formula
4802             #
4803             # Convert a table total function to a worksheet formula.
4804             #
4805             sub _table_function_to_formula {
4806              
4807 40     40   67 my $function = shift;
4808 40         64 my $col_name = shift;
4809 40         60 my $formula = '';
4810              
4811             # Escape special characters, as required by Excel.
4812 40         63 $col_name =~ s/'/''/g;
4813 40         64 $col_name =~ s/#/'#/g;
4814 40         58 $col_name =~ s/\[/'[/g;
4815 40         70 $col_name =~ s/]/']/g;
4816              
4817 40         204 my %subtotals = (
4818             average => 101,
4819             countNums => 102,
4820             count => 103,
4821             max => 104,
4822             min => 105,
4823             stdDev => 107,
4824             sum => 109,
4825             var => 110,
4826             );
4827              
4828 40 50       102 if ( exists $subtotals{$function} ) {
4829 40         65 my $func_num = $subtotals{$function};
4830 40         134 $formula = qq{SUBTOTAL($func_num,[$col_name])};
4831             }
4832             else {
4833 0         0 carp "Unsupported function '$function' in add_table()";
4834             }
4835              
4836 40         120 return $formula;
4837             }
4838              
4839              
4840             ###############################################################################
4841             #
4842             # _set_spark_color()
4843             #
4844             # Set the sparkline colour.
4845             #
4846             sub _set_spark_color {
4847              
4848 406     406   563 my $self = shift;
4849 406         535 my $sparkline = shift;
4850 406         609 my $param = shift;
4851 406         549 my $user_color = shift;
4852 406         631 my $spark_color = '_' . $user_color;
4853              
4854 406 100       812 return unless $param->{$user_color};
4855              
4856             $sparkline->{$spark_color} =
4857 8         20 { _rgb => $self->_get_palette_color( $param->{$user_color} ) };
4858             }
4859              
4860              
4861             ###############################################################################
4862             #
4863             # _get_palette_color()
4864             #
4865             # Convert from an Excel internal colour index to a XML style #RRGGBB index
4866             # based on the default or user defined values in the Workbook palette.
4867             #
4868             sub _get_palette_color {
4869              
4870 173     173   242 my $self = shift;
4871 173         225 my $index = shift;
4872 173         258 my $palette = $self->{_palette};
4873              
4874             # Handle colours in #XXXXXX RGB format.
4875 173 100       524 if ( $index =~ m/^#([0-9A-F]{6})$/i ) {
4876 167         522 return "FF" . uc( $1 );
4877             }
4878              
4879             # Adjust the colour index.
4880 6         16 $index -= 8;
4881              
4882             # Palette is passed in from the Workbook class.
4883 6         12 my @rgb = @{ $palette->[$index] };
  6         19  
4884              
4885 6         48 return sprintf "FF%02X%02X%02X", @rgb[0, 1, 2];
4886             }
4887              
4888              
4889             ###############################################################################
4890             #
4891             # _substitute_cellref()
4892             #
4893             # Substitute an Excel cell reference in A1 notation for zero based row and
4894             # column values in an argument list.
4895             #
4896             # Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
4897             #
4898             sub _substitute_cellref {
4899              
4900 2527     2527   4407 my $self = shift;
4901 2527         5772 my $cell = uc( shift );
4902              
4903             # Convert a column range: 'A:A' or 'B:G'.
4904             # A range such as A:A is equivalent to A1:Rowmax, so add rows as required
4905 2527 100       7898 if ( $cell =~ /\$?([A-Z]{1,3}):\$?([A-Z]{1,3})/ ) {
4906 191         1059 my ( $row1, $col1 ) = $self->_cell_to_rowcol( $1 . '1' );
4907             my ( $row2, $col2 ) =
4908 191         1135 $self->_cell_to_rowcol( $2 . $self->{_xls_rowmax} );
4909 191         799 return $row1, $col1, $row2, $col2, @_;
4910             }
4911              
4912             # Convert a cell range: 'A1:B7'
4913 2336 100       7839 if ( $cell =~ /\$?([A-Z]{1,3}\$?\d+):\$?([A-Z]{1,3}\$?\d+)/ ) {
4914 195         668 my ( $row1, $col1 ) = $self->_cell_to_rowcol( $1 );
4915 195         677 my ( $row2, $col2 ) = $self->_cell_to_rowcol( $2 );
4916 195         967 return $row1, $col1, $row2, $col2, @_;
4917             }
4918              
4919             # Convert a cell reference: 'A1' or 'AD2000'
4920 2141 50       9484 if ( $cell =~ /\$?([A-Z]{1,3}\$?\d+)/ ) {
4921 2141         6623 my ( $row1, $col1 ) = $self->_cell_to_rowcol( $1 );
4922 2141         8805 return $row1, $col1, @_;
4923              
4924             }
4925              
4926 0         0 croak( "Unknown cell reference $cell" );
4927             }
4928              
4929              
4930             ###############################################################################
4931             #
4932             # _cell_to_rowcol($cell_ref)
4933             #
4934             # Convert an Excel cell reference in A1 notation to a zero based row and column
4935             # reference; converts C1 to (0, 2).
4936             #
4937             # See also: http://www.perlmonks.org/index.pl?node_id=270352
4938             #
4939             # Returns: ($row, $col, $row_absolute, $col_absolute)
4940             #
4941             #
4942             sub _cell_to_rowcol {
4943              
4944 2913     2913   4930 my $self = shift;
4945              
4946 2913         6660 my $cell = $_[0];
4947 2913         8293 $cell =~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/;
4948              
4949 2913 50       8872 my $col_abs = $1 eq "" ? 0 : 1;
4950 2913         6052 my $col = $2;
4951 2913 100       7596 my $row_abs = $3 eq "" ? 0 : 1;
4952 2913         10866 my $row = $4;
4953              
4954             # Convert base26 column string to number
4955             # All your Base are belong to us.
4956 2913         8615 my @chars = split //, $col;
4957 2913         4856 my $expn = 0;
4958 2913         4675 $col = 0;
4959              
4960 2913         7543 while ( @chars ) {
4961 2955         5539 my $char = pop( @chars ); # LS char first
4962 2955         7990 $col += ( ord( $char ) - ord( 'A' ) + 1 ) * ( 26**$expn );
4963 2955         6688 $expn++;
4964             }
4965              
4966             # Convert 1-index to zero-index
4967 2913         6884 $row--;
4968 2913         4397 $col--;
4969              
4970             # TODO Check row and column range
4971 2913         8662 return $row, $col, $row_abs, $col_abs;
4972             }
4973              
4974              
4975             ###############################################################################
4976             #
4977             # _xl_rowcol_to_cell($row, $col)
4978             #
4979             # Optimised version of xl_rowcol_to_cell from Utility.pm for the inner loop
4980             # of _write_cell().
4981             #
4982              
4983             our @col_names = ( 'A' .. 'XFD' );
4984              
4985             sub _xl_rowcol_to_cell {
4986 10531     10531   24558 return $col_names[ $_[1] ] . ( $_[0] + 1 );
4987             }
4988              
4989              
4990             ###############################################################################
4991             #
4992             # _sort_pagebreaks()
4993             #
4994             # This is an internal method that is used to filter elements of the array of
4995             # pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
4996             # 1. Removes duplicate entries from the list.
4997             # 2. Sorts the list.
4998             # 3. Removes 0 from the list if present.
4999             #
5000             sub _sort_pagebreaks {
5001              
5002 2070     2070   3754 my $self = shift;
5003              
5004 2070 100       7092 return () unless @_;
5005              
5006 11         24 my %hash;
5007             my @array;
5008              
5009 11         904 @hash{@_} = undef; # Hash slice to remove duplicates
5010 11         187 @array = sort { $a <=> $b } keys %hash; # Numerical sort
  9029         12707  
5011 11 100       89 shift @array if $array[0] == 0; # Remove zero
5012              
5013             # The Excel 2007 specification says that the maximum number of page breaks
5014             # is 1026. However, in practice it is actually 1023.
5015 11         21 my $max_num_breaks = 1023;
5016 11 100       42 splice( @array, $max_num_breaks ) if @array > $max_num_breaks;
5017              
5018 11         245 return @array;
5019             }
5020              
5021              
5022             ###############################################################################
5023             #
5024             # _check_dimensions($row, $col, $ignore_row, $ignore_col)
5025             #
5026             # Check that $row and $col are valid and store max and min values for use in
5027             # other methods/elements.
5028             #
5029             # The $ignore_row/$ignore_col flags is used to indicate that we wish to
5030             # perform the dimension check without storing the value.
5031             #
5032             # The ignore flags are use by set_row() and data_validate.
5033             #
5034             sub _check_dimensions {
5035              
5036 16607     16607   20612 my $self = shift;
5037 16607         21231 my $row = $_[0];
5038 16607         19944 my $col = $_[1];
5039 16607         19888 my $ignore_row = $_[2];
5040 16607         19759 my $ignore_col = $_[3];
5041              
5042              
5043 16607 50       26512 return -2 if not defined $row;
5044 16607 100       29195 return -2 if $row >= $self->{_xls_rowmax};
5045              
5046 16594 50       25894 return -2 if not defined $col;
5047 16594 100       27120 return -2 if $col >= $self->{_xls_colmax};
5048              
5049             # In optimization mode we don't change dimensions for rows that are
5050             # already written.
5051 16584 100 66     59938 if ( !$ignore_row && !$ignore_col && $self->{_optimization} == 1 ) {
      100        
5052 318 100       601 return -2 if $row < $self->{_previous_row};
5053             }
5054              
5055 16579 100       26569 if ( !$ignore_row ) {
5056              
5057 15651 100 100     42214 if ( not defined $self->{_dim_rowmin} or $row < $self->{_dim_rowmin} ) {
5058 833         2204 $self->{_dim_rowmin} = $row;
5059             }
5060              
5061 15651 100 100     42614 if ( not defined $self->{_dim_rowmax} or $row > $self->{_dim_rowmax} ) {
5062 4677         8238 $self->{_dim_rowmax} = $row;
5063             }
5064             }
5065              
5066 16579 100       25993 if ( !$ignore_col ) {
5067              
5068 15699 100 100     41059 if ( not defined $self->{_dim_colmin} or $col < $self->{_dim_colmin} ) {
5069 840         2361 $self->{_dim_colmin} = $col;
5070             }
5071              
5072 15699 100 100     41241 if ( not defined $self->{_dim_colmax} or $col > $self->{_dim_colmax} ) {
5073 2318         4455 $self->{_dim_colmax} = $col;
5074             }
5075             }
5076              
5077 16579         31973 return 0;
5078             }
5079              
5080              
5081             ###############################################################################
5082             #
5083             # _position_object_pixels()
5084             #
5085             # Calculate the vertices that define the position of a graphical object within
5086             # the worksheet in pixels.
5087             #
5088             # +------------+------------+
5089             # | A | B |
5090             # +-----+------------+------------+
5091             # | |(x1,y1) | |
5092             # | 1 |(A1)._______|______ |
5093             # | | | | |
5094             # | | | | |
5095             # +-----+----| Object |-----+
5096             # | | | | |
5097             # | 2 | |______________. |
5098             # | | | (B2)|
5099             # | | | (x2,y2)|
5100             # +---- +------------+------------+
5101             #
5102             # Example of an object that covers some of the area from cell A1 to cell B2.
5103             #
5104             # Based on the width and height of the object we need to calculate 8 vars:
5105             #
5106             # $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2.
5107             #
5108             # We also calculate the absolute x and y position of the top left vertex of
5109             # the object. This is required for images.
5110             #
5111             # $x_abs, $y_abs
5112             #
5113             # The width and height of the cells that the object occupies can be variable
5114             # and have to be taken into account.
5115             #
5116             # The values of $col_start and $row_start are passed in from the calling
5117             # function. The values of $col_end and $row_end are calculated by subtracting
5118             # the width and height of the object from the width and height of the
5119             # underlying cells.
5120             #
5121             # The anchor/object position defines how images are scaled for hidden rows and
5122             # columns. For option 1 "Move and size with cells" the size of the hidden
5123             # row/column is subtracted from the image.
5124             #
5125             sub _position_object_pixels {
5126              
5127 4748     4748   6836 my $self = shift;
5128              
5129 4748         28485 my $col_start; # Col containing upper left corner of object.
5130             my $x1; # Distance to left side of object.
5131              
5132 4748         0 my $row_start; # Row containing top left corner of object.
5133 4748         0 my $y1; # Distance to top of object.
5134              
5135 4748         0 my $col_end; # Col containing lower right corner of object.
5136 4748         0 my $x2; # Distance to right side of object.
5137              
5138 4748         0 my $row_end; # Row containing bottom right corner of object.
5139 4748         0 my $y2; # Distance to bottom of object.
5140              
5141 4748         0 my $width; # Width of object frame.
5142 4748         0 my $height; # Height of object frame.
5143              
5144 4748         6121 my $x_abs = 0; # Absolute distance to left side of object.
5145 4748         5466 my $y_abs = 0; # Absolute distance to top side of object.
5146              
5147 4748         5732 my $anchor; # The type of object positioning.
5148              
5149 4748         8996 ( $col_start, $row_start, $x1, $y1, $width, $height, $anchor ) = @_;
5150              
5151             # Adjust start column for negative offsets.
5152 4748   100     11050 while ( $x1 < 0 && $col_start > 0) {
5153 8         25 $x1 += $self->_size_col( $col_start - 1);
5154 8         31 $col_start--;
5155             }
5156              
5157             # Adjust start row for negative offsets.
5158 4748   100     9640 while ( $y1 < 0 && $row_start > 0) {
5159 4         17 $y1 += $self->_size_row( $row_start - 1);
5160 4         12 $row_start--;
5161             }
5162              
5163             # Ensure that the image isn't shifted off the page at top left.
5164 4748 100       8131 $x1 = 0 if $x1 < 0;
5165 4748 100       7911 $y1 = 0 if $y1 < 0;
5166              
5167             # Calculate the absolute x offset of the top-left vertex.
5168 4748 100       8462 if ( $self->{_col_size_changed} ) {
5169 55         191 for my $col_id ( 0 .. $col_start -1 ) {
5170 202         471 $x_abs += $self->_size_col( $col_id );
5171             }
5172             }
5173             else {
5174             # Optimisation for when the column widths haven't changed.
5175 4693         6848 $x_abs += $self->{_default_col_pixels} * $col_start;
5176             }
5177              
5178 4748         5763 $x_abs += $x1;
5179              
5180             # Calculate the absolute y offset of the top-left vertex.
5181             # Store the column change to allow optimisations.
5182 4748 100       7569 if ( $self->{_row_size_changed} ) {
5183 23         100 for my $row_id ( 0 .. $row_start -1 ) {
5184 132         247 $y_abs += $self->_size_row( $row_id );
5185             }
5186             }
5187             else {
5188             # Optimisation for when the row heights haven't changed.
5189 4725         7345 $y_abs += $self->{_default_row_pixels} * $row_start;
5190             }
5191              
5192 4748         5941 $y_abs += $y1;
5193              
5194             # Adjust start column for offsets that are greater than the col width.
5195 4748         9747 while ( $x1 >= $self->_size_col( $col_start, $anchor ) ) {
5196 169         276 $x1 -= $self->_size_col( $col_start );
5197 169         249 $col_start++;
5198             }
5199              
5200             # Adjust start row for offsets that are greater than the row height.
5201 4748         9897 while ( $y1 >= $self->_size_row( $row_start, $anchor ) ) {
5202 247         345 $y1 -= $self->_size_row( $row_start );
5203 247         384 $row_start++;
5204             }
5205              
5206             # Initialise end cell to the same as the start cell.
5207 4748         6873 $col_end = $col_start;
5208 4748         5912 $row_end = $row_start;
5209              
5210             # Only offset the image in the cell if the row/col isn't hidden.
5211 4748 50       8050 if ($self->_size_col( $col_start, $anchor) > 0 ) {
5212 4748         6395 $width = $width + $x1;
5213             }
5214              
5215 4748 50       8081 if ( $self->_size_row( $row_start, $anchor ) > 0 ) {
5216 4748         6327 $height = $height + $y1;
5217             }
5218              
5219             # Subtract the underlying cell widths to find the end cell of the object.
5220 4748         8475 while ( $width >= $self->_size_col( $col_end, $anchor ) ) {
5221 11281         17075 $width -= $self->_size_col( $col_end, $anchor );
5222 11281         16934 $col_end++;
5223             }
5224              
5225              
5226             # Subtract the underlying cell heights to find the end cell of the object.
5227 4748         8710 while ( $height >= $self->_size_row( $row_end, $anchor ) ) {
5228 22647         32783 $height -= $self->_size_row( $row_end, $anchor );
5229 22647         32173 $row_end++;
5230             }
5231              
5232             # The end vertices are whatever is left from the width and height.
5233 4748         6330 $x2 = $width;
5234 4748         5792 $y2 = $height;
5235              
5236             return (
5237 4748         11636 $col_start, $row_start, $x1, $y1,
5238             $col_end, $row_end, $x2, $y2,
5239             $x_abs, $y_abs
5240              
5241             );
5242             }
5243              
5244              
5245             ###############################################################################
5246             #
5247             # _position_object_emus()
5248             #
5249             # Calculate the vertices that define the position of a graphical object within
5250             # the worksheet in EMUs.
5251             #
5252             # The vertices are expressed as English Metric Units (EMUs). There are 12,700
5253             # EMUs per point. Therefore, 12,700 * 3 /4 = 9,525 EMUs per pixel.
5254             #
5255             sub _position_object_emus {
5256              
5257 518     518   3216 my $self = shift;
5258              
5259             my (
5260 518         2294 $col_start, $row_start, $x1, $y1,
5261             $col_end, $row_end, $x2, $y2,
5262             $x_abs, $y_abs
5263              
5264             ) = $self->_position_object_pixels( @_ );
5265              
5266             # Convert the pixel values to EMUs. See above.
5267 518         1829 $x1 = int( 0.5 + 9_525 * $x1 );
5268 518         1302 $y1 = int( 0.5 + 9_525 * $y1 );
5269 518         1419 $x2 = int( 0.5 + 9_525 * $x2 );
5270 518         1378 $y2 = int( 0.5 + 9_525 * $y2 );
5271 518         1261 $x_abs = int( 0.5 + 9_525 * $x_abs );
5272 518         1166 $y_abs = int( 0.5 + 9_525 * $y_abs );
5273              
5274             return (
5275 518         2215 $col_start, $row_start, $x1, $y1,
5276             $col_end, $row_end, $x2, $y2,
5277             $x_abs, $y_abs
5278              
5279             );
5280             }
5281              
5282              
5283             ###############################################################################
5284             #
5285             # _position_shape_emus()
5286             #
5287             # Calculate the vertices that define the position of a shape object within
5288             # the worksheet in EMUs. Save the vertices with the object.
5289             #
5290             # The vertices are expressed as English Metric Units (EMUs). There are 12,700
5291             # EMUs per point. Therefore, 12,700 * 3 /4 = 9,525 EMUs per pixel.
5292             #
5293             sub _position_shape_emus {
5294              
5295 41     41   53 my $self = shift;
5296 41         52 my $shape = shift;
5297              
5298             my (
5299             $col_start, $row_start, $x1, $y1, $col_end,
5300             $row_end, $x2, $y2, $x_abs, $y_abs
5301             )
5302             = $self->_position_object_pixels(
5303             $shape->{_column_start},
5304             $shape->{_row_start},
5305             $shape->{_x_offset},
5306             $shape->{_y_offset},
5307             $shape->{_width} * $shape->{_scale_x},
5308             $shape->{_height} * $shape->{_scale_y},
5309             $shape->{_drawing}
5310 41         147 );
5311              
5312             # Now that x2/y2 have been calculated with a potentially negative
5313             # width/height we use the absolute value and convert to EMUs.
5314 41         107 $shape->{_width_emu} = int( abs( $shape->{_width} * 9_525 ) );
5315 41         76 $shape->{_height_emu} = int( abs( $shape->{_height} * 9_525 ) );
5316              
5317 41         60 $shape->{_column_start} = int( $col_start );
5318 41         56 $shape->{_row_start} = int( $row_start );
5319 41         62 $shape->{_column_end} = int( $col_end );
5320 41         59 $shape->{_row_end} = int( $row_end );
5321              
5322             # Convert the pixel values to EMUs. See above.
5323 41         58 $shape->{_x1} = int( $x1 * 9_525 );
5324 41         66 $shape->{_y1} = int( $y1 * 9_525 );
5325 41         74 $shape->{_x2} = int( $x2 * 9_525 );
5326 41         64 $shape->{_y2} = int( $y2 * 9_525 );
5327 41         56 $shape->{_x_abs} = int( $x_abs * 9_525 );
5328 41         81 $shape->{_y_abs} = int( $y_abs * 9_525 );
5329             }
5330              
5331             ###############################################################################
5332             #
5333             # _size_col($col)
5334             #
5335             # Convert the width of a cell from user's units to pixels. Excel rounds the
5336             # column width to the nearest pixel. If the width hasn't been set by the user
5337             # we use the default value. A hidden column is treated as having a width of
5338             # zero unless it has the special "object_position" of 4 (size with cells).
5339             #
5340             sub _size_col {
5341              
5342 37354     37354   43874 my $self = shift;
5343 37354         42157 my $col = shift;
5344 37354   100     70043 my $anchor = shift || 0;
5345              
5346 37354         40658 my $max_digit_width = 7; # For Calabri 11.
5347 37354         40175 my $padding = 5;
5348 37354         39875 my $pixels;
5349              
5350              
5351             # Look up the cell value to see if it has been changed.
5352 37354 100       55134 if ( exists $self->{_col_sizes}->{$col} )
5353             {
5354 175         2030 my $width = $self->{_col_sizes}->{$col}[0];
5355 175         263 my $hidden = $self->{_col_sizes}->{$col}[1];
5356              
5357             # Convert to pixels.
5358 175 100 100     660 if ( $hidden == 1 && $anchor != 4 ) {
    50          
5359 16         28 $pixels = 0;
5360             }
5361             elsif ( $width < 1 ) {
5362 0         0 $pixels = int( $width * ( $max_digit_width + $padding ) + 0.5 );
5363             }
5364             else {
5365 159         355 $pixels = int( $width * $max_digit_width + 0.5 ) + $padding;
5366             }
5367             }
5368             else {
5369 37179         42269 $pixels = $self->{_default_col_pixels};
5370             }
5371              
5372 37354         61948 return $pixels;
5373             }
5374              
5375              
5376             ###############################################################################
5377             #
5378             # _size_row($row)
5379             #
5380             # Convert the height of a cell from user's units to pixels. If the height
5381             # hasn't been set by the user we use the default value. A hidden row is
5382             # treated as having a height of zero unless it has the special
5383             # "object_position" of 4 (size with cells).
5384             #
5385             sub _size_row {
5386              
5387 60168     60168   70006 my $self = shift;
5388 60168         66086 my $row = shift;
5389 60168   100     107015 my $anchor = shift || 0;
5390 60168         64249 my $pixels;
5391              
5392             # Look up the cell value to see if it has been changed
5393 60168 100       85919 if ( exists $self->{_row_sizes}->{$row} ) {
5394 72         129 my $height = $self->{_row_sizes}->{$row}[0];
5395 72         114 my $hidden = $self->{_row_sizes}->{$row}[1];
5396              
5397 72 100 100     231 if ( $hidden == 1 && $anchor != 4 ) {
5398 8         13 $pixels = 0;
5399             }
5400             else {
5401 64         141 $pixels = int( 4 / 3 * $height );
5402             }
5403             }
5404             else {
5405 60096         78692 $pixels = int( 4 / 3 * $self->{_default_row_height} );
5406             }
5407              
5408 60168         91090 return $pixels;
5409             }
5410              
5411              
5412             ###############################################################################
5413             #
5414             # _get_shared_string_index()
5415             #
5416             # Add a string to the shared string table, if it isn't already there, and
5417             # return the string index.
5418             #
5419             sub _get_shared_string_index {
5420              
5421 2720     2720   3872 my $self = shift;
5422 2720         3831 my $str = shift;
5423              
5424             # Add the string to the shared string table.
5425 2720 100       3671 if ( not exists ${ $self->{_str_table} }->{$str} ) {
  2720         6355  
5426 1129         1574 ${ $self->{_str_table} }->{$str} = ${ $self->{_str_unique} }++;
  1129         3467  
  1129         2811  
5427             }
5428              
5429 2720         4931 ${ $self->{_str_total} }++;
  2720         4628  
5430 2720         3771 my $index = ${ $self->{_str_table} }->{$str};
  2720         4695  
5431              
5432 2720         5127 return $index;
5433             }
5434              
5435              
5436             ###############################################################################
5437             #
5438             # _get_drawing_rel_index()
5439             #
5440             # Get the index used to address a drawing rel link.
5441             #
5442             sub _get_drawing_rel_index {
5443              
5444 576     576   1630 my $self = shift;
5445 576         1194 my $target = shift;
5446              
5447 576 100       2404 if ( ! defined $target ) {
    100          
5448             # Undefined values for drawings like charts will always be unique.
5449 439         1609 return ++$self->{_drawing_rels_id};
5450             }
5451             elsif ( exists $self->{_drawing_rels}->{$target} ) {
5452 4         16 return $self->{_drawing_rels}->{$target};
5453             }
5454             else {
5455 133         356 $self->{_drawing_rels}->{$target} = ++$self->{_drawing_rels_id};
5456 133         698 return $self->{_drawing_rels_id};
5457             }
5458             }
5459              
5460              
5461             ###############################################################################
5462             #
5463             # _get_vml_drawing_rel_index()
5464             #
5465             # Get the index used to address a vml_drawing rel link.
5466             #
5467             sub _get_vml_drawing_rel_index {
5468              
5469 44     44   69 my $self = shift;
5470 44         83 my $target = shift;
5471              
5472 44 100       104 if ( exists $self->{_vml_drawing_rels}->{$target} ) {
5473 10         21 return $self->{_vml_drawing_rels}->{$target};
5474             }
5475             else {
5476 34         76 $self->{_vml_drawing_rels}->{$target} = ++$self->{_vml_drawing_rels_id};
5477 34         112 return $self->{_vml_drawing_rels_id};
5478             }
5479             }
5480              
5481              
5482             ###############################################################################
5483             #
5484             # insert_chart( $row, $col, $chart, $x, $y, $x_scale, $y_scale )
5485             #
5486             # Insert a chart into a worksheet. The $chart argument should be a Chart
5487             # object or else it is assumed to be a filename of an external binary file.
5488             # The latter is for backwards compatibility.
5489             #
5490             sub insert_chart {
5491              
5492 398     398 0 2968 my $self = shift;
5493              
5494             # Check for a cell reference in A1 notation and substitute row and column.
5495 398 50       2541 if ( $_[0] =~ /^\D/ ) {
5496 398         1756 @_ = $self->_substitute_cellref( @_ );
5497             }
5498              
5499 398         1124 my $row = $_[0];
5500 398         987 my $col = $_[1];
5501 398         928 my $chart = $_[2];
5502 398         2492 my $x_offset;
5503             my $y_offset;
5504 398         0 my $x_scale;
5505 398         0 my $y_scale;
5506 398         0 my $anchor;
5507              
5508 398 50       1782 croak "Insufficient arguments in insert_chart()" unless @_ >= 3;
5509              
5510 398 50       1697 if ( ref $chart ) {
5511              
5512             # Check for a Chart object.
5513 398 50       4537 croak "Not a Chart object in insert_chart()"
5514             unless $chart->isa( 'Excel::Writer::XLSX::Chart' );
5515              
5516             # Check that the chart is an embedded style chart.
5517             croak "Not a embedded style Chart object in insert_chart()"
5518 398 50       1979 unless $chart->{_embedded};
5519              
5520             }
5521              
5522 398 100       1762 if ( ref $_[3] eq 'HASH' ) {
5523             # Newer hashref bashed options.
5524 3         7 my $options = $_[3];
5525 3   50     15 $x_offset = $options->{x_offset} || 0;
5526 3   50     13 $y_offset = $options->{y_offset} || 0;
5527 3   100     16 $x_scale = $options->{x_scale} || 1;
5528 3   100     35 $y_scale = $options->{y_scale} || 1;
5529 3   100     16 $anchor = $options->{object_position} || 1;
5530             }
5531             else {
5532             # Older parameter based options.
5533 395   100     2430 $x_offset = $_[3] || 0;
5534 395   100     2365 $y_offset = $_[4] || 0;
5535 395   100     2485 $x_scale = $_[5] || 1;
5536 395   100     2755 $y_scale = $_[6] || 1;
5537 395   100     1950 $anchor = $_[7] || 1;
5538             }
5539              
5540             # Ensure a chart isn't inserted more than once.
5541 398 50 66     3336 if ( $chart->{_already_inserted}
      33        
5542             || $chart->{_combined} && $chart->{_combined}->{_already_inserted} )
5543             {
5544 0         0 carp "Chart cannot be inserted in a worksheet more than once";
5545 0         0 return;
5546             }
5547             else {
5548 398         1010 $chart->{_already_inserted} = 1;
5549              
5550 398 100       1423 if ( $chart->{_combined} ) {
5551 10         33 $chart->{_combined}->{_already_inserted} = 1;
5552             }
5553             }
5554              
5555             # Use the values set with $chart->set_size(), if any.
5556 398 100       1506 $x_scale = $chart->{_x_scale} if $chart->{_x_scale} != 1;
5557 398 100       1455 $y_scale = $chart->{_y_scale} if $chart->{_y_scale} != 1;
5558 398 100       1468 $x_offset = $chart->{_x_offset} if $chart->{_x_offset};
5559 398 100       1453 $y_offset = $chart->{_y_offset} if $chart->{_y_offset};
5560              
5561 398         979 push @{ $self->{_charts} },
  398         2695  
5562             [ $row, $col, $chart, $x_offset, $y_offset, $x_scale, $y_scale, $anchor ];
5563             }
5564              
5565              
5566             ###############################################################################
5567             #
5568             # _prepare_chart()
5569             #
5570             # Set up chart/drawings.
5571             #
5572             sub _prepare_chart {
5573              
5574 398     398   945 my $self = shift;
5575 398         908 my $index = shift;
5576 398         780 my $chart_id = shift;
5577 398         811 my $drawing_id = shift;
5578 398         818 my $drawing_type = 1;
5579 398         762 my $drawing;
5580              
5581             my ( $row, $col, $chart, $x_offset, $y_offset, $x_scale, $y_scale, $anchor )
5582 398         768 = @{ $self->{_charts}->[$index] };
  398         1938  
5583              
5584 398         1283 $chart->{_id} = $chart_id - 1;
5585              
5586             # Use user specified dimensions, if any.
5587 398 50       1650 my $width = $chart->{_width} if $chart->{_width};
5588 398 50       1697 my $height = $chart->{_height} if $chart->{_height};
5589              
5590 398         1436 $width = int( 0.5 + ( $width * $x_scale ) );
5591 398         1119 $height = int( 0.5 + ( $height * $y_scale ) );
5592              
5593 398         2165 my @dimensions =
5594             $self->_position_object_emus( $col, $row, $x_offset, $y_offset, $width,
5595             $height, $anchor);
5596              
5597             # Set the chart name for the embedded object if it has been specified.
5598 398         1283 my $name = $chart->{_chart_name};
5599              
5600             # Create a Drawing object to use with worksheet unless one already exists.
5601 398 100       1696 if ( !$self->{_drawing} ) {
5602              
5603 386         4117 $drawing = Excel::Writer::XLSX::Drawing->new();
5604 386         2722 $drawing->{_embedded} = 1;
5605 386         1042 $self->{_drawing} = $drawing;
5606              
5607 386         893 push @{ $self->{_external_drawing_links} },
  386         2684  
5608             [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ];
5609             }
5610             else {
5611 12         51 $drawing = $self->{_drawing};
5612             }
5613              
5614 398         2407 my $drawing_object = $drawing->_add_drawing_object();
5615              
5616 398         1072 $drawing_object->{_type} = $drawing_type;
5617 398         1116 $drawing_object->{_dimensions} = \@dimensions;
5618 398         926 $drawing_object->{_width} = 0;
5619 398         960 $drawing_object->{_height} = 0;
5620 398         1007 $drawing_object->{_description} = $name;
5621 398         903 $drawing_object->{_shape} = undef;
5622 398         1031 $drawing_object->{_anchor} = $anchor;
5623 398         2084 $drawing_object->{_rel_index} = $self->_get_drawing_rel_index();
5624 398         913 $drawing_object->{_url_rel_index} = 0;
5625 398         1185 $drawing_object->{_tip} = undef;
5626              
5627 398         818 push @{ $self->{_drawing_links} },
  398         3191  
5628             [ '/chart', '../charts/chart' . $chart_id . '.xml' ];
5629             }
5630              
5631              
5632             ###############################################################################
5633             #
5634             # _get_range_data
5635             #
5636             # Returns a range of data from the worksheet _table to be used in chart
5637             # cached data. Strings are returned as SST ids and decoded in the workbook.
5638             # Return undefs for data that doesn't exist since Excel can chart series
5639             # with data missing.
5640             #
5641             sub _get_range_data {
5642              
5643 1140     1140   2066 my $self = shift;
5644              
5645 1140 50       3000 return () if $self->{_optimization};
5646              
5647 1140         1757 my @data;
5648 1140         2796 my ( $row_start, $col_start, $row_end, $col_end ) = @_;
5649              
5650             # TODO. Check for worksheet limits.
5651              
5652             # Iterate through the table data.
5653 1140         2784 for my $row_num ( $row_start .. $row_end ) {
5654              
5655             # Store undef if row doesn't exist.
5656 5402 100       10899 if ( !exists $self->{_table}->{$row_num} ) {
5657 5         8 push @data, undef;
5658 5         10 next;
5659             }
5660              
5661 5397         8116 for my $col_num ( $col_start .. $col_end ) {
5662              
5663 5397 100       12487 if ( my $cell = $self->{_table}->{$row_num}->{$col_num} ) {
5664              
5665 5393         7683 my $type = $cell->[0];
5666 5393         6786 my $token = $cell->[1];
5667              
5668              
5669 5393 100       8958 if ( $type eq 'n' ) {
    50          
    0          
    0          
    0          
5670              
5671             # Store a number.
5672 5366         11024 push @data, $token;
5673             }
5674             elsif ( $type eq 's' ) {
5675              
5676             # Store a string.
5677 27 50       63 if ( $self->{_optimization} == 0 ) {
5678 27         134 push @data, { 'sst_id' => $token };
5679             }
5680             else {
5681 0         0 push @data, $token;
5682             }
5683             }
5684             elsif ( $type eq 'f' ) {
5685              
5686             # Store a formula.
5687 0   0     0 push @data, $cell->[3] || 0;
5688             }
5689             elsif ( $type eq 'a' ) {
5690              
5691             # Store an array formula.
5692 0   0     0 push @data, $cell->[4] || 0;
5693             }
5694             elsif ( $type eq 'b' ) {
5695              
5696             # Store a empty cell.
5697 0         0 push @data, '';
5698             }
5699             }
5700             else {
5701              
5702             # Store undef if col doesn't exist.
5703 4         10 push @data, undef;
5704             }
5705             }
5706             }
5707              
5708 1140         3863 return @data;
5709             }
5710              
5711              
5712             ###############################################################################
5713             #
5714             # insert_image( $row, $col, $filename, $options )
5715             #
5716             # Insert an image into the worksheet.
5717             #
5718             sub insert_image {
5719              
5720 114     114 0 958 my $self = shift;
5721              
5722             # Check for a cell reference in A1 notation and substitute row and column.
5723 114 100       598 if ( $_[0] =~ /^\D/ ) {
5724 112         535 @_ = $self->_substitute_cellref( @_ );
5725             }
5726              
5727 114         256 my $row = $_[0];
5728 114         218 my $col = $_[1];
5729 114         326 my $image = $_[2];
5730 114         874 my $x_offset;
5731             my $y_offset;
5732 114         0 my $x_scale;
5733 114         0 my $y_scale;
5734 114         0 my $anchor;
5735 114         0 my $url;
5736 114         0 my $tip;
5737              
5738 114 100       416 if ( ref $_[3] eq 'HASH' ) {
5739             # Newer hashref bashed options.
5740 34         65 my $options = $_[3];
5741 34   100     187 $x_offset = $options->{x_offset} || 0;
5742 34   100     171 $y_offset = $options->{y_offset} || 0;
5743 34   100     180 $x_scale = $options->{x_scale} || 1;
5744 34   100     294 $y_scale = $options->{y_scale} || 1;
5745 34   100     143 $anchor = $options->{object_position} || 2;
5746 34         62 $url = $options->{url};
5747 34         79 $tip = $options->{tip};
5748             }
5749             else {
5750             # Older parameter based options.
5751 80   100     400 $x_offset = $_[3] || 0;
5752 80   100     344 $y_offset = $_[4] || 0;
5753 80   100     323 $x_scale = $_[5] || 1;
5754 80   100     311 $y_scale = $_[6] || 1;
5755 80   100     412 $anchor = $_[7] || 2;
5756             }
5757              
5758 114 50       743 croak "Insufficient arguments in insert_image()" unless @_ >= 3;
5759 114 50       2248 croak "Couldn't locate $image: $!" unless -e $image;
5760              
5761 114         407 push @{ $self->{_images} },
  114         1242  
5762             [
5763             $row, $col, $image, $x_offset, $y_offset,
5764             $x_scale, $y_scale, $url, $tip, $anchor
5765             ];
5766             }
5767              
5768              
5769             ###############################################################################
5770             #
5771             # _prepare_image()
5772             #
5773             # Set up image/drawings.
5774             #
5775             sub _prepare_image {
5776              
5777 114     114   226 my $self = shift;
5778 114         198 my $index = shift;
5779 114         186 my $image_id = shift;
5780 114         185 my $drawing_id = shift;
5781 114         181 my $width = shift;
5782 114         192 my $height = shift;
5783 114         178 my $name = shift;
5784 114         193 my $image_type = shift;
5785 114         179 my $x_dpi = shift;
5786 114         165 my $y_dpi = shift;
5787 114         183 my $md5 = shift;
5788 114         176 my $drawing_type = 2;
5789 114         177 my $drawing;
5790              
5791             my (
5792             $row, $col, $image, $x_offset, $y_offset,
5793             $x_scale, $y_scale, $url, $tip, $anchor
5794 114         180 ) = @{ $self->{_images}->[$index] };
  114         444  
5795              
5796 114         218 $width *= $x_scale;
5797 114         179 $height *= $y_scale;
5798              
5799 114         319 $width *= 96 / $x_dpi;
5800 114         235 $height *= 96 / $y_dpi;
5801              
5802 114         459 my @dimensions =
5803             $self->_position_object_emus( $col, $row, $x_offset, $y_offset, $width,
5804             $height, $anchor);
5805              
5806             # Convert from pixels to emus.
5807 114         307 $width = int( 0.5 + ( $width * 9_525 ) );
5808 114         254 $height = int( 0.5 + ( $height * 9_525 ) );
5809              
5810             # Create a Drawing object to use with worksheet unless one already exists.
5811 114 100       471 if ( !$self->{_drawing} ) {
5812              
5813 87         847 $drawing = Excel::Writer::XLSX::Drawing->new();
5814 87         660 $drawing->{_embedded} = 1;
5815 87         213 $self->{_drawing} = $drawing;
5816              
5817 87         169 push @{ $self->{_external_drawing_links} },
  87         517  
5818             [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ];
5819             }
5820             else {
5821 27         47 $drawing = $self->{_drawing};
5822             }
5823              
5824 114         502 my $drawing_object = $drawing->_add_drawing_object();
5825              
5826 114         313 $drawing_object->{_type} = $drawing_type;
5827 114         261 $drawing_object->{_dimensions} = \@dimensions;
5828 114         215 $drawing_object->{_width} = $width;
5829 114         221 $drawing_object->{_height} = $height;
5830 114         246 $drawing_object->{_description} = $name;
5831 114         246 $drawing_object->{_shape} = undef;
5832 114         248 $drawing_object->{_anchor} = $anchor;
5833 114         213 $drawing_object->{_rel_index} = 0;
5834 114         242 $drawing_object->{_url_rel_index} = 0;
5835 114         226 $drawing_object->{_tip} = $tip;
5836              
5837              
5838 114 100       377 if ( $url ) {
5839 23         40 my $rel_type = '/hyperlink';
5840 23         40 my $target_mode = 'External';
5841 23         35 my $target;
5842              
5843 23 100 100     183 if ( $url =~ m{^[fh]tt?ps?://} || $url =~ m{^mailto:} ) {
5844 18         64 $target = _escape_url( $url );
5845             }
5846              
5847 23 100       96 if ( $url =~ s{^external:}{file:///} ) {
5848 3         14 $target = _escape_url( $url );
5849              
5850             # Additional escape not required in worksheet hyperlinks.
5851 3         8 $target =~ s/#/%23/g;
5852             }
5853              
5854 23 100       87 if ( $url =~ s/^internal:/#/ ) {
5855 2         4 $target = $url;
5856 2         3 $target_mode = undef;
5857             }
5858              
5859 23         55 my $max_url = $self->{_max_url_length};
5860 23 50       88 if ( length $target > $max_url ) {
5861 0         0 carp "Ignoring URL '$url' where link or anchor > $max_url characters "
5862             . "since it exceeds Excel's limit for URLS. See LIMITATIONS "
5863             . "section of the Excel::Writer::XLSX documentation.";
5864             }
5865             else {
5866 23 100 66     146 if ( $target && !exists $self->{_drawing_rels}->{$url} ) {
5867 22         43 push @{ $self->{_drawing_links} },
  22         84  
5868             [ $rel_type, $target, $target_mode ];
5869             }
5870              
5871             $drawing_object->{_url_rel_index} =
5872 23         80 $self->_get_drawing_rel_index( $url );
5873             }
5874             }
5875              
5876 114 100       371 if ( !exists $self->{_drawing_rels}->{$md5} ) {
5877 111         245 push @{ $self->{_drawing_links} },
  111         562  
5878             [ '/image', '../media/image' . $image_id . '.' . $image_type ];
5879             }
5880              
5881 114         490 $drawing_object->{_rel_index} = $self->_get_drawing_rel_index( $md5 );
5882             }
5883              
5884              
5885             ###############################################################################
5886             #
5887             # _prepare_header_image()
5888             #
5889             # Set up an image without a drawing object for header/footer images.
5890             #
5891             sub _prepare_header_image {
5892              
5893 44     44   74 my $self = shift;
5894 44         64 my $image_id = shift;
5895 44         76 my $width = shift;
5896 44         65 my $height = shift;
5897 44         134 my $name = shift;
5898 44         68 my $image_type = shift;
5899 44         70 my $position = shift;
5900 44         58 my $x_dpi = shift;
5901 44         60 my $y_dpi = shift;
5902 44         61 my $md5 = shift;
5903              
5904             # Strip the extension from the filename.
5905 44         270 $name =~ s/\.[^\.]+$//;
5906              
5907 44 100       144 if ( !exists $self->{_vml_drawing_rels}->{$md5} ) {
5908 34         54 push @{ $self->{_vml_drawing_links} },
  34         145  
5909             [ '/image', '../media/image' . $image_id . '.' . $image_type ];
5910             }
5911              
5912 44         128 my $ref_id = $self->_get_vml_drawing_rel_index( $md5 );
5913              
5914 44         70 push @{ $self->{_header_images_array} },
  44         221  
5915             [ $width, $height, $name, $position, $x_dpi, $y_dpi, $ref_id ];
5916             }
5917              
5918              
5919             ###############################################################################
5920             #
5921             # insert_shape( $row, $col, $shape, $x, $y, $x_scale, $y_scale )
5922             #
5923             # Insert a shape into the worksheet.
5924             #
5925             sub insert_shape {
5926              
5927 45     45 0 183 my $self = shift;
5928              
5929             # Check for a cell reference in A1 notation and substitute row and column.
5930 45 100       186 if ( $_[0] =~ /^\D/ ) {
5931 41         154 @_ = $self->_substitute_cellref( @_ );
5932             }
5933              
5934             # Check the number of arguments.
5935 45 50       409 croak "Insufficient arguments in insert_shape()" unless @_ >= 3;
5936              
5937 45         80 my $shape = $_[2];
5938              
5939             # Verify we are being asked to insert a "shape" object.
5940 45 50       297 croak "Not a Shape object in insert_shape()"
5941             unless $shape->isa( 'Excel::Writer::XLSX::Shape' );
5942              
5943             # Set the shape properties.
5944 45         148 $shape->{_row_start} = $_[0];
5945 45         70 $shape->{_column_start} = $_[1];
5946 45   100     148 $shape->{_x_offset} = $_[3] || 0;
5947 45   100     124 $shape->{_y_offset} = $_[4] || 0;
5948              
5949             # Override shape scale if supplied as an argument. Otherwise, use the
5950             # existing shape scale factors.
5951 45 100       90 $shape->{_scale_x} = $_[5] if defined $_[5];
5952 45 100       85 $shape->{_scale_y} = $_[6] if defined $_[6];
5953 45   50     152 $shape->{_anchor} = $_[7] || 1;
5954              
5955             # Assign a shape ID.
5956 45         56 my $needs_id = 1;
5957 45         99 while ( $needs_id ) {
5958 90   100     193 my $id = $shape->{_id} || 0;
5959 90 100       205 my $used = exists $self->{_shape_hash}->{$id} ? 1 : 0;
5960              
5961             # Test if shape ID is already used. Otherwise assign a new one.
5962 90 100 100     238 if ( !$used && $id != 0 ) {
5963 45         92 $needs_id = 0;
5964             }
5965             else {
5966 45         95 $shape->{_id} = ++$self->{_last_shape_id};
5967             }
5968             }
5969              
5970 45         59 $shape->{_element} = $#{ $self->{_shapes} } + 1;
  45         97  
5971              
5972             # Allow lookup of entry into shape array by shape ID.
5973 45         116 $self->{_shape_hash}->{ $shape->{_id} } = $shape->{_element};
5974              
5975             # Create link to Worksheet color palette.
5976 45         78 $shape->{_palette} = $self->{_palette};
5977              
5978 45 50       86 if ( $shape->{_stencil} ) {
5979              
5980             # Insert a copy of the shape, not a reference so that the shape is
5981             # used as a stencil. Previously stamped copies don't get modified
5982             # if the stencil is modified.
5983 45         61 my $insert = { %{$shape} };
  45         827  
5984              
5985             # For connectors change x/y co-ords based on location of connected shapes.
5986 45         222 $self->_auto_locate_connectors( $insert );
5987              
5988             # Bless the copy into this class, so AUTOLOADED _get, _set methods
5989             #still work on the child.
5990 45         93 bless $insert, ref $shape;
5991              
5992 45         62 push @{ $self->{_shapes} }, $insert;
  45         94  
5993 45         132 return $insert;
5994             }
5995             else {
5996              
5997             # For connectors change x/y co-ords based on location of connected shapes.
5998 0         0 $self->_auto_locate_connectors( $shape );
5999              
6000             # Insert a link to the shape on the list of shapes. Connection to
6001             # the parent shape is maintained
6002 0         0 push @{ $self->{_shapes} }, $shape;
  0         0  
6003 0         0 return $shape;
6004             }
6005             }
6006              
6007              
6008             ###############################################################################
6009             #
6010             # _prepare_shape()
6011             #
6012             # Set up drawing shapes
6013             #
6014             sub _prepare_shape {
6015              
6016 41     41   71 my $self = shift;
6017 41         63 my $index = shift;
6018 41         65 my $drawing_id = shift;
6019 41         74 my $shape = $self->{_shapes}->[$index];
6020 41         53 my $drawing;
6021 41         54 my $drawing_type = 3;
6022              
6023             # Create a Drawing object to use with worksheet unless one already exists.
6024 41 100       84 if ( !$self->{_drawing} ) {
6025              
6026 10         103 $drawing = Excel::Writer::XLSX::Drawing->new();
6027 10         66 $drawing->{_embedded} = 1;
6028 10         23 $self->{_drawing} = $drawing;
6029              
6030 10         20 push @{ $self->{_external_drawing_links} },
  10         62  
6031             [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ];
6032              
6033 10         26 $self->{_has_shapes} = 1;
6034             }
6035             else {
6036 31         51 $drawing = $self->{_drawing};
6037             }
6038              
6039             # Validate the he shape against various rules.
6040 41         133 $self->_validate_shape( $shape, $index );
6041              
6042 41         126 $self->_position_shape_emus( $shape );
6043              
6044             my @dimensions = (
6045             $shape->{_column_start}, $shape->{_row_start},
6046             $shape->{_x1}, $shape->{_y1},
6047             $shape->{_column_end}, $shape->{_row_end},
6048             $shape->{_x2}, $shape->{_y2},
6049             $shape->{_x_abs}, $shape->{_y_abs},
6050 41         134 );
6051              
6052 41         125 my $drawing_object = $drawing->_add_drawing_object();
6053              
6054 41         67 $drawing_object->{_type} = $drawing_type;
6055 41         83 $drawing_object->{_dimensions} = \@dimensions;
6056 41         68 $drawing_object->{_width} = $shape->{_width_emu};
6057 41         56 $drawing_object->{_height} = $shape->{_height_emu};
6058 41         61 $drawing_object->{_description} = $shape->{_name};
6059 41         57 $drawing_object->{_shape} = $shape;
6060 41         58 $drawing_object->{_anchor} = $shape->{_anchor};
6061 41         87 $drawing_object->{_rel_index} = $self->_get_drawing_rel_index();
6062 41         71 $drawing_object->{_url_rel_index} = 0;
6063 41         174 $drawing_object->{_tip} = undef;
6064             }
6065              
6066              
6067             ###############################################################################
6068             #
6069             # _auto_locate_connectors()
6070             #
6071             # Re-size connector shapes if they are connected to other shapes.
6072             #
6073             sub _auto_locate_connectors {
6074              
6075 45     45   68 my $self = shift;
6076 45         70 my $shape = shift;
6077              
6078             # Valid connector shapes.
6079 45         159 my $connector_shapes = {
6080             straightConnector => 1,
6081             Connector => 1,
6082             bentConnector => 1,
6083             curvedConnector => 1,
6084             line => 1,
6085             };
6086              
6087 45         83 my $shape_base = $shape->{_type};
6088              
6089             # Remove the number of segments from end of type.
6090 45         81 chop $shape_base;
6091              
6092 45 100       107 $shape->{_connect} = $connector_shapes->{$shape_base} ? 1 : 0;
6093              
6094 45 100       140 return unless $shape->{_connect};
6095              
6096             # Both ends have to be connected to size it.
6097 12 50 33     52 return unless ( $shape->{_start} and $shape->{_end} );
6098              
6099             # Both ends need to provide info about where to connect.
6100 12 50 33     76 return unless ( $shape->{_start_side} and $shape->{_end_side} );
6101              
6102 12         33 my $sid = $shape->{_start};
6103 12         20 my $eid = $shape->{_end};
6104              
6105 12         21 my $slink_id = $self->{_shape_hash}->{$sid};
6106 12         20 my ( $sls, $els );
6107 12 100       30 if ( defined $slink_id ) {
6108 11         21 $sls = $self->{_shapes}->[$slink_id]; # Start linked shape.
6109             }
6110             else {
6111 1         11 warn "missing start connection for '$shape->{_name}', id=$sid\n";
6112 1         8 return;
6113             }
6114              
6115 11         18 my $elink_id = $self->{_shape_hash}->{$eid};
6116 11 100       24 if ( defined $elink_id ) {
6117 10         16 $els = $self->{_shapes}->[$elink_id]; # Start linked shape.
6118             }
6119             else {
6120 1         8 warn "missing end connection for '$shape->{_name}', id=$eid\n";
6121 1         6 return;
6122             }
6123              
6124             # Assume shape connections are to the middle of an object, and
6125             # not a corner (for now).
6126 10         21 my $connect_type = $shape->{_start_side} . $shape->{_end_side};
6127 10         37 my $smidx = $sls->{_x_offset} + $sls->{_width} / 2;
6128 10         26 my $emidx = $els->{_x_offset} + $els->{_width} / 2;
6129 10         20 my $smidy = $sls->{_y_offset} + $sls->{_height} / 2;
6130 10         20 my $emidy = $els->{_y_offset} + $els->{_height} / 2;
6131 10         23 my $netx = abs( $smidx - $emidx );
6132 10         13 my $nety = abs( $smidy - $emidy );
6133              
6134 10 100       47 if ( $connect_type eq 'bt' ) {
    50          
6135 5         11 my $sy = $sls->{_y_offset} + $sls->{_height};
6136 5         7 my $ey = $els->{_y_offset};
6137              
6138 5         11 $shape->{_width} = abs( int( $emidx - $smidx ) );
6139 5         17 $shape->{_x_offset} = int( min( $smidx, $emidx ) );
6140             $shape->{_height} =
6141             abs(
6142 5         10 int( $els->{_y_offset} - ( $sls->{_y_offset} + $sls->{_height} ) )
6143             );
6144             $shape->{_y_offset} = int(
6145 5         12 min( ( $sls->{_y_offset} + $sls->{_height} ), $els->{_y_offset} ) );
6146 5 100       12 $shape->{_flip_h} = ( $smidx < $emidx ) ? 1 : 0;
6147 5         7 $shape->{_rotation} = 90;
6148              
6149 5 100       16 if ( $sy > $ey ) {
6150 2         3 $shape->{_flip_v} = 1;
6151              
6152             # Create 3 adjustments for an end shape vertically above a
6153             # start shape. Adjustments count from the upper left object.
6154 2 100       2 if ( $#{ $shape->{_adjustments} } < 0 ) {
  2         6  
6155 1         3 $shape->{_adjustments} = [ -10, 50, 110 ];
6156             }
6157              
6158 2         6 $shape->{_type} = 'bentConnector5';
6159             }
6160             }
6161             elsif ( $connect_type eq 'rl' ) {
6162             $shape->{_width} =
6163             abs(
6164 5         12 int( $els->{_x_offset} - ( $sls->{_x_offset} + $sls->{_width} ) ) );
6165 5         7 $shape->{_height} = abs( int( $emidy - $smidy ) );
6166             $shape->{_x_offset} =
6167 5         20 min( $sls->{_x_offset} + $sls->{_width}, $els->{_x_offset} );
6168 5         11 $shape->{_y_offset} = min( $smidy, $emidy );
6169              
6170 5 100 100     36 $shape->{_flip_h} = 1 if ( $smidx < $emidx ) and ( $smidy > $emidy );
6171 5 100 100     25 $shape->{_flip_h} = 1 if ( $smidx > $emidx ) and ( $smidy < $emidy );
6172 5 100       20 if ( $smidx > $emidx ) {
6173              
6174             # Create 3 adjustments if end shape is left of start
6175 2 100       2 if ( $#{ $shape->{_adjustments} } < 0 ) {
  2         6  
6176 1         3 $shape->{_adjustments} = [ -10, 50, 110 ];
6177             }
6178              
6179 2         5 $shape->{_type} = 'bentConnector5';
6180             }
6181             }
6182             else {
6183 0         0 warn "Connection $connect_type not implemented yet\n";
6184             }
6185             }
6186              
6187              
6188             ###############################################################################
6189             #
6190             # _validate_shape()
6191             #
6192             # Check shape attributes to ensure they are valid.
6193             #
6194             sub _validate_shape {
6195              
6196 41     41   68 my $self = shift;
6197 41         60 my $shape = shift;
6198 41         67 my $index = shift;
6199              
6200 41 50       463 if ( !grep ( /^$shape->{_align}$/, qw[l ctr r just] ) ) {
6201 0         0 croak "Shape $index ($shape->{_type}) alignment ($shape->{align}), "
6202             . "not in ('l', 'ctr', 'r', 'just')\n";
6203             }
6204              
6205 41 50       312 if ( !grep ( /^$shape->{_valign}$/, qw[t ctr b] ) ) {
6206 0         0 croak "Shape $index ($shape->{_type}) vertical alignment "
6207             . "($shape->{valign}), not ('t', 'ctr', 'b')\n";
6208             }
6209             }
6210              
6211              
6212             ###############################################################################
6213             #
6214             # _prepare_vml_objects()
6215             #
6216             # Turn the HoH that stores the comments into an array for easier handling
6217             # and set the external links for comments and buttons.
6218             #
6219             sub _prepare_vml_objects {
6220              
6221 57     57   126 my $self = shift;
6222 57         117 my $vml_data_id = shift;
6223 57         120 my $vml_shape_id = shift;
6224 57         112 my $vml_drawing_id = shift;
6225 57         95 my $comment_id = shift;
6226 57         104 my @comments;
6227              
6228              
6229             # We sort the comments by row and column but that isn't strictly required.
6230 57         111 my @rows = sort { $a <=> $b } keys %{ $self->{_comments} };
  1510         1653  
  57         339  
6231              
6232 57         183 for my $row ( @rows ) {
6233 317         464 my @cols = sort { $a <=> $b } keys %{ $self->{_comments}->{$row} };
  11074         12863  
  317         2235  
6234              
6235 317         698 for my $col ( @cols ) {
6236 4161         6640 my $user_options = $self->{_comments}->{$row}->{$col};
6237 4161         7736 my $params = [ $self->_comment_params( @$user_options ) ];
6238              
6239 4161         9940 $self->{_comments}->{$row}->{$col} = $params;
6240              
6241             # Set comment visibility if required and not already user defined.
6242 4161 100       6925 if ( $self->{_comments_visible} ) {
6243 10 100       21 if ( !defined $self->{_comments}->{$row}->{$col}->[4] ) {
6244 8         12 $self->{_comments}->{$row}->{$col}->[4] = 1;
6245             }
6246             }
6247              
6248             # Set comment author if not already user defined.
6249 4161 100       7722 if ( !defined $self->{_comments}->{$row}->{$col}->[3] ) {
6250             $self->{_comments}->{$row}->{$col}->[3] =
6251 4159         6517 $self->{_comments_author};
6252             }
6253              
6254 4161         9713 push @comments, $self->{_comments}->{$row}->{$col};
6255             }
6256             }
6257              
6258 57         122 push @{ $self->{_external_vml_links} },
  57         312  
6259             [ '/vmlDrawing', '../drawings/vmlDrawing' . $vml_drawing_id . '.vml' ];
6260              
6261 57 100       272 if ( $self->{_has_comments} ) {
6262              
6263 43         118 $self->{_comments_array} = \@comments;
6264              
6265 43         106 push @{ $self->{_external_comment_links} },
  43         186  
6266             [ '/comments', '../comments' . $comment_id . '.xml' ];
6267             }
6268              
6269 57         138 my $count = scalar @comments;
6270 57         105 my $start_data_id = $vml_data_id;
6271              
6272             # The VML o:idmap data id contains a comma separated range when there is
6273             # more than one 1024 block of comments, like this: data="1,2".
6274 57         283 for my $i ( 1 .. int( $count / 1024 ) ) {
6275 4         11 $vml_data_id = "$vml_data_id," . ( $start_data_id + $i );
6276             }
6277              
6278 57         154 $self->{_vml_data_id} = $vml_data_id;
6279 57         109 $self->{_vml_shape_id} = $vml_shape_id;
6280              
6281 57         243 return $count;
6282             }
6283              
6284              
6285             ###############################################################################
6286             #
6287             # _prepare_header_vml_objects()
6288             #
6289             # Set up external linkage for VML header/footer images.
6290             #
6291             sub _prepare_header_vml_objects {
6292              
6293 22     22   89 my $self = shift;
6294 22         46 my $vml_header_id = shift;
6295 22         352 my $vml_drawing_id = shift;
6296              
6297 22         202 $self->{_vml_header_id} = $vml_header_id;
6298              
6299 22         378 push @{ $self->{_external_vml_links} },
  22         282  
6300             [ '/vmlDrawing', '../drawings/vmlDrawing' . $vml_drawing_id . '.vml' ];
6301             }
6302              
6303              
6304             ###############################################################################
6305             #
6306             # _prepare_tables()
6307             #
6308             # Set the table ids for the worksheet tables.
6309             #
6310             sub _prepare_tables {
6311              
6312 39     39   165 my $self = shift;
6313 39         104 my $table_id = shift;
6314 39         77 my $seen = shift;
6315              
6316              
6317 39         83 for my $table ( @{ $self->{_tables} } ) {
  39         121  
6318              
6319 47         125 $table-> {_id} = $table_id;
6320              
6321             # Set the table name unless defined by the user.
6322 47 100       162 if ( !defined $table->{_name} ) {
6323              
6324             # Set a default name.
6325 46         155 $table->{_name} = 'Table' . $table_id;
6326             }
6327              
6328             # Check for duplicate table names.
6329 47         123 my $name = lc $table->{_name};
6330              
6331 47 50       161 if ( exists $seen->{$name} ) {
6332 0         0 die "error: invalid duplicate table name '$table->{_name}' found";
6333             }
6334             else {
6335 47         133 $seen->{$name} = 1;
6336             }
6337              
6338             # Store the link used for the rels file.
6339 47         188 my $link = [ '/table', '../tables/table' . $table_id . '.xml' ];
6340              
6341 47         86 push @{ $self->{_external_table_links} }, $link;
  47         131  
6342 47         180 $table_id++;
6343             }
6344             }
6345              
6346              
6347             ###############################################################################
6348             #
6349             # _comment_params()
6350             #
6351             # This method handles the additional optional parameters to write_comment() as
6352             # well as calculating the comment object position and vertices.
6353             #
6354             sub _comment_params {
6355              
6356 4161     4161   5170 my $self = shift;
6357              
6358 4161         5150 my $row = shift;
6359 4161         4780 my $col = shift;
6360 4161         4982 my $string = shift;
6361              
6362 4161         4788 my $default_width = 128;
6363 4161         4825 my $default_height = 74;
6364              
6365 4161         17561 my %params = (
6366             author => undef,
6367             color => 81,
6368             start_cell => undef,
6369             start_col => undef,
6370             start_row => undef,
6371             visible => undef,
6372             width => $default_width,
6373             height => $default_height,
6374             x_offset => undef,
6375             x_scale => 1,
6376             y_offset => undef,
6377             y_scale => 1,
6378             font => 'Tahoma',
6379             font_size => 8,
6380             font_family => 2,
6381             );
6382              
6383              
6384             # Overwrite the defaults with any user supplied values. Incorrect or
6385             # misspelled parameters are silently ignored.
6386 4161         22696 %params = ( %params, @_ );
6387              
6388              
6389             # Ensure that a width and height have been set.
6390 4161 50       9592 $params{width} = $default_width if not $params{width};
6391 4161 50       6362 $params{height} = $default_height if not $params{height};
6392              
6393              
6394             # Limit the string to the max number of chars.
6395 4161         5007 my $max_len = 32767;
6396              
6397 4161 50       6881 if ( length( $string ) > $max_len ) {
6398 0         0 $string = substr( $string, 0, $max_len );
6399             }
6400              
6401              
6402             # Set the comment background colour.
6403 4161         5232 my $color = $params{color};
6404 4161         9074 my $color_id = &Excel::Writer::XLSX::Format::_get_color( $color );
6405              
6406 4161 50       8752 if ( $color_id =~ m/^#[0-9A-F]{6}$/i ) {
    100          
6407 0         0 $params{color} = $color_id;
6408             }
6409             elsif ( $color_id == 0 ) {
6410 4160         6740 $params{color} = '#ffffe1';
6411             }
6412             else {
6413 1         2 my $palette = $self->{_palette};
6414              
6415             # Get the RGB color from the palette.
6416 1         2 my @rgb = @{ $palette->[ $color_id - 8 ] };
  1         5  
6417 1         7 my $rgb_color = sprintf "%02x%02x%02x", @rgb[0, 1, 2];
6418              
6419             # Minor modification to allow comparison testing. Change RGB colors
6420             # from long format, ffcc00 to short format fc0 used by VML.
6421 1         11 $rgb_color =~ s/^([0-9a-f])\1([0-9a-f])\2([0-9a-f])\3$/$1$2$3/;
6422              
6423 1         7 $params{color} = sprintf "#%s [%d]", $rgb_color, $color_id;
6424             }
6425              
6426              
6427             # Convert a cell reference to a row and column.
6428 4161 50       6608 if ( defined $params{start_cell} ) {
6429 0         0 my ( $row, $col ) = $self->_substitute_cellref( $params{start_cell} );
6430 0         0 $params{start_row} = $row;
6431 0         0 $params{start_col} = $col;
6432             }
6433              
6434              
6435             # Set the default start cell and offsets for the comment. These are
6436             # generally fixed in relation to the parent cell. However there are
6437             # some edge cases for cells at the, er, edges.
6438             #
6439 4161         5360 my $row_max = $self->{_xls_rowmax};
6440 4161         4993 my $col_max = $self->{_xls_colmax};
6441              
6442 4161 50       6716 if ( not defined $params{start_row} ) {
6443              
6444 4161 100       10216 if ( $row == 0 ) { $params{start_row} = 0 }
  53 50       89  
    50          
    100          
6445 0         0 elsif ( $row == $row_max - 3 ) { $params{start_row} = $row_max - 7 }
6446 0         0 elsif ( $row == $row_max - 2 ) { $params{start_row} = $row_max - 6 }
6447 1         3 elsif ( $row == $row_max - 1 ) { $params{start_row} = $row_max - 5 }
6448 4107         5123 else { $params{start_row} = $row - 1 }
6449             }
6450              
6451 4161 100       6316 if ( not defined $params{y_offset} ) {
6452              
6453 4160 100       9336 if ( $row == 0 ) { $params{y_offset} = 2 }
  53 50       88  
    50          
    100          
6454 0         0 elsif ( $row == $row_max - 3 ) { $params{y_offset} = 16 }
6455 0         0 elsif ( $row == $row_max - 2 ) { $params{y_offset} = 16 }
6456 1         2 elsif ( $row == $row_max - 1 ) { $params{y_offset} = 14 }
6457 4106         5147 else { $params{y_offset} = 10 }
6458             }
6459              
6460 4161 50       6304 if ( not defined $params{start_col} ) {
6461              
6462 4161 50       8340 if ( $col == $col_max - 3 ) { $params{start_col} = $col_max - 6 }
  0 50       0  
    100          
6463 0         0 elsif ( $col == $col_max - 2 ) { $params{start_col} = $col_max - 5 }
6464 1         2 elsif ( $col == $col_max - 1 ) { $params{start_col} = $col_max - 4 }
6465 4160         5453 else { $params{start_col} = $col + 1 }
6466             }
6467              
6468 4161 50       6147 if ( not defined $params{x_offset} ) {
6469              
6470 4161 50       8322 if ( $col == $col_max - 3 ) { $params{x_offset} = 49 }
  0 50       0  
    100          
6471 0         0 elsif ( $col == $col_max - 2 ) { $params{x_offset} = 49 }
6472 1         2 elsif ( $col == $col_max - 1 ) { $params{x_offset} = 49 }
6473 4160         4972 else { $params{x_offset} = 15 }
6474             }
6475              
6476              
6477             # Scale the size of the comment box if required.
6478 4161 50       6450 if ( $params{x_scale} ) {
6479 4161         6453 $params{width} = $params{width} * $params{x_scale};
6480             }
6481              
6482 4161 50       6126 if ( $params{y_scale} ) {
6483 4161         5334 $params{height} = $params{height} * $params{y_scale};
6484             }
6485              
6486             # Round the dimensions to the nearest pixel.
6487 4161         7809 $params{width} = int( 0.5 + $params{width} );
6488 4161         5823 $params{height} = int( 0.5 + $params{height} );
6489              
6490             # Calculate the positions of comment object.
6491             my @vertices = $self->_position_object_pixels(
6492             $params{start_col}, $params{start_row}, $params{x_offset},
6493             $params{y_offset}, $params{width}, $params{height}
6494 4161         8924 );
6495              
6496             # Add the width and height for VML.
6497 4161         6805 push @vertices, ( $params{width}, $params{height} );
6498              
6499             return (
6500             $row,
6501             $col,
6502             $string,
6503              
6504             $params{author},
6505             $params{visible},
6506             $params{color},
6507             $params{font},
6508             $params{font_size},
6509             $params{font_family},
6510              
6511 4161         33775 [@vertices],
6512             );
6513             }
6514              
6515              
6516             ###############################################################################
6517             #
6518             # _button_params()
6519             #
6520             # This method handles the parameters passed to insert_button() as well as
6521             # calculating the button object position and vertices.
6522             #
6523             sub _button_params {
6524              
6525 28     28   52 my $self = shift;
6526 28         71 my $row = shift;
6527 28         54 my $col = shift;
6528 28         64 my $params = shift;
6529 28         114 my $button = { _row => $row, _col => $col };
6530              
6531 28         55 my $button_number = 1 + @{ $self->{_buttons_array} };
  28         94  
6532              
6533             # Set the button caption.
6534 28         51 my $caption = $params->{caption};
6535              
6536             # Set a default caption if none was specified by user.
6537 28 100       87 if ( !defined $caption ) {
6538 24         65 $caption = 'Button ' . $button_number;
6539             }
6540              
6541 28         103 $button->{_font}->{_caption} = $caption;
6542              
6543              
6544             # Set the macro name.
6545 28 100       88 if ( $params->{macro} ) {
6546 5         20 $button->{_macro} = '[0]!' . $params->{macro};
6547             }
6548             else {
6549 23         78 $button->{_macro} = '[0]!Button' . $button_number . '_Click';
6550             }
6551              
6552              
6553             # Ensure that a width and height have been set.
6554 28         64 my $default_width = $self->{_default_col_pixels};
6555 28         59 my $default_height = $self->{_default_row_pixels};
6556 28 100       113 $params->{width} = $default_width if !$params->{width};
6557 28 100       90 $params->{height} = $default_height if !$params->{height};
6558              
6559             # Set the x/y offsets.
6560 28 100       107 $params->{x_offset} = 0 if !$params->{x_offset};
6561 28 100       78 $params->{y_offset} = 0 if !$params->{y_offset};
6562              
6563             # Scale the size of the button box if required.
6564 28 100       76 if ( $params->{x_scale} ) {
6565 1         2 $params->{width} = $params->{width} * $params->{x_scale};
6566             }
6567              
6568 28 100       78 if ( $params->{y_scale} ) {
6569 1         3 $params->{height} = $params->{height} * $params->{y_scale};
6570             }
6571              
6572             # Round the dimensions to the nearest pixel.
6573 28         210 $params->{width} = int( 0.5 + $params->{width} );
6574 28         143 $params->{height} = int( 0.5 + $params->{height} );
6575              
6576 28         299 $params->{start_row} = $row;
6577 28         213 $params->{start_col} = $col;
6578              
6579             # Calculate the positions of button object.
6580             my @vertices = $self->_position_object_pixels(
6581             $params->{start_col}, $params->{start_row}, $params->{x_offset},
6582             $params->{y_offset}, $params->{width}, $params->{height}
6583 28         136 );
6584              
6585             # Add the width and height for VML.
6586 28         86 push @vertices, ( $params->{width}, $params->{height} );
6587              
6588 28         67 $button->{_vertices} = \@vertices;
6589              
6590 28         71 return $button;
6591             }
6592              
6593              
6594             ###############################################################################
6595             #
6596             # Deprecated methods for backwards compatibility.
6597             #
6598             ###############################################################################
6599              
6600              
6601             # This method was mainly only required for Excel 5.
6602       0 0   sub write_url_range { }
6603              
6604             # Deprecated UTF-16 method required for the Excel 5 format.
6605             sub write_utf16be_string {
6606              
6607 1     1 0 8 my $self = shift;
6608              
6609             # Convert A1 notation if present.
6610 1 50       10 @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/;
6611              
6612             # Check the number of args.
6613 1 50       3 return -1 if @_ < 3;
6614              
6615             # Convert UTF16 string to UTF8.
6616 1         6 require Encode;
6617 1         11 my $utf8_string = Encode::decode( 'UTF-16BE', $_[2] );
6618              
6619 1         2643 return $self->write_string( $_[0], $_[1], $utf8_string, $_[3] );
6620             }
6621              
6622             # Deprecated UTF-16 method required for the Excel 5 format.
6623             sub write_utf16le_string {
6624              
6625 1     1 0 6 my $self = shift;
6626              
6627             # Convert A1 notation if present.
6628 1 50       6 @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/;
6629              
6630             # Check the number of args.
6631 1 50       3 return -1 if @_ < 3;
6632              
6633             # Convert UTF16 string to UTF8.
6634 1         5 require Encode;
6635 1         6 my $utf8_string = Encode::decode( 'UTF-16LE', $_[2] );
6636              
6637 1         22 return $self->write_string( $_[0], $_[1], $utf8_string, $_[3] );
6638             }
6639              
6640             # No longer required. Was used to avoid slow formula parsing.
6641             sub store_formula {
6642              
6643 5     5 0 2588 my $self = shift;
6644 5         12 my $string = shift;
6645              
6646 5         53 my @tokens = split /(\$?[A-I]?[A-Z]\$?\d+)/, $string;
6647              
6648 5         18 return \@tokens;
6649             }
6650              
6651             # No longer required. Was used to avoid slow formula parsing.
6652             sub repeat_formula {
6653              
6654 5     5 0 32 my $self = shift;
6655              
6656             # Convert A1 notation if present.
6657 5 50       30 @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/;
6658              
6659 5 50       42 if ( @_ < 2 ) { return -1 } # Check the number of args
  0         0  
6660              
6661 5         12 my $row = shift; # Zero indexed row
6662 5         8 my $col = shift; # Zero indexed column
6663 5         9 my $formula_ref = shift; # Array ref with formula tokens
6664 5         7 my $format = shift; # XF format
6665 5         16 my @pairs = @_; # Pattern/replacement pairs
6666              
6667              
6668             # Enforce an even number of arguments in the pattern/replacement list.
6669 5 50       15 croak "Odd number of elements in pattern/replacement list" if @pairs % 2;
6670              
6671             # Check that $formula is an array ref.
6672 5 50       18 croak "Not a valid formula" if ref $formula_ref ne 'ARRAY';
6673              
6674 5         14 my @tokens = @$formula_ref;
6675              
6676             # Allow the user to specify the result of the formula by appending a
6677             # result => $value pair to the end of the arguments.
6678 5         9 my $value = undef;
6679 5 50 66     23 if ( @pairs && $pairs[-2] eq 'result' ) {
6680 0         0 $value = pop @pairs;
6681 0         0 pop @pairs;
6682             }
6683              
6684             # Make the substitutions.
6685 5         14 while ( @pairs ) {
6686 6         12 my $pattern = shift @pairs;
6687 6         11 my $replace = shift @pairs;
6688              
6689 6         13 foreach my $token ( @tokens ) {
6690 16 100       91 last if $token =~ s/$pattern/$replace/;
6691             }
6692             }
6693              
6694 5         16 my $formula = join '', @tokens;
6695              
6696 5         16 return $self->write_formula( $row, $col, $formula, $format, $value );
6697             }
6698              
6699              
6700             ###############################################################################
6701             #
6702             # XML writing methods.
6703             #
6704             ###############################################################################
6705              
6706              
6707             ###############################################################################
6708             #
6709             # _write_worksheet()
6710             #
6711             # Write the element. This is the root element of Worksheet.
6712             #
6713             sub _write_worksheet {
6714              
6715 1034     1034   2678 my $self = shift;
6716 1034         2642 my $schema = 'http://schemas.openxmlformats.org/';
6717 1034         3947 my $xmlns = $schema . 'spreadsheetml/2006/main';
6718 1034         3041 my $xmlns_r = $schema . 'officeDocument/2006/relationships';
6719 1034         3069 my $xmlns_mc = $schema . 'markup-compatibility/2006';
6720              
6721 1034         3888 my @attributes = (
6722             'xmlns' => $xmlns,
6723             'xmlns:r' => $xmlns_r,
6724             );
6725              
6726 1034 100       4650 if ( $self->{_excel_version} == 2010 ) {
6727 23         77 push @attributes, ( 'xmlns:mc' => $xmlns_mc );
6728              
6729 23         70 push @attributes,
6730             ( 'xmlns:x14ac' => 'http://schemas.microsoft.com/'
6731             . 'office/spreadsheetml/2009/9/ac' );
6732              
6733 23         58 push @attributes, ( 'mc:Ignorable' => 'x14ac' );
6734              
6735             }
6736              
6737 1034         7811 $self->xml_start_tag( 'worksheet', @attributes );
6738             }
6739              
6740              
6741             ###############################################################################
6742             #
6743             # _write_sheet_pr()
6744             #
6745             # Write the element for Sheet level properties.
6746             #
6747             sub _write_sheet_pr {
6748              
6749 1036     1036   2414 my $self = shift;
6750 1036         2480 my @attributes = ();
6751              
6752 1036 100 100     17710 if ( !$self->{_fit_page}
      100        
      100        
      100        
6753             && !$self->{_filter_on}
6754             && !$self->{_tab_color}
6755             && !$self->{_outline_changed}
6756             && !$self->{_vba_codename} )
6757             {
6758 1010         2815 return;
6759             }
6760              
6761              
6762 26         90 my $codename = $self->{_vba_codename};
6763 26 100       95 push @attributes, ( 'codeName' => $codename ) if $codename;
6764 26 100       116 push @attributes, ( 'filterMode' => 1 ) if $self->{_filter_on};
6765              
6766 26 100 100     210 if ( $self->{_fit_page}
      100        
6767             || $self->{_tab_color}
6768             || $self->{_outline_changed} )
6769             {
6770 11         61 $self->xml_start_tag( 'sheetPr', @attributes );
6771 11         82 $self->_write_tab_color();
6772 11         46 $self->_write_outline_pr();
6773 11         54 $self->_write_page_set_up_pr();
6774 11         68 $self->xml_end_tag( 'sheetPr' );
6775             }
6776             else {
6777 15         127 $self->xml_empty_tag( 'sheetPr', @attributes );
6778             }
6779             }
6780              
6781              
6782             ##############################################################################
6783             #
6784             # _write_page_set_up_pr()
6785             #
6786             # Write the element.
6787             #
6788             sub _write_page_set_up_pr {
6789              
6790 13     13   42 my $self = shift;
6791              
6792 13 100       43 return unless $self->{_fit_page};
6793              
6794 9         33 my @attributes = ( 'fitToPage' => 1 );
6795              
6796 9         80 $self->xml_empty_tag( 'pageSetUpPr', @attributes );
6797             }
6798              
6799              
6800             ###############################################################################
6801             #
6802             # _write_dimension()
6803             #
6804             # Write the element. This specifies the range of cells in the
6805             # worksheet. As a special case, empty spreadsheets use 'A1' as a range.
6806             #
6807             sub _write_dimension {
6808              
6809 1043     1043   2557 my $self = shift;
6810 1043         2245 my $ref;
6811              
6812 1043 100 100     12578 if ( !defined $self->{_dim_rowmin} && !defined $self->{_dim_colmin} ) {
    100 66        
    100 100        
6813              
6814             # If the min dims are undefined then no dimensions have been set
6815             # and we use the default 'A1'.
6816 255         603 $ref = 'A1';
6817             }
6818             elsif ( !defined $self->{_dim_rowmin} && defined $self->{_dim_colmin} ) {
6819              
6820             # If the row dims aren't set but the column dims are then they
6821             # have been changed via set_column().
6822              
6823 9 100       33 if ( $self->{_dim_colmin} == $self->{_dim_colmax} ) {
6824              
6825             # The dimensions are a single cell and not a range.
6826 6         32 $ref = xl_rowcol_to_cell( 0, $self->{_dim_colmin} );
6827             }
6828             else {
6829              
6830             # The dimensions are a cell range.
6831 3         15 my $cell_1 = xl_rowcol_to_cell( 0, $self->{_dim_colmin} );
6832 3         10 my $cell_2 = xl_rowcol_to_cell( 0, $self->{_dim_colmax} );
6833              
6834 3         11 $ref = $cell_1 . ':' . $cell_2;
6835             }
6836              
6837             }
6838             elsif ($self->{_dim_rowmin} == $self->{_dim_rowmax}
6839             && $self->{_dim_colmin} == $self->{_dim_colmax} )
6840             {
6841              
6842             # The dimensions are a single cell and not a range.
6843 135         849 $ref = xl_rowcol_to_cell( $self->{_dim_rowmin}, $self->{_dim_colmin} );
6844             }
6845             else {
6846              
6847             # The dimensions are a cell range.
6848             my $cell_1 =
6849 644         3973 xl_rowcol_to_cell( $self->{_dim_rowmin}, $self->{_dim_colmin} );
6850             my $cell_2 =
6851 644         2909 xl_rowcol_to_cell( $self->{_dim_rowmax}, $self->{_dim_colmax} );
6852              
6853 644         2341 $ref = $cell_1 . ':' . $cell_2;
6854             }
6855              
6856              
6857 1043         4007 my @attributes = ( 'ref' => $ref );
6858              
6859 1043         8396 $self->xml_empty_tag( 'dimension', @attributes );
6860             }
6861              
6862              
6863             ###############################################################################
6864             #
6865             # _write_sheet_views()
6866             #
6867             # Write the element.
6868             #
6869             sub _write_sheet_views {
6870              
6871 1106     1106   2668 my $self = shift;
6872              
6873 1106         3002 my @attributes = ();
6874              
6875 1106         4817 $self->xml_start_tag( 'sheetViews', @attributes );
6876 1106         4846 $self->_write_sheet_view();
6877 1106         7824 $self->xml_end_tag( 'sheetViews' );
6878             }
6879              
6880              
6881             ###############################################################################
6882             #
6883             # _write_sheet_view()
6884             #
6885             # Write the element.
6886             #
6887             # Sample structure:
6888             #
6889             # showGridLines="0"
6890             # showRowColHeaders="0"
6891             # showZeros="0"
6892             # rightToLeft="1"
6893             # tabSelected="1"
6894             # showRuler="0"
6895             # showOutlineSymbols="0"
6896             # view="pageLayout"
6897             # zoomScale="121"
6898             # zoomScaleNormal="121"
6899             # workbookViewId="0"
6900             # />
6901             #
6902             sub _write_sheet_view {
6903              
6904 1113     1113   2681 my $self = shift;
6905 1113         2802 my $gridlines = $self->{_screen_gridlines};
6906 1113         2810 my $show_zeros = $self->{_show_zeros};
6907 1113         2654 my $right_to_left = $self->{_right_to_left};
6908 1113         2740 my $tab_selected = $self->{_selected};
6909 1113         2592 my $view = $self->{_page_view};
6910 1113         2689 my $zoom = $self->{_zoom};
6911 1113         2467 my $row_col_headers = $self->{_hide_row_col_headers};
6912 1113         2257 my $workbook_view_id = 0;
6913 1113         2996 my @attributes = ();
6914              
6915             # Hide screen gridlines if required.
6916 1113 100       4038 if ( !$gridlines ) {
6917 3         8 push @attributes, ( 'showGridLines' => 0 );
6918             }
6919              
6920             # Hide the row/column headers.
6921 1113 100       3790 if ( $row_col_headers ) {
6922 1         2 push @attributes, ( 'showRowColHeaders' => 0 );
6923             }
6924              
6925             # Hide zeroes in cells.
6926 1113 100       3955 if ( !$show_zeros ) {
6927 1         3 push @attributes, ( 'showZeros' => 0 );
6928             }
6929              
6930             # Display worksheet right to left for Hebrew, Arabic and others.
6931 1113 100       3830 if ( $right_to_left ) {
6932 1         2 push @attributes, ( 'rightToLeft' => 1 );
6933             }
6934              
6935             # Show that the sheet tab is selected.
6936 1113 100       4213 if ( $tab_selected ) {
6937 964         3418 push @attributes, ( 'tabSelected' => 1 );
6938             }
6939              
6940              
6941             # Turn outlines off. Also required in the outlinePr element.
6942 1113 100       4216 if ( !$self->{_outline_on} ) {
6943 1         3 push @attributes, ( "showOutlineSymbols" => 0 );
6944             }
6945              
6946             # Set the page view/layout mode if required.
6947             # TODO. Add pageBreakPreview mode when requested.
6948 1113 100       4238 if ( $view ) {
6949 2         6 push @attributes, ( 'view' => 'pageLayout' );
6950             }
6951              
6952             # Set the zoom level.
6953 1113 100       4372 if ( $zoom != 100 ) {
6954 2 50       6 push @attributes, ( 'zoomScale' => $zoom ) unless $view;
6955             push @attributes, ( 'zoomScaleNormal' => $zoom )
6956 2 100       8 if $self->{_zoom_scale_normal};
6957             }
6958              
6959 1113         3106 push @attributes, ( 'workbookViewId' => $workbook_view_id );
6960              
6961 1113 100 100     2313 if ( @{ $self->{_panes} } || @{ $self->{_selections} } ) {
  1113         5834  
  1061         4798  
6962 69         238 $self->xml_start_tag( 'sheetView', @attributes );
6963 69         227 $self->_write_panes();
6964 69         237 $self->_write_selections();
6965 69         327 $self->xml_end_tag( 'sheetView' );
6966             }
6967             else {
6968 1044         5032 $self->xml_empty_tag( 'sheetView', @attributes );
6969             }
6970             }
6971              
6972              
6973             ###############################################################################
6974             #
6975             # _write_selections()
6976             #
6977             # Write the elements.
6978             #
6979             sub _write_selections {
6980              
6981 69     69   146 my $self = shift;
6982              
6983 69         171 for my $selection ( @{ $self->{_selections} } ) {
  69         179  
6984 105         259 $self->_write_selection( @$selection );
6985             }
6986             }
6987              
6988              
6989             ###############################################################################
6990             #
6991             # _write_selection()
6992             #
6993             # Write the element.
6994             #
6995             sub _write_selection {
6996              
6997 106     106   165 my $self = shift;
6998 106         148 my $pane = shift;
6999 106         152 my $active_cell = shift;
7000 106         157 my $sqref = shift;
7001 106         164 my @attributes = ();
7002              
7003 106 100       275 push @attributes, ( 'pane' => $pane ) if $pane;
7004 106 100       242 push @attributes, ( 'activeCell' => $active_cell ) if $active_cell;
7005 106 100       227 push @attributes, ( 'sqref' => $sqref ) if $sqref;
7006              
7007 106         266 $self->xml_empty_tag( 'selection', @attributes );
7008             }
7009              
7010              
7011             ###############################################################################
7012             #
7013             # _write_sheet_format_pr()
7014             #
7015             # Write the element.
7016             #
7017             sub _write_sheet_format_pr {
7018              
7019 1034     1034   2553 my $self = shift;
7020 1034         2125 my $base_col_width = 10;
7021 1034         2833 my $default_row_height = $self->{_default_row_height};
7022 1034         2661 my $row_level = $self->{_outline_row_level};
7023 1034         2658 my $col_level = $self->{_outline_col_level};
7024 1034         2342 my $zero_height = $self->{_default_row_zeroed};
7025              
7026 1034         3310 my @attributes = ( 'defaultRowHeight' => $default_row_height );
7027              
7028 1034 100       4288 if ( $self->{_default_row_height} != $self->{_original_row_height} ) {
7029 4         12 push @attributes, ( 'customHeight' => 1 );
7030             }
7031              
7032 1034 100       4005 if ( $self->{_default_row_zeroed} ) {
7033 3         11 push @attributes, ( 'zeroHeight' => 1 );
7034             }
7035              
7036 1034 100       3500 push @attributes, ( 'outlineLevelRow' => $row_level ) if $row_level;
7037 1034 100       3583 push @attributes, ( 'outlineLevelCol' => $col_level ) if $col_level;
7038              
7039 1034 100       4350 if ( $self->{_excel_version} == 2010 ) {
7040 23         60 push @attributes, ( 'x14ac:dyDescent' => '0.25' );
7041             }
7042              
7043 1034         4265 $self->xml_empty_tag( 'sheetFormatPr', @attributes );
7044             }
7045              
7046              
7047             ##############################################################################
7048             #
7049             # _write_cols()
7050             #
7051             # Write the element and
7052             #
7053             sub _write_cols {
7054              
7055 1033     1033   2435 my $self = shift;
7056              
7057             # Exit unless some column have been formatted.
7058 1033 100       2031 return unless %{ $self->{_colinfo} };
  1033         4387  
7059              
7060 109         501 $self->xml_start_tag( 'cols' );
7061              
7062 109         229 for my $col ( sort keys %{ $self->{_colinfo} } ) {
  109         638  
7063 195         360 $self->_write_col_info( @{ $self->{_colinfo}->{$col} } );
  195         1596  
7064             }
7065              
7066 109         469 $self->xml_end_tag( 'cols' );
7067             }
7068              
7069              
7070             ##############################################################################
7071             #
7072             # _write_col_info()
7073             #
7074             # Write the
7075             #
7076             sub _write_col_info {
7077              
7078 201     201   591 my $self = shift;
7079 201   100     739 my $min = $_[0] || 0; # First formatted column.
7080 201   100     603 my $max = $_[1] || 0; # Last formatted column.
7081 201         375 my $width = $_[2]; # Col width in user units.
7082 201         364 my $format = $_[3]; # Format index.
7083 201   100     787 my $hidden = $_[4] || 0; # Hidden flag.
7084 201   100     826 my $level = $_[5] || 0; # Outline level.
7085 201   50     858 my $collapsed = $_[6] || 0; # Outline level.
7086 201         321 my $custom_width = 1;
7087 201         306 my $xf_index = 0;
7088              
7089             # Get the format index.
7090 201 100       599 if ( ref( $format ) ) {
7091 20         95 $xf_index = $format->get_xf_index();
7092             }
7093              
7094             # Set the Excel default col width.
7095 201 100       618 if ( !defined $width ) {
7096 29 100       101 if ( !$hidden ) {
7097 17         41 $width = 8.43;
7098 17         34 $custom_width = 0;
7099             }
7100             else {
7101 12         26 $width = 0;
7102             }
7103             }
7104             else {
7105              
7106             # Width is defined but same as default.
7107 172 100       582 if ( $width == 8.43 ) {
7108 1         2 $custom_width = 0;
7109             }
7110             }
7111              
7112              
7113             # Convert column width from user units to character width.
7114 201         336 my $max_digit_width = 7; # For Calabri 11.
7115 201         357 my $padding = 5;
7116              
7117 201 100       585 if ( $width > 0 ) {
7118 189 100       501 if ( $width < 1 ) {
7119 22         46 $width =
7120             int( ( int( $width * ($max_digit_width + $padding) + 0.5 ) ) /
7121             $max_digit_width *
7122             256 ) / 256;
7123             }
7124             else {
7125 167         777 $width =
7126             int( ( int( $width * $max_digit_width + 0.5 ) + $padding ) /
7127             $max_digit_width *
7128             256 ) / 256;
7129             }
7130             }
7131              
7132 201         771 my @attributes = (
7133             'min' => $min + 1,
7134             'max' => $max + 1,
7135             'width' => $width,
7136             );
7137              
7138 201 100       516 push @attributes, ( 'style' => $xf_index ) if $xf_index;
7139 201 100       616 push @attributes, ( 'hidden' => 1 ) if $hidden;
7140 201 100       1072 push @attributes, ( 'customWidth' => 1 ) if $custom_width;
7141 201 100       534 push @attributes, ( 'outlineLevel' => $level ) if $level;
7142 201 50       486 push @attributes, ( 'collapsed' => 1 ) if $collapsed;
7143              
7144              
7145 201         736 $self->xml_empty_tag( 'col', @attributes );
7146             }
7147              
7148              
7149             ###############################################################################
7150             #
7151             # _write_sheet_data()
7152             #
7153             # Write the element.
7154             #
7155             sub _write_sheet_data {
7156              
7157 1024     1024   5888 my $self = shift;
7158              
7159 1024 100       4248 if ( not defined $self->{_dim_rowmin} ) {
7160              
7161             # If the dimensions aren't defined then there is no data to write.
7162 264         886 $self->xml_empty_tag( 'sheetData' );
7163             }
7164             else {
7165 760         3548 $self->xml_start_tag( 'sheetData' );
7166 760         3711 $self->_write_rows();
7167 760         2718 $self->xml_end_tag( 'sheetData' );
7168              
7169             }
7170              
7171             }
7172              
7173              
7174             ###############################################################################
7175             #
7176             # _write_optimized_sheet_data()
7177             #
7178             # Write the element when the memory optimisation is on. In which
7179             # case we read the data stored in the temp file and rewrite it to the XML
7180             # sheet file.
7181             #
7182             sub _write_optimized_sheet_data {
7183              
7184 10     10   22 my $self = shift;
7185              
7186 10 50       49 if ( not defined $self->{_dim_rowmin} ) {
7187              
7188             # If the dimensions aren't defined then there is no data to write.
7189 0         0 $self->xml_empty_tag( 'sheetData' );
7190             }
7191             else {
7192              
7193 10         42 $self->xml_start_tag( 'sheetData' );
7194              
7195 10         65 my $xlsx_fh = $self->xml_get_fh();
7196 10         25 my $cell_fh = $self->{_cell_data_fh};
7197              
7198 10         31 my $buffer;
7199              
7200             # Rewind the temp file.
7201 10         454 seek $cell_fh, 0, 0;
7202              
7203 10         313 while ( read( $cell_fh, $buffer, 4_096 ) ) {
7204 14         71 local $\ = undef; # Protect print from -l on commandline.
7205 14         489 print $xlsx_fh $buffer;
7206             }
7207              
7208 10         66 $self->xml_end_tag( 'sheetData' );
7209             }
7210             }
7211              
7212              
7213             ###############################################################################
7214             #
7215             # _write_rows()
7216             #
7217             # Write out the worksheet data as a series of rows and cells.
7218             #
7219             sub _write_rows {
7220              
7221 760     760   1993 my $self = shift;
7222              
7223 760         3729 $self->_calculate_spans();
7224              
7225 760         2546 for my $row_num ( $self->{_dim_rowmin} .. $self->{_dim_rowmax} ) {
7226              
7227             # Skip row if it doesn't contain row formatting, cell data or a comment.
7228 1052962 100 100     3799186 if ( !$self->{_set_rows}->{$row_num}
      100        
7229             && !$self->{_table}->{$row_num}
7230             && !$self->{_comments}->{$row_num} )
7231             {
7232 1048856         1452401 next;
7233             }
7234              
7235 4106         9181 my $span_index = int( $row_num / 16 );
7236 4106         7155 my $span = $self->{_row_spans}->[$span_index];
7237              
7238             # Write the cells if the row contains data.
7239 4106 100       9119 if ( my $row_ref = $self->{_table}->{$row_num} ) {
    100          
7240              
7241 3738 100       8107 if ( !$self->{_set_rows}->{$row_num} ) {
7242 3420         8448 $self->_write_row( $row_num, $span );
7243             }
7244             else {
7245             $self->_write_row( $row_num, $span,
7246 318         420 @{ $self->{_set_rows}->{$row_num} } );
  318         788  
7247             }
7248              
7249              
7250 3738         9323 for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7251 27135 100       58553 if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) {
7252 10217         20114 $self->_write_cell( $row_num, $col_num, $col_ref );
7253             }
7254             }
7255              
7256 3738         9387 $self->xml_end_tag( 'row' );
7257             }
7258             elsif ( $self->{_comments}->{$row_num} ) {
7259              
7260             $self->_write_empty_row( $row_num, $span,
7261 306         424 @{ $self->{_set_rows}->{$row_num} } );
  306         864  
7262             }
7263             else {
7264              
7265             # Row attributes only.
7266             $self->_write_empty_row( $row_num, $span,
7267 62         107 @{ $self->{_set_rows}->{$row_num} } );
  62         192  
7268             }
7269             }
7270             }
7271              
7272              
7273             ###############################################################################
7274             #
7275             # _write_single_row()
7276             #
7277             # Write out the worksheet data as a single row with cells. This method is
7278             # used when memory optimisation is on. A single row is written and the data
7279             # table is reset. That way only one row of data is kept in memory at any one
7280             # time. We don't write span data in the optimised case since it is optional.
7281             #
7282             sub _write_single_row {
7283              
7284 300     300   467 my $self = shift;
7285 300   100     564 my $current_row = shift || 0;
7286 300         455 my $row_num = $self->{_previous_row};
7287              
7288             # Set the new previous row as the current row.
7289 300         384 $self->{_previous_row} = $current_row;
7290              
7291             # Skip row if it doesn't contain row formatting, cell data or a comment.
7292 300 0 66     906 if ( !$self->{_set_rows}->{$row_num}
      33        
7293             && !$self->{_table}->{$row_num}
7294             && !$self->{_comments}->{$row_num} )
7295             {
7296 0         0 return;
7297             }
7298              
7299             # Write the cells if the row contains data.
7300 300 50       502 if ( my $row_ref = $self->{_table}->{$row_num} ) {
7301              
7302 300 100       479 if ( !$self->{_set_rows}->{$row_num} ) {
7303 299         461 $self->_write_row( $row_num );
7304             }
7305             else {
7306             $self->_write_row( $row_num, undef,
7307 1         2 @{ $self->{_set_rows}->{$row_num} } );
  1         6  
7308             }
7309              
7310 300         654 for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7311 344 100       769 if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) {
7312 309         592 $self->_write_cell( $row_num, $col_num, $col_ref );
7313             }
7314             }
7315              
7316 300         653 $self->xml_end_tag( 'row' );
7317             }
7318             else {
7319              
7320             # Row attributes or comments only.
7321             $self->_write_empty_row( $row_num, undef,
7322 0         0 @{ $self->{_set_rows}->{$row_num} } );
  0         0  
7323             }
7324              
7325             # Reset table.
7326 300         848 $self->{_table} = {};
7327              
7328             }
7329              
7330              
7331             ###############################################################################
7332             #
7333             # _calculate_spans()
7334             #
7335             # Calculate the "spans" attribute of the tag. This is an XLSX
7336             # optimisation and isn't strictly required. However, it makes comparing
7337             # files easier.
7338             #
7339             # The span is the same for each block of 16 rows.
7340             #
7341             sub _calculate_spans {
7342              
7343 778     778   1733 my $self = shift;
7344              
7345 778         2981 my @spans;
7346             my $span_min;
7347 778         0 my $span_max;
7348              
7349 778         3318 for my $row_num ( $self->{_dim_rowmin} .. $self->{_dim_rowmax} ) {
7350              
7351             # Calculate spans for cell data.
7352 1053268 100       1854843 if ( my $row_ref = $self->{_table}->{$row_num} ) {
7353              
7354 4044         7666 for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7355 32337 100       55217 if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) {
7356              
7357 10523 100       16392 if ( !defined $span_min ) {
7358 818         1907 $span_min = $col_num;
7359 818         2267 $span_max = $col_num;
7360             }
7361             else {
7362 9705 100       15901 $span_min = $col_num if $col_num < $span_min;
7363 9705 100       18297 $span_max = $col_num if $col_num > $span_max;
7364             }
7365             }
7366             }
7367             }
7368              
7369             # Calculate spans for comments.
7370 1053268 100       1681408 if ( defined $self->{_comments}->{$row_num} ) {
7371              
7372 315         537 for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7373 37003 100       62018 if ( defined $self->{_comments}->{$row_num}->{$col_num} ) {
7374              
7375 4159 100       5077 if ( !defined $span_min ) {
7376 33         56 $span_min = $col_num;
7377 33         79 $span_max = $col_num;
7378             }
7379             else {
7380 4126 50       5481 $span_min = $col_num if $col_num < $span_min;
7381 4126 100       6244 $span_max = $col_num if $col_num > $span_max;
7382             }
7383             }
7384             }
7385             }
7386              
7387 1053268 100 100     2843270 if ( ( ( $row_num + 1 ) % 16 == 0 )
7388             || $row_num == $self->{_dim_rowmax} )
7389             {
7390 66402         101487 my $span_index = int( $row_num / 16 );
7391              
7392 66402 100       121476 if ( defined $span_min ) {
7393 851         1907 $span_min++;
7394 851         1627 $span_max++;
7395 851         3800 $spans[$span_index] = "$span_min:$span_max";
7396 851         2520 $span_min = undef;
7397             }
7398             }
7399             }
7400              
7401 778         3004 $self->{_row_spans} = \@spans;
7402             }
7403              
7404              
7405             ###############################################################################
7406             #
7407             # _write_row()
7408             #
7409             # Write the element.
7410             #
7411             sub _write_row {
7412              
7413 4414     4414   6791 my $self = shift;
7414 4414         6618 my $r = shift;
7415 4414         6301 my $spans = shift;
7416 4414         6044 my $height = shift;
7417 4414         6047 my $format = shift;
7418 4414   100     12066 my $hidden = shift || 0;
7419 4414   100     11777 my $level = shift || 0;
7420 4414   100     11545 my $collapsed = shift || 0;
7421 4414   100     11304 my $empty_row = shift || 0;
7422 4414         6288 my $xf_index = 0;
7423              
7424 4414 100       10110 $height = $self->{_default_row_height} if !defined $height;
7425              
7426 4414         9345 my @attributes = ( 'r' => $r + 1 );
7427              
7428             # Get the format index.
7429 4414 100       9191 if ( ref( $format ) ) {
7430 11         50 $xf_index = $format->get_xf_index();
7431             }
7432              
7433 4414 100       11065 push @attributes, ( 'spans' => $spans ) if defined $spans;
7434 4414 100       8593 push @attributes, ( 's' => $xf_index ) if $xf_index;
7435 4414 100       8594 push @attributes, ( 'customFormat' => 1 ) if $format;
7436              
7437 4414 100       9108 if ( $height != $self->{_original_row_height} ) {
7438 67         154 push @attributes, ( 'ht' => $height );
7439             }
7440              
7441 4414 100       8281 push @attributes, ( 'hidden' => 1 ) if $hidden;
7442              
7443 4414 100       9101 if ( $height != $self->{_original_row_height} ) {
7444 67         137 push @attributes, ( 'customHeight' => 1 );
7445             }
7446              
7447 4414 100       7994 push @attributes, ( 'outlineLevel' => $level ) if $level;
7448 4414 100       8017 push @attributes, ( 'collapsed' => 1 ) if $collapsed;
7449              
7450 4414 100       9337 if ( $self->{_excel_version} == 2010 ) {
7451 60         117 push @attributes, ( 'x14ac:dyDescent' => '0.25' );
7452             }
7453              
7454 4414 100       8322 if ( $empty_row ) {
7455 369         1111 $self->xml_empty_tag_unencoded( 'row', @attributes );
7456             }
7457             else {
7458 4045         13557 $self->xml_start_tag_unencoded( 'row', @attributes );
7459             }
7460             }
7461              
7462              
7463             ###############################################################################
7464             #
7465             # _write_empty_row()
7466             #
7467             # Write and empty element, i.e., attributes only, no cell data.
7468             #
7469             sub _write_empty_row {
7470              
7471 369     369   554 my $self = shift;
7472              
7473             # Set the $empty_row parameter.
7474 369         576 $_[7] = 1;
7475              
7476 369         699 $self->_write_row( @_ );
7477             }
7478              
7479              
7480             ###############################################################################
7481             #
7482             # _write_cell()
7483             #
7484             # Write the element. This is the innermost loop so efficiency is
7485             # important where possible. The basic methodology is that the data of every
7486             # cell type is passed in as follows:
7487             #
7488             # [ $row, $col, $aref]
7489             #
7490             # The aref, called $cell below, contains the following structure in all types:
7491             #
7492             # [ $type, $token, $xf, @args ]
7493             #
7494             # Where $type: represents the cell type, such as string, number, formula, etc.
7495             # $token: is the actual data for the string, number, formula, etc.
7496             # $xf: is the XF format object.
7497             # @args: additional args relevant to the specific data type.
7498             #
7499             sub _write_cell {
7500              
7501 10531     10531   14078 my $self = shift;
7502 10531         14339 my $row = shift;
7503 10531         13502 my $col = shift;
7504 10531         12962 my $cell = shift;
7505 10531         15975 my $type = $cell->[0];
7506 10531         16589 my $token = $cell->[1];
7507 10531         13584 my $xf = $cell->[2];
7508 10531         12802 my $xf_index = 0;
7509              
7510 10531         31748 my %error_codes = (
7511             '#DIV/0!' => 1,
7512             '#N/A' => 1,
7513             '#NAME?' => 1,
7514             '#NULL!' => 1,
7515             '#NUM!' => 1,
7516             '#REF!' => 1,
7517             '#VALUE!' => 1,
7518             );
7519              
7520 10531         18367 my %boolean = ( 'TRUE' => 1, 'FALSE' => 0 );
7521              
7522             # Get the format index.
7523 10531 100       18554 if ( ref( $xf ) ) {
7524 411         1209 $xf_index = $xf->get_xf_index();
7525             }
7526              
7527 10531         18312 my $range = _xl_rowcol_to_cell( $row, $col );
7528 10531         20484 my @attributes = ( 'r' => $range );
7529              
7530             # Add the cell format index.
7531 10531 100 66     33948 if ( $xf_index ) {
    100          
    100          
7532 411         917 push @attributes, ( 's' => $xf_index );
7533             }
7534             elsif ( $self->{_set_rows}->{$row} && $self->{_set_rows}->{$row}->[1] ) {
7535 11         20 my $row_xf = $self->{_set_rows}->{$row}->[1];
7536 11         26 push @attributes, ( 's' => $row_xf->get_xf_index() );
7537             }
7538             elsif ( $self->{_col_formats}->{$col} ) {
7539 17         39 my $col_xf = $self->{_col_formats}->{$col};
7540 17         53 push @attributes, ( 's' => $col_xf->get_xf_index() );
7541             }
7542              
7543              
7544             # Write the various cell types.
7545 10531 100       19554 if ( $type eq 'n' ) {
    100          
    100          
    100          
    100          
    50          
7546              
7547             # Write a number.
7548 7438         18261 $self->xml_number_element( $token, @attributes );
7549             }
7550             elsif ( $type eq 's' ) {
7551              
7552             # Write a string.
7553 2950 100       5184 if ( $self->{_optimization} == 0 ) {
7554 2648         6945 $self->xml_string_element( $token, @attributes );
7555             }
7556             else {
7557              
7558 302         385 my $string = $token;
7559              
7560             # Escape control characters. See SharedString.pm for details.
7561 302         504 $string =~ s/(_x[0-9a-fA-F]{4}_)/_x005F$1/g;
7562 302         566 $string =~ s/([\x00-\x08\x0B-\x1F])/sprintf "_x%04X_", ord($1)/eg;
  30         107  
7563              
7564             # Write any rich strings without further tags.
7565 302 100 66     698 if ( $string =~ m{^} && $string =~ m{$} ) {
7566              
7567 8         42 $self->xml_rich_inline_string( $string, @attributes );
7568             }
7569             else {
7570              
7571             # Add attribute to preserve leading or trailing whitespace.
7572 294         353 my $preserve = 0;
7573 294 100 66     1072 if ( $string =~ /^\s/ || $string =~ /\s$/ ) {
7574 3         5 $preserve = 1;
7575             }
7576              
7577 294         786 $self->xml_inline_string( $string, $preserve, @attributes );
7578             }
7579             }
7580             }
7581             elsif ( $type eq 'f' ) {
7582              
7583             # Write a formula.
7584 75         140 my $value = $cell->[3];
7585              
7586 75 100       166 $value = 0 if !defined $value;
7587              
7588             # Check if the formula value is a string.
7589 75 100 100     416 if ( $value
7590             && $value !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ )
7591             {
7592 17 100       53 if ( exists $boolean{$value} ) {
    100          
7593 2         3 push @attributes, ( 't' => 'b' );
7594 2         4 $value = $boolean{$value};
7595             }
7596             elsif ( exists $error_codes{$value} ) {
7597 8         12 push @attributes, ( 't' => 'e' );
7598             }
7599             else {
7600 7         20 push @attributes, ( 't' => 'str' );
7601 7         20 $value = Excel::Writer::XLSX::Package::XMLwriter::_escape_data(
7602             $value );
7603             }
7604             }
7605              
7606 75         308 $self->xml_formula_element( $token, $value, @attributes );
7607              
7608             }
7609             elsif ( $type eq 'a' ) {
7610              
7611             # Write an array formula.
7612 9         42 $self->xml_start_tag( 'c', @attributes );
7613 9         39 $self->_write_cell_array_formula( $token, $cell->[3] );
7614 9         35 $self->_write_cell_value( $cell->[4] );
7615 9         31 $self->xml_end_tag( 'c' );
7616             }
7617             elsif ( $type eq 'l' ) {
7618              
7619             # Write a boolean value.
7620 4         10 push @attributes, ( 't' => 'b' );
7621              
7622 4         16 $self->xml_start_tag( 'c', @attributes );
7623 4         13 $self->_write_cell_value( $cell->[1] );
7624 4         10 $self->xml_end_tag( 'c' );
7625             }
7626             elsif ( $type eq 'b' ) {
7627              
7628             # Write a empty cell.
7629 55         166 $self->xml_empty_tag( 'c', @attributes );
7630             }
7631             }
7632              
7633              
7634             ###############################################################################
7635             #
7636             # _write_cell_value()
7637             #
7638             # Write the cell value element.
7639             #
7640             sub _write_cell_value {
7641              
7642 14     14   37 my $self = shift;
7643 14 50       54 my $value = defined $_[0] ? $_[0] : '';
7644              
7645 14         66 $self->xml_data_element( 'v', $value );
7646             }
7647              
7648              
7649             ###############################################################################
7650             #
7651             # _write_cell_formula()
7652             #
7653             # Write the cell formula element.
7654             #
7655             sub _write_cell_formula {
7656              
7657 0     0   0 my $self = shift;
7658 0 0       0 my $formula = defined $_[0] ? $_[0] : '';
7659              
7660 0         0 $self->xml_data_element( 'f', $formula );
7661             }
7662              
7663              
7664             ###############################################################################
7665             #
7666             # _write_cell_array_formula()
7667             #
7668             # Write the cell array formula element.
7669             #
7670             sub _write_cell_array_formula {
7671              
7672 9     9   20 my $self = shift;
7673 9         12 my $formula = shift;
7674 9         17 my $range = shift;
7675              
7676 9         29 my @attributes = ( 't' => 'array', 'ref' => $range );
7677              
7678 9         49 $self->xml_data_element( 'f', $formula, @attributes );
7679             }
7680              
7681              
7682             ##############################################################################
7683             #
7684             # _write_sheet_calc_pr()
7685             #
7686             # Write the element for the worksheet calculation properties.
7687             #
7688             sub _write_sheet_calc_pr {
7689              
7690 1     1   8 my $self = shift;
7691 1         2 my $full_calc_on_load = 1;
7692              
7693 1         3 my @attributes = ( 'fullCalcOnLoad' => $full_calc_on_load );
7694              
7695 1         8 $self->xml_empty_tag( 'sheetCalcPr', @attributes );
7696             }
7697              
7698              
7699             ###############################################################################
7700             #
7701             # _write_phonetic_pr()
7702             #
7703             # Write the element.
7704             #
7705             sub _write_phonetic_pr {
7706              
7707 9     9   39 my $self = shift;
7708 9         17 my $font_id = 0;
7709 9         26 my $type = 'noConversion';
7710              
7711 9         32 my @attributes = (
7712             'fontId' => $font_id,
7713             'type' => $type,
7714             );
7715              
7716 9         52 $self->xml_empty_tag( 'phoneticPr', @attributes );
7717             }
7718              
7719              
7720             ###############################################################################
7721             #
7722             # _write_page_margins()
7723             #
7724             # Write the element.
7725             #
7726             sub _write_page_margins {
7727              
7728 1065     1065   2296 my $self = shift;
7729              
7730             my @attributes = (
7731             'left' => $self->{_margin_left},
7732             'right' => $self->{_margin_right},
7733             'top' => $self->{_margin_top},
7734             'bottom' => $self->{_margin_bottom},
7735             'header' => $self->{_margin_header},
7736             'footer' => $self->{_margin_footer},
7737 1065         6391 );
7738              
7739 1065         5498 $self->xml_empty_tag( 'pageMargins', @attributes );
7740             }
7741              
7742              
7743             ###############################################################################
7744             #
7745             # _write_page_setup()
7746             #
7747             # Write the element.
7748             #
7749             # The following is an example taken from Excel.
7750             #
7751             #
7752             # paperSize="9"
7753             # scale="110"
7754             # fitToWidth="2"
7755             # fitToHeight="2"
7756             # pageOrder="overThenDown"
7757             # orientation="portrait"
7758             # blackAndWhite="1"
7759             # draft="1"
7760             # horizontalDpi="200"
7761             # verticalDpi="200"
7762             # r:id="rId1"
7763             # />
7764             #
7765             sub _write_page_setup {
7766              
7767 1059     1059   2788 my $self = shift;
7768 1059         2514 my @attributes = ();
7769              
7770 1059 100       4278 return unless $self->{_page_setup_changed};
7771              
7772             # Set paper size.
7773 23 100       72 if ( $self->{_paper_size} ) {
7774 19         65 push @attributes, ( 'paperSize' => $self->{_paper_size} );
7775             }
7776              
7777             # Set the print_scale
7778 23 100       91 if ( $self->{_print_scale} != 100 ) {
7779 3         9 push @attributes, ( 'scale' => $self->{_print_scale} );
7780             }
7781              
7782             # Set the "Fit to page" properties.
7783 23 100 100     133 if ( $self->{_fit_page} && $self->{_fit_width} != 1 ) {
7784 3         10 push @attributes, ( 'fitToWidth' => $self->{_fit_width} );
7785             }
7786              
7787 23 100 100     122 if ( $self->{_fit_page} && $self->{_fit_height} != 1 ) {
7788 4         10 push @attributes, ( 'fitToHeight' => $self->{_fit_height} );
7789             }
7790              
7791             # Set the page print direction.
7792 23 100       122 if ( $self->{_page_order} ) {
7793 2         4 push @attributes, ( 'pageOrder' => "overThenDown" );
7794             }
7795              
7796             # Set start page.
7797 23 100       87 if ( $self->{_page_start} > 1 ) {
7798 2         6 push @attributes, ( 'firstPageNumber' => $self->{_page_start} );
7799             }
7800              
7801             # Set page orientation.
7802 23 100       107 if ( $self->{_orientation} == 0 ) {
7803 2         6 push @attributes, ( 'orientation' => 'landscape' );
7804             }
7805             else {
7806 21         84 push @attributes, ( 'orientation' => 'portrait' );
7807             }
7808              
7809             # Set print in black and white option.
7810 23 100       99 if ( $self->{_black_white} ) {
7811 1         2 push @attributes, ( 'blackAndWhite' => 1 );
7812             }
7813              
7814             # Set start page.
7815 23 100       108 if ( $self->{_page_start} != 0 ) {
7816 3         9 push @attributes, ( 'useFirstPageNumber' => 1 );
7817             }
7818              
7819             # Set the DPI. Mainly only for testing.
7820 23 50       75 if ( $self->{_horizontal_dpi} ) {
7821 0         0 push @attributes, ( 'horizontalDpi' => $self->{_horizontal_dpi} );
7822             }
7823              
7824 23 100       86 if ( $self->{_vertical_dpi} ) {
7825 5         15 push @attributes, ( 'verticalDpi' => $self->{_vertical_dpi} );
7826             }
7827              
7828              
7829 23         131 $self->xml_empty_tag( 'pageSetup', @attributes );
7830             }
7831              
7832              
7833             ##############################################################################
7834             #
7835             # _write_merge_cells()
7836             #
7837             # Write the element.
7838             #
7839             sub _write_merge_cells {
7840              
7841 1036     1036   2896 my $self = shift;
7842 1036         2655 my $merged_cells = $self->{_merge};
7843 1036         2610 my $count = @$merged_cells;
7844              
7845 1036 100       4302 return unless $count;
7846              
7847 14         41 my @attributes = ( 'count' => $count );
7848              
7849 14         78 $self->xml_start_tag( 'mergeCells', @attributes );
7850              
7851 14         35 for my $merged_range ( @$merged_cells ) {
7852              
7853             # Write the mergeCell element.
7854 27         99 $self->_write_merge_cell( $merged_range );
7855             }
7856              
7857 14         49 $self->xml_end_tag( 'mergeCells' );
7858             }
7859              
7860              
7861             ##############################################################################
7862             #
7863             # _write_merge_cell()
7864             #
7865             # Write the element.
7866             #
7867             sub _write_merge_cell {
7868              
7869 28     28   56 my $self = shift;
7870 28         42 my $merged_range = shift;
7871 28         82 my ( $row_min, $col_min, $row_max, $col_max ) = @$merged_range;
7872              
7873              
7874             # Convert the merge dimensions to a cell range.
7875 28         84 my $cell_1 = xl_rowcol_to_cell( $row_min, $col_min );
7876 28         74 my $cell_2 = xl_rowcol_to_cell( $row_max, $col_max );
7877 28         70 my $ref = $cell_1 . ':' . $cell_2;
7878              
7879 28         94 my @attributes = ( 'ref' => $ref );
7880              
7881 28         158 $self->xml_empty_tag( 'mergeCell', @attributes );
7882             }
7883              
7884              
7885             ##############################################################################
7886             #
7887             # _write_print_options()
7888             #
7889             # Write the element.
7890             #
7891             sub _write_print_options {
7892              
7893 1062     1062   2519 my $self = shift;
7894 1062         3292 my @attributes = ();
7895              
7896 1062 100       4227 return unless $self->{_print_options_changed};
7897              
7898             # Set horizontal centering.
7899 10 100       28 if ( $self->{_hcenter} ) {
7900 4         12 push @attributes, ( 'horizontalCentered' => 1 );
7901             }
7902              
7903             # Set vertical centering.
7904 10 100       26 if ( $self->{_vcenter} ) {
7905 4         10 push @attributes, ( 'verticalCentered' => 1 );
7906             }
7907              
7908             # Enable row and column headers.
7909 10 100       26 if ( $self->{_print_headers} ) {
7910 2         6 push @attributes, ( 'headings' => 1 );
7911             }
7912              
7913             # Set printed gridlines.
7914 10 100       39 if ( $self->{_print_gridlines} ) {
7915 4         11 push @attributes, ( 'gridLines' => 1 );
7916             }
7917              
7918              
7919 10         39 $self->xml_empty_tag( 'printOptions', @attributes );
7920             }
7921              
7922              
7923             ##############################################################################
7924             #
7925             # _write_header_footer()
7926             #
7927             # Write the element.
7928             #
7929             sub _write_header_footer {
7930              
7931 1057     1057   2854 my $self = shift;
7932 1057         2539 my @attributes = ();
7933              
7934 1057 100       4120 if ( !$self->{_header_footer_scales} ) {
7935 2         5 push @attributes, ( 'scaleWithDoc' => 0 );
7936             }
7937              
7938 1057 100       4057 if ( !$self->{_header_footer_aligns} ) {
7939 10         27 push @attributes, ( 'alignWithMargins' => 0 );
7940             }
7941              
7942 1057 100       6316 if ( $self->{_header_footer_changed} ) {
    100          
7943 32         132 $self->xml_start_tag( 'headerFooter', @attributes );
7944 32 100       191 $self->_write_odd_header() if $self->{_header};
7945 32 100       169 $self->_write_odd_footer() if $self->{_footer};
7946 32         137 $self->xml_end_tag( 'headerFooter' );
7947             }
7948             elsif ( $self->{_excel2003_style} ) {
7949 7         26 $self->xml_empty_tag( 'headerFooter', @attributes );
7950             }
7951             }
7952              
7953              
7954             ##############################################################################
7955             #
7956             # _write_odd_header()
7957             #
7958             # Write the element.
7959             #
7960             sub _write_odd_header {
7961              
7962 30     30   67 my $self = shift;
7963 30         61 my $data = $self->{_header};
7964              
7965 30         215 $self->xml_data_element( 'oddHeader', $data );
7966             }
7967              
7968              
7969             ##############################################################################
7970             #
7971             # _write_odd_footer()
7972             #
7973             # Write the element.
7974             #
7975             sub _write_odd_footer {
7976              
7977 14     14   35 my $self = shift;
7978 14         47 my $data = $self->{_footer};
7979              
7980 14         76 $self->xml_data_element( 'oddFooter', $data );
7981             }
7982              
7983              
7984             ##############################################################################
7985             #
7986             # _write_row_breaks()
7987             #
7988             # Write the element.
7989             #
7990             sub _write_row_breaks {
7991              
7992 1035     1035   2391 my $self = shift;
7993              
7994 1035         2499 my @page_breaks = $self->_sort_pagebreaks( @{ $self->{_hbreaks} } );
  1035         5459  
7995 1035         2661 my $count = scalar @page_breaks;
7996              
7997 1035 100       3716 return unless @page_breaks;
7998              
7999 6         20 my @attributes = (
8000             'count' => $count,
8001             'manualBreakCount' => $count,
8002             );
8003              
8004 6         41 $self->xml_start_tag( 'rowBreaks', @attributes );
8005              
8006 6         19 for my $row_num ( @page_breaks ) {
8007 1035         2222 $self->_write_brk( $row_num, 16383 );
8008             }
8009              
8010 6         34 $self->xml_end_tag( 'rowBreaks' );
8011             }
8012              
8013              
8014             ##############################################################################
8015             #
8016             # _write_col_breaks()
8017             #
8018             # Write the element.
8019             #
8020             sub _write_col_breaks {
8021              
8022 1035     1035   2329 my $self = shift;
8023              
8024 1035         2468 my @page_breaks = $self->_sort_pagebreaks( @{ $self->{_vbreaks} } );
  1035         3816  
8025 1035         2397 my $count = scalar @page_breaks;
8026              
8027 1035 100       4041 return unless @page_breaks;
8028              
8029 5         14 my @attributes = (
8030             'count' => $count,
8031             'manualBreakCount' => $count,
8032             );
8033              
8034 5         33 $self->xml_start_tag( 'colBreaks', @attributes );
8035              
8036 5         14 for my $col_num ( @page_breaks ) {
8037 11         28 $self->_write_brk( $col_num, 1048575 );
8038             }
8039              
8040 5         29 $self->xml_end_tag( 'colBreaks' );
8041             }
8042              
8043              
8044             ##############################################################################
8045             #
8046             # _write_brk()
8047             #
8048             # Write the element.
8049             #
8050             sub _write_brk {
8051              
8052 1047     1047   1702 my $self = shift;
8053 1047         1661 my $id = shift;
8054 1047         2215 my $max = shift;
8055 1047         1201 my $man = 1;
8056              
8057 1047         2160 my @attributes = (
8058             'id' => $id,
8059             'max' => $max,
8060             'man' => $man,
8061             );
8062              
8063 1047         19541 $self->xml_empty_tag( 'brk', @attributes );
8064             }
8065              
8066              
8067             ##############################################################################
8068             #
8069             # _write_auto_filter()
8070             #
8071             # Write the element.
8072             #
8073             sub _write_auto_filter {
8074              
8075 1054     1054   3073 my $self = shift;
8076 1054         2807 my $ref = $self->{_autofilter_ref};
8077              
8078 1054 100       4371 return unless $ref;
8079              
8080 32         73 my @attributes = ( 'ref' => $ref );
8081              
8082 32 100       81 if ( $self->{_filter_on} ) {
8083              
8084             # Autofilter defined active filters.
8085 29         132 $self->xml_start_tag( 'autoFilter', @attributes );
8086              
8087 29         102 $self->_write_autofilters();
8088              
8089 29         144 $self->xml_end_tag( 'autoFilter' );
8090              
8091             }
8092             else {
8093              
8094             # Autofilter defined without active filters.
8095 3         17 $self->xml_empty_tag( 'autoFilter', @attributes );
8096             }
8097              
8098             }
8099              
8100              
8101             ###############################################################################
8102             #
8103             # _write_autofilters()
8104             #
8105             # Function to iterate through the columns that form part of an autofilter
8106             # range and write the appropriate filters.
8107             #
8108             sub _write_autofilters {
8109              
8110 29     29   63 my $self = shift;
8111              
8112 29         54 my ( $col1, $col2 ) = @{ $self->{_filter_range} };
  29         77  
8113              
8114 29         80 for my $col ( $col1 .. $col2 ) {
8115              
8116             # Skip if column doesn't have an active filter.
8117 116 100       279 next unless $self->{_filter_cols}->{$col};
8118              
8119             # Retrieve the filter tokens and write the autofilter records.
8120 30         50 my @tokens = @{ $self->{_filter_cols}->{$col} };
  30         76  
8121 30         104 my $type = $self->{_filter_type}->{$col};
8122              
8123             # Filters are relative to first column in the autofilter.
8124 30         101 $self->_write_filter_column( $col - $col1, $type, \@tokens );
8125             }
8126             }
8127              
8128              
8129             ##############################################################################
8130             #
8131             # _write_filter_column()
8132             #
8133             # Write the element.
8134             #
8135             sub _write_filter_column {
8136              
8137 31     31   57 my $self = shift;
8138 31         51 my $col_id = shift;
8139 31         45 my $type = shift;
8140 31         44 my $filters = shift;
8141              
8142 31         62 my @attributes = ( 'colId' => $col_id );
8143              
8144 31         100 $self->xml_start_tag( 'filterColumn', @attributes );
8145              
8146              
8147 31 100       89 if ( $type == 1 ) {
8148              
8149             # Type == 1 is the new XLSX style filter.
8150 15         63 $self->_write_filters( @$filters );
8151              
8152             }
8153             else {
8154              
8155             # Type == 0 is the classic "custom" filter.
8156 16         39 $self->_write_custom_filters( @$filters );
8157             }
8158              
8159 31         157 $self->xml_end_tag( 'filterColumn' );
8160             }
8161              
8162              
8163             ##############################################################################
8164             #
8165             # _write_filters()
8166             #
8167             # Write the element.
8168             #
8169             sub _write_filters {
8170              
8171 18     18   83 my $self = shift;
8172 18         55 my @filters = @_;
8173 18         54 my @non_blanks = grep { !/^blanks$/i } @filters;
  31         104  
8174 18         44 my @attributes = ();
8175              
8176 18 100       91 if ( @filters != @non_blanks ) {
8177 4         20 @attributes = ( 'blank' => 1 );
8178             }
8179              
8180 18 100 100     103 if ( @filters == 1 && @non_blanks == 0 ) {
8181              
8182             # Special case for blank cells only.
8183 2         21 $self->xml_empty_tag( 'filters', @attributes );
8184             }
8185             else {
8186              
8187             # General case.
8188 16         143 $self->xml_start_tag( 'filters', @attributes );
8189              
8190 16         63 for my $filter ( sort @non_blanks ) {
8191 27         76 $self->_write_filter( $filter );
8192             }
8193              
8194 16         64 $self->xml_end_tag( 'filters' );
8195             }
8196             }
8197              
8198              
8199             ##############################################################################
8200             #
8201             # _write_filter()
8202             #
8203             # Write the element.
8204             #
8205             sub _write_filter {
8206              
8207 28     28   51 my $self = shift;
8208 28         44 my $val = shift;
8209              
8210 28         63 my @attributes = ( 'val' => $val );
8211              
8212 28         135 $self->xml_empty_tag( 'filter', @attributes );
8213             }
8214              
8215              
8216             ##############################################################################
8217             #
8218             # _write_custom_filters()
8219             #
8220             # Write the element.
8221             #
8222             sub _write_custom_filters {
8223              
8224 18     18   68 my $self = shift;
8225 18         37 my @tokens = @_;
8226              
8227 18 100       42 if ( @tokens == 2 ) {
8228              
8229             # One filter expression only.
8230 14         45 $self->xml_start_tag( 'customFilters' );
8231 14         41 $self->_write_custom_filter( @tokens );
8232 14         41 $self->xml_end_tag( 'customFilters' );
8233              
8234             }
8235             else {
8236              
8237             # Two filter expressions.
8238              
8239 4         8 my @attributes;
8240              
8241             # Check if the "join" operand is "and" or "or".
8242 4 50       14 if ( $tokens[2] == 0 ) {
8243 4         10 @attributes = ( 'and' => 1 );
8244             }
8245             else {
8246 0         0 @attributes = ( 'and' => 0 );
8247             }
8248              
8249             # Write the two custom filters.
8250 4         94 $self->xml_start_tag( 'customFilters', @attributes );
8251 4         18 $self->_write_custom_filter( $tokens[0], $tokens[1] );
8252 4         13 $self->_write_custom_filter( $tokens[3], $tokens[4] );
8253 4         13 $self->xml_end_tag( 'customFilters' );
8254             }
8255             }
8256              
8257              
8258             ##############################################################################
8259             #
8260             # _write_custom_filter()
8261             #
8262             # Write the element.
8263             #
8264             sub _write_custom_filter {
8265              
8266 23     23   49 my $self = shift;
8267 23         30 my $operator = shift;
8268 23         38 my $val = shift;
8269 23         37 my @attributes = ();
8270              
8271 23         161 my %operators = (
8272             1 => 'lessThan',
8273             2 => 'equal',
8274             3 => 'lessThanOrEqual',
8275             4 => 'greaterThan',
8276             5 => 'notEqual',
8277             6 => 'greaterThanOrEqual',
8278             22 => 'equal',
8279             );
8280              
8281              
8282             # Convert the operator from a number to a descriptive string.
8283 23 50       66 if ( defined $operators{$operator} ) {
8284 23         46 $operator = $operators{$operator};
8285             }
8286             else {
8287 0         0 croak "Unknown operator = $operator\n";
8288             }
8289              
8290             # The 'equal' operator is the default attribute and isn't stored.
8291 23 100       63 push @attributes, ( 'operator' => $operator ) unless $operator eq 'equal';
8292 23         41 push @attributes, ( 'val' => $val );
8293              
8294 23         102 $self->xml_empty_tag( 'customFilter', @attributes );
8295             }
8296              
8297              
8298             ##############################################################################
8299             #
8300             # _write_hyperlinks()
8301             #
8302             # Process any stored hyperlinks in row/col order and write the
8303             # element. The attributes are different for internal and external links.
8304             #
8305             sub _write_hyperlinks {
8306              
8307 1033     1033   2491 my $self = shift;
8308 1033         2209 my @hlink_refs;
8309              
8310             # Sort the hyperlinks into row order.
8311 1033         2626 my @row_nums = sort { $a <=> $b } keys %{ $self->{_hyperlinks} };
  50         130  
  1033         4860  
8312              
8313             # Exit if there are no hyperlinks to process.
8314 1033 100       4011 return if !@row_nums;
8315              
8316             # Iterate over the rows.
8317 49         162 for my $row_num ( @row_nums ) {
8318              
8319             # Sort the hyperlinks into column order.
8320 1         5 my @col_nums = sort { $a <=> $b }
8321 81         171 keys %{ $self->{_hyperlinks}->{$row_num} };
  81         321  
8322              
8323             # Iterate over the columns.
8324 81         345 for my $col_num ( @col_nums ) {
8325              
8326             # Get the link data for this cell.
8327 82         202 my $link = $self->{_hyperlinks}->{$row_num}->{$col_num};
8328 82         181 my $link_type = $link->{_link_type};
8329              
8330              
8331             # If the cell isn't a string then we have to add the url as
8332             # the string to display.
8333 82         160 my $display;
8334 82 50 66     666 if ( $self->{_table}
      66        
8335             && $self->{_table}->{$row_num}
8336             && $self->{_table}->{$row_num}->{$col_num} )
8337             {
8338 81         194 my $cell = $self->{_table}->{$row_num}->{$col_num};
8339 81 100       262 $display = $link->{_url} if $cell->[0] ne 's';
8340             }
8341              
8342              
8343 82 100       347 if ( $link_type == 1 ) {
8344              
8345             # External link with rel file relationship.
8346             push @hlink_refs,
8347             [
8348             $link_type, $row_num,
8349             $col_num, ++$self->{_rel_count},
8350             $link->{_str}, $display,
8351             $link->{_tip}
8352 74         298 ];
8353              
8354             # Links for use by the packager.
8355 74         342 push @{ $self->{_external_hyper_links} },
8356 74         154 [ '/hyperlink', $link->{_url}, 'External' ];
8357             }
8358             else {
8359              
8360             # Internal link with rel file relationship.
8361             push @hlink_refs,
8362             [
8363             $link_type, $row_num, $col_num,
8364             $link->{_url}, $link->{_str}, $link->{_tip}
8365 8         27 ];
8366             }
8367             }
8368             }
8369              
8370             # Write the hyperlink elements.
8371 49         270 $self->xml_start_tag( 'hyperlinks' );
8372              
8373 49         130 for my $aref ( @hlink_refs ) {
8374 82         262 my ( $type, @args ) = @$aref;
8375              
8376 82 100       242 if ( $type == 1 ) {
    50          
8377 74         270 $self->_write_hyperlink_external( @args );
8378             }
8379             elsif ( $type == 2 ) {
8380 8         20 $self->_write_hyperlink_internal( @args );
8381             }
8382             }
8383              
8384 49         230 $self->xml_end_tag( 'hyperlinks' );
8385             }
8386              
8387              
8388             ##############################################################################
8389             #
8390             # _write_hyperlink_external()
8391             #
8392             # Write the element for external links.
8393             #
8394             sub _write_hyperlink_external {
8395              
8396 75     75   159 my $self = shift;
8397 75         258 my $row = shift;
8398 75         192 my $col = shift;
8399 75         141 my $id = shift;
8400 75         197 my $location = shift;
8401 75         142 my $display = shift;
8402 75         112 my $tooltip = shift;
8403              
8404 75         237 my $ref = xl_rowcol_to_cell( $row, $col );
8405 75         289 my $r_id = 'rId' . $id;
8406              
8407 75         268 my @attributes = (
8408             'ref' => $ref,
8409             'r:id' => $r_id,
8410             );
8411              
8412 75 100       228 push @attributes, ( 'location' => $location ) if defined $location;
8413 75 100       212 push @attributes, ( 'display' => $display ) if defined $display;
8414 75 100       221 push @attributes, ( 'tooltip' => $tooltip ) if defined $tooltip;
8415              
8416 75         353 $self->xml_empty_tag( 'hyperlink', @attributes );
8417             }
8418              
8419              
8420             ##############################################################################
8421             #
8422             # _write_hyperlink_internal()
8423             #
8424             # Write the element for internal links.
8425             #
8426             sub _write_hyperlink_internal {
8427              
8428 11     11   69 my $self = shift;
8429 11         15 my $row = shift;
8430 11         13 my $col = shift;
8431 11         16 my $location = shift;
8432 11         16 my $display = shift;
8433 11         15 my $tooltip = shift;
8434              
8435 11         23 my $ref = xl_rowcol_to_cell( $row, $col );
8436              
8437 11         35 my @attributes = ( 'ref' => $ref, 'location' => $location );
8438              
8439 11 100       24 push @attributes, ( 'tooltip' => $tooltip ) if defined $tooltip;
8440 11         20 push @attributes, ( 'display' => $display );
8441              
8442 11         29 $self->xml_empty_tag( 'hyperlink', @attributes );
8443             }
8444              
8445              
8446             ##############################################################################
8447             #
8448             # _write_panes()
8449             #
8450             # Write the frozen or split elements.
8451             #
8452             sub _write_panes {
8453              
8454 83     83   163 my $self = shift;
8455 83         114 my @panes = @{ $self->{_panes} };
  83         256  
8456              
8457 83 100       206 return unless @panes;
8458              
8459 66 100       139 if ( $panes[4] == 2 ) {
8460 38         94 $self->_write_split_panes( @panes );
8461             }
8462             else {
8463 28         72 $self->_write_freeze_panes( @panes );
8464             }
8465             }
8466              
8467              
8468             ##############################################################################
8469             #
8470             # _write_freeze_panes()
8471             #
8472             # Write the element for freeze panes.
8473             #
8474             sub _write_freeze_panes {
8475              
8476 28     28   37 my $self = shift;
8477 28         36 my @attributes;
8478              
8479 28         65 my ( $row, $col, $top_row, $left_col, $type ) = @_;
8480              
8481 28         42 my $y_split = $row;
8482 28         36 my $x_split = $col;
8483 28         85 my $top_left_cell = xl_rowcol_to_cell( $top_row, $left_col );
8484 28         101 my $active_pane;
8485             my $state;
8486 28         0 my $active_cell;
8487 28         0 my $sqref;
8488              
8489             # Move user cell selection to the panes.
8490 28 100       38 if ( @{ $self->{_selections} } ) {
  28         70  
8491 7         10 ( undef, $active_cell, $sqref ) = @{ $self->{_selections}->[0] };
  7         21  
8492 7         18 $self->{_selections} = [];
8493             }
8494              
8495             # Set the active pane.
8496 28 100 100     129 if ( $row && $col ) {
    100          
8497 13         24 $active_pane = 'bottomRight';
8498              
8499 13         57 my $row_cell = xl_rowcol_to_cell( $row, 0 );
8500 13         33 my $col_cell = xl_rowcol_to_cell( 0, $col );
8501              
8502 13         25 push @{ $self->{_selections} },
  13         60  
8503             (
8504             [ 'topRight', $col_cell, $col_cell ],
8505             [ 'bottomLeft', $row_cell, $row_cell ],
8506             [ 'bottomRight', $active_cell, $sqref ]
8507             );
8508             }
8509             elsif ( $col ) {
8510 7         16 $active_pane = 'topRight';
8511 7         12 push @{ $self->{_selections} }, [ 'topRight', $active_cell, $sqref ];
  7         26  
8512             }
8513             else {
8514 8         24 $active_pane = 'bottomLeft';
8515 8         19 push @{ $self->{_selections} }, [ 'bottomLeft', $active_cell, $sqref ];
  8         37  
8516             }
8517              
8518             # Set the pane type.
8519 28 100       67 if ( $type == 0 ) {
    50          
8520 25         41 $state = 'frozen';
8521             }
8522             elsif ( $type == 1 ) {
8523 3         7 $state = 'frozenSplit';
8524             }
8525             else {
8526 0         0 $state = 'split';
8527             }
8528              
8529              
8530 28 100       64 push @attributes, ( 'xSplit' => $x_split ) if $x_split;
8531 28 100       65 push @attributes, ( 'ySplit' => $y_split ) if $y_split;
8532              
8533 28         54 push @attributes, ( 'topLeftCell' => $top_left_cell );
8534 28         53 push @attributes, ( 'activePane' => $active_pane );
8535 28         43 push @attributes, ( 'state' => $state );
8536              
8537              
8538 28         103 $self->xml_empty_tag( 'pane', @attributes );
8539             }
8540              
8541              
8542             ##############################################################################
8543             #
8544             # _write_split_panes()
8545             #
8546             # Write the element for split panes.
8547             #
8548             # See also, implementers note for split_panes().
8549             #
8550             sub _write_split_panes {
8551              
8552 38     38   60 my $self = shift;
8553 38         88 my @attributes;
8554             my $y_split;
8555 38         0 my $x_split;
8556 38         65 my $has_selection = 0;
8557 38         80 my $active_pane;
8558             my $active_cell;
8559 38         0 my $sqref;
8560              
8561 38         83 my ( $row, $col, $top_row, $left_col, $type ) = @_;
8562 38         69 $y_split = $row;
8563 38         57 $x_split = $col;
8564              
8565             # Move user cell selection to the panes.
8566 38 100       53 if ( @{ $self->{_selections} } ) {
  38         89  
8567 8         12 ( undef, $active_cell, $sqref ) = @{ $self->{_selections}->[0] };
  8         21  
8568 8         18 $self->{_selections} = [];
8569 8         14 $has_selection = 1;
8570             }
8571              
8572             # Convert the row and col to 1/20 twip units with padding.
8573 38 100       97 $y_split = int( 20 * $y_split + 300 ) if $y_split;
8574 38 100       97 $x_split = $self->_calculate_x_split_width( $x_split ) if $x_split;
8575              
8576             # For non-explicit topLeft definitions, estimate the cell offset based
8577             # on the pixels dimensions. This is only a workaround and doesn't take
8578             # adjusted cell dimensions into account.
8579 38 100 100     141 if ( $top_row == $row && $left_col == $col ) {
8580 26         67 $top_row = int( 0.5 + ( $y_split - 300 ) / 20 / 15 );
8581 26         100 $left_col = int( 0.5 + ( $x_split - 390 ) / 20 / 3 * 4 / 64 );
8582             }
8583              
8584 38         113 my $top_left_cell = xl_rowcol_to_cell( $top_row, $left_col );
8585              
8586             # If there is no selection set the active cell to the top left cell.
8587 38 100       82 if ( !$has_selection ) {
8588 30         42 $active_cell = $top_left_cell;
8589 30         45 $sqref = $top_left_cell;
8590             }
8591              
8592             # Set the Cell selections.
8593 38 100 100     190 if ( $row && $col ) {
    100          
8594 10         25 $active_pane = 'bottomRight';
8595              
8596 10         29 my $row_cell = xl_rowcol_to_cell( $top_row, 0 );
8597 10         27 my $col_cell = xl_rowcol_to_cell( 0, $left_col );
8598              
8599 10         18 push @{ $self->{_selections} },
  10         52  
8600             (
8601             [ 'topRight', $col_cell, $col_cell ],
8602             [ 'bottomLeft', $row_cell, $row_cell ],
8603             [ 'bottomRight', $active_cell, $sqref ]
8604             );
8605             }
8606             elsif ( $col ) {
8607 14         24 $active_pane = 'topRight';
8608 14         21 push @{ $self->{_selections} }, [ 'topRight', $active_cell, $sqref ];
  14         45  
8609             }
8610             else {
8611 14         29 $active_pane = 'bottomLeft';
8612 14         19 push @{ $self->{_selections} }, [ 'bottomLeft', $active_cell, $sqref ];
  14         52  
8613             }
8614              
8615 38 100       92 push @attributes, ( 'xSplit' => $x_split ) if $x_split;
8616 38 100       98 push @attributes, ( 'ySplit' => $y_split ) if $y_split;
8617 38         72 push @attributes, ( 'topLeftCell' => $top_left_cell );
8618 38 100       69 push @attributes, ( 'activePane' => $active_pane ) if $has_selection;
8619              
8620 38         125 $self->xml_empty_tag( 'pane', @attributes );
8621             }
8622              
8623              
8624             ##############################################################################
8625             #
8626             # _calculate_x_split_width()
8627             #
8628             # Convert column width from user units to pane split width.
8629             #
8630             sub _calculate_x_split_width {
8631              
8632 24     24   52 my $self = shift;
8633 24         38 my $width = shift;
8634              
8635 24         32 my $max_digit_width = 7; # For Calabri 11.
8636 24         35 my $padding = 5;
8637 24         37 my $pixels;
8638              
8639             # Convert to pixels.
8640 24 50       60 if ( $width < 1 ) {
8641 0         0 $pixels = int( $width * ( $max_digit_width + $padding ) + 0.5 );
8642             }
8643             else {
8644 24         59 $pixels = int( $width * $max_digit_width + 0.5 ) + $padding;
8645             }
8646              
8647             # Convert to points.
8648 24         50 my $points = $pixels * 3 / 4;
8649              
8650             # Convert to twips (twentieths of a point).
8651 24         43 my $twips = $points * 20;
8652              
8653             # Add offset/padding.
8654 24         37 $width = $twips + 390;
8655              
8656 24         40 return $width;
8657             }
8658              
8659              
8660             ##############################################################################
8661             #
8662             # _write_tab_color()
8663             #
8664             # Write the element.
8665             #
8666             sub _write_tab_color {
8667              
8668 13     13   62 my $self = shift;
8669 13         34 my $color_index = $self->{_tab_color};
8670              
8671 13 100       43 return unless $color_index;
8672              
8673 5         45 my $rgb = $self->_get_palette_color( $color_index );
8674              
8675 5         14 my @attributes = ( 'rgb' => $rgb );
8676              
8677 5         41 $self->xml_empty_tag( 'tabColor', @attributes );
8678             }
8679              
8680              
8681             ##############################################################################
8682             #
8683             # _write_outline_pr()
8684             #
8685             # Write the element.
8686             #
8687             sub _write_outline_pr {
8688              
8689 11     11   21 my $self = shift;
8690 11         33 my @attributes = ();
8691              
8692 11 100       39 return unless $self->{_outline_changed};
8693              
8694 1 50       4 push @attributes, ( "applyStyles" => 1 ) if $self->{_outline_style};
8695 1 50       5 push @attributes, ( "summaryBelow" => 0 ) if !$self->{_outline_below};
8696 1 50       17 push @attributes, ( "summaryRight" => 0 ) if !$self->{_outline_right};
8697 1 50       6 push @attributes, ( "showOutlineSymbols" => 0 ) if !$self->{_outline_on};
8698              
8699 1         9 $self->xml_empty_tag( 'outlinePr', @attributes );
8700             }
8701              
8702              
8703             ##############################################################################
8704             #
8705             # _write_sheet_protection()
8706             #
8707             # Write the element.
8708             #
8709             sub _write_sheet_protection {
8710              
8711 1079     1079   2475 my $self = shift;
8712 1079         2452 my @attributes;
8713              
8714 1079 100       5254 return unless $self->{_protect};
8715              
8716 27         40 my %arg = %{ $self->{_protect} };
  27         169  
8717              
8718 27 100       94 push @attributes, ( "password" => $arg{password} ) if $arg{password};
8719 27 100       64 push @attributes, ( "sheet" => 1 ) if $arg{sheet};
8720 27 100       61 push @attributes, ( "content" => 1 ) if $arg{content};
8721 27 100       79 push @attributes, ( "objects" => 1 ) if !$arg{objects};
8722 27 100       59 push @attributes, ( "scenarios" => 1 ) if !$arg{scenarios};
8723 27 100       60 push @attributes, ( "formatCells" => 0 ) if $arg{format_cells};
8724 27 100       54 push @attributes, ( "formatColumns" => 0 ) if $arg{format_columns};
8725 27 100       52 push @attributes, ( "formatRows" => 0 ) if $arg{format_rows};
8726 27 100       57 push @attributes, ( "insertColumns" => 0 ) if $arg{insert_columns};
8727 27 100       57 push @attributes, ( "insertRows" => 0 ) if $arg{insert_rows};
8728 27 100       57 push @attributes, ( "insertHyperlinks" => 0 ) if $arg{insert_hyperlinks};
8729 27 100       48 push @attributes, ( "deleteColumns" => 0 ) if $arg{delete_columns};
8730 27 100       46 push @attributes, ( "deleteRows" => 0 ) if $arg{delete_rows};
8731              
8732             push @attributes, ( "selectLockedCells" => 1 )
8733 27 100       58 if !$arg{select_locked_cells};
8734              
8735 27 100       52 push @attributes, ( "sort" => 0 ) if $arg{sort};
8736 27 100       57 push @attributes, ( "autoFilter" => 0 ) if $arg{autofilter};
8737 27 100       42 push @attributes, ( "pivotTables" => 0 ) if $arg{pivot_tables};
8738              
8739             push @attributes, ( "selectUnlockedCells" => 1 )
8740 27 100       52 if !$arg{select_unlocked_cells};
8741              
8742              
8743 27         89 $self->xml_empty_tag( 'sheetProtection', @attributes );
8744             }
8745              
8746              
8747             ##############################################################################
8748             #
8749             # _write_drawings()
8750             #
8751             # Write the elements.
8752             #
8753             sub _write_drawings {
8754              
8755 1054     1054   2346 my $self = shift;
8756              
8757 1054 100       4268 return unless $self->{_drawing};
8758              
8759 504         2697 $self->_write_drawing( ++$self->{_rel_count} );
8760             }
8761              
8762              
8763             ##############################################################################
8764             #
8765             # _write_drawing()
8766             #
8767             # Write the element.
8768             #
8769             sub _write_drawing {
8770              
8771 504     504   1096 my $self = shift;
8772 504         1306 my $id = shift;
8773 504         1781 my $r_id = 'rId' . $id;
8774              
8775 504         1903 my @attributes = ( 'r:id' => $r_id );
8776              
8777 504         2433 $self->xml_empty_tag( 'drawing', @attributes );
8778             }
8779              
8780              
8781             ##############################################################################
8782             #
8783             # _write_legacy_drawing()
8784             #
8785             # Write the element.
8786             #
8787             sub _write_legacy_drawing {
8788              
8789 1034     1034   2593 my $self = shift;
8790 1034         2169 my $id;
8791              
8792 1034 100       4082 return unless $self->{_has_vml};
8793              
8794             # Increment the relationship id for any drawings or comments.
8795 58         164 $id = ++$self->{_rel_count};
8796              
8797 58         231 my @attributes = ( 'r:id' => 'rId' . $id );
8798              
8799 58         246 $self->xml_empty_tag( 'legacyDrawing', @attributes );
8800             }
8801              
8802              
8803              
8804             ##############################################################################
8805             #
8806             # _write_legacy_drawing_hf()
8807             #
8808             # Write the element.
8809             #
8810             sub _write_legacy_drawing_hf {
8811              
8812 1033     1033   2318 my $self = shift;
8813 1033         2479 my $id;
8814              
8815 1033 100       4079 return unless $self->{_has_header_vml};
8816              
8817             # Increment the relationship id for any drawings or comments.
8818 22         49 $id = ++$self->{_rel_count};
8819              
8820 22         88 my @attributes = ( 'r:id' => 'rId' . $id );
8821              
8822 22         92 $self->xml_empty_tag( 'legacyDrawingHF', @attributes );
8823             }
8824              
8825              
8826             #
8827             # Note, the following font methods are, more or less, duplicated from the
8828             # Excel::Writer::XLSX::Package::Styles class. I will look at implementing
8829             # this is a cleaner encapsulated mode at a later stage.
8830             #
8831              
8832              
8833             ##############################################################################
8834             #
8835             # _write_font()
8836             #
8837             # Write the element.
8838             #
8839             sub _write_font {
8840              
8841 56     56   90 my $self = shift;
8842 56         85 my $format = shift;
8843              
8844 56         152 $self->{_rstring}->xml_start_tag( 'rPr' );
8845              
8846 56 100       202 $self->{_rstring}->xml_empty_tag( 'b' ) if $format->{_bold};
8847 56 100       138 $self->{_rstring}->xml_empty_tag( 'i' ) if $format->{_italic};
8848 56 50       137 $self->{_rstring}->xml_empty_tag( 'strike' ) if $format->{_font_strikeout};
8849 56 50       117 $self->{_rstring}->xml_empty_tag( 'outline' ) if $format->{_font_outline};
8850 56 50       120 $self->{_rstring}->xml_empty_tag( 'shadow' ) if $format->{_font_shadow};
8851              
8852             # Handle the underline variants.
8853 56 50       116 $self->_write_underline( $format->{_underline} ) if $format->{_underline};
8854              
8855 56 50       151 $self->_write_vert_align( 'superscript' ) if $format->{_font_script} == 1;
8856 56 50       140 $self->_write_vert_align( 'subscript' ) if $format->{_font_script} == 2;
8857              
8858 56         200 $self->{_rstring}->xml_empty_tag( 'sz', 'val', $format->{_size} );
8859              
8860 56 50       214 if ( my $theme = $format->{_theme} ) {
    100          
8861 0         0 $self->_write_rstring_color( 'theme' => $theme );
8862             }
8863             elsif ( my $color = $format->{_color} ) {
8864 1         4 $color = $self->_get_palette_color( $color );
8865              
8866 1         5 $self->_write_rstring_color( 'rgb' => $color );
8867             }
8868             else {
8869 55         144 $self->_write_rstring_color( 'theme' => 1 );
8870             }
8871              
8872 56         202 $self->{_rstring}->xml_empty_tag( 'rFont', 'val', $format->{_font} );
8873             $self->{_rstring}
8874 56         167 ->xml_empty_tag( 'family', 'val', $format->{_font_family} );
8875              
8876 56 50 33     261 if ( $format->{_font} eq 'Calibri' && !$format->{_hyperlink} ) {
8877             $self->{_rstring}
8878 56         144 ->xml_empty_tag( 'scheme', 'val', $format->{_font_scheme} );
8879             }
8880              
8881 56         145 $self->{_rstring}->xml_end_tag( 'rPr' );
8882             }
8883              
8884              
8885             ###############################################################################
8886             #
8887             # _write_underline()
8888             #
8889             # Write the underline font element.
8890             #
8891             sub _write_underline {
8892              
8893 0     0   0 my $self = shift;
8894 0         0 my $underline = shift;
8895 0         0 my @attributes;
8896              
8897             # Handle the underline variants.
8898 0 0       0 if ( $underline == 2 ) {
    0          
    0          
8899 0         0 @attributes = ( val => 'double' );
8900             }
8901             elsif ( $underline == 33 ) {
8902 0         0 @attributes = ( val => 'singleAccounting' );
8903             }
8904             elsif ( $underline == 34 ) {
8905 0         0 @attributes = ( val => 'doubleAccounting' );
8906             }
8907             else {
8908 0         0 @attributes = (); # Default to single underline.
8909             }
8910              
8911 0         0 $self->{_rstring}->xml_empty_tag( 'u', @attributes );
8912              
8913             }
8914              
8915              
8916             ##############################################################################
8917             #
8918             # _write_vert_align()
8919             #
8920             # Write the font sub-element.
8921             #
8922             sub _write_vert_align {
8923              
8924 0     0   0 my $self = shift;
8925 0         0 my $val = shift;
8926              
8927 0         0 my @attributes = ( 'val' => $val );
8928              
8929 0         0 $self->{_rstring}->xml_empty_tag( 'vertAlign', @attributes );
8930             }
8931              
8932              
8933             ##############################################################################
8934             #
8935             # _write_rstring_color()
8936             #
8937             # Write the element.
8938             #
8939             sub _write_rstring_color {
8940              
8941 56     56   89 my $self = shift;
8942 56         87 my $name = shift;
8943 56         85 my $value = shift;
8944              
8945 56         118 my @attributes = ( $name => $value );
8946              
8947 56         151 $self->{_rstring}->xml_empty_tag( 'color', @attributes );
8948             }
8949              
8950              
8951             #
8952             # End font duplication code.
8953             #
8954              
8955              
8956             ##############################################################################
8957             #
8958             # _write_data_validations()
8959             #
8960             # Write the element.
8961             #
8962             sub _write_data_validations {
8963              
8964 1089     1089   2538 my $self = shift;
8965 1089         2273 my @validations = @{ $self->{_validations} };
  1089         3463  
8966 1089         2762 my $count = @validations;
8967              
8968 1089 100       6015 return unless $count;
8969              
8970 62         112 my @attributes = ( 'count' => $count );
8971              
8972 62         206 $self->xml_start_tag( 'dataValidations', @attributes );
8973              
8974 62         132 for my $validation ( @validations ) {
8975              
8976             # Write the dataValidation element.
8977 64         144 $self->_write_data_validation( $validation );
8978             }
8979              
8980 62         145 $self->xml_end_tag( 'dataValidations' );
8981             }
8982              
8983              
8984             ##############################################################################
8985             #
8986             # _write_data_validation()
8987             #
8988             # Write the element.
8989             #
8990             sub _write_data_validation {
8991              
8992 64     64   89 my $self = shift;
8993 64         78 my $param = shift;
8994 64         92 my $sqref = '';
8995 64         98 my @attributes = ();
8996              
8997              
8998             # Set the cell range(s) for the data validation.
8999 64         85 for my $cells ( @{ $param->{cells} } ) {
  64         120  
9000              
9001             # Add a space between multiple cell ranges.
9002 68 100       148 $sqref .= ' ' if $sqref ne '';
9003              
9004 68         143 my ( $row_first, $col_first, $row_last, $col_last ) = @$cells;
9005              
9006             # Swap last row/col for first row/col as necessary
9007 68 50       129 if ( $row_first > $row_last ) {
9008 0         0 ( $row_first, $row_last ) = ( $row_last, $row_first );
9009             }
9010              
9011 68 50       141 if ( $col_first > $col_last ) {
9012 0         0 ( $col_first, $col_last ) = ( $col_last, $col_first );
9013             }
9014              
9015             # If the first and last cell are the same write a single cell.
9016 68 100 66     240 if ( ( $row_first == $row_last ) && ( $col_first == $col_last ) ) {
9017 65         186 $sqref .= xl_rowcol_to_cell( $row_first, $col_first );
9018             }
9019             else {
9020 3         12 $sqref .= xl_range( $row_first, $row_last, $col_first, $col_last );
9021             }
9022             }
9023              
9024              
9025 64 100       164 if ( $param->{validate} ne 'none' ) {
9026              
9027 62         116 push @attributes, ( 'type' => $param->{validate} );
9028              
9029 62 100       127 if ( $param->{criteria} ne 'between' ) {
9030 26         40 push @attributes, ( 'operator' => $param->{criteria} );
9031             }
9032              
9033             }
9034              
9035 64 100       143 if ( $param->{error_type} ) {
9036             push @attributes, ( 'errorStyle' => 'warning' )
9037 2 100       7 if $param->{error_type} == 1;
9038             push @attributes, ( 'errorStyle' => 'information' )
9039 2 100       6 if $param->{error_type} == 2;
9040             }
9041              
9042 64 100       148 push @attributes, ( 'allowBlank' => 1 ) if $param->{ignore_blank};
9043 64 100       135 push @attributes, ( 'showDropDown' => 1 ) if !$param->{dropdown};
9044 64 100       130 push @attributes, ( 'showInputMessage' => 1 ) if $param->{show_input};
9045 64 100       137 push @attributes, ( 'showErrorMessage' => 1 ) if $param->{show_error};
9046              
9047             push @attributes, ( 'errorTitle' => $param->{error_title} )
9048 64 100       119 if $param->{error_title};
9049              
9050             push @attributes, ( 'error' => $param->{error_message} )
9051 64 100       117 if $param->{error_message};
9052              
9053             push @attributes, ( 'promptTitle' => $param->{input_title} )
9054 64 100       116 if $param->{input_title};
9055              
9056             push @attributes, ( 'prompt' => $param->{input_message} )
9057 64 100       135 if $param->{input_message};
9058              
9059 64         114 push @attributes, ( 'sqref' => $sqref );
9060              
9061 64 100       146 if ( $param->{validate} eq 'none' ) {
9062 2         15 $self->xml_empty_tag( 'dataValidation', @attributes );
9063             }
9064             else {
9065 62         224 $self->xml_start_tag( 'dataValidation', @attributes );
9066              
9067             # Write the formula1 element.
9068 62         182 $self->_write_formula_1( $param->{value} );
9069              
9070             # Write the formula2 element.
9071             $self->_write_formula_2( $param->{maximum} )
9072 62 100       178 if defined $param->{maximum};
9073              
9074 62         171 $self->xml_end_tag( 'dataValidation' );
9075             }
9076             }
9077              
9078              
9079             ##############################################################################
9080             #
9081             # _write_formula_1()
9082             #
9083             # Write the element.
9084             #
9085             sub _write_formula_1 {
9086              
9087 62     62   85 my $self = shift;
9088 62         88 my $formula = shift;
9089              
9090             # Convert a list array ref into a comma separated string.
9091 62 100       143 if ( ref $formula eq 'ARRAY' ) {
9092 10         39 $formula = join ',', @$formula;
9093 10         37 $formula = qq("$formula");
9094             }
9095              
9096 62         140 $formula =~ s/^=//; # Remove formula symbol.
9097              
9098 62         179 $self->xml_data_element( 'formula1', $formula );
9099             }
9100              
9101              
9102             ##############################################################################
9103             #
9104             # _write_formula_2()
9105             #
9106             # Write the element.
9107             #
9108             sub _write_formula_2 {
9109              
9110 24     24   33 my $self = shift;
9111 24         33 my $formula = shift;
9112              
9113 24         48 $formula =~ s/^=//; # Remove formula symbol.
9114              
9115 24         43 $self->xml_data_element( 'formula2', $formula );
9116             }
9117              
9118              
9119             ##############################################################################
9120             #
9121             # _write_conditional_formats()
9122             #
9123             # Write the Worksheet conditional formats.
9124             #
9125             sub _write_conditional_formats {
9126              
9127 1037     1037   2905 my $self = shift;
9128 1037         2410 my @ranges = sort keys %{ $self->{_cond_formats} };
  1037         5039  
9129              
9130 1037 100       4941 return unless scalar @ranges;
9131              
9132 63         190 for my $range ( @ranges ) {
9133             $self->_write_conditional_formatting( $range,
9134 110         396 $self->{_cond_formats}->{$range} );
9135             }
9136             }
9137              
9138              
9139             ##############################################################################
9140             #
9141             # _write_conditional_formatting()
9142             #
9143             # Write the element.
9144             #
9145             sub _write_conditional_formatting {
9146              
9147 110     110   213 my $self = shift;
9148 110         182 my $range = shift;
9149 110         182 my $params = shift;
9150              
9151 110         279 my @attributes = ( 'sqref' => $range );
9152              
9153 110         475 $self->xml_start_tag( 'conditionalFormatting', @attributes );
9154              
9155 110         251 for my $param ( @$params ) {
9156              
9157             # Write the cfRule element.
9158 149         421 $self->_write_cf_rule( $param );
9159             }
9160              
9161 110         318 $self->xml_end_tag( 'conditionalFormatting' );
9162             }
9163              
9164             ##############################################################################
9165             #
9166             # _write_cf_rule()
9167             #
9168             # Write the element.
9169             #
9170             sub _write_cf_rule {
9171              
9172 149     149   239 my $self = shift;
9173 149         213 my $param = shift;
9174              
9175 149         379 my @attributes = ( 'type' => $param->{type} );
9176              
9177             push @attributes, ( 'dxfId' => $param->{format} )
9178 149 100       408 if defined $param->{format};
9179              
9180 149         335 push @attributes, ( 'priority' => $param->{priority} );
9181              
9182             push @attributes, ( 'stopIfTrue' => 1 )
9183 149 100       391 if $param->{stop_if_true};
9184              
9185 149 100 100     2114 if ( $param->{type} eq 'cellIs' ) {
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100          
    100          
    100          
    100          
    100          
    50          
9186 36         127 push @attributes, ( 'operator' => $param->{criteria} );
9187              
9188 36         200 $self->xml_start_tag( 'cfRule', @attributes );
9189              
9190 36 100 66     180 if ( defined $param->{minimum} && defined $param->{maximum} ) {
9191 5         23 $self->_write_formula( $param->{minimum} );
9192 5         18 $self->_write_formula( $param->{maximum} );
9193             }
9194             else {
9195 31         88 my $value = $param->{value};
9196              
9197             # String "Cell" values must be quoted, apart from ranges.
9198 31 100 100     365 if ( $value !~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/
9199             && $value !~
9200             /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ )
9201             {
9202 2 100       9 if ( $value !~ /^".*"$/ ) {
9203 1         4 $value = qq("$value");
9204             }
9205             }
9206              
9207 31         136 $self->_write_formula( $value );
9208             }
9209              
9210 36         173 $self->xml_end_tag( 'cfRule' );
9211             }
9212             elsif ( $param->{type} eq 'aboveAverage' ) {
9213 10 100       21 if ( $param->{criteria} =~ /below/ ) {
9214 5         8 push @attributes, ( 'aboveAverage' => 0 );
9215             }
9216              
9217 10 100       21 if ( $param->{criteria} =~ /equal/ ) {
9218 2         4 push @attributes, ( 'equalAverage' => 1 );
9219             }
9220              
9221 10 100       21 if ( $param->{criteria} =~ /([123]) std dev/ ) {
9222 6         14 push @attributes, ( 'stdDev' => $1 );
9223             }
9224              
9225 10         21 $self->xml_empty_tag( 'cfRule', @attributes );
9226             }
9227             elsif ( $param->{type} eq 'top10' ) {
9228 4 100 66     20 if ( defined $param->{criteria} && $param->{criteria} eq '%' ) {
9229 2         5 push @attributes, ( 'percent' => 1 );
9230             }
9231              
9232 4 100       8 if ( $param->{direction} ) {
9233 2         3 push @attributes, ( 'bottom' => 1 );
9234             }
9235              
9236 4   50     8 my $rank = $param->{value} || 10;
9237 4         7 push @attributes, ( 'rank' => $rank );
9238              
9239 4         19 $self->xml_empty_tag( 'cfRule', @attributes );
9240             }
9241             elsif ( $param->{type} eq 'duplicateValues' ) {
9242 1         3 $self->xml_empty_tag( 'cfRule', @attributes );
9243             }
9244             elsif ( $param->{type} eq 'uniqueValues' ) {
9245 1         3 $self->xml_empty_tag( 'cfRule', @attributes );
9246             }
9247             elsif ($param->{type} eq 'containsText'
9248             || $param->{type} eq 'notContainsText'
9249             || $param->{type} eq 'beginsWith'
9250             || $param->{type} eq 'endsWith' )
9251             {
9252 8         14 push @attributes, ( 'operator' => $param->{criteria} );
9253 8         14 push @attributes, ( 'text' => $param->{value} );
9254              
9255 8         24 $self->xml_start_tag( 'cfRule', @attributes );
9256 8         24 $self->_write_formula( $param->{formula} );
9257 8         26 $self->xml_end_tag( 'cfRule' );
9258             }
9259             elsif ( $param->{type} eq 'timePeriod' ) {
9260 10         16 push @attributes, ( 'timePeriod' => $param->{criteria} );
9261              
9262 10         24 $self->xml_start_tag( 'cfRule', @attributes );
9263 10         25 $self->_write_formula( $param->{formula} );
9264 10         20 $self->xml_end_tag( 'cfRule' );
9265             }
9266             elsif ($param->{type} eq 'containsBlanks'
9267             || $param->{type} eq 'notContainsBlanks'
9268             || $param->{type} eq 'containsErrors'
9269             || $param->{type} eq 'notContainsErrors' )
9270             {
9271 4         9 $self->xml_start_tag( 'cfRule', @attributes );
9272 4         12 $self->_write_formula( $param->{formula} );
9273 4         10 $self->xml_end_tag( 'cfRule' );
9274             }
9275             elsif ( $param->{type} eq 'colorScale' ) {
9276              
9277 5         29 $self->xml_start_tag( 'cfRule', @attributes );
9278 5         23 $self->_write_color_scale( $param );
9279 5         15 $self->xml_end_tag( 'cfRule' );
9280             }
9281             elsif ( $param->{type} eq 'dataBar' ) {
9282              
9283 29         107 $self->xml_start_tag( 'cfRule', @attributes );
9284              
9285 29         112 $self->_write_data_bar( $param );
9286              
9287 29 100       86 if ($param->{_is_data_bar_2010}) {
9288 25         58 $self->_write_data_bar_ext( $param );
9289             }
9290              
9291 29         77 $self->xml_end_tag( 'cfRule' );
9292             }
9293             elsif ( $param->{type} eq 'expression' ) {
9294              
9295 4         16 $self->xml_start_tag( 'cfRule', @attributes );
9296 4         14 $self->_write_formula( $param->{criteria} );
9297 4         11 $self->xml_end_tag( 'cfRule' );
9298             }
9299             elsif ( $param->{type} eq 'iconSet' ) {
9300              
9301 37         115 $self->xml_start_tag( 'cfRule', @attributes );
9302 37         107 $self->_write_icon_set( $param );
9303 37         92 $self->xml_end_tag( 'cfRule' );
9304             }
9305             }
9306              
9307              
9308             ##############################################################################
9309             #
9310             # _write_icon_set()
9311             #
9312             # Write the element.
9313             #
9314             sub _write_icon_set {
9315              
9316 37     37   53 my $self = shift;
9317 37         50 my $param = shift;
9318 37         56 my $icon_style = $param->{icon_style};
9319 37         58 my $total_icons = $param->{total_icons};
9320 37         52 my $icons = $param->{icons};
9321 37         48 my $i;
9322              
9323 37         61 my @attributes = ();
9324              
9325             # Don't set attribute for default style.
9326 37 100       76 if ( $icon_style ne '3TrafficLights' ) {
9327 36         61 @attributes = ( 'iconSet' => $icon_style );
9328             }
9329              
9330 37 50 66     88 if ( exists $param->{'icons_only'} && $param->{'icons_only'} ) {
9331 4         6 push @attributes, ( 'showValue' => 0 );
9332             }
9333              
9334 37 50 66     85 if ( exists $param->{'reverse_icons'} && $param->{'reverse_icons'} ) {
9335 6         12 push @attributes, ( 'reverse' => 1 );
9336             }
9337              
9338 37         103 $self->xml_start_tag( 'iconSet', @attributes );
9339              
9340             # Write the properties for different icon styles.
9341 37         54 for my $icon ( reverse @{ $param->{icons} } ) {
  37         72  
9342             $self->_write_cfvo(
9343             $icon->{'type'},
9344             $icon->{'value'},
9345 138         283 $icon->{'criteria'}
9346             );
9347             }
9348              
9349 37         91 $self->xml_end_tag( 'iconSet' );
9350             }
9351              
9352             ##############################################################################
9353             #
9354             # _write_formula()
9355             #
9356             # Write the element.
9357             #
9358             sub _write_formula {
9359              
9360 67     67   120 my $self = shift;
9361 67         105 my $data = shift;
9362              
9363             # Remove equality from formula.
9364 67         153 $data =~ s/^=//;
9365              
9366 67         341 $self->xml_data_element( 'formula', $data );
9367             }
9368              
9369              
9370             ##############################################################################
9371             #
9372             # _write_color_scale()
9373             #
9374             # Write the element.
9375             #
9376             sub _write_color_scale {
9377              
9378 5     5   10 my $self = shift;
9379 5         8 my $param = shift;
9380              
9381 5         15 $self->xml_start_tag( 'colorScale' );
9382              
9383 5         28 $self->_write_cfvo( $param->{min_type}, $param->{min_value} );
9384              
9385 5 100       18 if ( defined $param->{mid_type} ) {
9386 4         12 $self->_write_cfvo( $param->{mid_type}, $param->{mid_value} );
9387             }
9388              
9389 5         27 $self->_write_cfvo( $param->{max_type}, $param->{max_value} );
9390              
9391 5         24 $self->_write_color( 'rgb' => $param->{min_color} );
9392              
9393 5 100       18 if ( defined $param->{mid_color} ) {
9394 4         11 $self->_write_color( 'rgb' => $param->{mid_color} );
9395             }
9396              
9397 5         22 $self->_write_color( 'rgb' => $param->{max_color} );
9398              
9399 5         14 $self->xml_end_tag( 'colorScale' );
9400             }
9401              
9402              
9403             ##############################################################################
9404             #
9405             # _write_data_bar()
9406             #
9407             # Write the element.
9408             #
9409             sub _write_data_bar {
9410              
9411 29     29   50 my $self = shift;
9412 29         50 my $data_bar = shift;
9413 29         56 my @attributes = ();
9414              
9415 29 100       91 if ( $data_bar->{bar_only} ) {
9416 2         6 push @attributes, ( 'showValue', 0 );
9417             }
9418              
9419 29         101 $self->xml_start_tag( 'dataBar', @attributes );
9420              
9421 29         107 $self->_write_cfvo( $data_bar->{min_type}, $data_bar->{min_value} );
9422 29         77 $self->_write_cfvo( $data_bar->{max_type}, $data_bar->{max_value} );
9423              
9424 29         98 $self->_write_color( 'rgb' => $data_bar->{bar_color} );
9425              
9426 29         80 $self->xml_end_tag( 'dataBar' );
9427             }
9428              
9429              
9430             ##############################################################################
9431             #
9432             # _write_data_bar_ext()
9433             #
9434             # Write the dataBar extension element.
9435             #
9436             sub _write_data_bar_ext {
9437              
9438 25     25   41 my $self = shift;
9439 25         33 my $param = shift;
9440              
9441             # Create a pseudo GUID for each unique Excel 2010 data bar.
9442 25         42 my $worksheet_count = $self->{_index} + 1;
9443 25         36 my $data_bar_count = @{ $self->{_data_bars_2010} } + 1;
  25         46  
9444              
9445 25         119 my $guid = sprintf "{DA7ABA51-AAAA-BBBB-%04X-%012X}", $worksheet_count,
9446             $data_bar_count;
9447              
9448             # Store the 2010 data bar parameters to write the extLst elements.
9449 25         71 $param->{_guid} = $guid;
9450 25         43 push @{$self->{_data_bars_2010}}, $param;
  25         50  
9451              
9452 25         104 $self->xml_start_tag( 'extLst' );
9453 25         78 $self->_write_ext('{B025F937-C7B1-47D3-B67F-A62EFF666E3E}');
9454              
9455 25         118 $self->xml_data_element( 'x14:id', $guid);
9456              
9457 25         72 $self->xml_end_tag( 'ext' );
9458 25         56 $self->xml_end_tag( 'extLst' );
9459             }
9460              
9461              
9462             ##############################################################################
9463             #
9464             # _write_cfvo()
9465             #
9466             # Write the element.
9467             #
9468             sub _write_cfvo {
9469              
9470 210     210   299 my $self = shift;
9471 210         282 my $type = shift;
9472 210         279 my $value = shift;
9473 210         248 my $criteria = shift;
9474              
9475 210         380 my @attributes = ( 'type' => $type );
9476              
9477 210 100       412 if ( defined $value ) {
9478 169         273 push @attributes, ( 'val', $value );
9479             }
9480              
9481 210 100       350 if ( $criteria ) {
9482 7         14 push @attributes, ( 'gte', 0 );
9483             }
9484              
9485 210         463 $self->xml_empty_tag( 'cfvo', @attributes );
9486             }
9487              
9488              
9489             ##############################################################################
9490             #
9491             # _write_x14_cfvo()
9492             #
9493             # Write the element.
9494             #
9495             sub _write_x14_cfvo {
9496              
9497 50     50   68 my $self = shift;
9498 50         71 my $type = shift;
9499 50         75 my $value = shift;
9500              
9501 50         101 my @attributes = ( 'type' => $type );
9502              
9503 50 100 100     290 if ( $type eq 'min'
      100        
      100        
9504             || $type eq 'max'
9505             || $type eq 'autoMin'
9506             || $type eq 'autoMax' )
9507             {
9508 41         102 $self->xml_empty_tag( 'x14:cfvo', @attributes );
9509             }
9510             else {
9511 9         24 $self->xml_start_tag( 'x14:cfvo', @attributes );
9512 9         24 $self->xml_data_element( 'xm:f', $value );
9513 9         22 $self->xml_end_tag( 'x14:cfvo' );
9514             }
9515             }
9516              
9517              
9518             ##############################################################################
9519             #
9520             # _write_color()
9521             #
9522             # Write the element.
9523             #
9524             sub _write_color {
9525              
9526 43     43   80 my $self = shift;
9527 43         79 my $name = shift;
9528 43         83 my $value = shift;
9529              
9530 43         90 my @attributes = ( $name => $value );
9531              
9532 43         130 $self->xml_empty_tag( 'color', @attributes );
9533             }
9534              
9535              
9536             ##############################################################################
9537             #
9538             # _write_table_parts()
9539             #
9540             # Write the element.
9541             #
9542             sub _write_table_parts {
9543              
9544 1033     1033   2266 my $self = shift;
9545 1033         2294 my @tables = @{ $self->{_tables} };
  1033         3526  
9546 1033         2454 my $count = scalar @tables;
9547              
9548             # Return if worksheet doesn't contain any tables.
9549 1033 100       4140 return unless $count;
9550              
9551 27         191 my @attributes = ( 'count' => $count, );
9552              
9553 27         257 $self->xml_start_tag( 'tableParts', @attributes );
9554              
9555 27         94 for my $table ( @tables ) {
9556              
9557             # Write the tablePart element.
9558 35         133 $self->_write_table_part( ++$self->{_rel_count} );
9559              
9560             }
9561              
9562 27         88 $self->xml_end_tag( 'tableParts' );
9563             }
9564              
9565              
9566             ##############################################################################
9567             #
9568             # _write_table_part()
9569             #
9570             # Write the element.
9571             #
9572             sub _write_table_part {
9573              
9574 35     35   81 my $self = shift;
9575 35         62 my $id = shift;
9576 35         104 my $r_id = 'rId' . $id;
9577              
9578 35         116 my @attributes = ( 'r:id' => $r_id, );
9579              
9580 35         132 $self->xml_empty_tag( 'tablePart', @attributes );
9581             }
9582              
9583              
9584             ##############################################################################
9585             #
9586             # _write_ext_list()
9587             #
9588             # Write the element for data bars and sparklines.
9589             #
9590             sub _write_ext_list {
9591              
9592 1033     1033   2573 my $self = shift;
9593 1033         2111 my $has_data_bars = scalar @{ $self->{_data_bars_2010} };
  1033         3215  
9594 1033         2404 my $has_sparklines = scalar @{ $self->{_sparklines} };
  1033         2851  
9595              
9596 1033 100 100     6816 if ( !$has_data_bars and !$has_sparklines ) {
9597 1011         3567 return;
9598             }
9599              
9600             # Write the extLst element.
9601 22         102 $self->xml_start_tag( 'extLst' );
9602              
9603 22 100       86 if ( $has_data_bars ) {
9604 11         44 $self->_write_ext_list_data_bars();
9605             }
9606              
9607 22 100       88 if ( $has_sparklines ) {
9608 12         59 $self->_write_ext_list_sparklines();
9609             }
9610              
9611 22         204 $self->xml_end_tag( 'extLst' );
9612             }
9613              
9614              
9615             ##############################################################################
9616             #
9617             # _write_ext_list_data_bars()
9618             #
9619             # Write the Excel 2010 data_bar subelements.
9620             #
9621             sub _write_ext_list_data_bars {
9622              
9623 11     11   32 my $self = shift;
9624 11         25 my @data_bars = @{ $self->{_data_bars_2010} };
  11         34  
9625              
9626             # Write the ext element.
9627 11         39 $self->_write_ext('{78C0D931-6437-407d-A8EE-F0AAD7539E65}');
9628              
9629              
9630 11         40 $self->xml_start_tag( 'x14:conditionalFormattings' );
9631              
9632             # Write each of the Excel 2010 conditional formatting data bar elements.
9633 11         70 for my $data_bar (@data_bars) {
9634              
9635             # Write the x14:conditionalFormatting element.
9636 25         73 $self->_write_conditional_formatting_2010($data_bar);
9637             }
9638              
9639 11         49 $self->xml_end_tag( 'x14:conditionalFormattings' );
9640 11         32 $self->xml_end_tag( 'ext' );
9641              
9642              
9643             }
9644              
9645              
9646             ##############################################################################
9647             #
9648             # _write_conditional_formatting()
9649             #
9650             # Write the element.
9651             #
9652             sub _write_conditional_formatting_2010 {
9653              
9654 25     25   38 my $self = shift;
9655 25         31 my $data_bar = shift;
9656 25         48 my $xmlns_xm = 'http://schemas.microsoft.com/office/excel/2006/main';
9657              
9658 25         54 my @attributes = ( 'xmlns:xm' => $xmlns_xm );
9659              
9660 25         67 $self->xml_start_tag( 'x14:conditionalFormatting', @attributes );
9661              
9662             # Write the '
9663 25         79 $self->_write_x14_cf_rule( $data_bar );
9664              
9665             # Write the x14:dataBar element.
9666 25         87 $self->_write_x14_data_bar( $data_bar );
9667              
9668             # Write the x14 max and min data bars.
9669             $self->_write_x14_cfvo( $data_bar->{_x14_min_type},
9670 25         105 $data_bar->{min_value} );
9671              
9672             $self->_write_x14_cfvo( $data_bar->{_x14_max_type},
9673 25         77 $data_bar->{max_value} );
9674              
9675             # Write the x14:borderColor element.
9676 25 100       61 if ( !$data_bar->{bar_no_border} ) {
9677 24         62 $self->_write_x14_border_color( $data_bar->{bar_border_color} );
9678             }
9679              
9680             # Write the x14:negativeFillColor element.
9681 25 100       64 if ( !$data_bar->{bar_negative_color_same} ) {
9682             $self->_write_x14_negative_fill_color(
9683 24         79 $data_bar->{bar_negative_color} );
9684             }
9685              
9686             # Write the x14:negativeBorderColor element.
9687 25 100 100     112 if ( !$data_bar->{bar_no_border}
9688             && !$data_bar->{bar_negative_border_color_same} )
9689             {
9690             $self->_write_x14_negative_border_color(
9691 23         55 $data_bar->{bar_negative_border_color} );
9692             }
9693              
9694             # Write the x14:axisColor element.
9695 25 100       82 if ( $data_bar->{bar_axis_position} ne 'none') {
9696 24         61 $self->_write_x14_axis_color($data_bar->{bar_axis_color});
9697             }
9698              
9699             # Write closing elements.
9700 25         117 $self->xml_end_tag( 'x14:dataBar' );
9701 25         82 $self->xml_end_tag( 'x14:cfRule' );
9702              
9703             # Add the conditional format range.
9704 25         178 $self->xml_data_element( 'xm:sqref', $data_bar->{_range} );
9705              
9706 25         86 $self->xml_end_tag( 'x14:conditionalFormatting' );
9707             }
9708              
9709              
9710             ##############################################################################
9711             #
9712             # _write_x14_cf_rule()
9713             #
9714             # Write the <' element.
9715             #
9716             sub _write_x14_cf_rule {
9717              
9718 25     25   60 my $self = shift;
9719 25         50 my $data_bar = shift;
9720 25         42 my $type = 'dataBar';
9721 25         45 my $id = $data_bar->{_guid};
9722              
9723 25         61 my @attributes = (
9724             'type' => $type,
9725             'id' => $id,
9726             );
9727              
9728 25         75 $self->xml_start_tag( 'x14:cfRule', @attributes );
9729              
9730             }
9731              
9732              
9733             ##############################################################################
9734             #
9735             # _write_x14_data_bar()
9736             #
9737             # Write the element.
9738             #
9739             sub _write_x14_data_bar {
9740              
9741 25     25   40 my $self = shift;
9742 25         34 my $data_bar = shift;
9743 25         39 my $min_length = 0;
9744 25         33 my $max_length = 100;
9745              
9746 25         54 my @attributes = (
9747             'minLength' => $min_length,
9748             'maxLength' => $max_length,
9749             );
9750              
9751 25 100       62 if ( !$data_bar->{bar_no_border} ) {
9752 24         47 push @attributes, ( 'border', 1 );
9753             }
9754              
9755 25 100       61 if ( $data_bar->{bar_solid} ) {
9756 1         3 push @attributes, ( 'gradient', 0 );
9757             }
9758              
9759 25 100       63 if ( $data_bar->{bar_direction} eq 'left' ) {
9760 1         3 push @attributes, ( 'direction', 'leftToRight' );
9761             }
9762              
9763 25 100       56 if ( $data_bar->{bar_direction} eq 'right' ) {
9764 1         3 push @attributes, ( 'direction', 'rightToLeft' );
9765             }
9766              
9767 25 100       57 if ( $data_bar->{bar_negative_color_same} ) {
9768 1         2 push @attributes, ( 'negativeBarColorSameAsPositive', 1 );
9769             }
9770              
9771 25 100 100     104 if ( !$data_bar->{bar_no_border}
9772             && !$data_bar->{bar_negative_border_color_same} )
9773             {
9774 23         46 push @attributes, ( 'negativeBarBorderColorSameAsPositive', 0 );
9775             }
9776              
9777 25 100       58 if ( $data_bar->{bar_axis_position} eq 'middle') {
9778 1         2 push @attributes, ( 'axisPosition', 'middle' );
9779             }
9780              
9781 25 100       57 if ( $data_bar->{bar_axis_position} eq 'none') {
9782 1         2 push @attributes, ( 'axisPosition', 'none' );
9783             }
9784              
9785 25         63 $self->xml_start_tag( 'x14:dataBar', @attributes );
9786             }
9787              
9788              
9789             ##############################################################################
9790             #
9791             # _write_x14_border_color()
9792             #
9793             # Write the element.
9794             #
9795             sub _write_x14_border_color {
9796              
9797 24     24   41 my $self = shift;
9798 24         44 my $rgb = shift;
9799              
9800 24         55 my @attributes = ( 'rgb' => $rgb );
9801              
9802 24         67 $self->xml_empty_tag( 'x14:borderColor', @attributes );
9803             }
9804              
9805              
9806             ##############################################################################
9807             #
9808             # _write_x14_negative_fill_color()
9809             #
9810             # Write the element.
9811             #
9812             sub _write_x14_negative_fill_color {
9813              
9814 24     24   43 my $self = shift;
9815 24         35 my $rgb = shift;
9816              
9817 24         70 my @attributes = ( 'rgb' => $rgb );
9818              
9819 24         59 $self->xml_empty_tag( 'x14:negativeFillColor', @attributes );
9820             }
9821              
9822              
9823             ##############################################################################
9824             #
9825             # _write_x14_negative_border_color()
9826             #
9827             # Write the element.
9828             #
9829             sub _write_x14_negative_border_color {
9830              
9831 23     23   38 my $self = shift;
9832 23         33 my $rgb = shift;
9833              
9834 23         46 my @attributes = ( 'rgb' => $rgb );
9835              
9836 23         65 $self->xml_empty_tag( 'x14:negativeBorderColor', @attributes );
9837             }
9838              
9839              
9840             ##############################################################################
9841             #
9842             # _write_x14_axis_color()
9843             #
9844             # Write the element.
9845             #
9846             sub _write_x14_axis_color {
9847              
9848 24     24   41 my $self = shift;
9849 24         35 my $rgb = shift;
9850              
9851 24         45 my @attributes = ( 'rgb' => $rgb );
9852              
9853 24         79 $self->xml_empty_tag( 'x14:axisColor', @attributes );
9854             }
9855              
9856              
9857             ##############################################################################
9858             #
9859             # _write_ext_list_sparklines()
9860             #
9861             # Write the sparkline subelements.
9862             #
9863             sub _write_ext_list_sparklines {
9864              
9865 12     12   42 my $self = shift;
9866 12         28 my @sparklines = @{ $self->{_sparklines} };
  12         45  
9867 12         40 my $count = scalar @sparklines;
9868              
9869             # Write the ext element.
9870 12         64 $self->_write_ext('{05C60535-1F16-4fd2-B633-F4F36F0B64E0}');
9871              
9872             # Write the x14:sparklineGroups element.
9873 12         49 $self->_write_sparkline_groups();
9874              
9875             # Write the sparkline elements.
9876 12         33 for my $sparkline ( reverse @sparklines ) {
9877              
9878             # Write the x14:sparklineGroup element.
9879 58         196 $self->_write_sparkline_group( $sparkline );
9880              
9881             # Write the x14:colorSeries element.
9882 58         190 $self->_write_color_series( $sparkline->{_series_color} );
9883              
9884             # Write the x14:colorNegative element.
9885 58         188 $self->_write_color_negative( $sparkline->{_negative_color} );
9886              
9887             # Write the x14:colorAxis element.
9888 58         158 $self->_write_color_axis();
9889              
9890             # Write the x14:colorMarkers element.
9891 58         205 $self->_write_color_markers( $sparkline->{_markers_color} );
9892              
9893             # Write the x14:colorFirst element.
9894 58         193 $self->_write_color_first( $sparkline->{_first_color} );
9895              
9896             # Write the x14:colorLast element.
9897 58         185 $self->_write_color_last( $sparkline->{_last_color} );
9898              
9899             # Write the x14:colorHigh element.
9900 58         168 $self->_write_color_high( $sparkline->{_high_color} );
9901              
9902             # Write the x14:colorLow element.
9903 58         161 $self->_write_color_low( $sparkline->{_low_color} );
9904              
9905 58 100       151 if ( $sparkline->{_date_axis} ) {
9906 1         8 $self->xml_data_element( 'xm:f', $sparkline->{_date_axis} );
9907             }
9908              
9909 58         172 $self->_write_sparklines( $sparkline );
9910              
9911 58         122 $self->xml_end_tag( 'x14:sparklineGroup' );
9912             }
9913              
9914              
9915 12         54 $self->xml_end_tag( 'x14:sparklineGroups' );
9916 12         112 $self->xml_end_tag( 'ext' );
9917             }
9918              
9919              
9920             ##############################################################################
9921             #
9922             # _write_sparklines()
9923             #
9924             # Write the element and subelements.
9925             #
9926             sub _write_sparklines {
9927              
9928 58     58   88 my $self = shift;
9929 58         90 my $sparkline = shift;
9930              
9931             # Write the sparkline elements.
9932 58         173 $self->xml_start_tag( 'x14:sparklines' );
9933              
9934 58         182 for my $i ( 0 .. $sparkline->{_count} - 1 ) {
9935 59         150 my $range = $sparkline->{_ranges}->[$i];
9936 59         106 my $location = $sparkline->{_locations}->[$i];
9937              
9938 59         196 $self->xml_start_tag( 'x14:sparkline' );
9939 59         225 $self->xml_data_element( 'xm:f', $range );
9940 59         170 $self->xml_data_element( 'xm:sqref', $location );
9941 59         151 $self->xml_end_tag( 'x14:sparkline' );
9942             }
9943              
9944              
9945 58         146 $self->xml_end_tag( 'x14:sparklines' );
9946             }
9947              
9948              
9949             ##############################################################################
9950             #
9951             # _write_ext()
9952             #
9953             # Write the element for sparklines.
9954             #
9955             sub _write_ext {
9956              
9957 48     48   97 my $self = shift;
9958 48         98 my $uri = shift;
9959 48         83 my $schema = 'http://schemas.microsoft.com/office/';
9960 48         140 my $xmlns_x14 = $schema . 'spreadsheetml/2009/9/main';
9961              
9962 48         118 my @attributes = (
9963             'xmlns:x14' => $xmlns_x14,
9964             'uri' => $uri,
9965             );
9966              
9967 48         135 $self->xml_start_tag( 'ext', @attributes );
9968             }
9969              
9970              
9971             ##############################################################################
9972             #
9973             # _write_sparkline_groups()
9974             #
9975             # Write the element.
9976             #
9977             sub _write_sparkline_groups {
9978              
9979 12     12   33 my $self = shift;
9980 12         25 my $xmlns_xm = 'http://schemas.microsoft.com/office/excel/2006/main';
9981              
9982 12         33 my @attributes = ( 'xmlns:xm' => $xmlns_xm );
9983              
9984 12         39 $self->xml_start_tag( 'x14:sparklineGroups', @attributes );
9985              
9986             }
9987              
9988              
9989             ##############################################################################
9990             #
9991             # _write_sparkline_group()
9992             #
9993             # Write the element.
9994             #
9995             # Example for order.
9996             #
9997             #
9998             # manualMax="0"
9999             # manualMin="0"
10000             # lineWeight="2.25"
10001             # type="column"
10002             # dateAxis="1"
10003             # displayEmptyCellsAs="span"
10004             # markers="1"
10005             # high="1"
10006             # low="1"
10007             # first="1"
10008             # last="1"
10009             # negative="1"
10010             # displayXAxis="1"
10011             # displayHidden="1"
10012             # minAxisType="custom"
10013             # maxAxisType="custom"
10014             # rightToLeft="1">
10015             #
10016             sub _write_sparkline_group {
10017              
10018 58     58   98 my $self = shift;
10019 58         89 my $opts = shift;
10020 58         169 my $empty = $opts->{_empty};
10021 58         84 my $user_max = 0;
10022 58         111 my $user_min = 0;
10023 58         93 my @a;
10024              
10025 58 100       161 if ( defined $opts->{_max} ) {
10026              
10027 4 100       24 if ( $opts->{_max} eq 'group' ) {
10028 2         5 $opts->{_cust_max} = 'group';
10029             }
10030             else {
10031 2         7 push @a, ( 'manualMax' => $opts->{_max} );
10032 2         6 $opts->{_cust_max} = 'custom';
10033             }
10034             }
10035              
10036 58 100       135 if ( defined $opts->{_min} ) {
10037              
10038 4 100       11 if ( $opts->{_min} eq 'group' ) {
10039 1         3 $opts->{_cust_min} = 'group';
10040             }
10041             else {
10042 3         7 push @a, ( 'manualMin' => $opts->{_min} );
10043 3         7 $opts->{_cust_min} = 'custom';
10044             }
10045             }
10046              
10047              
10048             # Ignore the default type attribute (line).
10049 58 100       165 if ( $opts->{_type} ne 'line' ) {
10050 9         25 push @a, ( 'type' => $opts->{_type} );
10051             }
10052              
10053 58 100       162 push @a, ( 'lineWeight' => $opts->{_weight} ) if $opts->{_weight};
10054 58 100       135 push @a, ( 'dateAxis' => 1 ) if $opts->{_date_axis};
10055 58 100       153 push @a, ( 'displayEmptyCellsAs' => $empty ) if $empty;
10056              
10057 58 100       136 push @a, ( 'markers' => 1 ) if $opts->{_markers};
10058 58 100       125 push @a, ( 'high' => 1 ) if $opts->{_high};
10059 58 100       126 push @a, ( 'low' => 1 ) if $opts->{_low};
10060 58 100       137 push @a, ( 'first' => 1 ) if $opts->{_first};
10061 58 100       124 push @a, ( 'last' => 1 ) if $opts->{_last};
10062 58 100       127 push @a, ( 'negative' => 1 ) if $opts->{_negative};
10063 58 100       150 push @a, ( 'displayXAxis' => 1 ) if $opts->{_axis};
10064 58 100       138 push @a, ( 'displayHidden' => 1 ) if $opts->{_hidden};
10065 58 100       139 push @a, ( 'minAxisType' => $opts->{_cust_min} ) if $opts->{_cust_min};
10066 58 100       125 push @a, ( 'maxAxisType' => $opts->{_cust_max} ) if $opts->{_cust_max};
10067 58 100       128 push @a, ( 'rightToLeft' => 1 ) if $opts->{_reverse};
10068              
10069 58         163 $self->xml_start_tag( 'x14:sparklineGroup', @a );
10070             }
10071              
10072              
10073             ##############################################################################
10074             #
10075             # _write_spark_color()
10076             #
10077             # Helper function for the sparkline color functions below.
10078             #
10079             sub _write_spark_color {
10080              
10081 464     464   647 my $self = shift;
10082 464         642 my $element = shift;
10083 464         612 my $color = shift;
10084 464         648 my @attr;
10085              
10086 464 100       1031 push @attr, ( 'rgb' => $color->{_rgb} ) if defined $color->{_rgb};
10087 464 100       1047 push @attr, ( 'theme' => $color->{_theme} ) if defined $color->{_theme};
10088 464 100       908 push @attr, ( 'tint' => $color->{_tint} ) if defined $color->{_tint};
10089              
10090 464         968 $self->xml_empty_tag( $element, @attr );
10091             }
10092              
10093              
10094             ##############################################################################
10095             #
10096             # _write_color_series()
10097             #
10098             # Write the element.
10099             #
10100             sub _write_color_series {
10101              
10102 58     58   101 my $self = shift;
10103              
10104 58         136 $self->_write_spark_color( 'x14:colorSeries', @_ );
10105             }
10106              
10107              
10108             ##############################################################################
10109             #
10110             # _write_color_negative()
10111             #
10112             # Write the element.
10113             #
10114             sub _write_color_negative {
10115              
10116 58     58   93 my $self = shift;
10117              
10118 58         125 $self->_write_spark_color( 'x14:colorNegative', @_ );
10119             }
10120              
10121              
10122             ##############################################################################
10123             #
10124             # _write_color_axis()
10125             #
10126             # Write the element.
10127             #
10128             sub _write_color_axis {
10129              
10130 58     58   97 my $self = shift;
10131              
10132 58         173 $self->_write_spark_color( 'x14:colorAxis', { _rgb => 'FF000000' } );
10133             }
10134              
10135              
10136             ##############################################################################
10137             #
10138             # _write_color_markers()
10139             #
10140             # Write the element.
10141             #
10142             sub _write_color_markers {
10143              
10144 58     58   112 my $self = shift;
10145              
10146 58         118 $self->_write_spark_color( 'x14:colorMarkers', @_ );
10147             }
10148              
10149              
10150             ##############################################################################
10151             #
10152             # _write_color_first()
10153             #
10154             # Write the element.
10155             #
10156             sub _write_color_first {
10157              
10158 58     58   97 my $self = shift;
10159              
10160 58         125 $self->_write_spark_color( 'x14:colorFirst', @_ );
10161             }
10162              
10163              
10164             ##############################################################################
10165             #
10166             # _write_color_last()
10167             #
10168             # Write the element.
10169             #
10170             sub _write_color_last {
10171              
10172 58     58   95 my $self = shift;
10173              
10174 58         117 $self->_write_spark_color( 'x14:colorLast', @_ );
10175             }
10176              
10177              
10178             ##############################################################################
10179             #
10180             # _write_color_high()
10181             #
10182             # Write the element.
10183             #
10184             sub _write_color_high {
10185              
10186 58     58   99 my $self = shift;
10187              
10188 58         119 $self->_write_spark_color( 'x14:colorHigh', @_ );
10189             }
10190              
10191              
10192             ##############################################################################
10193             #
10194             # _write_color_low()
10195             #
10196             # Write the element.
10197             #
10198             sub _write_color_low {
10199              
10200 58     58   99 my $self = shift;
10201              
10202 58         128 $self->_write_spark_color( 'x14:colorLow', @_ );
10203             }
10204              
10205              
10206             1;
10207              
10208              
10209             __END__