File Coverage

blib/lib/Spreadsheet/WriteExcelXML/Worksheet.pm
Criterion Covered Total %
statement 1021 1217 83.8
branch 415 566 73.3
condition 155 230 67.3
subroutine 83 106 78.3
pod 0 59 0.0
total 1674 2178 76.8


line stmt bran cond sub pod time code
1             package Spreadsheet::WriteExcelXML::Worksheet;
2              
3             ###############################################################################
4             #
5             # Worksheet - A writer class for Excel Worksheets.
6             #
7             #
8             # Used in conjunction with Spreadsheet::WriteExcelXML
9             #
10             # Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
11             #
12             # Documentation after __END__
13             #
14              
15 23     23   1278 use Exporter;
  23         71  
  23         1138  
16 23     23   126 use strict;
  23         47  
  23         756  
17 23     23   131 use Carp;
  23         41  
  23         1828  
18 23     23   791 use Spreadsheet::WriteExcelXML::XMLwriter;
  23         39  
  23         955  
19 23     23   22623 use Spreadsheet::WriteExcelXML::Format;
  23         67  
  23         1435  
20 23     23   20760 use Spreadsheet::WriteExcelXML::Utility qw(xl_cell_to_rowcol xl_rowcol_to_cell);
  23         73  
  23         2270  
21              
22              
23              
24              
25 23     23   272 use vars qw($VERSION @ISA);
  23         38  
  23         227849  
