File Coverage

blib/lib/Excel/Writer/XLSX/Worksheet.pm
Criterion Covered Total %
statement 3600 3838 93.8
branch 1513 1804 83.8
condition 578 699 82.6
subroutine 241 249 96.7
pod 0 90 0.0
total 5932 6680 88.8


line stmt bran cond sub pod time code
1              
2             ###############################################################################
3             #
4             # Worksheet - A class for writing Excel Worksheets.
5             #
6             #
7             # Used in conjunction with Excel::Writer::XLSX
8             #
9             # Copyright 2000-2021, John McNamara, jmcnamara@cpan.org
10             #
11             # Documentation after __END__
12             #
13              
14             # perltidy with the following options: -mbl=2 -pt=0 -nola
15              
16             use 5.008002;
17 1126     1126   27902 use strict;
  1126         3672  
18 1126     1126   5287 use warnings;
  1126         2034  
  1126         19073  
19 1126     1126   4555 use Carp;
  1126         2060  
  1126         26627  
20 1126     1126   4807 use File::Temp 'tempfile';
  1126         2043  
  1126         60235  
21 1126     1126   7621 use List::Util qw(max min);
  1126         39226  
  1126         46352  
22 1126     1126   6215 use Excel::Writer::XLSX::Format;
  1126         2295  
  1126         73766  
23 1126     1126   432109 use Excel::Writer::XLSX::Drawing;
  1126         2873  
  1126         49487  
24 1126     1126   498262 use Excel::Writer::XLSX::Package::XMLwriter;
  1126         4377  
  1126         77032  
25 1126     1126   11178 use Excel::Writer::XLSX::Utility qw(xl_cell_to_rowcol
  1126         3214  
  1126         39882  
26 1126         1836186 xl_rowcol_to_cell
27             xl_col_to_name
28             xl_range
29             quote_sheetname);
30 1126     1126   515189  
  1126         3860  
31             our @ISA = qw(Excel::Writer::XLSX::Package::XMLwriter);
32             our $VERSION = '1.09';
33              
34              
35             ###############################################################################
36             #
37             # Public and private API methods.
38             #
39             ###############################################################################
40              
41              
42             ###############################################################################
43             #
44             # new()
45             #
46             # Constructor.
47             #
48              
49             my $class = shift;
50             my $fh = shift;
51 1418     1418 0 271739 my $self = Excel::Writer::XLSX::Package::XMLwriter->new( $fh );
52 1418         2643 my $rowmax = 1_048_576;
53 1418         6218 my $colmax = 16_384;
54 1418         2899 my $strmax = 32767;
55 1418         2640  
56 1418         2474 $self->{_name} = $_[0];
57             $self->{_index} = $_[1];
58 1418         4216 $self->{_activesheet} = $_[2];
59 1418         2984 $self->{_firstsheet} = $_[3];
60 1418         2910 $self->{_str_total} = $_[4];
61 1418         2754 $self->{_str_unique} = $_[5];
62 1418         2791 $self->{_str_table} = $_[6];
63 1418         2635 $self->{_date_1904} = $_[7];
64 1418         3978 $self->{_palette} = $_[8];
65 1418         2813 $self->{_optimization} = $_[9] || 0;
66 1418         2866 $self->{_tempdir} = $_[10];
67 1418   100     6529 $self->{_excel2003_style} = $_[11];
68 1418         2997 $self->{_default_url_format} = $_[12];
69 1418         2875 $self->{_max_url_length} = $_[13] || 2079;
70 1418         2747  
71 1418   100     4769 $self->{_ext_sheets} = [];
72             $self->{_fileclosed} = 0;
73 1418         4845 $self->{_excel_version} = 2007;
74 1418         3076  
75 1418         2990 $self->{_xls_rowmax} = $rowmax;
76             $self->{_xls_colmax} = $colmax;
77 1418         3045 $self->{_xls_strmax} = $strmax;
78 1418         2909 $self->{_dim_rowmin} = undef;
79 1418         2935 $self->{_dim_rowmax} = undef;
80 1418         2992 $self->{_dim_colmin} = undef;
81 1418         2957 $self->{_dim_colmax} = undef;
82 1418         2886  
83 1418         2903 $self->{_colinfo} = {};
84             $self->{_selections} = [];
85 1418         3086 $self->{_hidden} = 0;
86 1418         3081 $self->{_active} = 0;
87 1418         2929 $self->{_tab_color} = 0;
88 1418         2886  
89 1418         2845 $self->{_panes} = [];
90             $self->{_active_pane} = 3;
91 1418         2978 $self->{_selected} = 0;
92 1418         4913 $self->{_hide_row_col_headers} = 0;
93 1418         2820  
94 1418         2585 $self->{_page_setup_changed} = 0;
95             $self->{_paper_size} = 0;
96 1418         2759 $self->{_orientation} = 1;
97 1418         2579  
98 1418         2827 $self->{_print_options_changed} = 0;
99             $self->{_hcenter} = 0;
100 1418         2649 $self->{_vcenter} = 0;
101 1418         2621 $self->{_print_gridlines} = 0;
102 1418         2639 $self->{_screen_gridlines} = 1;
103 1418         2601 $self->{_print_headers} = 0;
104 1418         2599  
105 1418         2555 $self->{_header_footer_changed} = 0;
106             $self->{_header} = '';
107 1418         2626 $self->{_footer} = '';
108 1418         2929 $self->{_header_footer_aligns} = 1;
109 1418         3084 $self->{_header_footer_scales} = 1;
110 1418         2595 $self->{_header_images} = [];
111 1418         2703 $self->{_footer_images} = [];
112 1418         2891 $self->{_background_image} = '';
113 1418         3009  
114 1418         2912 $self->{_margin_left} = 0.7;
115             $self->{_margin_right} = 0.7;
116 1418         2750 $self->{_margin_top} = 0.75;
117 1418         2747 $self->{_margin_bottom} = 0.75;
118 1418         2769 $self->{_margin_header} = 0.3;
119 1418         2741 $self->{_margin_footer} = 0.3;
120 1418         2733  
121 1418         2592 $self->{_repeat_rows} = '';
122             $self->{_repeat_cols} = '';
123 1418         2801 $self->{_print_area} = '';
124 1418         3013  
125 1418         2758 $self->{_page_order} = 0;
126             $self->{_black_white} = 0;
127 1418         2541 $self->{_draft_quality} = 0;
128 1418         2686 $self->{_print_comments} = 0;
129 1418         2837 $self->{_page_start} = 0;
130 1418         7025  
131 1418         3406 $self->{_fit_page} = 0;
132             $self->{_fit_width} = 0;
133 1418         2565 $self->{_fit_height} = 0;
134 1418         2539  
135 1418         2477 $self->{_hbreaks} = [];
136             $self->{_vbreaks} = [];
137 1418         2920  
138 1418         2985 $self->{_protect} = 0;
139             $self->{_password} = undef;
140 1418         2790 $self->{_protected_ranges} = [];
141 1418         2675 $self->{_num_protected_ranges} = 0;
142 1418         2840  
143 1418         2755 $self->{_set_cols} = {};
144             $self->{_set_rows} = {};
145 1418         2896  
146 1418         2907 $self->{_zoom} = 100;
147             $self->{_zoom_scale_normal} = 1;
148 1418         2717 $self->{_print_scale} = 100;
149 1418         2664 $self->{_right_to_left} = 0;
150 1418         2678 $self->{_show_zeros} = 1;
151 1418         2729 $self->{_leading_zeros} = 0;
152 1418         2590  
153 1418         2592 $self->{_outline_row_level} = 0;
154             $self->{_outline_col_level} = 0;
155 1418         2505 $self->{_outline_style} = 0;
156 1418         2653 $self->{_outline_below} = 1;
157 1418         2668 $self->{_outline_right} = 1;
158 1418         2701 $self->{_outline_on} = 1;
159 1418         2675 $self->{_outline_changed} = 0;
160 1418         2547  
161 1418         2576 $self->{_original_row_height} = 15;
162             $self->{_default_row_height} = 15;
163 1418         2575 $self->{_default_row_pixels} = 20;
164 1418         2554 $self->{_default_col_width} = 8.43;
165 1418         2458 $self->{_default_col_pixels} = 64;
166 1418         2619 $self->{_default_row_zeroed} = 0;
167 1418         2602  
168 1418         2562 $self->{_names} = {};
169              
170 1418         2779 $self->{_write_match} = [];
171              
172 1418         2883  
173             $self->{_table} = {};
174             $self->{_merge} = [];
175 1418         2839  
176 1418         2813 $self->{_has_vml} = 0;
177             $self->{_has_header_vml} = 0;
178 1418         2716 $self->{_has_comments} = 0;
179 1418         2692 $self->{_comments} = {};
180 1418         2493 $self->{_comments_array} = [];
181 1418         2735 $self->{_comments_author} = '';
182 1418         2842 $self->{_comments_visible} = 0;
183 1418         2938 $self->{_vml_shape_id} = 1024;
184 1418         2585 $self->{_buttons_array} = [];
185 1418         2614 $self->{_header_images_array} = [];
186 1418         2836 $self->{_ignore_errors} = undef;
187 1418         2824  
188 1418         2854 $self->{_autofilter} = '';
189             $self->{_filter_on} = 0;
190 1418         2820 $self->{_filter_range} = [];
191 1418         2662 $self->{_filter_cols} = {};
192 1418         2805  
193 1418         2880 $self->{_col_sizes} = {};
194             $self->{_row_sizes} = {};
195 1418         3058 $self->{_col_formats} = {};
196 1418         2970 $self->{_col_size_changed} = 0;
197 1418         3019 $self->{_row_size_changed} = 0;
198 1418         2906  
199 1418         2704 $self->{_last_shape_id} = 1;
200             $self->{_rel_count} = 0;
201 1418         2590 $self->{_hlink_count} = 0;
202 1418         2585 $self->{_hlink_refs} = [];
203 1418         2624 $self->{_external_hyper_links} = [];
204 1418         2813 $self->{_external_drawing_links} = [];
205 1418         2841 $self->{_external_comment_links} = [];
206 1418         2875 $self->{_external_vml_links} = [];
207 1418         3002 $self->{_external_table_links} = [];
208 1418         2829 $self->{_external_background_links} = [];
209 1418         10669 $self->{_drawing_links} = [];
210 1418         3721 $self->{_vml_drawing_links} = [];
211 1418         2924 $self->{_charts} = [];
212 1418         2803 $self->{_images} = [];
213 1418         2613 $self->{_tables} = [];
214 1418         2686 $self->{_sparklines} = [];
215 1418         2680 $self->{_shapes} = [];
216 1418         2643 $self->{_shape_hash} = {};
217 1418         2584 $self->{_has_shapes} = 0;
218 1418         2850 $self->{_drawing} = 0;
219 1418         2653 $self->{_drawing_rels} = {};
220 1418         2676 $self->{_drawing_rels_id} = 0;
221 1418         2979 $self->{_vml_drawing_rels} = {};
222 1418         2807 $self->{_vml_drawing_rels_id} = 0;
223 1418         2782 $self->{_has_dynamic_arrays} = 0;
224 1418         2727  
225 1418         2611 $self->{_horizontal_dpi} = 0;
226             $self->{_vertical_dpi} = 0;
227 1418         2683  
228 1418         2954 $self->{_rstring} = '';
229             $self->{_previous_row} = 0;
230 1418         2913  
231 1418         2763 if ( $self->{_optimization} == 1 ) {
232             my $fh = tempfile( DIR => $self->{_tempdir} );
233 1418 100       4830 binmode $fh, ':utf8';
234 10         58  
235 10         5733 $self->{_cell_data_fh} = $fh;
236             $self->{_fh} = $fh;
237 10         28 }
238 10         27  
239             $self->{_validations} = [];
240             $self->{_cond_formats} = {};
241 1418         3203 $self->{_data_bars_2010} = [];
242 1418         7541 $self->{_use_data_bars_2010} = 0;
243 1418         3712 $self->{_dxf_priority} = 1;
244 1418         3045  
245 1418         2791 if ( $self->{_excel2003_style} ) {
246             $self->{_original_row_height} = 12.75;
247 1418 100       4212 $self->{_default_row_height} = 12.75;
248 8         15 $self->{_default_row_pixels} = 17;
249 8         15 $self->{_margin_left} = 0.75;
250 8         14 $self->{_margin_right} = 0.75;
251 8         14 $self->{_margin_top} = 1;
252 8         17 $self->{_margin_bottom} = 1;
253 8         20 $self->{_margin_header} = 0.5;
254 8         15 $self->{_margin_footer} = 0.5;
255 8         14 $self->{_header_footer_aligns} = 0;
256 8         11 }
257 8         14  
258             bless $self, $class;
259             return $self;
260 1418         3374 }
261 1418         5082  
262             ###############################################################################
263             #
264             # _set_xml_writer()
265             #
266             # Over-ridden to ensure that write_single_row() is called for the final row
267             # when optimisation mode is on.
268             #
269              
270             my $self = shift;
271             my $filename = shift;
272              
273 1041     1041   12208 if ( $self->{_optimization} == 1 ) {
274 1041         2174 $self->_write_single_row();
275             }
276 1041 100       4062  
277 10         43 $self->SUPER::_set_xml_writer( $filename );
278             }
279              
280 1041         7986  
281             ###############################################################################
282             #
283             # _assemble_xml_file()
284             #
285             # Assemble and write the XML file.
286             #
287              
288             my $self = shift;
289              
290             $self->xml_declaration();
291              
292 1078     1078   2763 # Write the root worksheet element.
293             $self->_write_worksheet();
294 1078         8639  
295             # Write the worksheet properties.
296             $self->_write_sheet_pr();
297 1078         5618  
298             # Write the worksheet dimensions.
299             $self->_write_dimension();
300 1078         4372  
301             # Write the sheet view properties.
302             $self->_write_sheet_views();
303 1078         4418  
304             # Write the sheet format properties.
305             $self->_write_sheet_format_pr();
306 1078         4603  
307             # Write the sheet column info.
308             $self->_write_cols();
309 1078         4585  
310             # Write the worksheet data such as rows columns and cells.
311             if ( $self->{_optimization} == 0 ) {
312 1078         4040 $self->_write_sheet_data();
313             }
314             else {
315 1078 100       3804 $self->_write_optimized_sheet_data();
316 1068         4623 }
317              
318             # Write the sheetProtection element.
319 10         32 $self->_write_sheet_protection();
320              
321             # Write the protectedRanges element.
322             $self->_write_protected_ranges();
323 1078         5553  
324             # Write the worksheet calculation properties.
325             #$self->_write_sheet_calc_pr();
326 1078         4254  
327             # Write the worksheet phonetic properties.
328             if ($self->{_excel2003_style}) {
329             $self->_write_phonetic_pr();
330             }
331              
332 1078 100       4441 # Write the autoFilter element.
333 8         33 $self->_write_auto_filter();
334              
335             # Write the mergeCells element.
336             $self->_write_merge_cells();
337 1078         5045  
338             # Write the conditional formats.
339             $self->_write_conditional_formats();
340 1078         4426  
341             # Write the dataValidations element.
342             $self->_write_data_validations();
343 1078         4640  
344             # Write the hyperlink element.
345             $self->_write_hyperlinks();
346 1078         4316  
347             # Write the printOptions element.
348             $self->_write_print_options();
349 1078         4768  
350             # Write the worksheet page_margins.
351             $self->_write_page_margins();
352 1078         4342  
353             # Write the worksheet page setup.
354             $self->_write_page_setup();
355 1078         4635  
356             # Write the headerFooter element.
357             $self->_write_header_footer();
358 1078         4787  
359             # Write the rowBreaks element.
360             $self->_write_row_breaks();
361 1078         4366  
362             # Write the colBreaks element.
363             $self->_write_col_breaks();
364 1078         4999  
365             # Write the ignoredErrors element.
366             $self->_write_ignored_errors();
367 1078         4424  
368             # Write the drawing element.
369             $self->_write_drawings();
370 1078         5334  
371             # Write the legacyDrawing element.
372             $self->_write_legacy_drawing();
373 1078         5635  
374             # Write the legacyDrawingHF element.
375             $self->_write_legacy_drawing_hf();
376 1078         5580  
377             # Write the picture element, for backgrounds.
378             $self->_write_picture();
379 1078         5535  
380             # Write the tableParts element.
381             $self->_write_table_parts();
382 1078         7098  
383             # Write the extLst elements.
384             $self->_write_ext_list();
385 1078         6332  
386             # Close the worksheet tag.
387             $self->xml_end_tag( 'worksheet' );
388 1078         5436  
389             # Close the XML writer filehandle.
390             $self->xml_get_fh()->close();
391 1078         4438 }
392              
393              
394 1078         7415 ###############################################################################
395             #
396             # _close()
397             #
398             # Write the worksheet elements.
399             #
400              
401             # TODO. Unused. Remove after refactoring.
402             my $self = shift;
403             my $sheetnames = shift;
404             my $num_sheets = scalar @$sheetnames;
405             }
406              
407 0     0   0  
408 0         0 ###############################################################################
409 0         0 #
410             # get_name().
411             #
412             # Retrieve the worksheet name.
413             #
414              
415             my $self = shift;
416              
417             return $self->{_name};
418             }
419              
420              
421 1041     1041 0 2268 ###############################################################################
422             #
423 1041         4637 # select()
424             #
425             # Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
426             # highlighted.
427             #
428              
429             my $self = shift;
430              
431             $self->{_hidden} = 0; # Selected worksheet can't be hidden.
432             $self->{_selected} = 1;
433             }
434              
435              
436 118     118 0 1765 ###############################################################################
437             #
438 118         405 # activate()
439 118         262 #
440             # Set this worksheet as the active worksheet, i.e. the worksheet that is
441             # displayed when the workbook is opened. Also set it as selected.
442             #
443              
444             my $self = shift;
445              
446             $self->{_hidden} = 0; # Active worksheet can't be hidden.
447             $self->{_selected} = 1;
448             ${ $self->{_activesheet} } = $self->{_index};
449             }
450              
451              
452 8     8 0 62 ###############################################################################
453             #
454 8         20 # hide()
455 8         38 #
456 8         18 # Hide this worksheet.
  8         24  
457             #
458              
459             my $self = shift;
460              
461             $self->{_hidden} = 1;
462              
463             # A hidden worksheet shouldn't be active or selected.
464             $self->{_selected} = 0;
465             ${ $self->{_activesheet} } = 0;
466             ${ $self->{_firstsheet} } = 0;
467             }
468 2     2 0 12  
469              
470 2         4 ###############################################################################
471             #
472             # set_first_sheet()
473 2         4 #
474 2         3 # Set this worksheet as the first visible sheet. This is necessary
  2         12  
475 2         5 # when there are a large number of worksheets and the activated
  2         4  
476             # worksheet is not visible on the screen.
477             #
478              
479             my $self = shift;
480              
481             $self->{_hidden} = 0; # Active worksheet can't be hidden.
482             ${ $self->{_firstsheet} } = $self->{_index};
483             }
484              
485              
486             ###############################################################################
487             #
488             # protect( $password )
489 1     1 0 6 #
490             # Set the worksheet protection flags to prevent modification of worksheet
491 1         2 # objects.
492 1         9 #
  1         4  
493              
494             my $self = shift;
495             my $password = shift || '';
496             my $options = shift || {};
497              
498             if ( $password ne '' ) {
499             $password = $self->_encode_password( $password );
500             }
501              
502             # Default values for objects that can be protected.
503             my %defaults = (
504             sheet => 1,
505 30     30 0 369 content => 0,
506 30   100     99 objects => 0,
507 30   100     78 scenarios => 0,
508             format_cells => 0,
509 30 100       79 format_columns => 0,
510 6         23 format_rows => 0,
511             insert_columns => 0,
512             insert_rows => 0,
513             insert_hyperlinks => 0,
514 30         288 delete_columns => 0,
515             delete_rows => 0,
516             select_locked_cells => 1,
517             sort => 0,
518             autofilter => 0,
519             pivot_tables => 0,
520             select_unlocked_cells => 1,
521             );
522              
523              
524             # Overwrite the defaults with user specified values.
525             for my $key ( keys %{$options} ) {
526              
527             if ( exists $defaults{$key} ) {
528             $defaults{$key} = $options->{$key};
529             }
530             else {
531             carp "Unknown protection object: $key\n";
532             }
533             }
534              
535             # Set the password after the user defined values.
536 30         55 $defaults{password} = $password;
  30         93  
537              
538 60 50       97 $self->{_protect} = \%defaults;
539 60         86 }
540              
541              
542 0         0 ###############################################################################
543             #
544             # unprotect_range( $range, $range_name, $password )
545             #
546             # Unprotect ranges within a protected worksheet.
547 30         72 #
548              
549 30         146 my $self = shift;
550             my $range = shift;
551             my $range_name = shift;
552             my $password = shift;
553              
554             if ( !defined $range ) {
555             carp "The range must be defined in unprotect_range())\n";
556             return;
557             }
558             else {
559             $range =~ s/\$//g;
560             $range =~ s/^=//;
561 9     9 0 39 $self->{_num_protected_ranges}++;
562 9         17 }
563 9         12  
564 9         11  
565             if ( !defined $range_name ) {
566 9 50       20 $range_name = 'Range' . $self->{_num_protected_ranges};
567 0         0 }
568 0         0  
569             if ( defined $password ) {
570             $password = $self->_encode_password( $password );
571 9         18 }
572 9         17  
573 9         12 push @{ $self->{_protected_ranges} }, [ $range, $range_name, $password ];
574             }
575              
576              
577 9 100       20 ###############################################################################
578 7         16 #
579             # _encode_password($password)
580             #
581 9 100       19 # Based on the algorithm provided by Daniel Rentz of OpenOffice.
582 2         5 #
583              
584             use integer;
585 9         12  
  9         27  
586             my $self = shift;
587             my $plaintext = $_[0];
588             my $password;
589             my $count;
590             my @chars;
591             my $i = 0;
592              
593             $count = @chars = split //, $plaintext;
594              
595             foreach my $char ( @chars ) {
596             my $low_15;
597 1126     1126   13147 my $high_15;
  1126         3427  
  1126         9347  
598             $char = ord( $char ) << ++$i;
599 8     8   13 $low_15 = $char & 0x7fff;
600 8         12 $high_15 = $char & 0x7fff << 15;
601 8         24 $high_15 = $high_15 >> 15;
602             $char = $low_15 | $high_15;
603 8         0 }
604 8         18  
605             $password = 0x0000;
606 8         73 $password ^= $_ for @chars;
607             $password ^= $count;
608 8         23 $password ^= 0xCE4B;
609 62         74  
610             return sprintf "%X", $password;
611 62         77 }
612 62         72  
613 62         68  
614 62         68 ###############################################################################
615 62         88 #
616             # set_column($first_col, $last_col, $width, $format, $hidden, $level)
617             #
618 8         14 # Set the width of a single column or a range of columns.
619 8         24 # See also: _write_col_info
620 8         14 #
621 8         10  
622             my $self = shift;
623 8         47 my @data = @_;
624             my $cell = $data[0];
625              
626             # Check for a cell reference in A1 notation and substitute row and column
627             if ( $cell =~ /^\D/ ) {
628             @data = $self->_substitute_cellref( @_ );
629              
630             # Returned values $row1 and $row2 aren't required here. Remove them.
631             shift @data; # $row1
632             splice @data, 1, 1; # $row2
633             }
634              
635             # Ensure at least $first_col, $last_col and $width
636 235     235 0 2503 return if @data < 3;
637 235         624  
638 235         412  
639             my $first_col = $data[0];
640             my $last_col = $data[1];
641 235 100       981 my $width = $data[2];
642 190         711 my $format = $data[3];
643             my $hidden = $data[4] || 0;
644             my $level = $data[5];
645 190         326  
646 190         389 return if not defined $first_col; # Columns must be defined.
647             return if not defined $last_col;
648              
649             # Assume second column is the same as first if 0. Avoids KB918419 bug.
650 235 50       716 $last_col = $first_col if $last_col == 0;
651              
652             # Ensure 2nd col is larger than first. Also for KB918419 bug.
653 235         462 ( $first_col, $last_col ) = ( $last_col, $first_col )
654 235         381 if $first_col > $last_col;
655 235         374  
656 235         341 # Check that cols are valid and store max and min values with default row.
657 235   100     883 # NOTE: The check shouldn't modify the row dimensions and should only modify
658 235         462 # the column dimensions in certain cases.
659             my $ignore_row = 1;
660 235 50       605 my $ignore_col = 1;
661 235 50       622 $ignore_col = 0 if ref $format; # Column has a format.
662             $ignore_col = 0 if $width && $hidden; # Column has a width but is hidden
663              
664 235 100       603 return -2
665             if $self->_check_dimensions( 0, $first_col, $ignore_row, $ignore_col );
666             return -2
667 235 100       551 if $self->_check_dimensions( 0, $last_col, $ignore_row, $ignore_col );
668              
669             # Set the limits for the outline levels (0 <= x <= 7).
670             $level = 0 unless defined $level;
671             $level = 0 if $level < 0;
672             $level = 7 if $level > 7;
673 235         354  
674 235         428 if ( $level > $self->{_outline_col_level} ) {
675 235 100       545 $self->{_outline_col_level} = $level;
676 235 100 100     1014 }
677              
678 235 50       985 # Store the column data based on the first column. Padded for sorting.
679             $self->{_colinfo}->{ sprintf "%05d", $first_col } = [@data];
680 235 100       2259  
681             # Store the column change to allow optimisations.
682             $self->{_col_size_changed} = 1;
683              
684 233 100       598 # Store the col sizes for use when calculating image vertices taking
685 233 50       612 # hidden columns into account. Also store the column formats.
686 233 50       494 $width = $self->{_default_col_width} if !defined $width;
687              
688 233 100       701 foreach my $col ( $first_col .. $last_col ) {
689 1         7 $self->{_col_sizes}->{$col} = [$width, $hidden];
690             $self->{_col_formats}->{$col} = $format if $format;
691             }
692             }
693 233         1285  
694             ###############################################################################
695             #
696 233         430 # set_column_pixels_($first_col, $last_col, $width, $format, $hidden, $level)
697             #
698             # Set the width (and properties) of a single column or a range of columns in
699             # pixels rather than character units.
700 233 100       532 #
701              
702 233         604 my $self = shift;
703 416         984 my @data = @_;
704 416 100       1214 my $cell = $data[0];
705              
706             # Check for a cell reference in A1 notation and substitute row and column
707             if ( $cell =~ /^\D/ ) {
708             @data = $self->_substitute_cellref( @_ );
709              
710             # Returned values $row1 and $row2 aren't required here. Remove them.
711             shift @data; # $row1
712             splice @data, 1, 1; # $row2
713             }
714              
715             # Ensure at least $first_col, $last_col and $width
716             return if @data < 3;
717 33     33 0 105  
718 33         57 my $first_col = $data[0];
719 33         39 my $last_col = $data[1];
720             my $pixels = $data[2];
721             my $format = $data[3];
722 33 50       103 my $hidden = $data[4] || 0;
723 33         62 my $level = $data[5];
724             my $width;
725              
726 33         44 if ($pixels) {
727 33         47 $width = _pixels_to_width( $pixels );
728             }
729              
730             return $self->set_column( $first_col, $last_col, $width, $format,
731 33 50       60 $hidden, $level );
732             }
733 33         42  
734 33         85  
735 33         38 ###############################################################################
736 33         37 #
737 33   100     80 # set_selection()
738 33         52 #
739 33         42 # Set which cell or cells are selected in a worksheet.
740             #
741 33 100       51  
742 32         54 my $self = shift;
743             my $pane;
744             my $active_cell;
745 33         64 my $sqref;
746              
747             return unless @_;
748              
749             # Check for a cell reference in A1 notation and substitute row and column.
750             if ( $_[0] =~ /^\D/ ) {
751             @_ = $self->_substitute_cellref( @_ );
752             }
753              
754              
755             # There should be either 2 or 4 arguments.
756             if ( @_ == 2 ) {
757              
758 36     36 0 157 # Single cell selection.
759 36         93 $active_cell = xl_rowcol_to_cell( $_[0], $_[1] );
760             $sqref = $active_cell;
761 36         0 }
762             elsif ( @_ == 4 ) {
763 36 50       92  
764             # Range selection.
765             $active_cell = xl_rowcol_to_cell( $_[0], $_[1] );
766 36 100       154  
767 33         104 my ( $row_first, $col_first, $row_last, $col_last ) = @_;
768              
769             # Swap last row/col for first row/col as necessary
770             if ( $row_first > $row_last ) {
771             ( $row_first, $row_last ) = ( $row_last, $row_first );
772 36 100       98 }
    50          
773              
774             if ( $col_first > $col_last ) {
775 28         109 ( $col_first, $col_last ) = ( $col_last, $col_first );
776 28         50 }
777              
778             $sqref = xl_range( $row_first, $row_last, $col_first, $col_last );
779              
780             }
781 8         24 else {
782              
783 8         20 # User supplied wrong number or arguments.
784             return;
785             }
786 8 100       49  
787 3         7 # Selection isn't set for cell A1.
788             return if $sqref eq 'A1';
789              
790 8 100       20 $self->{_selections} = [ [ $pane, $active_cell, $sqref ] ];
791 3         5 }
792              
793              
794 8         19 ###############################################################################
795             #
796             # freeze_panes( $row, $col, $top_row, $left_col )
797             #
798             # Set panes and mark them as frozen.
799             #
800 0         0  
801             my $self = shift;
802              
803             return unless @_;
804 36 100       197  
805             # Check for a cell reference in A1 notation and substitute row and column.
806 32         137 if ( $_[0] =~ /^\D/ ) {
807             @_ = $self->_substitute_cellref( @_ );
808             }
809              
810             my $row = shift;
811             my $col = shift || 0;
812             my $top_row = shift || $row;
813             my $left_col = shift || $col;
814             my $type = shift || 0;
815              
816             $self->{_panes} = [ $row, $col, $top_row, $left_col, $type ];
817             }
818 66     66 0 305  
819              
820 66 50       137 ###############################################################################
821             #
822             # split_panes( $y, $x, $top_row, $left_col )
823 66 100       232 #
824 10         35 # Set panes and mark them as split.
825             #
826             # Implementers note. The API for this method doesn't map well from the XLS
827 66         110 # file format and isn't sufficient to describe all cases of split panes.
828 66   100     160 # It should probably be something like:
829 66   100     179 #
830 66   100     161 # split_panes( $y, $x, $top_row, $left_col, $offset_row, $offset_col )
831 66   100     150 #
832             # I'll look at changing this if it becomes an issue.
833 66         232 #
834              
835             my $self = shift;
836              
837             # Call freeze panes but add the type flag for split panes.
838             $self->freeze_panes( @_[ 0 .. 3 ], 2 );
839             }
840              
841             # Older method name for backwards compatibility.
842             *thaw_panes = *split_panes;
843              
844              
845             ###############################################################################
846             #
847             # set_portrait()
848             #
849             # Set the page orientation as portrait.
850             #
851              
852             my $self = shift;
853 38     38 0 293  
854             $self->{_orientation} = 1;
855             $self->{_page_setup_changed} = 1;
856 38         114 }
857              
858              
859             ###############################################################################
860             #
861             # set_landscape()
862             #
863             # Set the page orientation as landscape.
864             #
865              
866             my $self = shift;
867              
868             $self->{_orientation} = 0;
869             $self->{_page_setup_changed} = 1;
870             }
871 2     2 0 26  
872              
873 2         6 ###############################################################################
874 2         4 #
875             # set_page_view()
876             #
877             # Set the page view mode for Mac Excel.
878             #
879              
880             my $self = shift;
881              
882             $self->{_page_view} = defined $_[0] ? $_[0] : 1;
883             }
884              
885              
886 2     2 0 82 ###############################################################################
887             #
888 2         5 # set_tab_color()
889 2         5 #
890             # Set the colour of the worksheet tab.
891             #
892              
893             my $self = shift;
894             my $color = &Excel::Writer::XLSX::Format::_get_color( $_[0] );
895              
896             $self->{_tab_color} = $color;
897             }
898              
899              
900             ###############################################################################
901 2     2 0 9 #
902             # set_paper()
903 2 50       13 #
904             # Set the paper type. Ex. 1 = US Letter, 9 = A4
905             #
906              
907             my $self = shift;
908             my $paper_size = shift;
909              
910             if ( $paper_size ) {
911             $self->{_paper_size} = $paper_size;
912             $self->{_page_setup_changed} = 1;
913             }
914             }
915 4     4 0 64  
916 4         13  
917             ###############################################################################
918 4         11 #
919             # set_header()
920             #
921             # Set the page header caption and optional margin.
922             #
923              
924             my $self = shift;
925             my $string = $_[0] || '';
926             my $margin = $_[1] || 0.3;
927             my $options = $_[2] || {};
928              
929              
930 19     19 0 171 # Replace the Excel placeholder &[Picture] with the internal &G.
931 19         40 $string =~ s/&\[Picture\]/&G/g;
932              
933 19 50       72 if ( length $string > 255 ) {
934 19         62 carp "Header string cannot be longer than Excel's " .
935 19         58 "limit of 255 characters";
936             return;
937             }
938              
939             if ( defined $options->{align_with_margins} ) {
940             $self->{_header_footer_aligns} = $options->{align_with_margins};
941             }
942              
943             if ( defined $options->{scale_with_doc} ) {
944             $self->{_header_footer_scales} = $options->{scale_with_doc};
945             }
946              
947             # Reset the array in case the function is called more than once.
948 34     34 0 298 $self->{_header_images} = [];
949 34   100     112  
950 34   100     167 if ( $options->{image_left} ) {
951 34   100     116 push @{ $self->{_header_images} }, [ $options->{image_left}, 'LH' ];
952             }
953              
954             if ( $options->{image_center} ) {
955 34         83 push @{ $self->{_header_images} }, [ $options->{image_center}, 'CH' ];
956             }
957 34 50       156  
958 0         0 if ( $options->{image_right} ) {
959             push @{ $self->{_header_images} }, [ $options->{image_right}, 'RH' ];
960 0         0 }
961              
962             my $placeholder_count = () = $string =~ /&G/g;
963 34 100       249 my $image_count = @{ $self->{_header_images} };
964 1         6  
965             if ( $image_count != $placeholder_count ) {
966             warn "Number of header images ($image_count) doesn't match placeholder "
967 34 100       110 . "count ($placeholder_count) in string: $string\n";
968 1         6 $self->{_header_images} = [];
969             return;
970             }
971              
972 34         130 if ( $image_count ) {
973             $self->{_has_header_vml} = 1;
974 34 100       102 }
975 21         242  
  21         91  
976             $self->{_header} = $string;
977             $self->{_margin_header} = $margin;
978 34 100       122 $self->{_header_footer_changed} = 1;
979 8         14 }
  8         38  
980              
981              
982 34 100       109 ###############################################################################
983 5         8 #
  5         14  
984             # set_footer()
985             #
986 34         287 # Set the page footer caption and optional margin.
987 34         96 #
  34         92  
988              
989 34 50       121 my $self = shift;
990 0         0 my $string = $_[0] || '';
991             my $margin = $_[1] || 0.3;
992 0         0 my $options = $_[2] || {};
993 0         0  
994              
995             # Replace the Excel placeholder &[Picture] with the internal &G.
996 34 100       196 $string =~ s/&\[Picture\]/&G/g;
997 23         54  
998             if ( length $string > 255 ) {
999             carp "Footer string cannot be longer than Excel's " .
1000 34         71 "limit of 255 characters";
1001 34         64 return;
1002 34         101 }
1003              
1004             if ( defined $options->{align_with_margins} ) {
1005             $self->{_header_footer_aligns} = $options->{align_with_margins};
1006             }
1007              
1008             if ( defined $options->{scale_with_doc} ) {
1009             $self->{_header_footer_scales} = $options->{scale_with_doc};
1010             }
1011              
1012             # Reset the array in case the function is called more than once.
1013             $self->{_footer_images} = [];
1014 15     15 0 146  
1015 15   100     55 if ( $options->{image_left} ) {
1016 15   100     62 push @{ $self->{_footer_images} }, [ $options->{image_left}, 'LF' ];
1017 15   100     52 }
1018              
1019             if ( $options->{image_center} ) {
1020             push @{ $self->{_footer_images} }, [ $options->{image_center}, 'CF' ];
1021 15         32 }
1022              
1023 15 50       47 if ( $options->{image_right} ) {
1024 0         0 push @{ $self->{_footer_images} }, [ $options->{image_right}, 'RF' ];
1025             }
1026 0         0  
1027             my $placeholder_count = () = $string =~ /&G/g;
1028             my $image_count = @{ $self->{_footer_images} };
1029 15 100       42  
1030 1         6 if ( $image_count != $placeholder_count ) {
1031             warn "Number of footer images ($image_count) doesn't match placeholder "
1032             . "count ($placeholder_count) in string: $string\n";
1033 15 100       44 $self->{_footer_images} = [];
1034 1         2 return;
1035             }
1036              
1037             if ( $image_count ) {
1038 15         36 $self->{_has_header_vml} = 1;
1039             }
1040 15 100       44  
1041 4         15 $self->{_footer} = $string;
  4         22  
1042             $self->{_margin_footer} = $margin;
1043             $self->{_header_footer_changed} = 1;
1044 15 100       38 }
1045 3         6  
  3         9  
1046              
1047             ###############################################################################
1048 15 100       69 #
1049 5         7 # center_horizontally()
  5         16  
1050             #
1051             # Center the page horizontally.
1052 15         69 #
1053 15         23  
  15         31  
1054             my $self = shift;
1055 15 50       58  
1056 0         0 $self->{_print_options_changed} = 1;
1057             $self->{_hcenter} = 1;
1058 0         0 }
1059 0         0  
1060              
1061             ###############################################################################
1062 15 100       46 #
1063 6         15 # center_vertically()
1064             #
1065             # Center the page horizontally.
1066 15         109 #
1067 15         82  
1068 15         44 my $self = shift;
1069              
1070             $self->{_print_options_changed} = 1;
1071             $self->{_vcenter} = 1;
1072             }
1073              
1074              
1075             ###############################################################################
1076             #
1077             # set_margins()
1078             #
1079             # Set all the page margins to the same value in inches.
1080 4     4 0 54 #
1081              
1082 4         11 my $self = shift;
1083 4         10  
1084             $self->set_margin_left( $_[0] );
1085             $self->set_margin_right( $_[0] );
1086             $self->set_margin_top( $_[0] );
1087             $self->set_margin_bottom( $_[0] );
1088             }
1089              
1090              
1091             ###############################################################################
1092             #
1093             # set_margins_LR()
1094             #
1095 4     4 0 29 # Set the left and right margins to the same value in inches.
1096             #
1097 4         14  
1098 4         8 my $self = shift;
1099              
1100             $self->set_margin_left( $_[0] );
1101             $self->set_margin_right( $_[0] );
1102             }
1103              
1104              
1105             ###############################################################################
1106             #
1107             # set_margins_TB()
1108             #
1109             # Set the top and bottom margins to the same value in inches.
1110 2     2 0 44 #
1111              
1112 2         7 my $self = shift;
1113 2         6  
1114 2         6 $self->set_margin_top( $_[0] );
1115 2         6 $self->set_margin_bottom( $_[0] );
1116             }
1117              
1118              
1119             ###############################################################################
1120             #
1121             # set_margin_left()
1122             #
1123             # Set the left margin in inches.
1124             #
1125              
1126             my $self = shift;
1127 1     1 0 18 my $margin = shift;
1128             my $default = 0.7;
1129 1         4  
1130 1         3 # Add 0 to ensure the argument is numeric.
1131             if ( defined $margin ) { $margin = 0 + $margin }
1132             else { $margin = $default }
1133              
1134             $self->{_margin_left} = $margin;
1135             }
1136              
1137              
1138             ###############################################################################
1139             #
1140             # set_margin_right()
1141             #
1142 1     1 0 19 # Set the right margin in inches.
1143             #
1144 1         4  
1145 1         3 my $self = shift;
1146             my $margin = shift;
1147             my $default = 0.7;
1148              
1149             # Add 0 to ensure the argument is numeric.
1150             if ( defined $margin ) { $margin = 0 + $margin }
1151             else { $margin = $default }
1152              
1153             $self->{_margin_right} = $margin;
1154             }
1155              
1156              
1157 5     5 0 28 ###############################################################################
1158 5         11 #
1159 5         6 # set_margin_top()
1160             #
1161             # Set the top margin in inches.
1162 5 50       13 #
  5         17  
1163 0         0  
1164             my $self = shift;
1165 5         13 my $margin = shift;
1166             my $default = 0.75;
1167              
1168             # Add 0 to ensure the argument is numeric.
1169             if ( defined $margin ) { $margin = 0 + $margin }
1170             else { $margin = $default }
1171              
1172             $self->{_margin_top} = $margin;
1173             }
1174              
1175              
1176             ###############################################################################
1177 5     5 0 29 #
1178 5         7 # set_margin_bottom()
1179 5         8 #
1180             # Set the bottom margin in inches.
1181             #
1182 5 50       8  
  5         11  
1183 0         0  
1184             my $self = shift;
1185 5         9 my $margin = shift;
1186             my $default = 0.75;
1187              
1188             # Add 0 to ensure the argument is numeric.
1189             if ( defined $margin ) { $margin = 0 + $margin }
1190             else { $margin = $default }
1191              
1192             $self->{_margin_bottom} = $margin;
1193             }
1194              
1195              
1196             ###############################################################################
1197 5     5 0 30 #
1198 5         8 # repeat_rows($first_row, $last_row)
1199 5         8 #
1200             # Set the rows to repeat at the top of each printed page.
1201             #
1202 5 50       9  
  5         10  
1203 0         0 my $self = shift;
1204              
1205 5         9 my $row_min = $_[0];
1206             my $row_max = $_[1] || $_[0]; # Second row is optional
1207              
1208              
1209             # Convert to 1 based.
1210             $row_min++;
1211             $row_max++;
1212              
1213             my $area = '$' . $row_min . ':' . '$' . $row_max;
1214              
1215             # Build up the print titles "Sheet1!$1:$2"
1216             my $sheetname = quote_sheetname( $self->{_name} );
1217             $area = $sheetname . "!" . $area;
1218 5     5 0 23  
1219 5         8 $self->{_repeat_rows} = $area;
1220 5         7 }
1221              
1222              
1223 5 50       16 ###############################################################################
  5         18  
1224 0         0 #
1225             # repeat_columns($first_col, $last_col)
1226 5         14 #
1227             # Set the columns to repeat at the left hand side of each printed page. This is
1228             # stored as a <NamedRange> element.
1229             #
1230              
1231             my $self = shift;
1232              
1233             # Check for a cell reference in A1 notation and substitute row and column
1234             if ( $_[0] =~ /^\D/ ) {
1235             @_ = $self->_substitute_cellref( @_ );
1236              
1237             # Returned values $row1 and $row2 aren't required here. Remove them.
1238 6     6 0 36 shift @_; # $row1
1239             splice @_, 1, 1; # $row2
1240 6         13 }
1241 6   66     27  
1242             my $col_min = $_[0];
1243             my $col_max = $_[1] || $_[0]; # Second col is optional
1244              
1245 6         16 # Convert to A notation.
1246 6         8 $col_min = xl_col_to_name( $_[0], 1 );
1247             $col_max = xl_col_to_name( $_[1], 1 );
1248 6         21  
1249             my $area = $col_min . ':' . $col_max;
1250              
1251 6         34 # Build up the print area range "=Sheet2!C1:C2"
1252 6         19 my $sheetname = quote_sheetname( $self->{_name} );
1253             $area = $sheetname . "!" . $area;
1254 6         12  
1255             $self->{_repeat_cols} = $area;
1256             }
1257              
1258              
1259             ###############################################################################
1260             #
1261             # print_area($first_row, $first_col, $last_row, $last_col)
1262             #
1263             # Set the print area in the current worksheet. This is stored as a <NamedRange>
1264             # element.
1265             #
1266              
1267 3     3 0 14 my $self = shift;
1268              
1269             # Check for a cell reference in A1 notation and substitute row and column
1270 3 50       14 if ( $_[0] =~ /^\D/ ) {
1271 3         12 @_ = $self->_substitute_cellref( @_ );
1272             }
1273              
1274 3         8 return if @_ != 4; # Require 4 parameters
1275 3         8  
1276             my ( $row1, $col1, $row2, $col2 ) = @_;
1277              
1278 3         6 # Ignore max print area since this is the same as no print area for Excel.
1279 3   66     13 if ( $row1 == 0
1280             and $col1 == 0
1281             and $row2 == $self->{_xls_rowmax} - 1
1282 3         14 and $col2 == $self->{_xls_colmax} - 1 )
1283 3         9 {
1284             return;
1285 3         9 }
1286              
1287             # Build up the print area range "=Sheet2!R1C1:R2C1"
1288 3         70 my $area = $self->_convert_name_area( $row1, $col1, $row2, $col2 );
1289 3         79  
1290             $self->{_print_area} = $area;
1291 3         14 }
1292              
1293              
1294             ###############################################################################
1295             #
1296             # autofilter($first_row, $first_col, $last_row, $last_col)
1297             #
1298             # Set the autofilter area in the worksheet.
1299             #
1300              
1301             my $self = shift;
1302              
1303             # Check for a cell reference in A1 notation and substitute row and column
1304 9     9 0 64 if ( $_[0] =~ /^\D/ ) {
1305             @_ = $self->_substitute_cellref( @_ );
1306             }
1307 9 50       52  
1308 9         42 return if @_ != 4; # Require 4 parameters
1309              
1310             my ( $row1, $col1, $row2, $col2 ) = @_;
1311 9 50       33  
1312             # Reverse max and min values if necessary.
1313 9         26 ( $row1, $row2 ) = ( $row2, $row1 ) if $row2 < $row1;
1314             ( $col1, $col2 ) = ( $col2, $col1 ) if $col2 < $col1;
1315              
1316 9 100 33     144 # Build up the print area range "Sheet1!$A$1:$C$13".
      66        
      100        
1317             my $area = $self->_convert_name_area( $row1, $col1, $row2, $col2 );
1318             my $ref = xl_range( $row1, $row2, $col1, $col2 );
1319              
1320             $self->{_autofilter} = $area;
1321 1         3 $self->{_autofilter_ref} = $ref;
1322             $self->{_filter_range} = [ $col1, $col2 ];
1323             }
1324              
1325 8         38  
1326             ###############################################################################
1327 8         27 #
1328             # filter_column($column, $criteria, ...)
1329             #
1330             # Set the column filter criteria.
1331             #
1332              
1333             my $self = shift;
1334             my $col = $_[0];
1335             my $expression = $_[1];
1336              
1337             croak "Must call autofilter() before filter_column()"
1338             unless $self->{_autofilter};
1339 32     32 0 584 croak "Incorrect number of arguments to filter_column()"
1340             unless @_ == 2;
1341              
1342 32 100       128  
1343 30         79 # Check for a column reference in A1 notation and substitute.
1344             if ( $col =~ /^\D/ ) {
1345             my $col_letter = $col;
1346 32 50       79  
1347             # Convert col ref to a cell ref and then to a col number.
1348 32         63 ( undef, $col ) = $self->_substitute_cellref( $col . '1' );
1349              
1350             croak "Invalid column '$col_letter'" if $col >= $self->{_xls_colmax};
1351 32 50       67 }
1352 32 50       65  
1353             my ( $col_first, $col_last ) = @{ $self->{_filter_range} };
1354              
1355 32         87 # Reject column if it is outside filter range.
1356 32         82 if ( $col < $col_first or $col > $col_last ) {
1357             croak "Column '$col' outside autofilter() column range "
1358 32         62 . "($col_first .. $col_last)";
1359 32         56 }
1360 32         112  
1361              
1362             my @tokens = $self->_extract_filter_tokens( $expression );
1363              
1364             croak "Incorrect number of tokens in expression '$expression'"
1365             unless ( @tokens == 3 or @tokens == 7 );
1366              
1367              
1368             @tokens = $self->_parse_filter_expression( $expression, @tokens );
1369              
1370             # Excel handles single or double custom filters as default filters. We need
1371             # to check for them and handle them accordingly.
1372 25     25 0 100 if ( @tokens == 2 && $tokens[0] == 2 ) {
1373 25         40  
1374 25         32 # Single equality.
1375             $self->filter_column_list( $col, $tokens[1] );
1376             }
1377 25 50       57 elsif (@tokens == 5
1378 25 50       64 && $tokens[0] == 2
1379             && $tokens[2] == 1
1380             && $tokens[3] == 2 )
1381             {
1382              
1383 25 100       81 # Double equality with "or" operator.
1384 24         36 $self->filter_column_list( $col, $tokens[1], $tokens[4] );
1385             }
1386             else {
1387 24         66  
1388             # Non default custom filter.
1389 24 50       69 $self->{_filter_cols}->{$col} = [@tokens];
1390             $self->{_filter_type}->{$col} = 0;
1391              
1392 25         38 }
  25         50  
1393              
1394             $self->{_filter_on} = 1;
1395 25 50 33     1053 }
1396 0         0  
1397              
1398             ###############################################################################
1399             #
1400             # filter_column_list($column, @matches )
1401 25         63 #
1402             # Set the column filter criteria in Excel 2007 list style.
1403 25 50 66     85 #
1404              
1405             my $self = shift;
1406             my $col = shift;
1407 25         66 my @tokens = @_;
1408              
1409             croak "Must call autofilter() before filter_column_list()"
1410             unless $self->{_autofilter};
1411 25 100 100     140 croak "Incorrect number of arguments to filter_column_list()"
    100 100        
      100        
      66        
1412             unless @tokens;
1413              
1414 6         34 # Check for a column reference in A1 notation and substitute.
1415             if ( $col =~ /^\D/ ) {
1416             my $col_letter = $col;
1417              
1418             # Convert col ref to a cell ref and then to a col number.
1419             ( undef, $col ) = $self->_substitute_cellref( $col . '1' );
1420              
1421             croak "Invalid column '$col_letter'" if $col >= $self->{_xls_colmax};
1422             }
1423 3         12  
1424             my ( $col_first, $col_last ) = @{ $self->{_filter_range} };
1425              
1426             # Reject column if it is outside filter range.
1427             if ( $col < $col_first or $col > $col_last ) {
1428 16         42 croak "Column '$col' outside autofilter() column range "
1429 16         33 . "($col_first .. $col_last)";
1430             }
1431              
1432             $self->{_filter_cols}->{$col} = [@tokens];
1433 25         65 $self->{_filter_type}->{$col} = 1; # Default style.
1434             $self->{_filter_on} = 1;
1435             }
1436              
1437              
1438             ###############################################################################
1439             #
1440             # _extract_filter_tokens($expression)
1441             #
1442             # Extract the tokens from the filter expression. The tokens are mainly non-
1443             # whitespace groups. The only tricky part is to extract string tokens that
1444             # contain whitespace and/or quoted double quotes (Excel's escaped quotes).
1445 14     14 0 39 #
1446 14         21 # Examples: 'x < 2000'
1447 14         32 # 'x > 2000 and x < 5000'
1448             # 'x = "foo"'
1449             # 'x = "foo bar"'
1450 14 50       50 # 'x = "foo "" bar"'
1451 14 50       43 #
1452              
1453             my $self = shift;
1454             my $expression = $_[0];
1455 14 100       50  
1456 5         8 return unless $expression;
1457              
1458             my @tokens = ( $expression =~ /"(?:[^"]|"")*"|\S+/g ); #"
1459 5         17  
1460             # Remove leading and trailing quotes and unescape other quotes
1461 5 50       15 for ( @tokens ) {
1462             s/^"//; #"
1463             s/"$//; #"
1464 14         23 s/""/"/g; #"
  14         41  
1465             }
1466              
1467 14 50 33     60 return @tokens;
1468 0         0 }
1469              
1470              
1471             ###############################################################################
1472 14         38 #
1473 14         36 # _parse_filter_expression(@token)
1474 14         30 #
1475             # Converts the tokens of a possibly conditional expression into 1 or 2
1476             # sub expressions for further parsing.
1477             #
1478             # Examples:
1479             # ('x', '==', 2000) -> exp1
1480             # ('x', '>', 2000, 'and', 'x', '<', 5000) -> exp1 and exp2
1481             #
1482              
1483             my $self = shift;
1484             my $expression = shift;
1485             my @tokens = @_;
1486              
1487             # The number of tokens will be either 3 (for 1 expression)
1488             # or 7 (for 2 expressions).
1489             #
1490             if ( @tokens == 7 ) {
1491              
1492             my $conditional = $tokens[3];
1493              
1494 67     67   21988 if ( $conditional =~ /^(and|&&)$/ ) {
1495 67         104 $conditional = 0;
1496             }
1497 67 100       172 elsif ( $conditional =~ /^(or|\|\|)$/ ) {
1498             $conditional = 1;
1499 65         418 }
1500             else {
1501             croak "Token '$conditional' is not a valid conditional "
1502 65         129 . "in filter expression '$expression'";
1503 247         336 }
1504 247         302  
1505 247         324 my @expression_1 =
1506             $self->_parse_filter_tokens( $expression, @tokens[ 0, 1, 2 ] );
1507             my @expression_2 =
1508 65         196 $self->_parse_filter_tokens( $expression, @tokens[ 4, 5, 6 ] );
1509              
1510             return ( @expression_1, $conditional, @expression_2 );
1511             }
1512             else {
1513             return $self->_parse_filter_tokens( $expression, @tokens );
1514             }
1515             }
1516              
1517              
1518             ###############################################################################
1519             #
1520             # _parse_filter_tokens(@token)
1521             #
1522             # Parse the 3 tokens of a filter expression and return the operator and token.
1523             #
1524              
1525 49     49   109 my $self = shift;
1526 49         64 my $expression = shift;
1527 49         127 my @tokens = @_;
1528              
1529             my %operators = (
1530             '==' => 2,
1531             '=' => 2,
1532 49 100       99 '=~' => 2,
1533             'eq' => 2,
1534 10         19  
1535             '!=' => 5,
1536 10 100       67 '!~' => 5,
    50          
1537 5         9 'ne' => 5,
1538             '<>' => 5,
1539              
1540 5         8 '<' => 1,
1541             '<=' => 3,
1542             '>' => 4,
1543 0         0 '>=' => 6,
1544             );
1545              
1546             my $operator = $operators{ $tokens[1] };
1547 10         36 my $token = $tokens[2];
1548              
1549 10         30  
1550             # Special handling of "Top" filter expressions.
1551             if ( $tokens[0] =~ /^top|bottom$/i ) {
1552 10         40  
1553             my $value = $tokens[1];
1554              
1555 39         87 if ( $value =~ /\D/
1556             or $value < 1
1557             or $value > 500 )
1558             {
1559             croak "The value '$value' in expression '$expression' "
1560             . "must be in the range 1 to 500";
1561             }
1562              
1563             $token = lc $token;
1564              
1565             if ( $token ne 'items' and $token ne '%' ) {
1566             croak "The type '$token' in expression '$expression' "
1567             . "must be either 'items' or '%'";
1568 59     59   81 }
1569 59         74  
1570 59         121 if ( $tokens[0] =~ /^top$/i ) {
1571             $operator = 30;
1572 59         304 }
1573             else {
1574             $operator = 32;
1575             }
1576              
1577             if ( $tokens[2] eq '%' ) {
1578             $operator++;
1579             }
1580              
1581             $token = $value;
1582             }
1583              
1584              
1585             if ( not $operator and $tokens[0] ) {
1586             croak "Token '$tokens[1]' is not a valid operator "
1587             . "in filter expression '$expression'";
1588             }
1589 59         109  
1590 59         89  
1591             # Special handling for Blanks/NonBlanks.
1592             if ( $token =~ /^blanks|nonblanks$/i ) {
1593              
1594 59 100       129 # Only allow Equals or NotEqual in this context.
1595             if ( $operator != 2 and $operator != 5 ) {
1596 4         5 croak "The operator '$tokens[1]' in expression '$expression' "
1597             . "is not valid in relation to Blanks/NonBlanks'";
1598 4 50 33     27 }
      33        
1599              
1600             $token = lc $token;
1601              
1602 0         0 # The operator should always be 2 (=) to flag a "simple" equality in
1603             # the binary record. Therefore we convert <> to =.
1604             if ( $token eq 'blanks' ) {
1605             if ( $operator == 5 ) {
1606 4         8 $token = ' ';
1607             }
1608 4 50 66     15 }
1609 0         0 else {
1610             if ( $operator == 5 ) {
1611             $operator = 2;
1612             $token = 'blanks';
1613 4 100       11 }
1614 2         3 else {
1615             $operator = 5;
1616             $token = ' ';
1617 2         4 }
1618             }
1619             }
1620 4 100       9  
1621 2         3  
1622             # if the string token contains an Excel match character then change the
1623             # operator type to indicate a non "simple" equality.
1624 4         6 if ( $operator == 2 and $token =~ /[*?]/ ) {
1625             $operator = 22;
1626             }
1627              
1628 59 0 33     110  
1629 0         0 return ( $operator, $token );
1630             }
1631              
1632              
1633             ###############################################################################
1634             #
1635 59 100       120 # _convert_name_area($first_row, $first_col, $last_row, $last_col)
1636             #
1637             # Convert zero indexed rows and columns to the format required by worksheet
1638 7 50 66     25 # named ranges, eg, "Sheet1!$A$1:$C$13".
1639 0         0 #
1640              
1641             my $self = shift;
1642              
1643 7         15 my $row_num_1 = $_[0];
1644             my $col_num_1 = $_[1];
1645             my $row_num_2 = $_[2];
1646             my $col_num_2 = $_[3];
1647 7 100       18  
1648 4 100       10 my $range1 = '';
1649 1         2 my $range2 = '';
1650             my $row_col_only = 0;
1651             my $area;
1652              
1653 3 100       7 # Convert to A1 notation.
1654 1         2 my $col_char_1 = xl_col_to_name( $col_num_1, 1 );
1655 1         3 my $col_char_2 = xl_col_to_name( $col_num_2, 1 );
1656             my $row_char_1 = '$' . ( $row_num_1 + 1 );
1657             my $row_char_2 = '$' . ( $row_num_2 + 1 );
1658 2         4  
1659 2         2 # We need to handle some special cases that refer to rows or columns only.
1660             if ( $row_num_1 == 0 and $row_num_2 == $self->{_xls_rowmax} - 1 ) {
1661             $range1 = $col_char_1;
1662             $range2 = $col_char_2;
1663             $row_col_only = 1;
1664             }
1665             elsif ( $col_num_1 == 0 and $col_num_2 == $self->{_xls_colmax} - 1 ) {
1666             $range1 = $row_char_1;
1667 59 100 100     172 $range2 = $row_char_2;
1668 3         5 $row_col_only = 1;
1669             }
1670             else {
1671             $range1 = $col_char_1 . $row_char_1;
1672 59         285 $range2 = $col_char_2 . $row_char_2;
1673             }
1674              
1675             # A repeated range is only written once (if it isn't a special case).
1676             if ( $range1 eq $range2 && !$row_col_only ) {
1677             $area = $range1;
1678             }
1679             else {
1680             $area = $range1 . ':' . $range2;
1681             }
1682              
1683             # Build up the print area range "Sheet1!$A$1:$C$13".
1684             my $sheetname = quote_sheetname( $self->{_name} );
1685 40     40   64 $area = $sheetname . "!" . $area;
1686              
1687 40         60 return $area;
1688 40         54 }
1689 40         60  
1690 40         75  
1691             ###############################################################################
1692 40         75 #
1693 40         71 # hide_gridlines()
1694 40         51 #
1695 40         55 # Set the option to hide gridlines on the screen and the printed page.
1696             #
1697             # This was mainly useful for Excel 5 where printed gridlines were on by
1698 40         144 # default.
1699 40         107 #
1700 40         110  
1701 40         85 my $self = shift;
1702             my $option =
1703             defined $_[0] ? $_[0] : 1; # Default to hiding printed gridlines
1704 40 100 100     295  
    100 100        
1705 1         2 if ( $option == 0 ) {
1706 1         2 $self->{_print_gridlines} = 1; # 1 = display, 0 = hide
1707 1         2 $self->{_screen_gridlines} = 1;
1708             $self->{_print_options_changed} = 1;
1709             }
1710 1         2 elsif ( $option == 1 ) {
1711 1         2 $self->{_print_gridlines} = 0;
1712 1         2 $self->{_screen_gridlines} = 1;
1713             }
1714             else {
1715 38         162 $self->{_print_gridlines} = 0;
1716 38         118 $self->{_screen_gridlines} = 0;
1717             }
1718             }
1719              
1720 40 100 100     329  
1721 1         73 ###############################################################################
1722             #
1723             # print_row_col_headers()
1724 39         517 #
1725             # Set the option to print the row and column headers on the printed page.
1726             # See also the _store_print_headers() method below.
1727             #
1728 40         380  
1729 40         94 my $self = shift;
1730             my $headers = defined $_[0] ? $_[0] : 1;
1731 40         83  
1732             if ( $headers ) {
1733             $self->{_print_headers} = 1;
1734             $self->{_print_options_changed} = 1;
1735             }
1736             else {
1737             $self->{_print_headers} = 0;
1738             }
1739             }
1740              
1741              
1742             ###############################################################################
1743             #
1744             # hide_row_col_headers()
1745             #
1746 12     12 0 106 # Set the option to hide the row and column headers in Excel.
1747 12 100       34 #
1748              
1749             my $self = shift;
1750 12 100       44 $self->{_hide_row_col_headers} = 1;
    100          
1751 5         18 }
1752 5         12  
1753 5         11  
1754             ###############################################################################
1755             #
1756 4         6 # fit_to_pages($width, $height)
1757 4         10 #
1758             # Store the vertical and horizontal number of pages that will define the
1759             # maximum area printed.
1760 3         16 #
1761 3         8  
1762             my $self = shift;
1763              
1764             $self->{_fit_page} = 1;
1765             $self->{_fit_width} = defined $_[0] ? $_[0] : 1;
1766             $self->{_fit_height} = defined $_[1] ? $_[1] : 1;
1767             $self->{_page_setup_changed} = 1;
1768             }
1769              
1770              
1771             ###############################################################################
1772             #
1773             # set_h_pagebreaks(@breaks)
1774             #
1775 2     2 0 11 # Store the horizontal page breaks on a worksheet.
1776 2 50       12 #
1777              
1778 2 50       7 my $self = shift;
1779 2         8  
1780 2         16 push @{ $self->{_hbreaks} }, @_;
1781             }
1782              
1783 0         0  
1784             ###############################################################################
1785             #
1786             # set_v_pagebreaks(@breaks)
1787             #
1788             # Store the vertical page breaks on a worksheet.
1789             #
1790              
1791             my $self = shift;
1792              
1793             push @{ $self->{_vbreaks} }, @_;
1794             }
1795              
1796 1     1 0 6  
1797 1         3 ###############################################################################
1798             #
1799             # set_zoom( $scale )
1800             #
1801             # Set the worksheet zoom factor.
1802             #
1803              
1804             my $self = shift;
1805             my $scale = $_[0] || 100;
1806              
1807             # Confine the scale to Excel's range
1808             if ( $scale < 10 or $scale > 400 ) {
1809             carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
1810 6     6 0 36 $scale = 100;
1811             }
1812 6         33  
1813 6 100       20 $self->{_zoom} = int $scale;
1814 6 100       33 }
1815 6         17  
1816              
1817             ###############################################################################
1818             #
1819             # set_print_scale($scale)
1820             #
1821             # Set the scale factor for the printed page.
1822             #
1823              
1824             my $self = shift;
1825             my $scale = $_[0] || 100;
1826              
1827 4     4 0 56 # Confine the scale to Excel's range
1828             if ( $scale < 10 or $scale > 400 ) {
1829 4         7 carp "Print scale $scale outside range: 10 <= zoom <= 400";
  4         66  
1830             $scale = 100;
1831             }
1832              
1833             # Turn off "fit to page" option.
1834             $self->{_fit_page} = 0;
1835              
1836             $self->{_print_scale} = int $scale;
1837             $self->{_page_setup_changed} = 1;
1838             }
1839              
1840              
1841 3     3 0 16 ###############################################################################
1842             #
1843 3         4 # print_black_and_white()
  3         17  
1844             #
1845             # Set the option to print the worksheet in black and white.
1846             #
1847              
1848             my $self = shift;
1849              
1850             $self->{_black_white} = 1;
1851             }
1852              
1853              
1854             ###############################################################################
1855 3     3 0 18 #
1856 3   50     9 # keep_leading_zeros()
1857             #
1858             # Causes the write() method to treat integers with a leading zero as a string.
1859 3 50 33     15 # This ensures that any leading zeros such, as in zip codes, are maintained.
1860 0         0 #
1861 0         0  
1862             my $self = shift;
1863              
1864 3         8 if ( defined $_[0] ) {
1865             $self->{_leading_zeros} = $_[0];
1866             }
1867             else {
1868             $self->{_leading_zeros} = 1;
1869             }
1870             }
1871              
1872              
1873             ###############################################################################
1874             #
1875             # show_comments()
1876 3     3 0 14 #
1877 3   50     8 # Make any comments in the worksheet visible.
1878             #
1879              
1880 3 50 33     26 my $self = shift;
1881 0         0  
1882 0         0 $self->{_comments_visible} = defined $_[0] ? $_[0] : 1;
1883             }
1884              
1885              
1886 3         20 ###############################################################################
1887             #
1888 3         13 # set_comments_author()
1889 3         7 #
1890             # Set the default author of the cell comments.
1891             #
1892              
1893             my $self = shift;
1894              
1895             $self->{_comments_author} = $_[0] if defined $_[0];
1896             }
1897              
1898              
1899             ###############################################################################
1900             #
1901 1     1 0 7 # right_to_left()
1902             #
1903 1         2 # Display the worksheet right to left for some eastern versions of Excel.
1904             #
1905              
1906             my $self = shift;
1907              
1908             $self->{_right_to_left} = defined $_[0] ? $_[0] : 1;
1909             }
1910              
1911              
1912             ###############################################################################
1913             #
1914             # hide_zero()
1915             #
1916 0     0 0 0 # Hide cell zero values.
1917             #
1918 0 0       0  
1919 0         0 my $self = shift;
1920              
1921             $self->{_show_zeros} = defined $_[0] ? not $_[0] : 0;
1922 0         0 }
1923              
1924              
1925             ###############################################################################
1926             #
1927             # print_across()
1928             #
1929             # Set the order in which pages are printed.
1930             #
1931              
1932             my $self = shift;
1933             my $page_order = defined $_[0] ? $_[0] : 1;
1934              
1935 2     2 0 10 if ( $page_order ) {
1936             $self->{_page_order} = 1;
1937 2 50       8 $self->{_page_setup_changed} = 1;
1938             }
1939             else {
1940             $self->{_page_order} = 0;
1941             }
1942             }
1943              
1944              
1945             ###############################################################################
1946             #
1947             # set_start_page()
1948             #
1949 44     44 0 508 # Set the start page number.
1950             #
1951 44 50       288  
1952             my $self = shift;
1953             return unless defined $_[0];
1954              
1955             $self->{_page_start} = $_[0];
1956             }
1957              
1958              
1959             ###############################################################################
1960             #
1961             # set_first_row_column()
1962             #
1963 1     1 0 5 # Set the topmost and leftmost visible row and column.
1964             # TODO: Document this when tested fully for interaction with panes.
1965 1 50       5 #
1966              
1967             my $self = shift;
1968              
1969             my $row = $_[0] || 0;
1970             my $col = $_[1] || 0;
1971              
1972             $row = $self->{_xls_rowmax} if $row > $self->{_xls_rowmax};
1973             $col = $self->{_xls_colmax} if $col > $self->{_xls_colmax};
1974              
1975             $self->{_first_row} = $row;
1976             $self->{_first_col} = $col;
1977 1     1 0 5 }
1978              
1979 1 50       5  
1980             ###############################################################################
1981             #
1982             # add_write_handler($re, $code_ref)
1983             #
1984             # Allow the user to add their own matches and handlers to the write() method.
1985             #
1986              
1987             my $self = shift;
1988              
1989             return unless @_ == 2;
1990             return unless ref $_[1] eq 'CODE';
1991 2     2 0 23  
1992 2 50       6 push @{ $self->{_write_match} }, [@_];
1993             }
1994 2 50       6  
1995 2         8  
1996 2         6 ###############################################################################
1997             #
1998             # write($row, $col, $token, $format)
1999 0         0 #
2000             # Parse $token and call appropriate write method. $row and $column are zero
2001             # indexed. $format is optional.
2002             #
2003             # Returns: return value of called subroutine
2004             #
2005              
2006             my $self = shift;
2007              
2008             # Check for a cell reference in A1 notation and substitute row and column
2009             if ( $_[0] =~ /^\D/ ) {
2010             @_ = $self->_substitute_cellref( @_ );
2011             }
2012 3     3 0 21  
2013 3 50       10 my $token = $_[2];
2014              
2015 3         20 # Handle undefs as blanks
2016             $token = '' unless defined $token;
2017              
2018              
2019             # First try user defined matches.
2020             for my $aref ( @{ $self->{_write_match} } ) {
2021             my $re = $aref->[0];
2022             my $sub = $aref->[1];
2023              
2024             if ( $token =~ /$re/ ) {
2025             my $match = &$sub( $self, @_ );
2026             return $match if defined $match;
2027             }
2028 0     0 0 0 }
2029              
2030 0   0     0  
2031 0   0     0 # Match an array ref.
2032             if ( ref $token eq "ARRAY" ) {
2033 0 0       0 return $self->write_row( @_ );
2034 0 0       0 }
2035              
2036 0         0 # Match integer with leading zero(s)
2037 0         0 elsif ( $self->{_leading_zeros} and $token =~ /^0\d+$/ ) {
2038             return $self->write_string( @_ );
2039             }
2040              
2041             # Match number
2042             elsif ( $token =~ /^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/ ) {
2043             return $self->write_number( @_ );
2044             }
2045              
2046             # Match http, https or ftp URL
2047             elsif ( $token =~ m|^[fh]tt?ps?://| ) {
2048             return $self->write_url( @_ );
2049 0     0 0 0 }
2050              
2051 0 0       0 # Match mailto:
2052 0 0       0 elsif ( $token =~ m/^mailto:/ ) {
2053             return $self->write_url( @_ );
2054 0         0 }
  0         0  
2055              
2056             # Match internal or external sheet link
2057             elsif ( $token =~ m[^(?:in|ex)ternal:] ) {
2058             return $self->write_url( @_ );
2059             }
2060              
2061             # Match formula
2062             elsif ( $token =~ /^=/ ) {
2063             return $self->write_formula( @_ );
2064             }
2065              
2066             # Match array formula
2067             elsif ( $token =~ /^{=.*}$/ ) {
2068             return $self->write_formula( @_ );
2069 10988     10988 0 22055 }
2070              
2071             # Match blank
2072 10988 100       25721 elsif ( $token eq '' ) {
2073 1112         3903 splice @_, 2, 1; # remove the empty string from the parameter list
2074             return $self->write_blank( @_ );
2075             }
2076 10988         13210  
2077             # Default: match string
2078             else {
2079 10988 100       16302 return $self->write_string( @_ );
2080             }
2081             }
2082              
2083 10988         12005  
  10988         19764  
2084 0         0 ###############################################################################
2085 0         0 #
2086             # write_row($row, $col, $array_ref, $format)
2087 0 0       0 #
2088 0         0 # Write a row of data starting from ($row, $col). Call write_col() if any of
2089 0 0       0 # the elements of the array ref are in turn array refs. This allows the writing
2090             # of 1D or 2D arrays of data in one go.
2091             #
2092             # Returns: the first encountered error value or zero for no errors
2093             #
2094              
2095 10988 100 33     54545 my $self = shift;
    50          
    100          
    100          
    50          
    50          
    100          
    100          
    100          
2096 1044         2819  
2097              
2098             # Check for a cell reference in A1 notation and substitute row and column
2099             if ( $_[0] =~ /^\D/ ) {
2100             @_ = $self->_substitute_cellref( @_ );
2101 0         0 }
2102              
2103             # Catch non array refs passed by user.
2104             if ( ref $_[2] ne 'ARRAY' ) {
2105             croak "Not an array ref in call to write_row()$!";
2106 7736         14636 }
2107              
2108             my $row = shift;
2109             my $col = shift;
2110             my $tokens = shift;
2111 14         60 my @options = @_;
2112             my $error = 0;
2113             my $ret;
2114              
2115             for my $token ( @$tokens ) {
2116 0         0  
2117             # Check for nested arrays
2118             if ( ref $token eq "ARRAY" ) {
2119             $ret = $self->write_col( $row, $col, $token, @options );
2120             }
2121 0         0 else {
2122             $ret = $self->write( $row, $col, $token, @options );
2123             }
2124              
2125             # Return only the first error encountered, if any.
2126 21         75 $error ||= $ret;
2127             $col++;
2128             }
2129              
2130             return $error;
2131 2         12 }
2132              
2133              
2134             ###############################################################################
2135             #
2136 31         66 # write_col($row, $col, $array_ref, $format)
2137 31         119 #
2138             # Write a column of data starting from ($row, $col). Call write_row() if any of
2139             # the elements of the array ref are in turn array refs. This allows the writing
2140             # of 1D or 2D arrays of data in one go.
2141             #
2142 2140         4172 # Returns: the first encountered error value or zero for no errors
2143             #
2144              
2145             my $self = shift;
2146              
2147              
2148             # Check for a cell reference in A1 notation and substitute row and column
2149             if ( $_[0] =~ /^\D/ ) {
2150             @_ = $self->_substitute_cellref( @_ );
2151             }
2152              
2153             # Catch non array refs passed by user.
2154             if ( ref $_[2] ne 'ARRAY' ) {
2155             croak "Not an array ref in call to write_col()$!";
2156             }
2157              
2158             my $row = shift;
2159 1051     1051 0 1544 my $col = shift;
2160             my $tokens = shift;
2161             my @options = @_;
2162             my $error = 0;
2163 1051 100       3258 my $ret;
2164 7         22  
2165             for my $token ( @$tokens ) {
2166              
2167             # write() will deal with any nested arrays
2168 1051 50       2684 $ret = $self->write( $row, $col, $token, @options );
2169 0         0  
2170             # Return only the first error encountered, if any.
2171             $error ||= $ret;
2172 1051         1626 $row++;
2173 1051         1430 }
2174 1051         1372  
2175 1051         1683 return $error;
2176 1051         1425 }
2177 1051         1353  
2178              
2179 1051         1834 ###############################################################################
2180             #
2181             # write_comment($row, $col, $comment)
2182 3976 100       6370 #
2183 1198         2885 # Write a comment to the specified row and column (zero indexed).
2184             #
2185             # Returns 0 : normal termination
2186 2778         4358 # -1 : insufficient number of arguments
2187             # -2 : row or column out of range
2188             #
2189              
2190 3976   33     11267 my $self = shift;
2191 3976         5018  
2192             # Check for a cell reference in A1 notation and substitute row and column
2193             if ( $_[0] =~ /^\D/ ) {
2194 1051         2757 @_ = $self->_substitute_cellref( @_ );
2195             }
2196              
2197             if ( @_ < 3 ) { return -1 } # Check the number of args
2198              
2199             my $row = $_[0];
2200             my $col = $_[1];
2201              
2202             # Check for pairs of optional arguments, i.e. an odd number of args.
2203             croak "Uneven number of additional arguments" unless @_ % 2;
2204              
2205             # Check that row and col are valid and store max and min values
2206             return -2 if $self->_check_dimensions( $row, $col );
2207              
2208             $self->{_has_vml} = 1;
2209             $self->{_has_comments} = 1;
2210 1219     1219 0 1849  
2211             # Process the properties of the cell comment.
2212             $self->{_comments}->{$row}->{$col} = [ @_ ];
2213             }
2214 1219 100       3300  
2215 19         70  
2216             ###############################################################################
2217             #
2218             # write_number($row, $col, $num, $format)
2219 1219 50       2819 #
2220 0         0 # Write a double to the specified row and column (zero indexed).
2221             # An integer can be written as a double. Excel will display an
2222             # integer. $format is optional.
2223 1219         1904 #
2224 1219         1617 # Returns 0 : normal termination
2225 1219         1644 # -1 : insufficient number of arguments
2226 1219         2038 # -2 : row or column out of range
2227 1219         1573 #
2228 1219         1538  
2229             my $self = shift;
2230 1219         2056  
2231             # Check for a cell reference in A1 notation and substitute row and column
2232             if ( $_[0] =~ /^\D/ ) {
2233 5955         10535 @_ = $self->_substitute_cellref( @_ );
2234             }
2235              
2236 5955   33     16584 if ( @_ < 3 ) { return -1 } # Check the number of args
2237 5955         7837  
2238              
2239             my $row = $_[0]; # Zero indexed row
2240 1219         2177 my $col = $_[1]; # Zero indexed column
2241             my $num = $_[2] + 0;
2242             my $xf = $_[3]; # The cell format
2243             my $type = 'n'; # The data type
2244              
2245             # Check that row and col are valid and store max and min values
2246             return -2 if $self->_check_dimensions( $row, $col );
2247              
2248             # Write previous row if in in-line string optimization mode.
2249             if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2250             $self->_write_single_row( $row );
2251             }
2252              
2253             $self->{_table}->{$row}->{$col} = [ $type, $num, $xf ];
2254              
2255             return 0;
2256 4166     4166 0 10913 }
2257              
2258              
2259 4166 100       7541 ###############################################################################
2260 70         214 #
2261             # write_string ($row, $col, $string, $format)
2262             #
2263 4166 50       5699 # Write a string to the specified row and column (zero indexed).
  0         0  
2264             # $format is optional.
2265 4166         4531 # Returns 0 : normal termination
2266 4166         4248 # -1 : insufficient number of arguments
2267             # -2 : row or column out of range
2268             # -3 : long string truncated to 32767 chars
2269 4166 50       5595 # -4 : Ignore undef strings
2270             #
2271              
2272 4166 100       5439 my $self = shift;
2273              
2274 4162         4749 # Check for a cell reference in A1 notation and substitute row and column
2275 4162         4372 if ( $_[0] =~ /^\D/ ) {
2276             @_ = $self->_substitute_cellref( @_ );
2277             }
2278 4162         12589  
2279             if ( @_ < 3 ) { return -1 } # Check the number of args
2280              
2281             my $row = $_[0]; # Zero indexed row
2282             my $col = $_[1]; # Zero indexed column
2283             my $str = $_[2];
2284             my $xf = $_[3]; # The cell format
2285             my $type = 's'; # The data type
2286             my $index;
2287             my $str_error = 0;
2288              
2289             # Ignore undef strings.
2290             return -4 if !defined $str;
2291              
2292             # Check that row and col are valid and store max and min values
2293             return -2 if $self->_check_dimensions( $row, $col );
2294              
2295             # Check that the string is < 32767 chars
2296 7752     7752 0 11000 if ( length $str > $self->{_xls_strmax} ) {
2297             $str = substr( $str, 0, $self->{_xls_strmax} );
2298             $str_error = -3;
2299 7752 50       14509 }
2300 0         0  
2301             # Write a shared string or an in-line string based on optimisation level.
2302             if ( $self->{_optimization} == 0 ) {
2303 7752 50       12298 $index = $self->_get_shared_string_index( $str );
  0         0  
2304             }
2305             else {
2306 7752         9533 $index = $str;
2307 7752         8504 }
2308 7752         9431  
2309 7752         8417 # Write previous row if in in-line string optimization mode.
2310 7752         8646 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2311             $self->_write_single_row( $row );
2312             }
2313 7752 100       12039  
2314             $self->{_table}->{$row}->{$col} = [ $type, $index, $xf ];
2315              
2316 7749 100 100     14242 return $str_error;
2317 2         6 }
2318              
2319              
2320 7749         18273 ###############################################################################
2321             #
2322 7749         13743 # write_rich_string( $row, $column, $format, $string, ..., $cell_format )
2323             #
2324             # The write_rich_string() method is used to write strings with multiple formats.
2325             # The method receives string fragments prefixed by format objects. The final
2326             # format object is used as the cell format.
2327             #
2328             # Returns 0 : normal termination.
2329             # -1 : insufficient number of arguments.
2330             # -2 : row or column out of range.
2331             # -3 : long string truncated to 32767 chars.
2332             # -4 : 2 consecutive formats used.
2333             #
2334              
2335             my $self = shift;
2336              
2337             # Check for a cell reference in A1 notation and substitute row and column
2338             if ( $_[0] =~ /^\D/ ) {
2339             @_ = $self->_substitute_cellref( @_ );
2340 3022     3022 0 6950 }
2341              
2342             if ( @_ < 3 ) { return -1 } # Check the number of args
2343 3022 100       6187  
2344 51         109 my $row = shift; # Zero indexed row.
2345             my $col = shift; # Zero indexed column.
2346             my $str = '';
2347 3022 50       5033 my $xf = undef;
  0         0  
2348             my $type = 's'; # The data type.
2349 3022         3753 my $length = 0; # String length.
2350 3022         3293 my $index;
2351 3022         3393 my $str_error = 0;
2352 3022         3250  
2353 3022         3401 # Check that row and col are valid and store max and min values
2354 3022         3160 return -2 if $self->_check_dimensions( $row, $col );
2355 3022         3640  
2356              
2357             # If the last arg is a format we use it as the cell format.
2358 3022 50       4565 if ( ref $_[-1] ) {
2359             $xf = pop @_;
2360             }
2361 3022 100       4941  
2362              
2363             # Create a temp XML::Writer object and use it to write the rich string
2364 3018 50       5606 # XML to a string.
2365 0         0 open my $str_fh, '>', \$str or die "Failed to open filehandle: $!";
2366 0         0 binmode $str_fh, ':utf8';
2367              
2368             my $writer = Excel::Writer::XLSX::Package::XMLwriter->new( $str_fh );
2369              
2370 3018 100       4665 $self->{_rstring} = $writer;
2371 2724         4307  
2372             # Create a temp format with the default font for unformatted fragments.
2373             my $default = Excel::Writer::XLSX::Format->new();
2374 294         311  
2375             # Convert the list of $format, $string tokens to pairs of ($format, $string)
2376             # except for the first $string fragment which doesn't require a default
2377             # formatting run. Use the default for strings without a leading format.
2378 3018 100 100     5551 my @fragments;
2379 280         431 my $last = 'format';
2380             my $pos = 0;
2381              
2382 3018         8082 for my $token ( @_ ) {
2383             if ( !ref $token ) {
2384 3018         5680  
2385             # Token is a string.
2386             if ( $last ne 'format' ) {
2387              
2388             # If previous token wasn't a format add one before the string.
2389             push @fragments, ( $default, $token );
2390             }
2391             else {
2392              
2393             # If previous token was a format just add the string.
2394             push @fragments, $token;
2395             }
2396              
2397             $length += length $token; # Keep track of actual string length.
2398             $last = 'string';
2399             }
2400             else {
2401              
2402             # Can't allow 2 formats in a row.
2403             if ( $last eq 'format' && $pos > 0 ) {
2404 29     29 0 131 return -4;
2405             }
2406              
2407 29 100       97 # Token is a format object. Add it to the fragment list.
2408 28         81 push @fragments, $token;
2409             $last = 'format';
2410             }
2411 29 50       81  
  0         0  
2412             $pos++;
2413 29         51 }
2414 29         60  
2415 29         45  
2416 29         52 # If the first token is a string start the <r> element.
2417 29         47 if ( !ref $fragments[0] ) {
2418 29         42 $self->{_rstring}->xml_start_tag( 'r' );
2419 29         38 }
2420 29         49  
2421             # Write the XML elements for the $format $string fragments.
2422             for my $token ( @fragments ) {
2423 29 50       71 if ( ref $token ) {
2424              
2425             # Write the font run.
2426             $self->{_rstring}->xml_start_tag( 'r' );
2427 29 100       72 $self->_write_font( $token );
2428 3         6 }
2429             else {
2430              
2431             # Write the string fragment part, with whitespace handling.
2432             my @attributes = ();
2433              
2434 29 50   17   711 if ( $token =~ /^\s/ || $token =~ /\s$/ ) {
  17         117  
  17         28  
  17         104  
2435 29         9824 push @attributes, ( 'xml:space' => 'preserve' );
2436             }
2437 29         186  
2438             $self->{_rstring}->xml_data_element( 't', $token, @attributes );
2439 29         143 $self->{_rstring}->xml_end_tag( 'r' );
2440             }
2441             }
2442 29         159  
2443             # Check that the string is < 32767 chars.
2444             if ( $length > $self->{_xls_strmax} ) {
2445             return -3;
2446             }
2447 29         48  
2448 29         45  
2449 29         44 # Write a shared string or an in-line string based on optimisation level.
2450             if ( $self->{_optimization} == 0 ) {
2451 29         66 $index = $self->_get_shared_string_index( $str );
2452 114 100       190 }
2453             else {
2454             $index = $str;
2455 81 100       137 }
2456              
2457             # Write previous row if in in-line string optimization mode.
2458 25         39 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2459             $self->_write_single_row( $row );
2460             }
2461              
2462             $self->{_table}->{$row}->{$col} = [ $type, $index, $xf ];
2463 56         82  
2464             return 0;
2465             }
2466 81         98  
2467 81         97  
2468             ###############################################################################
2469             #
2470             # write_blank($row, $col, $format)
2471             #
2472 33 100 100     122 # Write a blank cell to the specified row and column (zero indexed).
2473 1         7 # A blank cell is used to specify formatting without adding a string
2474             # or a number.
2475             #
2476             # A blank cell without a format serves no purpose. Therefore, we don't write
2477 32         51 # a BLANK record unless a format is specified. This is mainly an optimisation
2478 32         42 # for the write_row() and write_col() methods.
2479             #
2480             # Returns 0 : normal termination (including no format)
2481 113         147 # -1 : insufficient number of arguments
2482             # -2 : row or column out of range
2483             #
2484              
2485             my $self = shift;
2486 28 100       81  
2487 24         93 # Check for a cell reference in A1 notation and substitute row and column
2488             if ( $_[0] =~ /^\D/ ) {
2489             @_ = $self->_substitute_cellref( @_ );
2490             }
2491 28         61  
2492 136 100       253 # Check the number of args
2493             return -1 if @_ < 2;
2494              
2495 56         136 # Don't write a blank cell unless it has a format
2496 56         136 return 0 if not defined $_[2];
2497              
2498             my $row = $_[0]; # Zero indexed row
2499             my $col = $_[1]; # Zero indexed column
2500             my $xf = $_[2]; # The cell format
2501 80         120 my $type = 'b'; # The data type
2502              
2503 80 100 100     368 # Check that row and col are valid and store max and min values
2504 10         24 return -2 if $self->_check_dimensions( $row, $col );
2505              
2506             # Write previous row if in in-line string optimization mode.
2507 80         254 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2508 80         182 $self->_write_single_row( $row );
2509             }
2510              
2511             $self->{_table}->{$row}->{$col} = [ $type, undef, $xf ];
2512              
2513 28 50       95 return 0;
2514 0         0 }
2515              
2516              
2517             ###############################################################################
2518             #
2519 28 100       75 # write_formula($row, $col, $formula, $format)
2520 20         77 #
2521             # Write a formula to the specified row and column (zero indexed).
2522             #
2523 8         12 # $format is optional.
2524             #
2525             # Returns 0 : normal termination
2526             # -1 : insufficient number of arguments
2527 28 100 66     126 # -2 : row or column out of range
2528 8         15 #
2529              
2530             my $self = shift;
2531 28         124  
2532             # Check for a cell reference in A1 notation and substitute row and column
2533 28         200 if ( $_[0] =~ /^\D/ ) {
2534             @_ = $self->_substitute_cellref( @_ );
2535             }
2536              
2537             if ( @_ < 3 ) { return -1 } # Check the number of args
2538              
2539             my $row = $_[0]; # Zero indexed row
2540             my $col = $_[1]; # Zero indexed column
2541             my $formula = $_[2]; # The formula text string
2542             my $xf = $_[3]; # The format object.
2543             my $value = $_[4]; # Optional formula value.
2544             my $type = 'f'; # The data type
2545              
2546             # Hand off array formulas.
2547             if ( $formula =~ /^{=.*}$/ ) {
2548             return $self->write_array_formula( $row, $col, $row, $col, $formula,
2549             $xf, $value );
2550             }
2551              
2552             # Check that row and col are valid and store max and min values
2553             return -2 if $self->_check_dimensions( $row, $col );
2554              
2555 90     90 0 2068 # Remove the = sign if it exists.
2556             $formula =~ s/^=//;
2557              
2558 90 50       265 # Write previous row if in in-line string optimization mode.
2559 0         0 if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2560             $self->_write_single_row( $row );
2561             }
2562              
2563 90 50       214 $self->{_table}->{$row}->{$col} = [ $type, $formula, $xf, $value ];
2564              
2565             return 0;
2566 90 100       226 }
2567              
2568 66         100 # Internal method shared by the write_array_formula() and
2569 66         104 # write_dynamic_array_formula() methods.
2570 66         80  
2571 66         95 my $self = shift;
2572              
2573             # Check for a cell reference in A1 notation and substitute row and column
2574 66 100       115 if ( $_[0] =~ /^\D/ ) {
2575             @_ = $self->_substitute_cellref( @_ );
2576             }
2577 63 50 66     150  
2578 0         0 if ( @_ < 5 ) { return -1 } # Check the number of args
2579              
2580             my $row1 = $_[0]; # First row
2581 63         168 my $col1 = $_[1]; # First column
2582             my $row2 = $_[2]; # Last row
2583 63         161 my $col2 = $_[3]; # Last column
2584             my $formula = $_[4]; # The formula text string
2585             my $xf = $_[5]; # The format object.
2586             my $value = $_[6]; # Optional formula value.
2587             my $type = $_[7]; # The data type
2588              
2589             # Swap last row/col with first row/col as necessary
2590             ( $row1, $row2 ) = ( $row2, $row1 ) if $row1 > $row2;
2591             ( $col1, $col2 ) = ( $col1, $col2 ) if $col1 > $col2;
2592              
2593             # Check that row and col are valid and store max and min values.
2594             return -2 if $self->_check_dimensions( $row1, $col1 );
2595             return -2 if $self->_check_dimensions( $row2, $col2 );
2596              
2597             # Define array range
2598             my $range;
2599              
2600             if ( $row1 == $row2 and $col1 == $col2 ) {
2601 121     121 0 2076 $range = xl_rowcol_to_cell( $row1, $col1 );
2602              
2603             }
2604 121 100       348 else {
2605 25         69 $range =
2606             xl_rowcol_to_cell( $row1, $col1 ) . ':'
2607             . xl_rowcol_to_cell( $row2, $col2 );
2608 121 50       262 }
  0         0  
2609              
2610 121         168 # Remove array formula braces and the leading =.
2611 121         294 $formula =~ s/^{(.*)}$/$1/;
2612 121         168 $formula =~ s/^=//;
2613 121         265  
2614 121         151 # Write previous row if in in-line string optimization mode.
2615 121         164 my $row = $row1;
2616             if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2617             $self->_write_single_row( $row );
2618 121 100       281 }
2619 3         11  
2620             $self->{_table}->{$row1}->{$col1} =
2621             [ $type, $formula, $xf, $range, $value ];
2622              
2623              
2624 118 100       245 # Pad out the rest of the area with formatted zeroes.
2625             if ( !$self->{_optimization} ) {
2626             for my $row ( $row1 .. $row2 ) {
2627 115         256 for my $col ( $col1 .. $col2 ) {
2628             next if $row == $row1 and $col == $col1;
2629             $self->write_number( $row, $col, 0, $xf );
2630 115 50 66     714 }
2631 0         0 }
2632             }
2633              
2634 115         574 return 0;
2635             }
2636 115         428  
2637              
2638              
2639             ###############################################################################
2640             #
2641             # write_array_formula($row1, $col1, $row2, $col2, $formula, $format)
2642             #
2643 14     14   22 # Write an array formula to the specified row and column (zero indexed).
2644             #
2645             # $format is optional.
2646 14 100       57 #
2647 6         22 # Returns 0 : normal termination
2648             # -1 : insufficient number of arguments
2649             # -2 : row or column out of range
2650 14 50       44 #
  0         0  
2651              
2652 14         27 my $self = shift;
2653 14         23  
2654 14         20 return $self->_write_array_formula( @_, 'a' );
2655 14         21 }
2656 14         21  
2657 14         20  
2658 14         21 ###############################################################################
2659 14         23 #
2660             # write_dynamic_array_formula($row1, $col1, $row2, $col2, $formula, $format)
2661             #
2662 14 100       37 # Write a dynamic formula to the specified row and column (zero indexed).
2663 14 100       31 #
2664             # $format is optional.
2665             #
2666 14 100       39 # Returns 0 : normal termination
2667 12 100       30 # -1 : insufficient number of arguments
2668             # -2 : row or column out of range
2669             #
2670 9         13  
2671             my $self = shift;
2672 9 100 66     34  
2673 5         19 my $error = $self->_write_array_formula( @_, 'd' );
2674              
2675             if ( $error == 0 ) {
2676             $self->{_has_dynamic_arrays} = 1;
2677 4         14 }
2678              
2679             return $error;
2680             }
2681              
2682              
2683 9         47 ###############################################################################
2684 9         30 #
2685             # write_blank($row, $col, $format)
2686             #
2687 9         17 # Write a boolean value to the specified row and column (zero indexed).
2688 9 50 33     28 #
2689 0         0 # Returns 0 : normal termination (including no format)
2690             # -2 : row or column out of range
2691             #
2692 9         33  
2693             my $self = shift;
2694              
2695             # Check for a cell reference in A1 notation and substitute row and column
2696             if ( $_[0] =~ /^\D/ ) {
2697 9 50       24 @_ = $self->_substitute_cellref( @_ );
2698 9         29 }
2699 17         30  
2700 17 100 66     116 my $row = $_[0]; # Zero indexed row
2701 8         21 my $col = $_[1]; # Zero indexed column
2702             my $val = $_[2] ? 1 : 0; # Boolean value.
2703             my $xf = $_[3]; # The cell format
2704             my $type = 'l'; # The data type
2705              
2706 9         28 # Check that row and col are valid and store max and min values
2707             return -2 if $self->_check_dimensions( $row, $col );
2708              
2709             # Write previous row if in in-line string optimization mode.
2710             if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2711             $self->_write_single_row( $row );
2712             }
2713              
2714             $self->{_table}->{$row}->{$col} = [ $type, $val, $xf ];
2715              
2716             return 0;
2717             }
2718              
2719              
2720             ###############################################################################
2721             #
2722             # outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
2723             #
2724             # This method sets the properties for outlining and grouping. The defaults
2725 13     13 0 3644 # correspond to Excel's defaults.
2726             #
2727 13         37  
2728             my $self = shift;
2729              
2730             $self->{_outline_on} = defined $_[0] ? $_[0] : 1;
2731             $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
2732             $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
2733             $self->{_outline_style} = $_[3] || 0;
2734              
2735             $self->{_outline_changed} = 1;
2736             }
2737              
2738              
2739             ###############################################################################
2740             #
2741             # Escape urls like Excel.
2742             #
2743              
2744             my $url = shift;
2745 1     1 0 7  
2746             # Don't escape URL if it looks already escaped.
2747 1         4 return $url if $url =~ /%[0-9a-fA-F]{2}/;
2748              
2749 1 50       3 # Escape the URL escape symbol.
2750 1         2 $url =~ s/%/%25/g;
2751              
2752             # Escape whitespace in URL.
2753 1         3 $url =~ s/[\s\x00]/%20/g;
2754              
2755             # Escape other special characters in URL.
2756             $url =~ s/(["<>[\]`^{}])/sprintf '%%%x', ord $1/eg;
2757              
2758             return $url;
2759             }
2760              
2761              
2762             ###############################################################################
2763             #
2764             # write_url($row, $col, $url, format, $string)
2765             #
2766             # Write a hyperlink. This is comprised of two elements: the visible label and
2767             # the invisible link. The visible label is the same as the link unless an
2768 4     4 0 26 # alternative string is specified. The label is written using the
2769             # write_string() method. Therefore the max characters string limit applies.
2770             # $string and $format are optional and their order is interchangeable.
2771 4 50       17 #
2772 4         13 # The hyperlink can be to a http, ftp, mail, internal sheet, or external
2773             # directory url.
2774             #
2775 4         6 # Returns 0 : normal termination
2776 4         7 # -1 : insufficient number of arguments
2777 4 100       11 # -2 : row or column out of range
2778 4         7 # -3 : long string truncated to 32767 chars
2779 4         7 # -4 : URL longer than 255 characters
2780             # -5 : Exceeds limit of 65_530 urls per worksheet
2781             #
2782 4 50       11  
2783             my $self = shift;
2784              
2785 4 50 33     25 # Check for a cell reference in A1 notation and substitute row and column
2786 0         0 if ( $_[0] =~ /^\D/ ) {
2787             @_ = $self->_substitute_cellref( @_ );
2788             }
2789 4         99  
2790             if ( @_ < 3 ) { return -1 } # Check the number of args
2791 4         61  
2792              
2793             # Reverse the order of $string and $format if necessary, for backward
2794             # compatibility. We work on a copy in order to protect the callers
2795             # args. We don't use "local @_" in case of perl50005 threads.
2796             my @args = @_;
2797             if (defined $args[3] and !ref $args[3]) {
2798             ( $args[3], $args[4] ) = ( $args[4], $args[3] );
2799             }
2800              
2801             my $row = $args[0]; # Zero indexed row
2802             my $col = $args[1]; # Zero indexed column
2803             my $url = $args[2]; # URL string
2804 1     1 0 5 my $xf = $args[3]; # Cell format
2805             my $str = $args[4]; # Alternative label
2806 1 50       7 my $tip = $args[5]; # Tool tip
2807 1 50       4 my $type = 'l'; # XML data type
2808 1 50       4 my $link_type = 1;
2809 1   50     3 my $external = 0;
2810              
2811 1         1 # The displayed string defaults to the url string.
2812             $str = $url unless defined $str;
2813              
2814             # Remove the URI scheme from internal links.
2815             if ( $url =~ s/^internal:// ) {
2816             $str =~ s/^internal://;
2817             $link_type = 2;
2818             }
2819              
2820             # Remove the URI scheme from external links and change the directory
2821 103     103   183 # separator from Unix to Dos.
2822             if ( $url =~ s/^external:// ) {
2823             $str =~ s/^external://;
2824 103 100       336 $url =~ s[/][\\]g;
2825             $str =~ s[/][\\]g;
2826             $external = 1;
2827 102         198 }
2828              
2829             # Strip the mailto header.
2830 102         283 $str =~ s/^mailto://;
2831              
2832             # Check that row and col are valid and store max and min values
2833 102         197 return -2 if $self->_check_dimensions( $row, $col );
  11         31  
2834              
2835 102         192 # Check that the string is < 32767 chars
2836             my $str_error = 0;
2837             if ( length $str > $self->{_xls_strmax} ) {
2838             $str = substr( $str, 0, $self->{_xls_strmax} );
2839             $str_error = -3;
2840             }
2841              
2842             # Copy string for use in hyperlink elements.
2843             my $url_str = $str;
2844              
2845             # External links to URLs and to other Excel workbooks have slightly
2846             # different characteristics that we have to account for.
2847             if ( $link_type == 1 ) {
2848              
2849             # Split url into the link and optional anchor/location.
2850             ( $url, $url_str ) = split /#/, $url, 2;
2851              
2852             $url = _escape_url( $url );
2853              
2854             # Escape the anchor for hyperlink style urls only.
2855             if ( $url_str && !$external ) {
2856             $url_str = _escape_url( $url_str );
2857             }
2858              
2859             # Add the file:/// URI to the url for Windows style "C:/" link and
2860             # Network shares.
2861 83     83 0 538 if ( $url =~ m{^\w:} || $url =~ m{^\\\\} ) {
2862             $url = 'file:///' . $url;
2863             }
2864 83 100       369  
2865 68         238 # Convert a ./dir/file.xlsx link to dir/file.xlsx.
2866             $url =~ s{^.\\}{};
2867             }
2868 83 50       258  
  0         0  
2869             # Excel limits the escaped URL and location/anchor to 255 characters.
2870             my $tmp_url_str = $url_str || '';
2871             my $max_url = $self->{_max_url_length};
2872              
2873             if ( length $url > $max_url || length $tmp_url_str > $max_url ) {
2874 83         224 carp "Ignoring URL '$url' where link or anchor > $max_url characters "
2875 83 100 100     367 . "since it exceeds Excel's limit for URLS. See LIMITATIONS "
2876 13         40 . "section of the Excel::Writer::XLSX documentation.";
2877             return -4;
2878             }
2879 83         148  
2880 83         171 # Check the limit of URLS per worksheet.
2881 83         129 $self->{_hlink_count}++;
2882 83         133  
2883 83         143 if ( $self->{_hlink_count} > 65_530 ) {
2884 83         126 carp "Ignoring URL '$url' since it exceeds Excel's limit of 65,530 "
2885 83         147 . "URLs per worksheet. See LIMITATIONS section of the "
2886 83         130 . "Excel::Writer::XLSX documentation.";
2887 83         143 return -5;
2888             }
2889              
2890 83 100       213 # Write previous row if in in-line string optimization mode.
2891             if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2892             $self->_write_single_row( $row );
2893 83 100       263 }
2894 8         22  
2895 8         11 # Add the default URL format.
2896             if ( !defined $xf ) {
2897             $xf = $self->{_default_url_format};
2898             }
2899              
2900 83 100       242 # Write the hyperlink string.
2901 15         47 $self->write_string( $row, $col, $str, $xf );
2902 15         35  
2903 15         30 # Store the hyperlink data in a separate structure.
2904 15         25 $self->{_hyperlinks}->{$row}->{$col} = {
2905             _link_type => $link_type,
2906             _url => $url,
2907             _str => $url_str,
2908 83         149 _tip => $tip
2909             };
2910              
2911 83 50       294 return $str_error;
2912             }
2913              
2914 83         161  
2915 83 50       242 ###############################################################################
2916 0         0 #
2917 0         0 # write_date_time ($row, $col, $string, $format)
2918             #
2919             # Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
2920             # number representing an Excel date. $format is optional.
2921 83         146 #
2922             # Returns 0 : normal termination
2923             # -1 : insufficient number of arguments
2924             # -2 : row or column out of range
2925 83 100       231 # -3 : Invalid date_time, written as string
2926             #
2927              
2928 75         259 my $self = shift;
2929              
2930 75         207 # Check for a cell reference in A1 notation and substitute row and column
2931             if ( $_[0] =~ /^\D/ ) {
2932             @_ = $self->_substitute_cellref( @_ );
2933 75 100 100     242 }
2934 4         10  
2935             if ( @_ < 3 ) { return -1 } # Check the number of args
2936              
2937             my $row = $_[0]; # Zero indexed row
2938             my $col = $_[1]; # Zero indexed column
2939 75 100 100     373 my $str = $_[2];
2940 9         22 my $xf = $_[3]; # The cell format
2941             my $type = 'n'; # The data type
2942              
2943              
2944 75         154 # Check that row and col are valid and store max and min values
2945             return -2 if $self->_check_dimensions( $row, $col );
2946              
2947             my $str_error = 0;
2948 83   100     243 my $date_time = $self->convert_date_time( $str );
2949 83         148  
2950             # If the date isn't valid then write it as a string.
2951 83 100 66     352 if ( !defined $date_time ) {
2952 1         265 return $self->write_string( @_ );
2953             }
2954              
2955 1         7 # Write previous row if in in-line string optimization mode.
2956             if ( $self->{_optimization} == 1 && $row > $self->{_previous_row} ) {
2957             $self->_write_single_row( $row );
2958             }
2959 82         143  
2960             $self->{_table}->{$row}->{$col} = [ $type, $date_time, $xf ];
2961 82 50       205  
2962 0         0 return $str_error;
2963             }
2964              
2965 0         0  
2966             ###############################################################################
2967             #
2968             # convert_date_time($date_time_string)
2969 82 50 66     285 #
2970 0         0 # The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
2971             # and converts it to a decimal number representing a valid Excel date.
2972             #
2973             # Dates and times in Excel are represented by real numbers. The integer part of
2974 82 100       193 # the number stores the number of days since the epoch and the fractional part
2975 65         114 # stores the percentage of the day in seconds. The epoch can be either 1900 or
2976             # 1904.
2977             #
2978             # Parameter: Date and time string in one of the following formats:
2979 82         300 # yyyy-mm-ddThh:mm:ss.ss # Standard
2980             # yyyy-mm-ddT # Date only
2981             # Thh:mm:ss.ss # Time only
2982 82         482 #
2983             # Returns:
2984             # A decimal number representing a valid Excel date, or
2985             # undef if the date is invalid.
2986             #
2987              
2988             my $self = shift;
2989 82         311 my $date_time = $_[0];
2990              
2991             my $days = 0; # Number of days since epoch
2992             my $seconds = 0; # Time expressed as fraction of 24h hours in seconds
2993              
2994             my ( $year, $month, $day );
2995             my ( $hour, $min, $sec );
2996              
2997              
2998             # Strip leading and trailing whitespace.
2999             $date_time =~ s/^\s+//;
3000             $date_time =~ s/\s+$//;
3001              
3002             # Check for invalid date char.
3003             return if $date_time =~ /[^0-9T:\-\.Z]/;
3004              
3005             # Check for "T" after date or before time.
3006             return unless $date_time =~ /\dT|T\d/;
3007 129     129 0 662  
3008             # Strip trailing Z in ISO8601 date.
3009             $date_time =~ s/Z$//;
3010 129 100       320  
3011 12         27  
3012             # Split into date and time.
3013             my ( $date, $time ) = split /T/, $date_time;
3014 129 50       259  
  0         0  
3015              
3016 129         169 # We allow the time portion of the input DateTime to be optional.
3017 129         155 if ( $time ne '' ) {
3018 129         148  
3019 129         146 # Match hh:mm:ss.sss+ where the seconds are optional
3020 129         159 if ( $time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/ ) {
3021             $hour = $1;
3022             $min = $2;
3023             $sec = $4 || 0;
3024 129 50       221 }
3025             else {
3026 129         158 return undef; # Not a valid time format.
3027 129         269 }
3028              
3029             # Some boundary checks
3030 129 50       219 return if $hour >= 24;
3031 0         0 return if $min >= 60;
3032             return if $sec >= 60;
3033              
3034             # Excel expresses seconds as a fraction of the number in 24 hours.
3035 129 50 33     312 $seconds = ( $hour * 60 * 60 + $min * 60 + $sec ) / ( 24 * 60 * 60 );
3036 0         0 }
3037              
3038              
3039 129         406 # We allow the date portion of the input DateTime to be optional.
3040             return $seconds if $date eq '';
3041 129         535  
3042              
3043             # Match date as yyyy-mm-dd.
3044             if ( $date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/ ) {
3045             $year = $1;
3046             $month = $2;
3047             $day = $3;
3048             }
3049             else {
3050             return undef; # Not a valid date format.
3051             }
3052              
3053             # Set the epoch as 1900 or 1904. Defaults to 1900.
3054             my $date_1904 = $self->{_date_1904};
3055              
3056              
3057             # Special cases for Excel.
3058             if ( not $date_1904 ) {
3059             return $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
3060             return $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
3061             return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
3062             }
3063              
3064              
3065             # We calculate the date by calculating the number of days since the epoch
3066             # and adjust for the number of leap days. We calculate the number of leap
3067             # days by normalising the year in relation to the epoch. Thus the year 2000
3068 768     768 0 305781 # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
3069 768         1168 #
3070             my $epoch = $date_1904 ? 1904 : 1900;
3071 768         1027 my $offset = $date_1904 ? 4 : 0;
3072 768         951 my $norm = 300;
3073             my $range = $year - $epoch;
3074 768         1581  
3075 768         0  
3076             # Set month days and check for leap year.
3077             my @mdays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
3078             my $leap = 0;
3079 768         1919 $leap = 1 if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
3080 768         1290 $mdays[1] = 29 if $leap;
3081              
3082              
3083 768 100       1994 # Some boundary checks
3084             return if $year < $epoch or $year > 9999;
3085             return if $month < 1 or $month > 12;
3086 767 100       2631 return if $day < 1 or $day > $mdays[ $month - 1 ];
3087              
3088             # Accumulate the number of days since the epoch.
3089 765         1096 $days = $day; # Add days for current month
3090             $days += $mdays[$_] for 0 .. $month - 2; # Add days for past months
3091             $days += $range * 365; # Add days for past years
3092             $days += int( ( $range ) / 4 ); # Add leapdays
3093 765         1993 $days -= int( ( $range + $offset ) / 100 ); # Subtract 100 year leapdays
3094             $days += int( ( $range + $offset + $norm ) / 400 ); # Add 400 year leapdays
3095             $days -= $leap; # Already counted above
3096              
3097 765 100       1687  
3098             # Adjust for Excel erroneously treating 1900 as a leap year.
3099             $days++ if $date_1904 == 0 and $days > 59;
3100 206 50       727  
3101 206         337 return $days + $seconds;
3102 206         274 }
3103 206   100     481  
3104              
3105             ###############################################################################
3106 0         0 #
3107             # set_row($row, $height, $format, $hidden, $level, $collapsed)
3108             #
3109             # This method is used to set the height and properties of a row.
3110 206 100       415 #
3111 205 100       367  
3112 204 100       416 my $self = shift;
3113             my $row = shift; # Row Number.
3114             my $height = shift; # Row height.
3115 202         422 my $format = shift; # Format object.
3116             my $hidden = shift || 0; # Hidden flag.
3117             my $level = shift || 0; # Outline level.
3118             my $collapsed = shift || 0; # Collapsed row.
3119             my $min_col = 0;
3120 761 100       1309  
3121             return unless defined $row; # Ensure at least $row is specified.
3122              
3123             # Get the default row height.
3124 759 100       2151 my $default_height = $self->{_default_row_height};
3125 757         1399  
3126 757         1076 # Use min col in _check_dimensions(). Default to 0 if undefined.
3127 757         1085 if ( defined $self->{_dim_colmin} ) {
3128             $min_col = $self->{_dim_colmin};
3129             }
3130 2         5  
3131             # Check that row is valid.
3132             return -2 if $self->_check_dimensions( $row, $min_col );
3133              
3134 757         1155 $height = $default_height if !defined $height;
3135              
3136             # If the height is 0 the row is hidden and the height is the default.
3137             if ( $height == 0 ) {
3138 757 100       1350 $hidden = 1;
3139 542 100       1124 $height = $default_height;
3140 438 100       762 }
3141 437 100       703  
3142             # Set the limits for the outline levels (0 <= x <= 7).
3143             $level = 0 if $level < 0;
3144             $level = 7 if $level > 7;
3145              
3146             if ( $level > $self->{_outline_row_level} ) {
3147             $self->{_outline_row_level} = $level;
3148             }
3149              
3150 651 100       1058 # Store the row properties.
3151 651 100       902 $self->{_set_rows}->{$row} = [ $height, $format,
3152 651         757 $hidden, $level, $collapsed ];
3153 651         1242  
3154             # Store the row change to allow optimisations.
3155             $self->{_row_size_changed} = 1;
3156              
3157 651         1343 # Store the row sizes for use when calculating image vertices.
3158 651         777 $self->{_row_sizes}->{$row} = [$height, $hidden];
3159 651 100 100     2708 }
      100        
3160 651 100       1076  
3161              
3162             ###############################################################################
3163             #
3164 651 100 66     1721 # set_row_pixels($row, $height, $format, $hidden, $level, $collapsed)
3165 645 100 100     1773 #
3166 639 100 100     1781 # This method is used to set the height (in pixels) and the properties of the
3167             # row.
3168             #
3169 633         869  
3170 633         1971 my $self = shift;
3171 633         861 my @data = @_;
3172 633         1096 my $height = $data[1];
3173 633         864  
3174 633         869 if ( $height ) {
3175 633         763 $data[1] = _pixels_to_height( $height );
3176             }
3177              
3178             return $self->set_row( @data );
3179 633 100 100     1641 }
3180              
3181 633         1637  
3182             ###############################################################################
3183             #
3184             # set_default_row()
3185             #
3186             # Set the default row properties
3187             #
3188              
3189             my $self = shift;
3190             my $height = shift || $self->{_original_row_height};
3191             my $zero_height = shift || 0;
3192              
3193 427     427 0 1869 if ( $height != $self->{_original_row_height} ) {
3194 427         495 $self->{_default_row_height} = $height;
3195 427         759  
3196 427         469 # Store the row change to allow optimisations.
3197 427   100     858 $self->{_row_size_changed} = 1;
3198 427   100     1044 }
3199 427   100     880  
3200 427         463 if ( $zero_height ) {
3201             $self->{_default_row_zeroed} = 1;
3202 427 50       650 }
3203             }
3204              
3205 427         622  
3206             ###############################################################################
3207             #
3208 427 100       975 # merge_range($first_row, $first_col, $last_row, $last_col, $string, $format)
3209 390         470 #
3210             # Merge a range of cells. The first cell should contain the data and the others
3211             # should be blank. All cells should contain the same format.
3212             #
3213 427 50       747  
3214             my $self = shift;
3215 427 100       747  
3216             # Check for a cell reference in A1 notation and substitute row and column
3217             if ( $_[0] =~ /^\D/ ) {
3218 427 100       791 @_ = $self->_substitute_cellref( @_ );
3219 1         2 }
3220 1         2 croak "Incorrect number of arguments" if @_ < 6;
3221             croak "Fifth parameter must be a format object" unless ref $_[5];
3222              
3223             my $row_first = shift;
3224 427 50       678 my $col_first = shift;
3225 427 50       618 my $row_last = shift;
3226             my $col_last = shift;
3227 427 100       730 my $string = shift;
3228 11         16 my $format = shift;
3229             my @extra_args = @_; # For write_url().
3230              
3231             # Excel doesn't allow a single cell to be merged
3232 427         1142 if ( $row_first == $row_last and $col_first == $col_last ) {
3233             croak "Can't merge single cell";
3234             }
3235              
3236 427         579 # Swap last row/col with first row/col as necessary
3237             ( $row_first, $row_last ) = ( $row_last, $row_first )
3238             if $row_first > $row_last;
3239 427         1006 ( $col_first, $col_last ) = ( $col_last, $col_first )
3240             if $col_first > $col_last;
3241              
3242             # Check that the data range is valid and store the max and min values.
3243             return -2 if $self->_check_dimensions( $row_first, $col_first );
3244             return -2 if $self->_check_dimensions( $row_last, $col_last );
3245              
3246             # Store the merge range.
3247             push @{ $self->{_merge} }, [ $row_first, $col_first, $row_last, $col_last ];
3248              
3249             # Write the first cell
3250             $self->write( $row_first, $col_first, $string, $format, @extra_args );
3251              
3252 23     23 0 77 # Pad out the rest of the area with formatted blank cells.
3253 23         39 for my $row ( $row_first .. $row_last ) {
3254 23         25 for my $col ( $col_first .. $col_last ) {
3255             next if $row == $row_first and $col == $col_first;
3256 23 100       41 $self->write_blank( $row, $col, $format );
3257 22         33 }
3258             }
3259             }
3260 23         42  
3261              
3262             ###############################################################################
3263             #
3264             # merge_range_type()
3265             #
3266             # Same as merge_range() above except the type of write() is specified.
3267             #
3268              
3269             my $self = shift;
3270             my $type = shift;
3271              
3272 6     6 0 39 # Check for a cell reference in A1 notation and substitute row and column
3273 6   66     33 if ( $_[0] =~ /^\D/ ) {
3274 6   100     27 @_ = $self->_substitute_cellref( @_ );
3275             }
3276 6 100       44  
3277 5         12 my $row_first = shift;
3278             my $col_first = shift;
3279             my $row_last = shift;
3280 5         10 my $col_last = shift;
3281             my $format;
3282              
3283 6 100       26 # Get the format. It can be in different positions for the different types.
3284 3         7 if ( $type eq 'array_formula'
3285             || $type eq 'blank'
3286             || $type eq 'rich_string' )
3287             {
3288              
3289             # The format is the last element.
3290             $format = $_[-1];
3291             }
3292             else {
3293              
3294             # Or else it is after the token.
3295             $format = $_[1];
3296             }
3297              
3298 24     24 0 2596 # Check that there is a format object.
3299             croak "Format object missing or in an incorrect position"
3300             unless ref $format;
3301 24 100       96  
3302 12         40 # Excel doesn't allow a single cell to be merged
3303             if ( $row_first == $row_last and $col_first == $col_last ) {
3304 24 50       68 croak "Can't merge single cell";
3305 24 50       95 }
3306              
3307 24         44 # Swap last row/col with first row/col as necessary
3308 24         39 ( $row_first, $row_last ) = ( $row_last, $row_first )
3309 24         33 if $row_first > $row_last;
3310 24         44 ( $col_first, $col_last ) = ( $col_last, $col_first )
3311 24         259 if $col_first > $col_last;
3312 24         140  
3313 24         52 # Check that the data range is valid and store the max and min values.
3314             return -2 if $self->_check_dimensions( $row_first, $col_first );
3315             return -2 if $self->_check_dimensions( $row_last, $col_last );
3316 24 50 66     87  
3317 0         0 # Store the merge range.
3318             push @{ $self->{_merge} }, [ $row_first, $col_first, $row_last, $col_last ];
3319              
3320             # Write the first cell
3321 24 100       62 if ( $type eq 'string' ) {
3322             $self->write_string( $row_first, $col_first, @_ );
3323 24 100       57 }
3324             elsif ( $type eq 'number' ) {
3325             $self->write_number( $row_first, $col_first, @_ );
3326             }
3327 24 50       66 elsif ( $type eq 'blank' ) {
3328 24 100       55 $self->write_blank( $row_first, $col_first, @_ );
3329             }
3330             elsif ( $type eq 'date_time' ) {
3331 20         30 $self->write_date_time( $row_first, $col_first, @_ );
  20         60  
3332             }
3333             elsif ( $type eq 'rich_string' ) {
3334 20         72 $self->write_rich_string( $row_first, $col_first, @_ );
3335             }
3336             elsif ( $type eq 'url' ) {
3337 20         53 $self->write_url( $row_first, $col_first, @_ );
3338 30         52 }
3339 68 100 100     170 elsif ( $type eq 'formula' ) {
3340 48         96 $self->write_formula( $row_first, $col_first, @_ );
3341             }
3342             elsif ( $type eq 'array_formula' ) {
3343             $self->write_formula_array( $row_first, $col_first, @_ );
3344             }
3345             else {
3346             croak "Unknown type '$type'";
3347             }
3348              
3349             # Pad out the rest of the area with formatted blank cells.
3350             for my $row ( $row_first .. $row_last ) {
3351             for my $col ( $col_first .. $col_last ) {
3352             next if $row == $row_first and $col == $col_first;
3353             $self->write_blank( $row, $col, $format );
3354 7     7 0 30 }
3355 7         9 }
3356             }
3357              
3358 7 50       22  
3359 7         16 ###############################################################################
3360             #
3361             # data_validation($row, $col, {...})
3362 7         10 #
3363 7         11 # This method handles the interface to Excel data validation.
3364 7         11 # Somewhat ironically this requires a lot of validation code since the
3365 7         8 # interface is flexible and covers a several types of data validation.
3366 7         8 #
3367             # We allow data validation to be called on one cell or a range of cells. The
3368             # hashref contains the validation parameters and must be the last param:
3369 7 100 66     32 # data_validation($row, $col, {...})
      100        
3370             # data_validation($first_row, $first_col, $last_row, $last_col, {...})
3371             #
3372             # Returns 0 : normal termination
3373             # -1 : insufficient number of arguments
3374             # -2 : row or column out of range
3375 2         3 # -3 : incorrect parameter.
3376             #
3377              
3378             my $self = shift;
3379              
3380 5         7 # Check for a cell reference in A1 notation and substitute row and column
3381             if ( $_[0] =~ /^\D/ ) {
3382             @_ = $self->_substitute_cellref( @_ );
3383             }
3384 7 50       16  
3385             # Check for a valid number of args.
3386             if ( @_ != 5 && @_ != 3 ) { return -1 }
3387              
3388 7 50 33     22 # The final hashref contains the validation parameters.
3389 0         0 my $options = pop;
3390              
3391             # Make the last row/col the same as the first if not defined.
3392             my ( $row1, $col1, $row2, $col2 ) = @_;
3393 7 50       12 if ( !defined $row2 ) {
3394             $row2 = $row1;
3395 7 50       13 $col2 = $col1;
3396             }
3397              
3398             # Check that row and col are valid without storing the values.
3399 7 50       11 return -2 if $self->_check_dimensions( $row1, $col1, 1, 1 );
3400 7 50       14 return -2 if $self->_check_dimensions( $row2, $col2, 1, 1 );
3401              
3402             # Check that the last parameter is a hash list.
3403 7         10 if ( ref $options ne 'HASH' ) {
  7         19  
3404             carp "Last parameter in data_validation() must be a hash ref";
3405             return -3;
3406 7 100       27 }
    100          
    100          
    100          
    100          
    100          
    50          
    0          
3407 1         6  
3408             # Copy the user params.
3409             my $param = {%$options};
3410 1         14  
3411             # List of valid input parameters.
3412             my %valid_parameter = (
3413 1         4 validate => 1,
3414             criteria => 1,
3415             value => 1,
3416 1         5 source => 1,
3417             minimum => 1,
3418             maximum => 1,
3419 1         4 ignore_blank => 1,
3420             dropdown => 1,
3421             show_input => 1,
3422 1         4 input_title => 1,
3423             input_message => 1,
3424             show_error => 1,
3425 1         4 error_title => 1,
3426             error_message => 1,
3427             error_type => 1,
3428 0         0 other_cells => 1,
3429             );
3430              
3431 0         0 # Check for valid input parameters.
3432             for my $param_key ( keys %$param ) {
3433             if ( not exists $valid_parameter{$param_key} ) {
3434             carp "Unknown parameter '$param_key' in data_validation()";
3435 7         16 return -3;
3436 7         10 }
3437 14 100 66     37 }
3438 7         17  
3439             # Map alternative parameter names 'source' or 'minimum' to 'value'.
3440             $param->{value} = $param->{source} if defined $param->{source};
3441             $param->{value} = $param->{minimum} if defined $param->{minimum};
3442              
3443             # 'validate' is a required parameter.
3444             if ( not exists $param->{validate} ) {
3445             carp "Parameter 'validate' is required in data_validation()";
3446             return -3;
3447             }
3448              
3449              
3450             # List of valid validation types.
3451             my %valid_type = (
3452             'any' => 'none',
3453             'any value' => 'none',
3454             'whole number' => 'whole',
3455             'whole' => 'whole',
3456             'integer' => 'whole',
3457             'decimal' => 'decimal',
3458             'list' => 'list',
3459             'date' => 'date',
3460             'time' => 'time',
3461             'text length' => 'textLength',
3462             'length' => 'textLength',
3463             'custom' => 'custom',
3464 68     68 0 1485 );
3465              
3466              
3467 68 100       282 # Check for valid validation types.
3468 63         154 if ( not exists $valid_type{ lc( $param->{validate} ) } ) {
3469             carp "Unknown validation type '$param->{validate}' for parameter "
3470             . "'validate' in data_validation()";
3471             return -3;
3472 68 50 66     258 }
  0         0  
3473             else {
3474             $param->{validate} = $valid_type{ lc( $param->{validate} ) };
3475 68         93 }
3476              
3477             # No action is required for validation type 'any'
3478 68         137 # unless there are input messages.
3479 68 100       141 if ( $param->{validate} eq 'none'
3480 63         84 && !defined $param->{input_message}
3481 63         94 && !defined $param->{input_title} )
3482             {
3483             return 0;
3484             }
3485 68 50       157  
3486 68 50       119 # The any, list and custom validations don't have a criteria
3487             # so we use a default of 'between'.
3488             if ( $param->{validate} eq 'none'
3489 68 50       163 || $param->{validate} eq 'list'
3490 0         0 || $param->{validate} eq 'custom' )
3491 0         0 {
3492             $param->{criteria} = 'between';
3493             $param->{maximum} = undef;
3494             }
3495 68         313  
3496             # 'criteria' is a required parameter.
3497             if ( not exists $param->{criteria} ) {
3498 68         395 carp "Parameter 'criteria' is required in data_validation()";
3499             return -3;
3500             }
3501              
3502              
3503             # List of valid criteria types.
3504             my %criteria_type = (
3505             'between' => 'between',
3506             'not between' => 'notBetween',
3507             'equal to' => 'equal',
3508             '=' => 'equal',
3509             '==' => 'equal',
3510             'not equal to' => 'notEqual',
3511             '!=' => 'notEqual',
3512             '<>' => 'notEqual',
3513             'greater than' => 'greaterThan',
3514             '>' => 'greaterThan',
3515             'less than' => 'lessThan',
3516             '<' => 'lessThan',
3517             'greater than or equal to' => 'greaterThanOrEqual',
3518 68         220 '>=' => 'greaterThanOrEqual',
3519 262 50       439 'less than or equal to' => 'lessThanOrEqual',
3520 0         0 '<=' => 'lessThanOrEqual',
3521 0         0 );
3522              
3523             # Check for valid criteria types.
3524             if ( not exists $criteria_type{ lc( $param->{criteria} ) } ) {
3525             carp "Unknown criteria type '$param->{criteria}' for parameter "
3526 68 100       177 . "'criteria' in data_validation()";
3527 68 100       175 return -3;
3528             }
3529             else {
3530 68 50       138 $param->{criteria} = $criteria_type{ lc( $param->{criteria} ) };
3531 0         0 }
3532 0         0  
3533              
3534             # 'Between' and 'Not between' criteria require 2 values.
3535             if ( $param->{criteria} eq 'between' || $param->{criteria} eq 'notBetween' )
3536             {
3537 68         411 if ( not exists $param->{maximum} ) {
3538             carp "Parameter 'maximum' is required in data_validation() "
3539             . "when using 'between' or 'not between' criteria";
3540             return -3;
3541             }
3542             }
3543             else {
3544             $param->{maximum} = undef;
3545             }
3546              
3547              
3548             # List of valid error dialog types.
3549             my %error_type = (
3550             'stop' => 0,
3551             'warning' => 1,
3552             'information' => 2,
3553             );
3554 68 50       211  
3555 0         0 # Check for valid error dialog types.
3556             if ( not exists $param->{error_type} ) {
3557 0         0 $param->{error_type} = 0;
3558             }
3559             elsif ( not exists $error_type{ lc( $param->{error_type} ) } ) {
3560 68         623 carp "Unknown criteria type '$param->{error_type}' for parameter "
3561             . "'error_type' in data_validation()";
3562             return -3;
3563             }
3564             else {
3565 68 100 100     573 $param->{error_type} = $error_type{ lc( $param->{error_type} ) };
      66        
3566             }
3567              
3568              
3569 1         7 # Convert date/times value if required.
3570             if ( $param->{validate} eq 'date' || $param->{validate} eq 'time' ) {
3571             my $date_time = $self->convert_date_time( $param->{value} );
3572              
3573             if ( defined $date_time ) {
3574 67 100 100     335 $param->{value} = $date_time;
      100        
3575             }
3576              
3577             if ( defined $param->{maximum} ) {
3578 18         36 my $date_time = $self->convert_date_time( $param->{maximum} );
3579 18         32  
3580             if ( defined $date_time ) {
3581             $param->{maximum} = $date_time;
3582             }
3583 67 50       140 }
3584 0         0 }
3585 0         0  
3586             # Check that the input title doesn't exceed the maximum length.
3587             if ( $param->{input_title} and length $param->{input_title} > 32 ) {
3588             carp "Length of input title '$param->{input_title}'"
3589             . " exceeds Excel's limit of 32";
3590 67         493 return -3;
3591             }
3592              
3593             # Check that the error title don't exceed the maximum length.
3594             if ( $param->{error_title} and length $param->{error_title} > 32 ) {
3595             carp "Length of error title '$param->{error_title}'"
3596             . " exceeds Excel's limit of 32";
3597             return -3;
3598             }
3599              
3600             # Check that the input message don't exceed the maximum length.
3601             if ( $param->{input_message} and length $param->{input_message} > 255 ) {
3602             carp "Length of input message '$param->{input_message}'"
3603             . " exceeds Excel's limit of 255";
3604             return -3;
3605             }
3606              
3607             # Check that the error message don't exceed the maximum length.
3608             if ( $param->{error_message} and length $param->{error_message} > 255 ) {
3609             carp "Length of error message '$param->{error_message}'"
3610 67 50       161 . " exceeds Excel's limit of 255";
3611 0         0 return -3;
3612             }
3613 0         0  
3614             # Check that the input list don't exceed the maximum length.
3615             if ( $param->{validate} eq 'list' ) {
3616 67         129  
3617             if ( ref $param->{value} eq 'ARRAY' ) {
3618              
3619             my $formula = join ',', @{ $param->{value} };
3620             if ( length $formula > 255 ) {
3621 67 100 100     174 carp "Length of list items '$formula' exceeds Excel's "
3622             . "limit of 255, use a formula range instead";
3623 42 50       100 return -3;
3624 0         0 }
3625             }
3626 0         0 }
3627              
3628             # Set some defaults if they haven't been defined by the user.
3629             $param->{ignore_blank} = 1 if !defined $param->{ignore_blank};
3630 25         37 $param->{dropdown} = 1 if !defined $param->{dropdown};
3631             $param->{show_input} = 1 if !defined $param->{show_input};
3632             $param->{show_error} = 1 if !defined $param->{show_error};
3633              
3634              
3635 67         165 # These are the cells to which the validation is applied.
3636             $param->{cells} = [ [ $row1, $col1, $row2, $col2 ] ];
3637              
3638             # A (for now) undocumented parameter to pass additional cell ranges.
3639             if ( exists $param->{other_cells} ) {
3640              
3641             push @{ $param->{cells} }, @{ $param->{other_cells} };
3642 67 100       143 }
    50          
3643 65         101  
3644             # Store the validation information until we close the worksheet.
3645             push @{ $self->{_validations} }, $param;
3646 0         0 }
3647              
3648 0         0  
3649             ###############################################################################
3650             #
3651 2         5 # conditional_formatting($row, $col, {...})
3652             #
3653             # This method handles the interface to Excel conditional formatting.
3654             #
3655             # We allow the format to be called on one cell or a range of cells. The
3656 67 100 100     225 # hashref contains the formatting parameters and must be the last param:
3657 7         23 # conditional_formatting($row, $col, {...})
3658             # conditional_formatting($first_row, $first_col, $last_row, $last_col, {...})
3659 7 100       28 #
3660 5         11 # Returns 0 : normal termination
3661             # -1 : insufficient number of arguments
3662             # -2 : row or column out of range
3663 7 100       18 # -3 : incorrect parameter.
3664 3         8 #
3665              
3666 3 100       9 my $self = shift;
3667 2         6 my $user_range = '';
3668              
3669             # Check for a cell reference in A1 notation and substitute row and column
3670             if ( $_[0] =~ /^\D/ ) {
3671              
3672             # Check for a user defined multiple range like B3:K6,B8:K11.
3673 67 100 100     170 if ( $_[0] =~ /,/ ) {
3674 1         171 $user_range = $_[0];
3675             $user_range =~ s/^=//;
3676 1         13 $user_range =~ s/\s*,\s*/ /g;
3677             $user_range =~ s/\$//g;
3678             }
3679              
3680 66 50 66     149 @_ = $self->_substitute_cellref( @_ );
3681 0         0 }
3682              
3683 0         0 # The final hashref contains the validation parameters.
3684             my $options = pop;
3685              
3686             # Make the last row/col the same as the first if not defined.
3687 66 100 100     154 my ( $row1, $col1, $row2, $col2 ) = @_;
3688 1         182 if ( !defined $row2 ) {
3689             $row2 = $row1;
3690 1         13 $col2 = $col1;
3691             }
3692              
3693             # Check that row and col are valid without storing the values.
3694 65 50 66     136 return -2 if $self->_check_dimensions( $row1, $col1, 1, 1 );
3695 0         0 return -2 if $self->_check_dimensions( $row2, $col2, 1, 1 );
3696              
3697 0         0 # Check that the last parameter is a hash list.
3698             if ( ref $options ne 'HASH' ) {
3699             carp "Last parameter in conditional_formatting() must be a hash ref";
3700             return -3;
3701 65 100       134 }
3702              
3703 13 100       39 # Copy the user params.
3704             my $param = {%$options};
3705 11         21  
  11         39  
3706 11 100       35 # List of valid input parameters.
3707 1         218 my %valid_parameter = (
3708             type => 1,
3709 1         12 format => 1,
3710             criteria => 1,
3711             value => 1,
3712             minimum => 1,
3713             maximum => 1,
3714             stop_if_true => 1,
3715 64 100       158 min_type => 1,
3716 64 100       150 mid_type => 1,
3717 64 100       144 max_type => 1,
3718 64 100       131 min_value => 1,
3719             mid_value => 1,
3720             max_value => 1,
3721             min_color => 1,
3722 64         172 mid_color => 1,
3723             max_color => 1,
3724             bar_color => 1,
3725 64 100       135 bar_negative_color => 1,
3726             bar_negative_color_same => 1,
3727 3         9 bar_solid => 1,
  3         6  
  3         5  
3728             bar_border_color => 1,
3729             bar_negative_border_color => 1,
3730             bar_negative_border_color_same => 1,
3731 64         79 bar_no_border => 1,
  64         504  
3732             bar_direction => 1,
3733             bar_axis_position => 1,
3734             bar_axis_color => 1,
3735             bar_only => 1,
3736             icon_style => 1,
3737             reverse_icons => 1,
3738             icons_only => 1,
3739             icons => 1,
3740             data_bar_2010 => 1,
3741             );
3742              
3743             # Check for valid input parameters.
3744             for my $param_key ( keys %$param ) {
3745             if ( not exists $valid_parameter{$param_key} ) {
3746             carp "Unknown parameter '$param_key' in conditional_formatting()";
3747             return -3;
3748             }
3749             }
3750              
3751             # 'type' is a required parameter.
3752             if ( not exists $param->{type} ) {
3753 149     149 0 1383 carp "Parameter 'type' is required in conditional_formatting()";
3754 149         255 return -3;
3755             }
3756              
3757 149 50       572 # List of valid validation types.
3758             my %valid_type = (
3759             'cell' => 'cellIs',
3760 149 100       439 'date' => 'date',
3761 1         2 'time' => 'time',
3762 1         4 'average' => 'aboveAverage',
3763 1         7 'duplicate' => 'duplicateValues',
3764 1         5 'unique' => 'uniqueValues',
3765             'top' => 'top10',
3766             'bottom' => 'top10',
3767 149         413 'text' => 'text',
3768             'time_period' => 'timePeriod',
3769             'blanks' => 'containsBlanks',
3770             'no_blanks' => 'notContainsBlanks',
3771 149         281 'errors' => 'containsErrors',
3772             'no_errors' => 'notContainsErrors',
3773             '2_color_scale' => '2_color_scale',
3774 149         352 '3_color_scale' => '3_color_scale',
3775 149 100       365 'data_bar' => 'dataBar',
3776 74         140 'formula' => 'expression',
3777 74         111 'icon_set' => 'iconSet',
3778             );
3779              
3780              
3781 149 50       434 # Check for valid validation types.
3782 149 50       394 if ( not exists $valid_type{ lc( $param->{type} ) } ) {
3783             carp "Unknown validation type '$param->{type}' for parameter "
3784             . "'type' in conditional_formatting()";
3785 149 50       521 return -3;
3786 0         0 }
3787 0         0 else {
3788             $param->{direction} = 'bottom' if $param->{type} eq 'bottom';
3789             $param->{type} = $valid_type{ lc( $param->{type} ) };
3790             }
3791 149         633  
3792              
3793             # List of valid criteria types.
3794 149         2015 my %criteria_type = (
3795             'between' => 'between',
3796             'not between' => 'notBetween',
3797             'equal to' => 'equal',
3798             '=' => 'equal',
3799             '==' => 'equal',
3800             'not equal to' => 'notEqual',
3801             '!=' => 'notEqual',
3802             '<>' => 'notEqual',
3803             'greater than' => 'greaterThan',
3804             '>' => 'greaterThan',
3805             'less than' => 'lessThan',
3806             '<' => 'lessThan',
3807             'greater than or equal to' => 'greaterThanOrEqual',
3808             '>=' => 'greaterThanOrEqual',
3809             'less than or equal to' => 'lessThanOrEqual',
3810             '<=' => 'lessThanOrEqual',
3811             'containing' => 'containsText',
3812             'not containing' => 'notContains',
3813             'begins with' => 'beginsWith',
3814             'ends with' => 'endsWith',
3815             'yesterday' => 'yesterday',
3816             'today' => 'today',
3817             'last 7 days' => 'last7Days',
3818             'last week' => 'lastWeek',
3819             'this week' => 'thisWeek',
3820             'next week' => 'nextWeek',
3821             'last month' => 'lastMonth',
3822             'this month' => 'thisMonth',
3823             'next month' => 'nextMonth',
3824             );
3825              
3826             # Check for valid criteria types.
3827             if ( defined $param->{criteria}
3828             && exists $criteria_type{ lc( $param->{criteria} ) } )
3829             {
3830             $param->{criteria} = $criteria_type{ lc( $param->{criteria} ) };
3831 149         485 }
3832 492 50       972  
3833 0         0 # Convert date/times value if required.
3834 0         0 if ( $param->{type} eq 'date' || $param->{type} eq 'time' ) {
3835             $param->{type} = 'cellIs';
3836              
3837             if ( defined $param->{value} && $param->{value} =~ /T/ ) {
3838             my $date_time = $self->convert_date_time( $param->{value} );
3839 149 50       395  
3840 0         0 if ( !defined $date_time ) {
3841 0         0 carp "Invalid date/time value '$param->{value}' "
3842             . "in conditional_formatting()";
3843             return -3;
3844             }
3845 149         1554 else {
3846             $param->{value} = $date_time;
3847             }
3848             }
3849              
3850             if ( defined $param->{minimum} && $param->{minimum} =~ /T/ ) {
3851             my $date_time = $self->convert_date_time( $param->{minimum} );
3852              
3853             if ( !defined $date_time ) {
3854             carp "Invalid date/time value '$param->{minimum}' "
3855             . "in conditional_formatting()";
3856             return -3;
3857             }
3858             else {
3859             $param->{minimum} = $date_time;
3860             }
3861             }
3862              
3863             if ( defined $param->{maximum} && $param->{maximum} =~ /T/ ) {
3864             my $date_time = $self->convert_date_time( $param->{maximum} );
3865              
3866             if ( !defined $date_time ) {
3867             carp "Invalid date/time value '$param->{maximum}' "
3868             . "in conditional_formatting()";
3869 149 50       511 return -3;
3870 0         0 }
3871             else {
3872 0         0 $param->{maximum} = $date_time;
3873             }
3874             }
3875 149 100       389 }
3876 149         375  
3877              
3878             # List of valid icon styles.
3879             my %icon_set_styles = (
3880             "3_arrows" => "3Arrows", # 1
3881 149         1976 "3_flags" => "3Flags", # 2
3882             "3_traffic_lights_rimmed" => "3TrafficLights2", # 3
3883             "3_symbols_circled" => "3Symbols", # 4
3884             "4_arrows" => "4Arrows", # 5
3885             "4_red_to_black" => "4RedToBlack", # 6
3886             "4_traffic_lights" => "4TrafficLights", # 7
3887             "5_arrows_gray" => "5ArrowsGray", # 8
3888             "5_quarters" => "5Quarters", # 9
3889             "3_arrows_gray" => "3ArrowsGray", # 10
3890             "3_traffic_lights" => "3TrafficLights", # 11
3891             "3_signs" => "3Signs", # 12
3892             "3_symbols" => "3Symbols2", # 13
3893             "4_arrows_gray" => "4ArrowsGray", # 14
3894             "4_ratings" => "4Rating", # 15
3895             "5_arrows" => "5Arrows", # 16
3896             "5_ratings" => "5Rating", # 17
3897             );
3898              
3899              
3900             # Set properties for icon sets.
3901             if ( $param->{type} eq 'iconSet' ) {
3902              
3903             if ( !defined $param->{icon_style} ) {
3904             carp "The 'icon_style' parameter must be specified when "
3905             . "'type' == 'icon_set' in conditional_formatting()";
3906             return -3;
3907             }
3908              
3909             # Check for valid icon styles.
3910             if ( not exists $icon_set_styles{ $param->{icon_style} } ) {
3911             carp "Unknown icon style '$param->{icon_style}' for parameter "
3912             . "'icon_style' in conditional_formatting()";
3913             return -3;
3914 149 100 100     574 }
3915             else {
3916             $param->{icon_style} = $icon_set_styles{ $param->{icon_style} };
3917 53         137 }
3918              
3919             # Set the number of icons for the icon style.
3920             $param->{total_icons} = 3;
3921 149 100 66     701 if ( $param->{icon_style} =~ /^4/ ) {
3922 2         4 $param->{total_icons} = 4;
3923             }
3924 2 100 66     10 elsif ( $param->{icon_style} =~ /^5/ ) {
3925 1         4 $param->{total_icons} = 5;
3926             }
3927 1 50       3  
3928 0         0 $param->{icons} =
3929             $self->_set_icon_properties( $param->{total_icons}, $param->{icons} );
3930 0         0 }
3931              
3932              
3933 1         3 # Set the formatting range.
3934             my $range = '';
3935             my $start_cell = ''; # Use for formulas.
3936              
3937 2 100 66     10 # Swap last row/col for first row/col as necessary
3938 1         4 if ( $row1 > $row2 ) {
3939             ( $row1, $row2 ) = ( $row2, $row1 );
3940 1 50       3 }
3941 0         0  
3942             if ( $col1 > $col2 ) {
3943 0         0 ( $col1, $col2 ) = ( $col2, $col1 );
3944             }
3945              
3946 1         3 $range = xl_range( $row1, $row2, $col1, $col2 );
3947             $start_cell = xl_rowcol_to_cell( $row1, $col1 );
3948              
3949             # Override with user defined multiple range if provided.
3950 2 100 66     28 if ( $user_range ) {
3951 1         3 $range = $user_range;
3952             }
3953 1 50       3  
3954 0         0 # Get the dxf format index.
3955             if ( defined $param->{format} && ref $param->{format} ) {
3956 0         0 $param->{format} = $param->{format}->get_dxf_index();
3957             }
3958              
3959 1         33 # Set the priority based on the order of adding.
3960             $param->{priority} = $self->{_dxf_priority}++;
3961              
3962             # Check for 2010 style data_bar parameters.
3963             if ( $self->{_use_data_bars_2010}
3964             || $param->{data_bar_2010}
3965             || $param->{bar_solid}
3966 149         1413 || $param->{bar_border_color}
3967             || $param->{bar_negative_color}
3968             || $param->{bar_negative_color_same}
3969             || $param->{bar_negative_border_color}
3970             || $param->{bar_negative_border_color_same}
3971             || $param->{bar_no_border}
3972             || $param->{bar_axis_position}
3973             || $param->{bar_axis_color}
3974             || $param->{bar_direction} )
3975             {
3976             $param->{_is_data_bar_2010} = 1;
3977             }
3978              
3979             # Special handling of text criteria.
3980             if ( $param->{type} eq 'text' ) {
3981              
3982             if ( $param->{criteria} eq 'containsText' ) {
3983             $param->{type} = 'containsText';
3984             $param->{formula} = sprintf 'NOT(ISERROR(SEARCH("%s",%s)))',
3985             $param->{value}, $start_cell;
3986             }
3987             elsif ( $param->{criteria} eq 'notContains' ) {
3988 149 100       411 $param->{type} = 'notContainsText';
3989             $param->{formula} = sprintf 'ISERROR(SEARCH("%s",%s))',
3990 37 50       76 $param->{value}, $start_cell;
3991 0         0 }
3992             elsif ( $param->{criteria} eq 'beginsWith' ) {
3993 0         0 $param->{type} = 'beginsWith';
3994             $param->{formula} = sprintf 'LEFT(%s,%d)="%s"',
3995             $start_cell, length( $param->{value} ), $param->{value};
3996             }
3997 37 50       71 elsif ( $param->{criteria} eq 'endsWith' ) {
3998 0         0 $param->{type} = 'endsWith';
3999             $param->{formula} = sprintf 'RIGHT(%s,%d)="%s"',
4000 0         0 $start_cell, length( $param->{value} ), $param->{value};
4001             }
4002             else {
4003 37         62 carp "Invalid text criteria '$param->{criteria}' "
4004             . "in conditional_formatting()";
4005             }
4006             }
4007 37         58  
4008 37 100       131 # Special handling of time time_period criteria.
    100          
4009 11         20 if ( $param->{type} eq 'timePeriod' ) {
4010              
4011             if ( $param->{criteria} eq 'yesterday' ) {
4012 8         15 $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()-1', $start_cell;
4013             }
4014             elsif ( $param->{criteria} eq 'today' ) {
4015             $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()', $start_cell;
4016 37         105 }
4017             elsif ( $param->{criteria} eq 'tomorrow' ) {
4018             $param->{formula} = sprintf 'FLOOR(%s,1)=TODAY()+1', $start_cell;
4019             }
4020             elsif ( $param->{criteria} eq 'last7Days' ) {
4021 149         294 $param->{formula} =
4022 149         232 sprintf 'AND(TODAY()-FLOOR(%s,1)<=6,FLOOR(%s,1)<=TODAY())',
4023             $start_cell, $start_cell;
4024             }
4025 149 50       334 elsif ( $param->{criteria} eq 'lastWeek' ) {
4026 0         0 $param->{formula} =
4027             sprintf 'AND(TODAY()-ROUNDDOWN(%s,0)>=(WEEKDAY(TODAY())),'
4028             . 'TODAY()-ROUNDDOWN(%s,0)<(WEEKDAY(TODAY())+7))',
4029 149 50       357 $start_cell, $start_cell;
4030 0         0 }
4031             elsif ( $param->{criteria} eq 'thisWeek' ) {
4032             $param->{formula} =
4033 149         561 sprintf 'AND(TODAY()-ROUNDDOWN(%s,0)<=WEEKDAY(TODAY())-1,'
4034 149         381 . 'ROUNDDOWN(%s,0)-TODAY()<=7-WEEKDAY(TODAY()))',
4035             $start_cell, $start_cell;
4036             }
4037 149 100       354 elsif ( $param->{criteria} eq 'nextWeek' ) {
4038 1         2 $param->{formula} =
4039             sprintf 'AND(ROUNDDOWN(%s,0)-TODAY()>(7-WEEKDAY(TODAY())),'
4040             . 'ROUNDDOWN(%s,0)-TODAY()<(15-WEEKDAY(TODAY())))',
4041             $start_cell, $start_cell;
4042 149 100 66     570 }
4043 27         134 elsif ( $param->{criteria} eq 'lastMonth' ) {
4044             $param->{formula} =
4045             sprintf
4046             'AND(MONTH(%s)=MONTH(TODAY())-1,OR(YEAR(%s)=YEAR(TODAY()),'
4047 149         347 . 'AND(MONTH(%s)=1,YEAR(A1)=YEAR(TODAY())-1)))',
4048             $start_cell, $start_cell, $start_cell;
4049             }
4050 149 100 100     2439 elsif ( $param->{criteria} eq 'thisMonth' ) {
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
4051             $param->{formula} =
4052             sprintf 'AND(MONTH(%s)=MONTH(TODAY()),YEAR(%s)=YEAR(TODAY()))',
4053             $start_cell, $start_cell;
4054             }
4055             elsif ( $param->{criteria} eq 'nextMonth' ) {
4056             $param->{formula} =
4057             sprintf
4058             'AND(MONTH(%s)=MONTH(TODAY())+1,OR(YEAR(%s)=YEAR(TODAY()),'
4059             . 'AND(MONTH(%s)=12,YEAR(%s)=YEAR(TODAY())+1)))',
4060             $start_cell, $start_cell, $start_cell, $start_cell;
4061             }
4062             else {
4063 25         46 carp "Invalid time_period criteria '$param->{criteria}' "
4064             . "in conditional_formatting()";
4065             }
4066             }
4067 149 100       427  
4068              
4069 8 100       28 # Special handling of blanks/error types.
    100          
    100          
    50          
4070 1         2 if ( $param->{type} eq 'containsBlanks' ) {
4071             $param->{formula} = sprintf 'LEN(TRIM(%s))=0', $start_cell;
4072 1         5 }
4073              
4074             if ( $param->{type} eq 'notContainsBlanks' ) {
4075 1         3 $param->{formula} = sprintf 'LEN(TRIM(%s))>0', $start_cell;
4076             }
4077 1         4  
4078             if ( $param->{type} eq 'containsErrors' ) {
4079             $param->{formula} = sprintf 'ISERROR(%s)', $start_cell;
4080 3         7 }
4081              
4082 3         14 if ( $param->{type} eq 'notContainsErrors' ) {
4083             $param->{formula} = sprintf 'NOT(ISERROR(%s))', $start_cell;
4084             }
4085 3         13  
4086              
4087 3         14 # Special handling for 2 color scale.
4088             if ( $param->{type} eq '2_color_scale' ) {
4089             $param->{type} = 'colorScale';
4090 0         0  
4091             # Color scales don't use any additional formatting.
4092             $param->{format} = undef;
4093              
4094             # Turn off 3 color parameters.
4095             $param->{mid_type} = undef;
4096 149 100       360 $param->{mid_color} = undef;
4097              
4098 10 100       47 $param->{min_type} ||= 'min';
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
4099 1         5 $param->{max_type} ||= 'max';
4100             $param->{min_value} ||= 0;
4101             $param->{max_value} ||= 0;
4102 1         5 $param->{min_color} ||= '#FF7128';
4103             $param->{max_color} ||= '#FFEF9C';
4104              
4105 1         5 $param->{max_color} = $self->_get_palette_color( $param->{max_color} );
4106             $param->{min_color} = $self->_get_palette_color( $param->{min_color} );
4107             }
4108              
4109 1         5  
4110             # Special handling for 3 color scale.
4111             if ( $param->{type} eq '3_color_scale' ) {
4112             $param->{type} = 'colorScale';
4113              
4114 1         5 # Color scales don't use any additional formatting.
4115             $param->{format} = undef;
4116              
4117             $param->{min_type} ||= 'min';
4118             $param->{mid_type} ||= 'percentile';
4119             $param->{max_type} ||= 'max';
4120 1         6 $param->{min_value} ||= 0;
4121             $param->{mid_value} = 50 unless defined $param->{mid_value};
4122             $param->{max_value} ||= 0;
4123             $param->{min_color} ||= '#F8696B';
4124             $param->{mid_color} ||= '#FFEB84';
4125             $param->{max_color} ||= '#63BE7B';
4126 1         4  
4127             $param->{max_color} = $self->_get_palette_color( $param->{max_color} );
4128             $param->{mid_color} = $self->_get_palette_color( $param->{mid_color} );
4129             $param->{min_color} = $self->_get_palette_color( $param->{min_color} );
4130             }
4131              
4132 1         6  
4133             # Special handling for data bar.
4134             if ( $param->{type} eq 'dataBar' ) {
4135              
4136             # Excel 2007 data bars don't use any additional formatting.
4137             $param->{format} = undef;
4138              
4139 1         4 if ( !defined $param->{min_type} ) {
4140             $param->{min_type} = 'min';
4141             $param->{_x14_min_type} = 'autoMin';
4142             }
4143             else {
4144 1         5 $param->{_x14_min_type} = $param->{min_type};
4145             }
4146              
4147             if ( !defined $param->{max_type} ) {
4148             $param->{max_type} = 'max';
4149             $param->{_x14_max_type} = 'autoMax';
4150 0         0 }
4151             else {
4152             $param->{_x14_max_type} = $param->{max_type};
4153             }
4154              
4155             $param->{min_value} ||= 0;
4156             $param->{max_value} ||= 0;
4157 149 100       361 $param->{bar_color} ||= '#638EC6';
4158 1         13 $param->{bar_border_color} ||= $param->{bar_color};
4159             $param->{bar_only} ||= 0;
4160             $param->{bar_no_border} ||= 0;
4161 149 100       359 $param->{bar_solid} ||= 0;
4162 1         5 $param->{bar_direction} ||= '';
4163             $param->{bar_negative_color} ||= '#FF0000';
4164             $param->{bar_negative_border_color} ||= '#FF0000';
4165 149 100       340 $param->{bar_negative_color_same} ||= 0;
4166 1         3 $param->{bar_negative_border_color_same} ||= 0;
4167             $param->{bar_axis_position} ||= '';
4168             $param->{bar_axis_color} ||= '#000000';
4169 149 100       345  
4170 1         4 $param->{bar_color} =
4171             $self->_get_palette_color( $param->{bar_color} );
4172              
4173             $param->{bar_border_color} =
4174             $self->_get_palette_color( $param->{bar_border_color} );
4175 149 100       351  
4176 1         3 $param->{bar_negative_color} =
4177             $self->_get_palette_color( $param->{bar_negative_color} );
4178              
4179 1         1 $param->{bar_negative_border_color} =
4180             $self->_get_palette_color( $param->{bar_negative_border_color} );
4181              
4182 1         3 $param->{bar_axis_color} =
4183 1         2 $self->_get_palette_color( $param->{bar_axis_color} );
4184              
4185 1   50     5 }
4186 1   50     4  
4187 1   50     6 # Adjust for 2010 style data_bar parameters.
4188 1   50     4 if ( $param->{_is_data_bar_2010} ) {
4189 1   50     5  
4190 1   50     5 $self->{_excel_version} = 2010;
4191              
4192 1         4 if ( $param->{min_type} eq 'min' && $param->{min_value} == 0 ) {
4193 1         9 $param->{min_value} = undef;
4194             }
4195              
4196             if ( $param->{max_type} eq 'max' && $param->{max_value} == 0 ) {
4197             $param->{max_value} = undef;
4198 149 100       385 }
4199 4         12  
4200             # Store range for Excel 2010 data bars.
4201             $param->{_range} = $range;
4202 4         7 }
4203              
4204 4   100     18 # Strip the leading = from formulas.
4205 4   100     18 $param->{min_value} =~ s/^=// if defined $param->{min_value};
4206 4   100     22 $param->{mid_value} =~ s/^=// if defined $param->{mid_value};
4207 4   100     15 $param->{max_value} =~ s/^=// if defined $param->{max_value};
4208 4 100       15  
4209 4   100     21 # Store the validation information until we close the worksheet.
4210 4   100     18 push @{ $self->{_cond_formats}->{$range} }, $param;
4211 4   100     15 }
4212 4   100     19  
4213              
4214 4         20 ###############################################################################
4215 4         13 #
4216 4         15 # Set the sub-properties for icons.
4217             #
4218              
4219             my $self = shift;
4220             my $total_icons = shift;
4221 149 100       364 my $user_props = shift;
4222             my $props = [];
4223              
4224 29         59 # Set the default icon properties.
4225             for ( 0 .. $total_icons - 1 ) {
4226 29 100       95 push @$props,
4227 22         53 {
4228 22         63 criteria => 0,
4229             value => 0,
4230             type => 'percent'
4231 7         16 };
4232             }
4233              
4234 29 100       84 # Set the default icon values based on the number of icons.
4235 23         52 if ( $total_icons == 3 ) {
4236 23         48 $props->[0]->{value} = 67;
4237             $props->[1]->{value} = 33;
4238             }
4239 6         10  
4240             if ( $total_icons == 4 ) {
4241             $props->[0]->{value} = 75;
4242 29   100     119 $props->[1]->{value} = 50;
4243 29   100     111 $props->[2]->{value} = 25;
4244 29   100     95 }
4245 29   66     138  
4246 29   100     112 if ( $total_icons == 5 ) {
4247 29   100     146 $props->[0]->{value} = 80;
4248 29   100     172 $props->[1]->{value} = 60;
4249 29   100     115 $props->[2]->{value} = 40;
4250 29   100     121 $props->[3]->{value} = 20;
4251 29   100     126 }
4252 29   100     122  
4253 29   100     116 # Overwrite default properties with user defined properties.
4254 29   100     112 if ( defined $user_props ) {
4255 29   100     110  
4256             # Ensure we don't set user properties for lowest icon.
4257             my $max_data = @$user_props;
4258 29         95 if ( $max_data >= $total_icons ) {
4259             $max_data = $total_icons -1;
4260             }
4261 29         76  
4262             for my $i ( 0 .. $max_data - 1 ) {
4263              
4264 29         74 # Set the user defined 'value' property.
4265             if ( defined $user_props->[$i]->{value} ) {
4266             $props->[$i]->{value} = $user_props->[$i]->{value};
4267 29         83 $props->[$i]->{value} =~ s/^=//;
4268             }
4269              
4270 29         82 # Set the user defined 'type' property.
4271             if ( defined $user_props->[$i]->{type} ) {
4272              
4273             my $type = $user_props->[$i]->{type};
4274              
4275 149 100       349 if ( $type ne 'percent'
4276             && $type ne 'percentile'
4277 25         51 && $type ne 'number'
4278             && $type ne 'formula' )
4279 25 100 66     154 {
4280 20         39 carp "Unknown icon property type '$props->{type}' for sub-"
4281             . "property 'type' in conditional_formatting()";
4282             }
4283 25 100 66     105 else {
4284 21         57 $props->[$i]->{type} = $type;
4285              
4286             if ( $props->[$i]->{type} eq 'number' ) {
4287             $props->[$i]->{type} = 'num';
4288 25         54 }
4289             }
4290             }
4291              
4292 149 100       362 # Set the user defined 'criteria' property.
4293 149 100       336 if ( defined $user_props->[$i]->{criteria}
4294 149 100       341 && $user_props->[$i]->{criteria} eq '>' )
4295             {
4296             $props->[$i]->{criteria} = 1;
4297 149         266 }
  149         1953  
4298              
4299             }
4300              
4301             }
4302              
4303             return $props;
4304             }
4305              
4306              
4307 37     37   54 ###############################################################################
4308 37         48 #
4309 37         58 # add_table()
4310 37         63 #
4311             # Add an Excel table to a worksheet.
4312             #
4313 37         96  
4314 138         319 my $self = shift;
4315             my $user_range = '';
4316             my %table;
4317             my @col_formats;
4318              
4319             # We would need to order the write statements very carefully within this
4320             # function to support optimisation mode. Disable add_table() when it is
4321             # on for now.
4322             if ( $self->{_optimization} == 1 ) {
4323 37 100       70 carp "add_table() isn't supported when set_optimization() is on";
4324 18         39 return -1;
4325 18         50 }
4326              
4327             # Check for a cell reference in A1 notation and substitute row and column
4328 37 100       70 if ( @_ && $_[0] =~ /^\D/ ) {
4329 11         18 @_ = $self->_substitute_cellref( @_ );
4330 11         23 }
4331 11         18  
4332             # Check for a valid number of args.
4333             if ( @_ < 4 ) {
4334 37 100       70 carp "Not enough parameters to add_table()";
4335 8         18 return -1;
4336 8         15 }
4337 8         13  
4338 8         16 my ( $row1, $col1, $row2, $col2 ) = @_;
4339              
4340             # Check that row and col are valid without storing the values.
4341             return -2 if $self->_check_dimensions( $row1, $col1, 1, 1 );
4342 37 100       82 return -2 if $self->_check_dimensions( $row2, $col2, 1, 1 );
4343              
4344             # Swap last row/col for first row/col as necessary.
4345 13         22 if ( $row1 > $row2 ) {
4346 13 100       25 ( $row1, $row2 ) = ( $row2, $row1 );
4347 2         4 }
4348              
4349             if ( $col1 > $col2 ) {
4350 13         26 ( $col1, $col2 ) = ( $col2, $col1 );
4351             }
4352              
4353 30 100       55 # The final hashref contains the validation parameters.
4354 24         36 my $param = $_[4] || {};
4355 24         48  
4356             # Check that the last parameter is a hash list.
4357             if ( ref $param ne 'HASH' ) {
4358             carp "Last parameter '$param' in add_table() must be a hash ref";
4359 30 100       53 return -3;
4360             }
4361 14         19  
4362              
4363 14 50 100     77 # List of valid input parameters.
      100        
      66        
4364             my %valid_parameter = (
4365             autofilter => 1,
4366             banded_columns => 1,
4367             banded_rows => 1,
4368 0         0 columns => 1,
4369             data => 1,
4370             first_column => 1,
4371             header_row => 1,
4372 14         21 last_column => 1,
4373             name => 1,
4374 14 100       29 style => 1,
4375 2         5 total_row => 1,
4376             );
4377              
4378             # Check for valid input parameters.
4379             for my $param_key ( keys %$param ) {
4380             if ( not exists $valid_parameter{$param_key} ) {
4381 30 100 100     87 carp "Unknown parameter '$param_key' in add_table()";
4382             return -3;
4383             }
4384 7         11 }
4385              
4386             # Turn on Excel's defaults.
4387             $param->{banded_rows} = 1 if !defined $param->{banded_rows};
4388             $param->{header_row} = 1 if !defined $param->{header_row};
4389             $param->{autofilter} = 1 if !defined $param->{autofilter};
4390              
4391 37         84 # Check that there are enough rows.
4392             my $num_rows = $row2 - $row1;
4393             $num_rows -= 1 if $param->{header_row};
4394              
4395             if ( $num_rows < 0 ) {
4396             carp "Must have at least one data row in in add_table()";
4397             return -3;
4398             }
4399              
4400             # Set the table options.
4401             $table{_show_first_col} = $param->{first_column} ? 1 : 0;
4402             $table{_show_last_col} = $param->{last_column} ? 1 : 0;
4403 52     52 0 435 $table{_show_row_stripes} = $param->{banded_rows} ? 1 : 0;
4404 52         102 $table{_show_col_stripes} = $param->{banded_columns} ? 1 : 0;
4405 52         99 $table{_header_row_count} = $param->{header_row} ? 1 : 0;
4406             $table{_totals_row_shown} = $param->{total_row} ? 1 : 0;
4407              
4408              
4409             # Set the table name.
4410             if ( defined $param->{name} ) {
4411 52 50       201 my $name = $param->{name};
4412 0         0  
4413 0         0 # Warn if the name contains invalid chars as defined by Excel help.
4414             if ( $name !~ m/^[\w\\][\w\\.]*$/ || $name =~ m/^\d/ ) {
4415             carp "Invalid character in name '$name' used in add_table()";
4416             return -3;
4417 52 50 33     410 }
4418 52         180  
4419             # Warn if the name looks like a cell name.
4420             if ( $name =~ m/^[a-zA-Z][a-zA-Z]?[a-dA-D]?[0-9]+$/ ) {
4421             carp "Invalid name '$name' looks like a cell name in add_table()";
4422 52 50       185 return -3;
4423 0         0 }
4424 0         0  
4425             # Warn if the name looks like a R1C1.
4426             if ( $name =~ m/^[rcRC]$/ || $name =~ m/^[rcRC]\d+[rcRC]\d+$/ ) {
4427 52         141 carp "Invalid name '$name' like a RC cell ref in add_table()";
4428             return -3;
4429             }
4430 52 50       175  
4431 52 50       163 $table{_name} = $param->{name};
4432             }
4433              
4434 52 50       185 # Set the table style.
4435 0         0 if ( defined $param->{style} ) {
4436             $table{_style} = $param->{style};
4437              
4438 52 50       144 # Remove whitespace from style name.
4439 0         0 $table{_style} =~ s/\s//g;
4440             }
4441             else {
4442             $table{_style} = "TableStyleMedium9";
4443 52   100     182 }
4444              
4445              
4446 52 50       173 # Set the data range rows (without the header and footer).
4447 0         0 my $first_data_row = $row1;
4448 0         0 my $last_data_row = $row2;
4449             $first_data_row++ if $param->{header_row};
4450             $last_data_row-- if $param->{total_row};
4451              
4452              
4453 52         450 # Set the table and autofilter ranges.
4454             $table{_range} = xl_range( $row1, $row2, $col1, $col2 );
4455             $table{_a_range} = xl_range( $row1, $last_data_row, $col1, $col2 );
4456              
4457              
4458             # If the header row if off the default is to turn autofilter off.
4459             if ( !$param->{header_row} ) {
4460             $param->{autofilter} = 0;
4461             }
4462              
4463             # Set the autofilter range.
4464             if ( $param->{autofilter} ) {
4465             $table{_autofilter} = $table{_a_range};
4466             }
4467              
4468 52         201 # Add the table columns.
4469 46 50       157 my %seen_names;
4470 0         0 my $col_id = 1;
4471 0         0 for my $col_num ( $col1 .. $col2 ) {
4472              
4473             # Set up the default column data.
4474             my $col_data = {
4475             _id => $col_id,
4476 52 100       194 _name => 'Column' . $col_id,
4477 52 100       151 _total_string => '',
4478 52 100       172 _total_function => '',
4479             _formula => '',
4480             _format => undef,
4481 52         97 _name_format => undef,
4482 52 100       149 };
4483              
4484 52 100       137 # Overwrite the defaults with any use defined values.
4485 2         327 if ( $param->{columns} ) {
4486 2         35  
4487             # Check if there are user defined values for this column.
4488             if ( my $user_data = $param->{columns}->[ $col_id - 1 ] ) {
4489              
4490 50 100       150 # Map user defined values to internal values.
4491 50 100       139 $col_data->{_name} = $user_data->{header}
4492 50 100       153 if $user_data->{header};
4493 50 100       136  
4494 50 100       144 # Excel requires unique case insensitive header names.
4495 50 100       144 my $name = $col_data->{_name};
4496             my $key = lc $name;
4497             if (exists $seen_names{$key}) {
4498             carp "add_table() contains duplicate name: '$name'";
4499 50 100       171 return -1;
4500 1         2 }
4501             else {
4502             $seen_names{$key} = 1;
4503 1 50 33     8 }
4504 0         0  
4505 0         0 # Get the header format if defined.
4506             $col_data->{_name_format} = $user_data->{header_format};
4507              
4508             # Handle the column formula.
4509 1 50       4 if ( $user_data->{formula} ) {
4510 0         0 my $formula = $user_data->{formula};
4511 0         0  
4512             # Remove the leading = from formula.
4513             $formula =~ s/^=//;
4514              
4515 1 50 33     10 # Covert Excel 2010 "@" ref to 2007 "#This Row".
4516 0         0 $formula =~ s/@/[#This Row],/g;
4517 0         0  
4518             $col_data->{_formula} = $formula;
4519              
4520 1         3 for my $row ( $first_data_row .. $last_data_row ) {
4521             $self->write_formula( $row, $col_num, $formula,
4522             $user_data->{format} );
4523             }
4524 50 100       134 }
4525 3         7  
4526             # Handle the function for the total row.
4527             if ( $user_data->{total_function} ) {
4528 3         15 my $function = $user_data->{total_function};
4529              
4530             # Massage the function name.
4531 47         105 $function = lc $function;
4532             $function =~ s/_//g;
4533             $function =~ s/\s//g;
4534              
4535             $function = 'countNums' if $function eq 'countnums';
4536 50         89 $function = 'stdDev' if $function eq 'stddev';
4537 50         87  
4538 50 100       136 $col_data->{_total_function} = $function;
4539 50 100       127  
4540             my $formula = _table_function_to_formula(
4541             $function,
4542             $col_data->{_name}
4543 50         233  
4544 50         157 );
4545              
4546             my $value = $user_data->{total_value} || 0;
4547              
4548 50 100       172 $self->write_formula( $row2, $col_num, $formula,
4549 4         9 $user_data->{format}, $value );
4550              
4551             }
4552             elsif ( $user_data->{total_string} ) {
4553 50 100       149  
4554 45         112 # Total label only (not a function).
4555             my $total_string = $user_data->{total_string};
4556             $col_data->{_total_string} = $total_string;
4557              
4558 50         88 $self->write_string( $row2, $col_num, $total_string,
4559 50         85 $user_data->{format} );
4560 50         134 }
4561              
4562             # Get the dxf format index.
4563 216         1420 if ( defined $user_data->{format} && ref $user_data->{format} )
4564             {
4565             $col_data->{_format} =
4566             $user_data->{format}->get_dxf_index();
4567             }
4568              
4569             # Store the column format for writing the cell data.
4570             # It doesn't matter if it is undefined.
4571             $col_formats[ $col_id - 1 ] = $user_data->{format};
4572             }
4573             }
4574 216 100       508  
4575             # Store the column data.
4576             push @{ $table{_columns} }, $col_data;
4577 85 100       199  
4578             # Write the column headers to the worksheet.
4579             if ( $param->{header_row} ) {
4580             $self->write_string( $row1, $col_num, $col_data->{_name},
4581 84 100       176 $col_data->{_name_format} );
4582             }
4583              
4584 84         116 $col_id++;
4585 84         128 } # Table columns.
4586 84 100       507  
4587 1         190  
4588 1         36 # Write the cell data if supplied.
4589             if ( my $data = $param->{data} ) {
4590              
4591 83         186 my $i = 0; # For indexing the row data.
4592             for my $row ( $first_data_row .. $last_data_row ) {
4593             my $j = 0; # For indexing the col data.
4594              
4595 83         113 for my $col ( $col1 .. $col2 ) {
4596              
4597             my $token = $data->[$i]->[$j];
4598 83 100       183  
4599 3         5 if ( defined $token ) {
4600             $self->write( $row, $col, $token, $col_formats[$j] );
4601             }
4602 3         10  
4603             $j++;
4604             }
4605 3         7 $i++;
4606             }
4607 3         6 }
4608              
4609 3         10  
4610             # Store the table data.
4611 24         42 push @{ $self->{_tables} }, \%table;
4612              
4613             return \%table;
4614             }
4615              
4616 83 100       219  
    100          
4617 40         68 ###############################################################################
4618             #
4619             # add_sparkline()
4620 40         61 #
4621 40         75 # Add sparklines to the worksheet.
4622 40         83 #
4623              
4624 40 100       77 my $self = shift;
4625 40 100       70 my $param = shift;
4626             my $sparkline = {};
4627 40         68  
4628             # Check that the last parameter is a hash list.
4629             if ( ref $param ne 'HASH' ) {
4630             carp "Parameter list in add_sparkline() must be a hash ref";
4631             return -1;
4632             }
4633 40         97  
4634             # List of valid input parameters.
4635 40   100     126 my %valid_parameter = (
4636             location => 1,
4637             range => 1,
4638 40         125 type => 1,
4639             high_point => 1,
4640             low_point => 1,
4641             negative_points => 1,
4642             first_point => 1,
4643             last_point => 1,
4644 9         24 markers => 1,
4645 9         26 style => 1,
4646             series_color => 1,
4647             negative_color => 1,
4648 9         50 markers_color => 1,
4649             first_color => 1,
4650             last_color => 1,
4651             high_color => 1,
4652 83 100 66     246 low_color => 1,
4653             max => 1,
4654             min => 1,
4655 9         36 axis => 1,
4656             reverse => 1,
4657             empty_cells => 1,
4658             show_hidden => 1,
4659             plot_hidden => 1,
4660 83         174 date_axis => 1,
4661             weight => 1,
4662             );
4663              
4664             # Check for valid input parameters.
4665 215         324 for my $param_key ( keys %$param ) {
  215         468  
4666             if ( not exists $valid_parameter{$param_key} ) {
4667             carp "Unknown parameter '$param_key' in add_sparkline()";
4668 215 100       432 return -2;
4669             }
4670 203         468 }
4671              
4672             # 'location' is a required parameter.
4673 215         373 if ( not exists $param->{location} ) {
4674             carp "Parameter 'location' is required in add_sparkline()";
4675             return -3;
4676             }
4677              
4678 49 100       170 # 'range' is a required parameter.
4679             if ( not exists $param->{range} ) {
4680 6         17 carp "Parameter 'range' is required in add_sparkline()";
4681 6         25 return -3;
4682 22         30 }
4683              
4684 22         38  
4685             # Handle the sparkline type.
4686 84         193 my $type = $param->{type} || 'line';
4687              
4688 84 100       142 if ( $type ne 'line' && $type ne 'column' && $type ne 'win_loss' ) {
4689 77         153 carp "Parameter 'type' must be 'line', 'column' "
4690             . "or 'win_loss' in add_sparkline()";
4691             return -4;
4692 84         130 }
4693              
4694 22         45 $type = 'stacked' if $type eq 'win_loss';
4695             $sparkline->{_type} = $type;
4696              
4697              
4698             # We handle single location/range values or array refs of values.
4699             if ( ref $param->{location} ) {
4700 49         95 $sparkline->{_locations} = $param->{location};
  49         131  
4701             $sparkline->{_ranges} = $param->{range};
4702 49         287 }
4703             else {
4704             $sparkline->{_locations} = [ $param->{location} ];
4705             $sparkline->{_ranges} = [ $param->{range} ];
4706             }
4707              
4708             my $range_count = @{ $sparkline->{_ranges} };
4709             my $location_count = @{ $sparkline->{_locations} };
4710              
4711             # The ranges and locations must match.
4712             if ( $range_count != $location_count ) {
4713             carp "Must have the same number of location and range "
4714 58     58 0 786 . "parameters in add_sparkline()";
4715 58         82 return -5;
4716 58         93 }
4717              
4718             # Store the count.
4719 58 50       150 $sparkline->{_count} = @{ $sparkline->{_locations} };
4720 0         0  
4721 0         0 # Get the worksheet name for the range conversion below.
4722             my $sheetname = quote_sheetname( $self->{_name} );
4723              
4724             # Cleanup the input ranges.
4725 58         718 for my $range ( @{ $sparkline->{_ranges} } ) {
4726              
4727             # Remove the absolute reference $ symbols.
4728             $range =~ s{\$}{}g;
4729              
4730             # Remove the = from xl_range_formula(.
4731             $range =~ s{^=}{};
4732              
4733             # Convert a simple range into a full Sheet1!A1:D1 range.
4734             if ( $range !~ /!/ ) {
4735             $range = $sheetname . "!" . $range;
4736             }
4737             }
4738              
4739             # Cleanup the input locations.
4740             for my $location ( @{ $sparkline->{_locations} } ) {
4741             $location =~ s{\$}{}g;
4742             }
4743              
4744             # Map options.
4745             $sparkline->{_high} = $param->{high_point};
4746             $sparkline->{_low} = $param->{low_point};
4747             $sparkline->{_negative} = $param->{negative_points};
4748             $sparkline->{_first} = $param->{first_point};
4749             $sparkline->{_last} = $param->{last_point};
4750             $sparkline->{_markers} = $param->{markers};
4751             $sparkline->{_min} = $param->{min};
4752             $sparkline->{_max} = $param->{max};
4753             $sparkline->{_axis} = $param->{axis};
4754             $sparkline->{_reverse} = $param->{reverse};
4755 58         208 $sparkline->{_hidden} = $param->{show_hidden};
4756 212 50       372 $sparkline->{_weight} = $param->{weight};
4757 0         0  
4758 0         0 # Map empty cells options.
4759             my $empty = $param->{empty_cells} || '';
4760              
4761             if ( $empty eq 'zero' ) {
4762             $sparkline->{_empty} = 0;
4763 58 50       126 }
4764 0         0 elsif ( $empty eq 'connect' ) {
4765 0         0 $sparkline->{_empty} = 'span';
4766             }
4767             else {
4768             $sparkline->{_empty} = 'gap';
4769 58 50       436 }
4770 0         0  
4771 0         0  
4772             # Map the date axis range.
4773             my $date_range = $param->{date_axis};
4774              
4775             if ( $date_range && $date_range !~ /!/ ) {
4776 58   100     184 $date_range = $sheetname . "!" . $date_range;
4777             }
4778 58 50 100     162 $sparkline->{_date_axis} = $date_range;
      66        
4779 0         0  
4780              
4781 0         0 # Set the sparkline styles.
4782             my $style_id = $param->{style} || 0;
4783             my $style = $Excel::Writer::XLSX::Package::Theme::spark_styles[$style_id];
4784 58 100       124  
4785 58         111 $sparkline->{_series_color} = $style->{series};
4786             $sparkline->{_negative_color} = $style->{negative};
4787             $sparkline->{_markers_color} = $style->{markers};
4788             $sparkline->{_first_color} = $style->{first};
4789 58 100       122 $sparkline->{_last_color} = $style->{last};
4790 2         5 $sparkline->{_high_color} = $style->{high};
4791 2         5 $sparkline->{_low_color} = $style->{low};
4792              
4793             # Override the style colours with user defined colors.
4794 56         148 $self->_set_spark_color( $sparkline, $param, 'series_color' );
4795 56         127 $self->_set_spark_color( $sparkline, $param, 'negative_color' );
4796             $self->_set_spark_color( $sparkline, $param, 'markers_color' );
4797             $self->_set_spark_color( $sparkline, $param, 'first_color' );
4798 58         81 $self->_set_spark_color( $sparkline, $param, 'last_color' );
  58         160  
4799 58         73 $self->_set_spark_color( $sparkline, $param, 'high_color' );
  58         82  
4800             $self->_set_spark_color( $sparkline, $param, 'low_color' );
4801              
4802 58 50       127 push @{ $self->{_sparklines} }, $sparkline;
4803 0         0 }
4804              
4805 0         0  
4806             ###############################################################################
4807             #
4808             # insert_button()
4809 58         75 #
  58         82  
4810             # Insert a button form object into the worksheet.
4811             #
4812 58         188  
4813             my $self = shift;
4814              
4815 58         92 # Check for a cell reference in A1 notation and substitute row and column
  58         107  
4816             if ( $_[0] =~ /^\D/ ) {
4817             @_ = $self->_substitute_cellref( @_ );
4818 59         123 }
4819              
4820             # Check the number of args.
4821 59         92 if ( @_ < 3 ) { return -1 }
4822              
4823             my $button = $self->_button_params( @_ );
4824 59 100       134  
4825 54         154 push @{ $self->{_buttons_array} }, $button;
4826              
4827             $self->{_has_vml} = 1;
4828             }
4829              
4830 58         85  
  58         103  
4831 59         107 ###############################################################################
4832             #
4833             # set_vba_name()
4834             #
4835 58         106 # Set the VBA name for the worksheet.
4836 58         92 #
4837 58         90  
4838 58         116 my $self = shift;
4839 58         102 my $vba_codename = shift;
4840 58         86  
4841 58         94 if ( $vba_codename ) {
4842 58         111 $self->{_vba_codename} = $vba_codename;
4843 58         133 }
4844 58         98 else {
4845 58         99 $self->{_vba_codename} = "Sheet" . ($self->{_index} + 1);
4846 58         141 }
4847             }
4848              
4849 58   100     187  
4850              
4851 58 100       160 ###############################################################################
    100          
4852 1         3 #
4853             # ignore_errors()
4854             #
4855 1         2 # Ignore worksheet errors/warnings in user defined ranges.
4856             #
4857              
4858 56         196 my $self = shift;
4859             my $ignores = shift;
4860              
4861             # List of valid input parameters.
4862             my %valid_parameter = (
4863 58         88 number_stored_as_text => 1,
4864             eval_error => 1,
4865 58 100 66     225 formula_differs => 1,
4866 1         3 formula_range => 1,
4867             formula_unlocked => 1,
4868 58         148 empty_cell_reference => 1,
4869             list_data_validation => 1,
4870             calculated_column => 1,
4871             two_digit_text_year => 1,
4872 58   100     145 );
4873 58         101  
4874             for my $param_key ( keys %$ignores ) {
4875 58         129 if ( not exists $valid_parameter{$param_key} ) {
4876 58         101 carp "Unknown parameter '$param_key' in ignore_errors()";
4877 58         95 return -3;
4878 58         109 }
4879 58         99 }
4880 58         100  
4881 58         97 $self->{_ignore_errors} = {%$ignores};
4882             }
4883              
4884 58         168  
4885 58         132 ###############################################################################
4886 58         124 #
4887 58         124 # Internal methods.
4888 58         117 #
4889 58         124 ###############################################################################
4890 58         115  
4891              
4892 58         73 ###############################################################################
  58         330  
4893             #
4894             # _table_function_to_formula
4895             #
4896             # Convert a table total function to a worksheet formula.
4897             #
4898              
4899             my $function = shift;
4900             my $col_name = shift;
4901             my $formula = '';
4902              
4903             # Escape special characters, as required by Excel.
4904 28     28 0 286 $col_name =~ s/'/''/g;
4905             $col_name =~ s/#/'#/g;
4906             $col_name =~ s/\[/'[/g;
4907 28 50       132 $col_name =~ s/]/']/g;
4908 28         97  
4909             my %subtotals = (
4910             average => 101,
4911             countNums => 102,
4912 28 50       81 count => 103,
  0         0  
4913             max => 104,
4914 28         102 min => 105,
4915             stdDev => 107,
4916 28         44 sum => 109,
  28         60  
4917             var => 110,
4918 28         79 );
4919              
4920             if ( exists $subtotals{$function} ) {
4921             my $func_num = $subtotals{$function};
4922             $formula = qq{SUBTOTAL($func_num,[$col_name])};
4923             }
4924             else {
4925             carp "Unsupported function '$function' in add_table()";
4926             }
4927              
4928             return $formula;
4929             }
4930 7     7 0 22  
4931 7         14  
4932             ###############################################################################
4933 7 100       18 #
4934 2         10 # _set_spark_color()
4935             #
4936             # Set the sparkline colour.
4937 5         26 #
4938              
4939             my $self = shift;
4940             my $sparkline = shift;
4941             my $param = shift;
4942             my $user_color = shift;
4943             my $spark_color = '_' . $user_color;
4944              
4945             return unless $param->{$user_color};
4946              
4947             $sparkline->{$spark_color} =
4948             { _rgb => $self->_get_palette_color( $param->{$user_color} ) };
4949             }
4950              
4951 5     5 0 31  
4952 5         8 ###############################################################################
4953             #
4954             # _get_palette_color()
4955 5         45 #
4956             # Convert from an Excel internal colour index to a XML style #RRGGBB index
4957             # based on the default or user defined values in the Workbook palette.
4958             #
4959              
4960             my $self = shift;
4961             my $index = shift;
4962             my $palette = $self->{_palette};
4963              
4964             # Handle colours in #XXXXXX RGB format.
4965             if ( $index =~ m/^#([0-9A-F]{6})$/i ) {
4966             return "FF" . uc( $1 );
4967 5         20 }
4968 6 50       21  
4969 0         0 # Adjust the colour index.
4970 0         0 $index -= 8;
4971              
4972             # Palette is passed in from the Workbook class.
4973             my @rgb = @{ $palette->[$index] };
4974 5         25  
4975             return sprintf "FF%02X%02X%02X", @rgb[0, 1, 2];
4976             }
4977              
4978              
4979             ###############################################################################
4980             #
4981             # _substitute_cellref()
4982             #
4983             # Substitute an Excel cell reference in A1 notation for zero based row and
4984             # column values in an argument list.
4985             #
4986             # Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
4987             #
4988              
4989             my $self = shift;
4990             my $cell = uc( shift );
4991              
4992             # Convert a column range: 'A:A' or 'B:G'.
4993 40     40   54 # A range such as A:A is equivalent to A1:Rowmax, so add rows as required
4994 40         58 if ( $cell =~ /\$?([A-Z]{1,3}):\$?([A-Z]{1,3})/ ) {
4995 40         54 my ( $row1, $col1 ) = $self->_cell_to_rowcol( $1 . '1' );
4996             my ( $row2, $col2 ) =
4997             $self->_cell_to_rowcol( $2 . $self->{_xls_rowmax} );
4998 40         60 return $row1, $col1, $row2, $col2, @_;
4999 40         59 }
5000 40         58  
5001 40         51 # Convert a cell range: 'A1:B7'
5002             if ( $cell =~ /\$?([A-Z]{1,3}\$?\d+):\$?([A-Z]{1,3}\$?\d+)/ ) {
5003 40         186 my ( $row1, $col1 ) = $self->_cell_to_rowcol( $1 );
5004             my ( $row2, $col2 ) = $self->_cell_to_rowcol( $2 );
5005             return $row1, $col1, $row2, $col2, @_;
5006             }
5007              
5008             # Convert a cell reference: 'A1' or 'AD2000'
5009             if ( $cell =~ /\$?([A-Z]{1,3}\$?\d+)/ ) {
5010             my ( $row1, $col1 ) = $self->_cell_to_rowcol( $1 );
5011             return $row1, $col1, @_;
5012              
5013             }
5014 40 50       93  
5015 40         59 croak( "Unknown cell reference $cell" );
5016 40         97 }
5017              
5018              
5019 0         0 ###############################################################################
5020             #
5021             # _cell_to_rowcol($cell_ref)
5022 40         108 #
5023             # Convert an Excel cell reference in A1 notation to a zero based row and column
5024             # reference; converts C1 to (0, 2).
5025             #
5026             # See also: http://www.perlmonks.org/index.pl?node_id=270352
5027             #
5028             # Returns: ($row, $col, $row_absolute, $col_absolute)
5029             #
5030             #
5031              
5032             my $self = shift;
5033              
5034 406     406   559 my $cell = $_[0];
5035 406         451 $cell =~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/;
5036 406         428  
5037 406         633 my $col_abs = $1 eq "" ? 0 : 1;
5038 406         536 my $col = $2;
5039             my $row_abs = $3 eq "" ? 0 : 1;
5040 406 100       710 my $row = $4;
5041              
5042             # Convert base26 column string to number
5043 8         18 # All your Base are belong to us.
5044             my @chars = split //, $col;
5045             my $expn = 0;
5046             $col = 0;
5047              
5048             while ( @chars ) {
5049             my $char = pop( @chars ); # LS char first
5050             $col += ( ord( $char ) - ord( 'A' ) + 1 ) * ( 26**$expn );
5051             $expn++;
5052             }
5053              
5054             # Convert 1-index to zero-index
5055             $row--;
5056 173     173   235 $col--;
5057 173         214  
5058 173         227 # TODO Check row and column range
5059             return $row, $col, $row_abs, $col_abs;
5060             }
5061 173 100       516  
5062 167         504  
5063             ###############################################################################
5064             #
5065             # _xl_rowcol_to_cell($row, $col)
5066 6         14 #
5067             # Optimised version of xl_rowcol_to_cell from Utility.pm for the inner loop
5068             # of _write_cell().
5069 6         9 #
  6         19  
5070              
5071 6         40 our @col_names = ( 'A' .. 'XFD' );
5072              
5073             return $col_names[ $_[1] ] . ( $_[0] + 1 );
5074             }
5075              
5076              
5077             ###############################################################################
5078             #
5079             # _sort_pagebreaks()
5080             #
5081             # This is an internal method that is used to filter elements of the array of
5082             # pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
5083             # 1. Removes duplicate entries from the list.
5084             # 2. Sorts the list.
5085             # 3. Removes 0 from the list if present.
5086 2623     2623   4265 #
5087 2623         5431  
5088             my $self = shift;
5089              
5090             return () unless @_;
5091 2623 100       7296  
5092 226         1032 my %hash;
5093             my @array;
5094 226         1163  
5095 226         855 @hash{@_} = undef; # Hash slice to remove duplicates
5096             @array = sort { $a <=> $b } keys %hash; # Numerical sort
5097             shift @array if $array[0] == 0; # Remove zero
5098              
5099 2397 100       6971 # The Excel 2007 specification says that the maximum number of page breaks
5100 200         546 # is 1026. However, in practice it is actually 1023.
5101 200         514 my $max_num_breaks = 1023;
5102 200         816 splice( @array, $max_num_breaks ) if @array > $max_num_breaks;
5103              
5104             return @array;
5105             }
5106 2197 50       8929  
5107 2197         5866  
5108 2197         7851 ###############################################################################
5109             #
5110             # _check_dimensions($row, $col, $ignore_row, $ignore_col)
5111             #
5112 0         0 # Check that $row and $col are valid and store max and min values for use in
5113             # other methods/elements.
5114             #
5115             # The $ignore_row/$ignore_col flags is used to indicate that we wish to
5116             # perform the dimension check without storing the value.
5117             #
5118             # The ignore flags are use by set_row() and data_validate.
5119             #
5120              
5121             my $self = shift;
5122             my $row = $_[0];
5123             my $col = $_[1];
5124             my $ignore_row = $_[2];
5125             my $ignore_col = $_[3];
5126              
5127              
5128             return -2 if not defined $row;
5129             return -2 if $row >= $self->{_xls_rowmax};
5130 3049     3049   4561  
5131             return -2 if not defined $col;
5132 3049         6426 return -2 if $col >= $self->{_xls_colmax};
5133 3049         7888  
5134             # In optimization mode we don't change dimensions for rows that are
5135 3049 50       8184 # already written.
5136 3049         5578 if ( !$ignore_row && !$ignore_col && $self->{_optimization} == 1 ) {
5137 3049 100       7644 return -2 if $row < $self->{_previous_row};
5138 3049         6333 }
5139              
5140             if ( !$ignore_row ) {
5141              
5142 3049         7889 if ( not defined $self->{_dim_rowmin} or $row < $self->{_dim_rowmin} ) {
5143 3049         5420 $self->{_dim_rowmin} = $row;
5144 3049         4847 }
5145              
5146 3049         6994 if ( not defined $self->{_dim_rowmax} or $row > $self->{_dim_rowmax} ) {
5147 3103         5192 $self->{_dim_rowmax} = $row;
5148 3103         7708 }
5149 3103         6315 }
5150              
5151             if ( !$ignore_col ) {
5152              
5153 3049         6375 if ( not defined $self->{_dim_colmin} or $col < $self->{_dim_colmin} ) {
5154 3049         4118 $self->{_dim_colmin} = $col;
5155             }
5156              
5157 3049         8114 if ( not defined $self->{_dim_colmax} or $col > $self->{_dim_colmax} ) {
5158             $self->{_dim_colmax} = $col;
5159             }
5160             }
5161              
5162             return 0;
5163             }
5164              
5165              
5166             ###############################################################################
5167             #
5168             # _position_object_pixels()
5169             #
5170             # Calculate the vertices that define the position of a graphical object within
5171             # the worksheet in pixels.
5172 10691     10691   21491 #
5173             # +------------+------------+
5174             # | A | B |
5175             # +-----+------------+------------+
5176             # | |(x1,y1) | |
5177             # | 1 |(A1)._______|______ |
5178             # | | | | |
5179             # | | | | |
5180             # +-----+----| Object |-----+
5181             # | | | | |
5182             # | 2 | |______________. |
5183             # | | | (B2)|
5184             # | | | (x2,y2)|
5185             # +---- +------------+------------+
5186             #
5187             # Example of an object that covers some of the area from cell A1 to cell B2.
5188 2160     2160   3817 #
5189             # Based on the width and height of the object we need to calculate 8 vars:
5190 2160 100       7016 #
5191             # $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2.
5192 11         68 #
5193             # We also calculate the absolute x and y position of the top left vertex of
5194             # the object. This is required for images.
5195 11         649 #
5196 11         171 # $x_abs, $y_abs
  9049         9614  
5197 11 100       72 #
5198             # The width and height of the cells that the object occupies can be variable
5199             # and have to be taken into account.
5200             #
5201 11         22 # The values of $col_start and $row_start are passed in from the calling
5202 11 100       46 # function. The values of $col_end and $row_end are calculated by subtracting
5203             # the width and height of the object from the width and height of the
5204 11         175 # underlying cells.
5205             #
5206             # The anchor/object position defines how images are scaled for hidden rows and
5207             # columns. For option 1 "Move and size with cells" the size of the hidden
5208             # row/column is subtracted from the image.
5209             #
5210              
5211             my $self = shift;
5212              
5213             my $col_start; # Col containing upper left corner of object.
5214             my $x1; # Distance to left side of object.
5215              
5216             my $row_start; # Row containing top left corner of object.
5217             my $y1; # Distance to top of object.
5218              
5219             my $col_end; # Col containing lower right corner of object.
5220             my $x2; # Distance to right side of object.
5221              
5222 16892     16892   19619 my $row_end; # Row containing bottom right corner of object.
5223 16892         19776 my $y2; # Distance to bottom of object.
5224 16892         18617  
5225 16892         19325 my $width; # Width of object frame.
5226 16892         18403 my $height; # Height of object frame.
5227              
5228             my $x_abs = 0; # Absolute distance to left side of object.
5229 16892 50       25038 my $y_abs = 0; # Absolute distance to top side of object.
5230 16892 100       27974  
5231             my $anchor; # The type of object positioning.
5232 16879 50       24821  
5233 16879 100       25530 ( $col_start, $row_start, $x1, $y1, $width, $height, $anchor ) = @_;
5234              
5235             # Adjust start column for negative offsets.
5236             while ( $x1 < 0 && $col_start > 0) {
5237 16869 100 66     54707 $x1 += $self->_size_col( $col_start - 1);
      100        
5238 318 100       500 $col_start--;
5239             }
5240              
5241 16864 100       27658 # Adjust start row for negative offsets.
5242             while ( $y1 < 0 && $row_start > 0) {
5243 15858 100 100     39601 $y1 += $self->_size_row( $row_start - 1);
5244 859         2640 $row_start--;
5245             }
5246              
5247 15858 100 100     39138 # Ensure that the image isn't shifted off the page at top left.
5248 4799         9140 $x1 = 0 if $x1 < 0;
5249             $y1 = 0 if $y1 < 0;
5250              
5251             # Calculate the absolute x offset of the top-left vertex.
5252 16864 100       24582 if ( $self->{_col_size_changed} ) {
5253             for my $col_id ( 0 .. $col_start -1 ) {
5254 15906 100 100     37195 $x_abs += $self->_size_col( $col_id );
5255 866         2407 }
5256             }
5257             else {
5258 15906 100 100     37101 # Optimisation for when the column widths haven't changed.
5259 2366         3946 $x_abs += $self->{_default_col_pixels} * $col_start;
5260             }
5261              
5262             $x_abs += $x1;
5263 16864         31156  
5264             # Calculate the absolute y offset of the top-left vertex.
5265             # Store the column change to allow optimisations.
5266             if ( $self->{_row_size_changed} ) {
5267             for my $row_id ( 0 .. $row_start -1 ) {
5268             $y_abs += $self->_size_row( $row_id );
5269             }
5270             }
5271             else {
5272             # Optimisation for when the row heights haven't changed.
5273             $y_abs += $self->{_default_row_pixels} * $row_start;
5274             }
5275              
5276             $y_abs += $y1;
5277              
5278             # Adjust start column for offsets that are greater than the col width.
5279             while ( $x1 >= $self->_size_col( $col_start, $anchor ) ) {
5280             $x1 -= $self->_size_col( $col_start );
5281             $col_start++;
5282             }
5283              
5284             # Adjust start row for offsets that are greater than the row height.
5285             while ( $y1 >= $self->_size_row( $row_start, $anchor ) ) {
5286             $y1 -= $self->_size_row( $row_start );
5287             $row_start++;
5288             }
5289              
5290             # Initialise end cell to the same as the start cell.
5291             $col_end = $col_start;
5292             $row_end = $row_start;
5293              
5294             # Only offset the image in the cell if the row/col isn't hidden.
5295             if ($self->_size_col( $col_start, $anchor) > 0 ) {
5296             $width = $width + $x1;
5297             }
5298              
5299             if ( $self->_size_row( $row_start, $anchor ) > 0 ) {
5300             $height = $height + $y1;
5301             }
5302              
5303             # Subtract the underlying cell widths to find the end cell of the object.
5304             while ( $width >= $self->_size_col( $col_end, $anchor ) ) {
5305             $width -= $self->_size_col( $col_end, $anchor );
5306             $col_end++;
5307             }
5308              
5309              
5310             # Subtract the underlying cell heights to find the end cell of the object.
5311             while ( $height >= $self->_size_row( $row_end, $anchor ) ) {
5312             $height -= $self->_size_row( $row_end, $anchor );
5313 4769     4769   6141 $row_end++;
5314             }
5315 4769         27732  
5316             # The end vertices are whatever is left from the width and height.
5317             $x2 = $width;
5318 4769         0 $y2 = $height;
5319 4769         0  
5320             return (
5321 4769         0 $col_start, $row_start, $x1, $y1,
5322 4769         0 $col_end, $row_end, $x2, $y2,
5323             $x_abs, $y_abs
5324 4769         0  
5325 4769         0 );
5326             }
5327 4769         0  
5328 4769         0  
5329             ###############################################################################
5330 4769         5394 #
5331 4769         5478 # _position_object_emus()
5332             #
5333 4769         5596 # Calculate the vertices that define the position of a graphical object within
5334             # the worksheet in EMUs.
5335 4769         7942 #
5336             # The vertices are expressed as English Metric Units (EMUs). There are 12,700
5337             # EMUs per point. Therefore, 12,700 * 3 /4 = 9,525 EMUs per pixel.
5338 4769   100     10135 #
5339 8         25  
5340 8         21 my $self = shift;
5341              
5342             my (
5343             $col_start, $row_start, $x1, $y1,
5344 4769   100     8711 $col_end, $row_end, $x2, $y2,
5345 4         17 $x_abs, $y_abs
5346 4         10  
5347             ) = $self->_position_object_pixels( @_ );
5348              
5349             # Convert the pixel values to EMUs. See above.
5350 4769 100       7418 $x1 = int( 0.5 + 9_525 * $x1 );
5351 4769 100       7303 $y1 = int( 0.5 + 9_525 * $y1 );
5352             $x2 = int( 0.5 + 9_525 * $x2 );
5353             $y2 = int( 0.5 + 9_525 * $y2 );
5354 4769 100       7722 $x_abs = int( 0.5 + 9_525 * $x_abs );
5355 56         211 $y_abs = int( 0.5 + 9_525 * $y_abs );
5356 206         449  
5357             return (
5358             $col_start, $row_start, $x1, $y1,
5359             $col_end, $row_end, $x2, $y2,
5360             $x_abs, $y_abs
5361 4713         6359  
5362             );
5363             }
5364 4769         5423  
5365              
5366             ###############################################################################
5367             #
5368 4769 100       7061 # _position_shape_emus()
5369 24         78 #
5370 140         278 # Calculate the vertices that define the position of a shape object within
5371             # the worksheet in EMUs. Save the vertices with the object.
5372             #
5373             # The vertices are expressed as English Metric Units (EMUs). There are 12,700
5374             # EMUs per point. Therefore, 12,700 * 3 /4 = 9,525 EMUs per pixel.
5375 4745         6122 #
5376              
5377             my $self = shift;
5378 4769         5339 my $shape = shift;
5379              
5380             my (
5381 4769         8867 $col_start, $row_start, $x1, $y1, $col_end,
5382 169         229 $row_end, $x2, $y2, $x_abs, $y_abs
5383 169         221 )
5384             = $self->_position_object_pixels(
5385             $shape->{_column_start},
5386             $shape->{_row_start},
5387 4769         9415 $shape->{_x_offset},
5388 247         285 $shape->{_y_offset},
5389 247         315 $shape->{_width} * $shape->{_scale_x},
5390             $shape->{_height} * $shape->{_scale_y},
5391             $shape->{_drawing}
5392             );
5393 4769         5869  
5394 4769         5343 # Now that x2/y2 have been calculated with a potentially negative
5395             # width/height we use the absolute value and convert to EMUs.
5396             $shape->{_width_emu} = int( abs( $shape->{_width} * 9_525 ) );
5397 4769 50       7508 $shape->{_height_emu} = int( abs( $shape->{_height} * 9_525 ) );
5398 4769         5765  
5399             $shape->{_column_start} = int( $col_start );
5400             $shape->{_row_start} = int( $row_start );
5401 4769 50       8077 $shape->{_column_end} = int( $col_end );
5402 4769         5604 $shape->{_row_end} = int( $row_end );
5403              
5404             # Convert the pixel values to EMUs. See above.
5405             $shape->{_x1} = int( $x1 * 9_525 );
5406 4769         8020 $shape->{_y1} = int( $y1 * 9_525 );
5407 11355         16023 $shape->{_x2} = int( $x2 * 9_525 );
5408 11355         15235 $shape->{_y2} = int( $y2 * 9_525 );
5409             $shape->{_x_abs} = int( $x_abs * 9_525 );
5410             $shape->{_y_abs} = int( $y_abs * 9_525 );
5411             }
5412              
5413 4769         8196 ###############################################################################
5414 22791         29876 #
5415 22791         28748 # _size_col($col)
5416             #
5417             # Convert the width of a cell from user's units to pixels. Excel rounds the
5418             # column width to the nearest pixel. If the width hasn't been set by the user
5419 4769         5871 # we use the default value. A hidden column is treated as having a width of
5420 4769         5206 # zero unless it has the special "object_position" of 4 (size with cells).
5421             #
5422              
5423 4769         10822 my $self = shift;
5424             my $col = shift;
5425             my $anchor = shift || 0;
5426              
5427             my $max_digit_width = 7; # For Calabri 11.
5428             my $padding = 5;
5429             my $pixels;
5430              
5431              
5432             # Look up the cell value to see if it has been changed.
5433             if ( exists $self->{_col_sizes}->{$col} )
5434             {
5435             my $width = $self->{_col_sizes}->{$col}[0];
5436             my $hidden = $self->{_col_sizes}->{$col}[1];
5437              
5438             # Convert to pixels.
5439             if ( $hidden == 1 && $anchor != 4 ) {
5440             $pixels = 0;
5441             }
5442             elsif ( $width < 1 ) {
5443 538     538   1109 $pixels = int( $width * ( $max_digit_width + $padding ) + 0.5 );
5444             }
5445             else {
5446 538         2087 $pixels = int( $width * $max_digit_width + 0.5 ) + $padding;
5447             }
5448             }
5449             else {
5450             $pixels = $self->{_default_col_pixels};
5451             }
5452              
5453 538         1720 return $pixels;
5454 538         1197 }
5455 538         1400  
5456 538         1217 ###############################################################################
5457 538         1170 #
5458 538         1125 # _size_row($row)
5459             #
5460             # Convert the height of a cell from user's units to pixels. If the height
5461 538         2272 # hasn't been set by the user we use the default value. A hidden row is
5462             # treated as having a height of zero unless it has the special
5463             # "object_position" of 4 (size with cells).
5464             #
5465              
5466             my $self = shift;
5467             my $row = shift;
5468             my $anchor = shift || 0;
5469             my $pixels;
5470              
5471             # Look up the cell value to see if it has been changed
5472             if ( exists $self->{_row_sizes}->{$row} ) {
5473             my $height = $self->{_row_sizes}->{$row}[0];
5474             my $hidden = $self->{_row_sizes}->{$row}[1];
5475              
5476             if ( $hidden == 1 && $anchor != 4 ) {
5477             $pixels = 0;
5478             }
5479             else {
5480             $pixels = int( 4 / 3 * $height );
5481 41     41   58 }
5482 41         58 }
5483             else {
5484             $pixels = int( 4 / 3 * $self->{_default_row_height} );
5485             }
5486              
5487             return $pixels;
5488             }
5489              
5490              
5491             ###############################################################################
5492             #
5493             # _pixels_to_width($pixels)
5494             #
5495             # Convert the width of a cell from pixels to character units.
5496 41         157 #
5497              
5498             my $pixels = shift;
5499             my $max_digit_width = 7;
5500 41         96 my $padding = 5;
5501 41         77 my $width;
5502              
5503 41         66 if ( $pixels <= 12 ) {
5504 41         54 $width = $pixels / ( $max_digit_width + $padding );
5505 41         52 }
5506 41         55 else {
5507             $width = ( $pixels - $padding ) / $max_digit_width;
5508             }
5509 41         59  
5510 41         64 return $width;
5511 41         55 }
5512 41         59  
5513 41         57  
5514 41         61 ###############################################################################
5515             #
5516             # _pixels_to_height($pixels)
5517             #
5518             # Convert the height of a cell from pixels to character units.
5519             #
5520              
5521             my $pixels = shift;
5522              
5523             return 0.75 * $pixels;
5524             }
5525              
5526              
5527             ###############################################################################
5528 37569     37569   40117 #
5529 37569         37858 # _get_shared_string_index()
5530 37569   100     63903 #
5531             # Add a string to the shared string table, if it isn't already there, and
5532 37569         38151 # return the string index.
5533 37569         36831 #
5534 37569         36942  
5535             my $self = shift;
5536             my $str = shift;
5537              
5538 37569 100       50404 # Add the string to the shared string table.
5539             if ( not exists ${ $self->{_str_table} }->{$str} ) {
5540 177         287 ${ $self->{_str_table} }->{$str} = ${ $self->{_str_unique} }++;
5541 177         244 }
5542              
5543             ${ $self->{_str_total} }++;
5544 177 100 100     604 my $index = ${ $self->{_str_table} }->{$str};
    50          
5545 18         34  
5546             return $index;
5547             }
5548 0         0  
5549              
5550             ###############################################################################
5551 159         358 #
5552             # _get_drawing_rel_index()
5553             #
5554             # Get the index used to address a drawing rel link.
5555 37392         39735 #
5556              
5557             my $self = shift;
5558 37569         55946 my $target = shift;
5559              
5560             if ( ! defined $target ) {
5561             # Undefined values for drawings like charts will always be unique.
5562             return ++$self->{_drawing_rels_id};
5563             }
5564             elsif ( exists $self->{_drawing_rels}->{$target} ) {
5565             return $self->{_drawing_rels}->{$target};
5566             }
5567             else {
5568             $self->{_drawing_rels}->{$target} = ++$self->{_drawing_rels_id};
5569             return $self->{_drawing_rels_id};
5570             }
5571             }
5572 60527     60527   64246  
5573 60527         60150  
5574 60527   100     97647 ###############################################################################
5575 60527         60191 #
5576             # _get_vml_drawing_rel_index()
5577             #
5578 60527 100       77434 # Get the index used to address a vml_drawing rel link.
5579 74         117 #
5580 74         103  
5581             my $self = shift;
5582 74 100 100     215 my $target = shift;
5583 10         15  
5584             if ( exists $self->{_vml_drawing_rels}->{$target} ) {
5585             return $self->{_vml_drawing_rels}->{$target};
5586 64         110 }
5587             else {
5588             $self->{_vml_drawing_rels}->{$target} = ++$self->{_vml_drawing_rels_id};
5589             return $self->{_vml_drawing_rels_id};
5590 60453         69205 }
5591             }
5592              
5593 60527         83751  
5594             ###############################################################################
5595             #
5596             # insert_chart( $row, $col, $chart, $x, $y, $x_scale, $y_scale )
5597             #
5598             # Insert a chart into a worksheet. The $chart argument should be a Chart
5599             # object or else it is assumed to be a filename of an external binary file.
5600             # The latter is for backwards compatibility.
5601             #
5602              
5603             my $self = shift;
5604              
5605 1823     1823   935033 # Check for a cell reference in A1 notation and substitute row and column.
5606 1823         2671 if ( $_[0] =~ /^\D/ ) {
5607 1823         2156 @_ = $self->_substitute_cellref( @_ );
5608 1823         2111 }
5609              
5610 1823 100       3516 my $row = $_[0];
5611 25         45 my $col = $_[1];
5612             my $chart = $_[2];
5613             my $x_offset;
5614 1798         3223 my $y_offset;
5615             my $x_scale;
5616             my $y_scale;
5617 1823         4428 my $anchor;
5618              
5619             croak "Insufficient arguments in insert_chart()" unless @_ >= 3;
5620              
5621             if ( ref $chart ) {
5622              
5623             # Check for a Chart object.
5624             croak "Not a Chart object in insert_chart()"
5625             unless $chart->isa( 'Excel::Writer::XLSX::Chart' );
5626              
5627             # Check that the chart is an embedded style chart.
5628             croak "Not a embedded style Chart object in insert_chart()"
5629 568     568   280103 unless $chart->{_embedded};
5630              
5631 568         1620 }
5632              
5633             if ( ref $_[3] eq 'HASH' ) {
5634             # Newer hashref bashed options.
5635             my $options = $_[3];
5636             $x_offset = $options->{x_offset} || 0;
5637             $y_offset = $options->{y_offset} || 0;
5638             $x_scale = $options->{x_scale} || 1;
5639             $y_scale = $options->{y_scale} || 1;
5640             $anchor = $options->{object_position} || 1;
5641             }
5642             else {
5643             # Older parameter based options.
5644 2744     2744   3073 $x_offset = $_[3] || 0;
5645 2744         3095 $y_offset = $_[4] || 0;
5646             $x_scale = $_[5] || 1;
5647             $y_scale = $_[6] || 1;
5648 2744 100       2751 $anchor = $_[7] || 1;
  2744         5456  
5649 1141         1365 }
  1141         2361  
  1141         1699  
5650              
5651             # Ensure a chart isn't inserted more than once.
5652 2744         3343 if ( $chart->{_already_inserted}
  2744         3316  
5653 2744         2885 || $chart->{_combined} && $chart->{_combined}->{_already_inserted} )
  2744         3618  
5654             {
5655 2744         3623 carp "Chart cannot be inserted in a worksheet more than once";
5656             return;
5657             }
5658             else {
5659             $chart->{_already_inserted} = 1;
5660              
5661             if ( $chart->{_combined} ) {
5662             $chart->{_combined}->{_already_inserted} = 1;
5663             }
5664             }
5665              
5666             # Use the values set with $chart->set_size(), if any.
5667 599     599   1209 $x_scale = $chart->{_x_scale} if $chart->{_x_scale} != 1;
5668 599         1094 $y_scale = $chart->{_y_scale} if $chart->{_y_scale} != 1;
5669             $x_offset = $chart->{_x_offset} if $chart->{_x_offset};
5670 599 100       2166 $y_offset = $chart->{_y_offset} if $chart->{_y_offset};
    100          
5671              
5672 447         1419 push @{ $self->{_charts} },
5673             [ $row, $col, $chart, $x_offset, $y_offset, $x_scale, $y_scale, $anchor ];
5674             }
5675 4         15  
5676              
5677             ###############################################################################
5678 148         339 #
5679 148         648 # _prepare_chart()
5680             #
5681             # Set up chart/drawings.
5682             #
5683              
5684             my $self = shift;
5685             my $index = shift;
5686             my $chart_id = shift;
5687             my $drawing_id = shift;
5688             my $drawing_type = 1;
5689             my $drawing;
5690              
5691             my ( $row, $col, $chart, $x_offset, $y_offset, $x_scale, $y_scale, $anchor )
5692 46     46   66 = @{ $self->{_charts}->[$index] };
5693 46         75  
5694             $chart->{_id} = $chart_id - 1;
5695 46 100       101  
5696 10         21 # Use user specified dimensions, if any.
5697             my $width = $chart->{_width} if $chart->{_width};
5698             my $height = $chart->{_height} if $chart->{_height};
5699 36         78  
5700 36         83 $width = int( 0.5 + ( $width * $x_scale ) );
5701             $height = int( 0.5 + ( $height * $y_scale ) );
5702              
5703             my @dimensions =
5704             $self->_position_object_emus( $col, $row, $x_offset, $y_offset, $width,
5705             $height, $anchor);
5706              
5707             # Set the chart name for the embedded object if it has been specified.
5708             my $name = $chart->{_chart_name};
5709              
5710             # Create a Drawing object to use with worksheet unless one already exists.
5711             if ( !$self->{_drawing} ) {
5712              
5713             $drawing = Excel::Writer::XLSX::Drawing->new();
5714             $drawing->{_embedded} = 1;
5715 406     406 0 2602 $self->{_drawing} = $drawing;
5716              
5717             push @{ $self->{_external_drawing_links} },
5718 406 50       2194 [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ];
5719 406         1657 }
5720             else {
5721             $drawing = $self->{_drawing};
5722 406         1017 }
5723 406         830  
5724 406         763 my $drawing_object = $drawing->_add_drawing_object();
5725 406         2128  
5726             $drawing_object->{_type} = $drawing_type;
5727 406         0 $drawing_object->{_dimensions} = \@dimensions;
5728 406         0 $drawing_object->{_width} = 0;
5729 406         0 $drawing_object->{_height} = 0;
5730             $drawing_object->{_description} = $name;
5731 406 50       1705 $drawing_object->{_shape} = undef;
5732             $drawing_object->{_anchor} = $anchor;
5733 406 50       1590 $drawing_object->{_rel_index} = $self->_get_drawing_rel_index();
5734             $drawing_object->{_url_rel_index} = 0;
5735             $drawing_object->{_tip} = undef;
5736 406 50       4292 $drawing_object->{_decorative} = 0;
5737              
5738             push @{ $self->{_drawing_links} },
5739             [ '/chart', '../charts/chart' . $chart_id . '.xml' ];
5740             }
5741 406 50       1753  
5742              
5743             ###############################################################################
5744             #
5745 406 100       1621 # _get_range_data
5746             #
5747 3         5 # Returns a range of data from the worksheet _table to be used in chart
5748 3   50     14 # cached data. Strings are returned as SST ids and decoded in the workbook.
5749 3   50     10 # Return undefs for data that doesn't exist since Excel can chart series
5750 3   100     8 # with data missing.
5751 3   100     41 #
5752 3   100     13  
5753             my $self = shift;
5754              
5755             return () if $self->{_optimization};
5756 403   100     2024  
5757 403   100     2094 my @data;
5758 403   100     2253 my ( $row_start, $col_start, $row_end, $col_end ) = @_;
5759 403   100     2474  
5760 403   100     1832 # TODO. Check for worksheet limits.
5761              
5762             # Iterate through the table data.
5763             for my $row_num ( $row_start .. $row_end ) {
5764 406 50 66     2913  
      33        
5765             # Store undef if row doesn't exist.
5766             if ( !exists $self->{_table}->{$row_num} ) {
5767 0         0 push @data, undef;
5768 0         0 next;
5769             }
5770              
5771 406         882 for my $col_num ( $col_start .. $col_end ) {
5772              
5773 406 100       1295 if ( my $cell = $self->{_table}->{$row_num}->{$col_num} ) {
5774 10         22  
5775             my $type = $cell->[0];
5776             my $token = $cell->[1];
5777              
5778              
5779 406 100       1425 if ( $type eq 'n' ) {
5780 406 100       1344  
5781 406 100       1334 # Store a number.
5782 406 100       1259 push @data, $token;
5783             }
5784 406         713 elsif ( $type eq 's' ) {
  406         2429  
5785              
5786             # Store a string.
5787             if ( $self->{_optimization} == 0 ) {
5788             push @data, { 'sst_id' => $token };
5789             }
5790             else {
5791             push @data, $token;
5792             }
5793             }
5794             elsif ( $type eq 'f' ) {
5795              
5796             # Store a formula.
5797 406     406   928 push @data, $cell->[3] || 0;
5798 406         794 }
5799 406         778 elsif ( $type eq 'a' || $type eq 'd') {
5800 406         742  
5801 406         740 # Store an array formula.
5802 406         684 push @data, $cell->[4] || 0;
5803             }
5804             elsif ( $type eq 'b' ) {
5805 406         660  
  406         1604  
5806             # Store a empty cell.
5807 406         1164 push @data, '';
5808             }
5809             }
5810 406 50       1504 else {
5811 406 50       1452  
5812             # Store undef if col doesn't exist.
5813 406         1300 push @data, undef;
5814 406         920 }
5815             }
5816 406         1817 }
5817              
5818             return @data;
5819             }
5820              
5821 406         1134  
5822             ###############################################################################
5823             #
5824 406 100       1508 # insert_image( $row, $col, $filename, $options )
5825             #
5826 394         4386 # Insert an image into the worksheet.
5827 394         2360 #
5828 394         876  
5829             my $self = shift;
5830 394         779  
  394         2357  
5831             # Check for a cell reference in A1 notation and substitute row and column.
5832             if ( $_[0] =~ /^\D/ ) {
5833             @_ = $self->_substitute_cellref( @_ );
5834 12         23 }
5835              
5836             my $row = $_[0];
5837 406         1886 my $col = $_[1];
5838             my $image = $_[2];
5839 406         946 my $x_offset;
5840 406         1030 my $y_offset;
5841 406         873 my $x_scale;
5842 406         841 my $y_scale;
5843 406         853 my $anchor;
5844 406         797 my $url;
5845 406         788 my $tip;
5846 406         2558 my $description;
5847 406         884 my $decorative;
5848 406         855  
5849 406         782 if ( ref $_[3] eq 'HASH' ) {
5850             # Newer hashref bashed options.
5851 406         772 my $options = $_[3];
  406         2881  
5852             $x_offset = $options->{x_offset} || 0;
5853             $y_offset = $options->{y_offset} || 0;
5854             $x_scale = $options->{x_scale} || 1;
5855             $y_scale = $options->{y_scale} || 1;
5856             $anchor = $options->{object_position} || 2;
5857             $url = $options->{url};
5858             $tip = $options->{tip};
5859             $description = $options->{description};
5860             $decorative = $options->{decorative};
5861             }
5862             else {
5863             # Older parameter based options.
5864             $x_offset = $_[3] || 0;
5865             $y_offset = $_[4] || 0;
5866             $x_scale = $_[5] || 1;
5867 1167     1167   1792 $y_scale = $_[6] || 1;
5868             $anchor = $_[7] || 2;
5869 1167 50       2772 }
5870              
5871 1167         1607 croak "Insufficient arguments in insert_image()" unless @_ >= 3;
5872 1167         2495 croak "Couldn't locate $image: $!" unless -e $image;
5873              
5874             push @{ $self->{_images} },
5875             [
5876             $row, $col, $image, $x_offset,
5877 1167         2550 $y_offset, $x_scale, $y_scale, $url,
5878             $tip, $anchor, $description, $decorative
5879             ];
5880 5525 100       9682 }
5881 5         6  
5882 5         8  
5883             ###############################################################################
5884             #
5885 5520         7115 # _prepare_image()
5886             #
5887 5520 100       10316 # Set up image/drawings.
5888             #
5889 5516         7188  
5890 5516         5952 my $self = shift;
5891             my $index = shift;
5892             my $image_id = shift;
5893 5516 100 0     7788 my $drawing_id = shift;
    50          
    0          
    0          
    0          
5894             my $width = shift;
5895             my $height = shift;
5896 5488         9793 my $name = shift;
5897             my $image_type = shift;
5898             my $x_dpi = shift;
5899             my $y_dpi = shift;
5900             my $md5 = shift;
5901 28 50       55 my $drawing_type = 2;
5902 28         82 my $drawing;
5903              
5904             my (
5905 0         0 $row, $col, $image, $x_offset,
5906             $y_offset, $x_scale, $y_scale, $url,
5907             $tip, $anchor, $description, $decorative
5908             ) = @{ $self->{_images}->[$index] };
5909              
5910             $width *= $x_scale;
5911 0   0     0 $height *= $y_scale;
5912              
5913             $width *= 96 / $x_dpi;
5914             $height *= 96 / $y_dpi;
5915              
5916 0   0     0 my @dimensions =
5917             $self->_position_object_emus( $col, $row, $x_offset, $y_offset, $width,
5918             $height, $anchor);
5919              
5920             # Convert from pixels to emus.
5921 0         0 $width = int( 0.5 + ( $width * 9_525 ) );
5922             $height = int( 0.5 + ( $height * 9_525 ) );
5923              
5924             # Create a Drawing object to use with worksheet unless one already exists.
5925             if ( !$self->{_drawing} ) {
5926              
5927 4         10 $drawing = Excel::Writer::XLSX::Drawing->new();
5928             $drawing->{_embedded} = 1;
5929             $self->{_drawing} = $drawing;
5930              
5931             push @{ $self->{_external_drawing_links} },
5932 1167         3481 [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ];
5933             }
5934             else {
5935             $drawing = $self->{_drawing};
5936             }
5937              
5938             my $drawing_object = $drawing->_add_drawing_object();
5939              
5940             $drawing_object->{_type} = $drawing_type;
5941             $drawing_object->{_dimensions} = \@dimensions;
5942             $drawing_object->{_width} = $width;
5943             $drawing_object->{_height} = $height;
5944 126     126 0 956 $drawing_object->{_description} = $name;
5945             $drawing_object->{_shape} = undef;
5946             $drawing_object->{_anchor} = $anchor;
5947 126 100       659 $drawing_object->{_rel_index} = 0;
5948 124         488 $drawing_object->{_url_rel_index} = 0;
5949             $drawing_object->{_tip} = $tip;
5950             $drawing_object->{_decorative} = $decorative;
5951 126         244  
5952 126         213 if ( defined $description ) {
5953 126         214 $drawing_object->{_description} = $description;
5954 126         991 }
5955              
5956 126         0 if ( $url ) {
5957 126         0 my $rel_type = '/hyperlink';
5958 126         0 my $target_mode = 'External';
5959 126         0 my $target;
5960 126         0  
5961 126         0 if ( $url =~ m{^[fh]tt?ps?://} || $url =~ m{^mailto:} ) {
5962 126         0 $target = _escape_url( $url );
5963             }
5964 126 100       398  
5965              
5966 40         75 if ( $url =~ s{^external:}{} ) {
5967 40   100     210 $target = _escape_url( $url );
5968 40   100     164  
5969 40   100     151 # Additional escape not required in worksheet hyperlinks.
5970 40   100     151 $target =~ s/#/%23/g;
5971 40   100     147  
5972 40         68 # Prefix absolute paths (not relative) with file:///.
5973 40         66 if ( $target =~ m{^\w:} || $target =~ m{^\\\\} ) {
5974 40         64 $target = 'file:///' . $target;
5975 40         82 }
5976             else {
5977             $target =~ s[\\][/]g;
5978             }
5979 86   100     387 }
5980 86   100     311  
5981 86   100     327 if ( $url =~ s/^internal:/#/ ) {
5982 86   100     483 $target = $url;
5983 86   100     380 $target_mode = undef;
5984             }
5985              
5986 126 50       375 my $max_url = $self->{_max_url_length};
5987 126 50       1990 if ( length $target > $max_url ) {
5988             carp "Ignoring URL '$url' where link or anchor > $max_url characters "
5989 126         351 . "since it exceeds Excel's limit for URLS. See LIMITATIONS "
  126         1044  
5990             . "section of the Excel::Writer::XLSX documentation.";
5991             }
5992             else {
5993             if ( $target && !exists $self->{_drawing_rels}->{$url} ) {
5994             push @{ $self->{_drawing_links} },
5995             [ $rel_type, $target, $target_mode ];
5996             }
5997              
5998             $drawing_object->{_url_rel_index} =
5999             $self->_get_drawing_rel_index( $url );
6000             }
6001             }
6002              
6003             if ( !exists $self->{_drawing_rels}->{$md5} ) {
6004             push @{ $self->{_drawing_links} },
6005             [ '/image', '../media/image' . $image_id . '.' . $image_type ];
6006 126     126   221 }
6007 126         188  
6008 126         184 $drawing_object->{_rel_index} = $self->_get_drawing_rel_index( $md5 );
6009 126         189 }
6010 126         188  
6011 126         177  
6012 126         180 ###############################################################################
6013 126         200 #
6014 126         165 # _prepare_header_image()
6015 126         158 #
6016 126         175 # Set up an image without a drawing object for header/footer images.
6017 126         179 #
6018 126         194  
6019             my $self = shift;
6020             my $image_id = shift;
6021             my $width = shift;
6022             my $height = shift;
6023             my $name = shift;
6024 126         178 my $image_type = shift;
  126         492  
6025             my $position = shift;
6026 126         218 my $x_dpi = shift;
6027 126         190 my $y_dpi = shift;
6028             my $md5 = shift;
6029 126         324  
6030 126         231 # Strip the extension from the filename.
6031             $name =~ s/\.[^\.]+$//;
6032 126         440  
6033             if ( !exists $self->{_vml_drawing_rels}->{$md5} ) {
6034             push @{ $self->{_vml_drawing_links} },
6035             [ '/image', '../media/image' . $image_id . '.' . $image_type ];
6036             }
6037 126         290  
6038 126         273 my $ref_id = $self->_get_vml_drawing_rel_index( $md5 );
6039              
6040             push @{ $self->{_header_images_array} },
6041 126 100       488 [ $width, $height, $name, $position, $x_dpi, $y_dpi, $ref_id ];
6042             }
6043 99         800  
6044 99         696  
6045 99         259 ###############################################################################
6046             #
6047 99         252 # set_background( $filename )
  99         561  
6048             #
6049             # Set the background image for the worksheet.
6050             #
6051 27         39  
6052             my $self = shift;
6053             my $image = shift;
6054 126         492  
6055             croak "Couldn't locate $image: $!" unless -e $image;
6056 126         261  
6057 126         295 $self->{_background_image} = $image;
6058 126         207 }
6059 126         220  
6060 126         237  
6061 126         225 ###############################################################################
6062 126         202 #
6063 126         209 # _prepare_background()
6064 126         270 #
6065 126         235 # Set up an image without a drawing object for the background image.
6066 126         231 #
6067              
6068 126 100       384 my $self = shift;
6069 2         4 my $image_id = shift;
6070             my $image_type = shift;
6071              
6072 126 100       317 push @{ $self->{_external_background_links} },
6073 26         43 [ '/image', '../media/image' . $image_id . '.' . $image_type ];
6074 26         43 }
6075 26         49  
6076              
6077 26 100 100     209 ###############################################################################
6078 19         69 #
6079             # insert_shape( $row, $col, $shape, $x, $y, $x_scale, $y_scale )
6080             #
6081             # Insert a shape into the worksheet.
6082 26 100       103 #
6083 5         24  
6084             my $self = shift;
6085              
6086 5         12 # Check for a cell reference in A1 notation and substitute row and column.
6087             if ( $_[0] =~ /^\D/ ) {
6088             @_ = $self->_substitute_cellref( @_ );
6089 5 100 100     27 }
6090 4         12  
6091             # Check the number of arguments.
6092             croak "Insufficient arguments in insert_shape()" unless @_ >= 3;
6093 1         4  
6094             my $shape = $_[2];
6095              
6096             # Verify we are being asked to insert a "shape" object.
6097 26 100       93 croak "Not a Shape object in insert_shape()"
6098 2         4 unless $shape->isa( 'Excel::Writer::XLSX::Shape' );
6099 2         3  
6100             # Set the shape properties.
6101             $shape->{_row_start} = $_[0];
6102 26         47 $shape->{_column_start} = $_[1];
6103 26 50       73 $shape->{_x_offset} = $_[3] || 0;
6104 0         0 $shape->{_y_offset} = $_[4] || 0;
6105              
6106             # Override shape scale if supplied as an argument. Otherwise, use the
6107             # existing shape scale factors.
6108             $shape->{_scale_x} = $_[5] if defined $_[5];
6109 26 100 66     137 $shape->{_scale_y} = $_[6] if defined $_[6];
6110 25         43 $shape->{_anchor} = $_[7] || 1;
  25         79  
6111              
6112             # Assign a shape ID.
6113             my $needs_id = 1;
6114             while ( $needs_id ) {
6115 26         75 my $id = $shape->{_id} || 0;
6116             my $used = exists $self->{_shape_hash}->{$id} ? 1 : 0;
6117              
6118             # Test if shape ID is already used. Otherwise assign a new one.
6119 126 100       363 if ( !$used && $id != 0 ) {
6120 123         257 $needs_id = 0;
  123         602  
6121             }
6122             else {
6123             $shape->{_id} = ++$self->{_last_shape_id};
6124 126         539 }
6125             }
6126              
6127             $shape->{_element} = $#{ $self->{_shapes} } + 1;
6128              
6129             # Allow lookup of entry into shape array by shape ID.
6130             $self->{_shape_hash}->{ $shape->{_id} } = $shape->{_element};
6131              
6132             # Create link to Worksheet color palette.
6133             $shape->{_palette} = $self->{_palette};
6134              
6135             if ( $shape->{_stencil} ) {
6136 46     46   78  
6137 46         61 # Insert a copy of the shape, not a reference so that the shape is
6138 46         69 # used as a stencil. Previously stamped copies don't get modified
6139 46         68 # if the stencil is modified.
6140 46         72 my $insert = { %{$shape} };
6141 46         61  
6142 46         57 # For connectors change x/y co-ords based on location of connected shapes.
6143 46         62 $self->_auto_locate_connectors( $insert );
6144 46         60  
6145 46         65 # Bless the copy into this class, so AUTOLOADED _get, _set methods
6146             #still work on the child.
6147             bless $insert, ref $shape;
6148 46         252  
6149             push @{ $self->{_shapes} }, $insert;
6150 46 100       149 return $insert;
6151 36         51 }
  36         151  
6152             else {
6153              
6154             # For connectors change x/y co-ords based on location of connected shapes.
6155 46         132 $self->_auto_locate_connectors( $shape );
6156              
6157 46         65 # Insert a link to the shape on the list of shapes. Connection to
  46         223  
6158             # the parent shape is maintained
6159             push @{ $self->{_shapes} }, $shape;
6160             return $shape;
6161             }
6162             }
6163              
6164              
6165             ###############################################################################
6166             #
6167             # _prepare_shape()
6168             #
6169             # Set up drawing shapes
6170 8     8 0 45 #
6171 8         14  
6172             my $self = shift;
6173 8 50       91 my $index = shift;
6174             my $drawing_id = shift;
6175 8         36 my $shape = $self->{_shapes}->[$index];
6176             my $drawing;
6177             my $drawing_type = 3;
6178              
6179             # Create a Drawing object to use with worksheet unless one already exists.
6180             if ( !$self->{_drawing} ) {
6181              
6182             $drawing = Excel::Writer::XLSX::Drawing->new();
6183             $drawing->{_embedded} = 1;
6184             $self->{_drawing} = $drawing;
6185              
6186             push @{ $self->{_external_drawing_links} },
6187 8     8   14 [ '/drawing', '../drawings/drawing' . $drawing_id . '.xml' ];
6188 8         11  
6189 8         12 $self->{_has_shapes} = 1;
6190             }
6191 8         10 else {
  8         37  
6192             $drawing = $self->{_drawing};
6193             }
6194              
6195             # Validate the he shape against various rules.
6196             $self->_validate_shape( $shape, $index );
6197              
6198             $self->_position_shape_emus( $shape );
6199              
6200             my @dimensions = (
6201             $shape->{_column_start}, $shape->{_row_start},
6202             $shape->{_x1}, $shape->{_y1},
6203             $shape->{_column_end}, $shape->{_row_end},
6204 45     45 0 228 $shape->{_x2}, $shape->{_y2},
6205             $shape->{_x_abs}, $shape->{_y_abs},
6206             );
6207 45 100       229  
6208 41         123 my $drawing_object = $drawing->_add_drawing_object();
6209              
6210             $drawing_object->{_type} = $drawing_type;
6211             $drawing_object->{_dimensions} = \@dimensions;
6212 45 50       99 $drawing_object->{_width} = $shape->{_width_emu};
6213             $drawing_object->{_height} = $shape->{_height_emu};
6214 45         69 $drawing_object->{_description} = $shape->{_name};
6215             $drawing_object->{_shape} = $shape;
6216             $drawing_object->{_anchor} = $shape->{_anchor};
6217 45 50       159 $drawing_object->{_rel_index} = $self->_get_drawing_rel_index();
6218             $drawing_object->{_url_rel_index} = 0;
6219             $drawing_object->{_tip} = undef;
6220             $drawing_object->{_decorative} = 0;
6221 45         79 }
6222 45         57  
6223 45   100     106  
6224 45   100     125 ###############################################################################
6225             #
6226             # _auto_locate_connectors()
6227             #
6228 45 100       78 # Re-size connector shapes if they are connected to other shapes.
6229 45 100       79 #
6230 45   50     142  
6231             my $self = shift;
6232             my $shape = shift;
6233 45         58  
6234 45         76 # Valid connector shapes.
6235 90   100     172 my $connector_shapes = {
6236 90 100       176 straightConnector => 1,
6237             Connector => 1,
6238             bentConnector => 1,
6239 90 100 100     244 curvedConnector => 1,
6240 45         82 line => 1,
6241             };
6242              
6243 45         93 my $shape_base = $shape->{_type};
6244              
6245             # Remove the number of segments from end of type.
6246             chop $shape_base;
6247 45         58  
  45         86  
6248             $shape->{_connect} = $connector_shapes->{$shape_base} ? 1 : 0;
6249              
6250 45         103 return unless $shape->{_connect};
6251              
6252             # Both ends have to be connected to size it.
6253 45         65 return unless ( $shape->{_start} and $shape->{_end} );
6254              
6255 45 50       72 # Both ends need to provide info about where to connect.
6256             return unless ( $shape->{_start_side} and $shape->{_end_side} );
6257              
6258             my $sid = $shape->{_start};
6259             my $eid = $shape->{_end};
6260 45         61  
  45         701  
6261             my $slink_id = $self->{_shape_hash}->{$sid};
6262             my ( $sls, $els );
6263 45         211 if ( defined $slink_id ) {
6264             $sls = $self->{_shapes}->[$slink_id]; # Start linked shape.
6265             }
6266             else {
6267 45         82 warn "missing start connection for '$shape->{_name}', id=$sid\n";
6268             return;
6269 45         52 }
  45         84  
6270 45         109  
6271             my $elink_id = $self->{_shape_hash}->{$eid};
6272             if ( defined $elink_id ) {
6273             $els = $self->{_shapes}->[$elink_id]; # Start linked shape.
6274             }
6275 0         0 else {
6276             warn "missing end connection for '$shape->{_name}', id=$eid\n";
6277             return;
6278             }
6279 0         0  
  0         0  
6280 0         0 # Assume shape connections are to the middle of an object, and
6281             # not a corner (for now).
6282             my $connect_type = $shape->{_start_side} . $shape->{_end_side};
6283             my $smidx = $sls->{_x_offset} + $sls->{_width} / 2;
6284             my $emidx = $els->{_x_offset} + $els->{_width} / 2;
6285             my $smidy = $sls->{_y_offset} + $sls->{_height} / 2;
6286             my $emidy = $els->{_y_offset} + $els->{_height} / 2;
6287             my $netx = abs( $smidx - $emidx );
6288             my $nety = abs( $smidy - $emidy );
6289              
6290             if ( $connect_type eq 'bt' ) {
6291             my $sy = $sls->{_y_offset} + $sls->{_height};
6292             my $ey = $els->{_y_offset};
6293 41     41   61  
6294 41         49 $shape->{_width} = abs( int( $emidx - $smidx ) );
6295 41         52 $shape->{_x_offset} = int( min( $smidx, $emidx ) );
6296 41         74 $shape->{_height} =
6297 41         46 abs(
6298 41         54 int( $els->{_y_offset} - ( $sls->{_y_offset} + $sls->{_height} ) )
6299             );
6300             $shape->{_y_offset} = int(
6301 41 100       92 min( ( $sls->{_y_offset} + $sls->{_height} ), $els->{_y_offset} ) );
6302             $shape->{_flip_h} = ( $smidx < $emidx ) ? 1 : 0;
6303 10         80 $shape->{_rotation} = 90;
6304 10         58  
6305 10         21 if ( $sy > $ey ) {
6306             $shape->{_flip_v} = 1;
6307 10         18  
  10         72  
6308             # Create 3 adjustments for an end shape vertically above a
6309             # start shape. Adjustments count from the upper left object.
6310 10         29 if ( $#{ $shape->{_adjustments} } < 0 ) {
6311             $shape->{_adjustments} = [ -10, 50, 110 ];
6312             }
6313 31         40  
6314             $shape->{_type} = 'bentConnector5';
6315             }
6316             }
6317 41         110 elsif ( $connect_type eq 'rl' ) {
6318             $shape->{_width} =
6319 41         108 abs(
6320             int( $els->{_x_offset} - ( $sls->{_x_offset} + $sls->{_width} ) ) );
6321             $shape->{_height} = abs( int( $emidy - $smidy ) );
6322             $shape->{_x_offset} =
6323             min( $sls->{_x_offset} + $sls->{_width}, $els->{_x_offset} );
6324             $shape->{_y_offset} = min( $smidy, $emidy );
6325              
6326             $shape->{_flip_h} = 1 if ( $smidx < $emidx ) and ( $smidy > $emidy );
6327 41         146 $shape->{_flip_h} = 1 if ( $smidx > $emidx ) and ( $smidy < $emidy );
6328             if ( $smidx > $emidx ) {
6329 41         153  
6330             # Create 3 adjustments if end shape is left of start
6331 41         57 if ( $#{ $shape->{_adjustments} } < 0 ) {
6332 41         69 $shape->{_adjustments} = [ -10, 50, 110 ];
6333 41         49 }
6334 41         49  
6335 41         64 $shape->{_type} = 'bentConnector5';
6336 41         51 }
6337 41         62 }
6338 41         105 else {
6339 41         66 warn "Connection $connect_type not implemented yet\n";
6340 41         52 }
6341 41         101 }
6342              
6343              
6344             ###############################################################################
6345             #
6346             # _validate_shape()
6347             #
6348             # Check shape attributes to ensure they are valid.
6349             #
6350              
6351             my $self = shift;
6352             my $shape = shift;
6353 45     45   57 my $index = shift;
6354 45         52  
6355             if ( !grep ( /^$shape->{_align}$/, qw[l ctr r just] ) ) {
6356             croak "Shape $index ($shape->{_type}) alignment ($shape->{align}), "
6357 45         140 . "not in ('l', 'ctr', 'r', 'just')\n";
6358             }
6359              
6360             if ( !grep ( /^$shape->{_valign}$/, qw[t ctr b] ) ) {
6361             croak "Shape $index ($shape->{_type}) vertical alignment "
6362             . "($shape->{valign}), not ('t', 'ctr', 'b')\n";
6363             }
6364             }
6365 45         89  
6366              
6367             ###############################################################################
6368 45         80 #
6369             # _prepare_vml_objects()
6370 45 100       104 #
6371             # Turn the HoH that stores the comments into an array for easier handling
6372 45 100       123 # and set the external links for comments and buttons.
6373             #
6374              
6375 12 50 33     51 my $self = shift;
6376             my $vml_data_id = shift;
6377             my $vml_shape_id = shift;
6378 12 50 33     60 my $vml_drawing_id = shift;
6379             my $comment_id = shift;
6380 12         21 my @comments;
6381 12         17  
6382              
6383 12         19 # We sort the comments by row and column but that isn't strictly required.
6384 12         19 my @rows = sort { $a <=> $b } keys %{ $self->{_comments} };
6385 12 100       22  
6386 11         23 for my $row ( @rows ) {
6387             my @cols = sort { $a <=> $b } keys %{ $self->{_comments}->{$row} };
6388              
6389 1         9 for my $col ( @cols ) {
6390 1         7 my $user_options = $self->{_comments}->{$row}->{$col};
6391             my $params = [ $self->_comment_params( @$user_options ) ];
6392              
6393 11         20 $self->{_comments}->{$row}->{$col} = $params;
6394 11 100       30  
6395 10         16 # Set comment visibility if required and not already user defined.
6396             if ( $self->{_comments_visible} ) {
6397             if ( !defined $self->{_comments}->{$row}->{$col}->[4] ) {
6398 1         7 $self->{_comments}->{$row}->{$col}->[4] = 1;
6399 1         6 }
6400             }
6401              
6402             # Set comment author if not already user defined.
6403             if ( !defined $self->{_comments}->{$row}->{$col}->[3] ) {
6404 10         21 $self->{_comments}->{$row}->{$col}->[3] =
6405 10         28 $self->{_comments_author};
6406 10         21 }
6407 10         15  
6408 10         19 push @comments, $self->{_comments}->{$row}->{$col};
6409 10         16 }
6410 10         15 }
6411              
6412 10 100       28 push @{ $self->{_external_vml_links} },
    50          
6413 5         8 [ '/vmlDrawing', '../drawings/vmlDrawing' . $vml_drawing_id . '.vml' ];
6414 5         16  
6415             if ( $self->{_has_comments} ) {
6416 5         8  
6417 5         15 $self->{_comments_array} = \@comments;
6418              
6419             push @{ $self->{_external_comment_links} },
6420 5         11 [ '/comments', '../comments' . $comment_id . '.xml' ];
6421             }
6422              
6423 5         18 my $count = scalar @comments;
6424 5 100       10 my $start_data_id = $vml_data_id;
6425 5         6  
6426             # The VML o:idmap data id contains a comma separated range when there is
6427 5 100       17 # more than one 1024 block of comments, like this: data="1,2".
6428 2         3 for my $i ( 1 .. int( $count / 1024 ) ) {
6429             $vml_data_id = "$vml_data_id," . ( $start_data_id + $i );
6430             }
6431              
6432 2 100       3 $self->{_vml_data_id} = $vml_data_id;
  2         6  
6433 1         2 $self->{_vml_shape_id} = $vml_shape_id;
6434              
6435             return $count;
6436 2         5 }
6437              
6438              
6439             ###############################################################################
6440             #
6441             # _prepare_header_vml_objects()
6442 5         12 #
6443 5         33 # Set up external linkage for VML header/footer images.
6444             #
6445 5         20  
6446 5         16 my $self = shift;
6447             my $vml_header_id = shift;
6448 5 100 100     19 my $vml_drawing_id = shift;
6449 5 100 100     17  
6450 5 100       16 $self->{_vml_header_id} = $vml_header_id;
6451              
6452             push @{ $self->{_external_vml_links} },
6453 2 100       3 [ '/vmlDrawing', '../drawings/vmlDrawing' . $vml_drawing_id . '.vml' ];
  2         7  
6454 1         2 }
6455              
6456              
6457 2         6 ###############################################################################
6458             #
6459             # _prepare_tables()
6460             #
6461 0         0 # Set the table ids for the worksheet tables.
6462             #
6463              
6464             my $self = shift;
6465             my $table_id = shift;
6466             my $seen = shift;
6467              
6468              
6469             for my $table ( @{ $self->{_tables} } ) {
6470              
6471             $table-> {_id} = $table_id;
6472              
6473             # Set the table name unless defined by the user.
6474 41     41   60 if ( !defined $table->{_name} ) {
6475 41         55  
6476 41         49 # Set a default name.
6477             $table->{_name} = 'Table' . $table_id;
6478 41 50       431 }
6479 0         0  
6480             # Check for duplicate table names.
6481             my $name = lc $table->{_name};
6482              
6483 41 50       282 if ( exists $seen->{$name} ) {
6484 0         0 die "error: invalid duplicate table name '$table->{_name}' found";
6485             }
6486             else {
6487             $seen->{$name} = 1;
6488             }
6489              
6490             # Store the link used for the rels file.
6491             my $link = [ '/table', '../tables/table' . $table_id . '.xml' ];
6492              
6493             push @{ $self->{_external_table_links} }, $link;
6494             $table_id++;
6495             }
6496             }
6497              
6498              
6499 58     58   105 ###############################################################################
6500 58         95 #
6501 58         120 # _comment_params()
6502 58         107 #
6503 58         104 # This method handles the additional optional parameters to write_comment() as
6504 58         105 # well as calculating the comment object position and vertices.
6505             #
6506              
6507             my $self = shift;
6508 58         98  
  1524         1594  
  58         339  
6509             my $row = shift;
6510 58         171 my $col = shift;
6511 318         420 my $string = shift;
  11759         12639  
  318         2013  
6512              
6513 318         679 my $default_width = 128;
6514 4162         6452 my $default_height = 74;
6515 4162         7434  
6516             my %params = (
6517 4162         8958 author => undef,
6518             color => 81,
6519             start_cell => undef,
6520 4162 100       6299 start_col => undef,
6521 10 100       18 start_row => undef,
6522 8         15 visible => undef,
6523             width => $default_width,
6524             height => $default_height,
6525             x_offset => undef,
6526             x_scale => 1,
6527 4162 100       7153 y_offset => undef,
6528             y_scale => 1,
6529 4160         6271 font => 'Tahoma',
6530             font_size => 8,
6531             font_family => 2,
6532 4162         8668 );
6533              
6534              
6535             # Overwrite the defaults with any user supplied values. Incorrect or
6536 58         105 # misspelled parameters are silently ignored.
  58         315  
6537             %params = ( %params, @_ );
6538              
6539 58 100       228  
6540             # Ensure that a width and height have been set.
6541 44         111 $params{width} = $default_width if not $params{width};
6542             $params{height} = $default_height if not $params{height};
6543 44         81  
  44         177  
6544              
6545             # Limit the string to the max number of chars.
6546             my $max_len = 32767;
6547 58         143  
6548 58         102 if ( length( $string ) > $max_len ) {
6549             $string = substr( $string, 0, $max_len );
6550             }
6551              
6552 58         305  
6553 4         11 # Set the comment background colour.
6554             my $color = $params{color};
6555             my $color_id = &Excel::Writer::XLSX::Format::_get_color( $color );
6556 58         135  
6557 58         99 if ( $color_id =~ m/^#[0-9A-F]{6}$/i ) {
6558             $params{color} = $color_id;
6559 58         209 }
6560             elsif ( $color_id == 0 ) {
6561             $params{color} = '#ffffe1';
6562             }
6563             else {
6564             my $palette = $self->{_palette};
6565              
6566             # Get the RGB color from the palette.
6567             my @rgb = @{ $palette->[ $color_id - 8 ] };
6568             my $rgb_color = sprintf "%02x%02x%02x", @rgb[0, 1, 2];
6569              
6570             # Minor modification to allow comparison testing. Change RGB colors
6571 24     24   47 # from long format, ffcc00 to short format fc0 used by VML.
6572 24         41 $rgb_color =~ s/^([0-9a-f])\1([0-9a-f])\2([0-9a-f])\3$/$1$2$3/;
6573 24         42  
6574             $params{color} = sprintf "#%s [%d]", $rgb_color, $color_id;
6575 24         50 }
6576              
6577 24         38  
  24         184  
6578             # Convert a cell reference to a row and column.
6579             if ( defined $params{start_cell} ) {
6580             my ( $row, $col ) = $self->_substitute_cellref( $params{start_cell} );
6581             $params{start_row} = $row;
6582             $params{start_col} = $col;
6583             }
6584              
6585              
6586             # Set the default start cell and offsets for the comment. These are
6587             # generally fixed in relation to the parent cell. However there are
6588             # some edge cases for cells at the, er, edges.
6589             #
6590 40     40   169 my $row_max = $self->{_xls_rowmax};
6591 40         73 my $col_max = $self->{_xls_colmax};
6592 40         98  
6593             if ( not defined $params{start_row} ) {
6594              
6595 40         78 if ( $row == 0 ) { $params{start_row} = 0 }
  40         132  
6596             elsif ( $row == $row_max - 3 ) { $params{start_row} = $row_max - 7 }
6597 49         145 elsif ( $row == $row_max - 2 ) { $params{start_row} = $row_max - 6 }
6598             elsif ( $row == $row_max - 1 ) { $params{start_row} = $row_max - 5 }
6599             else { $params{start_row} = $row - 1 }
6600 49 100       141 }
6601              
6602             if ( not defined $params{y_offset} ) {
6603 48         191  
6604             if ( $row == 0 ) { $params{y_offset} = 2 }
6605             elsif ( $row == $row_max - 3 ) { $params{y_offset} = 16 }
6606             elsif ( $row == $row_max - 2 ) { $params{y_offset} = 16 }
6607 49         128 elsif ( $row == $row_max - 1 ) { $params{y_offset} = 14 }
6608             else { $params{y_offset} = 10 }
6609 49 50       154 }
6610 0         0  
6611             if ( not defined $params{start_col} ) {
6612              
6613 49         134 if ( $col == $col_max - 3 ) { $params{start_col} = $col_max - 6 }
6614             elsif ( $col == $col_max - 2 ) { $params{start_col} = $col_max - 5 }
6615             elsif ( $col == $col_max - 1 ) { $params{start_col} = $col_max - 4 }
6616             else { $params{start_col} = $col + 1 }
6617 49         208 }
6618              
6619 49         90 if ( not defined $params{x_offset} ) {
  49         125  
6620 49         153  
6621             if ( $col == $col_max - 3 ) { $params{x_offset} = 49 }
6622             elsif ( $col == $col_max - 2 ) { $params{x_offset} = 49 }
6623             elsif ( $col == $col_max - 1 ) { $params{x_offset} = 49 }
6624             else { $params{x_offset} = 15 }
6625             }
6626              
6627              
6628             # Scale the size of the comment box if required.
6629             if ( $params{x_scale} ) {
6630             $params{width} = $params{width} * $params{x_scale};
6631             }
6632              
6633             if ( $params{y_scale} ) {
6634 4162     4162   4835 $params{height} = $params{height} * $params{y_scale};
6635             }
6636 4162         4663  
6637 4162         4309 # Round the dimensions to the nearest pixel.
6638 4162         4743 $params{width} = int( 0.5 + $params{width} );
6639             $params{height} = int( 0.5 + $params{height} );
6640 4162         4467  
6641 4162         4304 # Calculate the positions of comment object.
6642             my @vertices = $self->_position_object_pixels(
6643 4162         15456 $params{start_col}, $params{start_row}, $params{x_offset},
6644             $params{y_offset}, $params{width}, $params{height}
6645             );
6646              
6647             # Add the width and height for VML.
6648             push @vertices, ( $params{width}, $params{height} );
6649              
6650             return (
6651             $row,
6652             $col,
6653             $string,
6654              
6655             $params{author},
6656             $params{visible},
6657             $params{color},
6658             $params{font},
6659             $params{font_size},
6660             $params{font_family},
6661              
6662             [@vertices],
6663             );
6664 4162         21614 }
6665              
6666              
6667             ###############################################################################
6668 4162 50       9089 #
6669 4162 50       6125 # _button_params()
6670             #
6671             # This method handles the parameters passed to insert_button() as well as
6672             # calculating the button object position and vertices.
6673 4162         4362 #
6674              
6675 4162 50       6554 my $self = shift;
6676 0         0 my $row = shift;
6677             my $col = shift;
6678             my $params = shift;
6679             my $button = { _row => $row, _col => $col };
6680              
6681 4162         4800 my $button_number = 1 + @{ $self->{_buttons_array} };
6682 4162         7972  
6683             # Set the button caption.
6684 4162 50       7920 my $caption = $params->{caption};
    100          
6685 0         0  
6686             # Set a default caption if none was specified by user.
6687             if ( !defined $caption ) {
6688 4161         5733 $caption = 'Button ' . $button_number;
6689             }
6690              
6691 1         2 $button->{_font}->{_caption} = $caption;
6692              
6693              
6694 1         2 # Set the macro name.
  1         3  
6695 1         6 if ( $params->{macro} ) {
6696             $button->{_macro} = '[0]!' . $params->{macro};
6697             }
6698             else {
6699 1         10 $button->{_macro} = '[0]!Button' . $button_number . '_Click';
6700             }
6701 1         6  
6702              
6703             # Ensure that a width and height have been set.
6704             my $default_width = $self->{_default_col_pixels};
6705             my $default_height = $self->{_default_row_pixels};
6706 4162 50       6246 $params->{width} = $default_width if !$params->{width};
6707 0         0 $params->{height} = $default_height if !$params->{height};
6708 0         0  
6709 0         0 # Set the x/y offsets.
6710             $params->{x_offset} = 0 if !$params->{x_offset};
6711             $params->{y_offset} = 0 if !$params->{y_offset};
6712              
6713             # Scale the size of the button box if required.
6714             if ( $params->{x_scale} ) {
6715             $params->{width} = $params->{width} * $params->{x_scale};
6716             }
6717 4162         4790  
6718 4162         4747 if ( $params->{y_scale} ) {
6719             $params->{height} = $params->{height} * $params->{y_scale};
6720 4162 50       6792 }
6721              
6722 4162 100       9685 # Round the dimensions to the nearest pixel.
  53 50       89  
    50          
    100          
6723 0         0 $params->{width} = int( 0.5 + $params->{width} );
6724 0         0 $params->{height} = int( 0.5 + $params->{height} );
6725 1         3  
6726 4108         4934 $params->{start_row} = $row;
6727             $params->{start_col} = $col;
6728              
6729 4162 100       6114 # Calculate the positions of button object.
6730             my @vertices = $self->_position_object_pixels(
6731 4161 100       8715 $params->{start_col}, $params->{start_row}, $params->{x_offset},
  53 50       85  
    50          
    100          
6732 0         0 $params->{y_offset}, $params->{width}, $params->{height}
6733 0         0 );
6734 1         2  
6735 4107         4685 # Add the width and height for VML.
6736             push @vertices, ( $params->{width}, $params->{height} );
6737              
6738 4162 50       5985 $button->{_vertices} = \@vertices;
6739              
6740 4162 50       7831 return $button;
  0 50       0  
    100          
6741 0         0 }
6742 1         2  
6743 4161         5176  
6744             ###############################################################################
6745             #
6746 4162 50       6078 # Deprecated methods for backwards compatibility.
6747             #
6748 4162 50       7914 ###############################################################################
  0 50       0  
    100          
6749 0         0  
6750 1         1  
6751 4161         4670 # This method was mainly only required for Excel 5.
6752              
6753             # Deprecated UTF-16 method required for the Excel 5 format.
6754              
6755             my $self = shift;
6756 4162 50       5923  
6757 4162         5250 # Convert A1 notation if present.
6758             @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/;
6759              
6760 4162 50       5838 # Check the number of args.
6761 4162         4844 return -1 if @_ < 3;
6762              
6763             # Convert UTF16 string to UTF8.
6764             require Encode;
6765 4162         6893 my $utf8_string = Encode::decode( 'UTF-16BE', $_[2] );
6766 4162         5066  
6767             return $self->write_string( $_[0], $_[1], $utf8_string, $_[3] );
6768             }
6769              
6770             # Deprecated UTF-16 method required for the Excel 5 format.
6771              
6772 4162         7921 my $self = shift;
6773              
6774             # Convert A1 notation if present.
6775 4162         6249 @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/;
6776              
6777             # Check the number of args.
6778             return -1 if @_ < 3;
6779              
6780             # Convert UTF16 string to UTF8.
6781             require Encode;
6782             my $utf8_string = Encode::decode( 'UTF-16LE', $_[2] );
6783              
6784             return $self->write_string( $_[0], $_[1], $utf8_string, $_[3] );
6785             }
6786              
6787             # No longer required. Was used to avoid slow formula parsing.
6788              
6789 4162         28177 my $self = shift;
6790             my $string = shift;
6791              
6792             my @tokens = split /(\$?[A-I]?[A-Z]\$?\d+)/, $string;
6793              
6794             return \@tokens;
6795             }
6796              
6797             # No longer required. Was used to avoid slow formula parsing.
6798              
6799             my $self = shift;
6800              
6801             # Convert A1 notation if present.
6802             @_ = $self->_substitute_cellref( @_ ) if $_[0] =~ /^\D/;
6803 28     28   47  
6804 28         43 if ( @_ < 2 ) { return -1 } # Check the number of args
6805 28         41  
6806 28         48 my $row = shift; # Zero indexed row
6807 28         88 my $col = shift; # Zero indexed column
6808             my $formula_ref = shift; # Array ref with formula tokens
6809 28         48 my $format = shift; # XF format
  28         78  
6810             my @pairs = @_; # Pattern/replacement pairs
6811              
6812 28         51  
6813             # Enforce an even number of arguments in the pattern/replacement list.
6814             croak "Odd number of elements in pattern/replacement list" if @pairs % 2;
6815 28 100       73  
6816 24         50 # Check that $formula is an array ref.
6817             croak "Not a valid formula" if ref $formula_ref ne 'ARRAY';
6818              
6819 28         74 my @tokens = @$formula_ref;
6820              
6821             # Allow the user to specify the result of the formula by appending a
6822             # result => $value pair to the end of the arguments.
6823 28 100       68 my $value = undef;
6824 5         19 if ( @pairs && $pairs[-2] eq 'result' ) {
6825             $value = pop @pairs;
6826             pop @pairs;
6827 23         61 }
6828              
6829             # Make the substitutions.
6830             while ( @pairs ) {
6831             my $pattern = shift @pairs;
6832 28         50 my $replace = shift @pairs;
6833 28         42  
6834 28 100       100 foreach my $token ( @tokens ) {
6835 28 100       84 last if $token =~ s/$pattern/$replace/;
6836             }
6837             }
6838 28 100       87  
6839 28 100       76 my $formula = join '', @tokens;
6840              
6841             return $self->write_formula( $row, $col, $formula, $format, $value );
6842 28 100       70 }
6843 1         3  
6844              
6845             ###############################################################################
6846 28 100       155 #
6847 1         4 # XML writing methods.
6848             #
6849             ###############################################################################
6850              
6851 28         139  
6852 28         153 ###############################################################################
6853             #
6854 28         113 # _write_worksheet()
6855 28         63 #
6856             # Write the <worksheet> element. This is the root element of Worksheet.
6857             #
6858              
6859             my $self = shift;
6860             my $schema = 'http://schemas.openxmlformats.org/';
6861 28         101 my $xmlns = $schema . 'spreadsheetml/2006/main';
6862             my $xmlns_r = $schema . 'officeDocument/2006/relationships';
6863             my $xmlns_mc = $schema . 'markup-compatibility/2006';
6864 28         101  
6865             my @attributes = (
6866 28         57 'xmlns' => $xmlns,
6867             'xmlns:r' => $xmlns_r,
6868 28         61 );
6869              
6870             if ( $self->{_excel_version} == 2010 ) {
6871             push @attributes, ( 'xmlns:mc' => $xmlns_mc );
6872              
6873             push @attributes,
6874             ( 'xmlns:x14ac' => 'http://schemas.microsoft.com/'
6875             . 'office/spreadsheetml/2009/9/ac' );
6876              
6877             push @attributes, ( 'mc:Ignorable' => 'x14ac' );
6878              
6879             }
6880       0 0    
6881             $self->xml_start_tag( 'worksheet', @attributes );
6882             }
6883              
6884              
6885 1     1 0 7 ###############################################################################
6886             #
6887             # _write_sheet_pr()
6888 1 50       9 #
6889             # Write the <sheetPr> element for Sheet level properties.
6890             #
6891 1 50       4  
6892             my $self = shift;
6893             my @attributes = ();
6894 1         6  
6895 1         6 if ( !$self->{_fit_page}
6896             && !$self->{_filter_on}
6897 1         2420 && !$self->{_tab_color}
6898             && !$self->{_outline_changed}
6899             && !$self->{_vba_codename} )
6900             {
6901             return;
6902             }
6903 1     1 0 6  
6904              
6905             my $codename = $self->{_vba_codename};
6906 1 50       7 push @attributes, ( 'codeName' => $codename ) if $codename;
6907             push @attributes, ( 'filterMode' => 1 ) if $self->{_filter_on};
6908              
6909 1 50       3 if ( $self->{_fit_page}
6910             || $self->{_tab_color}
6911             || $self->{_outline_changed} )
6912 1         5 {
6913 1         3 $self->xml_start_tag( 'sheetPr', @attributes );
6914             $self->_write_tab_color();
6915 1         43 $self->_write_outline_pr();
6916             $self->_write_page_set_up_pr();
6917             $self->xml_end_tag( 'sheetPr' );
6918             }
6919             else {
6920             $self->xml_empty_tag( 'sheetPr', @attributes );
6921 5     5 0 2552 }
6922 5         9 }
6923              
6924 5         74  
6925             ##############################################################################
6926 5         26 #
6927             # _write_page_set_up_pr()
6928             #
6929             # Write the <pageSetUpPr> element.
6930             #
6931              
6932 5     5 0 30 my $self = shift;
6933              
6934             return unless $self->{_fit_page};
6935 5 50       17  
6936             my @attributes = ( 'fitToPage' => 1 );
6937 5 50       12  
  0         0  
6938             $self->xml_empty_tag( 'pageSetUpPr', @attributes );
6939 5         8 }
6940 5         6  
6941 5         8  
6942 5         9 ###############################################################################
6943 5         12 #
6944             # _write_dimension()
6945             #
6946             # Write the <dimension> element. This specifies the range of cells in the
6947 5 50       13 # worksheet. As a special case, empty spreadsheets use 'A1' as a range.
6948             #
6949              
6950 5 50       13 my $self = shift;
6951             my $ref;
6952 5         14  
6953             if ( !defined $self->{_dim_rowmin} && !defined $self->{_dim_colmin} ) {
6954              
6955             # If the min dims are undefined then no dimensions have been set
6956 5         8 # and we use the default 'A1'.
6957 5 50 66     17 $ref = 'A1';
6958 0         0 }
6959 0         0 elsif ( !defined $self->{_dim_rowmin} && defined $self->{_dim_colmin} ) {
6960              
6961             # If the row dims aren't set but the column dims are then they
6962             # have been changed via set_column().
6963 5         11  
6964 6         10 if ( $self->{_dim_colmin} == $self->{_dim_colmax} ) {
6965 6         9  
6966             # The dimensions are a single cell and not a range.
6967 6         8 $ref = xl_rowcol_to_cell( 0, $self->{_dim_colmin} );
6968 16 100       74 }
6969             else {
6970              
6971             # The dimensions are a cell range.
6972 5         14 my $cell_1 = xl_rowcol_to_cell( 0, $self->{_dim_colmin} );
6973             my $cell_2 = xl_rowcol_to_cell( 0, $self->{_dim_colmax} );
6974 5         12  
6975             $ref = $cell_1 . ':' . $cell_2;
6976             }
6977              
6978             }
6979             elsif ($self->{_dim_rowmin} == $self->{_dim_rowmax}
6980             && $self->{_dim_colmin} == $self->{_dim_colmax} )
6981             {
6982              
6983             # The dimensions are a single cell and not a range.
6984             $ref = xl_rowcol_to_cell( $self->{_dim_rowmin}, $self->{_dim_colmin} );
6985             }
6986             else {
6987              
6988             # The dimensions are a cell range.
6989             my $cell_1 =
6990             xl_rowcol_to_cell( $self->{_dim_rowmin}, $self->{_dim_colmin} );
6991             my $cell_2 =
6992             xl_rowcol_to_cell( $self->{_dim_rowmax}, $self->{_dim_colmax} );
6993 1079     1079   2404  
6994 1079         2405 $ref = $cell_1 . ':' . $cell_2;
6995 1079         3649 }
6996 1079         3112  
6997 1079         2971  
6998             my @attributes = ( 'ref' => $ref );
6999 1079         3806  
7000             $self->xml_empty_tag( 'dimension', @attributes );
7001             }
7002              
7003              
7004 1079 100       4413 ###############################################################################
7005 23         79 #
7006             # _write_sheet_views()
7007 23         68 #
7008             # Write the <sheetViews> element.
7009             #
7010              
7011 23         71 my $self = shift;
7012              
7013             my @attributes = ();
7014              
7015 1079         7233 $self->xml_start_tag( 'sheetViews', @attributes );
7016             $self->_write_sheet_view();
7017             $self->xml_end_tag( 'sheetViews' );
7018             }
7019              
7020              
7021             ###############################################################################
7022             #
7023             # _write_sheet_view()
7024             #
7025             # Write the <sheetView> element.
7026             #
7027 1081     1081   2184 # Sample structure:
7028 1081         2635 # <sheetView
7029             # showGridLines="0"
7030 1081 100 100     16642 # showRowColHeaders="0"
      100        
      100        
      100        
7031             # showZeros="0"
7032             # rightToLeft="1"
7033             # tabSelected="1"
7034             # showRuler="0"
7035             # showOutlineSymbols="0"
7036 1055         2552 # view="pageLayout"
7037             # zoomScale="121"
7038             # zoomScaleNormal="121"
7039             # workbookViewId="0"
7040 26         72 # />
7041 26 100       94 #
7042 26 100       104  
7043             my $self = shift;
7044 26 100 100     193 my $gridlines = $self->{_screen_gridlines};
      100        
7045             my $show_zeros = $self->{_show_zeros};
7046             my $right_to_left = $self->{_right_to_left};
7047             my $tab_selected = $self->{_selected};
7048 11         43 my $view = $self->{_page_view};
7049 11         48 my $zoom = $self->{_zoom};
7050 11         37 my $row_col_headers = $self->{_hide_row_col_headers};
7051 11         41 my $workbook_view_id = 0;
7052 11         56 my @attributes = ();
7053              
7054             # Hide screen gridlines if required.
7055 15         99 if ( !$gridlines ) {
7056             push @attributes, ( 'showGridLines' => 0 );
7057             }
7058              
7059             # Hide the row/column headers.
7060             if ( $row_col_headers ) {
7061             push @attributes, ( 'showRowColHeaders' => 0 );
7062             }
7063              
7064             # Hide zeroes in cells.
7065             if ( !$show_zeros ) {
7066             push @attributes, ( 'showZeros' => 0 );
7067             }
7068 13     13   42  
7069             # Display worksheet right to left for Hebrew, Arabic and others.
7070 13 100       38 if ( $right_to_left ) {
7071             push @attributes, ( 'rightToLeft' => 1 );
7072 9         25 }
7073              
7074 9         62 # Show that the sheet tab is selected.
7075             if ( $tab_selected ) {
7076             push @attributes, ( 'tabSelected' => 1 );
7077             }
7078              
7079              
7080             # Turn outlines off. Also required in the outlinePr element.
7081             if ( !$self->{_outline_on} ) {
7082             push @attributes, ( "showOutlineSymbols" => 0 );
7083             }
7084              
7085             # Set the page view/layout mode if required.
7086             # TODO. Add pageBreakPreview mode when requested.
7087 1088     1088   2564 if ( $view ) {
7088 1088         1983 push @attributes, ( 'view' => 'pageLayout' );
7089             }
7090 1088 100 100     12361  
    100 66        
    100 100        
7091             # Set the zoom level.
7092             if ( $zoom != 100 ) {
7093             push @attributes, ( 'zoomScale' => $zoom ) unless $view;
7094 274         610 push @attributes, ( 'zoomScaleNormal' => $zoom )
7095             if $self->{_zoom_scale_normal};
7096             }
7097              
7098             push @attributes, ( 'workbookViewId' => $workbook_view_id );
7099              
7100             if ( @{ $self->{_panes} } || @{ $self->{_selections} } ) {
7101 9 100       30 $self->xml_start_tag( 'sheetView', @attributes );
7102             $self->_write_panes();
7103             $self->_write_selections();
7104 6         30 $self->xml_end_tag( 'sheetView' );
7105             }
7106             else {
7107             $self->xml_empty_tag( 'sheetView', @attributes );
7108             }
7109 3         14 }
7110 3         11  
7111              
7112 3         11 ###############################################################################
7113             #
7114             # _write_selections()
7115             #
7116             # Write the <selection> elements.
7117             #
7118              
7119             my $self = shift;
7120              
7121 139         750 for my $selection ( @{ $self->{_selections} } ) {
7122             $self->_write_selection( @$selection );
7123             }
7124             }
7125              
7126              
7127 666         3906 ###############################################################################
7128             #
7129 666         2630 # _write_selection()
7130             #
7131 666         2472 # Write the <selection> element.
7132             #
7133              
7134             my $self = shift;
7135 1088         3531 my $pane = shift;
7136             my $active_cell = shift;
7137 1088         7233 my $sqref = shift;
7138             my @attributes = ();
7139              
7140             push @attributes, ( 'pane' => $pane ) if $pane;
7141             push @attributes, ( 'activeCell' => $active_cell ) if $active_cell;
7142             push @attributes, ( 'sqref' => $sqref ) if $sqref;
7143              
7144             $self->xml_empty_tag( 'selection', @attributes );
7145             }
7146              
7147              
7148             ###############################################################################
7149 1151     1151   2493 #
7150             # _write_sheet_format_pr()
7151 1151         2635 #
7152             # Write the <sheetFormatPr> element.
7153 1151         4511 #
7154 1151         4547  
7155 1151         6602 my $self = shift;
7156             my $base_col_width = 10;
7157             my $default_row_height = $self->{_default_row_height};
7158             my $row_level = $self->{_outline_row_level};
7159             my $col_level = $self->{_outline_col_level};
7160             my $zero_height = $self->{_default_row_zeroed};
7161              
7162             my @attributes = ( 'defaultRowHeight' => $default_row_height );
7163              
7164             if ( $self->{_default_row_height} != $self->{_original_row_height} ) {
7165             push @attributes, ( 'customHeight' => 1 );
7166             }
7167              
7168             if ( $self->{_default_row_zeroed} ) {
7169             push @attributes, ( 'zeroHeight' => 1 );
7170             }
7171              
7172             push @attributes, ( 'outlineLevelRow' => $row_level ) if $row_level;
7173             push @attributes, ( 'outlineLevelCol' => $col_level ) if $col_level;
7174              
7175             if ( $self->{_excel_version} == 2010 ) {
7176             push @attributes, ( 'x14ac:dyDescent' => '0.25' );
7177             }
7178              
7179             $self->xml_empty_tag( 'sheetFormatPr', @attributes );
7180             }
7181              
7182 1158     1158   2557  
7183 1158         3105 ##############################################################################
7184 1158         2704 #
7185 1158         2435 # _write_cols()
7186 1158         3109 #
7187 1158         2602 # Write the <cols> element and <col> sub elements.
7188 1158         2347 #
7189 1158         2329  
7190 1158         2181 my $self = shift;
7191 1158         2515  
7192             # Exit unless some column have been formatted.
7193             return unless %{ $self->{_colinfo} };
7194 1158 100       3611  
7195 3         9 $self->xml_start_tag( 'cols' );
7196              
7197             for my $col ( sort keys %{ $self->{_colinfo} } ) {
7198             $self->_write_col_info( @{ $self->{_colinfo}->{$col} } );
7199 1158 100       3595 }
7200 1         3  
7201             $self->xml_end_tag( 'cols' );
7202             }
7203              
7204 1158 100       3636  
7205 1         4 ##############################################################################
7206             #
7207             # _write_col_info()
7208             #
7209 1158 100       3449 # Write the <col> element.
7210 1         3 #
7211              
7212             my $self = shift;
7213             my $min = $_[0] || 0; # First formatted column.
7214 1158 100       3549 my $max = $_[1] || 0; # Last formatted column.
7215 1007         3086 my $width = $_[2]; # Col width in user units.
7216             my $format = $_[3]; # Format index.
7217             my $hidden = $_[4] || 0; # Hidden flag.
7218             my $level = $_[5] || 0; # Outline level.
7219             my $collapsed = $_[6] || 0; # Outline level.
7220 1158 100       3818 my $custom_width = 1;
7221 1         3 my $xf_index = 0;
7222              
7223             # Get the format index.
7224             if ( ref( $format ) ) {
7225             $xf_index = $format->get_xf_index();
7226 1158 100       3547 }
7227 2         7  
7228             # Set the Excel default col width.
7229             if ( !defined $width ) {
7230             if ( !$hidden ) {
7231 1158 100       3930 $width = 8.43;
7232 2 50       7 $custom_width = 0;
7233             }
7234 2 100       22 else {
7235             $width = 0;
7236             }
7237 1158         2981 }
7238             else {
7239 1158 100 100     1949  
  1158         5227  
  1106         4338  
7240 69         199 # Width is defined but same as default.
7241 69         244 if ( $width == 8.43 ) {
7242 69         204 $custom_width = 0;
7243 69         232 }
7244             }
7245              
7246 1089         4316  
7247             # Convert column width from user units to character width.
7248             my $max_digit_width = 7; # For Calabri 11.
7249             my $padding = 5;
7250              
7251             if ( $width > 0 ) {
7252             if ( $width < 1 ) {
7253             $width =
7254             int( ( int( $width * ($max_digit_width + $padding) + 0.5 ) ) /
7255             $max_digit_width *
7256             256 ) / 256;
7257             }
7258             else {
7259 69     69   115 $width =
7260             int( ( int( $width * $max_digit_width + 0.5 ) + $padding ) /
7261 69         90 $max_digit_width *
  69         161  
7262 105         246 256 ) / 256;
7263             }
7264             }
7265              
7266             my @attributes = (
7267             'min' => $min + 1,
7268             'max' => $max + 1,
7269             'width' => $width,
7270             );
7271              
7272             push @attributes, ( 'style' => $xf_index ) if $xf_index;
7273             push @attributes, ( 'hidden' => 1 ) if $hidden;
7274             push @attributes, ( 'customWidth' => 1 ) if $custom_width;
7275 106     106   168 push @attributes, ( 'outlineLevel' => $level ) if $level;
7276 106         144 push @attributes, ( 'collapsed' => 1 ) if $collapsed;
7277 106         146  
7278 106         144  
7279 106         156 $self->xml_empty_tag( 'col', @attributes );
7280             }
7281 106 100       233  
7282 106 100       223  
7283 106 100       214 ###############################################################################
7284             #
7285 106         229 # _write_sheet_data()
7286             #
7287             # Write the <sheetData> element.
7288             #
7289              
7290             my $self = shift;
7291              
7292             if ( not defined $self->{_dim_rowmin} ) {
7293              
7294             # If the dimensions aren't defined then there is no data to write.
7295             $self->xml_empty_tag( 'sheetData' );
7296             }
7297 1079     1079   2273 else {
7298 1079         2011 $self->xml_start_tag( 'sheetData' );
7299 1079         2418 $self->_write_rows();
7300 1079         2430 $self->xml_end_tag( 'sheetData' );
7301 1079         2191  
7302 1079         2225 }
7303              
7304 1079         6257 }
7305              
7306 1079 100       4188  
7307 4         12 ###############################################################################
7308             #
7309             # _write_optimized_sheet_data()
7310 1079 100       3857 #
7311 3         7 # Write the <sheetData> element when the memory optimisation is on. In which
7312             # case we read the data stored in the temp file and rewrite it to the XML
7313             # sheet file.
7314 1079 100       3554 #
7315 1079 100       3447  
7316             my $self = shift;
7317 1079 100       4025  
7318 23         62 if ( not defined $self->{_dim_rowmin} ) {
7319              
7320             # If the dimensions aren't defined then there is no data to write.
7321 1079         3968 $self->xml_empty_tag( 'sheetData' );
7322             }
7323             else {
7324              
7325             $self->xml_start_tag( 'sheetData' );
7326              
7327             my $xlsx_fh = $self->xml_get_fh();
7328             my $cell_fh = $self->{_cell_data_fh};
7329              
7330             my $buffer;
7331              
7332             # Rewind the temp file.
7333 1078     1078   2136 seek $cell_fh, 0, 0;
7334              
7335             while ( read( $cell_fh, $buffer, 4_096 ) ) {
7336 1078 100       1873 local $\ = undef; # Protect print from -l on commandline.
  1078         4457  
7337             print $xlsx_fh $buffer;
7338 112         500 }
7339              
7340 112         238 $self->xml_end_tag( 'sheetData' );
  112         643  
7341 230         432 }
  230         802  
7342             }
7343              
7344 112         488  
7345             ###############################################################################
7346             #
7347             # _write_rows()
7348             #
7349             # Write out the worksheet data as a series of rows and cells.
7350             #
7351              
7352             my $self = shift;
7353              
7354             $self->_calculate_spans();
7355              
7356 236     236   492 for my $row_num ( $self->{_dim_rowmin} .. $self->{_dim_rowmax} ) {
7357 236   100     725  
7358 236   100     704 # Skip row if it doesn't contain row formatting, cell data or a comment.
7359 236         383 if ( !$self->{_set_rows}->{$row_num}
7360 236         330 && !$self->{_table}->{$row_num}
7361 236   100     850 && !$self->{_comments}->{$row_num} )
7362 236   100     763 {
7363 236   50     864 next;
7364 236         413 }
7365 236         361  
7366             my $span_index = int( $row_num / 16 );
7367             my $span = $self->{_row_spans}->[$span_index];
7368 236 100       568  
7369 20         83 # Write the cells if the row contains data.
7370             if ( my $row_ref = $self->{_table}->{$row_num} ) {
7371              
7372             if ( !$self->{_set_rows}->{$row_num} ) {
7373 236 100       622 $self->_write_row( $row_num, $span );
7374 30 100       95 }
7375 17         32 else {
7376 17         28 $self->_write_row( $row_num, $span,
7377             @{ $self->{_set_rows}->{$row_num} } );
7378             }
7379 13         27  
7380              
7381             for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7382             if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) {
7383             $self->_write_cell( $row_num, $col_num, $col_ref );
7384             }
7385 206 100       649 }
7386 1         2  
7387             $self->xml_end_tag( 'row' );
7388             }
7389             elsif ( $self->{_comments}->{$row_num} ) {
7390              
7391             $self->_write_empty_row( $row_num, $span,
7392 236         376 @{ $self->{_set_rows}->{$row_num} } );
7393 236         423 }
7394             else {
7395 236 100       612  
7396 223 100       486 # Row attributes only.
7397 33         75 $self->_write_empty_row( $row_num, $span,
7398             @{ $self->{_set_rows}->{$row_num} } );
7399             }
7400             }
7401             }
7402              
7403 190         764  
7404             ###############################################################################
7405             #
7406             # _write_single_row()
7407             #
7408             # Write out the worksheet data as a single row with cells. This method is
7409             # used when memory optimisation is on. A single row is written and the data
7410 236         797 # table is reset. That way only one row of data is kept in memory at any one
7411             # time. We don't write span data in the optimised case since it is optional.
7412             #
7413              
7414             my $self = shift;
7415             my $current_row = shift || 0;
7416 236 100       637 my $row_num = $self->{_previous_row};
7417 236 100       553  
7418 236 100       715 # Set the new previous row as the current row.
7419 236 100       488 $self->{_previous_row} = $current_row;
7420 236 50       552  
7421             # Skip row if it doesn't contain row formatting, cell data or a comment.
7422             if ( !$self->{_set_rows}->{$row_num}
7423 236         812 && !$self->{_table}->{$row_num}
7424             && !$self->{_comments}->{$row_num} )
7425             {
7426             return;
7427             }
7428              
7429             # Write the cells if the row contains data.
7430             if ( my $row_ref = $self->{_table}->{$row_num} ) {
7431              
7432             if ( !$self->{_set_rows}->{$row_num} ) {
7433             $self->_write_row( $row_num );
7434             }
7435 1069     1069   2195 else {
7436             $self->_write_row( $row_num, undef,
7437 1069 100       4182 @{ $self->{_set_rows}->{$row_num} } );
7438             }
7439              
7440 283         973 for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7441             if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) {
7442             $self->_write_cell( $row_num, $col_num, $col_ref );
7443 786         3011 }
7444 786         3333 }
7445 786         2733  
7446             $self->xml_end_tag( 'row' );
7447             }
7448             else {
7449              
7450             # Row attributes or comments only.
7451             $self->_write_empty_row( $row_num, undef,
7452             @{ $self->{_set_rows}->{$row_num} } );
7453             }
7454              
7455             # Reset table.
7456             $self->{_table} = {};
7457              
7458             }
7459              
7460              
7461             ###############################################################################
7462 10     10   16 #
7463             # _calculate_spans()
7464 10 50       37 #
7465             # Calculate the "spans" attribute of the <row> tag. This is an XLSX
7466             # optimisation and isn't strictly required. However, it makes comparing
7467 0         0 # files easier.
7468             #
7469             # The span is the same for each block of 16 rows.
7470             #
7471 10         32  
7472             my $self = shift;
7473 10         50  
7474 10         23 my @spans;
7475             my $span_min;
7476 10         12 my $span_max;
7477              
7478             for my $row_num ( $self->{_dim_rowmin} .. $self->{_dim_rowmax} ) {
7479 10         397  
7480             # Calculate spans for cell data.
7481 10         268 if ( my $row_ref = $self->{_table}->{$row_num} ) {
7482 14         43  
7483 14         363 for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7484             if ( my $col_ref = $self->{_table}->{$row_num}->{$col_num} ) {
7485              
7486 10         47 if ( !defined $span_min ) {
7487             $span_min = $col_num;
7488             $span_max = $col_num;
7489             }
7490             else {
7491             $span_min = $col_num if $col_num < $span_min;
7492             $span_max = $col_num if $col_num > $span_max;
7493             }
7494             }
7495             }
7496             }
7497              
7498             # Calculate spans for comments.
7499 786     786   1718 if ( defined $self->{_comments}->{$row_num} ) {
7500              
7501 786         3523 for my $col_num ( $self->{_dim_colmin} .. $self->{_dim_colmax} ) {
7502             if ( defined $self->{_comments}->{$row_num}->{$col_num} ) {
7503 786         2536  
7504             if ( !defined $span_min ) {
7505             $span_min = $col_num;
7506 1053136 100 100     3076043 $span_max = $col_num;
      100        
7507             }
7508             else {
7509             $span_min = $col_num if $col_num < $span_min;
7510 1048908         1234026 $span_max = $col_num if $col_num > $span_max;
7511             }
7512             }
7513 4228         8083 }
7514 4228         6137 }
7515              
7516             if ( ( ( $row_num + 1 ) % 16 == 0 )
7517 4228 100       8291 || $row_num == $self->{_dim_rowmax} )
    100          
7518             {
7519 3814 100       6929 my $span_index = int( $row_num / 16 );
7520 3496         7578  
7521             if ( defined $span_min ) {
7522             $span_min++;
7523             $span_max++;
7524 318         382 $spans[$span_index] = "$span_min:$span_max";
  318         706  
7525             $span_min = undef;
7526             }
7527             }
7528 3814         8133 }
7529 27314 100       49509  
7530 10377         16729 $self->{_row_spans} = \@spans;
7531             }
7532              
7533              
7534 3814         8350 ###############################################################################
7535             #
7536             # _write_row()
7537             #
7538             # Write the <row> element.
7539 307         363 #
  307         849  
7540              
7541             my $self = shift;
7542             my $r = shift;
7543             my $spans = shift;
7544             my $height = shift;
7545 107         141 my $format = shift;
  107         317  
7546             my $hidden = shift || 0;
7547             my $level = shift || 0;
7548             my $collapsed = shift || 0;
7549             my $empty_row = shift || 0;
7550             my $xf_index = 0;
7551              
7552             $height = $self->{_default_row_height} if !defined $height;
7553              
7554             my @attributes = ( 'r' => $r + 1 );
7555              
7556             # Get the format index.
7557             if ( ref( $format ) ) {
7558             $xf_index = $format->get_xf_index();
7559             }
7560              
7561             push @attributes, ( 'spans' => $spans ) if defined $spans;
7562 300     300   607 push @attributes, ( 's' => $xf_index ) if $xf_index;
7563 300   100     503 push @attributes, ( 'customFormat' => 1 ) if $format;
7564 300         342  
7565             if ( $height != $self->{_original_row_height} ) {
7566             push @attributes, ( 'ht' => $height );
7567 300         315 }
7568              
7569             push @attributes, ( 'hidden' => 1 ) if $hidden;
7570 300 0 66     839  
      33        
7571             if ( $height != $self->{_original_row_height} ) {
7572             push @attributes, ( 'customHeight' => 1 );
7573             }
7574 0         0  
7575             push @attributes, ( 'outlineLevel' => $level ) if $level;
7576             push @attributes, ( 'collapsed' => 1 ) if $collapsed;
7577              
7578 300 50       480 if ( $self->{_excel_version} == 2010 ) {
7579             push @attributes, ( 'x14ac:dyDescent' => '0.25' );
7580 300 100       445 }
7581 299         438  
7582             if ( $empty_row ) {
7583             $self->xml_empty_tag_unencoded( 'row', @attributes );
7584             }
7585 1         1 else {
  1         5  
7586             $self->xml_start_tag_unencoded( 'row', @attributes );
7587             }
7588 300         522 }
7589 344 100       668  
7590 309         433  
7591             ###############################################################################
7592             #
7593             # _write_empty_row()
7594 300         574 #
7595             # Write and empty <row> element, i.e., attributes only, no cell data.
7596             #
7597              
7598             my $self = shift;
7599              
7600 0         0 # Set the $empty_row parameter.
  0         0  
7601             $_[7] = 1;
7602              
7603             $self->_write_row( @_ );
7604 300         660 }
7605              
7606              
7607             ###############################################################################
7608             #
7609             # _write_cell()
7610             #
7611             # Write the <cell> element. This is the innermost loop so efficiency is
7612             # important where possible. The basic methodology is that the data of every
7613             # cell type is passed in as follows:
7614             #
7615             # [ $row, $col, $aref]
7616             #
7617             # The aref, called $cell below, contains the following structure in all types:
7618             #
7619             # [ $type, $token, $xf, @args ]
7620             #
7621 804     804   1771 # Where $type: represents the cell type, such as string, number, formula, etc.
7622             # $token: is the actual data for the string, number, formula, etc.
7623 804         2842 # $xf: is the XF format object.
7624             # @args: additional args relevant to the specific data type.
7625 804         0 #
7626              
7627 804         3137 my $self = shift;
7628             my $row = shift;
7629             my $col = shift;
7630 1053442 100       1576783 my $cell = shift;
7631             my $type = $cell->[0];
7632 4120         6905 my $token = $cell->[1];
7633 32516 100       54167 my $xf = $cell->[2];
7634             my $xf_index = 0;
7635 10683 100       14913  
7636 840         1702 my %error_codes = (
7637 840         2136 '#DIV/0!' => 1,
7638             '#N/A' => 1,
7639             '#NAME?' => 1,
7640 9843 100       13857 '#NULL!' => 1,
7641 9843 100       16183 '#NUM!' => 1,
7642             '#REF!' => 1,
7643             '#VALUE!' => 1,
7644             );
7645              
7646             my %boolean = ( 'TRUE' => 1, 'FALSE' => 0 );
7647              
7648 1053442 100       1484669 # Get the format index.
7649             if ( ref( $xf ) ) {
7650 316         487 $xf_index = $xf->get_xf_index();
7651 37005 100       57425 }
7652              
7653 4160 100       5050 my $range = _xl_rowcol_to_cell( $row, $col );
7654 33         69 my @attributes = ( 'r' => $range );
7655 33         69  
7656             # Add the cell format index.
7657             if ( $xf_index ) {
7658 4127 50       5288 push @attributes, ( 's' => $xf_index );
7659 4127 100       5815 }
7660             elsif ( $self->{_set_rows}->{$row} && $self->{_set_rows}->{$row}->[1] ) {
7661             my $row_xf = $self->{_set_rows}->{$row}->[1];
7662             push @attributes, ( 's' => $row_xf->get_xf_index() );
7663             }
7664             elsif ( $self->{_col_formats}->{$col} ) {
7665 1053442 100 100     2342603 my $col_xf = $self->{_col_formats}->{$col};
7666             push @attributes, ( 's' => $col_xf->get_xf_index() );
7667             }
7668 66432         87057  
7669              
7670 66432 100       103657 # Write the various cell types.
7671 873         1740 if ( $type eq 'n' ) {
7672 873         1536  
7673 873         3319 # Write a number.
7674 873         2219 $self->xml_number_element( $token, @attributes );
7675             }
7676             elsif ( $type eq 's' ) {
7677              
7678             # Write a string.
7679 804         2734 if ( $self->{_optimization} == 0 ) {
7680             $self->xml_string_element( $token, @attributes );
7681             }
7682             else {
7683              
7684             my $string = $token;
7685              
7686             # Escape control characters. See SharedString.pm for details.
7687             $string =~ s/(_x[0-9a-fA-F]{4}_)/_x005F$1/g;
7688             $string =~ s/([\x00-\x08\x0B-\x1F])/sprintf "_x%04X_", ord($1)/eg;
7689              
7690             # Write any rich strings without further tags.
7691 4536     4536   6018 if ( $string =~ m{^<r>} && $string =~ m{</r>$} ) {
7692 4536         5891  
7693 4536         5612 $self->xml_rich_inline_string( $string, @attributes );
7694 4536         5432 }
7695 4536         5392 else {
7696 4536   100     10780  
7697 4536   100     10304 # Add attribute to preserve leading or trailing whitespace.
7698 4536   100     10188 my $preserve = 0;
7699 4536   100     9507 if ( $string =~ /^\s/ || $string =~ /\s$/ ) {
7700 4536         5504 $preserve = 1;
7701             }
7702 4536 100       8826  
7703             $self->xml_inline_string( $string, $preserve, @attributes );
7704 4536         8199 }
7705             }
7706             }
7707 4536 100       8233 elsif ( $type eq 'f' ) {
7708 11         48  
7709             # Write a formula.
7710             my $value = $cell->[3];
7711 4536 100       9797  
7712 4536 100       8608 $value = 0 if !defined $value;
7713 4536 100       7542  
7714             # Check if the formula value is a string.
7715 4536 100       8543 if ( $value
7716 111         220 && $value !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ )
7717             {
7718             if ( exists $boolean{$value} ) {
7719 4536 100       7380 push @attributes, ( 't' => 'b' );
7720             $value = $boolean{$value};
7721 4536 100       8026 }
7722 111         189 elsif ( exists $error_codes{$value} ) {
7723             push @attributes, ( 't' => 'e' );
7724             }
7725 4536 100       7225 else {
7726 4536 100       7209 push @attributes, ( 't' => 'str' );
7727             $value = Excel::Writer::XLSX::Package::XMLwriter::_escape_data(
7728 4536 100       8432 $value );
7729 60         103 }
7730             }
7731              
7732 4536 100       7658 $self->xml_formula_element( $token, $value, @attributes );
7733 415         1082  
7734             }
7735             elsif ( $type eq 'a' || $type eq 'd') {
7736 4121         11799  
7737             # Add metadata linkage for dynamic array formulas.
7738             if ($type eq 'd') {
7739             push @attributes, ( 'cm' => '1' );
7740             }
7741              
7742             # Write an array formula.
7743             $self->xml_start_tag( 'c', @attributes );
7744             $self->_write_cell_array_formula( $token, $cell->[3] );
7745             $self->_write_cell_value( $cell->[4] );
7746             $self->xml_end_tag( 'c' );
7747             }
7748             elsif ( $type eq 'l' ) {
7749 415     415   562  
7750             # Write a boolean value.
7751             push @attributes, ( 't' => 'b' );
7752 415         591  
7753             $self->xml_start_tag( 'c', @attributes );
7754 415         707 $self->_write_cell_value( $cell->[1] );
7755             $self->xml_end_tag( 'c' );
7756             }
7757             elsif ( $type eq 'b' ) {
7758              
7759             # Write a empty cell.
7760             $self->xml_empty_tag( 'c', @attributes );
7761             }
7762             }
7763              
7764              
7765             ###############################################################################
7766             #
7767             # _write_cell_value()
7768             #
7769             # Write the cell value <v> element.
7770             #
7771              
7772             my $self = shift;
7773             my $value = defined $_[0] ? $_[0] : '';
7774              
7775             $self->xml_data_element( 'v', $value );
7776             }
7777              
7778              
7779 10691     10691   12579 ###############################################################################
7780 10691         12434 #
7781 10691         12112 # _write_cell_formula()
7782 10691         11674 #
7783 10691         14269 # Write the cell formula <f> element.
7784 10691         11824 #
7785 10691         11893  
7786 10691         11431 my $self = shift;
7787             my $formula = defined $_[0] ? $_[0] : '';
7788 10691         28134  
7789             $self->xml_data_element( 'f', $formula );
7790             }
7791              
7792              
7793             ###############################################################################
7794             #
7795             # _write_cell_array_formula()
7796             #
7797             # Write the cell array formula <f> element.
7798 10691         16851 #
7799              
7800             my $self = shift;
7801 10691 100       16775 my $formula = shift;
7802 421         1287 my $range = shift;
7803              
7804             my @attributes = ( 't' => 'array', 'ref' => $range );
7805 10691         16357  
7806 10691         17723 $self->xml_data_element( 'f', $formula, @attributes );
7807             }
7808              
7809 10691 100 66     30442  
    100          
    100          
7810 421         1066 ##############################################################################
7811             #
7812             # _write_sheet_calc_pr()
7813 11         17 #
7814 11         20 # Write the <sheetCalcPr> element for the worksheet calculation properties.
7815             #
7816              
7817 17         25 my $self = shift;
7818 17         59 my $full_calc_on_load = 1;
7819              
7820             my @attributes = ( 'fullCalcOnLoad' => $full_calc_on_load );
7821              
7822             $self->xml_empty_tag( 'sheetCalcPr', @attributes );
7823 10691 100 100     18104 }
    100          
    100          
    100          
    100          
    50          
7824              
7825              
7826 7567         15721 ###############################################################################
7827             #
7828             # _write_phonetic_pr()
7829             #
7830             # Write the <phoneticPr> element.
7831 2974 100       4470 #
7832 2672         5967  
7833             my $self = shift;
7834             my $font_id = 0;
7835             my $type = 'noConversion';
7836 302         337  
7837             my @attributes = (
7838             'fontId' => $font_id,
7839 302         387 'type' => $type,
7840 302         466 );
  30         93  
7841              
7842             $self->xml_empty_tag( 'phoneticPr', @attributes );
7843 302 100 66     595 }
7844              
7845 8         31  
7846             ###############################################################################
7847             #
7848             # _write_page_margins()
7849             #
7850 294         305 # Write the <pageMargins> element.
7851 294 100 66     1053 #
7852 3         4  
7853             my $self = shift;
7854              
7855 294         698 my @attributes = (
7856             'left' => $self->{_margin_left},
7857             'right' => $self->{_margin_right},
7858             'top' => $self->{_margin_top},
7859             'bottom' => $self->{_margin_bottom},
7860             'header' => $self->{_margin_header},
7861             'footer' => $self->{_margin_footer},
7862 79         121 );
7863              
7864 79 100       179 $self->xml_empty_tag( 'pageMargins', @attributes );
7865             }
7866              
7867 79 100 100     440  
7868             ###############################################################################
7869             #
7870 18 100       58 # _write_page_setup()
    100          
7871 2         5 #
7872 2         3 # Write the <pageSetup> element.
7873             #
7874             # The following is an example taken from Excel.
7875 9         17 #
7876             # <pageSetup
7877             # paperSize="9"
7878 7         16 # scale="110"
7879 7         19 # fitToWidth="2"
7880             # fitToHeight="2"
7881             # pageOrder="overThenDown"
7882             # orientation="portrait"
7883             # blackAndWhite="1"
7884 79         297 # draft="1"
7885             # horizontalDpi="200"
7886             # verticalDpi="200"
7887             # r:id="rId1"
7888             # />
7889             #
7890 10 100       26  
7891 1         4 my $self = shift;
7892             my @attributes = ();
7893              
7894             return unless $self->{_page_setup_changed};
7895 10         41  
7896 10         41 # Set paper size.
7897 10         43 if ( $self->{_paper_size} ) {
7898 10         32 push @attributes, ( 'paperSize' => $self->{_paper_size} );
7899             }
7900              
7901             # Set the print_scale
7902             if ( $self->{_print_scale} != 100 ) {
7903 4         8 push @attributes, ( 'scale' => $self->{_print_scale} );
7904             }
7905 4         14  
7906 4         15 # Set the "Fit to page" properties.
7907 4         11 if ( $self->{_fit_page} && $self->{_fit_width} != 1 ) {
7908             push @attributes, ( 'fitToWidth' => $self->{_fit_width} );
7909             }
7910              
7911             if ( $self->{_fit_page} && $self->{_fit_height} != 1 ) {
7912 57         194 push @attributes, ( 'fitToHeight' => $self->{_fit_height} );
7913             }
7914              
7915             # Set the page print direction.
7916             if ( $self->{_page_order} ) {
7917             push @attributes, ( 'pageOrder' => "overThenDown" );
7918             }
7919              
7920             # Set start page.
7921             if ( $self->{_page_start} > 1 ) {
7922             push @attributes, ( 'firstPageNumber' => $self->{_page_start} );
7923             }
7924              
7925 15     15   44 # Set page orientation.
7926 15 50       40 if ( $self->{_orientation} == 0 ) {
7927             push @attributes, ( 'orientation' => 'landscape' );
7928 15         56 }
7929             else {
7930             push @attributes, ( 'orientation' => 'portrait' );
7931             }
7932              
7933             # Set print in black and white option.
7934             if ( $self->{_black_white} ) {
7935             push @attributes, ( 'blackAndWhite' => 1 );
7936             }
7937              
7938             # Set start page.
7939             if ( $self->{_page_start} != 0 ) {
7940 0     0   0 push @attributes, ( 'useFirstPageNumber' => 1 );
7941 0 0       0 }
7942              
7943 0         0 # Set the DPI. Mainly only for testing.
7944             if ( $self->{_horizontal_dpi} ) {
7945             push @attributes, ( 'horizontalDpi' => $self->{_horizontal_dpi} );
7946             }
7947              
7948             if ( $self->{_vertical_dpi} ) {
7949             push @attributes, ( 'verticalDpi' => $self->{_vertical_dpi} );
7950             }
7951              
7952              
7953             $self->xml_empty_tag( 'pageSetup', @attributes );
7954             }
7955 10     10   15  
7956 10         17  
7957 10         17 ##############################################################################
7958             #
7959 10         26 # _write_merge_cells()
7960             #
7961 10         56 # Write the <mergeCells> element.
7962             #
7963              
7964             my $self = shift;
7965             my $merged_cells = $self->{_merge};
7966             my $count = @$merged_cells;
7967              
7968             return unless $count;
7969              
7970             my @attributes = ( 'count' => $count );
7971              
7972             $self->xml_start_tag( 'mergeCells', @attributes );
7973 1     1   11  
7974 1         2 for my $merged_range ( @$merged_cells ) {
7975              
7976 1         4 # Write the mergeCell element.
7977             $self->_write_merge_cell( $merged_range );
7978 1         11 }
7979              
7980             $self->xml_end_tag( 'mergeCells' );
7981             }
7982              
7983              
7984             ##############################################################################
7985             #
7986             # _write_merge_cell()
7987             #
7988             # Write the <mergeCell> element.
7989             #
7990 9     9   22  
7991 9         13 my $self = shift;
7992 9         39 my $merged_range = shift;
7993             my ( $row_min, $col_min, $row_max, $col_max ) = @$merged_range;
7994 9         27  
7995              
7996             # Convert the merge dimensions to a cell range.
7997             my $cell_1 = xl_rowcol_to_cell( $row_min, $col_min );
7998             my $cell_2 = xl_rowcol_to_cell( $row_max, $col_max );
7999 9         46 my $ref = $cell_1 . ':' . $cell_2;
8000              
8001             my @attributes = ( 'ref' => $ref );
8002              
8003             $self->xml_empty_tag( 'mergeCell', @attributes );
8004             }
8005              
8006              
8007             ##############################################################################
8008             #
8009             # _write_print_options()
8010             #
8011 1110     1110   2378 # Write the <printOptions> element.
8012             #
8013              
8014             my $self = shift;
8015             my @attributes = ();
8016              
8017             return unless $self->{_print_options_changed};
8018              
8019             # Set horizontal centering.
8020 1110         6312 if ( $self->{_hcenter} ) {
8021             push @attributes, ( 'horizontalCentered' => 1 );
8022 1110         5233 }
8023              
8024             # Set vertical centering.
8025             if ( $self->{_vcenter} ) {
8026             push @attributes, ( 'verticalCentered' => 1 );
8027             }
8028              
8029             # Enable row and column headers.
8030             if ( $self->{_print_headers} ) {
8031             push @attributes, ( 'headings' => 1 );
8032             }
8033              
8034             # Set printed gridlines.
8035             if ( $self->{_print_gridlines} ) {
8036             push @attributes, ( 'gridLines' => 1 );
8037             }
8038              
8039              
8040             $self->xml_empty_tag( 'printOptions', @attributes );
8041             }
8042              
8043              
8044             ##############################################################################
8045             #
8046             # _write_header_footer()
8047             #
8048             # Write the <headerFooter> element.
8049             #
8050 1104     1104   2526  
8051 1104         2514 my $self = shift;
8052             my @attributes = ();
8053 1104 100       4101  
8054             if ( !$self->{_header_footer_scales} ) {
8055             push @attributes, ( 'scaleWithDoc' => 0 );
8056 23 100       97 }
8057 19         69  
8058             if ( !$self->{_header_footer_aligns} ) {
8059             push @attributes, ( 'alignWithMargins' => 0 );
8060             }
8061 23 100       87  
8062 3         8 if ( $self->{_header_footer_changed} ) {
8063             $self->xml_start_tag( 'headerFooter', @attributes );
8064             $self->_write_odd_header() if $self->{_header};
8065             $self->_write_odd_footer() if $self->{_footer};
8066 23 100 100     135 $self->xml_end_tag( 'headerFooter' );
8067 3         9 }
8068             elsif ( $self->{_excel2003_style} ) {
8069             $self->xml_empty_tag( 'headerFooter', @attributes );
8070 23 100 100     105 }
8071 4         12 }
8072              
8073              
8074             ##############################################################################
8075 23 100       84 #
8076 2         7 # _write_odd_header()
8077             #
8078             # Write the <oddHeader> element.
8079             #
8080 23 100       70  
8081 2         5 my $self = shift;
8082             my $data = $self->{_header};
8083              
8084             $self->xml_data_element( 'oddHeader', $data );
8085 23 100       75 }
8086 2         7  
8087              
8088             ##############################################################################
8089 21         54 #
8090             # _write_odd_footer()
8091             #
8092             # Write the <oddFooter> element.
8093 23 100       71 #
8094 1         3  
8095             my $self = shift;
8096             my $data = $self->{_footer};
8097              
8098 23 100       84 $self->xml_data_element( 'oddFooter', $data );
8099 3         8 }
8100              
8101              
8102             ##############################################################################
8103 23 50       75 #
8104 0         0 # _write_row_breaks()
8105             #
8106             # Write the <rowBreaks> element.
8107 23 100       64 #
8108 5         21  
8109             my $self = shift;
8110              
8111             my @page_breaks = $self->_sort_pagebreaks( @{ $self->{_hbreaks} } );
8112 23         92 my $count = scalar @page_breaks;
8113              
8114             return unless @page_breaks;
8115              
8116             my @attributes = (
8117             'count' => $count,
8118             'manualBreakCount' => $count,
8119             );
8120              
8121             $self->xml_start_tag( 'rowBreaks', @attributes );
8122              
8123             for my $row_num ( @page_breaks ) {
8124 1081     1081   2272 $self->_write_brk( $row_num, 16383 );
8125 1081         2492 }
8126 1081         2318  
8127             $self->xml_end_tag( 'rowBreaks' );
8128 1081 100       3378 }
8129              
8130 14         51  
8131             ##############################################################################
8132 14         433 #
8133             # _write_col_breaks()
8134 14         36 #
8135             # Write the <colBreaks> element.
8136             #
8137 27         62  
8138             my $self = shift;
8139              
8140 14         107 my @page_breaks = $self->_sort_pagebreaks( @{ $self->{_vbreaks} } );
8141             my $count = scalar @page_breaks;
8142              
8143             return unless @page_breaks;
8144              
8145             my @attributes = (
8146             'count' => $count,
8147             'manualBreakCount' => $count,
8148             );
8149              
8150             $self->xml_start_tag( 'colBreaks', @attributes );
8151              
8152 28     28   46 for my $col_num ( @page_breaks ) {
8153 28         40 $self->_write_brk( $col_num, 1048575 );
8154 28         67 }
8155              
8156             $self->xml_end_tag( 'colBreaks' );
8157             }
8158 28         76  
8159 28         80  
8160 28         72 ##############################################################################
8161             #
8162 28         64 # _write_brk()
8163             #
8164 28         74 # Write the <brk> element.
8165             #
8166              
8167             my $self = shift;
8168             my $id = shift;
8169             my $max = shift;
8170             my $man = 1;
8171              
8172             my @attributes = (
8173             'id' => $id,
8174             'max' => $max,
8175             'man' => $man,
8176 1107     1107   2231 );
8177 1107         2524  
8178             $self->xml_empty_tag( 'brk', @attributes );
8179 1107 100       4449 }
8180              
8181              
8182 10 100       26 ##############################################################################
8183 4         16 #
8184             # _write_auto_filter()
8185             #
8186             # Write the <autoFilter> element.
8187 10 100       25 #
8188 4         9  
8189             my $self = shift;
8190             my $ref = $self->{_autofilter_ref};
8191              
8192 10 100       25 return unless $ref;
8193 2         4  
8194             my @attributes = ( 'ref' => $ref );
8195              
8196             if ( $self->{_filter_on} ) {
8197 10 100       24  
8198 4         10 # Autofilter defined active filters.
8199             $self->xml_start_tag( 'autoFilter', @attributes );
8200              
8201             $self->_write_autofilters();
8202 10         40  
8203             $self->xml_end_tag( 'autoFilter' );
8204              
8205             }
8206             else {
8207              
8208             # Autofilter defined without active filters.
8209             $self->xml_empty_tag( 'autoFilter', @attributes );
8210             }
8211              
8212             }
8213              
8214 1102     1102   2679  
8215 1102         2414 ###############################################################################
8216             #
8217 1102 100       4033 # _write_autofilters()
8218 2         7 #
8219             # Function to iterate through the columns that form part of an autofilter
8220             # range and write the appropriate filters.
8221 1102 100       3835 #
8222 10         23  
8223             my $self = shift;
8224              
8225 1102 100       5833 my ( $col1, $col2 ) = @{ $self->{_filter_range} };
    100          
8226 35         134  
8227 35 100       190 for my $col ( $col1 .. $col2 ) {
8228 35 100       155  
8229 35         125 # Skip if column doesn't have an active filter.
8230             next unless $self->{_filter_cols}->{$col};
8231              
8232 7         32 # Retrieve the filter tokens and write the autofilter records.
8233             my @tokens = @{ $self->{_filter_cols}->{$col} };
8234             my $type = $self->{_filter_type}->{$col};
8235              
8236             # Filters are relative to first column in the autofilter.
8237             $self->_write_filter_column( $col - $col1, $type, \@tokens );
8238             }
8239             }
8240              
8241              
8242             ##############################################################################
8243             #
8244             # _write_filter_column()
8245 33     33   146 #
8246 33         78 # Write the <filterColumn> element.
8247             #
8248 33         251  
8249             my $self = shift;
8250             my $col_id = shift;
8251             my $type = shift;
8252             my $filters = shift;
8253              
8254             my @attributes = ( 'colId' => $col_id );
8255              
8256             $self->xml_start_tag( 'filterColumn', @attributes );
8257              
8258              
8259             if ( $type == 1 ) {
8260 14     14   34  
8261 14         131 # Type == 1 is the new XLSX style filter.
8262             $self->_write_filters( @$filters );
8263 14         80  
8264             }
8265             else {
8266              
8267             # Type == 0 is the classic "custom" filter.
8268             $self->_write_custom_filters( @$filters );
8269             }
8270              
8271             $self->xml_end_tag( 'filterColumn' );
8272             }
8273              
8274              
8275 1080     1080   2453 ##############################################################################
8276             #
8277 1080         2417 # _write_filters()
  1080         5351  
8278 1080         2671 #
8279             # Write the <filters> element.
8280 1080 100       3823 #
8281              
8282 6         17 my $self = shift;
8283             my @filters = @_;
8284             my @non_blanks = grep { !/^blanks$/i } @filters;
8285             my @attributes = ();
8286              
8287 6         30 if ( @filters != @non_blanks ) {
8288             @attributes = ( 'blank' => 1 );
8289 6         13 }
8290 1035         1579  
8291             if ( @filters == 1 && @non_blanks == 0 ) {
8292              
8293 6         23 # Special case for blank cells only.
8294             $self->xml_empty_tag( 'filters', @attributes );
8295             }
8296             else {
8297              
8298             # General case.
8299             $self->xml_start_tag( 'filters', @attributes );
8300              
8301             for my $filter ( sort @non_blanks ) {
8302             $self->_write_filter( $filter );
8303             }
8304              
8305 1080     1080   3138 $self->xml_end_tag( 'filters' );
8306             }
8307 1080         2580 }
  1080         4191  
8308 1080         3029  
8309              
8310 1080 100       3849 ##############################################################################
8311             #
8312 5         13 # _write_filter()
8313             #
8314             # Write the <filter> element.
8315             #
8316              
8317 5         32 my $self = shift;
8318             my $val = shift;
8319 5         12  
8320 11         26 my @attributes = ( 'val' => $val );
8321              
8322             $self->xml_empty_tag( 'filter', @attributes );
8323 5         19 }
8324              
8325              
8326             ##############################################################################
8327             #
8328             # _write_custom_filters()
8329             #
8330             # Write the <customFilters> element.
8331             #
8332              
8333             my $self = shift;
8334             my @tokens = @_;
8335 1047     1047   1233  
8336 1047         1187 if ( @tokens == 2 ) {
8337 1047         1152  
8338 1047         1130 # One filter expression only.
8339             $self->xml_start_tag( 'customFilters' );
8340 1047         1669 $self->_write_custom_filter( @tokens );
8341             $self->xml_end_tag( 'customFilters' );
8342              
8343             }
8344             else {
8345              
8346 1047         1698 # Two filter expressions.
8347              
8348             my @attributes;
8349              
8350             # Check if the "join" operand is "and" or "or".
8351             if ( $tokens[2] == 0 ) {
8352             @attributes = ( 'and' => 1 );
8353             }
8354             else {
8355             @attributes = ( 'and' => 0 );
8356             }
8357              
8358 1099     1099   2364 # Write the two custom filters.
8359 1099         2521 $self->xml_start_tag( 'customFilters', @attributes );
8360             $self->_write_custom_filter( $tokens[0], $tokens[1] );
8361 1099 100       4908 $self->_write_custom_filter( $tokens[3], $tokens[4] );
8362             $self->xml_end_tag( 'customFilters' );
8363 32         67 }
8364             }
8365 32 100       70  
8366              
8367             ##############################################################################
8368 29         179 #
8369             # _write_custom_filter()
8370 29         89 #
8371             # Write the <customFilter> element.
8372 29         59 #
8373              
8374             my $self = shift;
8375             my $operator = shift;
8376             my $val = shift;
8377             my @attributes = ();
8378 3         52  
8379             my %operators = (
8380             1 => 'lessThan',
8381             2 => 'equal',
8382             3 => 'lessThanOrEqual',
8383             4 => 'greaterThan',
8384             5 => 'notEqual',
8385             6 => 'greaterThanOrEqual',
8386             22 => 'equal',
8387             );
8388              
8389              
8390             # Convert the operator from a number to a descriptive string.
8391             if ( defined $operators{$operator} ) {
8392             $operator = $operators{$operator};
8393 29     29   46 }
8394             else {
8395 29         36 croak "Unknown operator = $operator\n";
  29         62  
8396             }
8397 29         75  
8398             # The 'equal' operator is the default attribute and isn't stored.
8399             push @attributes, ( 'operator' => $operator ) unless $operator eq 'equal';
8400 116 100       248 push @attributes, ( 'val' => $val );
8401              
8402             $self->xml_empty_tag( 'customFilter', @attributes );
8403 30         47 }
  30         71  
8404 30         62  
8405              
8406             ##############################################################################
8407 30         137 #
8408             # _write_hyperlinks()
8409             #
8410             # Process any stored hyperlinks in row/col order and write the <hyperlinks>
8411             # element. The attributes are different for internal and external links.
8412             #
8413              
8414             my $self = shift;
8415             my @hlink_refs;
8416              
8417             # Sort the hyperlinks into row order.
8418             my @row_nums = sort { $a <=> $b } keys %{ $self->{_hyperlinks} };
8419              
8420 31     31   55 # Exit if there are no hyperlinks to process.
8421 31         45 return if !@row_nums;
8422 31         40  
8423 31         42 # Iterate over the rows.
8424             for my $row_num ( @row_nums ) {
8425 31         50  
8426             # Sort the hyperlinks into column order.
8427 31         140 my @col_nums = sort { $a <=> $b }
8428             keys %{ $self->{_hyperlinks}->{$row_num} };
8429              
8430 31 100       79 # Iterate over the columns.
8431             for my $col_num ( @col_nums ) {
8432              
8433 15         79 # Get the link data for this cell.
8434             my $link = $self->{_hyperlinks}->{$row_num}->{$col_num};
8435             my $link_type = $link->{_link_type};
8436              
8437              
8438             # If the cell isn't a string then we have to add the url as
8439 16         38 # the string to display.
8440             my $display;
8441             if ( $self->{_table}
8442 31         78 && $self->{_table}->{$row_num}
8443             && $self->{_table}->{$row_num}->{$col_num} )
8444             {
8445             my $cell = $self->{_table}->{$row_num}->{$col_num};
8446             $display = $link->{_url} if $cell->[0] ne 's';
8447             }
8448              
8449              
8450             if ( $link_type == 1 ) {
8451              
8452             # External link with rel file relationship.
8453             push @hlink_refs,
8454 18     18   72 [
8455 18         52 $link_type, $row_num,
8456 18         56 $col_num, ++$self->{_rel_count},
  31         102  
8457 18         42 $link->{_str}, $display,
8458             $link->{_tip}
8459 18 100       55 ];
8460 4         11  
8461             # Links for use by the packager.
8462             push @{ $self->{_external_hyper_links} },
8463 18 100 100     82 [ '/hyperlink', $link->{_url}, 'External' ];
8464             }
8465             else {
8466 2         8  
8467             # Internal link with rel file relationship.
8468             push @hlink_refs,
8469             [
8470             $link_type, $row_num, $col_num,
8471 16         59 $link->{_url}, $link->{_str}, $link->{_tip}
8472             ];
8473 16         63 }
8474 27         63 }
8475             }
8476              
8477 16         59 # Write the hyperlink elements.
8478             $self->xml_start_tag( 'hyperlinks' );
8479              
8480             for my $aref ( @hlink_refs ) {
8481             my ( $type, @args ) = @$aref;
8482              
8483             if ( $type == 1 ) {
8484             $self->_write_hyperlink_external( @args );
8485             }
8486             elsif ( $type == 2 ) {
8487             $self->_write_hyperlink_internal( @args );
8488             }
8489             }
8490 28     28   51  
8491 28         130 $self->xml_end_tag( 'hyperlinks' );
8492             }
8493 28         70  
8494              
8495 28         85 ##############################################################################
8496             #
8497             # _write_hyperlink_external()
8498             #
8499             # Write the <hyperlink> element for external links.
8500             #
8501              
8502             my $self = shift;
8503             my $row = shift;
8504             my $col = shift;
8505             my $id = shift;
8506             my $location = shift;
8507 18     18   75 my $display = shift;
8508 18         40 my $tooltip = shift;
8509              
8510 18 100       49 my $ref = xl_rowcol_to_cell( $row, $col );
8511             my $r_id = 'rId' . $id;
8512              
8513 14         42 my @attributes = (
8514 14         36 'ref' => $ref,
8515 14         35 'r:id' => $r_id,
8516             );
8517              
8518             push @attributes, ( 'location' => $location ) if defined $location;
8519             push @attributes, ( 'display' => $display ) if defined $display;
8520             push @attributes, ( 'tooltip' => $tooltip ) if defined $tooltip;
8521              
8522 4         7 $self->xml_empty_tag( 'hyperlink', @attributes );
8523             }
8524              
8525 4 50       21  
8526 4         12 ##############################################################################
8527             #
8528             # _write_hyperlink_internal()
8529 0         0 #
8530             # Write the <hyperlink> element for internal links.
8531             #
8532              
8533 4         17 my $self = shift;
8534 4         20 my $row = shift;
8535 4         14 my $col = shift;
8536 4         12 my $location = shift;
8537             my $display = shift;
8538             my $tooltip = shift;
8539              
8540             my $ref = xl_rowcol_to_cell( $row, $col );
8541              
8542             my @attributes = ( 'ref' => $ref, 'location' => $location );
8543              
8544             push @attributes, ( 'tooltip' => $tooltip ) if defined $tooltip;
8545             push @attributes, ( 'display' => $display );
8546              
8547             $self->xml_empty_tag( 'hyperlink', @attributes );
8548             }
8549 23     23   46  
8550 23         30  
8551 23         58 ##############################################################################
8552 23         35 #
8553             # _write_panes()
8554 23         126 #
8555             # Write the frozen or split <pane> elements.
8556             #
8557              
8558             my $self = shift;
8559             my @panes = @{ $self->{_panes} };
8560              
8561             return unless @panes;
8562              
8563             if ( $panes[4] == 2 ) {
8564             $self->_write_split_panes( @panes );
8565             }
8566 23 50       59 else {
8567 23         41 $self->_write_freeze_panes( @panes );
8568             }
8569             }
8570 0         0  
8571              
8572             ##############################################################################
8573             #
8574 23 100       69 # _write_freeze_panes()
8575 23         37 #
8576             # Write the <pane> element for freeze panes.
8577 23         72 #
8578              
8579             my $self = shift;
8580             my @attributes;
8581              
8582             my ( $row, $col, $top_row, $left_col, $type ) = @_;
8583              
8584             my $y_split = $row;
8585             my $x_split = $col;
8586             my $top_left_cell = xl_rowcol_to_cell( $top_row, $left_col );
8587             my $active_pane;
8588             my $state;
8589             my $active_cell;
8590 1078     1078   2201 my $sqref;
8591 1078         1985  
8592             # Move user cell selection to the panes.
8593             if ( @{ $self->{_selections} } ) {
8594 1078         2018 ( undef, $active_cell, $sqref ) = @{ $self->{_selections}->[0] };
  50         111  
  1078         4498  
8595             $self->{_selections} = [];
8596             }
8597 1078 100       3756  
8598             # Set the active pane.
8599             if ( $row && $col ) {
8600 49         164 $active_pane = 'bottomRight';
8601              
8602             my $row_cell = xl_rowcol_to_cell( $row, 0 );
8603 1         4 my $col_cell = xl_rowcol_to_cell( 0, $col );
8604 81         133  
  81         304  
8605             push @{ $self->{_selections} },
8606             (
8607 81         186 [ 'topRight', $col_cell, $col_cell ],
8608             [ 'bottomLeft', $row_cell, $row_cell ],
8609             [ 'bottomRight', $active_cell, $sqref ]
8610 82         153 );
8611 82         149 }
8612             elsif ( $col ) {
8613             $active_pane = 'topRight';
8614             push @{ $self->{_selections} }, [ 'topRight', $active_cell, $sqref ];
8615             }
8616 82         127 else {
8617 82 50 66     555 $active_pane = 'bottomLeft';
      66        
8618             push @{ $self->{_selections} }, [ 'bottomLeft', $active_cell, $sqref ];
8619             }
8620              
8621 81         143 # Set the pane type.
8622 81 100       246 if ( $type == 0 ) {
8623             $state = 'frozen';
8624             }
8625             elsif ( $type == 1 ) {
8626 82 100       225 $state = 'frozenSplit';
8627             }
8628             else {
8629             $state = 'split';
8630             }
8631              
8632              
8633             push @attributes, ( 'xSplit' => $x_split ) if $x_split;
8634             push @attributes, ( 'ySplit' => $y_split ) if $y_split;
8635 74         284  
8636             push @attributes, ( 'topLeftCell' => $top_left_cell );
8637             push @attributes, ( 'activePane' => $active_pane );
8638 74         301 push @attributes, ( 'state' => $state );
8639 74         130  
8640              
8641             $self->xml_empty_tag( 'pane', @attributes );
8642             }
8643              
8644              
8645             ##############################################################################
8646             #
8647             # _write_split_panes()
8648 8         31 #
8649             # Write the <pane> element for split panes.
8650             #
8651             # See also, implementers note for split_panes().
8652             #
8653              
8654 49         219 my $self = shift;
8655             my @attributes;
8656 49         120 my $y_split;
8657 82         243 my $x_split;
8658             my $has_selection = 0;
8659 82 100       209 my $active_pane;
    50          
8660 74         224 my $active_cell;
8661             my $sqref;
8662              
8663 8         14 my ( $row, $col, $top_row, $left_col, $type ) = @_;
8664             $y_split = $row;
8665             $x_split = $col;
8666              
8667 49         185 # Move user cell selection to the panes.
8668             if ( @{ $self->{_selections} } ) {
8669             ( undef, $active_cell, $sqref ) = @{ $self->{_selections}->[0] };
8670             $self->{_selections} = [];
8671             $has_selection = 1;
8672             }
8673              
8674             # Convert the row and col to 1/20 twip units with padding.
8675             $y_split = int( 20 * $y_split + 300 ) if $y_split;
8676             $x_split = $self->_calculate_x_split_width( $x_split ) if $x_split;
8677              
8678             # For non-explicit topLeft definitions, estimate the cell offset based
8679 75     75   136 # on the pixels dimensions. This is only a workaround and doesn't take
8680 75         139 # adjusted cell dimensions into account.
8681 75         114 if ( $top_row == $row && $left_col == $col ) {
8682 75         136 $top_row = int( 0.5 + ( $y_split - 300 ) / 20 / 15 );
8683 75         121 $left_col = int( 0.5 + ( $x_split - 390 ) / 20 / 3 * 4 / 64 );
8684 75         134 }
8685 75         113  
8686             my $top_left_cell = xl_rowcol_to_cell( $top_row, $left_col );
8687 75         213  
8688 75         180 # If there is no selection set the active cell to the top left cell.
8689             if ( !$has_selection ) {
8690 75         229 $active_cell = $top_left_cell;
8691             $sqref = $top_left_cell;
8692             }
8693              
8694             # Set the Cell selections.
8695 75 100       214 if ( $row && $col ) {
8696 75 100       196 $active_pane = 'bottomRight';
8697 75 100       195  
8698             my $row_cell = xl_rowcol_to_cell( $top_row, 0 );
8699 75         262 my $col_cell = xl_rowcol_to_cell( 0, $left_col );
8700              
8701             push @{ $self->{_selections} },
8702             (
8703             [ 'topRight', $col_cell, $col_cell ],
8704             [ 'bottomLeft', $row_cell, $row_cell ],
8705             [ 'bottomRight', $active_cell, $sqref ]
8706             );
8707             }
8708             elsif ( $col ) {
8709             $active_pane = 'topRight';
8710             push @{ $self->{_selections} }, [ 'topRight', $active_cell, $sqref ];
8711 11     11   68 }
8712 11         22 else {
8713 11         15 $active_pane = 'bottomLeft';
8714 11         20 push @{ $self->{_selections} }, [ 'bottomLeft', $active_cell, $sqref ];
8715 11         12 }
8716 11         15  
8717             push @attributes, ( 'xSplit' => $x_split ) if $x_split;
8718 11         25 push @attributes, ( 'ySplit' => $y_split ) if $y_split;
8719             push @attributes, ( 'topLeftCell' => $top_left_cell );
8720 11         27 push @attributes, ( 'activePane' => $active_pane ) if $has_selection;
8721              
8722 11 100       23 $self->xml_empty_tag( 'pane', @attributes );
8723 11         20 }
8724              
8725 11         35  
8726             ##############################################################################
8727             #
8728             # _calculate_x_split_width()
8729             #
8730             # Convert column width from user units to pane split width.
8731             #
8732              
8733             my $self = shift;
8734             my $width = shift;
8735              
8736             my $max_digit_width = 7; # For Calabri 11.
8737 83     83   158 my $padding = 5;
8738 83         122 my $pixels;
  83         239  
8739              
8740 83 100       202 # Convert to pixels.
8741             if ( $width < 1 ) {
8742 66 100       156 $pixels = int( $width * ( $max_digit_width + $padding ) + 0.5 );
8743 38         99 }
8744             else {
8745             $pixels = int( $width * $max_digit_width + 0.5 ) + $padding;
8746 28         75 }
8747              
8748             # Convert to points.
8749             my $points = $pixels * 3 / 4;
8750              
8751             # Convert to twips (twentieths of a point).
8752             my $twips = $points * 20;
8753              
8754             # Add offset/padding.
8755             $width = $twips + 390;
8756              
8757             return $width;
8758             }
8759 28     28   42  
8760 28         44  
8761             ##############################################################################
8762 28         65 #
8763             # _write_tab_color()
8764 28         50 #
8765 28         38 # Write the <tabColor> element.
8766 28         76 #
8767 28         93  
8768             my $self = shift;
8769 28         0 my $color_index = $self->{_tab_color};
8770 28         0  
8771             return unless $color_index;
8772              
8773 28 100       41 my $rgb = $self->_get_palette_color( $color_index );
  28         71  
8774 7         10  
  7         16  
8775 7         15 my @attributes = ( 'rgb' => $rgb );
8776              
8777             $self->xml_empty_tag( 'tabColor', @attributes );
8778             }
8779 28 100 100     117  
    100          
8780 13         26  
8781             ##############################################################################
8782 13         36 #
8783 13         37 # _write_outline_pr()
8784             #
8785 13         24 # Write the <outlinePr> element.
  13         56  
8786             #
8787              
8788             my $self = shift;
8789             my @attributes = ();
8790              
8791             return unless $self->{_outline_changed};
8792              
8793 7         20 push @attributes, ( "applyStyles" => 1 ) if $self->{_outline_style};
8794 7         14 push @attributes, ( "summaryBelow" => 0 ) if !$self->{_outline_below};
  7         26  
8795             push @attributes, ( "summaryRight" => 0 ) if !$self->{_outline_right};
8796             push @attributes, ( "showOutlineSymbols" => 0 ) if !$self->{_outline_on};
8797 8         28  
8798 8         15 $self->xml_empty_tag( 'outlinePr', @attributes );
  8         30  
8799             }
8800              
8801              
8802 28 100       109 ##############################################################################
    50          
8803 25         45 #
8804             # _write_sheet_protection()
8805             #
8806 3         7 # Write the <sheetProtection> element.
8807             #
8808              
8809 0         0 my $self = shift;
8810             my @attributes;
8811              
8812             return unless $self->{_protect};
8813 28 100       70  
8814 28 100       77 my %arg = %{ $self->{_protect} };
8815              
8816 28         53 push @attributes, ( "password" => $arg{password} ) if $arg{password};
8817 28         48 push @attributes, ( "sheet" => 1 ) if $arg{sheet};
8818 28         49 push @attributes, ( "content" => 1 ) if $arg{content};
8819             push @attributes, ( "objects" => 1 ) if !$arg{objects};
8820             push @attributes, ( "scenarios" => 1 ) if !$arg{scenarios};
8821 28         109 push @attributes, ( "formatCells" => 0 ) if $arg{format_cells};
8822             push @attributes, ( "formatColumns" => 0 ) if $arg{format_columns};
8823             push @attributes, ( "formatRows" => 0 ) if $arg{format_rows};
8824             push @attributes, ( "insertColumns" => 0 ) if $arg{insert_columns};
8825             push @attributes, ( "insertRows" => 0 ) if $arg{insert_rows};
8826             push @attributes, ( "insertHyperlinks" => 0 ) if $arg{insert_hyperlinks};
8827             push @attributes, ( "deleteColumns" => 0 ) if $arg{delete_columns};
8828             push @attributes, ( "deleteRows" => 0 ) if $arg{delete_rows};
8829              
8830             push @attributes, ( "selectLockedCells" => 1 )
8831             if !$arg{select_locked_cells};
8832              
8833             push @attributes, ( "sort" => 0 ) if $arg{sort};
8834             push @attributes, ( "autoFilter" => 0 ) if $arg{autofilter};
8835 38     38   99 push @attributes, ( "pivotTables" => 0 ) if $arg{pivot_tables};
8836 38         94  
8837             push @attributes, ( "selectUnlockedCells" => 1 )
8838 38         0 if !$arg{select_unlocked_cells};
8839 38         56  
8840 38         85  
8841             $self->xml_empty_tag( 'sheetProtection', @attributes );
8842 38         0 }
8843              
8844 38         84  
8845 38         58 ##############################################################################
8846 38         57 #
8847             # _write_protected_ranges()
8848             #
8849 38 100       45 # Write the <protectedRanges> element.
  38         97  
8850 8         12 #
  8         27  
8851 8         17  
8852 8         17 my $self = shift;
8853              
8854             return if $self->{_num_protected_ranges} == 0;
8855              
8856 38 100       102 $self->xml_start_tag( 'protectedRanges' );
8857 38 100       100  
8858             for my $aref (@{ $self->{_protected_ranges} }) {
8859             $self->_write_protected_range(@$aref);
8860             }
8861              
8862 38 100 100     140 $self->xml_end_tag( 'protectedRanges' );
8863 26         64 }
8864 26         64  
8865              
8866             ##############################################################################
8867 38         101 #
8868             # _write_protected_range()
8869             #
8870 38 100       81 # Write the <protectedRange> element.
8871 30         47 #
8872 30         42  
8873             my $self = shift;
8874             my $sqref = shift;
8875             my $name = shift;
8876 38 100 100     140 my $password = shift;
    100          
8877 10         17  
8878             my @attributes = ();
8879 10         27  
8880 10         29 push @attributes, ( 'password' => $password ) if $password;
8881             push @attributes, ( 'sqref' => $sqref );
8882 10         17 push @attributes, ( 'name' => $name );
  10         52  
8883              
8884             $self->xml_empty_tag( 'protectedRange', @attributes );
8885             }
8886              
8887              
8888             ##############################################################################
8889             #
8890 14         22 # _write_drawings()
8891 14         22 #
  14         43  
8892             # Write the <drawing> elements.
8893             #
8894 14         23  
8895 14         19 my $self = shift;
  14         53  
8896              
8897             return unless $self->{_drawing};
8898 38 100       136  
8899 38 100       89 $self->_write_drawing( ++$self->{_rel_count} );
8900 38         69 }
8901 38 100       74  
8902              
8903 38         119 ##############################################################################
8904             #
8905             # _write_drawing()
8906             #
8907             # Write the <drawing> element.
8908             #
8909              
8910             my $self = shift;
8911             my $id = shift;
8912             my $r_id = 'rId' . $id;
8913              
8914             my @attributes = ( 'r:id' => $r_id );
8915 24     24   39  
8916 24         35 $self->xml_empty_tag( 'drawing', @attributes );
8917             }
8918 24         34  
8919 24         34  
8920 24         31 ##############################################################################
8921             #
8922             # _write_legacy_drawing()
8923 24 50       63 #
8924 0         0 # Write the <legacyDrawing> element.
8925             #
8926              
8927 24         61 my $self = shift;
8928             my $id;
8929              
8930             return unless $self->{_has_vml};
8931 24         52  
8932             # Increment the relationship id for any drawings or comments.
8933             $id = ++$self->{_rel_count};
8934 24         37  
8935             my @attributes = ( 'r:id' => 'rId' . $id );
8936              
8937 24         39 $self->xml_empty_tag( 'legacyDrawing', @attributes );
8938             }
8939 24         42  
8940              
8941             ##############################################################################
8942             #
8943             # _write_legacy_drawing_hf()
8944             #
8945             # Write the <legacyDrawingHF> element.
8946             #
8947              
8948             my $self = shift;
8949             my $id;
8950              
8951 13     13   41 return unless $self->{_has_header_vml};
8952 13         25  
8953             # Increment the relationship id for any drawings or comments.
8954 13 100       34 $id = ++$self->{_rel_count};
8955              
8956 5         19 my @attributes = ( 'r:id' => 'rId' . $id );
8957              
8958 5         21 $self->xml_empty_tag( 'legacyDrawingHF', @attributes );
8959             }
8960 5         35  
8961              
8962             ##############################################################################
8963             #
8964             # _write_picture()
8965             #
8966             # Write the <picture> element.
8967             #
8968              
8969             my $self = shift;
8970             my $id;
8971              
8972 11     11   19 return unless $self->{_background_image};
8973 11         21  
8974             # Increment the relationship id.
8975 11 100       31 $id = ++$self->{_rel_count};
8976              
8977 1 50       3 my @attributes = ( 'r:id' => 'rId' . $id );
8978 1 50       4  
8979 1 50       4 $self->xml_empty_tag( 'picture', @attributes );
8980 1 50       4 }
8981              
8982 1         10  
8983             #
8984             # Note, the following font methods are, more or less, duplicated from the
8985             # Excel::Writer::XLSX::Package::Styles class. I will look at implementing
8986             # this is a cleaner encapsulated mode at a later stage.
8987             #
8988              
8989              
8990             ##############################################################################
8991             #
8992             # _write_font()
8993             #
8994 1124     1124   2446 # Write the <font> element.
8995 1124         2419 #
8996              
8997 1124 100       4952 my $self = shift;
8998             my $format = shift;
8999 30         45  
  30         219  
9000             $self->{_rstring}->xml_start_tag( 'rPr' );
9001 30 100       95  
9002 30 100       78 $self->{_rstring}->xml_empty_tag( 'b' ) if $format->{_bold};
9003 30 100       70 $self->{_rstring}->xml_empty_tag( 'i' ) if $format->{_italic};
9004 30 100       86 $self->{_rstring}->xml_empty_tag( 'strike' ) if $format->{_font_strikeout};
9005 30 100       76 $self->{_rstring}->xml_empty_tag( 'outline' ) if $format->{_font_outline};
9006 30 100       66 $self->{_rstring}->xml_empty_tag( 'shadow' ) if $format->{_font_shadow};
9007 30 100       74  
9008 30 100       56 # Handle the underline variants.
9009 30 100       64 $self->_write_underline( $format->{_underline} ) if $format->{_underline};
9010 30 100       91  
9011 30 100       60 $self->_write_vert_align( 'superscript' ) if $format->{_font_script} == 1;
9012 30 100       57 $self->_write_vert_align( 'subscript' ) if $format->{_font_script} == 2;
9013 30 100       59  
9014             $self->{_rstring}->xml_empty_tag( 'sz', 'val', $format->{_size} );
9015              
9016 30 100       70 if ( my $theme = $format->{_theme} ) {
9017             $self->_write_rstring_color( 'theme' => $theme );
9018 30 100       61 }
9019 30 100       59 elsif ( my $color = $format->{_color} ) {
9020 30 100       68 $color = $self->_get_palette_color( $color );
9021              
9022             $self->_write_rstring_color( 'rgb' => $color );
9023 30 100       57 }
9024             else {
9025             $self->_write_rstring_color( 'theme' => 1 );
9026 30         98 }
9027              
9028             $self->{_rstring}->xml_empty_tag( 'rFont', 'val', $format->{_font} );
9029             $self->{_rstring}
9030             ->xml_empty_tag( 'family', 'val', $format->{_font_family} );
9031              
9032             if ( $format->{_font} eq 'Calibri' && !$format->{_hyperlink} ) {
9033             $self->{_rstring}
9034             ->xml_empty_tag( 'scheme', 'val', $format->{_font_scheme} );
9035             }
9036              
9037             $self->{_rstring}->xml_end_tag( 'rPr' );
9038 1078     1078   2302 }
9039              
9040 1078 100       4605  
9041             ###############################################################################
9042 3         11 #
9043             # _write_underline()
9044 3         5 #
  3         11  
9045 9         20 # Write the underline font element.
9046             #
9047              
9048 3         25 my $self = shift;
9049             my $underline = shift;
9050             my @attributes;
9051              
9052             # Handle the underline variants.
9053             if ( $underline == 2 ) {
9054             @attributes = ( val => 'double' );
9055             }
9056             elsif ( $underline == 33 ) {
9057             @attributes = ( val => 'singleAccounting' );
9058             }
9059             elsif ( $underline == 34 ) {
9060 9     9   12 @attributes = ( val => 'doubleAccounting' );
9061 9         15 }
9062 9         13 else {
9063 9         12 @attributes = (); # Default to single underline.
9064             }
9065 9         13  
9066             $self->{_rstring}->xml_empty_tag( 'u', @attributes );
9067 9 100       17  
9068 9         24 }
9069 9         15  
9070              
9071 9         21 ##############################################################################
9072             #
9073             # _write_vert_align()
9074             #
9075             # Write the <vertAlign> font sub-element.
9076             #
9077              
9078             my $self = shift;
9079             my $val = shift;
9080              
9081             my @attributes = ( 'val' => $val );
9082              
9083 1099     1099   3255 $self->{_rstring}->xml_empty_tag( 'vertAlign', @attributes );
9084             }
9085 1099 100       5064  
9086              
9087 524         2872 ##############################################################################
9088             #
9089             # _write_rstring_color()
9090             #
9091             # Write the <color> element.
9092             #
9093              
9094             my $self = shift;
9095             my $name = shift;
9096             my $value = shift;
9097              
9098             my @attributes = ( $name => $value );
9099 524     524   2375  
9100 524         3194 $self->{_rstring}->xml_empty_tag( 'color', @attributes );
9101 524         2783 }
9102              
9103 524         3088  
9104             #
9105 524         3271 # End font duplication code.
9106             #
9107              
9108              
9109             ##############################################################################
9110             #
9111             # _write_data_validations()
9112             #
9113             # Write the <dataValidations> element.
9114             #
9115              
9116             my $self = shift;
9117 1079     1079   3149 my @validations = @{ $self->{_validations} };
9118 1079         3308 my $count = @validations;
9119              
9120 1079 100       4371 return unless $count;
9121              
9122             my @attributes = ( 'count' => $count );
9123 59         128  
9124             $self->xml_start_tag( 'dataValidations', @attributes );
9125 59         198  
9126             for my $validation ( @validations ) {
9127 59         325  
9128             # Write the dataValidation element.
9129             $self->_write_data_validation( $validation );
9130             }
9131              
9132             $self->xml_end_tag( 'dataValidations' );
9133             }
9134              
9135              
9136             ##############################################################################
9137             #
9138             # _write_data_validation()
9139 1078     1078   2472 #
9140 1078         2124 # Write the <dataValidation> element.
9141             #
9142 1078 100       4327  
9143             my $self = shift;
9144             my $param = shift;
9145 24         52 my $sqref = '';
9146             my @attributes = ();
9147 24         89  
9148              
9149 24         80 # Set the cell range(s) for the data validation.
9150             for my $cells ( @{ $param->{cells} } ) {
9151              
9152             # Add a space between multiple cell ranges.
9153             $sqref .= ' ' if $sqref ne '';
9154              
9155             my ( $row_first, $col_first, $row_last, $col_last ) = @$cells;
9156              
9157             # Swap last row/col for first row/col as necessary
9158             if ( $row_first > $row_last ) {
9159             ( $row_first, $row_last ) = ( $row_last, $row_first );
9160             }
9161 1078     1078   2822  
9162 1078         3118 if ( $col_first > $col_last ) {
9163             ( $col_first, $col_last ) = ( $col_last, $col_first );
9164 1078 100       4669 }
9165              
9166             $sqref .= xl_range( $row_first, $row_last, $col_first, $col_last );
9167 8         13 }
9168              
9169 8         25  
9170             if ( $param->{validate} ne 'none' ) {
9171 8         23  
9172             push @attributes, ( 'type' => $param->{validate} );
9173              
9174             if ( $param->{criteria} ne 'between' ) {
9175             push @attributes, ( 'operator' => $param->{criteria} );
9176             }
9177              
9178             }
9179              
9180             if ( $param->{error_type} ) {
9181             push @attributes, ( 'errorStyle' => 'warning' )
9182             if $param->{error_type} == 1;
9183             push @attributes, ( 'errorStyle' => 'information' )
9184             if $param->{error_type} == 2;
9185             }
9186              
9187             push @attributes, ( 'allowBlank' => 1 ) if $param->{ignore_blank};
9188             push @attributes, ( 'showDropDown' => 1 ) if !$param->{dropdown};
9189             push @attributes, ( 'showInputMessage' => 1 ) if $param->{show_input};
9190 56     56   80 push @attributes, ( 'showErrorMessage' => 1 ) if $param->{show_error};
9191 56         69  
9192             push @attributes, ( 'errorTitle' => $param->{error_title} )
9193 56         131 if $param->{error_title};
9194              
9195 56 100       198 push @attributes, ( 'error' => $param->{error_message} )
9196 56 100       128 if $param->{error_message};
9197 56 50       112  
9198 56 50       121 push @attributes, ( 'promptTitle' => $param->{input_title} )
9199 56 50       106 if $param->{input_title};
9200              
9201             push @attributes, ( 'prompt' => $param->{input_message} )
9202 56 50       111 if $param->{input_message};
9203              
9204 56 50       111 push @attributes, ( 'sqref' => $sqref );
9205 56 50       103  
9206             if ( $param->{validate} eq 'none' ) {
9207 56         201 $self->xml_empty_tag( 'dataValidation', @attributes );
9208             }
9209 56 50       205 else {
    100          
9210 0         0 $self->xml_start_tag( 'dataValidation', @attributes );
9211              
9212             # Write the formula1 element.
9213 1         4 $self->_write_formula_1( $param->{value} );
9214              
9215 1         4 # Write the formula2 element.
9216             $self->_write_formula_2( $param->{maximum} )
9217             if defined $param->{maximum};
9218 55         138  
9219             $self->xml_end_tag( 'dataValidation' );
9220             }
9221 56         185 }
9222              
9223 56         153  
9224             ##############################################################################
9225 56 50 33     238 #
9226             # _write_formula_1()
9227 56         140 #
9228             # Write the <formula1> element.
9229             #
9230 56         129  
9231             my $self = shift;
9232             my $formula = shift;
9233              
9234             # Convert a list array ref into a comma separated string.
9235             if ( ref $formula eq 'ARRAY' ) {
9236             $formula = join ',', @$formula;
9237             $formula = qq("$formula");
9238             }
9239              
9240             $formula =~ s/^=//; # Remove formula symbol.
9241              
9242 0     0   0 $self->xml_data_element( 'formula1', $formula );
9243 0         0 }
9244 0         0  
9245              
9246             ##############################################################################
9247 0 0       0 #
    0          
    0          
9248 0         0 # _write_formula_2()
9249             #
9250             # Write the <formula2> element.
9251 0         0 #
9252              
9253             my $self = shift;
9254 0         0 my $formula = shift;
9255              
9256             $formula =~ s/^=//; # Remove formula symbol.
9257 0         0  
9258             $self->xml_data_element( 'formula2', $formula );
9259             }
9260 0         0  
9261              
9262             ##############################################################################
9263             #
9264             # _write_conditional_formats()
9265             #
9266             # Write the Worksheet conditional formats.
9267             #
9268              
9269             my $self = shift;
9270             my @ranges = sort keys %{ $self->{_cond_formats} };
9271              
9272             return unless scalar @ranges;
9273 0     0   0  
9274 0         0 for my $range ( @ranges ) {
9275             $self->_write_conditional_formatting( $range,
9276 0         0 $self->{_cond_formats}->{$range} );
9277             }
9278 0         0 }
9279              
9280              
9281             ##############################################################################
9282             #
9283             # _write_conditional_formatting()
9284             #
9285             # Write the <conditionalFormatting> element.
9286             #
9287              
9288             my $self = shift;
9289             my $range = shift;
9290 56     56   77 my $params = shift;
9291 56         71  
9292 56         65 my @attributes = ( 'sqref' => $range );
9293              
9294 56         118 $self->xml_start_tag( 'conditionalFormatting', @attributes );
9295              
9296 56         127 for my $param ( @$params ) {
9297              
9298             # Write the cfRule element.
9299             $self->_write_cf_rule( $param );
9300             }
9301              
9302             $self->xml_end_tag( 'conditionalFormatting' );
9303             }
9304              
9305             ##############################################################################
9306             #
9307             # _write_cf_rule()
9308             #
9309             # Write the <cfRule> element.
9310             #
9311              
9312             my $self = shift;
9313 1134     1134   2411 my $param = shift;
9314 1134         2147  
  1134         3146  
9315 1134         2312 my @attributes = ( 'type' => $param->{type} );
9316              
9317 1134 100       3499 push @attributes, ( 'dxfId' => $param->{format} )
9318             if defined $param->{format};
9319 62         113  
9320             push @attributes, ( 'priority' => $param->{priority} );
9321 62         189  
9322             push @attributes, ( 'stopIfTrue' => 1 )
9323 62         137 if $param->{stop_if_true};
9324              
9325             if ( $param->{type} eq 'cellIs' ) {
9326 64         129 push @attributes, ( 'operator' => $param->{criteria} );
9327              
9328             $self->xml_start_tag( 'cfRule', @attributes );
9329 62         132  
9330             if ( defined $param->{minimum} && defined $param->{maximum} ) {
9331             $self->_write_formula( $param->{minimum} );
9332             $self->_write_formula( $param->{maximum} );
9333             }
9334             else {
9335             my $value = $param->{value};
9336              
9337             # String "Cell" values must be quoted, apart from ranges.
9338             if ( $value !~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/
9339             && $value !~
9340             /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ )
9341 64     64   87 {
9342 64         73 if ( $value !~ /^".*"$/ ) {
9343 64         102 $value = qq("$value");
9344 64         96 }
9345             }
9346              
9347             $self->_write_formula( $value );
9348 64         78 }
  64         131  
9349              
9350             $self->xml_end_tag( 'cfRule' );
9351 68 100       138 }
9352             elsif ( $param->{type} eq 'aboveAverage' ) {
9353 68         143 if ( $param->{criteria} =~ /below/ ) {
9354             push @attributes, ( 'aboveAverage' => 0 );
9355             }
9356 68 50       149  
9357 0         0 if ( $param->{criteria} =~ /equal/ ) {
9358             push @attributes, ( 'equalAverage' => 1 );
9359             }
9360 68 50       132  
9361 0         0 if ( $param->{criteria} =~ /([123]) std dev/ ) {
9362             push @attributes, ( 'stdDev' => $1 );
9363             }
9364 68         186  
9365             $self->xml_empty_tag( 'cfRule', @attributes );
9366             }
9367             elsif ( $param->{type} eq 'top10' ) {
9368 64 100       164 if ( defined $param->{criteria} && $param->{criteria} eq '%' ) {
9369             push @attributes, ( 'percent' => 1 );
9370 62         159 }
9371              
9372 62 100       133 if ( $param->{direction} ) {
9373 26         42 push @attributes, ( 'bottom' => 1 );
9374             }
9375              
9376             my $rank = $param->{value} || 10;
9377             push @attributes, ( 'rank' => $rank );
9378 64 100       132  
9379             $self->xml_empty_tag( 'cfRule', @attributes );
9380 2 100       7 }
9381             elsif ( $param->{type} eq 'duplicateValues' ) {
9382 2 100       7 $self->xml_empty_tag( 'cfRule', @attributes );
9383             }
9384             elsif ( $param->{type} eq 'uniqueValues' ) {
9385 64 100       155 $self->xml_empty_tag( 'cfRule', @attributes );
9386 64 100       120 }
9387 64 100       131 elsif ($param->{type} eq 'containsText'
9388 64 100       137 || $param->{type} eq 'notContainsText'
9389             || $param->{type} eq 'beginsWith'
9390             || $param->{type} eq 'endsWith' )
9391 64 100       135 {
9392             push @attributes, ( 'operator' => $param->{criteria} );
9393             push @attributes, ( 'text' => $param->{value} );
9394 64 100       145  
9395             $self->xml_start_tag( 'cfRule', @attributes );
9396             $self->_write_formula( $param->{formula} );
9397 64 100       126 $self->xml_end_tag( 'cfRule' );
9398             }
9399             elsif ( $param->{type} eq 'timePeriod' ) {
9400 64 100       140 push @attributes, ( 'timePeriod' => $param->{criteria} );
9401              
9402 64         110 $self->xml_start_tag( 'cfRule', @attributes );
9403             $self->_write_formula( $param->{formula} );
9404 64 100       134 $self->xml_end_tag( 'cfRule' );
9405 2         14 }
9406             elsif ($param->{type} eq 'containsBlanks'
9407             || $param->{type} eq 'notContainsBlanks'
9408 62         194 || $param->{type} eq 'containsErrors'
9409             || $param->{type} eq 'notContainsErrors' )
9410             {
9411 62         177 $self->xml_start_tag( 'cfRule', @attributes );
9412             $self->_write_formula( $param->{formula} );
9413             $self->xml_end_tag( 'cfRule' );
9414             }
9415 62 100       200 elsif ( $param->{type} eq 'colorScale' ) {
9416              
9417 62         159 $self->xml_start_tag( 'cfRule', @attributes );
9418             $self->_write_color_scale( $param );
9419             $self->xml_end_tag( 'cfRule' );
9420             }
9421             elsif ( $param->{type} eq 'dataBar' ) {
9422              
9423             $self->xml_start_tag( 'cfRule', @attributes );
9424              
9425             $self->_write_data_bar( $param );
9426              
9427             if ($param->{_is_data_bar_2010}) {
9428             $self->_write_data_bar_ext( $param );
9429             }
9430 62     62   84  
9431 62         75 $self->xml_end_tag( 'cfRule' );
9432             }
9433             elsif ( $param->{type} eq 'expression' ) {
9434 62 100       136  
9435 10         34 $self->xml_start_tag( 'cfRule', @attributes );
9436 10         30 $self->_write_formula( $param->{criteria} );
9437             $self->xml_end_tag( 'cfRule' );
9438             }
9439 62         142 elsif ( $param->{type} eq 'iconSet' ) {
9440              
9441 62         182 $self->xml_start_tag( 'cfRule', @attributes );
9442             $self->_write_icon_set( $param );
9443             $self->xml_end_tag( 'cfRule' );
9444             }
9445             }
9446              
9447              
9448             ##############################################################################
9449             #
9450             # _write_icon_set()
9451             #
9452             # Write the <iconSet> element.
9453 24     24   32 #
9454 24         35  
9455             my $self = shift;
9456 24         39 my $param = shift;
9457             my $icon_style = $param->{icon_style};
9458 24         48 my $total_icons = $param->{total_icons};
9459             my $icons = $param->{icons};
9460             my $i;
9461              
9462             my @attributes = ();
9463              
9464             # Don't set attribute for default style.
9465             if ( $icon_style ne '3TrafficLights' ) {
9466             @attributes = ( 'iconSet' => $icon_style );
9467             }
9468              
9469             if ( exists $param->{'icons_only'} && $param->{'icons_only'} ) {
9470 1082     1082   2221 push @attributes, ( 'showValue' => 0 );
9471 1082         2198 }
  1082         4942  
9472              
9473 1082 100       3964 if ( exists $param->{'reverse_icons'} && $param->{'reverse_icons'} ) {
9474             push @attributes, ( 'reverse' => 1 );
9475 63         157 }
9476              
9477 110         396 $self->xml_start_tag( 'iconSet', @attributes );
9478              
9479             # Write the properties for different icon styles.
9480             for my $icon ( reverse @{ $param->{icons} } ) {
9481             $self->_write_cfvo(
9482             $icon->{'type'},
9483             $icon->{'value'},
9484             $icon->{'criteria'}
9485             );
9486             }
9487              
9488             $self->xml_end_tag( 'iconSet' );
9489             }
9490 110     110   199  
9491 110         258 ##############################################################################
9492 110         176 #
9493             # _write_formula()
9494 110         244 #
9495             # Write the <formula> element.
9496 110         431 #
9497              
9498 110         253 my $self = shift;
9499             my $data = shift;
9500              
9501 149         421 # Remove equality from formula.
9502             $data =~ s/^=//;
9503              
9504 110         425 $self->xml_data_element( 'formula', $data );
9505             }
9506              
9507              
9508             ##############################################################################
9509             #
9510             # _write_color_scale()
9511             #
9512             # Write the <colorScale> element.
9513             #
9514              
9515 149     149   238 my $self = shift;
9516 149         226 my $param = shift;
9517              
9518 149         386 $self->xml_start_tag( 'colorScale' );
9519              
9520             $self->_write_cfvo( $param->{min_type}, $param->{min_value} );
9521 149 100       422  
9522             if ( defined $param->{mid_type} ) {
9523 149         308 $self->_write_cfvo( $param->{mid_type}, $param->{mid_value} );
9524             }
9525              
9526 149 100       359 $self->_write_cfvo( $param->{max_type}, $param->{max_value} );
9527              
9528 149 100 100     1924 $self->_write_color( 'rgb' => $param->{min_color} );
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100          
    100          
    100          
    100          
    100          
    50          
9529 36         115  
9530             if ( defined $param->{mid_color} ) {
9531 36         170 $self->_write_color( 'rgb' => $param->{mid_color} );
9532             }
9533 36 100 66     169  
9534 5         111 $self->_write_color( 'rgb' => $param->{max_color} );
9535 5         16  
9536             $self->xml_end_tag( 'colorScale' );
9537             }
9538 31         69  
9539              
9540             ##############################################################################
9541 31 100 100     330 #
9542             # _write_data_bar()
9543             #
9544             # Write the <dataBar> element.
9545 2 100       8 #
9546 1         3  
9547             my $self = shift;
9548             my $data_bar = shift;
9549             my @attributes = ();
9550 31         113  
9551             if ( $data_bar->{bar_only} ) {
9552             push @attributes, ( 'showValue', 0 );
9553 36         213 }
9554              
9555             $self->xml_start_tag( 'dataBar', @attributes );
9556 10 100       23  
9557 5         8 $self->_write_cfvo( $data_bar->{min_type}, $data_bar->{min_value} );
9558             $self->_write_cfvo( $data_bar->{max_type}, $data_bar->{max_value} );
9559              
9560 10 100       18 $self->_write_color( 'rgb' => $data_bar->{bar_color} );
9561 2         5  
9562             $self->xml_end_tag( 'dataBar' );
9563             }
9564 10 100       24  
9565 6         13  
9566             ##############################################################################
9567             #
9568 10         20 # _write_data_bar_ext()
9569             #
9570             # Write the <extLst> dataBar extension element.
9571 4 100 66     12 #
9572 2         4  
9573             my $self = shift;
9574             my $param = shift;
9575 4 100       8  
9576 2         3 # Create a pseudo GUID for each unique Excel 2010 data bar.
9577             my $worksheet_count = $self->{_index} + 1;
9578             my $data_bar_count = @{ $self->{_data_bars_2010} } + 1;
9579 4   50     9  
9580 4         7 my $guid = sprintf "{DA7ABA51-AAAA-BBBB-%04X-%012X}", $worksheet_count,
9581             $data_bar_count;
9582 4         10  
9583             # Store the 2010 data bar parameters to write the extLst elements.
9584             $param->{_guid} = $guid;
9585 1         4 push @{$self->{_data_bars_2010}}, $param;
9586              
9587             $self->xml_start_tag( 'extLst' );
9588 1         3 $self->_write_ext('{B025F937-C7B1-47D3-B67F-A62EFF666E3E}');
9589              
9590             $self->xml_data_element( 'x14:id', $guid);
9591              
9592             $self->xml_end_tag( 'ext' );
9593             $self->xml_end_tag( 'extLst' );
9594             }
9595 8         17  
9596 8         11  
9597             ##############################################################################
9598 8         20 #
9599 8         23 # _write_cfvo()
9600 8         17 #
9601             # Write the <cfvo> element.
9602             #
9603 10         17  
9604             my $self = shift;
9605 10         23 my $type = shift;
9606 10         25 my $value = shift;
9607 10         22 my $criteria = shift;
9608              
9609             my @attributes = ( 'type' => $type );
9610              
9611             if ( defined $value ) {
9612             push @attributes, ( 'val', $value );
9613             }
9614 4         13  
9615 4         10 if ( $criteria ) {
9616 4         9 push @attributes, ( 'gte', 0 );
9617             }
9618              
9619             $self->xml_empty_tag( 'cfvo', @attributes );
9620 5         22 }
9621 5         20  
9622 5         15  
9623             ##############################################################################
9624             #
9625             # _write_x14_cfvo()
9626 29         102 #
9627             # Write the <cfvo> element.
9628 29         114 #
9629              
9630 29 100       82 my $self = shift;
9631 25         62 my $type = shift;
9632             my $value = shift;
9633              
9634 29         77 my @attributes = ( 'type' => $type );
9635              
9636             if ( $type eq 'min'
9637             || $type eq 'max'
9638 4         9 || $type eq 'autoMin'
9639 4         11 || $type eq 'autoMax' )
9640 4         9 {
9641             $self->xml_empty_tag( 'x14:cfvo', @attributes );
9642             }
9643             else {
9644 37         89 $self->xml_start_tag( 'x14:cfvo', @attributes );
9645 37         96 $self->xml_data_element( 'xm:f', $value );
9646 37         77 $self->xml_end_tag( 'x14:cfvo' );
9647             }
9648             }
9649              
9650              
9651             ##############################################################################
9652             #
9653             # _write_color()
9654             #
9655             # Write the <color> element.
9656             #
9657              
9658             my $self = shift;
9659 37     37   56 my $name = shift;
9660 37         63 my $value = shift;
9661 37         63  
9662 37         50 my @attributes = ( $name => $value );
9663 37         53  
9664 37         44 $self->xml_empty_tag( 'color', @attributes );
9665             }
9666 37         52  
9667              
9668             ##############################################################################
9669 37 100       83 #
9670 36         64 # _write_table_parts()
9671             #
9672             # Write the <tableParts> element.
9673 37 50 66     81 #
9674 4         8  
9675             my $self = shift;
9676             my @tables = @{ $self->{_tables} };
9677 37 50 66     76 my $count = scalar @tables;
9678 6         13  
9679             # Return if worksheet doesn't contain any tables.
9680             return unless $count;
9681 37         87  
9682             my @attributes = ( 'count' => $count, );
9683              
9684 37         50 $self->xml_start_tag( 'tableParts', @attributes );
  37         76  
9685              
9686             for my $table ( @tables ) {
9687              
9688 138         278 # Write the tablePart element.
9689             $self->_write_table_part( ++$self->{_rel_count} );
9690              
9691             }
9692 37         90  
9693             $self->xml_end_tag( 'tableParts' );
9694             }
9695              
9696              
9697             ##############################################################################
9698             #
9699             # _write_table_part()
9700             #
9701             # Write the <tablePart> element.
9702             #
9703 67     67   117  
9704 67         103 my $self = shift;
9705             my $id = shift;
9706             my $r_id = 'rId' . $id;
9707 67         157  
9708             my @attributes = ( 'r:id' => $r_id, );
9709 67         337  
9710             $self->xml_empty_tag( 'tablePart', @attributes );
9711             }
9712              
9713              
9714             ##############################################################################
9715             #
9716             # _write_ext_list()
9717             #
9718             # Write the <extLst> element for data bars and sparklines.
9719             #
9720              
9721 5     5   17 my $self = shift;
9722 5         8 my $has_data_bars = scalar @{ $self->{_data_bars_2010} };
9723             my $has_sparklines = scalar @{ $self->{_sparklines} };
9724 5         17  
9725             if ( !$has_data_bars and !$has_sparklines ) {
9726 5         21 return;
9727             }
9728 5 100       15  
9729 4         12 # Write the extLst element.
9730             $self->xml_start_tag( 'extLst' );
9731              
9732 5         33 if ( $has_data_bars ) {
9733             $self->_write_ext_list_data_bars();
9734 5         23 }
9735              
9736 5 100       17 if ( $has_sparklines ) {
9737 4         17 $self->_write_ext_list_sparklines();
9738             }
9739              
9740 5         20 $self->xml_end_tag( 'extLst' );
9741             }
9742 5         15  
9743              
9744             ##############################################################################
9745             #
9746             # _write_ext_list_data_bars()
9747             #
9748             # Write the Excel 2010 data_bar subelements.
9749             #
9750              
9751             my $self = shift;
9752             my @data_bars = @{ $self->{_data_bars_2010} };
9753              
9754 29     29   51 # Write the ext element.
9755 29         43 $self->_write_ext('{78C0D931-6437-407d-A8EE-F0AAD7539E65}');
9756 29         46  
9757              
9758 29 100       105 $self->xml_start_tag( 'x14:conditionalFormattings' );
9759 2         6  
9760             # Write each of the Excel 2010 conditional formatting data bar elements.
9761             for my $data_bar (@data_bars) {
9762 29         82  
9763             # Write the x14:conditionalFormatting element.
9764 29         126 $self->_write_conditional_formatting_2010($data_bar);
9765 29         101 }
9766              
9767 29         110 $self->xml_end_tag( 'x14:conditionalFormattings' );
9768             $self->xml_end_tag( 'ext' );
9769 29         74  
9770              
9771             }
9772              
9773              
9774             ##############################################################################
9775             #
9776             # _write_conditional_formatting()
9777             #
9778             # Write the <x14:conditionalFormatting> element.
9779             #
9780              
9781 25     25   44 my $self = shift;
9782 25         34 my $data_bar = shift;
9783             my $xmlns_xm = 'http://schemas.microsoft.com/office/excel/2006/main';
9784              
9785 25         45 my @attributes = ( 'xmlns:xm' => $xmlns_xm );
9786 25         40  
  25         54  
9787             $self->xml_start_tag( 'x14:conditionalFormatting', @attributes );
9788 25         126  
9789             # Write the '<x14:cfRule element.
9790             $self->_write_x14_cf_rule( $data_bar );
9791              
9792 25         47 # Write the x14:dataBar element.
9793 25         39 $self->_write_x14_data_bar( $data_bar );
  25         54  
9794              
9795 25         81 # Write the x14 max and min data bars.
9796 25         76 $self->_write_x14_cfvo( $data_bar->{_x14_min_type},
9797             $data_bar->{min_value} );
9798 25         122  
9799             $self->_write_x14_cfvo( $data_bar->{_x14_max_type},
9800 25         69 $data_bar->{max_value} );
9801 25         60  
9802             # Write the x14:borderColor element.
9803             if ( !$data_bar->{bar_no_border} ) {
9804             $self->_write_x14_border_color( $data_bar->{bar_border_color} );
9805             }
9806              
9807             # Write the x14:negativeFillColor element.
9808             if ( !$data_bar->{bar_negative_color_same} ) {
9809             $self->_write_x14_negative_fill_color(
9810             $data_bar->{bar_negative_color} );
9811             }
9812              
9813 210     210   281 # Write the x14:negativeBorderColor element.
9814 210         256 if ( !$data_bar->{bar_no_border}
9815 210         255 && !$data_bar->{bar_negative_border_color_same} )
9816 210         253 {
9817             $self->_write_x14_negative_border_color(
9818 210         343 $data_bar->{bar_negative_border_color} );
9819             }
9820 210 100       391  
9821 169         264 # Write the x14:axisColor element.
9822             if ( $data_bar->{bar_axis_position} ne 'none') {
9823             $self->_write_x14_axis_color($data_bar->{bar_axis_color});
9824 210 100       340 }
9825 7         13  
9826             # Write closing elements.
9827             $self->xml_end_tag( 'x14:dataBar' );
9828 210         411 $self->xml_end_tag( 'x14:cfRule' );
9829              
9830             # Add the conditional format range.
9831             $self->xml_data_element( 'xm:sqref', $data_bar->{_range} );
9832              
9833             $self->xml_end_tag( 'x14:conditionalFormatting' );
9834             }
9835              
9836              
9837             ##############################################################################
9838             #
9839             # _write_x14_cf_rule()
9840 50     50   74 #
9841 50         67 # Write the <'<x14:cfRule> element.
9842 50         67 #
9843              
9844 50         101 my $self = shift;
9845             my $data_bar = shift;
9846 50 100 100     281 my $type = 'dataBar';
      100        
      100        
9847             my $id = $data_bar->{_guid};
9848              
9849             my @attributes = (
9850             'type' => $type,
9851 41         95 'id' => $id,
9852             );
9853              
9854 9         32 $self->xml_start_tag( 'x14:cfRule', @attributes );
9855 9         27  
9856 9         19 }
9857              
9858              
9859             ##############################################################################
9860             #
9861             # _write_x14_data_bar()
9862             #
9863             # Write the <x14:dataBar> element.
9864             #
9865              
9866             my $self = shift;
9867             my $data_bar = shift;
9868             my $min_length = 0;
9869 43     43   78 my $max_length = 100;
9870 43         87  
9871 43         67 my @attributes = (
9872             'minLength' => $min_length,
9873 43         94 'maxLength' => $max_length,
9874             );
9875 43         106  
9876             if ( !$data_bar->{bar_no_border} ) {
9877             push @attributes, ( 'border', 1 );
9878             }
9879              
9880             if ( $data_bar->{bar_solid} ) {
9881             push @attributes, ( 'gradient', 0 );
9882             }
9883              
9884             if ( $data_bar->{bar_direction} eq 'left' ) {
9885             push @attributes, ( 'direction', 'leftToRight' );
9886             }
9887 1078     1078   5329  
9888 1078         4378 if ( $data_bar->{bar_direction} eq 'right' ) {
  1078         6631  
9889 1078         3746 push @attributes, ( 'direction', 'rightToLeft' );
9890             }
9891              
9892 1078 100       4319 if ( $data_bar->{bar_negative_color_same} ) {
9893             push @attributes, ( 'negativeBarColorSameAsPositive', 1 );
9894 28         80 }
9895              
9896 28         146 if ( !$data_bar->{bar_no_border}
9897             && !$data_bar->{bar_negative_border_color_same} )
9898 28         102 {
9899             push @attributes, ( 'negativeBarBorderColorSameAsPositive', 0 );
9900             }
9901 37         252  
9902             if ( $data_bar->{bar_axis_position} eq 'middle') {
9903             push @attributes, ( 'axisPosition', 'middle' );
9904             }
9905 28         125  
9906             if ( $data_bar->{bar_axis_position} eq 'none') {
9907             push @attributes, ( 'axisPosition', 'none' );
9908             }
9909              
9910             $self->xml_start_tag( 'x14:dataBar', @attributes );
9911             }
9912              
9913              
9914             ##############################################################################
9915             #
9916             # _write_x14_border_color()
9917 37     37   69 #
9918 37         69 # Write the <x14:borderColor> element.
9919 37         103 #
9920              
9921 37         109 my $self = shift;
9922             my $rgb = shift;
9923 37         131  
9924             my @attributes = ( 'rgb' => $rgb );
9925              
9926             $self->xml_empty_tag( 'x14:borderColor', @attributes );
9927             }
9928              
9929              
9930             ##############################################################################
9931             #
9932             # _write_x14_negative_fill_color()
9933             #
9934             # Write the <x14:negativeFillColor> element.
9935 1078     1078   4670 #
9936 1078         4967  
  1078         3333  
9937 1078         2577 my $self = shift;
  1078         2504  
9938             my $rgb = shift;
9939 1078 100 100     6396  
9940 1056         3355 my @attributes = ( 'rgb' => $rgb );
9941              
9942             $self->xml_empty_tag( 'x14:negativeFillColor', @attributes );
9943             }
9944 22         92  
9945              
9946 22 100       74 ##############################################################################
9947 11         49 #
9948             # _write_x14_negative_border_color()
9949             #
9950 22 100       76 # Write the <x14:negativeBorderColor> element.
9951 12         50 #
9952              
9953             my $self = shift;
9954 22         70 my $rgb = shift;
9955              
9956             my @attributes = ( 'rgb' => $rgb );
9957              
9958             $self->xml_empty_tag( 'x14:negativeBorderColor', @attributes );
9959             }
9960              
9961              
9962             ##############################################################################
9963             #
9964             # _write_x14_axis_color()
9965             #
9966 11     11   34 # Write the <x14:axisColor> element.
9967 11         21 #
  11         42  
9968              
9969             my $self = shift;
9970 11         43 my $rgb = shift;
9971              
9972             my @attributes = ( 'rgb' => $rgb );
9973 11         42  
9974             $self->xml_empty_tag( 'x14:axisColor', @attributes );
9975             }
9976 11         46  
9977              
9978             ##############################################################################
9979 25         66 #
9980             # _write_ext_list_sparklines()
9981             #
9982 11         43 # Write the sparkline subelements.
9983 11         41 #
9984              
9985             my $self = shift;
9986             my @sparklines = @{ $self->{_sparklines} };
9987             my $count = scalar @sparklines;
9988              
9989             # Write the ext element.
9990             $self->_write_ext('{05C60535-1F16-4fd2-B633-F4F36F0B64E0}');
9991              
9992             # Write the x14:sparklineGroups element.
9993             $self->_write_sparkline_groups();
9994              
9995             # Write the sparkline elements.
9996             for my $sparkline ( reverse @sparklines ) {
9997 25     25   43  
9998 25         47 # Write the x14:sparklineGroup element.
9999 25         41 $self->_write_sparkline_group( $sparkline );
10000              
10001 25         52 # Write the x14:colorSeries element.
10002             $self->_write_color_series( $sparkline->{_series_color} );
10003 25         82  
10004             # Write the x14:colorNegative element.
10005             $self->_write_color_negative( $sparkline->{_negative_color} );
10006 25         97  
10007             # Write the x14:colorAxis element.
10008             $self->_write_color_axis();
10009 25         86  
10010             # Write the x14:colorMarkers element.
10011             $self->_write_color_markers( $sparkline->{_markers_color} );
10012              
10013 25         147 # Write the x14:colorFirst element.
10014             $self->_write_color_first( $sparkline->{_first_color} );
10015              
10016 25         78 # Write the x14:colorLast element.
10017             $self->_write_color_last( $sparkline->{_last_color} );
10018              
10019 25 100       63 # Write the x14:colorHigh element.
10020 24         84 $self->_write_color_high( $sparkline->{_high_color} );
10021              
10022             # Write the x14:colorLow element.
10023             $self->_write_color_low( $sparkline->{_low_color} );
10024 25 100       64  
10025             if ( $sparkline->{_date_axis} ) {
10026 24         61 $self->xml_data_element( 'xm:f', $sparkline->{_date_axis} );
10027             }
10028              
10029             $self->_write_sparklines( $sparkline );
10030 25 100 100     115  
10031             $self->xml_end_tag( 'x14:sparklineGroup' );
10032             }
10033              
10034 23         59  
10035             $self->xml_end_tag( 'x14:sparklineGroups' );
10036             $self->xml_end_tag( 'ext' );
10037             }
10038 25 100       74  
10039 24         65  
10040             ##############################################################################
10041             #
10042             # _write_sparklines()
10043 25         85 #
10044 25         77 # Write the <x14:sparklines> element and <x14:sparkline> subelements.
10045             #
10046              
10047 25         75 my $self = shift;
10048             my $sparkline = shift;
10049 25         66  
10050             # Write the sparkline elements.
10051             $self->xml_start_tag( 'x14:sparklines' );
10052              
10053             for my $i ( 0 .. $sparkline->{_count} - 1 ) {
10054             my $range = $sparkline->{_ranges}->[$i];
10055             my $location = $sparkline->{_locations}->[$i];
10056              
10057             $self->xml_start_tag( 'x14:sparkline' );
10058             $self->xml_data_element( 'xm:f', $range );
10059             $self->xml_data_element( 'xm:sqref', $location );
10060             $self->xml_end_tag( 'x14:sparkline' );
10061 25     25   42 }
10062 25         40  
10063 25         41  
10064 25         50 $self->xml_end_tag( 'x14:sparklines' );
10065             }
10066 25         61  
10067              
10068             ##############################################################################
10069             #
10070             # _write_ext()
10071 25         67 #
10072             # Write the <ext> element for sparklines.
10073             #
10074              
10075             my $self = shift;
10076             my $uri = shift;
10077             my $schema = 'http://schemas.microsoft.com/office/';
10078             my $xmlns_x14 = $schema . 'spreadsheetml/2009/9/main';
10079              
10080             my @attributes = (
10081             'xmlns:x14' => $xmlns_x14,
10082             'uri' => $uri,
10083             );
10084 25     25   38  
10085 25         41 $self->xml_start_tag( 'ext', @attributes );
10086 25         41 }
10087 25         36  
10088              
10089 25         60 ##############################################################################
10090             #
10091             # _write_sparkline_groups()
10092             #
10093             # Write the <x14:sparklineGroups> element.
10094 25 100       66 #
10095 24         109  
10096             my $self = shift;
10097             my $xmlns_xm = 'http://schemas.microsoft.com/office/excel/2006/main';
10098 25 100       62  
10099 1         2 my @attributes = ( 'xmlns:xm' => $xmlns_xm );
10100              
10101             $self->xml_start_tag( 'x14:sparklineGroups', @attributes );
10102 25 100       69  
10103 1         3 }
10104              
10105              
10106 25 100       67 ##############################################################################
10107 1         1 #
10108             # _write_sparkline_group()
10109             #
10110 25 100       61 # Write the <x14:sparklineGroup> element.
10111 1         2 #
10112             # Example for order.
10113             #
10114 25 100 100     109 # <x14:sparklineGroup
10115             # manualMax="0"
10116             # manualMin="0"
10117 23         53 # lineWeight="2.25"
10118             # type="column"
10119             # dateAxis="1"
10120 25 100       65 # displayEmptyCellsAs="span"
10121 1         3 # markers="1"
10122             # high="1"
10123             # low="1"
10124 25 100       53 # first="1"
10125 1         3 # last="1"
10126             # negative="1"
10127             # displayXAxis="1"
10128 25         75 # displayHidden="1"
10129             # minAxisType="custom"
10130             # maxAxisType="custom"
10131             # rightToLeft="1">
10132             #
10133              
10134             my $self = shift;
10135             my $opts = shift;
10136             my $empty = $opts->{_empty};
10137             my $user_max = 0;
10138             my $user_min = 0;
10139             my @a;
10140 24     24   53  
10141 24         50 if ( defined $opts->{_max} ) {
10142              
10143 24         50 if ( $opts->{_max} eq 'group' ) {
10144             $opts->{_cust_max} = 'group';
10145 24         74 }
10146             else {
10147             push @a, ( 'manualMax' => $opts->{_max} );
10148             $opts->{_cust_max} = 'custom';
10149             }
10150             }
10151              
10152             if ( defined $opts->{_min} ) {
10153              
10154             if ( $opts->{_min} eq 'group' ) {
10155             $opts->{_cust_min} = 'group';
10156             }
10157 24     24   58 else {
10158 24         35 push @a, ( 'manualMin' => $opts->{_min} );
10159             $opts->{_cust_min} = 'custom';
10160 24         51 }
10161             }
10162 24         172  
10163              
10164             # Ignore the default type attribute (line).
10165             if ( $opts->{_type} ne 'line' ) {
10166             push @a, ( 'type' => $opts->{_type} );
10167             }
10168              
10169             push @a, ( 'lineWeight' => $opts->{_weight} ) if $opts->{_weight};
10170             push @a, ( 'dateAxis' => 1 ) if $opts->{_date_axis};
10171             push @a, ( 'displayEmptyCellsAs' => $empty ) if $empty;
10172              
10173             push @a, ( 'markers' => 1 ) if $opts->{_markers};
10174 23     23   39 push @a, ( 'high' => 1 ) if $opts->{_high};
10175 23         33 push @a, ( 'low' => 1 ) if $opts->{_low};
10176             push @a, ( 'first' => 1 ) if $opts->{_first};
10177 23         66 push @a, ( 'last' => 1 ) if $opts->{_last};
10178             push @a, ( 'negative' => 1 ) if $opts->{_negative};
10179 23         157 push @a, ( 'displayXAxis' => 1 ) if $opts->{_axis};
10180             push @a, ( 'displayHidden' => 1 ) if $opts->{_hidden};
10181             push @a, ( 'minAxisType' => $opts->{_cust_min} ) if $opts->{_cust_min};
10182             push @a, ( 'maxAxisType' => $opts->{_cust_max} ) if $opts->{_cust_max};
10183             push @a, ( 'rightToLeft' => 1 ) if $opts->{_reverse};
10184              
10185             $self->xml_start_tag( 'x14:sparklineGroup', @a );
10186             }
10187              
10188              
10189             ##############################################################################
10190             #
10191 24     24   38 # _write_spark_color()
10192 24         35 #
10193             # Helper function for the sparkline color functions below.
10194 24         68 #
10195              
10196 24         58 my $self = shift;
10197             my $element = shift;
10198             my $color = shift;
10199             my @attr;
10200              
10201             push @attr, ( 'rgb' => $color->{_rgb} ) if defined $color->{_rgb};
10202             push @attr, ( 'theme' => $color->{_theme} ) if defined $color->{_theme};
10203             push @attr, ( 'tint' => $color->{_tint} ) if defined $color->{_tint};
10204              
10205             $self->xml_empty_tag( $element, @attr );
10206             }
10207              
10208 12     12   30  
10209 12         28 ##############################################################################
  12         66  
10210 12         38 #
10211             # _write_color_series()
10212             #
10213 12         55 # Write the <x14:colorSeries> element.
10214             #
10215              
10216 12         62 my $self = shift;
10217              
10218             $self->_write_spark_color( 'x14:colorSeries', @_ );
10219 12         36 }
10220              
10221              
10222 58         158 ##############################################################################
10223             #
10224             # _write_color_negative()
10225 58         159 #
10226             # Write the <x14:colorNegative> element.
10227             #
10228 58         169  
10229             my $self = shift;
10230              
10231 58         149 $self->_write_spark_color( 'x14:colorNegative', @_ );
10232             }
10233              
10234 58         184  
10235             ##############################################################################
10236             #
10237 58         170 # _write_color_axis()
10238             #
10239             # Write the <x14:colorAxis> element.
10240 58         174 #
10241              
10242             my $self = shift;
10243 58         163  
10244             $self->_write_spark_color( 'x14:colorAxis', { _rgb => 'FF000000' } );
10245             }
10246 58         152  
10247              
10248 58 100       128 ##############################################################################
10249 1         6 #
10250             # _write_color_markers()
10251             #
10252 58         156 # Write the <x14:colorMarkers> element.
10253             #
10254 58         117  
10255             my $self = shift;
10256              
10257             $self->_write_spark_color( 'x14:colorMarkers', @_ );
10258 12         56 }
10259 12         54  
10260              
10261             ##############################################################################
10262             #
10263             # _write_color_first()
10264             #
10265             # Write the <x14:colorFirst> element.
10266             #
10267              
10268             my $self = shift;
10269              
10270             $self->_write_spark_color( 'x14:colorFirst', @_ );
10271 58     58   86 }
10272 58         78  
10273              
10274             ##############################################################################
10275 58         176 #
10276             # _write_color_last()
10277 58         167 #
10278 59         128 # Write the <x14:colorLast> element.
10279 59         116 #
10280              
10281 59         276 my $self = shift;
10282 59         363  
10283 59         192 $self->_write_spark_color( 'x14:colorLast', @_ );
10284 59         154 }
10285              
10286              
10287             ##############################################################################
10288 58         137 #
10289             # _write_color_high()
10290             #
10291             # Write the <x14:colorHigh> element.
10292             #
10293              
10294             my $self = shift;
10295              
10296             $self->_write_spark_color( 'x14:colorHigh', @_ );
10297             }
10298              
10299              
10300 48     48   109 ##############################################################################
10301 48         81 #
10302 48         86 # _write_color_low()
10303 48         119 #
10304             # Write the <x14:colorLow> element.
10305 48         143 #
10306              
10307             my $self = shift;
10308              
10309             $self->_write_spark_color( 'x14:colorLow', @_ );
10310 48         125 }
10311              
10312              
10313             ##############################################################################
10314             #
10315             # _write_ignored_errors()
10316             #
10317             # Write the <ignoredErrors> element.
10318             #
10319              
10320             my $self = shift;
10321             my $ignore = $self->{_ignore_errors};
10322 12     12   25  
10323 12         24 if ( !defined $ignore ) {
10324             return;
10325 12         41 }
10326              
10327 12         38 $self->xml_start_tag( 'ignoredErrors' );
10328              
10329             if ( exists $ignore->{number_stored_as_text} ) {
10330             my $range = $ignore->{number_stored_as_text};
10331             $self->_write_ignored_error( 'numberStoredAsText', $range );
10332             }
10333              
10334             if ( exists $ignore->{eval_error} ) {
10335             my $range = $ignore->{eval_error};
10336             $self->_write_ignored_error( 'evalError', $range );
10337             }
10338              
10339             if ( exists $ignore->{formula_differs} ) {
10340             my $range = $ignore->{formula_differs};
10341             $self->_write_ignored_error( 'formula', $range );
10342             }
10343              
10344             if ( exists $ignore->{formula_range} ) {
10345             my $range = $ignore->{formula_range};
10346             $self->_write_ignored_error( 'formulaRange', $range );
10347             }
10348              
10349             if ( exists $ignore->{formula_unlocked} ) {
10350             my $range = $ignore->{formula_unlocked};
10351             $self->_write_ignored_error( 'unlockedFormula', $range );
10352             }
10353              
10354             if ( exists $ignore->{empty_cell_reference} ) {
10355             my $range = $ignore->{empty_cell_reference};
10356             $self->_write_ignored_error( 'emptyCellReference', $range );
10357             }
10358              
10359             if ( exists $ignore->{list_data_validation} ) {
10360             my $range = $ignore->{list_data_validation};
10361 58     58   90 $self->_write_ignored_error( 'listDataValidation', $range );
10362 58         80 }
10363 58         118  
10364 58         86 if ( exists $ignore->{calculated_column} ) {
10365 58         75 my $range = $ignore->{calculated_column};
10366 58         78 $self->_write_ignored_error( 'calculatedColumn', $range );
10367             }
10368 58 100       145  
10369             if ( exists $ignore->{two_digit_text_year} ) {
10370 4 100       14 my $range = $ignore->{two_digit_text_year};
10371 2         3 $self->_write_ignored_error( 'twoDigitTextYear', $range );
10372             }
10373              
10374 2         6 $self->xml_end_tag( 'ignoredErrors' );
10375 2         4 }
10376              
10377             ##############################################################################
10378             #
10379 58 100       157 # _write_ignored_error()
10380             #
10381 4 100       12 # Write the <ignoredError> element.
10382 1         2 #
10383              
10384             my $self = shift;
10385 3         6 my $type = shift;
10386 3         6 my $sqref = shift;
10387              
10388             my @attributes = (
10389             'sqref' => $sqref,
10390             $type => 1,
10391             );
10392 58 100       148  
10393 9         18 $self->xml_empty_tag( 'ignoredError', @attributes );
10394             }
10395              
10396 58 100       147  
10397 58 100       193 1;
10398 58 100       136  
10399              
10400 58 100       142  
10401 58 100       132  
10402 58 100       116 =head1 NAME
10403 58 100       128  
10404 58 100       121 Worksheet - A class for writing Excel Worksheets.
10405 58 100       116  
10406 58 100       117 =head1 SYNOPSIS
10407 58 100       131  
10408 58 100       117 See the documentation for L<Excel::Writer::XLSX>
10409 58 100       116  
10410 58 100       112 =head1 DESCRIPTION
10411              
10412 58         137 This module is used in conjunction with L<Excel::Writer::XLSX>.
10413              
10414             =head1 AUTHOR
10415              
10416             John McNamara jmcnamara@cpan.org
10417              
10418             =head1 COPYRIGHT
10419              
10420             (c) MM-MMXXI, John McNamara.
10421              
10422             All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.