26             @ISA = qw(Spreadsheet::WriteExcelXML::XMLwriter);
27              
28             $VERSION = '0.14';
29              
30             ###############################################################################
31             #
32             # new()
33             #
34             # Constructor. Creates a new Worksheet object from a XMLwriter object
35             #
36             sub new {
37              
38 78     78 0 401 my $class = shift;
39 78         548 my $self = Spreadsheet::WriteExcelXML::XMLwriter->new();
40 78         117 my $rowmax = 1_048_576;
41 78         285 my $colmax = 16_384;
42 78         740 my $strmax = 32767;
43              
44 78         1082 $self->{_name} = $_[0];
45 78         158 $self->{_index} = $_[1];
46 78         121 $self->{_filehandle} = $_[2];
47 78         119 $self->{_indentation} = $_[3];
48 78         134 $self->{_activesheet} = $_[4];
49 78         153 $self->{_firstsheet} = $_[5];
50 78         189 $self->{_1904} = $_[6];
51 78         165 $self->{_lower_cell_limits} = $_[7];
52              
53 78         191 $self->{_ext_sheets} = [];
54 78         154 $self->{_fileclosed} = 0;
55 78         134 $self->{_offset} = 0;
56 78         153 $self->{_xls_rowmax} = $rowmax;
57 78         177 $self->{_xls_colmax} = $colmax;
58 78         164 $self->{_xls_strmax} = $strmax;
59 78         255 $self->{_dim_rowmin} = $rowmax +1;
60 78         150 $self->{_dim_rowmax} = 0;
61 78         136 $self->{_dim_colmin} = $colmax +1;
62 78         195 $self->{_dim_colmax} = 0;
63 78         113 $self->{_dim_changed} = 0;
64 78         217 $self->{_colinfo} = [];
65 78         198 $self->{_selection} = [0, 0];
66 78         161 $self->{_panes} = [];
67 78         140 $self->{_active_pane} = 3;
68 78         169 $self->{_frozen} = 0;
69 78         121 $self->{_selected} = 0;
70              
71 78         122 $self->{_paper_size} = 0x0;
72 78         131 $self->{_orientation} = 0x1;
73 78         143 $self->{_header} = '';
74 78         126 $self->{_footer} = '';
75 78         145 $self->{_hcenter} = 0;
76 78         257 $self->{_vcenter} = 0;
77 78         128 $self->{_margin_head} = 0.50;
78 78         118 $self->{_margin_foot} = 0.50;
79 78         157 $self->{_margin_left} = 0.75;
80 78         126 $self->{_margin_right} = 0.75;
81 78         156 $self->{_margin_top} = 1.00;
82 78         127 $self->{_margin_bottom} = 1.00;
83              
84 78         147 $self->{_repeat_rows} = '';
85 78         128 $self->{_repeat_cols} = '';
86              
87 78         120 $self->{_print_gridlines} = 0;
88 78         110 $self->{_screen_gridlines} = 1;
89 78         128 $self->{_print_headers} = 0;
90              
91 78         135 $self->{_page_order} = 0;
92 78         118 $self->{_black_white} = 0;
93 78         149 $self->{_draft_quality} = 0;
94 78         130 $self->{_print_comments} = 0;
95 78         108 $self->{_page_start} = 0;
96              
97 78         117 $self->{_fit_page} = 0;
98 78         124 $self->{_fit_width} = 0;
99 78         133 $self->{_fit_height} = 0;
100              
101 78         184 $self->{_hbreaks} = [];
102 78         143 $self->{_vbreaks} = [];
103              
104 78         134 $self->{_protect} = 0;
105 78         126 $self->{_password} = undef;
106              
107 78         141 $self->{_set_cols} = {};
108 78         166 $self->{_set_rows} = {};
109              
110 78         157 $self->{_zoom} = 100;
111 78         121 $self->{_print_scale} = 100;
112              
113 78         127 $self->{_leading_zeros} = 0;
114              
115 78         118 $self->{_outline_row_level} = 0;
116 78         112 $self->{_outline_style} = 0;
117 78         126 $self->{_outline_below} = 1;
118 78         402 $self->{_outline_right} = 1;
119 78         144 $self->{_outline_on} = 1;
120              
121 78         191 $self->{_names} = {};
122              
123 78         198 $self->{_write_match} = [];
124              
125 78         156 $self->{prev_col} = -1;
126              
127 78         190 $self->{_table} = [];
128 78         149 $self->{_merge} = {};
129 78         158 $self->{_comment} = {};
130              
131 78         143 $self->{_autofilter} = '';
132 78         137 $self->{_filter_on} = 0;
133 78         140 $self->{_filter_range} = [];
134 78         140 $self->{_filter_cols} = {};
135              
136              
137              
138 78         576 $self->{_datatypes} = {String => 1,
139             Number => 2,
140             DateTime => 3,
141             Formula => 4,
142             Blank => 5,
143             HRef => 6,
144             Merge => 7,
145             Comment => 8,
146             };
147              
148             # Set older cell limits if required for backward compatibility.
149 78 100       240 if ( $self->{_lower_cell_limits} ) {
150 11         23 $self->{_xls_rowmax} = 65536;
151 11         17 $self->{_xls_colmax} = 256;
152             }
153              
154              
155 78         188 bless $self, $class;
156 78         196 $self->_initialize();
157 78         215 return $self;
158             }
159              
160              
161             ###############################################################################
162             #
163             # _initialize()
164             #
165             # Placeholder.
166             #
167             sub _initialize {
168              
169 78     78   151 my $self = shift;
170             }
171              
172              
173             ###############################################################################
174             #
175             # _close()
176             #
177             # Write the worksheet elements.
178             #
179             sub _close {
180              
181 73     73   105 my $self = shift;
182 73         110 my $sheetnames = shift;
183 73         103 my $num_sheets = scalar @$sheetnames;
184              
185 73         409 $self->_write_xml_start_tag(1, 1, 0, 'Worksheet',
186             'ss:Name',
187             $self->{_name});
188              
189             # Write the Name elements such as print area and repeat rows.
190 73         189 $self->_write_names();
191              
192             # Write the Table element and the child Row, Cell and Data elements.
193 73         214 $self->_write_xml_table();
194              
195             # Write the worksheet page setup options.
196 73         236 $self->_write_worksheet_options();
197              
198             # Store horizontal and vertical pagebreaks.
199 73         208 $self->_store_pagebreaks();
200              
201             # Store autofilter information.
202 73         191 $self->_write_autofilter();
203              
204             # Close Workbook tag. WriteExcel _store_eof().
205 73         219 $self->_write_xml_end_tag(1, 1, 1, 'Worksheet');
206              
207             }
208              
209              
210             ###############################################################################
211             #
212             # get_name().
213             #
214             # Retrieve the worksheet name.
215             #
216             sub get_name {
217              
218 636     636 0 691 my $self = shift;
219              
220 636         2535 return $self->{_name};
221             }
222              
223              
224             ###############################################################################
225             #
226             # select()
227             #
228             # Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
229             # highlighted.
230             #
231             sub select {
232              
233 0     0 0 0 my $self = shift;
234              
235 0         0 $self->{_selected} = 1;
236             }
237              
238              
239             ###############################################################################
240             #
241             # activate()
242             #
243             # Set this worksheet as the active worksheet, i.e. the worksheet that is
244             # displayed when the workbook is opened. Also set it as selected.
245             #
246             sub activate {
247              
248 0     0 0 0 my $self = shift;
249              
250 0         0 $self->{_selected} = 1;
251 0         0 ${$self->{_activesheet}} = $self->{_index};
  0         0  
252             }
253              
254              
255             ###############################################################################
256             #
257             # set_first_sheet()
258             #
259             # Set this worksheet as the first visible sheet. This is necessary
260             # when there are a large number of worksheets and the activated
261             # worksheet is not visible on the screen.
262             #
263             sub set_first_sheet {
264              
265 0     0 0 0 my $self = shift;
266              
267 0         0 ${$self->{_firstsheet}} = $self->{_index};
  0         0  
268             }
269              
270              
271             ###############################################################################
272             #
273             # protect($password)
274             #
275             # Set the worksheet protection flag to prevent accidental modification and to
276             # hide formulas if the locked and hidden format properties have been set.
277             #
278             sub protect {
279              
280 0     0 0 0 my $self = shift;
281              
282 0         0 $self->{_protect} = 1;
283              
284             # No password in XML format.
285             }
286              
287              
288             ###############################################################################
289             #
290             # set_column($firstcol, $lastcol, $width, $format, $hidden, $autofit)
291             #
292             # Set the width of a single column or a range of columns.
293             # See also: _store_colinfo
294             #
295             sub set_column {
296              
297 24     24 0 146 my $self = shift;
298 24         44 my $cell = $_[0];
299              
300             # Check for a cell reference in A1 notation and substitute row and column
301 24 50       92 if ($cell =~ /^\D/) {
302 24         81 @_ = $self->_substitute_cellref(@_);
303              
304             # Returned values $row1 and $row2 aren't required here. Remove them.
305 24         45 shift @_; # $row1
306 24         55 splice @_, 1, 1; # $row2
307             }
308              
309              
310 24         35 my ($firstcol, $lastcol) = @_;
311              
312             # Ensure at least $firstcol, $lastcol and $width
313 24 50       72 return if @_ < 3;
314              
315             # Check that column number is valid and store the max value
316 24 100       73 return if $self->_check_dimensions(0, $lastcol);
317              
318              
319 22         33 my $width = $_[2];
320 22         80 my $format = _XF($self, 0, 0, $_[3]);
321 22         52 my $hidden = $_[4];
322 22         28 my $autofit = $_[5];
323              
324 22 100       72 if (defined $width) {
325 12         53 $width = $self->_size_col($_[2]);
326              
327             # The cell is hidden if the width is zero.
328 12 50       46 $hidden = 1 if $width == 0;
329             }
330              
331              
332 22         55 foreach my $col ($firstcol .. $lastcol) {
333 57         309 $self->{_set_cols}->{$col} = [$width, $format, $hidden, $autofit];
334             }
335             }
336              
337              
338             ###############################################################################
339             #
340             # set_selection()
341             #
342             # Set which cell or cells are selected in a worksheet: see also the
343             # sub _store_selection
344             #
345             sub set_selection {
346              
347 1     1 0 6 my $self = shift;
348              
349             # Check for a cell reference in A1 notation and substitute row and column
350 1 50       5 if ($_[0] =~ /^\D/) {
351 1         4 @_ = $self->_substitute_cellref(@_);
352             }
353              
354 1         13 $self->{_selection} = [ @_ ];
355             }
356              
357              
358             ###############################################################################
359             #
360             # freeze_panes()
361             #
362             # Set panes and mark them as frozen. See also _store_panes().
363             #
364             sub freeze_panes {
365              
366 0     0 0 0 my $self = shift;
367              
368             # Check for a cell reference in A1 notation and substitute row and column
369 0 0       0 if ($_[0] =~ /^\D/) {
370 0         0 @_ = $self->_substitute_cellref(@_);
371             }
372              
373 0         0 $self->{_frozen} = 1;
374 0         0 $self->{_panes} = [ @_ ];
375             }
376              
377              
378             ###############################################################################
379             #
380             # thaw_panes()
381             #
382             # Set panes and mark them as unfrozen. See also _store_panes().
383             #
384             sub thaw_panes {
385              
386 0     0 0 0 my $self = shift;
387              
388 0         0 $self->{_frozen} = 0;
389 0         0 $self->{_panes} = [ @_ ];
390             }
391              
392              
393             ###############################################################################
394             #
395             # set_portrait()
396             #
397             # Set the page orientation as portrait.
398             #
399             sub set_portrait {
400              
401 1     1 0 7 my $self = shift;
402              
403 1         3 $self->{_orientation} = 1;
404             }
405              
406              
407             ###############################################################################
408             #
409             # set_landscape()
410             #
411             # Set the page orientation as landscape.
412             #
413             sub set_landscape {
414              
415 1     1 0 6 my $self = shift;
416              
417 1         8 $self->{_orientation} = 0;
418             }
419              
420              
421             ###############################################################################
422             #
423             # set_paper()
424             #
425             # Set the paper type. Ex. 1 = US Letter, 9 = A4
426             #
427             sub set_paper {
428              
429 2     2 0 9 my $self = shift;
430              
431 2   100     21 $self->{_paper_size} = $_[0] || 0;
432             }
433              
434              
435             ###############################################################################
436             #
437             # set_header()
438             #
439             # Set the page header caption and optional margin.
440             #
441             sub set_header {
442              
443 2     2 0 9 my $self = shift;
444 2   50     8 my $string = $_[0] || '';
445              
446 2 50       7 if (length $string >= 255) {
447 0         0 carp 'Header string must be less than 255 characters';
448 0         0 return;
449             }
450              
451 2         4 $self->{_header} = $string;
452 2   100     12 $self->{_margin_head} = $_[1] || 0.50;
453             }
454              
455              
456             ###############################################################################
457             #
458             # set_footer()
459             #
460             # Set the page footer caption and optional margin.
461             #
462             sub set_footer {
463              
464 2     2 0 8 my $self = shift;
465 2   50     8 my $string = $_[0] || '';
466              
467 2 50       5 if (length $string >= 255) {
468 0         0 carp 'Footer string must be less than 255 characters';
469 0         0 return;
470             }
471              
472              
473 2         4 $self->{_footer} = $string;
474 2   100     11 $self->{_margin_foot} = $_[1] || 0.50;
475             }
476              
477              
478             ###############################################################################
479             #
480             # center_horizontally()
481             #
482             # Center the page horizontally.
483             #
484             sub center_horizontally {
485              
486 1     1 0 7 my $self = shift;
487              
488 1 50       4 if (defined $_[0]) {
489 0         0 $self->{_hcenter} = $_[0];
490             }
491             else {
492 1         4 $self->{_hcenter} = 1;
493             }
494             }
495              
496              
497             ###############################################################################
498             #
499             # center_vertically()
500             #
501             # Center the page horinzontally.
502             #
503             sub center_vertically {
504              
505 1     1 0 6 my $self = shift;
506              
507 1 50       14 if (defined $_[0]) {
508 0         0 $self->{_vcenter} = $_[0];
509             }
510             else {
511 1         4 $self->{_vcenter} = 1;
512             }
513             }
514              
515              
516             ###############################################################################
517             #
518             # set_margins()
519             #
520             # Set all the page margins to the same value in inches.
521             #
522             sub set_margins {
523              
524 1     1 0 6 my $self = shift;
525              
526 1         5 $self->set_margin_left($_[0]);
527 1         5 $self->set_margin_right($_[0]);
528 1         4 $self->set_margin_top($_[0]);
529 1         17 $self->set_margin_bottom($_[0]);
530             }
531              
532              
533             ###############################################################################
534             #
535             # set_margins_LR()
536             #
537             # Set the left and right margins to the same value in inches.
538             #
539             sub set_margins_LR {
540              
541 1     1 0 7 my $self = shift;
542              
543 1         4 $self->set_margin_left($_[0]);
544 1         4 $self->set_margin_right($_[0]);
545             }
546              
547              
548             ###############################################################################
549             #
550             # set_margins_TB()
551             #
552             # Set the top and bottom margins to the same value in inches.
553             #
554             sub set_margins_TB {
555              
556 1     1 0 5 my $self = shift;
557              
558 1         4 $self->set_margin_top($_[0]);
559 1         3 $self->set_margin_bottom($_[0]);
560             }
561              
562              
563             ###############################################################################
564             #
565             # set_margin_left()
566             #
567             # Set the left margin in inches.
568             #
569             sub set_margin_left {
570              
571 4     4 0 12 my $self = shift;
572              
573 4 50       14 $self->{_margin_left} = defined $_[0] ? $_[0] : 0.75;
574             }
575              
576              
577             ###############################################################################
578             #
579             # set_margin_right()
580             #
581             # Set the right margin in inches.
582             #
583             sub set_margin_right {
584              
585 4     4 0 8 my $self = shift;
586              
587 4 50       20 $self->{_margin_right} = defined $_[0] ? $_[0] : 0.75;
588             }
589              
590              
591             ###############################################################################
592             #
593             # set_margin_top()
594             #
595             # Set the top margin in inches.
596             #
597             sub set_margin_top {
598              
599 4     4 0 10 my $self = shift;
600              
601 4 50       14 $self->{_margin_top} = defined $_[0] ? $_[0] : 1.00;
602             }
603              
604              
605             ###############################################################################
606             #
607             # set_margin_bottom()
608             #
609             # Set the bottom margin in inches.
610             #
611             sub set_margin_bottom {
612              
613 4     4 0 10 my $self = shift;
614              
615 4 50       15 $self->{_margin_bottom} = defined $_[0] ? $_[0] : 1.00;
616             }
617              
618              
619             ###############################################################################
620             #
621             # repeat_rows($first_row, $last_row)
622             #
623             # Set the rows to repeat at the top of each printed page. This is stored as
624             # element.
625             #
626             sub repeat_rows {
627              
628 4     4 0 17 my $self = shift;
629              
630 4         7 my $row_min = $_[0];
631 4   66     11 my $row_max = $_[1] || $_[0]; # Second row is optional
632              
633 4         4 my $area;
634              
635             # Convert the zero-indexed rows to R1:R2 notation.
636 4 100       8 if ($row_min == $row_max) {
637 2         6 $area = 'R' . ($row_min +1);
638             }
639             else {
640 2         13 $area = 'R' . ($row_min +1) . ':' . 'R' . ($row_max +1);
641             }
642              
643             # Build up the print area range "=Sheet2!R1:R2"
644 4         19 my $sheetname = $self->_quote_sheetname($self->{_name});
645 4         8 $area = $sheetname . "!". $area;
646              
647              
648 4         12 $self->{_repeat_rows} = $area;
649             }
650              
651              
652             ###############################################################################
653             #
654             # repeat_columns($first_col, $last_col)
655             #
656             # Set the columns to repeat at the left hand side of each printed page. This is
657             # stored as a element.
658             #
659             sub repeat_columns {
660              
661 4     4 0 16 my $self = shift;
662              
663             # Check for a cell reference in A1 notation and substitute row and column
664 4 50       49 if ($_[0] =~ /^\D/) {
665 4         13 @_ = $self->_substitute_cellref(@_);
666              
667             # Returned values $row1 and $row2 aren't required here. Remove them.
668 4         6 shift @_; # $row1
669 4         9 splice @_, 1, 1; # $row2
670             }
671              
672 4         7 my $col_min = $_[0];
673 4   66     13 my $col_max = $_[1] || $_[0]; # Second col is optional
674              
675 4         5 my $area;
676              
677             # Convert the zero-indexed cols to C1:C2 notation.
678 4 100       10 if ($col_min == $col_max) {
679 2         5 $area = 'C' . ($col_min +1);
680             }
681             else {
682 2         7 $area = 'C' . ($col_min +1) . ':' . 'C' . ($col_max +1);
683             }
684              
685             # Build up the print area range "=Sheet2!C1:C2"
686 4         11 my $sheetname = $self->_quote_sheetname($self->{_name});
687 4         8 $area = $sheetname . "!". $area;
688              
689              
690 4         17 $self->{_repeat_cols} = $area;
691             }
692              
693              
694             ###############################################################################
695             #
696             # print_area($first_row, $first_col, $last_row, $last_col)
697             #
698             # Set the print area in the current worksheet. This is stored as a
699             # element.
700             #
701             sub print_area {
702              
703 16     16 0 62 my $self = shift;
704              
705             # Check for a cell reference in A1 notation and substitute row and column
706 16 100       57 if ($_[0] =~ /^\D/) {
707 14         41 @_ = $self->_substitute_cellref(@_);
708             }
709              
710 16 100       61 return if @_ != 4; # Require 4 parameters
711              
712 13         27 my ($row1, $col1, $row2, $col2) = @_;
713              
714             # Ignore max print area since this is the same as no print area for Excel.
715 13 100 33     136 if ($row1 == 0 and
  1   66     4  
      100        
716             $col1 == 0 and
717             $row2 == $self->{_xls_rowmax} -1 and
718             $col2 == $self->{_xls_colmax} -1
719             ){return}
720              
721             # Build up the print area range "=Sheet2!R1C1:R2C1"
722 12         39 my $area = $self->_convert_name_area($row1, $col1, $row2, $col2);
723              
724 12         54 $self->{_names}->{'Print_Area'} = $area;
725             }
726              
727              
728             ###############################################################################
729             #
730             # autofilter($first_row, $first_col, $last_row, $last_col)
731             #
732             # Set the autofilter area in the worksheet.
733             #
734             sub autofilter {
735              
736 2     2 0 15 my $self = shift;
737              
738             # Check for a cell reference in A1 notation and substitute row and column
739 2 50       12 if ($_[0] =~ /^\D/) {
740 2         9 @_ = $self->_substitute_cellref(@_);
741             }
742              
743 2 50       10 return if @_ != 4; # Require 4 parameters
744              
745 2         4 my ($row1, $col1, $row2, $col2) = @_;
746              
747              
748             # Build up the print area range "=Sheet2!R1C1:R2C1"
749 2         20 my $area = $self->_convert_name_area($row1, $col1, $row2, $col2);
750              
751              
752             # Store the filter as a named range
753 2         6 $self->{_names}->{'_FilterDatabase'} = $area;
754              
755             # Store the information
756 2         15 $area =~ s/[^!]+!//; # Remove sheet name
757 2         6 $self->{_autofilter} = $area;
758 2         11 $self->{_filter_range} = [$col1, $col2];
759             }
760              
761              
762             ###############################################################################
763             #
764             # filter_column($column, $criteria, ...)
765             #
766             # Set the column filter criteria.
767             #
768             sub filter_column {
769              
770 4     4 0 18 my $self = shift;
771 4         7 my $col = $_[0];
772 4         7 my $expression = $_[1];
773              
774              
775             # Check for a column reference in A1 notation and substitute.
776 4 50       19 if ($col =~ /^\D/) {
777 4         8 my $col_letter = $col;
778 4         29 (undef, $col) = xl_cell_to_rowcol($col . '1');
779              
780 4 50       22 croak "Invalid column '$col_letter'" if $col >= $self->{_xls_colmax};
781             }
782              
783              
784 4         6 my ($col_first, $col_last) = @{$self->{_filter_range}};
  4         10  
785              
786             # Ignore column if it is outside filter range.
787 4 50 33     24 return if $col < $col_first or $col > $col_last;
788              
789              
790 4         18 my @tokens = split ' ', $expression;
791              
792 4 50 66     24 croak "Incorrect number of tokens in expression '$expression'"
793             unless (@tokens == 3 or @tokens == 7);
794              
795              
796             # We create an array slice to extract the operators from the arguments
797             # and another to exclude the column placeholders.
798             #
799             # Index: 0 1 2 3 4 5 6
800             # x > 2
801             # x > 2 and x < 6
802              
803 4 100       15 my @slice1 = @tokens == 3 ? (1) : (1, 3, 5 );
804 4 100       21 my @slice2 = @tokens == 3 ? (1, 2) : (1, 2, 3, 5, 6);
805              
806              
807 4         55 my %operators = (
808             '==' => 'Equals',
809             '=' => 'Equals',
810             '=~' => 'Equals',
811             'eq' => 'Equals',
812              
813             '!=' => 'DoesNotEqual',
814             '!~' => 'DoesNotEqual',
815             'ne' => 'DoesNotEqual',
816             '<>' => 'DoesNotEqual',
817              
818             '>' => 'GreaterThan',
819             '>=' => 'GreaterThanOrEqual',
820             '<' => 'LessThan',
821             '<=' => 'LessThanOrEqual',
822              
823             'and' => 'AutoFilterAnd',
824             'or' => 'AutoFilterOr',
825             '&&' => 'AutoFilterAnd',
826             '||' => 'AutoFilterOr',
827             );
828              
829              
830 4         12 for (@tokens[@slice1]) {
831 8 50       30 if (not exists $operators{$_}) {
832 0         0 croak "Unknown operator '$_'";
833             }
834             }
835              
836              
837 4         9 for (@tokens[@slice1]) {
838 8         31 for my $key (keys %operators) {
839 128         1043 s/^\Q$key\E$/$operators{$key}/i;
840             }
841             }
842              
843 4         20 $self->{_filter_cols}->{$col} = [@tokens[@slice2]];
844 4         37 $self->{_filter_on} = 1;
845             }
846              
847              
848             ###############################################################################
849             #
850             # _convert_name_area($first_row, $first_col, $last_row, $last_col)
851             #
852             # Convert zero indexed rows and columns to the R1C1 range required by worksheet
853             # named ranges, eg, "=Sheet2!R1C1:R2C1".
854             #
855             sub _convert_name_area {
856              
857 14     14   20 my $self = shift;
858              
859 14         21 my $row1 = $_[0];
860 14         21 my $col1 = $_[1];
861 14         18 my $row2 = $_[2];
862 14         19 my $col2 = $_[3];
863              
864 14         31 my $range1 = '';
865 14         22 my $range2 = '';
866 14         23 my $area;
867              
868              
869             # We need to handle some special cases that refer to rows or columns only.
870 14 100 100     118 if ( $row1 == 0 and $row2 == $self->{_xls_rowmax} -1) {
    100 100        
871 2         5 $range1 = 'C' . ($col1 +1);
872 2         4 $range2 = 'C' . ($col2 +1);
873             }
874             elsif ($col1 == 0 and $col2 == $self->{_xls_colmax} -1) {
875 2         5 $range1 = 'R' . ($row1 +1);
876 2         6 $range2 = 'R' . ($row2 +1);
877             }
878             else {
879 10         33 $range1 = 'R' . ($row1 +1) . 'C' . ($col1 +1);
880 10         30 $range2 = 'R' . ($row2 +1) . 'C' . ($col2 +1);
881             }
882              
883              
884             # A repeated range is only written once.
885 14 100       40 if ($range1 eq $range2) {
886 6         11 $area = $range1;
887             }
888             else {
889 8         18 $area = $range1 . ':' . $range2;
890             }
891              
892             # Build up the print area range "=Sheet2!R1C1:R2C1"
893 14         51 my $sheetname = $self->_quote_sheetname($self->{_name});
894 14         32 $area = '=' . $sheetname . "!". $area;
895              
896              
897 14         31 return $area;
898             }
899              
900              
901             ###############################################################################
902             #
903             # hide_gridlines()
904             #
905             # Set the option to hide gridlines on the screen and the printed page.
906             #
907             # This was mainly useful for Excel 5 where printed gridlines were on by
908             # default.
909             #
910             sub hide_gridlines {
911              
912 2     2 0 10 my $self = shift;
913 2         4 my $option = $_[0];
914              
915 2 50       5 $option = 1 unless defined $option; # Default to hiding printed gridlines
916              
917 2 50       9 if ($option == 0) {
    100          
918 0         0 $self->{_print_gridlines} = 1; # 1 = display, 0 = hide
919 0         0 $self->{_screen_gridlines} = 1;
920             }
921             elsif ($option == 1) {
922 1         2 $self->{_print_gridlines} = 0;
923 1         3 $self->{_screen_gridlines} = 1;
924             }
925             else {
926 1         2 $self->{_print_gridlines} = 0;
927 1         2 $self->{_screen_gridlines} = 0;
928             }
929             }
930              
931              
932             ###############################################################################
933             #
934             # print_gridlines()
935             #
936             # Turn on the printed gridlines.
937             #
938             sub print_gridlines {
939              
940 3     3 0 13 my $self = shift;
941              
942 3 100       11 $self->{_print_gridlines} = defined $_[0] ? $_[0] : 1;
943             }
944              
945              
946             ###############################################################################
947             #
948             # print_row_col_headers()
949             #
950             # Set the option to print the row and column headers on the printed page.
951             # See also the _store_print_headers() method below.
952             #
953             sub print_row_col_headers {
954              
955 1     1 0 6 my $self = shift;
956              
957 1 50       5 if (defined $_[0]) {
958 0         0 $self->{_print_headers} = $_[0];
959             }
960             else {
961 1         3 $self->{_print_headers} = 1;
962             }
963             }
964              
965              
966             ###############################################################################
967             #
968             # fit_to_pages($width, $height)
969             #
970             # Store the vertical and horizontal number of pages that will define the
971             # maximum area printed. See also _store_setup() and _store_wsbool() below.
972             #
973             sub fit_to_pages {
974              
975 4     4 0 17 my $self = shift;
976              
977 4         7 $self->{_fit_page} = 1;
978 4   50     12 $self->{_fit_width} = $_[0] || 1;
979 4   100     19 $self->{_fit_height} = $_[1] || 1;
980             }
981              
982              
983             ###############################################################################
984             #
985             # set_h_pagebreaks(@breaks)
986             #
987             # Store the horizontal page breaks on a worksheet.
988             #
989             sub set_h_pagebreaks {
990              
991 3     3 0 10 my $self = shift;
992              
993 3         4 push @{$self->{_hbreaks}}, @_;
  3         9  
994             }
995              
996              
997             ###############################################################################
998             #
999             # set_v_pagebreaks(@breaks)
1000             #
1001             # Store the vertical page breaks on a worksheet.
1002             #
1003             sub set_v_pagebreaks {
1004              
1005 3     3 0 11 my $self = shift;
1006              
1007 3         4 push @{$self->{_vbreaks}}, @_;
  3         10  
1008             }
1009              
1010              
1011             ###############################################################################
1012             #
1013             # set_zoom($scale)
1014             #
1015             # Set the worksheet zoom factor.
1016             #
1017             sub set_zoom {
1018              
1019 0     0 0 0 my $self = shift;
1020 0   0     0 my $scale = $_[0] || 100;
1021              
1022             # Confine the scale to Excel's range
1023 0 0 0     0 if ($scale < 10 or $scale > 400) {
1024 0         0 carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
1025 0         0 $scale = 100;
1026             }
1027              
1028 0         0 $self->{_zoom} = int $scale;
1029             }
1030              
1031              
1032             ###############################################################################
1033             #
1034             # set_print_scale($scale)
1035             #
1036             # Set the scale factor for the printed page.
1037             #
1038             sub set_print_scale {
1039              
1040 1     1 0 5 my $self = shift;
1041 1   50     4 my $scale = $_[0] || 100;
1042              
1043             # Confine the scale to Excel's range
1044 1 50 33     7 if ($scale < 10 or $scale > 400) {
1045 0         0 carp "Print scale $scale outside range: 10 <= zoom <= 400";
1046 0         0 $scale = 100;
1047             }
1048              
1049             # Turn off "fit to page" option
1050 1         2 $self->{_fit_page} = 0;
1051              
1052 1         3 $self->{_print_scale} = int $scale;
1053             }
1054              
1055              
1056             ###############################################################################
1057             #
1058             # keep_leading_zeros()
1059             #
1060             # Causes the write() method to treat integers with a leading zero as a string.
1061             # This ensures that any leading zeros such, as in zip codes, are maintained.
1062             #
1063             sub keep_leading_zeros {
1064              
1065 0     0 0 0 my $self = shift;
1066              
1067 0 0       0 if (defined $_[0]) {
1068 0         0 $self->{_leading_zeros} = $_[0];
1069             }
1070             else {
1071 0         0 $self->{_leading_zeros} = 1;
1072             }
1073             }
1074              
1075              
1076             ###############################################################################
1077             #
1078             # add_write_handler($re, $code_ref)
1079             #
1080             # Allow the user to add their own matches and handlers to the write() method.
1081             #
1082             sub add_write_handler {
1083              
1084 0     0 0 0 my $self = shift;
1085              
1086 0 0       0 return unless @_ == 2;
1087 0 0       0 return unless ref $_[1] eq 'CODE';
1088              
1089 0         0 push @{$self->{_write_match}}, [ @_ ];
  0         0  
1090             }
1091              
1092              
1093              
1094             ###############################################################################
1095             #
1096             # write($row, $col, $token, $format)
1097             #
1098             # Parse $token and call appropriate write method. $row and $column are zero
1099             # indexed. $format is optional.
1100             #
1101             # Returns: return value of called subroutine
1102             #
1103             sub write {
1104              
1105 270     270 0 790 my $self = shift;
1106              
1107             # Check for a cell reference in A1 notation and substitute row and column
1108 270 100       882 if ($_[0] =~ /^\D/) {
1109 129         331 @_ = $self->_substitute_cellref(@_);
1110             }
1111              
1112 270         397 my $token = $_[2];
1113              
1114             # Handle undefs as blanks
1115 270 50       599 $token = '' unless defined $token;
1116              
1117              
1118             # First try user defined matches.
1119 270         426 for my $aref (@{$self->{_write_match}}) {
  270         659  
1120 0         0 my $re = $aref->[0];
1121 0         0 my $sub = $aref->[1];
1122              
1123 0 0       0 if ($token =~ /$re/) {
1124 0         0 my $match = &$sub($self, @_);
1125 0 0       0 return $match if defined $match;
1126             }
1127             }
1128              
1129              
1130             # Match an array ref.
1131 270 100 33     2819 if (ref $token eq "ARRAY") {
    50          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
1132 26         70 return $self->write_row(@_);
1133             }
1134             # Match integer with leading zero(s)
1135             elsif ($self->{_leading_zeros} and $token =~ /^0\d+$/) {
1136 0         0 return $self->write_string(@_);
1137             }
1138             # Match number
1139             elsif ($token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
1140 39         129 return $self->write_number(@_);
1141             }
1142             # Match http, https or ftp URL
1143             elsif ($token =~ m|^[fh]tt?ps?://|) {
1144 6         25 return $self->write_url(@_);
1145             }
1146             # Match mailto:
1147             elsif ($token =~ m/^mailto:/) {
1148 1         4 return $self->write_url(@_);
1149             }
1150             # Match internal or external sheet link
1151             elsif ($token =~ m[^(?:in|ex)ternal:]) {
1152 0         0 return $self->write_url(@_);
1153             }
1154             # Match formula
1155             elsif ($token =~ /^=/) {
1156 2         14 return $self->write_formula(@_);
1157             }
1158             # Match array formula
1159             elsif ($token =~ /^{=.*}$/) {
1160 1         5 return $self->write_formula(@_);
1161             }
1162             # Match blank
1163             elsif ($token eq '') {
1164 2         6 splice @_, 2, 1; # remove the empty string from the parameter list
1165 2         9 return $self->write_blank(@_);
1166             }
1167             # Default: match string
1168             else {
1169 193         482 return $self->write_string(@_);
1170             }
1171             }
1172              
1173              
1174             ###############################################################################
1175             #
1176             # write_row($row, $col, $array_ref, $format)
1177             #
1178             # Write a row of data starting from ($row, $col). Call write_col() if any of
1179             # the elements of the array ref are in turn array refs. This allows the writing
1180             # of 1D or 2D arrays of data in one go.
1181             #
1182             # Returns: the first encountered error value or zero for no errors
1183             #
1184             sub write_row {
1185              
1186 27     27 0 48 my $self = shift;
1187              
1188              
1189             # Check for a cell reference in A1 notation and substitute row and column
1190 27 100       79 if ($_[0] =~ /^\D/) {
1191 1         3 @_ = $self->_substitute_cellref(@_);
1192             }
1193              
1194             # Catch non array refs passed by user.
1195 27 50       68 if (ref $_[2] ne 'ARRAY') {
1196 0         0 croak "Not an array ref in call to write_row()$!";
1197             }
1198              
1199 27         44 my $row = shift;
1200 27         37 my $col = shift;
1201 27         45 my $tokens = shift;
1202 27         38 my @options = @_;
1203 27         35 my $error = 0;
1204 27         26 my $ret;
1205              
1206 27         50 foreach my $token (@$tokens) {
1207              
1208             # Check for nested arrays
1209 96 100       172 if (ref $token eq "ARRAY") {
1210 6         20 $ret = $self->write_col($row, $col, $token, @options);
1211             } else {
1212 90         193 $ret = $self->write ($row, $col, $token, @options);
1213             }
1214              
1215             # Return only the first error encountered, if any.
1216 96   33     318 $error ||= $ret;
1217 96         166 $col++;
1218             }
1219              
1220 27         87 return $error;
1221             }
1222              
1223              
1224             ###############################################################################
1225             #
1226             # write_col($row, $col, $array_ref, $format)
1227             #
1228             # Write a column of data starting from ($row, $col). Call write_row() if any of
1229             # the elements of the array ref are in turn array refs. This allows the writing
1230             # of 1D or 2D arrays of data in one go.
1231             #
1232             # Returns: the first encountered error value or zero for no errors
1233             #
1234             sub write_col {
1235              
1236 6     6 0 9 my $self = shift;
1237              
1238              
1239             # Check for a cell reference in A1 notation and substitute row and column
1240 6 50       27 if ($_[0] =~ /^\D/) {
1241 0         0 @_ = $self->_substitute_cellref(@_);
1242             }
1243              
1244             # Catch non array refs passed by user.
1245 6 50       19 if (ref $_[2] ne 'ARRAY') {
1246 0         0 croak "Not an array ref in call to write_col()$!";
1247             }
1248              
1249 6         10 my $row = shift;
1250 6         15 my $col = shift;
1251 6         8 my $tokens = shift;
1252 6         12 my @options = @_;
1253 6         6 my $error = 0;
1254 6         10 my $ret;
1255              
1256 6         13 foreach my $token (@$tokens) {
1257              
1258             # write() will deal with any nested arrays
1259 32         83 $ret = $self->write($row, $col, $token, @options);
1260              
1261             # Return only the first error encountered, if any.
1262 32   33     145 $error ||= $ret;
1263 32         48 $row++;
1264             }
1265              
1266 6         24 return $error;
1267             }
1268              
1269              
1270             ###############################################################################
1271             #
1272             # write_comment($row, $col, $comment)
1273             #
1274             # Write a comment to the specified row and column (zero indexed). The maximum
1275             # comment size is 30831 chars. Excel5 probably accepts 32k-1 chars. However, it
1276             # can only display 30831 chars. Excel 7 and 2000 will crash above 32k-1.
1277             #
1278             # In Excel 5 a comment is referred to as a NOTE.
1279             #
1280             # Returns 0 : normal termination
1281             # -1 : insufficient number of arguments
1282             # -2 : row or column out of range
1283             # -3 : long comment truncated to 30831 chars
1284             #
1285             sub write_comment {
1286              
1287 8     8 0 26 my $self = shift;
1288              
1289             # Check for a cell reference in A1 notation and substitute row and column
1290 8 50       21 if ($_[0] =~ /^\D/) {
1291 8         14 @_ = $self->_substitute_cellref(@_);
1292             }
1293              
1294              
1295 8 50       17 if (@_ < 3) { return -1 } # Check the number of args
  0         0  
1296              
1297 8         7 my $row = $_[0];
1298 8         7 my $col = $_[1];
1299 8         9 my $comment = $_[2];
1300 8         8 my $length = length($_[2]);
1301 8         8 my $error = 0;
1302 8         5 my $max_len = 30831; # Maintain same max as binary file.
1303 8         10 my $type = $self->{_datatypes}->{Comment};
1304              
1305             # Check that row and col are valid and store max and min values
1306 8 50       13 return -2 if $self->_check_dimensions($row, $col);
1307              
1308             # String must be <= 30831 chars
1309 8 50       13 if ($length > $max_len) {
1310 0         0 $comment = substr($comment, 0, $max_len);
1311 0         0 $error = -3;
1312             }
1313              
1314              
1315             # Check that row and col are valid and store max and min values
1316 8 50       14 return -2 if $self->_check_dimensions($row, $col);
1317              
1318              
1319             # Add a datatype to the cell if it doesn't already contain one.
1320             # This prevents an empty cell with a comment from being ignored.
1321             #
1322 8 100       23 if (not $self->{_table}->[$row]->[$col]) {
1323 1         3 $self->{_table}->[$row]->[$col] = [$type];
1324             }
1325              
1326             # Store the comment.
1327 8         31 $self->{_comment}->{$row}->{$col} = $comment;
1328              
1329 8         19 return $error;
1330             }
1331              
1332              
1333             ###############################################################################
1334             #
1335             # _XF()
1336             #
1337             # Returns an index to the XF record in the workbook.
1338             #
1339             # Note: this is a function, not a method.
1340             #
1341             sub _XF {
1342              
1343             # TODO $row and $col aren't actually required in the XML version and
1344             # should eventually be removed. They are required in the Biff version
1345             # to allow for row and col formats.
1346              
1347 315     315   388 my $self = $_[0];
1348 315         362 my $row = $_[1];
1349 315         395 my $col = $_[2];
1350 315         469 my $format = $_[3];
1351              
1352 315 100       555 if (ref($format)) {
1353 64         216 return $format->get_xf_index();
1354             }
1355             else {
1356 251         505 return 0; # 0x0F for Spreadsheet::WriteExcel
1357             }
1358             }
1359              
1360              
1361             ###############################################################################
1362             ###############################################################################
1363             #
1364             # Internal methods
1365             #
1366              
1367              
1368              
1369             ###############################################################################
1370             #
1371             # _substitute_cellref()
1372             #
1373             # Substitute an Excel cell reference in A1 notation for zero based row and
1374             # column values in an argument list.
1375             #
1376             # Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
1377             #
1378             sub _substitute_cellref {
1379              
1380 210     210   295 my $self = shift;
1381 210         412 my $cell = uc(shift);
1382              
1383             # Convert a column range: 'A:A' or 'B:G'.
1384             # A range such as A:A is equivalent to A1:Rowmax, so add rows as required
1385 210 100       630 if ($cell =~ /\$?([A-Z]{1,3}):\$?([A-Z]{1,3})/) {
1386 30         136 my ($row1, $col1) = $self->_cell_to_rowcol($1 .'1');
1387 30         192 my ($row2, $col2) = $self->_cell_to_rowcol($2 . $self->{_xls_rowmax});
1388 30         158 return $row1, $col1, $row2, $col2, @_;
1389             }
1390              
1391             # Convert a cell range: 'A1:B7'
1392 180 100       457 if ($cell =~ /\$?([A-Z]{1,3}\$?\d+):\$?([A-Z]{1,3}\$?\d+)/) {
1393 33         91 my ($row1, $col1) = $self->_cell_to_rowcol($1);
1394 33         86 my ($row2, $col2) = $self->_cell_to_rowcol($2);
1395 33         184 return $row1, $col1, $row2, $col2, @_;
1396             }
1397              
1398             # Convert a cell reference: 'A1' or 'AD2000'
1399 147 50       655 if ($cell =~ /\$?([A-Z]{1,3}\$?\d+)/) {
1400 147         454 my ($row1, $col1) = $self->_cell_to_rowcol($1);
1401 147         682 return $row1, $col1, @_;
1402              
1403             }
1404              
1405 0         0 croak("Unknown cell reference $cell");
1406             }
1407              
1408              
1409             ###############################################################################
1410             #
1411             # _cell_to_rowcol($cell_ref)
1412             #
1413             # Convert an Excel cell reference in A1 notation to a zero based row and column
1414             # reference; converts C1 to (0, 2).
1415             #
1416             # See also: http://www.perlmonks.org/index.pl?node_id=270352
1417             #
1418             # Returns: ($row, $col, $row_absolute, $col_absolute)
1419             #
1420             #
1421             sub _cell_to_rowcol {
1422              
1423 360     360   446 my $self = shift;
1424              
1425 360         658 my $cell = $_[0];
1426 360         1061 $cell =~ /(\$?)([A-Z]{1,3})(\$?)(\d+)/;
1427              
1428 360 100       885 my $col_abs = $1 eq "" ? 0 : 1;
1429 360         571 my $col = $2;
1430 360 100       708 my $row_abs = $3 eq "" ? 0 : 1;
1431 360         525 my $row = $4;
1432              
1433             # Convert base26 column string to number
1434             # All your Base are belong to us.
1435 360         950 my @chars = split //, $col;
1436 360         592 my $expn = 0;
1437 360         389 $col = 0;
1438              
1439 360         1044 while (@chars) {
1440 394         786 my $char = pop(@chars); # LS char first
1441 394         795 $col += (ord($char) -ord('A') +1) * (26**$expn);
1442 394         964 $expn++;
1443             }
1444              
1445             # Convert 1-index to zero-index
1446 360         542 $row--;
1447 360         393 $col--;
1448              
1449             # TODO Check row and column range
1450 360         1140 return $row, $col, $row_abs, $col_abs;
1451             }
1452              
1453              
1454             ###############################################################################
1455             #
1456             # _sort_pagebreaks()
1457             #
1458             #
1459             # This is an internal method that is used to filter elements of the array of
1460             # pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
1461             # 1. Removes duplicate entries from the list.
1462             # 2. Sorts the list.
1463             # 3. Removes 0 from the list if present.
1464             #
1465             sub _sort_pagebreaks {
1466              
1467 6     6   7 my $self= shift;
1468              
1469 6         6 my %hash;
1470             my @array;
1471              
1472 6         16 @hash{@_} = undef; # Hash slice to remove duplicates
1473 6         19 @array = sort {$a <=> $b} keys %hash; # Numerical sort
  4         9  
1474 6 50       16 shift @array if $array[0] == 0; # Remove zero
1475              
1476             # 1000 vertical pagebreaks appears to be an internal Excel 5 limit.
1477             # It is slightly higher in Excel 97/200, approx. 1026
1478 6 50       11 splice(@array, 1000) if (@array > 1000);
1479              
1480             return @array
1481 6         19 }
1482              
1483              
1484             ###############################################################################
1485             #
1486             # outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
1487             #
1488             # This method sets the properties for outlining and grouping. The defaults
1489             # correspond to Excel's defaults.
1490             #
1491             sub outline_settings {
1492              
1493 0     0 0 0 my $self = shift;
1494              
1495 0 0       0 $self->{_outline_on} = defined $_[0] ? $_[0] : 1;
1496 0 0       0 $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
1497 0 0       0 $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
1498 0   0     0 $self->{_outline_style} = $_[3] || 0;
1499              
1500             # Ensure this is a boolean vale for Window2
1501 0 0       0 $self->{_outline_on} = 1 if $self->{_outline_on};
1502             }
1503              
1504              
1505              
1506              
1507             ###############################################################################
1508             ###############################################################################
1509             #
1510             # Public Methods
1511             #
1512              
1513              
1514             ###############################################################################
1515             #
1516             # write_number($row, $col, $num, $format)
1517             #
1518             # Write a double to the specified row and column (zero indexed).
1519             # An integer can be written as a double. Excel will display an
1520             # integer. $format is optional.
1521             #
1522             # Returns 0 : normal termination
1523             # -1 : insufficient number of arguments
1524             # -2 : row or column out of range
1525             #
1526             sub write_number {
1527              
1528 39     39 0 52 my $self = shift;
1529              
1530             # Check for a cell reference in A1 notation and substitute row and column
1531 39 50       131 if ($_[0] =~ /^\D/) {
1532 0         0 @_ = $self->_substitute_cellref(@_);
1533             }
1534              
1535 39 50       524 if (@_ < 3) { return -1 } # Check the number of args
  0         0  
1536              
1537              
1538 39         59 my $row = $_[0]; # Zero indexed row
1539 39         107 my $col = $_[1]; # Zero indexed column
1540 39         59 my $num = $_[2];
1541 39         169 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
1542 39         228 my $type = $self->{_datatypes}->{Number}; # The data type
1543              
1544             # Check that row and col are valid and store max and min values
1545 39 50       93 return -2 if $self->_check_dimensions($row, $col);
1546              
1547 39         127 $self->{_table}->[$row]->[$col] = [$type, $num, $xf];
1548              
1549 39         109 return 0;
1550             }
1551              
1552              
1553             ###############################################################################
1554             #
1555             # write_string ($row, $col, $string, $format, $html)
1556             #
1557             # Write a string to the specified row and column (zero indexed).
1558             # $format is optional.
1559             # Returns 0 : normal termination
1560             # -1 : insufficient number of arguments
1561             # -2 : row or column out of range
1562             # -3 : long string truncated to 32767 chars
1563             #
1564             sub write_string {
1565              
1566 197     197 0 269 my $self = shift;
1567              
1568             # Check for a cell reference in A1 notation and substitute row and column
1569 197 100       555 if ($_[0] =~ /^\D/) {
1570 1         3 @_ = $self->_substitute_cellref(@_);
1571             }
1572              
1573 197 50       390 if (@_ < 3) { return -1 } # Check the number of args
  0         0  
1574              
1575 197         271 my $row = $_[0]; # Zero indexed row
1576 197         358 my $col = $_[1]; # Zero indexed column
1577 197         302 my $str = $_[2];
1578 197         522 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
1579 197   100     814 my $html = $_[4] || 0; # Cell contains html text
1580 197         258 my $comment = ''; # Cell comment
1581 197         324 my $type = $self->{_datatypes}->{String}; # The data type
1582              
1583 197         198 my $str_error = 0;
1584              
1585             # Check that row and col are valid and store max and min values
1586 197 100       394 return -2 if $self->_check_dimensions($row, $col);
1587              
1588 185 50       448 if (length $str > $self->{_xls_strmax}) { # LABEL must be < 32767 chars
1589 0         0 $str = substr($str, 0, $self->{_xls_strmax});
1590 0         0 $str_error = -3;
1591             }
1592              
1593             # Check if the cell already has a comment
1594 185 50       12599 if ($self->{_table}->[$row]->[$col]) {
1595 0         0 $comment = $self->{_table}->[$row]->[$col]->[4];
1596             }
1597              
1598              
1599 185         1070 $self->{_table}->[$row]->[$col] = [$type, $str, $xf, $html, $comment];
1600              
1601 185         679 return $str_error;
1602             }
1603              
1604              
1605             ###############################################################################
1606             #
1607             # write_html_string ($row, $col, $string, $format)
1608             #
1609             # Write a string to the specified row and column (zero indexed).
1610             #
1611             # Returns 0 : normal termination
1612             # -1 : insufficient number of arguments
1613             # -2 : row or column out of range
1614             # -3 : long string truncated to 32767 chars
1615             #
1616             sub write_html_string {
1617              
1618 3     3 0 101 my $self = shift;
1619              
1620             # Check for a cell reference in A1 notation and substitute row and column
1621 3 50       13 if ($_[0] =~ /^\D/) {
1622 3         9 @_ = $self->_substitute_cellref(@_);
1623             }
1624              
1625 3 50       20 if (@_ < 3) { return -1 } # Check the number of args
  0         0  
1626              
1627 3         5 my $row = $_[0]; # Zero indexed row
1628 3         5 my $col = $_[1]; # Zero indexed column
1629 3         4 my $str = $_[2];
1630 3         4 my $xf = $_[3]; # The cell format
1631 3         5 my $html = 1; # Cell contains html text
1632              
1633              
1634 3         8 return $self->write_string($row, $col, $str, $xf, $html);
1635             }
1636              
1637              
1638             ###############################################################################
1639             #
1640             # write_blank($row, $col, $format)
1641             #
1642             # Write a blank cell to the specified row and column (zero indexed).
1643             # A blank cell is used to specify formatting without adding a string
1644             # or a number.
1645             #
1646             # A blank cell without a format serves no purpose. Therefore, we don't write
1647             # a BLANK record unless a format is specified. This is mainly an optimisation
1648             # for the write_row() and write_col() methods.
1649             #
1650             # Returns 0 : normal termination (including no format)
1651             # -1 : insufficient number of arguments
1652             # -2 : row or column out of range
1653             #
1654             sub write_blank {
1655              
1656 2     2 0 3 my $self = shift;
1657              
1658             # Check for a cell reference in A1 notation and substitute row and column
1659 2 50       15 if ($_[0] =~ /^\D/) {
1660 0         0 @_ = $self->_substitute_cellref(@_);
1661             }
1662              
1663             # Check the number of args
1664 2 50       7 return -1 if @_ < 2;
1665              
1666             # Don't write a blank cell unless it has a format
1667 2 100       16 return 0 if not defined $_[2];
1668              
1669              
1670 1         3 my $record = 0x0201; # Record identifier
1671 1         2 my $length = 0x0006; # Number of bytes to follow
1672              
1673 1         2 my $row = $_[0]; # Zero indexed row
1674 1         1 my $col = $_[1]; # Zero indexed column
1675 1         5 my $xf = _XF($self, $row, $col, $_[2]); # The cell format
1676 1         3 my $type = $self->{_datatypes}->{Blank}; # The data type
1677              
1678             # Check that row and col are valid and store max and min values
1679 1 50       2 return -2 if $self->_check_dimensions($row, $col);
1680              
1681 1         19 $self->{_table}->[$row]->[$col] = [$type, undef, $xf];
1682              
1683 1         3 return 0;
1684             }
1685              
1686              
1687             ###############################################################################
1688             #
1689             # write_formula($row, $col, $formula, $format)
1690             #
1691             # Write a formula to the specified row and column (zero indexed).
1692             #
1693             # $format is optional.
1694             #
1695             # Returns 0 : normal termination
1696             # -1 : insufficient number of arguments
1697             # -2 : row or column out of range
1698             #
1699             sub write_formula{
1700              
1701 3     3 0 17 my $self = shift;
1702              
1703             # Check for a cell reference in A1 notation and substitute row and column
1704 3 50       18 if ($_[0] =~ /^\D/) {
1705 0         0 @_ = $self->_substitute_cellref(@_);
1706             }
1707              
1708 3 50       14 if (@_ < 3) { return -1 } # Check the number of args
  0         0  
1709              
1710 3         7 my $row = $_[0]; # Zero indexed row
1711 3         5 my $col = $_[1]; # Zero indexed column
1712 3         7 my $formula = $_[2]; # The formula text string
1713              
1714              
1715 3         17 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
1716 3         10 my $type = $self->{_datatypes}->{Formula}; # The data type
1717              
1718              
1719             # Check that row and col are valid and store max and min values
1720 3 50       11 return -2 if $self->_check_dimensions($row, $col);
1721              
1722              
1723 3 100       20 my $array_range = 'RC' if $formula =~ s/^{(.*)}$/$1/;
1724              
1725             # Add the = sign if it doesn't exist
1726 3         9 $formula =~ s/^([^=])/=$1/;
1727              
1728              
1729             # Convert A1 style references in the formula to R1C1 references
1730 3         22 $formula = $self->_convert_formula($row, $col, $formula);
1731              
1732              
1733 3         13 $self->{_table}->[$row]->[$col] = [$type, $formula, $xf, $array_range];
1734              
1735 3         13 return 0;
1736             }
1737              
1738              
1739             ###############################################################################
1740             #
1741             # write_array_formula($row1, $col1, $row2, $col2, $formula, $format)
1742             #
1743             # Write an array formula to the specified row and column (zero indexed).
1744             #
1745             # $format is optional.
1746             #
1747             # Returns 0 : normal termination
1748             # -1 : insufficient number of arguments
1749             # -2 : row or column out of range
1750             #
1751             sub write_array_formula {
1752              
1753 4     4 0 48 my $self = shift;
1754              
1755             # Check for a cell reference in A1 notation and substitute row and column
1756 4 50       16 if ($_[0] =~ /^\D/) {
1757 4         10 @_ = $self->_substitute_cellref(@_);
1758             }
1759              
1760 4 50       16 if (@_ < 5) { return -1 } # Check the number of args
  0         0  
1761              
1762 4         4 my $record = 0x0006; # Record identifier
1763 4         6 my $length; # Bytes to follow
1764              
1765 4         5 my $row1 = $_[0]; # First row
1766 4         6 my $col1 = $_[1]; # First column
1767 4         5 my $row2 = $_[2]; # Last row
1768 4         4 my $col2 = $_[3]; # Last column
1769 4         6 my $formula = $_[4]; # The formula text string
1770              
1771 4         12 my $xf = _XF($self, $row1, $col1, $_[5]); # The cell format
1772 4         11 my $type = $self->{_datatypes}->{Formula}; # The data type
1773              
1774              
1775             # Swap last row/col with first row/col as necessary
1776 4 50       10 ($row1, $row2) = ($row2, $row1) if $row1 > $row2;
1777 4 50       9 ($col1, $col2) = ($col1, $col2) if $col1 > $col2;
1778              
1779              
1780             # Check that row and col are valid and store max and min values
1781 4 50       9 return -2 if $self->_check_dimensions($row2, $col2);
1782              
1783              
1784             # Define array range
1785 4         5 my $array_range;
1786              
1787 4 100 66     31 if ($row1 == $row2 and $col1 == $col2) {
1788 1         2 $array_range = 'RC';
1789             }
1790             else {
1791 3         13 $array_range = xl_rowcol_to_cell($row1, $col1) . ':' .
1792             xl_rowcol_to_cell($row2, $col2);
1793 3         8 $array_range = $self->_convert_formula($row1, $col1, $array_range);
1794             }
1795              
1796              
1797             # Remove array formula braces and add = as required.
1798 4         16 $formula =~ s/^{(.*)}$/$1/;
1799 4         12 $formula =~ s/^([^=])/=$1/;
1800              
1801              
1802             # Convert A1 style references in the formula to R1C1 references
1803 4         11 $formula = $self->_convert_formula($row1, $col1, $formula);
1804              
1805 4         16 $self->{_table}->[$row1]->[$col1] = [$type, $formula, $xf, $array_range];
1806              
1807 4         17 return 0;
1808             }
1809              
1810              
1811             ###############################################################################
1812             #
1813             # store_formula($formula)
1814             #
1815             # Pre-parse a formula. This is used in conjunction with repeat_formula()
1816             # to repetitively rewrite a formula without re-parsing it.
1817             #
1818             sub store_formula{
1819              
1820              
1821 0     0 0 0 my $self = shift;
1822              
1823             # TODO Update for ExcelXML format
1824             }
1825              
1826              
1827             ###############################################################################
1828             #
1829             # repeat_formula($row, $col, $formula, $format, ($pattern => $replacement,...))
1830             #
1831             # Write a formula to the specified row and column (zero indexed) by
1832             # substituting $pattern $replacement pairs in the $formula created via
1833             # store_formula(). This allows the user to repetitively rewrite a formula
1834             # without the significant overhead of parsing.
1835             #
1836             # Returns 0 : normal termination
1837             # -1 : insufficient number of arguments
1838             # -2 : row or column out of range
1839             #
1840             sub repeat_formula {
1841              
1842 0     0 0 0 my $self = shift;
1843              
1844             # TODO Update for ExcelXML format
1845             }
1846              
1847              
1848             ###############################################################################
1849             #
1850             # write_url($row, $col, $url, $string, $format)
1851             #
1852             # Write a hyperlink. This is comprised of two elements: the visible label and
1853             # the invisible link. The visible label is the same as the link unless an
1854             # alternative string is specified. The label is written using the
1855             # write_string() method. Therefore the max characters string limit applies.
1856             # $string and $format are optional and their order is interchangeable.
1857             #
1858             # The hyperlink can be to a http, ftp, mail, internal sheet, or external
1859             # directory url.
1860             #
1861             # Returns 0 : normal termination
1862             # -1 : insufficient number of arguments
1863             # -2 : row or column out of range
1864             # -3 : long string truncated to 32767 chars
1865             #
1866             sub write_url {
1867              
1868 7     7 0 12 my $self = shift;
1869              
1870             # Check for a cell reference in A1 notation and substitute row and column
1871 7 50       28 if ($_[0] =~ /^\D/) {
1872 0         0 @_ = $self->_substitute_cellref(@_);
1873             }
1874              
1875 7 50       20 if (@_ < 3) { return -1 } # Check the number of args
  0         0  
1876              
1877              
1878             # Reverse the order of $string and $format if necessary. We work on a copy
1879             # in order to protect the callers args. We don't use "local @_" in case of
1880             # perl50005 threads.
1881             #
1882 7         20 my @args = @_;
1883 7 100       38 ($args[3], $args[4]) = ($args[4], $args[3]) if ref $args[3];
1884              
1885              
1886 7         13 my $row = $args[0]; # Zero indexed row
1887 7         11 my $col = $args[1]; # Zero indexed column
1888 7         10 my $url = $args[2]; # URL string
1889 7         14 my $str = $args[3]; # Alternative label
1890 7         29 my $xf = _XF($self, $row, $col, $args[4]); # Tool tip
1891 7         24 my $tip = $args[5]; # XML data type
1892 7         15 my $type = $self->{_datatypes}->{HRef};
1893              
1894              
1895 7         14 $url =~ s/^internal:/#/; # Remove designators required by SWE.
1896 7         12 $url =~ s/^external://; # Remove designators required by SWE.
1897 7 100       21 $str = $url unless defined $str;
1898              
1899             # Check that row and col are valid and store max and min values
1900 7 50       30 return -2 if $self->_check_dimensions($row, $col);
1901              
1902 7         11 my $str_error = 0;
1903              
1904              
1905 7         29 $self->{_table}->[$row]->[$col] = [$type, $url, $xf, $str, $tip];
1906              
1907 7         36 return $str_error;
1908             }
1909              
1910              
1911             ###############################################################################
1912             #
1913             # write_url_range($row1, $col1, $row2, $col2, $url, $string, $format)
1914             #
1915             # This is the more general form of write_url(). It allows a hyperlink to be
1916             # written to a range of cells. This function also decides the type of hyperlink
1917             # to be written. These are either, Web (http, ftp, mailto), Internal
1918             # (Sheet1!A1) or external ('c:\temp\foo.xls#Sheet1!A1').
1919             #
1920             # See also write_url() above for a general description and return values.
1921             #
1922             sub write_url_range {
1923              
1924 0     0 0 0 my $self = shift;
1925              
1926             # Check for a cell reference in A1 notation and substitute row and column
1927 0 0       0 if ($_[0] =~ /^\D/) {
1928 0         0 @_ = $self->_substitute_cellref(@_);
1929             }
1930              
1931             # Check the number of args
1932 0 0       0 return -1 if @_ < 5;
1933              
1934              
1935             # Reverse the order of $string and $format if necessary. We work on a copy
1936             # in order to protect the callers args. We don't use "local @_" in case of
1937             # perl50005 threads.
1938             #
1939 0         0 my @args = @_;
1940              
1941 0 0       0 ($args[5], $args[6]) = ($args[6], $args[5]) if ref $args[5];
1942              
1943 0         0 my $url = $args[4];
1944              
1945              
1946             # Check for internal/external sheet links or default to web link
1947 0 0       0 return $self->_write_url_internal(@args) if $url =~ m[^internal:];
1948 0 0       0 return $self->_write_url_external(@args) if $url =~ m[^external:];
1949 0         0 return $self->_write_url_web(@args);
1950             }
1951              
1952              
1953             ###############################################################################
1954             #
1955             # write_date_time ($row, $col, $string, $format)
1956             #
1957             # Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
1958             # number representing an Excel date. $format is optional.
1959             #
1960             # Returns 0 : normal termination
1961             # -1 : insufficient number of arguments
1962             # -2 : row or column out of range
1963             # -3 : Invalid date_time, written as string
1964             #
1965             sub write_date_time {
1966              
1967 1     1 0 7 my $self = shift;
1968              
1969             # Check for a cell reference in A1 notation and substitute row and column
1970 1 50       7 if ($_[0] =~ /^\D/) {
1971 1         4 @_ = $self->_substitute_cellref(@_);
1972             }
1973              
1974 1 50       4 if (@_ < 3) { return -1 } # Check the number of args
  0         0  
1975              
1976 1         3 my $row = $_[0]; # Zero indexed row
1977 1         1 my $col = $_[1]; # Zero indexed column
1978 1         3 my $str = $_[2];
1979 1         5 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
1980 1         3 my $type = $self->{_datatypes}->{DateTime}; # The data type
1981              
1982              
1983             # Check that row and col are valid and store max and min values
1984 1 50       8 return -2 if $self->_check_dimensions($row, $col);
1985              
1986 1         2 my $str_error = 0;
1987 1         4 my $date_time = $self->convert_date_time($str);
1988              
1989             # If the date isn't valid then write it as a string.
1990 1 50       4 if (not defined $date_time) {
1991 0         0 $type = $self->{_datatypes}->{String};
1992 0         0 $str_error = -3;
1993             }
1994              
1995 1         3 $self->{_table}->[$row]->[$col] = [$type, $str, $xf];
1996              
1997 1         5 return $str_error;
1998             }
1999              
2000              
2001              
2002             ###############################################################################
2003             #
2004             # convert_date_time($date_time_string)
2005             #
2006             # The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
2007             # and converts it to a decimal number representing a valid Excel date.
2008             #
2009             # Dates and times in Excel are represented by real numbers. The integer part of
2010             # the number stores the number of days since the epoch and the fractional part
2011             # stores the percentage of the day in seconds. The epoch can be either 1900 or
2012             # 1904.
2013             #
2014             # Parameter: Date and time string in one of the following formats:
2015             # yyyy-mm-ddThh:mm:ss.ss # Standard
2016             # yyyy-mm-ddT # Date only
2017             # Thh:mm:ss.ss # Time only
2018             #
2019             # Returns:
2020             # A decimal number representing a valid Excel date, or
2021             # undef if the date is invalid.
2022             #
2023             sub convert_date_time {
2024              
2025 632     632 0 260581 my $self = shift;
2026 632         883 my $date_time = $_[0];
2027              
2028 632         710 my $days = 0; # Number of days since epoch
2029 632         665 my $seconds = 0; # Time expressed as fraction of 24h hours in seconds
2030              
2031 632         635 my ($year, $month, $day);
2032 0         0 my ($hour, $min, $sec);
2033              
2034              
2035             # Strip leading and trailing whitespace.
2036 632         1260 $date_time =~ s/^\s+//;
2037 632         1584 $date_time =~ s/\s+$//;
2038              
2039             # Check for invalid date char.
2040 632 100       1884 return if $date_time =~ /[^0-9T:\-\.Z]/;
2041              
2042             # Check for "T" after date or before time.
2043 625 50       2844 return unless $date_time =~ /\dT|T\d/;
2044              
2045             # Strip trailing Z in ISO8601 date.
2046 625         789 $date_time =~ s/Z$//;
2047              
2048              
2049             # Split into date and time.
2050 625         2024 my ($date, $time) = split /T/, $date_time;
2051              
2052              
2053             # We allow the time portion of the input DateTime to be optional.
2054 625 100       1367 if ($time ne '') {
2055             # Match hh:mm:ss.sss+ where the seconds are optional
2056 204 50       943 if ($time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/) {
2057 204         327 $hour = $1;
2058 204         293 $min = $2;
2059 204   50     581 $sec = $4 || 0;
2060             }
2061             else {
2062 0         0 return undef; # Not a valid time format.
2063             }
2064              
2065             # Some boundary checks
2066 204 100       434 return if $hour >= 24;
2067 203 100       354 return if $min >= 60;
2068 202 100       451 return if $sec >= 60;
2069              
2070             # Excel expresses seconds as a fraction of the number in 24 hours.
2071 200         415 $seconds = ($hour *60*60 + $min *60 + $sec) / (24 *60 *60);
2072             }
2073              
2074              
2075             # We allow the date portion of the input DateTime to be optional.
2076 621 50       1158 return $seconds if $date eq '';
2077              
2078              
2079             # Match date as yyyy-mm-dd.
2080 621 100       2105 if ($date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
2081 619         1074 $year = $1;
2082 619         839 $month = $2;
2083 619         878 $day = $3;
2084             }
2085             else {
2086 2         9 return undef; # Not a valid date format.
2087             }
2088              
2089             # Set the epoch as 1900 or 1904. Defaults to 1900.
2090 619         1063 my $date_1904 = $self->{_1904};
2091              
2092              
2093             # Special cases for Excel.
2094 619 100       1274 if (not $date_1904) {
2095 410 100       1032 return $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
2096 306 100       554 return $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
2097 305 100       611 return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
2098             }
2099              
2100              
2101             # We calculate the date by calculating the number of days since the epoch
2102             # and adjust for the number of leap days. We calculate the number of leap
2103             # days by normalising the year in relation to the epoch. Thus the year 2000
2104             # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
2105             #
2106 513 100       912 my $epoch = $date_1904 ? 1904 : 1900;
2107 513 100       803 my $offset = $date_1904 ? 4 : 0;
2108 513         526 my $norm = 300;
2109 513         758 my $range = $year -$epoch;
2110              
2111              
2112             # Set month days and check for leap year.
2113 513         1479 my @mdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
2114 513         577 my $leap = 0;
2115 513 100 100     3037 $leap = 1 if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
      100        
2116 513 100       890 $mdays[1] = 29 if $leap;
2117              
2118              
2119             # Some boundary checks
2120 513 100 66     2006 return if $year < $epoch or $year > 9999;
2121 507 100 100     1986 return if $month < 1 or $month > 12;
2122 501 100 100     7891 return if $day < 1 or $day > $mdays[$month -1];
2123              
2124             # Accumulate the number of days since the epoch.
2125 495         665 $days = $day; # Add days for current month
2126 495         2320 $days += $mdays[$_] for 0 .. $month -2; # Add days for past months
2127 495         749 $days += $range *365; # Add days for past years
2128 495         760 $days += int(($range) / 4); # Add leapdays
2129 495         817 $days -= int(($range +$offset) /100); # Subtract 100 year leapdays
2130 495         676 $days += int(($range +$offset +$norm)/400); # Add 400 year leapdays
2131 495         498 $days -= $leap; # Already counted above
2132              
2133              
2134             # Adjust for Excel erroneously treating 1900 as a leap year.
2135 495 100 100     1834 $days++ if $date_1904 == 0 and $days > 59;
2136              
2137 495         1817 return $days + $seconds;
2138             }
2139              
2140             ###############################################################################
2141             #
2142             # insert_bitmap($row, $col, $filename, $x, $y, $scale_x, $scale_y)
2143             #
2144             # Insert a 24bit bitmap image in a worksheet. The main record required is
2145             # IMDATA but it must be proceeded by a OBJ record to define its position.
2146             #
2147             sub insert_bitmap {
2148              
2149 0     0 0 0 my $self = shift;
2150              
2151             # Can't store images in ExcelXML
2152              
2153             # TODO Update for ExcelXML format
2154              
2155             }
2156              
2157              
2158             ###############################################################################
2159             #
2160             # set_row($row, $height, $XF, $hidden, $level)
2161             #
2162             # This method is used to set the height and XF format for a row.
2163             #
2164             sub set_row {
2165              
2166 43     43 0 163 my $self = shift;
2167 43         51 my $row = $_[0];
2168              
2169             # Ensure at least $row and $height
2170 43 50       83 return if @_ < 2;
2171              
2172             # Check that row number is valid and store the max value
2173 43 100       93 return if $self->_check_dimensions($row, 0);
2174              
2175              
2176 41         50 my $height = $_[1];
2177 41         98 my $format = _XF($self, 0, 0, $_[2]);
2178 41         73 my $hidden = $_[3];
2179 41         75 my $autofit = $_[4];
2180              
2181 41 100       85 if ($height) {
2182 25         57 $height = $self->_size_row($_[1]);
2183              
2184             # The cell is hidden if the width is zero.
2185 25 50       66 $hidden = 1 if $height == 0;
2186             }
2187              
2188              
2189 41         181 $self->{_set_rows}->{$row} = [$height, $format, $hidden, $autofit];
2190             }
2191              
2192              
2193             ###############################################################################
2194             #
2195             # _check_dimensions($row, $col)
2196             #
2197             # Check that $row and $col are valid and store max and min values for use in
2198             # DIMENSIONS record. See, _store_dimensions().
2199             #
2200             sub _check_dimensions {
2201              
2202 354     354   418 my $self = shift;
2203 354         416 my $row = $_[0];
2204 354         396 my $col = $_[1];
2205              
2206 354 100       1305 if ($row >= $self->{_xls_rowmax}) { return -2 }
  10         54  
2207 344 100       727 if ($col >= $self->{_xls_colmax}) { return -2 }
  6         34  
2208              
2209 338         481 $self->{_dim_changed} = 1;
2210              
2211 338 100       694 if ($row < $self->{_dim_rowmin}) { $self->{_dim_rowmin} = $row }
  48         112  
2212 338 100       740 if ($row > $self->{_dim_rowmax}) { $self->{_dim_rowmax} = $row }
  125         285  
2213 338 100       670 if ($col < $self->{_dim_colmin}) { $self->{_dim_colmin} = $col }
  54         101  
2214 338 100       659 if ($col > $self->{_dim_colmax}) { $self->{_dim_colmax} = $col }
  36         57  
2215              
2216 338         833 return 0;
2217             }
2218              
2219              
2220              
2221              
2222             ###############################################################################
2223             #
2224             # _store_window2()
2225             #
2226             # Write BIFF record Window2.
2227             #
2228             sub _store_window2 {
2229              
2230 23     23   27719 use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
  23         298  
  23         129  
2231              
2232 0     0   0 my $self = shift;
2233 0         0 my $record = 0x023E; # Record identifier
2234 0         0 my $length = 0x000A; # Number of bytes to follow
2235              
2236 0         0 my $grbit = 0x00B6; # Option flags
2237 0         0 my $rwTop = 0x0000; # Top row visible in window
2238 0         0 my $colLeft = 0x0000; # Leftmost column visible in window
2239 0         0 my $rgbHdr = 0x00000000; # Row/column heading and gridline color
2240              
2241             # The options flags that comprise $grbit
2242 0         0 my $fDspFmla = 0; # 0 - bit
2243 0         0 my $fDspGrid = $self->{_screen_gridlines}; # 1
2244 0         0 my $fDspRwCol = 1; # 2
2245 0         0 my $fFrozen = $self->{_frozen}; # 3
2246 0         0 my $fDspZeros = 1; # 4
2247 0         0 my $fDefaultHdr = 1; # 5
2248 0         0 my $fArabic = 0; # 6
2249 0         0 my $fDspGuts = $self->{_outline_on}; # 7
2250 0         0 my $fFrozenNoSplit = 0; # 0 - bit
2251 0         0 my $fSelected = $self->{_selected}; # 1
2252 0         0 my $fPaged = 1; # 2
2253              
2254             # TODO Update for ExcelXML format
2255             }
2256              
2257              
2258             ###############################################################################
2259             #
2260             # _store_defcol()
2261             #
2262             # Write BIFF record DEFCOLWIDTH if COLINFO records are in use.
2263             #
2264             sub _store_defcol {
2265              
2266 0     0   0 my $self = shift;
2267 0         0 my $record = 0x0055; # Record identifier
2268 0         0 my $length = 0x0002; # Number of bytes to follow
2269              
2270 0         0 my $colwidth = 0x0008; # Default column width
2271              
2272             # TODO Update for ExcelXML format
2273             }
2274              
2275              
2276             ###############################################################################
2277             #
2278             # _store_colinfo($firstcol, $lastcol, $width, $format, $autofit)
2279             #
2280             # Write XML elements to define column widths.
2281             #
2282             #
2283             sub _store_colinfo {
2284              
2285 48     48   71 my $self = shift;
2286              
2287             # Extract only the columns that have been defined.
2288 48         61 my @cols = sort {$a <=> $b} keys %{$self->{_set_cols}};
  148         187  
  48         228  
2289 48 100       156 return unless @cols;
2290              
2291 7         14 my @attribs;
2292 7         13 my $previous = -1;
2293 7         20 my $span = 0;
2294              
2295 7         22 for my $col (@cols) {
2296 55 100       106 if (not $span) {
2297 24         66 my $width = $self->{_set_cols}->{$col}->[0];
2298 24         99 my $format = $self->{_set_cols}->{$col}->[1];
2299 24         38 my $hidden = $self->{_set_cols}->{$col}->[2];
2300 24   50     109 my $autofit = $self->{_set_cols}->{$col}->[3] || 0;
2301              
2302 24 100       88 push @attribs, "ss:Index", $col +1 if $col != $previous+1;
2303 24 100       87 push @attribs, "ss:StyleID", "s" . $format if $format;
2304 24 100       66 push @attribs, "ss:Hidden", $hidden if $hidden;
2305 24         50 push @attribs, "ss:AutoFitWidth", $autofit;
2306 24 100       58 push @attribs, "ss:Width", $width if $width;
2307              
2308             # Note. "Overview of SpreadsheetML" states that the ss:Index
2309             # attribute is implicit in a Column element directly following a
2310             # Column element with an ss:Span attribute. However Excel doesn't
2311             # comply. In order to test directly against Excel we follow suit
2312             # and make ss:Index explicit. To get the implicit behaviour move
2313             # the next line outside the for() loop.
2314 24         49 $previous = $col;
2315             }
2316              
2317             # $previous = $col; # See note above.
2318 55         135 local $^W = 0; # Ignore warnings about undefs in array ref comparison.
2319              
2320             # Check if the same attributes are shared over consecutive columns.
2321 55 100 100     200 if (exists $self->{_set_cols}->{$col +1} and
  36         256  
2322 36         338 join("|", @{$self->{_set_cols}->{$col }}) eq
2323             join("|", @{$self->{_set_cols}->{$col +1}}))
2324             {
2325 31         34 $span++;
2326 31         78 next;
2327             }
2328              
2329 24 100       65 push @attribs, "ss:Span", $span if $span;
2330 24         107 $self->_write_xml_element(3, 1, 0, 'Column', @attribs);
2331              
2332 24         50 @attribs = ();
2333 24         70 $span = 0;
2334             }
2335             }
2336              
2337              
2338             ###############################################################################
2339             #
2340             # _store_selection($first_row, $first_col, $last_row, $last_col)
2341             #
2342             # Write BIFF record SELECTION.
2343             #
2344             sub _store_selection {
2345              
2346 0     0   0 my $self = shift;
2347 0         0 my $record = 0x001D; # Record identifier
2348 0         0 my $length = 0x000F; # Number of bytes to follow
2349              
2350 0         0 my $pnn = $self->{_active_pane}; # Pane position
2351 0         0 my $rwAct = $_[0]; # Active row
2352 0         0 my $colAct = $_[1]; # Active column
2353 0         0 my $irefAct = 0; # Active cell ref
2354 0         0 my $cref = 1; # Number of refs
2355              
2356 0         0 my $rwFirst = $_[0]; # First row in reference
2357 0         0 my $colFirst = $_[1]; # First col in reference
2358 0   0     0 my $rwLast = $_[2] || $rwFirst; # Last row in reference
2359 0   0     0 my $colLast = $_[3] || $colFirst; # Last col in reference
2360              
2361             # Swap last row/col for first row/col as necessary
2362 0 0       0 if ($rwFirst > $rwLast) {
2363 0         0 ($rwFirst, $rwLast) = ($rwLast, $rwFirst);
2364             }
2365              
2366 0 0       0 if ($colFirst > $colLast) {
2367 0         0 ($colFirst, $colLast) = ($colLast, $colFirst);
2368             }
2369              
2370              
2371             # TODO Update for ExcelXML format
2372             }
2373              
2374              
2375             ###############################################################################
2376             #
2377             # _store_externcount($count)
2378             #
2379             # Write BIFF record EXTERNCOUNT to indicate the number of external sheet
2380             # references in a worksheet.
2381             #
2382             # Excel only stores references to external sheets that are used in formulas.
2383             # For simplicity we store references to all the sheets in the workbook
2384             # regardless of whether they are used or not. This reduces the overall
2385             # complexity and eliminates the need for a two way dialogue between the formula
2386             # parser the worksheet objects.
2387             #
2388             sub _store_externcount {
2389              
2390 0     0   0 my $self = shift;
2391 0         0 my $record = 0x0016; # Record identifier
2392 0         0 my $length = 0x0002; # Number of bytes to follow
2393              
2394 0         0 my $cxals = $_[0]; # Number of external references
2395              
2396             # TODO Update for ExcelXML format
2397             }
2398              
2399              
2400             ###############################################################################
2401             #
2402             # _store_externsheet($sheetname)
2403             #
2404             #
2405             # Writes the Excel BIFF EXTERNSHEET record. These references are used by
2406             # formulas. A formula references a sheet name via an index. Since we store a
2407             # reference to all of the external worksheets the EXTERNSHEET index is the same
2408             # as the worksheet index.
2409             #
2410             sub _store_externsheet {
2411              
2412 0     0   0 my $self = shift;
2413              
2414 0         0 my $record = 0x0017; # Record identifier
2415 0         0 my $length; # Number of bytes to follow
2416              
2417 0         0 my $sheetname = $_[0]; # Worksheet name
2418 0         0 my $cch; # Length of sheet name
2419             my $rgch; # Filename encoding
2420              
2421             # References to the current sheet are encoded differently to references to
2422             # external sheets.
2423             #
2424 0 0       0 if ($self->{_name} eq $sheetname) {
2425 0         0 $sheetname = '';
2426 0         0 $length = 0x02; # The following 2 bytes
2427 0         0 $cch = 1; # The following byte
2428 0         0 $rgch = 0x02; # Self reference
2429             }
2430             else {
2431 0         0 $length = 0x02 + length($_[0]);
2432 0         0 $cch = length($sheetname);
2433 0         0 $rgch = 0x03; # Reference to a sheet in the current workbook
2434             }
2435              
2436             # TODO Update for ExcelXML format
2437             }
2438              
2439              
2440             ###############################################################################
2441             #
2442             # _store_panes()
2443             #
2444             #
2445             # Writes the Excel BIFF PANE record.
2446             # The panes can either be frozen or thawed (unfrozen).
2447             # Frozen panes are specified in terms of a integer number of rows and columns.
2448             # Thawed panes are specified in terms of Excel's units for rows and columns.
2449             #
2450             sub _store_panes {
2451              
2452 0     0   0 my $self = shift;
2453 0         0 my $record = 0x0041; # Record identifier
2454 0         0 my $length = 0x000A; # Number of bytes to follow
2455              
2456 0   0     0 my $y = $_[0] || 0; # Vertical split position
2457 0   0     0 my $x = $_[1] || 0; # Horizontal split position
2458 0         0 my $rwTop = $_[2]; # Top row visible
2459 0         0 my $colLeft = $_[3]; # Leftmost column visible
2460 0         0 my $pnnAct = $_[4]; # Active pane
2461              
2462              
2463             # Code specific to frozen or thawed panes.
2464 0 0       0 if ($self->{_frozen}) {
2465             # Set default values for $rwTop and $colLeft
2466 0 0       0 $rwTop = $y unless defined $rwTop;
2467 0 0       0 $colLeft = $x unless defined $colLeft;
2468             }
2469             else {
2470             # Set default values for $rwTop and $colLeft
2471 0 0       0 $rwTop = 0 unless defined $rwTop;
2472 0 0       0 $colLeft = 0 unless defined $colLeft;
2473              
2474             # Convert Excel's row and column units to the internal units.
2475             # The default row height is 12.75
2476             # The default column width is 8.43
2477             # The following slope and intersection values were interpolated.
2478             #
2479 0         0 $y = 20*$y + 255;
2480 0         0 $x = 113.879*$x + 390;
2481             }
2482              
2483              
2484             # Determine which pane should be active. There is also the undocumented
2485             # option to override this should it be necessary: may be removed later.
2486             #
2487 0 0       0 if (not defined $pnnAct) {
2488 0 0 0     0 $pnnAct = 0 if ($x != 0 && $y != 0); # Bottom right
2489 0 0 0     0 $pnnAct = 1 if ($x != 0 && $y == 0); # Top right
2490 0 0 0     0 $pnnAct = 2 if ($x == 0 && $y != 0); # Bottom left
2491 0 0 0     0 $pnnAct = 3 if ($x == 0 && $y == 0); # Top left
2492             }
2493              
2494 0         0 $self->{_active_pane} = $pnnAct; # Used in _store_selection
2495              
2496             # TODO Update for ExcelXML format
2497             }
2498              
2499              
2500             ###############################################################################
2501             #
2502             # _store_setup()
2503             #
2504             # Store the child element .
2505             #
2506             sub _store_setup {
2507              
2508 14     14   13 my $self = shift;
2509              
2510             # Write the child element.
2511 14         12 my @layout;
2512 14 100       29 push @layout, 'x:Orientation', 'Landscape' if $self->{_orientation} == 0;
2513 14 100       29 push @layout, 'x:CenterHorizontal', 1 if $self->{_hcenter} == 1;
2514 14 100       24 push @layout, 'x:CenterVertical', 1 if $self->{_vcenter} == 1;
2515 14 50       37 push @layout, 'x:StartPageNumber',
2516             $self->{_start_page} if $self->{_page_start} > 0;
2517              
2518              
2519             # Write the
child element.
2520 14         14 my @header;
2521 14 100       31 push @header, 'x:Margin',
2522             $self->{_margin_head} if $self->{_margin_head} != 0.5;
2523 14 100       27 push @header, 'x:Data',
2524             $self->{_header} if $self->{_header} ne '';
2525              
2526              
2527             # Write the
child element.
2528 14         14 my @footer;
2529 14 100       26 push @footer, 'x:Margin',
2530             $self->{_margin_foot} if $self->{_margin_foot} != 0.5;
2531 14 100       27 push @footer, 'x:Data',
2532             $self->{_footer} if $self->{_footer} ne '';
2533              
2534              
2535             # Write the child element.
2536 14         13 my @margins;
2537 14 100       34 push @margins, 'x:Bottom',
2538             $self->{_margin_bottom} if $self->{_margin_bottom} != 1.00;
2539 14 100       30 push @margins, 'x:Left',
2540             $self->{_margin_left} if $self->{_margin_left} != 0.75;
2541 14 100       31 push @margins, 'x:Right',
2542             $self->{_margin_right} if $self->{_margin_right} != 0.75;
2543 14 100       29 push @margins, 'x:Top',
2544             $self->{_margin_top} if $self->{_margin_top} != 1.00;
2545              
2546              
2547              
2548 14 100       36 $self->_write_xml_element(4, 1, 1, 'Layout', @layout) if @layout;
2549 14 100       30 $self->_write_xml_element(4, 1, 1, 'Header', @header) if @header;
2550 14 100       29 $self->_write_xml_element(4, 1, 1, 'Footer', @footer) if @footer;
2551 14 100       45 $self->_write_xml_element(4, 1, 1, 'PageMargins', @margins) if @margins;
2552             }
2553              
2554              
2555             ###############################################################################
2556             #
2557             # _store_print()
2558             #
2559             # Store the child element .
2560             #
2561             sub _store_print {
2562              
2563 12     12   12 my $self = shift;
2564              
2565              
2566 12 100       27 if ($self->{_fit_width} > 1) {
2567 2         7 $self->_write_xml_start_tag(4, 0, 0, 'FitWidth');
2568 2         5 $self->_write_xml_content ($self->{_fit_width});
2569 2         6 $self->_write_xml_end_tag (0, 1, 0, 'FitWidth');
2570             }
2571              
2572 12 100       25 if ($self->{_fit_height} > 1) {
2573 1         4 $self->_write_xml_start_tag(4, 0, 0, 'FitHeight');
2574 1         14 $self->_write_xml_content ($self->{_fit_height});
2575 1         4 $self->_write_xml_end_tag (0, 1, 0, 'FitHeight');
2576             }
2577              
2578              
2579             # Print scale won't work without this.
2580 12         25 $self->_write_xml_element(4,1,0,'ValidPrinterInfo');
2581              
2582              
2583 12 50       24 $self->_write_xml_element(4,1,0,'BlackAndWhite') if $self->{_black_white};
2584 12 50       28 $self->_write_xml_element(4,1,0,'LeftToRight') if $self->{_page_order};
2585 12 50       24 $self->_write_xml_element(4,1,0,'DraftQuality') if $self->{_draft_quality};
2586              
2587              
2588 12 100       22 if ($self->{_paper_size}) {
2589 1         3 $self->_write_xml_start_tag(4, 0, 0, 'PaperSizeIndex');
2590 1         4 $self->_write_xml_content ($self->{_paper_size});
2591 1         3 $self->_write_xml_end_tag (0, 1, 0, 'PaperSizeIndex');
2592             }
2593              
2594 12 100       27 if ($self->{_print_scale} != 100) {
2595 1         5 $self->_write_xml_start_tag(4, 0, 0, 'Scale');
2596 1         5 $self->_write_xml_content ($self->{_print_scale});
2597 1         3 $self->_write_xml_end_tag (0, 1, 0, 'Scale');
2598             }
2599              
2600              
2601 12 100       25 $self->_write_xml_element(4,1,0,'Gridlines') if $self->{_print_gridlines};
2602 12 100       28 $self->_write_xml_element(4,1,0,'RowColHeadings')if $self->{_print_headers};
2603             }
2604              
2605              
2606             ###############################################################################
2607             #
2608             # _write_names()
2609             #
2610             # Write the element.
2611             #
2612             sub _write_names {
2613              
2614 73     73   97 my $self = shift;
2615              
2616              
2617 73 100 66     105 if (not keys %{$self->{_names}} and
  73   66     620  
  53         74  
2618             not $self->{_repeat_rows} and
2619             not $self->{_repeat_cols}
2620             ){return}
2621              
2622              
2623 20 100 100     109 if ($self->{_repeat_rows} or $self->{_repeat_cols}) {
2624 12         54 $self->{_names}->{Print_Titles} = '=' .
2625             join ',',
2626 6         16 grep {/\S/}
2627             $self->{_repeat_cols},
2628             $self->{_repeat_rows}
2629             }
2630              
2631              
2632 20         76 $self->_write_xml_start_tag(2, 1, 0, 'Names');
2633              
2634             # Sort the elements lexically and case insensitively.
2635 20         28 for my $key (sort {lc $a cmp lc $b} keys %{$self->{_names}}) {
  0         0  
  20         75  
2636              
2637 20         81 my @attributes = (
2638             'NamedRange',
2639             'ss:Name',
2640             $key,
2641             'ss:RefersTo',
2642             $self->{_names}->{$key}
2643             );
2644              
2645             # Temp workaround to hide _FilterDatabase.
2646             # TODO. make this configurable later.
2647 20 100       49 if ($key eq '_FilterDatabase') {
2648 2         7 push @attributes, 'ss:Hidden' => 1;
2649             }
2650              
2651              
2652 20         89 $self->_write_xml_element(3, 1, 0, @attributes);
2653              
2654             }
2655              
2656 20         94 $self->_write_xml_end_tag (2, 1, 0, 'Names');
2657              
2658             }
2659              
2660              
2661             ###############################################################################
2662             #
2663             # merge_range($first_row, $first_col, $last_row, $last_col, $string, $format)
2664             #
2665             # This is a wrapper to ensure correct use of the merge_cells method, i.e. write
2666             # the first cell of the range, write the formatted blank cells in the range and
2667             # then call the merge_cells record. Failing to do the steps in this order will
2668             # cause Excel 97 to crash.
2669             #
2670             sub merge_range {
2671              
2672 19     19 0 87 my $self = shift;
2673              
2674             # Check for a cell reference in A1 notation and substitute row and column
2675 19 100       104 if ($_[0] =~ /^\D/) {
2676 18         47 @_ = $self->_substitute_cellref(@_);
2677             }
2678 19 50       57 croak "Incorrect number of arguments" if @_ != 6;
2679 19 50       44 croak "Final argument must be a format object" unless ref $_[5];
2680              
2681 19         22 my $rwFirst = $_[0];
2682 19         24 my $colFirst = $_[1];
2683 19         21 my $rwLast = $_[2];
2684 19         22 my $colLast = $_[3];
2685 19         22 my $string = $_[4];
2686 19         22 my $format = $_[5];
2687              
2688              
2689             # Excel doesn't allow a single cell to be merged
2690 19 50 66     80 croak "Can't merge single cell" if $rwFirst == $rwLast and
2691             $colFirst == $colLast;
2692              
2693             # Swap last row/col with first row/col as necessary
2694 19 100       41 ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
2695 19 100       35 ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
2696              
2697              
2698             # Check that column number is valid and store the max value
2699 19 50       49 return if $self->_check_dimensions($rwLast, $colLast);
2700              
2701              
2702             # Store the merge range as a HoHoHoA
2703 19         93 $self->{_merge}->{$rwFirst}->{$colFirst} = [$colLast -$colFirst,
2704             $rwLast -$rwFirst];
2705              
2706             # Write the first cell
2707 19         45 return $self->write($rwFirst, $colFirst, $string, $format);
2708             }
2709              
2710              
2711             ###############################################################################
2712             #
2713             # _store_pagebreaks()
2714             #
2715             # Store horizontal and vertical pagebreaks.
2716             #
2717             sub _store_pagebreaks {
2718              
2719 73     73   100 my $self = shift;
2720              
2721 73         267 return if not @{$self->{_hbreaks}}
  70         224  
2722 73 100 66     147 and not @{$self->{_vbreaks}} ;
2723              
2724 5         16 $self->_write_xml_start_tag(2, 1, 0, 'PageBreaks',
2725             'xmlns',
2726             'urn:schemas-microsoft-com:' .
2727             'office:excel');
2728              
2729              
2730 5 100       5 if (@{$self->{_vbreaks}}) {
  5         12  
2731 3         5 my @breaks = $self->_sort_pagebreaks(@{$self->{_vbreaks}});
  3         7  
2732              
2733 3         9 $self->_write_xml_start_tag(3, 1, 0, 'ColBreaks');
2734              
2735 3         4 for my $break (@breaks) {
2736 5         20 $self->_write_xml_start_tag(4, 0, 0, 'ColBreak');
2737 5         12 $self->_write_xml_start_tag(0, 0, 0, 'Column' );
2738 5         12 $self->_write_xml_content ($break );
2739 5         11 $self->_write_xml_end_tag (0, 0, 0, 'Column' );
2740 5         20 $self->_write_xml_end_tag (0, 1, 0, 'ColBreak');
2741             }
2742              
2743 3         9 $self->_write_xml_end_tag(3, 1, 0, 'ColBreaks');
2744              
2745             }
2746              
2747 5 100       7 if (@{$self->{_hbreaks}}) {
  5         14  
2748 3         3 my @breaks = $self->_sort_pagebreaks(@{$self->{_hbreaks}});
  3         14  
2749              
2750 3         10 $self->_write_xml_start_tag(3, 1, 0, 'RowBreaks');
2751              
2752 3         5 for my $break (@breaks) {
2753 5         16 $self->_write_xml_start_tag(4, 0, 0, 'RowBreak');
2754 5         13 $self->_write_xml_start_tag(0, 0, 0, 'Row' );
2755 5         12 $self->_write_xml_content ($break );
2756 5         13 $self->_write_xml_end_tag (0, 0, 0, 'Row' );
2757 5         13 $self->_write_xml_end_tag (0, 1, 0, 'RowBreak');
2758             }
2759              
2760 3         9 $self->_write_xml_end_tag(3, 1, 0, 'RowBreaks');
2761             }
2762              
2763 5         12 $self->_write_xml_end_tag(2, 1, 0, 'PageBreaks');
2764             }
2765              
2766              
2767              
2768             ###############################################################################
2769             #
2770             # _store_protect()
2771             #
2772             # Set the Biff PROTECT record to indicate that the worksheet is protected.
2773             #
2774             sub _store_protect {
2775              
2776 0     0   0 my $self = shift;
2777              
2778             # Exit unless sheet protection has been specified
2779 0 0       0 return unless $self->{_protect};
2780              
2781 0         0 my $record = 0x0012; # Record identifier
2782 0         0 my $length = 0x0002; # Bytes to follow
2783              
2784 0         0 my $fLock = $self->{_protect}; # Worksheet is protected
2785              
2786             # TODO Update for ExcelXML format
2787             }
2788              
2789              
2790              
2791             ###############################################################################
2792             #
2793             # _size_col($col)
2794             #
2795             # Convert the width of a cell from user's units to pixels. Excel rounds the
2796             # column width to the nearest pixel. Excel XML also scales the pixel value
2797             # by 0.75.
2798             #
2799             sub _size_col {
2800              
2801 12     12   20 my $self = shift;
2802 12         17 my $width = $_[0];
2803              
2804             # The relationship is different for user units less than 1.
2805 12 50       56 if ($width < 1) {
2806 0         0 return 0.75 * int($width *12);
2807             }
2808             else {
2809 12         60 return 0.75 * (int($width *7 ) +5);
2810             }
2811             }
2812              
2813              
2814             ###############################################################################
2815             #
2816             # _size_row($row)
2817             #
2818             # Convert the height of a cell from user's units to pixels. By interpolation
2819             # the relationship is: y = 4/3x. Excel XML also scales the pixel value by 0.75.
2820             #
2821             sub _size_row {
2822              
2823 25     25   34 my $self = shift;
2824 25         28 my $height = $_[0];
2825              
2826 25         86 return 0.75 * int(4/3 *$height);
2827             }
2828              
2829              
2830             ###############################################################################
2831             #
2832             # _store_zoom($zoom)
2833             #
2834             #
2835             # Store the window zoom factor. This should be a reduced fraction but for
2836             # simplicity we will store all fractions with a numerator of 100.
2837             #
2838             sub _store_zoom {
2839              
2840 0     0   0 my $self = shift;
2841              
2842             # If scale is 100 we don't need to write a record
2843 0 0       0 return if $self->{_zoom} == 100;
2844              
2845 0         0 my $record = 0x00A0; # Record identifier
2846 0         0 my $length = 0x0004; # Bytes to follow
2847              
2848             # TODO Update for ExcelXML format
2849             }
2850              
2851              
2852             ###############################################################################
2853             #
2854             # _store_comment
2855             #
2856             # Store the Excel 5 NOTE record. This format is not compatible with the Excel 7
2857             # record.
2858             #
2859             sub _store_comment {
2860              
2861 0     0   0 my $self = shift;
2862 0 0       0 if (@_ < 3) { return -1 }
  0         0  
2863              
2864             # TODO Update for ExcelXML format
2865              
2866             }
2867              
2868              
2869              
2870              
2871              
2872              
2873              
2874              
2875             ###############################################################################
2876             #
2877             # New XML code
2878             #
2879             ###############################################################################
2880              
2881              
2882              
2883              
2884              
2885              
2886             ###############################################################################
2887             #
2888             # _write_xml_table()
2889             #
2890             # Write the stored data into the element.
2891             #
2892             # TODO Add note about data structure
2893             #
2894             sub _write_xml_table {
2895              
2896 73     73   99 my $self = shift;
2897              
2898             # Don't write element if it contains no data.
2899 73 100       353 return unless $self->{_dim_changed};
2900              
2901              
2902              
2903 48         238 $self->_write_xml_start_tag(2, 1, 0, 'Table',
2904             'ss:ExpandedColumnCount',
2905             $self->{_dim_colmax} +1,
2906             'ss:ExpandedRowCount',
2907             $self->{_dim_rowmax} +1,
2908             );
2909 48         144 $self->_store_colinfo();
2910              
2911             # Write stored and data
2912 48         127 $self->_write_xml_rows();
2913              
2914 48         168 $self->_write_xml_end_tag(2, 1, 0, 'Table');
2915             }
2916              
2917              
2918             ###############################################################################
2919             #
2920             # _write_xml_rows()
2921             #
2922             # Write all elements.
2923             #
2924             sub _write_xml_rows {
2925              
2926 48     48   136 my $self = shift;
2927              
2928 48         61 my @attribs;
2929 48         68 my $previous = -1;
2930 48         100 my $span = 0;
2931              
2932 48         124 for my $row (0 .. $self->{_dim_rowmax}) {
2933              
2934 2228377 100 100     21953695 next unless $self->{_set_rows}->{$row} or $self->{_table}->[$row];
2935              
2936 183 100       386 if (not $span) {
2937 163         537 my $height = $self->{_set_rows}->{$row}->[0];
2938 163         271 my $format = $self->{_set_rows}->{$row}->[1];
2939 163         410 my $hidden = $self->{_set_rows}->{$row}->[2];
2940 163   50     884 my $autofit = $self->{_set_rows}->{$row}->[3] || 0;
2941              
2942 163 100       445 push @attribs, "ss:Index", $row +1 if $row != $previous+1;
2943 163 100 66     635 push @attribs, "ss:AutoFitHeight", $autofit if $height or $autofit;
2944 163 100       347 push @attribs, "ss:Height", $height if $height;
2945 163 100       294 push @attribs, "ss:Hidden", $hidden if $hidden;
2946 163 100       342 push @attribs, "ss:StyleID", "s" . $format if $format;
2947              
2948             # See ss:Index note in _store_colinfo
2949 163         255 $previous = $row;
2950             }
2951              
2952             # $previous = $row; # See ss:Index note in _store_colinfo
2953 183         478 local $^W = 0; # Ignore warnings about undefs in array ref comparison.
2954              
2955             # Check if the same attributes are shared over consecutive columns.
2956 183 100 100     998 if (not $self->{_table}->[$row ] and
  24   66     112  
      100        
      100        
2957             not $self->{_table}->[$row +1] and
2958             exists $self->{_set_rows}->{$row } and
2959             exists $self->{_set_rows}->{$row +1} and
2960 24         144 join("|", @{$self->{_set_rows}->{$row }}) eq
2961             join("|", @{$self->{_set_rows}->{$row +1}}))
2962             {
2963 20         24 $span++;
2964 20         45 next;
2965             }
2966              
2967 163 100       338 push @attribs, "ss:Span", $span if $span;
2968              
2969             # Write with data or formatted without data.
2970             #
2971 163 100       438 if (my $row_ref = $self->{_table}->[$row]) {
2972 147         477 $self->_write_xml_start_tag(3, 1, 0, 'Row', @attribs);
2973              
2974 147         192 my $col = 0;
2975 147         212 $self->{prev_col} = -1;
2976              
2977 147         281 for my $col_ref (@$row_ref) {
2978 33678 100       62316 $self->_write_xml_cell($row, $col) if $col_ref;
2979 33678         49075 $col++;
2980             }
2981 147         447 $self->_write_xml_end_tag(3, 1, 0, 'Row');
2982             }
2983             else {
2984 16         74 $self->_write_xml_element(3, 1, 0, 'Row', @attribs);
2985             }
2986              
2987              
2988 163         290 @attribs = ();
2989 163         444 $span = 0;
2990             }
2991             }
2992              
2993              
2994             ###############################################################################
2995             #
2996             # _write_xml_cell()
2997             #
2998             # Write a element start tag.
2999             #
3000             sub _write_xml_cell {
3001              
3002 254     254   300 my $self = shift;
3003              
3004 254         307 my $row = $_[0];
3005 254         472 my $col = $_[1];
3006              
3007 254         460 my $datatype = $self->{_table}->[$row]->[$col]->[0];
3008 254         431 my $data = $self->{_table}->[$row]->[$col]->[1];
3009 254         353 my $format = $self->{_table}->[$row]->[$col]->[2];
3010              
3011 254         257 my @attribs;
3012 254         321 my $comment = '';
3013              
3014              
3015             ###########################################################################
3016             #
3017             # Only add the cell index if it doesn't follow another cell.
3018             #
3019 254 100       660 push @attribs, "ss:Index", $col +1 if $col != $self->{prev_col} +1;
3020              
3021              
3022             ###########################################################################
3023             #
3024             # Check for merged cells.
3025             #
3026 254 100 100     813 if (exists $self->{_merge}->{$row} and
3027             exists $self->{_merge}->{$row}->{$col})
3028             {
3029 19         22 my ($across, $down) = @{$self->{_merge}->{$row}->{$col}};
  19         52  
3030              
3031 19 100       61 push @attribs, "ss:MergeAcross", $across if $across;
3032 19 100       40 push @attribs, "ss:MergeDown", $down if $down;
3033              
3034             # Fill the merge range to ensure that it doesn't contain any data types.
3035 19         38 for my $m_row (0 .. $down) {
3036 40         52 for my $m_col (0 .. $across) {
3037 84 100 100     265 next if $m_row == 0 and $m_col == 0;
3038 65         179 $self->{_table}->[$row +$m_row ]->[$col +$m_col] = undef;
3039             }
3040             }
3041              
3042             # Fill the last col so that $self->{prev_col} is incremented correctly.
3043 19         35 my $type = $self->{_datatypes}->{Merge};
3044 19         58 $self->{_table}->[$row]->[$col +$across] = [$type];
3045             }
3046              
3047              
3048             ###########################################################################
3049             #
3050             # Check for cell comments.
3051             #
3052 254 100 100     716 if (exists $self->{_comment}->{$row} and
3053             exists $self->{_comment}->{$row}->{$col})
3054             {
3055 8         15 $comment = $self->{_comment}->{$row}->{$col};
3056             }
3057              
3058              
3059             # Add the format attribute.
3060 254 100       588 push @attribs, "ss:StyleID", "s" . $format if $format;
3061              
3062              
3063             # Add to the attribute list for data types with additional options
3064 254 100       659 if ($datatype == $self->{_datatypes}->{Formula}) {
3065 7         19 my $array_range = $self->{_table}->[$row]->[$col]->[3];
3066              
3067 7 100       33 push @attribs, "ss:ArrayRange", $array_range if $array_range;
3068 7         12 push @attribs, "ss:Formula", $data;
3069             }
3070              
3071 254 100       604 if ($datatype == $self->{_datatypes}->{HRef}) {
3072 7         13 push @attribs, "ss:HRef", $data;
3073              
3074 7         17 my $tip = $self->{_table}->[$row]->[$col]->[4];
3075 7 100       22 push @attribs, "x:HRefScreenTip", $tip if defined $tip ;
3076             }
3077              
3078              
3079             ###########################################################################
3080             #
3081             # Write the data for various data types.
3082             #
3083              
3084             # Write the Number data element
3085 254 100       919 if ($datatype == $self->{_datatypes}->{Number}) {
    100          
    100          
    100          
    100          
    100          
    100          
    50          
3086 39         165 $self->_write_xml_start_tag(4, 1, 0, 'Cell', @attribs);
3087 39         104 $self->_write_xml_cell_data('Number', $data);
3088 39 100       92 $self->_write_xml_cell_comment($comment) if $comment;
3089 39         116 $self->_write_xml_end_tag(4, 1, 0, 'Cell');
3090             }
3091              
3092              
3093             # Write the String data element
3094             elsif ($datatype == $self->{_datatypes}->{String}) {
3095 184         296 my $html = $self->{_table}->[$row]->[$col]->[3];
3096              
3097 184         540 $self->_write_xml_start_tag(4, 1, 0, 'Cell', @attribs);
3098              
3099 184 100       333 if ($html){$self->_write_xml_html_string($data);}
  5         48  
  179         364  
3100             else {$self->_write_xml_cell_data('String', $data);}
3101              
3102 184 100       390 $self->_write_xml_cell_comment($comment) if $comment;
3103 184         515 $self->_write_xml_end_tag(4, 1, 0, 'Cell');
3104             }
3105              
3106              
3107             # Write the DateTime data element
3108             elsif ($datatype == $self->{_datatypes}->{DateTime}) {
3109 1         5 $self->_write_xml_start_tag(4, 1, 0, 'Cell', @attribs);
3110 1         2 $self->_write_xml_cell_data('DateTime', $data);
3111 1 50       4 $self->_write_xml_cell_comment($comment) if $comment;
3112 1         3 $self->_write_xml_end_tag(4, 1, 0, 'Cell');
3113             }
3114              
3115              
3116             # Write an empty Data element for a formula data
3117             elsif ($datatype == $self->{_datatypes}->{Formula}) {
3118 7 100       17 if ($comment) {
3119 1         5 $self->_write_xml_start_tag(4, 1, 0, 'Cell', @attribs);
3120 1         2 $self->_write_xml_cell_comment($comment);
3121 1         4 $self->_write_xml_end_tag(4, 1, 0, 'Cell');
3122             }
3123             else {
3124 6         30 $self->_write_xml_element(4, 1, 0, 'Cell', @attribs);
3125             }
3126             }
3127              
3128              
3129             # Write the HRef data element
3130             elsif ($datatype == $self->{_datatypes}->{HRef}) {
3131              
3132 7         26 $self->_write_xml_start_tag(4, 1, 0, 'Cell', @attribs);
3133              
3134 7         25 my $data = $self->{_table}->[$row]->[$col]->[3];
3135 7         11 my $type;
3136              
3137             # Match DateTime string.
3138 7 50 33     29 if ($self->convert_date_time($data)) {
    50          
    50          
3139 0         0 $type = 'DateTime';
3140             }
3141             # Match integer with leading zero(s)
3142             elsif ($self->{_leading_zeros} and $data =~ /^0\d+$/) {
3143 0         0 $type = 'String';
3144             }
3145             # Match number.
3146             elsif ($data =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
3147 0         0 $type = 'Number';
3148             }
3149             # Default to string.
3150             else {
3151 7         11 $type = 'String';
3152             }
3153              
3154 7 100       20 $self->_write_xml_cell_comment($comment) if $comment;
3155 7         24 $self->_write_xml_cell_data($type, $data);
3156 7         23 $self->_write_xml_end_tag(4, 1, 0, 'Cell');
3157             }
3158              
3159              
3160             # Write an empty Data element for a blank cell
3161             elsif ($datatype == $self->{_datatypes}->{Blank}) {
3162 1 50       4 if ($comment) {
3163 0         0 $self->_write_xml_start_tag(4, 1, 0, 'Cell', @attribs);
3164 0         0 $self->_write_xml_cell_comment($comment);
3165 0         0 $self->_write_xml_end_tag(4, 1, 0, 'Cell');
3166             }
3167             else {
3168 1         5 $self->_write_xml_element(4, 1, 0, 'Cell', @attribs);
3169             }
3170             }
3171              
3172             # Write an empty Data element for an empty cell with a comment;
3173             elsif ($datatype == $self->{_datatypes}->{Comment}) {
3174 1 50       3 if ($comment) {
3175 1         4 $self->_write_xml_start_tag(4, 1, 0, 'Cell', @attribs);
3176 1         2 $self->_write_xml_cell_comment($comment);
3177 1         4 $self->_write_xml_end_tag(4, 1, 0, 'Cell');
3178             }
3179             else {
3180 0         0 $self->_write_xml_element(4, 1, 0, 'Cell', @attribs);
3181             }
3182             }
3183              
3184             # Ignore merge cells
3185             elsif ($datatype == $self->{_datatypes}->{Merge}) {
3186             # Do nothing.
3187             }
3188              
3189              
3190 254         399 $self->{prev_col} = $col;
3191 254         585 return;
3192             }
3193              
3194              
3195             ###############################################################################
3196             #
3197             # _write_xml_cell_data()
3198             #
3199             # Write a generic Data element.
3200             #
3201             sub _write_xml_cell_data {
3202              
3203 226     226   261 my $self = shift;
3204              
3205 226         278 my $datatype = $_[0];
3206 226         258 my $data = $_[1];
3207              
3208 226         623 $self->_write_xml_start_tag(5, 0, 0, 'Data', 'ss:Type', $datatype);
3209              
3210 226 100       448 if ($datatype eq 'Number') {$self->_write_xml_unencoded_content($data)}
  39         170  
  187         542  
3211             else {$self->_write_xml_content($data) }
3212              
3213 226         692 $self->_write_xml_end_tag(0, 1, 0, 'Data');
3214             }
3215              
3216              
3217             ###############################################################################
3218             #
3219             # _write_xml_html_string()
3220             #
3221             # Write a string Data element with html text.
3222             #
3223             sub _write_xml_html_string {
3224              
3225 5     5   14 my $self = shift;
3226 5         11 my $data = $_[0];
3227              
3228 5         16 $self->_write_xml_start_tag(5, 0, 0, 'ss:Data',
3229             'ss:Type',
3230             'String',
3231             'xmlns',
3232             'http://www.w3.org/TR/REC-html40'
3233             );
3234              
3235 5         24 $self->_write_xml_unencoded_content($data);
3236              
3237 5         16 $self->_write_xml_end_tag(0, 1, 0, 'ss:Data');
3238             }
3239              
3240              
3241             ###############################################################################
3242             #
3243             # _write_xml_cell_comment()
3244             #
3245             # Write a cell Comment element.
3246             #
3247             sub _write_xml_cell_comment {
3248              
3249 8     8   10 my $self = shift;
3250 8         10 my $comment = $_[0];
3251              
3252 8         20 $self->_write_xml_start_tag(5, 1, 0, 'Comment');
3253              
3254 8         26 $self->_write_xml_start_tag(6, 0, 0, 'ss:Data',
3255             'xmlns',
3256             'http://www.w3.org/TR/REC-html40'
3257             );
3258              
3259 8         22 $self->_write_xml_unencoded_content($comment);
3260              
3261 8         20 $self->_write_xml_end_tag(0, 1, 0, 'ss:Data');
3262              
3263 8         20 $self->_write_xml_end_tag(5, 1, 0, 'Comment');
3264              
3265             }
3266              
3267              
3268             ###############################################################################
3269             #
3270             # _convert_formula($row, $col, $A1_formula)
3271             #
3272             # Converts a string containing an Excel formula in A1 notation into a string
3273             # containing a formula in R1C1 notation.
3274             #
3275             # Instead of parsing the formula into its component parts, as Spreadsheet::
3276             # WriteExcel::Formula does, we convert the A1 style references to R1C1
3277             # references using regexes. This avoid the significant overhead of the
3278             # Parse::RecDescent parser in S::WE::Formula. The main problem with this
3279             # simplified approach is that there is potential for false matches. Such as
3280             # B5 in the following formula (only the last is a valid match).
3281             #
3282             # "= "B5" & SheetB5!B5"
3283             #
3284             # The method used here is to replace potential false matches before converting
3285             # the real A1 cell references and then substitute back the replaced data.
3286             #
3287             # Returns: a string. A representation of a formula in R1C1 notation.
3288             #
3289             sub _convert_formula {
3290              
3291 81     81   25158 my $self = shift;
3292              
3293 81         136 my $row = $_[0];
3294 81         104 my $col = $_[1];
3295 81         101 my $formula = $_[2];
3296              
3297 81         93 my @strings;
3298             my @sheets;
3299              
3300             # Replace double quoted strings in formula. Strings may contain escaped
3301             # double quotes. Regex by merlyn.
3302             # See http://www.perlmonks.org/index.pl?node_id=330280
3303             #
3304 81         336 push @strings, $1 while $formula =~ s/("([^"]|"")*")/__swe__str__/; # "
3305              
3306              
3307             # Replace worksheet references in formula, such as Sheet1! or 'Sheet 1'!
3308             #
3309 81         331 push @sheets, $1 while $formula =~ s/(('[^']+'|[\w\.]+)!)/__swe__sht__/;
3310              
3311              
3312             # Replace valid A1 cell references with R1C1 references. Cell ranges such
3313             # as B5:G10 are replaced in two passes.
3314             # The negative look-ahead is to prevent false matches such as =LOG10(LOG10)
3315             #
3316 81         474 $formula =~ s{(\$?[A-Z]{1,3}\$?\d+)(?![(\d])}
3317 87         217 {$self->_A1_to_R1C1($row, $col, $1)}eg;
3318              
3319              
3320             # Replace row ranges such as 2:9 with R1C1 references.
3321             #
3322 81         267 $formula =~ s{(\$?\d+:\$?\d+)}
3323 5         14 {$self->_row_range_to_R1C1($row, $1)}eg;
3324              
3325              
3326             # Replace column ranges such as A:Z with R1C1 references.
3327             # The negative look-behind is to prevent false column matches such
3328             # as "=A1:A1" => "=RC:RC"
3329             #
3330             # Note: there is a tricky parse due to the increased column limits that
3331             # isn't handled here. RC:RC is now a valid column range in A1 notation.
3332             # Fix later. Maybe.
3333 81         164 $formula =~ s{(?
3334 6         17 {$self->_col_range_to_R1C1($col, $1)}eg;
3335              
3336              
3337             # Quoted A1 style alphanumeric sheetnames don't need quoting when
3338             # converted to R1C1 style. For example "='A1'!A1" becomes "=A1!RC" (without
3339             # the single quotes since A1 isn't a reserved name in R1C1 notation).
3340 81         220 s/^'([a-zA-Z0-9]+)'!$/$1!/ for @sheets;
3341              
3342              
3343             # However, sheet names that looks like R1C1 notation do have to be single
3344             # quoted. For example "='R4C'!A1" becomes "='R4C'!RC".
3345             #
3346 81         215 s/^((R\d*|R\[\d+\])?(C\d*|C\[\d+\])?)!$/\'$1\'!/ for @sheets;
3347              
3348              
3349             # Replace temporarily escaped strings. Note that the s///s are performed in
3350             # reverse order to the substitutions above in case of nested strings.
3351 81         229 $formula =~ s/__swe__sht__/shift @sheets /e while @sheets;
  22         87  
3352 81         198 $formula =~ s/__swe__str__/shift @strings/e while @strings;
  12         65  
3353              
3354 81         488 return $formula;
3355             }
3356              
3357              
3358             ###############################################################################
3359             #
3360             # _A1_to_R1C1($A1_string)
3361             #
3362             # Converts a string containing an Excel cell reference in A1 notation into a
3363             # string containing a formula in R1C1 notation. For example:
3364             #
3365             # '=G1' in cell (0, 0) becomes '=RC[6]'.
3366             #
3367             # The R1C1 value is relative to the row and column from which it is referred.
3368             # With reference to the above example:
3369             #
3370             # '=G1' in cell (1, 0) becomes '=R[-1]C[6]'.
3371             #
3372             # Returns: a string. A representation of a cell reference in R1C1 notation.
3373             #
3374             #
3375             sub _A1_to_R1C1 {
3376              
3377 87     87   161 my $self = shift;
3378              
3379 87         132 my $current_row = $_[0];
3380 87         87 my $current_col = $_[1];
3381              
3382 87         220 my ($row, $col, $row_abs, $col_abs) = $self->_cell_to_rowcol($_[2]);
3383              
3384             # Row part
3385 87         153 my $r1c1 = 'R';
3386              
3387 87 100       152 if ($row_abs) {
3388 16         27 $r1c1 .= $row +1; # 1 based
3389             }
3390             else {
3391 71 100       204 $r1c1 .= '[' . ($row -$current_row) . ']' unless $row == $current_row;
3392             }
3393              
3394             # Column part
3395 87         108 $r1c1 .= 'C';
3396              
3397 87 100       142 if ($col_abs) {
3398 16         22 $r1c1 .= $col +1; # 1 based
3399             }
3400             else {
3401 71 100       177 $r1c1 .= '[' . ($col -$current_col) . ']' unless $col == $current_col;
3402             }
3403              
3404 87         328 return $r1c1;
3405             }
3406              
3407              
3408             ###############################################################################
3409             #
3410             # _row_range_to_R1C1($string)
3411             #
3412             # Replace row ranges with R1C1 references. For example:
3413             #
3414             # '=20:120' in cell (7, 0) becomes '=R[12]:R[112]'
3415             #
3416             # Returns: a string. A representation of a row cell reference in R1C1 notation.
3417              
3418             #
3419             sub _row_range_to_R1C1 {
3420              
3421 5     5   7 my $self = shift;
3422              
3423 5         9 my $current_row = $_[0] +1; # One based
3424 5         10 my $range = $_[1];
3425              
3426              
3427             # Split the range into 2 rows
3428 5         13 my ($row1, $row2) = split ':', $range;
3429              
3430 5         10 for my $row ($row1, $row2) {
3431              
3432 10         21 my $row_abs = $row =~ s/\$//;
3433              
3434             # TODO Check row range
3435              
3436 10         14 my $r1c1 = 'R';
3437              
3438 10 100       20 if ($row_abs) {
3439 4         6 $r1c1 .= $row;
3440             }
3441             else {
3442 6 100       22 $r1c1 .= '['.($row -$current_row) .']' unless $row == $current_row;
3443             }
3444              
3445 10         18 $row = $r1c1;
3446             }
3447              
3448             # A single row range such as 'R2:R2' is represented as 'R2'
3449 5 100       14 if ($row1 eq $row2) {return $row1 }
  3         10  
  2         8  
3450             else {return "$row1:$row2"}
3451             }
3452              
3453              
3454             ###############################################################################
3455             #
3456             # _col_range_to_R1C1($string)
3457             #
3458             # Replace column ranges with R1C1 references. For example:
3459             #
3460             # '=D:Z' in cell (6, 0) becomes '=C[3]:C[25]'
3461             #
3462             # Returns: a string. A representation of a col range reference in R1C1 notation.
3463             #
3464             sub _col_range_to_R1C1 {
3465              
3466 6     6   11 my $self = shift;
3467              
3468 6         8 my $current_col = $_[0] +1; # One based
3469 6         15 my $range = $_[1];
3470              
3471              
3472             # Split the range into 2 cols
3473 6         15 my ($col_letter1, $col_letter2) = split ':', $range;
3474              
3475             # Note $col is used as an alias. The original values are changed in place.
3476             # This should probably be refactored into a function.
3477 6         12 for my $col ($col_letter1, $col_letter2) {
3478              
3479 12         15 my $col_abs;
3480 12         15 my $col_letter = $col;
3481              
3482 12         45 (undef, $col, undef, $col_abs) = xl_cell_to_rowcol($col . '1');
3483              
3484             # Switch from 0 based to 1 based.
3485 12         24 $col++;
3486              
3487 12 50       40 if ($col > $self->{_xls_colmax}) {
3488 0         0 warn "$col_letter is not an Excel column label.\n"; # TODO Carp
3489 0         0 return $range;
3490             }
3491              
3492 12         15 my $r1c1 = 'C';
3493              
3494 12 100       26 if ($col_abs) {
3495 4         6 $r1c1 .= $col;
3496             }
3497             else {
3498 8 50       30 $r1c1 .= '['.($col -$current_col).']' unless $col == $current_col;
3499             }
3500 12         24 $col = $r1c1;
3501             }
3502              
3503             # A single column range such as 'C3:C3' is represented as 'C3'
3504 6 100       15 if ($col_letter1 eq $col_letter2) {return $col_letter1 }
  4         14  
  2         10  
3505             else {return "$col_letter1:$col_letter2"}
3506             }
3507              
3508              
3509             ###############################################################################
3510             #
3511             # _write_worksheet_options()
3512             #
3513             # Write the element if the worksheet options have changed.
3514             #
3515             sub _write_worksheet_options {
3516              
3517 73     73   106 my $self = shift;
3518              
3519 73         197 my ($options_changed, $print_changed, $setup_changed) =
3520             $self->_options_changed();
3521              
3522 73 100       201 return unless $options_changed;
3523              
3524 31         114 $self->_write_xml_start_tag(2, 1, 0, 'WorksheetOptions',
3525             'xmlns',
3526             'urn:schemas-microsoft-com:' .
3527             'office:excel');
3528              
3529              
3530 31 100       70 if ($setup_changed) {
3531 14         33 $self->_write_xml_start_tag(3, 1, 0, 'PageSetup');
3532 14         32 $self->_store_setup();
3533 14         34 $self->_write_xml_end_tag (3, 1, 0, 'PageSetup');
3534             }
3535              
3536              
3537 31 100       71 $self->_write_xml_element(3,1,0,'FitToPage') if $self->{_fit_page};
3538              
3539              
3540 31 100       57 if ($print_changed) {
3541 12         30 $self->_write_xml_start_tag(3, 1, 0, 'Print');
3542 12         19 $self->_store_print();
3543 12         28 $self->_write_xml_end_tag (3, 1, 0, 'Print');
3544             }
3545              
3546 31 100       59 $self->_write_xml_element(3,1,0,'DoNotDisplayGridlines')
3547             if $self->{_screen_gridlines} == 0;
3548              
3549 31 100       73 $self->_write_xml_element(3,1,0,'FilterOn') if $self->{_filter_on};
3550              
3551 31         75 $self->_write_xml_end_tag(2, 1, 0, 'WorksheetOptions');
3552             }
3553              
3554              
3555             ###############################################################################
3556             #
3557             # _options_changed()
3558             #
3559             # Check to see if any of the worksheet options have changed.
3560             #
3561             sub _options_changed {
3562              
3563 73     73   95 my $self = shift;
3564              
3565 73         112 my $options_changed = 0;
3566 73         82 my $print_changed = 0;
3567 73         100 my $setup_changed = 0;
3568              
3569              
3570 73 100 100     2237 if (
      100        
      100        
      100        
      66        
      66        
      66        
      100        
      100        
      100        
3571             $self->{_orientation} == 0 or
3572             $self->{_hcenter} == 1 or
3573             $self->{_vcenter} == 1 or
3574             $self->{_header} ne '' or
3575             $self->{_footer} ne '' or
3576             $self->{_margin_head} != 0.50 or
3577             $self->{_margin_foot} != 0.50 or
3578             $self->{_margin_left} != 0.75 or
3579             $self->{_margin_right} != 0.75 or
3580             $self->{_margin_top} != 1.00 or
3581             $self->{_margin_bottom} != 1.00
3582             )
3583             {
3584 14         14 $setup_changed = 1;
3585             }
3586              
3587              
3588             # Special case for 1x1 page fit.
3589 73 100 66     294 if ($self->{_fit_width} == 1 and $self->{_fit_height} == 1) {
3590 2         4 $options_changed = 1;
3591 2         3 $self->{_fit_width} = 0;
3592 2         3 $self->{_fit_height} = 0;
3593             }
3594              
3595              
3596 73 100 66     2082 if (
      66        
      33        
      33        
      33        
      66        
      100        
      100        
      100        
      100        
      100        
3597 66         317 $self->{_fit_width} > 1 or
3598             $self->{_fit_height} > 1 or
3599             $self->{_page_order} == 1 or
3600             $self->{_black_white} == 1 or
3601             $self->{_draft_quality} == 1 or
3602             $self->{_print_comments} == 1 or
3603             $self->{_paper_size} != 0 or
3604             $self->{_print_scale} != 100 or
3605             $self->{_print_gridlines} == 1 or
3606             $self->{_print_headers} == 1 or
3607 63         242 @{$self->{_hbreaks}} > 0 or
3608             @{$self->{_vbreaks}} > 0
3609             )
3610             {
3611 12         15 $print_changed = 1;
3612             }
3613              
3614              
3615 73 100 100     384 if (
3616             $print_changed or
3617             $setup_changed
3618             )
3619             {
3620 26         22 $options_changed = 1;
3621             }
3622              
3623              
3624 73 100       203 $options_changed = 1 if $self->{_screen_gridlines} == 0;
3625 73 100       185 $options_changed = 1 if $self->{_filter_on};
3626              
3627 73         194 return ($options_changed, $print_changed, $setup_changed);
3628             }
3629              
3630              
3631             ###############################################################################
3632             #
3633             # _write_autofilter()
3634             #
3635             # Write the element.
3636             #
3637             sub _write_autofilter {
3638              
3639 73     73   96 my $self = shift;
3640              
3641 73 100       232 return unless $self->{_autofilter};
3642              
3643 2         11 $self->_write_xml_start_tag(2, 1, 0, 'AutoFilter',
3644             'x:Range',
3645             $self->{_autofilter},
3646             'xmlns',
3647             'urn:schemas-microsoft-com:' .
3648             'office:excel');
3649              
3650              
3651 2         10 $self->_write_autofilter_column();
3652              
3653 2         10 $self->_write_xml_end_tag(2, 1, 0, 'AutoFilter');
3654             }
3655              
3656              
3657             ###############################################################################
3658             #
3659             # _write_autofilter_column()
3660             #
3661             # Write the and elements. The format
3662             # of this is a little complicated.
3663             #
3664             sub _write_autofilter_column {
3665              
3666 2     2   5 my $self = shift;
3667 2         3 my @tokens;
3668              
3669              
3670 2         4 my ($col_first, $col_last) = @{$self->{_filter_range}};
  2         24  
3671              
3672 2         11 my $prev_col = $col_first -1;
3673              
3674              
3675 2         9 for my $col ($col_first .. $col_last) {
3676              
3677             # Check for rows with defined filter criteria.
3678 8 100       150 if (defined $self->{_filter_cols}->{$col}) {
3679              
3680 4         16 my @attribs = ('AutoFilterColumn');
3681              
3682             # The col indices are relative to the first column
3683 4 100       12 push @attribs, "x:Index", $col +1 -$col_first if $col != $prev_col +1;
3684 4         9 push @attribs, "x:Type", 'Custom';
3685 4         7 $prev_col = $col;
3686              
3687 4         14 $self->_write_xml_start_tag(3, 1, 0, @attribs);
3688              
3689 4         5 @tokens = @{$self->{_filter_cols}->{$col}};
  4         19  
3690              
3691              
3692             # Excel allows either one or two filter conditions
3693              
3694             # Single criterion.
3695 4 100       14 if (@tokens == 2) {
3696 2         6 my ($op, $value) = @tokens;
3697              
3698 2         8 $self->_write_xml_element(4, 1, 0, 'AutoFilterCondition',
3699             'x:Operator',
3700             $op,
3701             'x:Value',
3702             $value);
3703             }
3704             # Double criteria, either 'And' or 'Or'.
3705             else {
3706 2         7 my ($op1, $value1, $op2, $op3, $value3) = @tokens;
3707              
3708             # or
3709 2         10 $self->_write_xml_start_tag(4, 1, 0, $op2);
3710              
3711 2         11 $self->_write_xml_element(5, 1, 0, 'AutoFilterCondition',
3712             'x:Operator',
3713             $op1,
3714             'x:Value',
3715             $value1);
3716              
3717 2         12 $self->_write_xml_element(5, 1, 0, 'AutoFilterCondition',
3718             'x:Operator',
3719             $op3,
3720             'x:Value',
3721             $value3);
3722              
3723 2         8 $self->_write_xml_end_tag(4, 1, 0, $op2);
3724              
3725             }
3726              
3727 4         14 $self->_write_xml_end_tag(3, 1, 0, 'AutoFilterColumn');
3728             }
3729             }
3730             }
3731              
3732              
3733             ###############################################################################
3734             #
3735             # _quote_sheetname()
3736             #
3737             # Sheetnames used in references should be quoted if they contain any spaces,
3738             # special characters or if the look like something that isn't a sheet name.
3739             # However, the rules are complex so for now we just quote anything that doesn't
3740             # look like a simple sheet name.
3741             #
3742             sub _quote_sheetname {
3743              
3744 22     22   31 my $self = shift;
3745 22         31 my $sheetname = $_[0];
3746              
3747              
3748 22 100       89 if ($sheetname =~ /^Sheet\d+$/) {
3749 2         6 return $sheetname;
3750             }
3751             else {
3752 20         69 return "'" . $sheetname . "'";
3753             }
3754             }
3755              
3756              
3757              
3758              
3759             1;
3760              
3761              
3762             __END__