blob: 95142f68b3b6cf063c5e5d4b927fec50d4e16765 [file] [log] [blame]
rjw6c1fd8f2022-11-30 14:33:01 +08001package Spreadsheet::WriteExcel::Worksheet;
2
3###############################################################################
4#
5# Worksheet - A writer class for Excel Worksheets.
6#
7#
8# Used in conjunction with Spreadsheet::WriteExcel
9#
10# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
11#
12# Documentation after __END__
13#
14
15use Exporter;
16use strict;
17use Carp;
18use Spreadsheet::WriteExcel::BIFFwriter;
19use Spreadsheet::WriteExcel::Format;
20use Spreadsheet::WriteExcel::Formula;
21
22
23
24use vars qw($VERSION @ISA);
25@ISA = qw(Spreadsheet::WriteExcel::BIFFwriter);
26
27$VERSION = '2.37';
28
29###############################################################################
30#
31# new()
32#
33# Constructor. Creates a new Worksheet object from a BIFFwriter object
34#
35sub new {
36
37 my $class = shift;
38 my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
39 my $rowmax = 65536;
40 my $colmax = 256;
41 my $strmax = 0;
42
43 $self->{_name} = $_[0];
44 $self->{_index} = $_[1];
45 $self->{_encoding} = $_[2];
46 $self->{_activesheet} = $_[3];
47 $self->{_firstsheet} = $_[4];
48 $self->{_url_format} = $_[5];
49 $self->{_parser} = $_[6];
50 $self->{_tempdir} = $_[7];
51
52 $self->{_str_total} = $_[8];
53 $self->{_str_unique} = $_[9];
54 $self->{_str_table} = $_[10];
55 $self->{_1904} = $_[11];
56 $self->{_compatibility} = $_[12];
57 $self->{_palette} = $_[13];
58
59 $self->{_sheet_type} = 0x0000;
60 $self->{_ext_sheets} = [];
61 $self->{_using_tmpfile} = 1;
62 $self->{_filehandle} = "";
63 $self->{_fileclosed} = 0;
64 $self->{_offset} = 0;
65 $self->{_xls_rowmax} = $rowmax;
66 $self->{_xls_colmax} = $colmax;
67 $self->{_xls_strmax} = $strmax;
68 $self->{_dim_rowmin} = undef;
69 $self->{_dim_rowmax} = undef;
70 $self->{_dim_colmin} = undef;
71 $self->{_dim_colmax} = undef;
72 $self->{_colinfo} = [];
73 $self->{_selection} = [0, 0];
74 $self->{_panes} = [];
75 $self->{_active_pane} = 3;
76 $self->{_frozen} = 0;
77 $self->{_frozen_no_split} = 1;
78 $self->{_selected} = 0;
79 $self->{_hidden} = 0;
80 $self->{_active} = 0;
81 $self->{_tab_color} = 0;
82
83 $self->{_first_row} = 0;
84 $self->{_first_col} = 0;
85 $self->{_display_formulas} = 0;
86 $self->{_display_headers} = 1;
87 $self->{_display_zeros} = 1;
88 $self->{_display_arabic} = 0;
89
90 $self->{_paper_size} = 0x0;
91 $self->{_orientation} = 0x1;
92 $self->{_header} = '';
93 $self->{_footer} = '';
94 $self->{_header_encoding} = 0;
95 $self->{_footer_encoding} = 0;
96 $self->{_hcenter} = 0;
97 $self->{_vcenter} = 0;
98 $self->{_margin_header} = 0.50;
99 $self->{_margin_footer} = 0.50;
100 $self->{_margin_left} = 0.75;
101 $self->{_margin_right} = 0.75;
102 $self->{_margin_top} = 1.00;
103 $self->{_margin_bottom} = 1.00;
104
105 $self->{_title_rowmin} = undef;
106 $self->{_title_rowmax} = undef;
107 $self->{_title_colmin} = undef;
108 $self->{_title_colmax} = undef;
109 $self->{_print_rowmin} = undef;
110 $self->{_print_rowmax} = undef;
111 $self->{_print_colmin} = undef;
112 $self->{_print_colmax} = undef;
113
114 $self->{_print_gridlines} = 1;
115 $self->{_screen_gridlines} = 1;
116 $self->{_print_headers} = 0;
117
118 $self->{_page_order} = 0;
119 $self->{_black_white} = 0;
120 $self->{_draft_quality} = 0;
121 $self->{_print_comments} = 0;
122 $self->{_page_start} = 1;
123 $self->{_custom_start} = 0;
124
125 $self->{_fit_page} = 0;
126 $self->{_fit_width} = 0;
127 $self->{_fit_height} = 0;
128
129 $self->{_hbreaks} = [];
130 $self->{_vbreaks} = [];
131
132 $self->{_protect} = 0;
133 $self->{_password} = undef;
134
135 $self->{_col_sizes} = {};
136 $self->{_row_sizes} = {};
137
138 $self->{_col_formats} = {};
139 $self->{_row_formats} = {};
140
141 $self->{_zoom} = 100;
142 $self->{_print_scale} = 100;
143 $self->{_page_view} = 0;
144
145 $self->{_leading_zeros} = 0;
146
147 $self->{_outline_row_level} = 0;
148 $self->{_outline_style} = 0;
149 $self->{_outline_below} = 1;
150 $self->{_outline_right} = 1;
151 $self->{_outline_on} = 1;
152
153 $self->{_write_match} = [];
154
155 $self->{_object_ids} = [];
156 $self->{_images} = {};
157 $self->{_images_array} = [];
158 $self->{_charts} = {};
159 $self->{_charts_array} = [];
160 $self->{_comments} = {};
161 $self->{_comments_array} = [];
162 $self->{_comments_author} = '';
163 $self->{_comments_author_enc} = 0;
164 $self->{_comments_visible} = 0;
165
166 $self->{_filter_area} = [];
167 $self->{_filter_count} = 0;
168 $self->{_filter_on} = 0;
169
170 $self->{_writing_url} = 0;
171
172 $self->{_db_indices} = [];
173
174 $self->{_validations} = [];
175
176 bless $self, $class;
177 $self->_initialize();
178 return $self;
179}
180
181
182###############################################################################
183#
184# _initialize()
185#
186# Open a tmp file to store the majority of the Worksheet data. If this fails,
187# for example due to write permissions, store the data in memory. This can be
188# slow for large files.
189#
190sub _initialize {
191
192 my $self = shift;
193 my $fh;
194 my $tmp_dir;
195
196 # The following code is complicated by Windows limitations. Porters can
197 # choose a more direct method.
198
199
200
201 # In the default case we use IO::File->new_tmpfile(). This may fail, in
202 # particular with IIS on Windows, so we allow the user to specify a temp
203 # directory via File::Temp.
204 #
205 if (defined $self->{_tempdir}) {
206
207 # Delay loading File:Temp to reduce the module dependencies.
208 eval { require File::Temp };
209 die "The File::Temp module must be installed in order ".
210 "to call set_tempdir().\n" if $@;
211
212
213 # Trap but ignore File::Temp errors.
214 eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
215
216 # Store the failed tmp dir in case of errors.
217 $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
218 }
219 else {
220
221 $fh = IO::File->new_tmpfile();
222
223 # Store the failed tmp dir in case of errors.
224 $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
225 }
226
227
228 # Check if the temp file creation was successful. Else store data in memory.
229 if ($fh) {
230
231 # binmode file whether platform requires it or not.
232 binmode($fh);
233
234 # Store filehandle
235 $self->{_filehandle} = $fh;
236 }
237 else {
238
239 # Set flag to store data in memory if XX::tempfile() failed.
240 $self->{_using_tmpfile} = 0;
241
242 if ($self->{_index} == 0 && $^W) {
243 my $dir = $self->{_tempdir} || File::Spec->tmpdir();
244
245 warn "Unable to create temp files in $tmp_dir. Data will be ".
246 "stored in memory. Refer to set_tempdir() in the ".
247 "Spreadsheet::WriteExcel documentation.\n" ;
248 }
249 }
250}
251
252
253###############################################################################
254#
255# _close()
256#
257# Add data to the beginning of the workbook (note the reverse order)
258# and to the end of the workbook.
259#
260sub _close {
261
262 my $self = shift;
263
264 ################################################
265 # Prepend in reverse order!!
266 #
267
268 # Prepend the sheet dimensions
269 $self->_store_dimensions();
270
271 # Prepend the autofilter filters.
272 $self->_store_autofilters;
273
274 # Prepend the sheet autofilter info.
275 $self->_store_autofilterinfo();
276
277 # Prepend the sheet filtermode record.
278 $self->_store_filtermode();
279
280 # Prepend the COLINFO records if they exist
281 if (@{$self->{_colinfo}}){
282 my @colinfo = @{$self->{_colinfo}};
283 while (@colinfo) {
284 my $arrayref = pop @colinfo;
285 $self->_store_colinfo(@$arrayref);
286 }
287 }
288
289 # Prepend the DEFCOLWIDTH record
290 $self->_store_defcol();
291
292 # Prepend the sheet password
293 $self->_store_password();
294
295 # Prepend the sheet protection
296 $self->_store_protect();
297 $self->_store_obj_protect();
298
299 # Prepend the page setup
300 $self->_store_setup();
301
302 # Prepend the bottom margin
303 $self->_store_margin_bottom();
304
305 # Prepend the top margin
306 $self->_store_margin_top();
307
308 # Prepend the right margin
309 $self->_store_margin_right();
310
311 # Prepend the left margin
312 $self->_store_margin_left();
313
314 # Prepend the page vertical centering
315 $self->_store_vcenter();
316
317 # Prepend the page horizontal centering
318 $self->_store_hcenter();
319
320 # Prepend the page footer
321 $self->_store_footer();
322
323 # Prepend the page header
324 $self->_store_header();
325
326 # Prepend the vertical page breaks
327 $self->_store_vbreak();
328
329 # Prepend the horizontal page breaks
330 $self->_store_hbreak();
331
332 # Prepend WSBOOL
333 $self->_store_wsbool();
334
335 # Prepend the default row height.
336 $self->_store_defrow();
337
338 # Prepend GUTS
339 $self->_store_guts();
340
341 # Prepend GRIDSET
342 $self->_store_gridset();
343
344 # Prepend PRINTGRIDLINES
345 $self->_store_print_gridlines();
346
347 # Prepend PRINTHEADERS
348 $self->_store_print_headers();
349
350 #
351 # End of prepend. Read upwards from here.
352 ################################################
353
354 # Append
355 $self->_store_table();
356 $self->_store_images();
357 $self->_store_charts();
358 $self->_store_filters();
359 $self->_store_comments();
360 $self->_store_window2();
361 $self->_store_page_view();
362 $self->_store_zoom();
363 $self->_store_panes(@{$self->{_panes}}) if @{$self->{_panes}};
364 $self->_store_selection(@{$self->{_selection}});
365 $self->_store_validation_count();
366 $self->_store_validations();
367 $self->_store_tab_color();
368 $self->_store_eof();
369
370 # Prepend the BOF and INDEX records
371 $self->_store_index();
372 $self->_store_bof(0x0010);
373}
374
375
376###############################################################################
377#
378# _compatibility_mode()
379#
380# Set the compatibility mode.
381#
382# See the explanation in Workbook::compatibility_mode(). This private method
383# is mainly used for test purposes.
384#
385sub _compatibility_mode {
386
387 my $self = shift;
388
389 if (defined($_[0])) {
390 $self->{_compatibility} = $_[0];
391 }
392 else {
393 $self->{_compatibility} = 1;
394 }
395}
396
397
398###############################################################################
399#
400# get_name().
401#
402# Retrieve the worksheet name.
403#
404# Note, there is no set_name() method because names are used in formulas and
405# converted to internal indices. Allowing the user to change sheet names
406# after they have been set in add_worksheet() is asking for trouble.
407#
408sub get_name {
409
410 my $self = shift;
411
412 return $self->{_name};
413}
414
415
416###############################################################################
417#
418# get_data().
419#
420# Retrieves data from memory in one chunk, or from disk in $buffer
421# sized chunks.
422#
423sub get_data {
424
425 my $self = shift;
426 my $buffer = 4096;
427 my $tmp;
428
429 # Return data stored in memory
430 if (defined $self->{_data}) {
431 $tmp = $self->{_data};
432 $self->{_data} = undef;
433 my $fh = $self->{_filehandle};
434 seek($fh, 0, 0) if $self->{_using_tmpfile};
435 return $tmp;
436 }
437
438 # Return data stored on disk
439 if ($self->{_using_tmpfile}) {
440 return $tmp if read($self->{_filehandle}, $tmp, $buffer);
441 }
442
443 # No data to return
444 return undef;
445}
446
447
448###############################################################################
449#
450# select()
451#
452# Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
453# highlighted.
454#
455sub select {
456
457 my $self = shift;
458
459 $self->{_hidden} = 0; # Selected worksheet can't be hidden.
460 $self->{_selected} = 1;
461}
462
463
464###############################################################################
465#
466# activate()
467#
468# Set this worksheet as the active worksheet, i.e. the worksheet that is
469# displayed when the workbook is opened. Also set it as selected.
470#
471sub activate {
472
473 my $self = shift;
474
475 $self->{_hidden} = 0; # Active worksheet can't be hidden.
476 $self->{_selected} = 1;
477 ${$self->{_activesheet}} = $self->{_index};
478}
479
480
481###############################################################################
482#
483# hide()
484#
485# Hide this worksheet.
486#
487sub hide {
488
489 my $self = shift;
490
491 $self->{_hidden} = 1;
492
493 # A hidden worksheet shouldn't be active or selected.
494 $self->{_selected} = 0;
495 ${$self->{_activesheet}} = 0;
496 ${$self->{_firstsheet}} = 0;
497}
498
499
500###############################################################################
501#
502# set_first_sheet()
503#
504# Set this worksheet as the first visible sheet. This is necessary
505# when there are a large number of worksheets and the activated
506# worksheet is not visible on the screen.
507#
508sub set_first_sheet {
509
510 my $self = shift;
511
512 $self->{_hidden} = 0; # Active worksheet can't be hidden.
513 ${$self->{_firstsheet}} = $self->{_index};
514}
515
516
517###############################################################################
518#
519# protect($password)
520#
521# Set the worksheet protection flag to prevent accidental modification and to
522# hide formulas if the locked and hidden format properties have been set.
523#
524sub protect {
525
526 my $self = shift;
527
528 $self->{_protect} = 1;
529 $self->{_password} = $self->_encode_password($_[0]) if defined $_[0];
530
531}
532
533
534###############################################################################
535#
536# set_column($firstcol, $lastcol, $width, $format, $hidden, $level)
537#
538# Set the width of a single column or a range of columns.
539# See also: _store_colinfo
540#
541sub set_column {
542
543 my $self = shift;
544 my @data = @_;
545 my $cell = $data[0];
546
547 # Check for a cell reference in A1 notation and substitute row and column
548 if ($cell =~ /^\D/) {
549 @data = $self->_substitute_cellref(@_);
550
551 # Returned values $row1 and $row2 aren't required here. Remove them.
552 shift @data; # $row1
553 splice @data, 1, 1; # $row2
554 }
555
556 return if @data < 3; # Ensure at least $firstcol, $lastcol and $width
557 return if not defined $data[0]; # Columns must be defined.
558 return if not defined $data[1];
559
560 # Assume second column is the same as first if 0. Avoids KB918419 bug.
561 $data[1] = $data[0] if $data[1] == 0;
562
563 # Ensure 2nd col is larger than first. Also for KB918419 bug.
564 ($data[0], $data[1]) = ($data[1], $data[0]) if $data[0] > $data[1];
565
566 # Limit columns to Excel max of 255.
567 $data[0] = 255 if $data[0] > 255;
568 $data[1] = 255 if $data[1] > 255;
569
570 push @{$self->{_colinfo}}, [ @data ];
571
572
573 # Store the col sizes for use when calculating image vertices taking
574 # hidden columns into account. Also store the column formats.
575 #
576 my $width = $data[4] ? 0 : $data[2]; # Set width to zero if col is hidden
577 $width ||= 0; # Ensure width isn't undef.
578 my $format = $data[3];
579
580 my ($firstcol, $lastcol) = @data;
581
582 foreach my $col ($firstcol .. $lastcol) {
583 $self->{_col_sizes}->{$col} = $width;
584 $self->{_col_formats}->{$col} = $format if defined $format;
585 }
586}
587
588
589###############################################################################
590#
591# set_selection()
592#
593# Set which cell or cells are selected in a worksheet: see also the
594# sub _store_selection
595#
596sub set_selection {
597
598 my $self = shift;
599
600 # Check for a cell reference in A1 notation and substitute row and column
601 if ($_[0] =~ /^\D/) {
602 @_ = $self->_substitute_cellref(@_);
603 }
604
605 $self->{_selection} = [ @_ ];
606}
607
608
609###############################################################################
610#
611# freeze_panes()
612#
613# Set panes and mark them as frozen. See also _store_panes().
614#
615sub freeze_panes {
616
617 my $self = shift;
618
619 # Check for a cell reference in A1 notation and substitute row and column
620 if ($_[0] =~ /^\D/) {
621 @_ = $self->_substitute_cellref(@_);
622 }
623
624 # Extra flag indicated a split and freeze.
625 $self->{_frozen_no_split} = 0 if $_[4];
626
627 $self->{_frozen} = 1;
628 $self->{_panes} = [ @_ ];
629}
630
631
632###############################################################################
633#
634# split_panes()
635#
636# Set panes and mark them as split. See also _store_panes().
637#
638sub split_panes {
639
640 my $self = shift;
641
642 $self->{_frozen} = 0;
643 $self->{_frozen_no_split} = 0;
644 $self->{_panes} = [ @_ ];
645}
646
647# Older method name for backwards compatibility.
648*thaw_panes = *split_panes;
649
650
651###############################################################################
652#
653# set_portrait()
654#
655# Set the page orientation as portrait.
656#
657sub set_portrait {
658
659 my $self = shift;
660
661 $self->{_orientation} = 1;
662}
663
664
665###############################################################################
666#
667# set_landscape()
668#
669# Set the page orientation as landscape.
670#
671sub set_landscape {
672
673 my $self = shift;
674
675 $self->{_orientation} = 0;
676}
677
678
679###############################################################################
680#
681# set_page_view()
682#
683# Set the page view mode for Mac Excel.
684#
685sub set_page_view {
686
687 my $self = shift;
688
689 $self->{_page_view} = defined $_[0] ? $_[0] : 1;
690}
691
692
693###############################################################################
694#
695# set_tab_color()
696#
697# Set the colour of the worksheet colour.
698#
699sub set_tab_color {
700
701 my $self = shift;
702
703 my $color = &Spreadsheet::WriteExcel::Format::_get_color($_[0]);
704 $color = 0 if $color == 0x7FFF; # Default color.
705
706 $self->{_tab_color} = $color;
707}
708
709
710###############################################################################
711#
712# set_paper()
713#
714# Set the paper type. Ex. 1 = US Letter, 9 = A4
715#
716sub set_paper {
717
718 my $self = shift;
719
720 $self->{_paper_size} = $_[0] || 0;
721}
722
723
724###############################################################################
725#
726# set_header()
727#
728# Set the page header caption and optional margin.
729#
730sub set_header {
731
732 my $self = shift;
733 my $string = $_[0] || '';
734 my $margin = $_[1] || 0.50;
735 my $encoding = $_[2] || 0;
736
737 # Handle utf8 strings in perl 5.8.
738 if ($] >= 5.008) {
739 require Encode;
740
741 if (Encode::is_utf8($string)) {
742 $string = Encode::encode("UTF-16BE", $string);
743 $encoding = 1;
744 }
745 }
746
747 my $limit = $encoding ? 255 *2 : 255;
748
749 if (length $string >= $limit) {
750 carp 'Header string must be less than 255 characters';
751 return;
752 }
753
754 $self->{_header} = $string;
755 $self->{_margin_header} = $margin;
756 $self->{_header_encoding} = $encoding;
757}
758
759
760###############################################################################
761#
762# set_footer()
763#
764# Set the page footer caption and optional margin.
765#
766sub set_footer {
767
768 my $self = shift;
769 my $string = $_[0] || '';
770 my $margin = $_[1] || 0.50;
771 my $encoding = $_[2] || 0;
772
773 # Handle utf8 strings in perl 5.8.
774 if ($] >= 5.008) {
775 require Encode;
776
777 if (Encode::is_utf8($string)) {
778 $string = Encode::encode("UTF-16BE", $string);
779 $encoding = 1;
780 }
781 }
782
783 my $limit = $encoding ? 255 *2 : 255;
784
785
786 if (length $string >= $limit) {
787 carp 'Footer string must be less than 255 characters';
788 return;
789 }
790
791 $self->{_footer} = $string;
792 $self->{_margin_footer} = $margin;
793 $self->{_footer_encoding} = $encoding;
794}
795
796
797###############################################################################
798#
799# center_horizontally()
800#
801# Center the page horizontally.
802#
803sub center_horizontally {
804
805 my $self = shift;
806
807 if (defined $_[0]) {
808 $self->{_hcenter} = $_[0];
809 }
810 else {
811 $self->{_hcenter} = 1;
812 }
813}
814
815
816###############################################################################
817#
818# center_vertically()
819#
820# Center the page horizontally.
821#
822sub center_vertically {
823
824 my $self = shift;
825
826 if (defined $_[0]) {
827 $self->{_vcenter} = $_[0];
828 }
829 else {
830 $self->{_vcenter} = 1;
831 }
832}
833
834
835###############################################################################
836#
837# set_margins()
838#
839# Set all the page margins to the same value in inches.
840#
841sub set_margins {
842
843 my $self = shift;
844
845 $self->set_margin_left($_[0]);
846 $self->set_margin_right($_[0]);
847 $self->set_margin_top($_[0]);
848 $self->set_margin_bottom($_[0]);
849}
850
851
852###############################################################################
853#
854# set_margins_LR()
855#
856# Set the left and right margins to the same value in inches.
857#
858sub set_margins_LR {
859
860 my $self = shift;
861
862 $self->set_margin_left($_[0]);
863 $self->set_margin_right($_[0]);
864}
865
866
867###############################################################################
868#
869# set_margins_TB()
870#
871# Set the top and bottom margins to the same value in inches.
872#
873sub set_margins_TB {
874
875 my $self = shift;
876
877 $self->set_margin_top($_[0]);
878 $self->set_margin_bottom($_[0]);
879}
880
881
882###############################################################################
883#
884# set_margin_left()
885#
886# Set the left margin in inches.
887#
888sub set_margin_left {
889
890 my $self = shift;
891
892 $self->{_margin_left} = defined $_[0] ? $_[0] : 0.75;
893}
894
895
896###############################################################################
897#
898# set_margin_right()
899#
900# Set the right margin in inches.
901#
902sub set_margin_right {
903
904 my $self = shift;
905
906 $self->{_margin_right} = defined $_[0] ? $_[0] : 0.75;
907}
908
909
910###############################################################################
911#
912# set_margin_top()
913#
914# Set the top margin in inches.
915#
916sub set_margin_top {
917
918 my $self = shift;
919
920 $self->{_margin_top} = defined $_[0] ? $_[0] : 1.00;
921}
922
923
924###############################################################################
925#
926# set_margin_bottom()
927#
928# Set the bottom margin in inches.
929#
930sub set_margin_bottom {
931
932 my $self = shift;
933
934 $self->{_margin_bottom} = defined $_[0] ? $_[0] : 1.00;
935}
936
937
938###############################################################################
939#
940# repeat_rows($first_row, $last_row)
941#
942# Set the rows to repeat at the top of each printed page. See also the
943# _store_name_xxxx() methods in Workbook.pm.
944#
945sub repeat_rows {
946
947 my $self = shift;
948
949 $self->{_title_rowmin} = $_[0];
950 $self->{_title_rowmax} = $_[1] || $_[0]; # Second row is optional
951}
952
953
954###############################################################################
955#
956# repeat_columns($first_col, $last_col)
957#
958# Set the columns to repeat at the left hand side of each printed page.
959# See also the _store_names() methods in Workbook.pm.
960#
961sub repeat_columns {
962
963 my $self = shift;
964
965 # Check for a cell reference in A1 notation and substitute row and column
966 if ($_[0] =~ /^\D/) {
967 @_ = $self->_substitute_cellref(@_);
968
969 # Returned values $row1 and $row2 aren't required here. Remove them.
970 shift @_; # $row1
971 splice @_, 1, 1; # $row2
972 }
973
974 $self->{_title_colmin} = $_[0];
975 $self->{_title_colmax} = $_[1] || $_[0]; # Second col is optional
976}
977
978
979###############################################################################
980#
981# print_area($first_row, $first_col, $last_row, $last_col)
982#
983# Set the area of each worksheet that will be printed. See also the
984# _store_names() methods in Workbook.pm.
985#
986sub print_area {
987
988 my $self = shift;
989
990 # Check for a cell reference in A1 notation and substitute row and column
991 if ($_[0] =~ /^\D/) {
992 @_ = $self->_substitute_cellref(@_);
993 }
994
995 return if @_ != 4; # Require 4 parameters
996
997 $self->{_print_rowmin} = $_[0];
998 $self->{_print_colmin} = $_[1];
999 $self->{_print_rowmax} = $_[2];
1000 $self->{_print_colmax} = $_[3];
1001}
1002
1003
1004###############################################################################
1005#
1006# autofilter($first_row, $first_col, $last_row, $last_col)
1007#
1008# Set the autofilter area in the worksheet.
1009#
1010sub autofilter {
1011
1012 my $self = shift;
1013
1014 # Check for a cell reference in A1 notation and substitute row and column
1015 if ($_[0] =~ /^\D/) {
1016 @_ = $self->_substitute_cellref(@_);
1017 }
1018
1019 return if @_ != 4; # Require 4 parameters
1020
1021 my ($row1, $col1, $row2, $col2) = @_;
1022
1023 # Reverse max and min values if necessary.
1024 ($row1, $row2) = ($row2, $row1) if $row2 < $row1;
1025 ($col1, $col2) = ($col2, $col1) if $col2 < $col1;
1026
1027 # Store the Autofilter information
1028 $self->{_filter_area} = [$row1, $row2, $col1, $col2];
1029 $self->{_filter_count} = 1+ $col2 -$col1;
1030}
1031
1032
1033###############################################################################
1034#
1035# filter_column($column, $criteria, ...)
1036#
1037# Set the column filter criteria.
1038#
1039sub filter_column {
1040
1041 my $self = shift;
1042 my $col = $_[0];
1043 my $expression = $_[1];
1044
1045
1046 croak "Must call autofilter() before filter_column()"
1047 unless $self->{_filter_count};
1048 croak "Incorrect number of arguments to filter_column()" unless @_ == 2;
1049
1050
1051 # Check for a column reference in A1 notation and substitute.
1052 if ($col =~ /^\D/) {
1053 # Convert col ref to a cell ref and then to a col number.
1054 (undef, $col) = $self->_substitute_cellref($col . '1');
1055 }
1056
1057 my (undef, undef, $col_first, $col_last) = @{$self->{_filter_area}};
1058
1059 # Reject column if it is outside filter range.
1060 if ($col < $col_first or $col > $col_last) {
1061 croak "Column '$col' outside autofilter() column range " .
1062 "($col_first .. $col_last)";
1063 }
1064
1065
1066 my @tokens = $self->_extract_filter_tokens($expression);
1067
1068 croak "Incorrect number of tokens in expression '$expression'"
1069 unless (@tokens == 3 or @tokens == 7);
1070
1071
1072 @tokens = $self->_parse_filter_expression($expression, @tokens);
1073
1074 $self->{_filter_cols}->{$col} = [@tokens];
1075 $self->{_filter_on} = 1;
1076}
1077
1078
1079###############################################################################
1080#
1081# _extract_filter_tokens($expression)
1082#
1083# Extract the tokens from the filter expression. The tokens are mainly non-
1084# whitespace groups. The only tricky part is to extract string tokens that
1085# contain whitespace and/or quoted double quotes (Excel's escaped quotes).
1086#
1087# Examples: 'x < 2000'
1088# 'x > 2000 and x < 5000'
1089# 'x = "foo"'
1090# 'x = "foo bar"'
1091# 'x = "foo "" bar"'
1092#
1093sub _extract_filter_tokens {
1094
1095 my $self = shift;
1096 my $expression = $_[0];
1097
1098 return unless $expression;
1099
1100 my @tokens = ($expression =~ /"(?:[^"]|"")*"|\S+/g); #"
1101
1102 # Remove leading and trailing quotes and unescape other quotes
1103 for (@tokens) {
1104 s/^"//; #"
1105 s/"$//; #"
1106 s/""/"/g; #"
1107 }
1108
1109 return @tokens;
1110}
1111
1112
1113###############################################################################
1114#
1115# _parse_filter_expression(@token)
1116#
1117# Converts the tokens of a possibly conditional expression into 1 or 2
1118# sub expressions for further parsing.
1119#
1120# Examples:
1121# ('x', '==', 2000) -> exp1
1122# ('x', '>', 2000, 'and', 'x', '<', 5000) -> exp1 and exp2
1123#
1124sub _parse_filter_expression {
1125
1126 my $self = shift;
1127 my $expression = shift;
1128 my @tokens = @_;
1129
1130 # The number of tokens will be either 3 (for 1 expression)
1131 # or 7 (for 2 expressions).
1132 #
1133 if (@tokens == 7) {
1134
1135 my $conditional = $tokens[3];
1136
1137 if ($conditional =~ /^(and|&&)$/) {
1138 $conditional = 0;
1139 }
1140 elsif ($conditional =~ /^(or|\|\|)$/) {
1141 $conditional = 1;
1142 }
1143 else {
1144 croak "Token '$conditional' is not a valid conditional " .
1145 "in filter expression '$expression'";
1146 }
1147
1148 my @expression_1 = $self->_parse_filter_tokens($expression,
1149 @tokens[0, 1, 2]);
1150 my @expression_2 = $self->_parse_filter_tokens($expression,
1151 @tokens[4, 5, 6]);
1152
1153 return (@expression_1, $conditional, @expression_2);
1154 }
1155 else {
1156 return $self->_parse_filter_tokens($expression, @tokens);
1157 }
1158}
1159
1160
1161###############################################################################
1162#
1163# _parse_filter_tokens(@token)
1164#
1165# Parse the 3 tokens of a filter expression and return the operator and token.
1166#
1167sub _parse_filter_tokens {
1168
1169 my $self = shift;
1170 my $expression = shift;
1171 my @tokens = @_;
1172
1173 my %operators = (
1174 '==' => 2,
1175 '=' => 2,
1176 '=~' => 2,
1177 'eq' => 2,
1178
1179 '!=' => 5,
1180 '!~' => 5,
1181 'ne' => 5,
1182 '<>' => 5,
1183
1184 '<' => 1,
1185 '<=' => 3,
1186 '>' => 4,
1187 '>=' => 6,
1188 );
1189
1190 my $operator = $operators{$tokens[1]};
1191 my $token = $tokens[2];
1192
1193
1194 # Special handling of "Top" filter expressions.
1195 if ($tokens[0] =~ /^top|bottom$/i) {
1196
1197 my $value = $tokens[1];
1198
1199 if ($value =~ /\D/ or
1200 $value < 1 or
1201 $value > 500)
1202 {
1203 croak "The value '$value' in expression '$expression' " .
1204 "must be in the range 1 to 500";
1205 }
1206
1207 $token = lc $token;
1208
1209 if ($token ne 'items' and $token ne '%') {
1210 croak "The type '$token' in expression '$expression' " .
1211 "must be either 'items' or '%'";
1212 }
1213
1214 if ($tokens[0] =~ /^top$/i) {
1215 $operator = 30;
1216 }
1217 else {
1218 $operator = 32;
1219 }
1220
1221 if ($tokens[2] eq '%') {
1222 $operator++;
1223 }
1224
1225 $token = $value;
1226 }
1227
1228
1229 if (not $operator and $tokens[0]) {
1230 croak "Token '$tokens[1]' is not a valid operator " .
1231 "in filter expression '$expression'";
1232 }
1233
1234
1235 # Special handling for Blanks/NonBlanks.
1236 if ($token =~ /^blanks|nonblanks$/i) {
1237
1238 # Only allow Equals or NotEqual in this context.
1239 if ($operator != 2 and $operator != 5) {
1240 croak "The operator '$tokens[1]' in expression '$expression' " .
1241 "is not valid in relation to Blanks/NonBlanks'";
1242 }
1243
1244 $token = lc $token;
1245
1246 # The operator should always be 2 (=) to flag a "simple" equality in
1247 # the binary record. Therefore we convert <> to =.
1248 if ($token eq 'blanks') {
1249 if ($operator == 5) {
1250 $operator = 2;
1251 $token = 'nonblanks';
1252 }
1253 }
1254 else {
1255 if ($operator == 5) {
1256 $operator = 2;
1257 $token = 'blanks';
1258 }
1259 }
1260 }
1261
1262
1263 # if the string token contains an Excel match character then change the
1264 # operator type to indicate a non "simple" equality.
1265 if ($operator == 2 and $token =~ /[*?]/) {
1266 $operator = 22;
1267 }
1268
1269
1270 return ($operator, $token);
1271}
1272
1273
1274###############################################################################
1275#
1276# hide_gridlines()
1277#
1278# Set the option to hide gridlines on the screen and the printed page.
1279# There are two ways of doing this in the Excel BIFF format: The first is by
1280# setting the DspGrid field of the WINDOW2 record, this turns off the screen
1281# and subsequently the print gridline. The second method is to via the
1282# PRINTGRIDLINES and GRIDSET records, this turns off the printed gridlines
1283# only. The first method is probably sufficient for most cases. The second
1284# method is supported for backwards compatibility. Porters take note.
1285#
1286sub hide_gridlines {
1287
1288 my $self = shift;
1289 my $option = $_[0];
1290
1291 $option = 1 unless defined $option; # Default to hiding printed gridlines
1292
1293 if ($option == 0) {
1294 $self->{_print_gridlines} = 1; # 1 = display, 0 = hide
1295 $self->{_screen_gridlines} = 1;
1296 }
1297 elsif ($option == 1) {
1298 $self->{_print_gridlines} = 0;
1299 $self->{_screen_gridlines} = 1;
1300 }
1301 else {
1302 $self->{_print_gridlines} = 0;
1303 $self->{_screen_gridlines} = 0;
1304 }
1305}
1306
1307
1308###############################################################################
1309#
1310# print_row_col_headers()
1311#
1312# Set the option to print the row and column headers on the printed page.
1313# See also the _store_print_headers() method below.
1314#
1315sub print_row_col_headers {
1316
1317 my $self = shift;
1318
1319 if (defined $_[0]) {
1320 $self->{_print_headers} = $_[0];
1321 }
1322 else {
1323 $self->{_print_headers} = 1;
1324 }
1325}
1326
1327
1328###############################################################################
1329#
1330# fit_to_pages($width, $height)
1331#
1332# Store the vertical and horizontal number of pages that will define the
1333# maximum area printed. See also _store_setup() and _store_wsbool() below.
1334#
1335sub fit_to_pages {
1336
1337 my $self = shift;
1338
1339 $self->{_fit_page} = 1;
1340 $self->{_fit_width} = $_[0] || 0;
1341 $self->{_fit_height} = $_[1] || 0;
1342}
1343
1344
1345###############################################################################
1346#
1347# set_h_pagebreaks(@breaks)
1348#
1349# Store the horizontal page breaks on a worksheet.
1350#
1351sub set_h_pagebreaks {
1352
1353 my $self = shift;
1354
1355 push @{$self->{_hbreaks}}, @_;
1356}
1357
1358
1359###############################################################################
1360#
1361# set_v_pagebreaks(@breaks)
1362#
1363# Store the vertical page breaks on a worksheet.
1364#
1365sub set_v_pagebreaks {
1366
1367 my $self = shift;
1368
1369 push @{$self->{_vbreaks}}, @_;
1370}
1371
1372
1373###############################################################################
1374#
1375# set_zoom($scale)
1376#
1377# Set the worksheet zoom factor.
1378#
1379sub set_zoom {
1380
1381 my $self = shift;
1382 my $scale = $_[0] || 100;
1383
1384 # Confine the scale to Excel's range
1385 if ($scale < 10 or $scale > 400) {
1386 carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
1387 $scale = 100;
1388 }
1389
1390 $self->{_zoom} = int $scale;
1391}
1392
1393
1394###############################################################################
1395#
1396# set_print_scale($scale)
1397#
1398# Set the scale factor for the printed page.
1399#
1400sub set_print_scale {
1401
1402 my $self = shift;
1403 my $scale = $_[0] || 100;
1404
1405 # Confine the scale to Excel's range
1406 if ($scale < 10 or $scale > 400) {
1407 carp "Print scale $scale outside range: 10 <= zoom <= 400";
1408 $scale = 100;
1409 }
1410
1411 # Turn off "fit to page" option
1412 $self->{_fit_page} = 0;
1413
1414 $self->{_print_scale} = int $scale;
1415}
1416
1417
1418###############################################################################
1419#
1420# keep_leading_zeros()
1421#
1422# Causes the write() method to treat integers with a leading zero as a string.
1423# This ensures that any leading zeros such, as in zip codes, are maintained.
1424#
1425sub keep_leading_zeros {
1426
1427 my $self = shift;
1428
1429 if (defined $_[0]) {
1430 $self->{_leading_zeros} = $_[0];
1431 }
1432 else {
1433 $self->{_leading_zeros} = 1;
1434 }
1435}
1436
1437
1438###############################################################################
1439#
1440# show_comments()
1441#
1442# Make any comments in the worksheet visible.
1443#
1444sub show_comments {
1445
1446 my $self = shift;
1447
1448 $self->{_comments_visible} = defined $_[0] ? $_[0] : 1;
1449}
1450
1451
1452###############################################################################
1453#
1454# set_comments_author()
1455#
1456# Set the default author of the cell comments.
1457#
1458sub set_comments_author {
1459
1460 my $self = shift;
1461
1462 $self->{_comments_author} = defined $_[0] ? $_[0] : '';
1463 $self->{_comments_author_enc} = $_[1] ? 1 : 0;
1464}
1465
1466
1467###############################################################################
1468#
1469# right_to_left()
1470#
1471# Display the worksheet right to left for some eastern versions of Excel.
1472#
1473sub right_to_left {
1474
1475 my $self = shift;
1476
1477 $self->{_display_arabic} = defined $_[0] ? $_[0] : 1;
1478}
1479
1480
1481###############################################################################
1482#
1483# hide_zero()
1484#
1485# Hide cell zero values.
1486#
1487sub hide_zero {
1488
1489 my $self = shift;
1490
1491 $self->{_display_zeros} = defined $_[0] ? not $_[0] : 0;
1492}
1493
1494
1495###############################################################################
1496#
1497# print_across()
1498#
1499# Set the order in which pages are printed.
1500#
1501sub print_across {
1502
1503 my $self = shift;
1504
1505 $self->{_page_order} = defined $_[0] ? $_[0] : 1;
1506}
1507
1508
1509###############################################################################
1510#
1511# set_start_page()
1512#
1513# Set the start page number.
1514#
1515sub set_start_page {
1516
1517 my $self = shift;
1518 return unless defined $_[0];
1519
1520 $self->{_page_start} = $_[0];
1521 $self->{_custom_start} = 1;
1522}
1523
1524
1525###############################################################################
1526#
1527# set_first_row_column()
1528#
1529# Set the topmost and leftmost visible row and column.
1530# TODO: Document this when tested fully for interaction with panes.
1531#
1532sub set_first_row_column {
1533
1534 my $self = shift;
1535
1536 my $row = $_[0] || 0;
1537 my $col = $_[1] || 0;
1538
1539 $row = 65535 if $row > 65535;
1540 $col = 255 if $col > 255;
1541
1542 $self->{_first_row} = $row;
1543 $self->{_first_col} = $col;
1544}
1545
1546
1547###############################################################################
1548#
1549# add_write_handler($re, $code_ref)
1550#
1551# Allow the user to add their own matches and handlers to the write() method.
1552#
1553sub add_write_handler {
1554
1555 my $self = shift;
1556
1557 return unless @_ == 2;
1558 return unless ref $_[1] eq 'CODE';
1559
1560 push @{$self->{_write_match}}, [ @_ ];
1561}
1562
1563
1564
1565###############################################################################
1566#
1567# write($row, $col, $token, $format)
1568#
1569# Parse $token and call appropriate write method. $row and $column are zero
1570# indexed. $format is optional.
1571#
1572# The write_url() methods have a flag to prevent recursion when writing a
1573# string that looks like a url.
1574#
1575# Returns: return value of called subroutine
1576#
1577sub write {
1578
1579 my $self = shift;
1580
1581 # Check for a cell reference in A1 notation and substitute row and column
1582 if ($_[0] =~ /^\D/) {
1583 @_ = $self->_substitute_cellref(@_);
1584 }
1585
1586 my $token = $_[2];
1587
1588 # Handle undefs as blanks
1589 $token = '' unless defined $token;
1590
1591
1592 # First try user defined matches.
1593 for my $aref (@{$self->{_write_match}}) {
1594 my $re = $aref->[0];
1595 my $sub = $aref->[1];
1596
1597 if ($token =~ /$re/) {
1598 my $match = &$sub($self, @_);
1599 return $match if defined $match;
1600 }
1601 }
1602
1603
1604 # Match an array ref.
1605 if (ref $token eq "ARRAY") {
1606 return $self->write_row(@_);
1607 }
1608 # Match integer with leading zero(s)
1609 elsif ($self->{_leading_zeros} and $token =~ /^0\d+$/) {
1610 return $self->write_string(@_);
1611 }
1612 # Match number
1613 elsif ($token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
1614 return $self->write_number(@_);
1615 }
1616 # Match http, https or ftp URL
1617 elsif ($token =~ m|^[fh]tt?ps?://| and not $self->{_writing_url}) {
1618 return $self->write_url(@_);
1619 }
1620 # Match mailto:
1621 elsif ($token =~ m/^mailto:/ and not $self->{_writing_url}) {
1622 return $self->write_url(@_);
1623 }
1624 # Match internal or external sheet link
1625 elsif ($token =~ m[^(?:in|ex)ternal:] and not $self->{_writing_url}) {
1626 return $self->write_url(@_);
1627 }
1628 # Match formula
1629 elsif ($token =~ /^=/) {
1630 return $self->write_formula(@_);
1631 }
1632 # Match blank
1633 elsif ($token eq '') {
1634 splice @_, 2, 1; # remove the empty string from the parameter list
1635 return $self->write_blank(@_);
1636 }
1637 else {
1638 return $self->write_string(@_);
1639 }
1640}
1641
1642
1643###############################################################################
1644#
1645# write_row($row, $col, $array_ref, $format)
1646#
1647# Write a row of data starting from ($row, $col). Call write_col() if any of
1648# the elements of the array ref are in turn array refs. This allows the writing
1649# of 1D or 2D arrays of data in one go.
1650#
1651# Returns: the first encountered error value or zero for no errors
1652#
1653sub write_row {
1654
1655 my $self = shift;
1656
1657
1658 # Check for a cell reference in A1 notation and substitute row and column
1659 if ($_[0] =~ /^\D/) {
1660 @_ = $self->_substitute_cellref(@_);
1661 }
1662
1663 # Catch non array refs passed by user.
1664 if (ref $_[2] ne 'ARRAY') {
1665 croak "Not an array ref in call to write_row()$!";
1666 }
1667
1668 my $row = shift;
1669 my $col = shift;
1670 my $tokens = shift;
1671 my @options = @_;
1672 my $error = 0;
1673 my $ret;
1674
1675 foreach my $token (@$tokens) {
1676
1677 # Check for nested arrays
1678 if (ref $token eq "ARRAY") {
1679 $ret = $self->write_col($row, $col, $token, @options);
1680 } else {
1681 $ret = $self->write ($row, $col, $token, @options);
1682 }
1683
1684 # Return only the first error encountered, if any.
1685 $error ||= $ret;
1686 $col++;
1687 }
1688
1689 return $error;
1690}
1691
1692
1693###############################################################################
1694#
1695# write_col($row, $col, $array_ref, $format)
1696#
1697# Write a column of data starting from ($row, $col). Call write_row() if any of
1698# the elements of the array ref are in turn array refs. This allows the writing
1699# of 1D or 2D arrays of data in one go.
1700#
1701# Returns: the first encountered error value or zero for no errors
1702#
1703sub write_col {
1704
1705 my $self = shift;
1706
1707
1708 # Check for a cell reference in A1 notation and substitute row and column
1709 if ($_[0] =~ /^\D/) {
1710 @_ = $self->_substitute_cellref(@_);
1711 }
1712
1713 # Catch non array refs passed by user.
1714 if (ref $_[2] ne 'ARRAY') {
1715 croak "Not an array ref in call to write_row()$!";
1716 }
1717
1718 my $row = shift;
1719 my $col = shift;
1720 my $tokens = shift;
1721 my @options = @_;
1722 my $error = 0;
1723 my $ret;
1724
1725 foreach my $token (@$tokens) {
1726
1727 # write() will deal with any nested arrays
1728 $ret = $self->write($row, $col, $token, @options);
1729
1730 # Return only the first error encountered, if any.
1731 $error ||= $ret;
1732 $row++;
1733 }
1734
1735 return $error;
1736}
1737
1738
1739###############################################################################
1740#
1741# write_comment($row, $col, $comment)
1742#
1743# Write a comment to the specified row and column (zero indexed).
1744#
1745# Returns 0 : normal termination
1746# -1 : insufficient number of arguments
1747# -2 : row or column out of range
1748#
1749sub write_comment {
1750
1751 my $self = shift;
1752
1753
1754 # Check for a cell reference in A1 notation and substitute row and column
1755 if ($_[0] =~ /^\D/) {
1756 @_ = $self->_substitute_cellref(@_);
1757 }
1758
1759 if (@_ < 3) { return -1 } # Check the number of args
1760
1761
1762 my $row = $_[0];
1763 my $col = $_[1];
1764
1765 # Check for pairs of optional arguments, i.e. an odd number of args.
1766 croak "Uneven number of additional arguments" unless @_ % 2;
1767
1768
1769 # Check that row and col are valid and store max and min values
1770 return -2 if $self->_check_dimensions($row, $col);
1771
1772
1773 # We have to avoid duplicate comments in cells or else Excel will complain.
1774 $self->{_comments}->{$row}->{$col} = [ $self->_comment_params(@_) ];
1775
1776}
1777
1778
1779###############################################################################
1780#
1781# _XF()
1782#
1783# Returns an index to the XF record in the workbook.
1784#
1785# Note: this is a function, not a method.
1786#
1787sub _XF {
1788
1789 my $self = $_[0];
1790 my $row = $_[1];
1791 my $col = $_[2];
1792 my $format = $_[3];
1793
1794 my $error = "Error: refer to merge_range() in the documentation. " .
1795 "Can't use previously merged format in non-merged cell";
1796
1797 if (ref($format)) {
1798 # Temp code to prevent merged formats in non-merged cells.
1799 croak $error if $format->{_used_merge} == 1;
1800 $format->{_used_merge} = -1;
1801
1802 return $format->get_xf_index();
1803 }
1804 elsif (exists $self->{_row_formats}->{$row}) {
1805 # Temp code to prevent merged formats in non-merged cells.
1806 croak $error if $self->{_row_formats}->{$row}->{_used_merge} == 1;
1807 $self->{_row_formats}->{$row}->{_used_merge} = -1;
1808
1809 return $self->{_row_formats}->{$row}->get_xf_index();
1810 }
1811 elsif (exists $self->{_col_formats}->{$col}) {
1812 # Temp code to prevent merged formats in non-merged cells.
1813 croak $error if $self->{_col_formats}->{$col}->{_used_merge} == 1;
1814 $self->{_col_formats}->{$col}->{_used_merge} = -1;
1815
1816 return $self->{_col_formats}->{$col}->get_xf_index();
1817 }
1818 else {
1819 return 0x0F;
1820 }
1821}
1822
1823
1824###############################################################################
1825###############################################################################
1826#
1827# Internal methods
1828#
1829
1830
1831###############################################################################
1832#
1833# _append(), overridden.
1834#
1835# Store Worksheet data in memory using the base class _append() or to a
1836# temporary file, the default.
1837#
1838sub _append {
1839
1840 my $self = shift;
1841 my $data = '';
1842
1843 if ($self->{_using_tmpfile}) {
1844 $data = join('', @_);
1845
1846 # Add CONTINUE records if necessary
1847 $data = $self->_add_continue($data) if length($data) > $self->{_limit};
1848
1849 # Protect print() from -l on the command line.
1850 local $\ = undef;
1851
1852 print {$self->{_filehandle}} $data;
1853 $self->{_datasize} += length($data);
1854 }
1855 else {
1856 $data = $self->SUPER::_append(@_);
1857 }
1858
1859 return $data;
1860}
1861
1862
1863###############################################################################
1864#
1865# _substitute_cellref()
1866#
1867# Substitute an Excel cell reference in A1 notation for zero based row and
1868# column values in an argument list.
1869#
1870# Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
1871#
1872sub _substitute_cellref {
1873
1874 my $self = shift;
1875 my $cell = uc(shift);
1876
1877 # Convert a column range: 'A:A' or 'B:G'.
1878 # A range such as A:A is equivalent to A1:65536, so add rows as required
1879 if ($cell =~ /\$?([A-I]?[A-Z]):\$?([A-I]?[A-Z])/) {
1880 my ($row1, $col1) = $self->_cell_to_rowcol($1 .'1');
1881 my ($row2, $col2) = $self->_cell_to_rowcol($2 .'65536');
1882 return $row1, $col1, $row2, $col2, @_;
1883 }
1884
1885 # Convert a cell range: 'A1:B7'
1886 if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+):\$?([A-I]?[A-Z]\$?\d+)/) {
1887 my ($row1, $col1) = $self->_cell_to_rowcol($1);
1888 my ($row2, $col2) = $self->_cell_to_rowcol($2);
1889 return $row1, $col1, $row2, $col2, @_;
1890 }
1891
1892 # Convert a cell reference: 'A1' or 'AD2000'
1893 if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+)/) {
1894 my ($row1, $col1) = $self->_cell_to_rowcol($1);
1895 return $row1, $col1, @_;
1896
1897 }
1898
1899 croak("Unknown cell reference $cell");
1900}
1901
1902
1903###############################################################################
1904#
1905# _cell_to_rowcol($cell_ref)
1906#
1907# Convert an Excel cell reference in A1 notation to a zero based row and column
1908# reference; converts C1 to (0, 2).
1909#
1910# Returns: row, column
1911#
1912sub _cell_to_rowcol {
1913
1914 my $self = shift;
1915 my $cell = shift;
1916
1917 $cell =~ /\$?([A-I]?[A-Z])\$?(\d+)/;
1918
1919 my $col = $1;
1920 my $row = $2;
1921
1922 # Convert base26 column string to number
1923 # All your Base are belong to us.
1924 my @chars = split //, $col;
1925 my $expn = 0;
1926 $col = 0;
1927
1928 while (@chars) {
1929 my $char = pop(@chars); # LS char first
1930 $col += (ord($char) -ord('A') +1) * (26**$expn);
1931 $expn++;
1932 }
1933
1934 # Convert 1-index to zero-index
1935 $row--;
1936 $col--;
1937
1938 return $row, $col;
1939}
1940
1941
1942###############################################################################
1943#
1944# _sort_pagebreaks()
1945#
1946#
1947# This is an internal method that is used to filter elements of the array of
1948# pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
1949# 1. Removes duplicate entries from the list.
1950# 2. Sorts the list.
1951# 3. Removes 0 from the list if present.
1952#
1953sub _sort_pagebreaks {
1954
1955 my $self= shift;
1956
1957 my %hash;
1958 my @array;
1959
1960 @hash{@_} = undef; # Hash slice to remove duplicates
1961 @array = sort {$a <=> $b} keys %hash; # Numerical sort
1962 shift @array if $array[0] == 0; # Remove zero
1963
1964 # 1000 vertical pagebreaks appears to be an internal Excel 5 limit.
1965 # It is slightly higher in Excel 97/200, approx. 1026
1966 splice(@array, 1000) if (@array > 1000);
1967
1968 return @array
1969}
1970
1971
1972###############################################################################
1973#
1974# _encode_password($password)
1975#
1976# Based on the algorithm provided by Daniel Rentz of OpenOffice.
1977#
1978#
1979sub _encode_password {
1980
1981 use integer;
1982
1983 my $self = shift;
1984 my $plaintext = $_[0];
1985 my $password;
1986 my $count;
1987 my @chars;
1988 my $i = 0;
1989
1990 $count = @chars = split //, $plaintext;
1991
1992 foreach my $char (@chars) {
1993 my $low_15;
1994 my $high_15;
1995 $char = ord($char) << ++$i;
1996 $low_15 = $char & 0x7fff;
1997 $high_15 = $char & 0x7fff << 15;
1998 $high_15 = $high_15 >> 15;
1999 $char = $low_15 | $high_15;
2000 }
2001
2002 $password = 0x0000;
2003 $password ^= $_ for @chars;
2004 $password ^= $count;
2005 $password ^= 0xCE4B;
2006
2007 return $password;
2008}
2009
2010
2011###############################################################################
2012#
2013# outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
2014#
2015# This method sets the properties for outlining and grouping. The defaults
2016# correspond to Excel's defaults.
2017#
2018sub outline_settings {
2019
2020 my $self = shift;
2021
2022 $self->{_outline_on} = defined $_[0] ? $_[0] : 1;
2023 $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
2024 $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
2025 $self->{_outline_style} = $_[3] || 0;
2026
2027 # Ensure this is a boolean vale for Window2
2028 $self->{_outline_on} = 1 if $self->{_outline_on};
2029}
2030
2031
2032
2033
2034###############################################################################
2035###############################################################################
2036#
2037# BIFF RECORDS
2038#
2039
2040
2041###############################################################################
2042#
2043# write_number($row, $col, $num, $format)
2044#
2045# Write a double to the specified row and column (zero indexed).
2046# An integer can be written as a double. Excel will display an
2047# integer. $format is optional.
2048#
2049# Returns 0 : normal termination
2050# -1 : insufficient number of arguments
2051# -2 : row or column out of range
2052#
2053sub write_number {
2054
2055 my $self = shift;
2056
2057 # Check for a cell reference in A1 notation and substitute row and column
2058 if ($_[0] =~ /^\D/) {
2059 @_ = $self->_substitute_cellref(@_);
2060 }
2061
2062 if (@_ < 3) { return -1 } # Check the number of args
2063
2064 my $record = 0x0203; # Record identifier
2065 my $length = 0x000E; # Number of bytes to follow
2066
2067 my $row = $_[0]; # Zero indexed row
2068 my $col = $_[1]; # Zero indexed column
2069 my $num = $_[2];
2070 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
2071
2072 # Check that row and col are valid and store max and min values
2073 return -2 if $self->_check_dimensions($row, $col);
2074
2075 my $header = pack("vv", $record, $length);
2076 my $data = pack("vvv", $row, $col, $xf);
2077 my $xl_double = pack("d", $num);
2078
2079 if ($self->{_byte_order}) { $xl_double = reverse $xl_double }
2080
2081 # Store the data or write immediately depending on the compatibility mode.
2082 if ($self->{_compatibility}) {
2083 $self->{_table}->[$row]->[$col] = $header . $data . $xl_double;
2084 }
2085 else {
2086 $self->_append($header, $data, $xl_double);
2087 }
2088
2089 return 0;
2090}
2091
2092
2093###############################################################################
2094#
2095# write_string ($row, $col, $string, $format)
2096#
2097# Write a string to the specified row and column (zero indexed).
2098# NOTE: there is an Excel 5 defined limit of 255 characters.
2099# $format is optional.
2100# Returns 0 : normal termination
2101# -1 : insufficient number of arguments
2102# -2 : row or column out of range
2103# -3 : long string truncated to 255 chars
2104#
2105sub write_string {
2106
2107 my $self = shift;
2108
2109 # Check for a cell reference in A1 notation and substitute row and column
2110 if ($_[0] =~ /^\D/) {
2111 @_ = $self->_substitute_cellref(@_);
2112 }
2113
2114 if (@_ < 3) { return -1 } # Check the number of args
2115
2116 my $record = 0x00FD; # Record identifier
2117 my $length = 0x000A; # Bytes to follow
2118
2119 my $row = $_[0]; # Zero indexed row
2120 my $col = $_[1]; # Zero indexed column
2121 my $strlen = length($_[2]);
2122 my $str = $_[2];
2123 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
2124 my $encoding = 0x0;
2125 my $str_error = 0;
2126
2127
2128 # Handle utf8 strings in perl 5.8.
2129 if ($] >= 5.008) {
2130 require Encode;
2131
2132 if (Encode::is_utf8($str)) {
2133 my $tmp = Encode::encode("UTF-16LE", $str);
2134 return $self->write_utf16le_string($row, $col, $tmp, $_[3]);
2135 }
2136 }
2137
2138
2139 # Check that row and col are valid and store max and min values
2140 return -2 if $self->_check_dimensions($row, $col);
2141
2142 # Limit the string to the max number of chars.
2143 if ($strlen > 32767) {
2144 $str = substr($str, 0, 32767);
2145 $str_error = -3;
2146 }
2147
2148
2149 # Prepend the string with the type.
2150 my $str_header = pack("vC", length($str), $encoding);
2151 $str = $str_header . $str;
2152
2153
2154 if (not exists ${$self->{_str_table}}->{$str}) {
2155 ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
2156 }
2157
2158
2159 ${$self->{_str_total}}++;
2160
2161
2162 my $header = pack("vv", $record, $length);
2163 my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
2164
2165
2166 # Store the data or write immediately depending on the compatibility mode.
2167 if ($self->{_compatibility}) {
2168 $self->{_table}->[$row]->[$col] = $header . $data;
2169 }
2170 else {
2171 $self->_append($header, $data);
2172 }
2173
2174 return $str_error;
2175}
2176
2177
2178###############################################################################
2179#
2180# write_blank($row, $col, $format)
2181#
2182# Write a blank cell to the specified row and column (zero indexed).
2183# A blank cell is used to specify formatting without adding a string
2184# or a number.
2185#
2186# A blank cell without a format serves no purpose. Therefore, we don't write
2187# a BLANK record unless a format is specified. This is mainly an optimisation
2188# for the write_row() and write_col() methods.
2189#
2190# Returns 0 : normal termination (including no format)
2191# -1 : insufficient number of arguments
2192# -2 : row or column out of range
2193#
2194sub write_blank {
2195
2196 my $self = shift;
2197
2198 # Check for a cell reference in A1 notation and substitute row and column
2199 if ($_[0] =~ /^\D/) {
2200 @_ = $self->_substitute_cellref(@_);
2201 }
2202
2203 # Check the number of args
2204 return -1 if @_ < 2;
2205
2206 # Don't write a blank cell unless it has a format
2207 return 0 if not defined $_[2];
2208
2209
2210 my $record = 0x0201; # Record identifier
2211 my $length = 0x0006; # Number of bytes to follow
2212
2213 my $row = $_[0]; # Zero indexed row
2214 my $col = $_[1]; # Zero indexed column
2215 my $xf = _XF($self, $row, $col, $_[2]); # The cell format
2216
2217 # Check that row and col are valid and store max and min values
2218 return -2 if $self->_check_dimensions($row, $col);
2219
2220 my $header = pack("vv", $record, $length);
2221 my $data = pack("vvv", $row, $col, $xf);
2222
2223 # Store the data or write immediately depending on the compatibility mode.
2224 if ($self->{_compatibility}) {
2225 $self->{_table}->[$row]->[$col] = $header . $data;
2226 }
2227 else {
2228 $self->_append($header, $data);
2229 }
2230
2231 return 0;
2232}
2233
2234
2235###############################################################################
2236#
2237# write_formula($row, $col, $formula, $format, $value)
2238#
2239# Write a formula to the specified row and column (zero indexed).
2240# The textual representation of the formula is passed to the parser in
2241# Formula.pm which returns a packed binary string.
2242#
2243# $format is optional.
2244#
2245# $value is an optional result of the formula that can be supplied by the user.
2246#
2247# Returns 0 : normal termination
2248# -1 : insufficient number of arguments
2249# -2 : row or column out of range
2250#
2251sub write_formula {
2252
2253 my $self = shift;
2254
2255 # Check for a cell reference in A1 notation and substitute row and column
2256 if ($_[0] =~ /^\D/) {
2257 @_ = $self->_substitute_cellref(@_);
2258 }
2259
2260 if (@_ < 3) { return -1 } # Check the number of args
2261
2262 my $record = 0x0006; # Record identifier
2263 my $length; # Bytes to follow
2264
2265 my $row = $_[0]; # Zero indexed row
2266 my $col = $_[1]; # Zero indexed column
2267 my $formula = $_[2]; # The formula text string
2268 my $value = $_[4]; # The formula text string
2269
2270
2271 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
2272 my $chn = 0x0000; # Must be zero
2273 my $is_string = 0; # Formula evaluates to str
2274 my $num; # Current value of formula
2275 my $grbit; # Option flags
2276
2277
2278 # Excel normally stores the last calculated value of the formula in $num.
2279 # Clearly we are not in a position to calculate this "a priori". Instead
2280 # we set $num to zero and set the option flags in $grbit to ensure
2281 # automatic calculation of the formula when the file is opened.
2282 # As a workaround for some non-Excel apps we also allow the user to
2283 # specify the result of the formula.
2284 #
2285 ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
2286
2287
2288 # Check that row and col are valid and store max and min values
2289 return -2 if $self->_check_dimensions($row, $col);
2290
2291 # Strip the = sign at the beginning of the formula string
2292 $formula =~ s(^=)();
2293
2294 my $tmp = $formula;
2295
2296 # Parse the formula using the parser in Formula.pm
2297 my $parser = $self->{_parser};
2298
2299 # In order to raise formula errors from the point of view of the calling
2300 # program we use an eval block and re-raise the error from here.
2301 #
2302 eval { $formula = $parser->parse_formula($formula) };
2303
2304 if ($@) {
2305 $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
2306 croak $@; # Re-raise the error
2307 }
2308
2309
2310 my $formlen = length($formula); # Length of the binary string
2311 $length = 0x16 + $formlen; # Length of the record data
2312
2313 my $header = pack("vv", $record, $length);
2314 my $data = pack("vvv", $row, $col, $xf);
2315 $data .= $num;
2316 $data .= pack("vVv", $grbit, $chn, $formlen);
2317
2318 # The STRING record if the formula evaluates to a string.
2319 my $string = '';
2320 $string = $self->_get_formula_string($value) if $is_string;
2321
2322
2323 # Store the data or write immediately depending on the compatibility mode.
2324 if ($self->{_compatibility}) {
2325 $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
2326 }
2327 else {
2328 $self->_append($header, $data, $formula, $string);
2329 }
2330
2331 return 0;
2332}
2333
2334
2335###############################################################################
2336#
2337# _encode_formula_result()
2338#
2339# Encode the user supplied result for a formula.
2340#
2341sub _encode_formula_result {
2342
2343 my $self = shift;
2344
2345 my $value = $_[0]; # Result to be encoded.
2346 my $is_string = 0; # Formula evaluates to str.
2347 my $num; # Current value of formula.
2348 my $grbit; # Option flags.
2349
2350 if (not defined $value) {
2351 $grbit = 0x03;
2352 $num = pack "d", 0;
2353 }
2354 else {
2355 # The user specified the result of the formula. We turn off the recalc
2356 # flag and check the result type.
2357 $grbit = 0x00;
2358
2359 if ($value =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
2360 # Value is a number.
2361 $num = pack "d", $value;
2362 }
2363 else {
2364
2365 my %bools = (
2366 'TRUE' => [1, 1],
2367 'FALSE' => [1, 0],
2368 '#NULL!' => [2, 0],
2369 '#DIV/0!' => [2, 7],
2370 '#VALUE!' => [2, 15],
2371 '#REF!' => [2, 23],
2372 '#NAME?' => [2, 29],
2373 '#NUM!' => [2, 36],
2374 '#N/A' => [2, 42],
2375 );
2376
2377 if (exists $bools{$value}) {
2378 # Value is a boolean.
2379 $num = pack "vvvv", $bools{$value}->[0],
2380 $bools{$value}->[1],
2381 0,
2382 0xFFFF;
2383 }
2384 else {
2385 # Value is a string.
2386 $num = pack "vvvv", 0,
2387 0,
2388 0,
2389 0xFFFF;
2390 $is_string = 1;
2391 }
2392 }
2393 }
2394
2395 return ($num, $grbit, $is_string);
2396}
2397
2398
2399###############################################################################
2400#
2401# _get_formula_string()
2402#
2403# Pack the string value when a formula evaluates to a string. The value cannot
2404# be calculated by the module and thus must be supplied by the user.
2405#
2406sub _get_formula_string {
2407
2408 my $self = shift;
2409
2410 my $record = 0x0207; # Record identifier
2411 my $length = 0x00; # Bytes to follow
2412 my $string = $_[0]; # Formula string.
2413 my $strlen = length $_[0]; # Length of the formula string (chars).
2414 my $encoding = 0; # String encoding.
2415
2416
2417 # Handle utf8 strings in perl 5.8.
2418 if ($] >= 5.008) {
2419 require Encode;
2420
2421 if (Encode::is_utf8($string)) {
2422 $string = Encode::encode("UTF-16BE", $string);
2423 $encoding = 1;
2424 }
2425 }
2426
2427
2428 $length = 0x03 + length $string; # Length of the record data
2429
2430 my $header = pack("vv", $record, $length);
2431 my $data = pack("vC", $strlen, $encoding);
2432
2433 return $header . $data . $string;
2434}
2435
2436
2437###############################################################################
2438#
2439# store_formula($formula)
2440#
2441# Pre-parse a formula. This is used in conjunction with repeat_formula()
2442# to repetitively rewrite a formula without re-parsing it.
2443#
2444sub store_formula {
2445
2446 my $self = shift;
2447 my $formula = $_[0]; # The formula text string
2448
2449 # Strip the = sign at the beginning of the formula string
2450 $formula =~ s(^=)();
2451
2452 # Parse the formula using the parser in Formula.pm
2453 my $parser = $self->{_parser};
2454
2455 # In order to raise formula errors from the point of view of the calling
2456 # program we use an eval block and re-raise the error from here.
2457 #
2458 my @tokens;
2459 eval { @tokens = $parser->parse_formula($formula) };
2460
2461 if ($@) {
2462 $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
2463 croak $@; # Re-raise the error
2464 }
2465
2466
2467 # Return the parsed tokens in an anonymous array
2468 return [@tokens];
2469}
2470
2471
2472###############################################################################
2473#
2474# repeat_formula($row, $col, $formula, $format, ($pattern => $replacement,...))
2475#
2476# Write a formula to the specified row and column (zero indexed) by
2477# substituting $pattern $replacement pairs in the $formula created via
2478# store_formula(). This allows the user to repetitively rewrite a formula
2479# without the significant overhead of parsing.
2480#
2481# Returns 0 : normal termination
2482# -1 : insufficient number of arguments
2483# -2 : row or column out of range
2484#
2485sub repeat_formula {
2486
2487 my $self = shift;
2488
2489 # Check for a cell reference in A1 notation and substitute row and column
2490 if ($_[0] =~ /^\D/) {
2491 @_ = $self->_substitute_cellref(@_);
2492 }
2493
2494 if (@_ < 2) { return -1 } # Check the number of args
2495
2496 my $record = 0x0006; # Record identifier
2497 my $length; # Bytes to follow
2498
2499 my $row = shift; # Zero indexed row
2500 my $col = shift; # Zero indexed column
2501 my $formula_ref = shift; # Array ref with formula tokens
2502 my $format = shift; # XF format
2503 my @pairs = @_; # Pattern/replacement pairs
2504
2505
2506 # Enforce an even number of arguments in the pattern/replacement list
2507 croak "Odd number of elements in pattern/replacement list" if @pairs %2;
2508
2509 # Check that $formula is an array ref
2510 croak "Not a valid formula" if ref $formula_ref ne 'ARRAY';
2511
2512 my @tokens = @$formula_ref;
2513
2514 # Ensure that there are tokens to substitute
2515 croak "No tokens in formula" unless @tokens;
2516
2517
2518 # As a temporary and undocumented measure we allow the user to specify the
2519 # result of the formula by appending a result => $value pair to the end
2520 # of the arguments.
2521 my $value = undef;
2522 if ($pairs[-2] eq 'result') {
2523 $value = pop @pairs;
2524 pop @pairs;
2525 }
2526
2527
2528 while (@pairs) {
2529 my $pattern = shift @pairs;
2530 my $replace = shift @pairs;
2531
2532 foreach my $token (@tokens) {
2533 last if $token =~ s/$pattern/$replace/;
2534 }
2535 }
2536
2537
2538 # Change the parameters in the formula cached by the Formula.pm object
2539 my $parser = $self->{_parser};
2540 my $formula = $parser->parse_tokens(@tokens);
2541
2542 croak "Unrecognised token in formula" unless defined $formula;
2543
2544
2545 my $xf = _XF($self, $row, $col, $format); # The cell format
2546 my $chn = 0x0000; # Must be zero
2547 my $is_string = 0; # Formula evaluates to str
2548 my $num; # Current value of formula
2549 my $grbit; # Option flags
2550
2551 # Excel normally stores the last calculated value of the formula in $num.
2552 # Clearly we are not in a position to calculate this "a priori". Instead
2553 # we set $num to zero and set the option flags in $grbit to ensure
2554 # automatic calculation of the formula when the file is opened.
2555 # As a workaround for some non-Excel apps we also allow the user to
2556 # specify the result of the formula.
2557 #
2558 ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
2559
2560 # Check that row and col are valid and store max and min values
2561 return -2 if $self->_check_dimensions($row, $col);
2562
2563
2564 my $formlen = length($formula); # Length of the binary string
2565 $length = 0x16 + $formlen; # Length of the record data
2566
2567 my $header = pack("vv", $record, $length);
2568 my $data = pack("vvv", $row, $col, $xf);
2569 $data .= $num;
2570 $data .= pack("vVv", $grbit, $chn, $formlen);
2571
2572
2573 # The STRING record if the formula evaluates to a string.
2574 my $string = '';
2575 $string = $self->_get_formula_string($value) if $is_string;
2576
2577
2578 # Store the data or write immediately depending on the compatibility mode.
2579 if ($self->{_compatibility}) {
2580 $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
2581 }
2582 else {
2583 $self->_append($header, $data, $formula, $string);
2584 }
2585
2586 return 0;
2587}
2588
2589
2590###############################################################################
2591#
2592# write_url($row, $col, $url, $string, $format)
2593#
2594# Write a hyperlink. This is comprised of two elements: the visible label and
2595# the invisible link. The visible label is the same as the link unless an
2596# alternative string is specified.
2597#
2598# The parameters $string and $format are optional and their order is
2599# interchangeable for backward compatibility reasons.
2600#
2601# The hyperlink can be to a http, ftp, mail, internal sheet, or external
2602# directory url.
2603#
2604# Returns 0 : normal termination
2605# -1 : insufficient number of arguments
2606# -2 : row or column out of range
2607# -3 : long string truncated to 255 chars
2608#
2609sub write_url {
2610
2611 my $self = shift;
2612
2613 # Check for a cell reference in A1 notation and substitute row and column
2614 if ($_[0] =~ /^\D/) {
2615 @_ = $self->_substitute_cellref(@_);
2616 }
2617
2618 # Check the number of args
2619 return -1 if @_ < 3;
2620
2621 # Add start row and col to arg list
2622 return $self->write_url_range($_[0], $_[1], @_);
2623}
2624
2625
2626###############################################################################
2627#
2628# write_url_range($row1, $col1, $row2, $col2, $url, $string, $format)
2629#
2630# This is the more general form of write_url(). It allows a hyperlink to be
2631# written to a range of cells. This function also decides the type of hyperlink
2632# to be written. These are either, Web (http, ftp, mailto), Internal
2633# (Sheet1!A1) or external ('c:\temp\foo.xls#Sheet1!A1').
2634#
2635# See also write_url() above for a general description and return values.
2636#
2637sub write_url_range {
2638
2639 my $self = shift;
2640
2641 # Check for a cell reference in A1 notation and substitute row and column
2642 if ($_[0] =~ /^\D/) {
2643 @_ = $self->_substitute_cellref(@_);
2644 }
2645
2646 # Check the number of args
2647 return -1 if @_ < 5;
2648
2649
2650 # Reverse the order of $string and $format if necessary. We work on a copy
2651 # in order to protect the callers args. We don't use "local @_" in case of
2652 # perl50005 threads.
2653 #
2654 my @args = @_;
2655
2656 ($args[5], $args[6]) = ($args[6], $args[5]) if ref $args[5];
2657
2658 my $url = $args[4];
2659
2660
2661 # Check for internal/external sheet links or default to web link
2662 return $self->_write_url_internal(@args) if $url =~ m[^internal:];
2663 return $self->_write_url_external(@args) if $url =~ m[^external:];
2664 return $self->_write_url_web(@args);
2665}
2666
2667
2668###############################################################################
2669#
2670# _write_url_web($row1, $col1, $row2, $col2, $url, $string, $format)
2671#
2672# Used to write http, ftp and mailto hyperlinks.
2673# The link type ($options) is 0x03 is the same as absolute dir ref without
2674# sheet. However it is differentiated by the $unknown2 data stream.
2675#
2676# See also write_url() above for a general description and return values.
2677#
2678sub _write_url_web {
2679
2680 my $self = shift;
2681
2682 my $record = 0x01B8; # Record identifier
2683 my $length = 0x00000; # Bytes to follow
2684
2685 my $row1 = $_[0]; # Start row
2686 my $col1 = $_[1]; # Start column
2687 my $row2 = $_[2]; # End row
2688 my $col2 = $_[3]; # End column
2689 my $url = $_[4]; # URL string
2690 my $str = $_[5]; # Alternative label
2691 my $xf = $_[6] || $self->{_url_format};# The cell format
2692
2693
2694 # Write the visible label but protect against url recursion in write().
2695 $str = $url unless defined $str;
2696 $self->{_writing_url} = 1;
2697 my $error = $self->write($row1, $col1, $str, $xf);
2698 $self->{_writing_url} = 0;
2699 return $error if $error == -2;
2700
2701
2702 # Pack the undocumented parts of the hyperlink stream
2703 my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
2704 my $unknown2 = pack("H*", "E0C9EA79F9BACE118C8200AA004BA90B");
2705
2706
2707 # Pack the option flags
2708 my $options = pack("V", 0x03);
2709
2710
2711 # URL encoding.
2712 my $encoding = 0;
2713
2714 # Convert an Utf8 URL type and to a null terminated wchar string.
2715 if ($] >= 5.008) {
2716 require Encode;
2717
2718 if (Encode::is_utf8($url)) {
2719 $url = Encode::encode("UTF-16LE", $url);
2720 $url .= "\0\0"; # URL is null terminated.
2721 $encoding = 1;
2722 }
2723 }
2724
2725 # Convert an Ascii URL type and to a null terminated wchar string.
2726 if ($encoding == 0) {
2727 $url .= "\0";
2728 $url = pack 'v*', unpack 'c*', $url;
2729 }
2730
2731
2732 # Pack the length of the URL
2733 my $url_len = pack("V", length($url));
2734
2735
2736 # Calculate the data length
2737 $length = 0x34 + length($url);
2738
2739
2740 # Pack the header data
2741 my $header = pack("vv", $record, $length);
2742 my $data = pack("vvvv", $row1, $row2, $col1, $col2);
2743
2744
2745 # Write the packed data
2746 $self->_append( $header,
2747 $data,
2748 $unknown1,
2749 $options,
2750 $unknown2,
2751 $url_len,
2752 $url);
2753
2754 return $error;
2755}
2756
2757
2758###############################################################################
2759#
2760# _write_url_internal($row1, $col1, $row2, $col2, $url, $string, $format)
2761#
2762# Used to write internal reference hyperlinks such as "Sheet1!A1".
2763#
2764# See also write_url() above for a general description and return values.
2765#
2766sub _write_url_internal {
2767
2768 my $self = shift;
2769
2770 my $record = 0x01B8; # Record identifier
2771 my $length = 0x00000; # Bytes to follow
2772
2773 my $row1 = $_[0]; # Start row
2774 my $col1 = $_[1]; # Start column
2775 my $row2 = $_[2]; # End row
2776 my $col2 = $_[3]; # End column
2777 my $url = $_[4]; # URL string
2778 my $str = $_[5]; # Alternative label
2779 my $xf = $_[6] || $self->{_url_format};# The cell format
2780
2781 # Strip URL type
2782 $url =~ s[^internal:][];
2783
2784
2785 # Write the visible label but protect against url recursion in write().
2786 $str = $url unless defined $str;
2787 $self->{_writing_url} = 1;
2788 my $error = $self->write($row1, $col1, $str, $xf);
2789 $self->{_writing_url} = 0;
2790 return $error if $error == -2;
2791
2792
2793 # Pack the undocumented parts of the hyperlink stream
2794 my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
2795
2796
2797 # Pack the option flags
2798 my $options = pack("V", 0x08);
2799
2800
2801 # URL encoding.
2802 my $encoding = 0;
2803
2804
2805 # Convert an Utf8 URL type and to a null terminated wchar string.
2806 if ($] >= 5.008) {
2807 require Encode;
2808
2809 if (Encode::is_utf8($url)) {
2810 # Quote sheet name if not already, i.e., Sheet!A1 to 'Sheet!A1'.
2811 $url =~ s/^(.+)!/'$1'!/ if not $url =~ /^'/;
2812
2813 $url = Encode::encode("UTF-16LE", $url);
2814 $url .= "\0\0"; # URL is null terminated.
2815 $encoding = 1;
2816 }
2817 }
2818
2819
2820 # Convert an Ascii URL type and to a null terminated wchar string.
2821 if ($encoding == 0) {
2822 $url .= "\0";
2823 $url = pack 'v*', unpack 'c*', $url;
2824 }
2825
2826
2827 # Pack the length of the URL as chars (not wchars)
2828 my $url_len = pack("V", int(length($url)/2));
2829
2830
2831 # Calculate the data length
2832 $length = 0x24 + length($url);
2833
2834
2835 # Pack the header data
2836 my $header = pack("vv", $record, $length);
2837 my $data = pack("vvvv", $row1, $row2, $col1, $col2);
2838
2839
2840 # Write the packed data
2841 $self->_append( $header,
2842 $data,
2843 $unknown1,
2844 $options,
2845 $url_len,
2846 $url);
2847
2848 return $error;
2849}
2850
2851
2852###############################################################################
2853#
2854# _write_url_external($row1, $col1, $row2, $col2, $url, $string, $format)
2855#
2856# Write links to external directory names such as 'c:\foo.xls',
2857# c:\foo.xls#Sheet1!A1', '../../foo.xls'. and '../../foo.xls#Sheet1!A1'.
2858#
2859# Note: Excel writes some relative links with the $dir_long string. We ignore
2860# these cases for the sake of simpler code.
2861#
2862# See also write_url() above for a general description and return values.
2863#
2864sub _write_url_external {
2865
2866 my $self = shift;
2867
2868 # Network drives are different. We will handle them separately
2869 # MS/Novell network drives and shares start with \\
2870 return $self->_write_url_external_net(@_) if $_[4] =~ m[^external:\\\\];
2871
2872
2873 my $record = 0x01B8; # Record identifier
2874 my $length = 0x00000; # Bytes to follow
2875
2876 my $row1 = $_[0]; # Start row
2877 my $col1 = $_[1]; # Start column
2878 my $row2 = $_[2]; # End row
2879 my $col2 = $_[3]; # End column
2880 my $url = $_[4]; # URL string
2881 my $str = $_[5]; # Alternative label
2882 my $xf = $_[6] || $self->{_url_format};# The cell format
2883
2884
2885 # Strip URL type and change Unix dir separator to Dos style (if needed)
2886 #
2887 $url =~ s[^external:][];
2888 $url =~ s[/][\\]g;
2889
2890
2891 # Write the visible label but protect against url recursion in write().
2892 ($str = $url) =~ s[\#][ - ] unless defined $str;
2893 $self->{_writing_url} = 1;
2894 my $error = $self->write($row1, $col1, $str, $xf);
2895 $self->{_writing_url} = 0;
2896 return $error if $error == -2;
2897
2898
2899 # Determine if the link is relative or absolute:
2900 # Absolute if link starts with DOS drive specifier like C:
2901 # Otherwise default to 0x00 for relative link.
2902 #
2903 my $absolute = 0x00;
2904 $absolute = 0x02 if $url =~ m/^[A-Za-z]:/;
2905
2906
2907 # Determine if the link contains a sheet reference and change some of the
2908 # parameters accordingly.
2909 # Split the dir name and sheet name (if it exists)
2910 #
2911 my ($dir_long , $sheet) = split /\#/, $url;
2912 my $link_type = 0x01 | $absolute;
2913 my $sheet_len;
2914
2915 if (defined $sheet) {
2916 $link_type |= 0x08;
2917 $sheet_len = pack("V", length($sheet) + 0x01);
2918 $sheet = join("\0", split('', $sheet));
2919 $sheet .= "\0\0\0";
2920 }
2921 else {
2922 $sheet_len = '';
2923 $sheet = '';
2924 }
2925
2926
2927 # Pack the link type
2928 $link_type = pack("V", $link_type);
2929
2930
2931 # Calculate the up-level dir count e.g. (..\..\..\ == 3)
2932 my $up_count = 0;
2933 $up_count++ while $dir_long =~ s[^\.\.\\][];
2934 $up_count = pack("v", $up_count);
2935
2936
2937 # Store the short dos dir name (null terminated)
2938 my $dir_short = $dir_long . "\0";
2939
2940
2941 # Store the long dir name as a wchar string (non-null terminated)
2942 $dir_long = join("\0", split('', $dir_long));
2943 $dir_long = $dir_long . "\0";
2944
2945
2946 # Pack the lengths of the dir strings
2947 my $dir_short_len = pack("V", length $dir_short );
2948 my $dir_long_len = pack("V", length $dir_long );
2949 my $stream_len = pack("V", length($dir_long) + 0x06);
2950
2951
2952 # Pack the undocumented parts of the hyperlink stream
2953 my $unknown1 =pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000' );
2954 my $unknown2 =pack("H*",'0303000000000000C000000000000046' );
2955 my $unknown3 =pack("H*",'FFFFADDE000000000000000000000000000000000000000');
2956 my $unknown4 =pack("v", 0x03 );
2957
2958
2959 # Pack the main data stream
2960 my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
2961 $unknown1 .
2962 $link_type .
2963 $unknown2 .
2964 $up_count .
2965 $dir_short_len.
2966 $dir_short .
2967 $unknown3 .
2968 $stream_len .
2969 $dir_long_len .
2970 $unknown4 .
2971 $dir_long .
2972 $sheet_len .
2973 $sheet ;
2974
2975
2976 # Pack the header data
2977 $length = length $data;
2978 my $header = pack("vv", $record, $length);
2979
2980
2981 # Write the packed data
2982 $self->_append($header, $data);
2983
2984 return $error;
2985}
2986
2987
2988
2989
2990###############################################################################
2991#
2992# _write_url_external_net($row1, $col1, $row2, $col2, $url, $string, $format)
2993#
2994# Write links to external MS/Novell network drives and shares such as
2995# '//NETWORK/share/foo.xls' and '//NETWORK/share/foo.xls#Sheet1!A1'.
2996#
2997# See also write_url() above for a general description and return values.
2998#
2999sub _write_url_external_net {
3000
3001 my $self = shift;
3002
3003 my $record = 0x01B8; # Record identifier
3004 my $length = 0x00000; # Bytes to follow
3005
3006 my $row1 = $_[0]; # Start row
3007 my $col1 = $_[1]; # Start column
3008 my $row2 = $_[2]; # End row
3009 my $col2 = $_[3]; # End column
3010 my $url = $_[4]; # URL string
3011 my $str = $_[5]; # Alternative label
3012 my $xf = $_[6] || $self->{_url_format};# The cell format
3013
3014
3015 # Strip URL type and change Unix dir separator to Dos style (if needed)
3016 #
3017 $url =~ s[^external:][];
3018 $url =~ s[/][\\]g;
3019
3020
3021 # Write the visible label but protect against url recursion in write().
3022 ($str = $url) =~ s[\#][ - ] unless defined $str;
3023 $self->{_writing_url} = 1;
3024 my $error = $self->write($row1, $col1, $str, $xf);
3025 $self->{_writing_url} = 0;
3026 return $error if $error == -2;
3027
3028
3029 # Determine if the link contains a sheet reference and change some of the
3030 # parameters accordingly.
3031 # Split the dir name and sheet name (if it exists)
3032 #
3033 my ($dir_long , $sheet) = split /\#/, $url;
3034 my $link_type = 0x0103; # Always absolute
3035 my $sheet_len;
3036
3037 if (defined $sheet) {
3038 $link_type |= 0x08;
3039 $sheet_len = pack("V", length($sheet) + 0x01);
3040 $sheet = join("\0", split('', $sheet));
3041 $sheet .= "\0\0\0";
3042 }
3043 else {
3044 $sheet_len = '';
3045 $sheet = '';
3046 }
3047
3048 # Pack the link type
3049 $link_type = pack("V", $link_type);
3050
3051
3052 # Make the string null terminated
3053 $dir_long = $dir_long . "\0";
3054
3055
3056 # Pack the lengths of the dir string
3057 my $dir_long_len = pack("V", length $dir_long);
3058
3059
3060 # Store the long dir name as a wchar string (non-null terminated)
3061 $dir_long = join("\0", split('', $dir_long));
3062 $dir_long = $dir_long . "\0";
3063
3064
3065 # Pack the undocumented part of the hyperlink stream
3066 my $unknown1 = pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000');
3067
3068
3069 # Pack the main data stream
3070 my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
3071 $unknown1 .
3072 $link_type .
3073 $dir_long_len .
3074 $dir_long .
3075 $sheet_len .
3076 $sheet ;
3077
3078
3079 # Pack the header data
3080 $length = length $data;
3081 my $header = pack("vv", $record, $length);
3082
3083
3084 # Write the packed data
3085 $self->_append($header, $data);
3086
3087 return $error;
3088}
3089
3090
3091###############################################################################
3092#
3093# write_date_time ($row, $col, $string, $format)
3094#
3095# Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
3096# number representing an Excel date. $format is optional.
3097#
3098# Returns 0 : normal termination
3099# -1 : insufficient number of arguments
3100# -2 : row or column out of range
3101# -3 : Invalid date_time, written as string
3102#
3103sub write_date_time {
3104
3105 my $self = shift;
3106
3107 # Check for a cell reference in A1 notation and substitute row and column
3108 if ($_[0] =~ /^\D/) {
3109 @_ = $self->_substitute_cellref(@_);
3110 }
3111
3112 if (@_ < 3) { return -1 } # Check the number of args
3113
3114 my $row = $_[0]; # Zero indexed row
3115 my $col = $_[1]; # Zero indexed column
3116 my $str = $_[2];
3117
3118
3119 # Check that row and col are valid and store max and min values
3120 return -2 if $self->_check_dimensions($row, $col);
3121
3122 my $error = 0;
3123 my $date_time = $self->convert_date_time($str);
3124
3125 if (defined $date_time) {
3126 $error = $self->write_number($row, $col, $date_time, $_[3]);
3127 }
3128 else {
3129 # The date isn't valid so write it as a string.
3130 $self->write_string($row, $col, $str, $_[3]);
3131 $error = -3;
3132 }
3133 return $error;
3134}
3135
3136
3137
3138###############################################################################
3139#
3140# convert_date_time($date_time_string)
3141#
3142# The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
3143# and converts it to a decimal number representing a valid Excel date.
3144#
3145# Dates and times in Excel are represented by real numbers. The integer part of
3146# the number stores the number of days since the epoch and the fractional part
3147# stores the percentage of the day in seconds. The epoch can be either 1900 or
3148# 1904.
3149#
3150# Parameter: Date and time string in one of the following formats:
3151# yyyy-mm-ddThh:mm:ss.ss # Standard
3152# yyyy-mm-ddT # Date only
3153# Thh:mm:ss.ss # Time only
3154#
3155# Returns:
3156# A decimal number representing a valid Excel date, or
3157# undef if the date is invalid.
3158#
3159sub convert_date_time {
3160
3161 my $self = shift;
3162 my $date_time = $_[0];
3163
3164 my $days = 0; # Number of days since epoch
3165 my $seconds = 0; # Time expressed as fraction of 24h hours in seconds
3166
3167 my ($year, $month, $day);
3168 my ($hour, $min, $sec);
3169
3170
3171 # Strip leading and trailing whitespace.
3172 $date_time =~ s/^\s+//;
3173 $date_time =~ s/\s+$//;
3174
3175 # Check for invalid date char.
3176 return if $date_time =~ /[^0-9T:\-\.Z]/;
3177
3178 # Check for "T" after date or before time.
3179 return unless $date_time =~ /\dT|T\d/;
3180
3181 # Strip trailing Z in ISO8601 date.
3182 $date_time =~ s/Z$//;
3183
3184
3185 # Split into date and time.
3186 my ($date, $time) = split /T/, $date_time;
3187
3188
3189 # We allow the time portion of the input DateTime to be optional.
3190 if ($time ne '') {
3191 # Match hh:mm:ss.sss+ where the seconds are optional
3192 if ($time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/) {
3193 $hour = $1;
3194 $min = $2;
3195 $sec = $4 || 0;
3196 }
3197 else {
3198 return undef; # Not a valid time format.
3199 }
3200
3201 # Some boundary checks
3202 return if $hour >= 24;
3203 return if $min >= 60;
3204 return if $sec >= 60;
3205
3206 # Excel expresses seconds as a fraction of the number in 24 hours.
3207 $seconds = ($hour *60*60 + $min *60 + $sec) / (24 *60 *60);
3208 }
3209
3210
3211 # We allow the date portion of the input DateTime to be optional.
3212 return $seconds if $date eq '';
3213
3214
3215 # Match date as yyyy-mm-dd.
3216 if ($date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
3217 $year = $1;
3218 $month = $2;
3219 $day = $3;
3220 }
3221 else {
3222 return undef; # Not a valid date format.
3223 }
3224
3225 # Set the epoch as 1900 or 1904. Defaults to 1900.
3226 my $date_1904 = $self->{_1904};
3227
3228
3229 # Special cases for Excel.
3230 if (not $date_1904) {
3231 return $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
3232 return $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
3233 return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
3234 }
3235
3236
3237 # We calculate the date by calculating the number of days since the epoch
3238 # and adjust for the number of leap days. We calculate the number of leap
3239 # days by normalising the year in relation to the epoch. Thus the year 2000
3240 # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
3241 #
3242 my $epoch = $date_1904 ? 1904 : 1900;
3243 my $offset = $date_1904 ? 4 : 0;
3244 my $norm = 300;
3245 my $range = $year -$epoch;
3246
3247
3248 # Set month days and check for leap year.
3249 my @mdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
3250 my $leap = 0;
3251 $leap = 1 if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
3252 $mdays[1] = 29 if $leap;
3253
3254
3255 # Some boundary checks
3256 return if $year < $epoch or $year > 9999;
3257 return if $month < 1 or $month > 12;
3258 return if $day < 1 or $day > $mdays[$month -1];
3259
3260 # Accumulate the number of days since the epoch.
3261 $days = $day; # Add days for current month
3262 $days += $mdays[$_] for 0 .. $month -2; # Add days for past months
3263 $days += $range *365; # Add days for past years
3264 $days += int(($range) / 4); # Add leapdays
3265 $days -= int(($range +$offset) /100); # Subtract 100 year leapdays
3266 $days += int(($range +$offset +$norm)/400); # Add 400 year leapdays
3267 $days -= $leap; # Already counted above
3268
3269
3270 # Adjust for Excel erroneously treating 1900 as a leap year.
3271 $days++ if $date_1904 == 0 and $days > 59;
3272
3273 return $days + $seconds;
3274}
3275
3276
3277
3278
3279
3280###############################################################################
3281#
3282# set_row($row, $height, $XF, $hidden, $level)
3283#
3284# This method is used to set the height and XF format for a row.
3285# Writes the BIFF record ROW.
3286#
3287sub set_row {
3288
3289 my $self = shift;
3290 my $record = 0x0208; # Record identifier
3291 my $length = 0x0010; # Number of bytes to follow
3292
3293 my $row = $_[0]; # Row Number
3294 my $colMic = 0x0000; # First defined column
3295 my $colMac = 0x0000; # Last defined column
3296 my $miyRw; # Row height
3297 my $irwMac = 0x0000; # Used by Excel to optimise loading
3298 my $reserved = 0x0000; # Reserved
3299 my $grbit = 0x0000; # Option flags
3300 my $ixfe; # XF index
3301 my $height = $_[1]; # Format object
3302 my $format = $_[2]; # Format object
3303 my $hidden = $_[3] || 0; # Hidden flag
3304 my $level = $_[4] || 0; # Outline level
3305 my $collapsed = $_[5] || 0; # Collapsed row
3306
3307
3308 return unless defined $row; # Ensure at least $row is specified.
3309
3310 # Check that row and col are valid and store max and min values
3311 return -2 if $self->_check_dimensions($row, 0, 0, 1);
3312
3313 # Check for a format object
3314 if (ref $format) {
3315 $ixfe = $format->get_xf_index();
3316 }
3317 else {
3318 $ixfe = 0x0F;
3319 }
3320
3321
3322 # Set the row height in units of 1/20 of a point. Note, some heights may
3323 # not be obtained exactly due to rounding in Excel.
3324 #
3325 if (defined $height) {
3326 $miyRw = $height *20;
3327 }
3328 else {
3329 $miyRw = 0xff; # The default row height
3330 $height = 0;
3331 }
3332
3333
3334 # Set the limits for the outline levels (0 <= x <= 7).
3335 $level = 0 if $level < 0;
3336 $level = 7 if $level > 7;
3337
3338 $self->{_outline_row_level} = $level if $level >$self->{_outline_row_level};
3339
3340
3341 # Set the options flags.
3342 # 0x10: The fCollapsed flag indicates that the row contains the "+"
3343 # when an outline group is collapsed.
3344 # 0x20: The fDyZero height flag indicates a collapsed or hidden row.
3345 # 0x40: The fUnsynced flag is used to show that the font and row heights
3346 # are not compatible. This is usually the case for WriteExcel.
3347 # 0x80: The fGhostDirty flag indicates that the row has been formatted.
3348 #
3349 $grbit |= $level;
3350 $grbit |= 0x0010 if $collapsed;
3351 $grbit |= 0x0020 if $hidden;
3352 $grbit |= 0x0040;
3353 $grbit |= 0x0080 if $format;
3354 $grbit |= 0x0100;
3355
3356
3357 my $header = pack("vv", $record, $length);
3358 my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
3359 $irwMac,$reserved, $grbit, $ixfe);
3360
3361
3362 # Store the data or write immediately depending on the compatibility mode.
3363 if ($self->{_compatibility}) {
3364 $self->{_row_data}->{$_[0]} = $header . $data;
3365 }
3366 else {
3367 $self->_append($header, $data);
3368 }
3369
3370
3371 # Store the row sizes for use when calculating image vertices.
3372 # Also store the column formats.
3373 $self->{_row_sizes}->{$_[0]} = $height;
3374 $self->{_row_formats}->{$_[0]} = $format if defined $format;
3375}
3376
3377
3378
3379###############################################################################
3380#
3381# _write_row_default()
3382#
3383# Write a default row record, in compatibility mode, for rows that don't have
3384# user specified values..
3385#
3386sub _write_row_default {
3387
3388 my $self = shift;
3389 my $record = 0x0208; # Record identifier
3390 my $length = 0x0010; # Number of bytes to follow
3391
3392 my $row = $_[0]; # Row Number
3393 my $colMic = $_[1]; # First defined column
3394 my $colMac = $_[2]; # Last defined column
3395 my $miyRw = 0xFF; # Row height
3396 my $irwMac = 0x0000; # Used by Excel to optimise loading
3397 my $reserved = 0x0000; # Reserved
3398 my $grbit = 0x0100; # Option flags
3399 my $ixfe = 0x0F; # XF index
3400
3401 my $header = pack("vv", $record, $length);
3402 my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
3403 $irwMac,$reserved, $grbit, $ixfe);
3404
3405 $self->_append($header, $data);
3406}
3407
3408
3409###############################################################################
3410#
3411# _check_dimensions($row, $col, $ignore_row, $ignore_col)
3412#
3413# Check that $row and $col are valid and store max and min values for use in
3414# DIMENSIONS record. See, _store_dimensions().
3415#
3416# The $ignore_row/$ignore_col flags is used to indicate that we wish to
3417# perform the dimension check without storing the value.
3418#
3419# The ignore flags are use by set_row() and data_validate.
3420#
3421sub _check_dimensions {
3422
3423 my $self = shift;
3424 my $row = $_[0];
3425 my $col = $_[1];
3426 my $ignore_row = $_[2];
3427 my $ignore_col = $_[3];
3428
3429
3430 return -2 if not defined $row;
3431 return -2 if $row >= $self->{_xls_rowmax};
3432
3433 return -2 if not defined $col;
3434 return -2 if $col >= $self->{_xls_colmax};
3435
3436
3437 if (not $ignore_row) {
3438
3439 if (not defined $self->{_dim_rowmin} or $row < $self->{_dim_rowmin}) {
3440 $self->{_dim_rowmin} = $row;
3441 }
3442
3443 if (not defined $self->{_dim_rowmax} or $row > $self->{_dim_rowmax}) {
3444 $self->{_dim_rowmax} = $row;
3445 }
3446 }
3447
3448 if (not $ignore_col) {
3449
3450 if (not defined $self->{_dim_colmin} or $col < $self->{_dim_colmin}) {
3451 $self->{_dim_colmin} = $col;
3452 }
3453
3454 if (not defined $self->{_dim_colmax} or $col > $self->{_dim_colmax}) {
3455 $self->{_dim_colmax} = $col;
3456 }
3457 }
3458
3459 return 0;
3460}
3461
3462
3463###############################################################################
3464#
3465# _store_dimensions()
3466#
3467# Writes Excel DIMENSIONS to define the area in which there is cell data.
3468#
3469# Notes:
3470# Excel stores the max row/col as row/col +1.
3471# Max and min values of 0 are used to indicate that no cell data.
3472# We set the undef member data to 0 since it is used by _store_table().
3473# Inserting images or charts doesn't change the DIMENSION data.
3474#
3475sub _store_dimensions {
3476
3477 my $self = shift;
3478 my $record = 0x0200; # Record identifier
3479 my $length = 0x000E; # Number of bytes to follow
3480 my $row_min; # First row
3481 my $row_max; # Last row plus 1
3482 my $col_min; # First column
3483 my $col_max; # Last column plus 1
3484 my $reserved = 0x0000; # Reserved by Excel
3485
3486 if (defined $self->{_dim_rowmin}) {$row_min = $self->{_dim_rowmin} }
3487 else {$row_min = 0 }
3488
3489 if (defined $self->{_dim_rowmax}) {$row_max = $self->{_dim_rowmax} + 1}
3490 else {$row_max = 0 }
3491
3492 if (defined $self->{_dim_colmin}) {$col_min = $self->{_dim_colmin} }
3493 else {$col_min = 0 }
3494
3495 if (defined $self->{_dim_colmax}) {$col_max = $self->{_dim_colmax} + 1}
3496 else {$col_max = 0 }
3497
3498
3499 # Set member data to the new max/min value for use by _store_table().
3500 $self->{_dim_rowmin} = $row_min;
3501 $self->{_dim_rowmax} = $row_max;
3502 $self->{_dim_colmin} = $col_min;
3503 $self->{_dim_colmax} = $col_max;
3504
3505
3506 my $header = pack("vv", $record, $length);
3507 my $data = pack("VVvvv", $row_min, $row_max,
3508 $col_min, $col_max, $reserved);
3509 $self->_prepend($header, $data);
3510}
3511
3512
3513###############################################################################
3514#
3515# _store_window2()
3516#
3517# Write BIFF record Window2.
3518#
3519sub _store_window2 {
3520
3521 use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
3522
3523 my $self = shift;
3524 my $record = 0x023E; # Record identifier
3525 my $length = 0x0012; # Number of bytes to follow
3526
3527 my $grbit = 0x00B6; # Option flags
3528 my $rwTop = $self->{_first_row}; # Top visible row
3529 my $colLeft = $self->{_first_col}; # Leftmost visible column
3530 my $rgbHdr = 0x00000040; # Row/col heading, grid color
3531
3532 my $wScaleSLV = 0x0000; # Zoom in page break preview
3533 my $wScaleNormal = 0x0000; # Zoom in normal view
3534 my $reserved = 0x00000000;
3535
3536
3537 # The options flags that comprise $grbit
3538 my $fDspFmla = $self->{_display_formulas}; # 0 - bit
3539 my $fDspGrid = $self->{_screen_gridlines}; # 1
3540 my $fDspRwCol = $self->{_display_headers}; # 2
3541 my $fFrozen = $self->{_frozen}; # 3
3542 my $fDspZeros = $self->{_display_zeros}; # 4
3543 my $fDefaultHdr = 1; # 5
3544 my $fArabic = $self->{_display_arabic}; # 6
3545 my $fDspGuts = $self->{_outline_on}; # 7
3546 my $fFrozenNoSplit = $self->{_frozen_no_split}; # 0 - bit
3547 my $fSelected = $self->{_selected}; # 1
3548 my $fPaged = $self->{_active}; # 2
3549 my $fBreakPreview = 0; # 3
3550
3551 $grbit = $fDspFmla;
3552 $grbit |= $fDspGrid << 1;
3553 $grbit |= $fDspRwCol << 2;
3554 $grbit |= $fFrozen << 3;
3555 $grbit |= $fDspZeros << 4;
3556 $grbit |= $fDefaultHdr << 5;
3557 $grbit |= $fArabic << 6;
3558 $grbit |= $fDspGuts << 7;
3559 $grbit |= $fFrozenNoSplit << 8;
3560 $grbit |= $fSelected << 9;
3561 $grbit |= $fPaged << 10;
3562 $grbit |= $fBreakPreview << 11;
3563
3564 my $header = pack("vv", $record, $length);
3565 my $data = pack("vvvVvvV", $grbit, $rwTop, $colLeft, $rgbHdr,
3566 $wScaleSLV, $wScaleNormal, $reserved );
3567
3568 $self->_append($header, $data);
3569}
3570
3571
3572###############################################################################
3573#
3574# _store_page_view()
3575#
3576# Set page view mode. Only applicable to Mac Excel.
3577#
3578sub _store_page_view {
3579
3580 my $self = shift;
3581
3582 return unless $self->{_page_view};
3583
3584 my $data = pack "H*", 'C8081100C808000000000040000000000900000000';
3585
3586 $self->_append($data);
3587}
3588
3589
3590###############################################################################
3591#
3592# _store_tab_color()
3593#
3594# Write the Tab Color BIFF record.
3595#
3596sub _store_tab_color {
3597
3598 my $self = shift;
3599 my $color = $self->{_tab_color};
3600
3601 return unless $color;
3602
3603 my $record = 0x0862; # Record identifier
3604 my $length = 0x0014; # Number of bytes to follow
3605
3606 my $zero = 0x0000;
3607 my $unknown = 0x0014;
3608
3609 my $header = pack("vv", $record, $length);
3610 my $data = pack("vvvvvvvvvv", $record, $zero, $zero, $zero, $zero,
3611 $zero, $unknown, $zero, $color, $zero);
3612
3613 $self->_append($header, $data);
3614}
3615
3616
3617###############################################################################
3618#
3619# _store_defrow()
3620#
3621# Write BIFF record DEFROWHEIGHT.
3622#
3623sub _store_defrow {
3624
3625 my $self = shift;
3626 my $record = 0x0225; # Record identifier
3627 my $length = 0x0004; # Number of bytes to follow
3628
3629 my $grbit = 0x0000; # Options.
3630 my $height = 0x00FF; # Default row height
3631
3632 my $header = pack("vv", $record, $length);
3633 my $data = pack("vv", $grbit, $height);
3634
3635 $self->_prepend($header, $data);
3636}
3637
3638
3639###############################################################################
3640#
3641# _store_defcol()
3642#
3643# Write BIFF record DEFCOLWIDTH.
3644#
3645sub _store_defcol {
3646
3647 my $self = shift;
3648 my $record = 0x0055; # Record identifier
3649 my $length = 0x0002; # Number of bytes to follow
3650
3651 my $colwidth = 0x0008; # Default column width
3652
3653 my $header = pack("vv", $record, $length);
3654 my $data = pack("v", $colwidth);
3655
3656 $self->_prepend($header, $data);
3657}
3658
3659
3660###############################################################################
3661#
3662# _store_colinfo($firstcol, $lastcol, $width, $format, $hidden)
3663#
3664# Write BIFF record COLINFO to define column widths
3665#
3666# Note: The SDK says the record length is 0x0B but Excel writes a 0x0C
3667# length record.
3668#
3669sub _store_colinfo {
3670
3671 my $self = shift;
3672 my $record = 0x007D; # Record identifier
3673 my $length = 0x000B; # Number of bytes to follow
3674
3675 my $colFirst = $_[0] || 0; # First formatted column
3676 my $colLast = $_[1] || 0; # Last formatted column
3677 my $width = $_[2] || 8.43; # Col width in user units, 8.43 is default
3678 my $coldx; # Col width in internal units
3679 my $pixels; # Col width in pixels
3680
3681 # Excel rounds the column width to the nearest pixel. Therefore we first
3682 # convert to pixels and then to the internal units. The pixel to users-units
3683 # relationship is different for values less than 1.
3684 #
3685 if ($width < 1) {
3686 $pixels = int($width *12);
3687 }
3688 else {
3689 $pixels = int($width *7 ) +5;
3690 }
3691
3692 $coldx = int($pixels *256/7);
3693
3694
3695 my $ixfe; # XF index
3696 my $grbit = 0x0000; # Option flags
3697 my $reserved = 0x00; # Reserved
3698 my $format = $_[3]; # Format object
3699 my $hidden = $_[4] || 0; # Hidden flag
3700 my $level = $_[5] || 0; # Outline level
3701 my $collapsed = $_[6] || 0; # Outline level
3702
3703
3704 # Check for a format object
3705 if (ref $format) {
3706 $ixfe = $format->get_xf_index();
3707 }
3708 else {
3709 $ixfe = 0x0F;
3710 }
3711
3712
3713 # Set the limits for the outline levels (0 <= x <= 7).
3714 $level = 0 if $level < 0;
3715 $level = 7 if $level > 7;
3716
3717
3718 # Set the options flags. (See set_row() for more details).
3719 $grbit |= 0x0001 if $hidden;
3720 $grbit |= $level << 8;
3721 $grbit |= 0x1000 if $collapsed;
3722
3723
3724 my $header = pack("vv", $record, $length);
3725 my $data = pack("vvvvvC", $colFirst, $colLast, $coldx,
3726 $ixfe, $grbit, $reserved);
3727
3728 $self->_prepend($header, $data);
3729}
3730
3731
3732###############################################################################
3733#
3734# _store_filtermode()
3735#
3736# Write BIFF record FILTERMODE to indicate that the worksheet contains
3737# AUTOFILTER record, ie. autofilters with a filter set.
3738#
3739sub _store_filtermode {
3740
3741 my $self = shift;
3742
3743 my $record = 0x009B; # Record identifier
3744 my $length = 0x0000; # Number of bytes to follow
3745
3746 # Only write the record if the worksheet contains a filtered autofilter.
3747 return unless $self->{_filter_on};
3748
3749 my $header = pack("vv", $record, $length);
3750
3751 $self->_prepend($header);
3752}
3753
3754
3755###############################################################################
3756#
3757# _store_autofilterinfo()
3758#
3759# Write BIFF record AUTOFILTERINFO.
3760#
3761sub _store_autofilterinfo {
3762
3763 my $self = shift;
3764
3765 my $record = 0x009D; # Record identifier
3766 my $length = 0x0002; # Number of bytes to follow
3767 my $num_filters = $self->{_filter_count};
3768
3769 # Only write the record if the worksheet contains an autofilter.
3770 return unless $self->{_filter_count};
3771
3772 my $header = pack("vv", $record, $length);
3773 my $data = pack("v", $num_filters);
3774
3775 $self->_prepend($header, $data);
3776}
3777
3778
3779###############################################################################
3780#
3781# _store_selection($first_row, $first_col, $last_row, $last_col)
3782#
3783# Write BIFF record SELECTION.
3784#
3785sub _store_selection {
3786
3787 my $self = shift;
3788 my $record = 0x001D; # Record identifier
3789 my $length = 0x000F; # Number of bytes to follow
3790
3791 my $pnn = $self->{_active_pane}; # Pane position
3792 my $rwAct = $_[0]; # Active row
3793 my $colAct = $_[1]; # Active column
3794 my $irefAct = 0; # Active cell ref
3795 my $cref = 1; # Number of refs
3796
3797 my $rwFirst = $_[0]; # First row in reference
3798 my $colFirst = $_[1]; # First col in reference
3799 my $rwLast = $_[2] || $rwFirst; # Last row in reference
3800 my $colLast = $_[3] || $colFirst; # Last col in reference
3801
3802 # Swap last row/col for first row/col as necessary
3803 if ($rwFirst > $rwLast) {
3804 ($rwFirst, $rwLast) = ($rwLast, $rwFirst);
3805 }
3806
3807 if ($colFirst > $colLast) {
3808 ($colFirst, $colLast) = ($colLast, $colFirst);
3809 }
3810
3811
3812 my $header = pack("vv", $record, $length);
3813 my $data = pack("CvvvvvvCC", $pnn, $rwAct, $colAct,
3814 $irefAct, $cref,
3815 $rwFirst, $rwLast,
3816 $colFirst, $colLast);
3817
3818 $self->_append($header, $data);
3819}
3820
3821
3822###############################################################################
3823#
3824# _store_externcount($count)
3825#
3826# Write BIFF record EXTERNCOUNT to indicate the number of external sheet
3827# references in a worksheet.
3828#
3829# Excel only stores references to external sheets that are used in formulas.
3830# For simplicity we store references to all the sheets in the workbook
3831# regardless of whether they are used or not. This reduces the overall
3832# complexity and eliminates the need for a two way dialogue between the formula
3833# parser the worksheet objects.
3834#
3835sub _store_externcount {
3836
3837 my $self = shift;
3838 my $record = 0x0016; # Record identifier
3839 my $length = 0x0002; # Number of bytes to follow
3840
3841 my $cxals = $_[0]; # Number of external references
3842
3843 my $header = pack("vv", $record, $length);
3844 my $data = pack("v", $cxals);
3845
3846 $self->_prepend($header, $data);
3847}
3848
3849
3850###############################################################################
3851#
3852# _store_externsheet($sheetname)
3853#
3854#
3855# Writes the Excel BIFF EXTERNSHEET record. These references are used by
3856# formulas. A formula references a sheet name via an index. Since we store a
3857# reference to all of the external worksheets the EXTERNSHEET index is the same
3858# as the worksheet index.
3859#
3860sub _store_externsheet {
3861
3862 my $self = shift;
3863
3864 my $record = 0x0017; # Record identifier
3865 my $length; # Number of bytes to follow
3866
3867 my $sheetname = $_[0]; # Worksheet name
3868 my $cch; # Length of sheet name
3869 my $rgch; # Filename encoding
3870
3871 # References to the current sheet are encoded differently to references to
3872 # external sheets.
3873 #
3874 if ($self->{_name} eq $sheetname) {
3875 $sheetname = '';
3876 $length = 0x02; # The following 2 bytes
3877 $cch = 1; # The following byte
3878 $rgch = 0x02; # Self reference
3879 }
3880 else {
3881 $length = 0x02 + length($_[0]);
3882 $cch = length($sheetname);
3883 $rgch = 0x03; # Reference to a sheet in the current workbook
3884 }
3885
3886 my $header = pack("vv", $record, $length);
3887 my $data = pack("CC", $cch, $rgch);
3888
3889 $self->_prepend($header, $data, $sheetname);
3890}
3891
3892
3893###############################################################################
3894#
3895# _store_panes()
3896#
3897#
3898# Writes the Excel BIFF PANE record.
3899# The panes can either be frozen or thawed (unfrozen).
3900# Frozen panes are specified in terms of a integer number of rows and columns.
3901# Thawed panes are specified in terms of Excel's units for rows and columns.
3902#
3903sub _store_panes {
3904
3905 my $self = shift;
3906 my $record = 0x0041; # Record identifier
3907 my $length = 0x000A; # Number of bytes to follow
3908
3909 my $y = $_[0] || 0; # Vertical split position
3910 my $x = $_[1] || 0; # Horizontal split position
3911 my $rwTop = $_[2]; # Top row visible
3912 my $colLeft = $_[3]; # Leftmost column visible
3913 my $no_split = $_[4]; # No used here.
3914 my $pnnAct = $_[5]; # Active pane
3915
3916
3917 # Code specific to frozen or thawed panes.
3918 if ($self->{_frozen}) {
3919 # Set default values for $rwTop and $colLeft
3920 $rwTop = $y unless defined $rwTop;
3921 $colLeft = $x unless defined $colLeft;
3922 }
3923 else {
3924 # Set default values for $rwTop and $colLeft
3925 $rwTop = 0 unless defined $rwTop;
3926 $colLeft = 0 unless defined $colLeft;
3927
3928 # Convert Excel's row and column units to the internal units.
3929 # The default row height is 12.75
3930 # The default column width is 8.43
3931 # The following slope and intersection values were interpolated.
3932 #
3933 $y = 20*$y + 255;
3934 $x = 113.879*$x + 390;
3935 }
3936
3937
3938 # Determine which pane should be active. There is also the undocumented
3939 # option to override this should it be necessary: may be removed later.
3940 #
3941 if (not defined $pnnAct) {
3942 $pnnAct = 0 if ($x != 0 && $y != 0); # Bottom right
3943 $pnnAct = 1 if ($x != 0 && $y == 0); # Top right
3944 $pnnAct = 2 if ($x == 0 && $y != 0); # Bottom left
3945 $pnnAct = 3 if ($x == 0 && $y == 0); # Top left
3946 }
3947
3948 $self->{_active_pane} = $pnnAct; # Used in _store_selection
3949
3950 my $header = pack("vv", $record, $length);
3951 my $data = pack("vvvvv", $x, $y, $rwTop, $colLeft, $pnnAct);
3952
3953 $self->_append($header, $data);
3954}
3955
3956
3957###############################################################################
3958#
3959# _store_setup()
3960#
3961# Store the page setup SETUP BIFF record.
3962#
3963sub _store_setup {
3964
3965 use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
3966
3967 my $self = shift;
3968 my $record = 0x00A1; # Record identifier
3969 my $length = 0x0022; # Number of bytes to follow
3970
3971
3972 my $iPaperSize = $self->{_paper_size}; # Paper size
3973 my $iScale = $self->{_print_scale}; # Print scaling factor
3974 my $iPageStart = $self->{_page_start}; # Starting page number
3975 my $iFitWidth = $self->{_fit_width}; # Fit to number of pages wide
3976 my $iFitHeight = $self->{_fit_height}; # Fit to number of pages high
3977 my $grbit = 0x00; # Option flags
3978 my $iRes = 0x0258; # Print resolution
3979 my $iVRes = 0x0258; # Vertical print resolution
3980 my $numHdr = $self->{_margin_header}; # Header Margin
3981 my $numFtr = $self->{_margin_footer}; # Footer Margin
3982 my $iCopies = 0x01; # Number of copies
3983
3984
3985 my $fLeftToRight = $self->{_page_order}; # Print over then down
3986 my $fLandscape = $self->{_orientation}; # Page orientation
3987 my $fNoPls = 0x0; # Setup not read from printer
3988 my $fNoColor = $self->{_black_white}; # Print black and white
3989 my $fDraft = $self->{_draft_quality}; # Print draft quality
3990 my $fNotes = $self->{_print_comments};# Print notes
3991 my $fNoOrient = 0x0; # Orientation not set
3992 my $fUsePage = $self->{_custom_start}; # Use custom starting page
3993
3994
3995 $grbit = $fLeftToRight;
3996 $grbit |= $fLandscape << 1;
3997 $grbit |= $fNoPls << 2;
3998 $grbit |= $fNoColor << 3;
3999 $grbit |= $fDraft << 4;
4000 $grbit |= $fNotes << 5;
4001 $grbit |= $fNoOrient << 6;
4002 $grbit |= $fUsePage << 7;
4003
4004
4005 $numHdr = pack("d", $numHdr);
4006 $numFtr = pack("d", $numFtr);
4007
4008 if ($self->{_byte_order}) {
4009 $numHdr = reverse $numHdr;
4010 $numFtr = reverse $numFtr;
4011 }
4012
4013 my $header = pack("vv", $record, $length);
4014 my $data1 = pack("vvvvvvvv", $iPaperSize,
4015 $iScale,
4016 $iPageStart,
4017 $iFitWidth,
4018 $iFitHeight,
4019 $grbit,
4020 $iRes,
4021 $iVRes);
4022 my $data2 = $numHdr .$numFtr;
4023 my $data3 = pack("v", $iCopies);
4024
4025 $self->_prepend($header, $data1, $data2, $data3);
4026
4027}
4028
4029###############################################################################
4030#
4031# _store_header()
4032#
4033# Store the header caption BIFF record.
4034#
4035sub _store_header {
4036
4037 my $self = shift;
4038
4039 my $record = 0x0014; # Record identifier
4040 my $length; # Bytes to follow
4041
4042 my $str = $self->{_header}; # header string
4043 my $cch = length($str); # Length of header string
4044 my $encoding = $self->{_header_encoding}; # Character encoding
4045
4046
4047 # Character length is num of chars not num of bytes
4048 $cch /= 2 if $encoding;
4049
4050 # Change the UTF-16 name from BE to LE
4051 $str = pack 'n*', unpack 'v*', $str if $encoding;
4052
4053 $length = 3 + length($str);
4054
4055 my $header = pack("vv", $record, $length);
4056 my $data = pack("vC", $cch, $encoding);
4057
4058 $self->_prepend($header, $data, $str);
4059}
4060
4061
4062###############################################################################
4063#
4064# _store_footer()
4065#
4066# Store the footer caption BIFF record.
4067#
4068sub _store_footer {
4069
4070 my $self = shift;
4071
4072 my $record = 0x0015; # Record identifier
4073 my $length; # Bytes to follow
4074
4075 my $str = $self->{_footer}; # footer string
4076 my $cch = length($str); # Length of footer string
4077 my $encoding = $self->{_footer_encoding}; # Character encoding
4078
4079
4080 # Character length is num of chars not num of bytes
4081 $cch /= 2 if $encoding;
4082
4083 # Change the UTF-16 name from BE to LE
4084 $str = pack 'n*', unpack 'v*', $str if $encoding;
4085
4086 $length = 3 + length($str);
4087
4088 my $header = pack("vv", $record, $length);
4089 my $data = pack("vC", $cch, $encoding);
4090
4091 $self->_prepend($header, $data, $str);
4092}
4093
4094
4095###############################################################################
4096#
4097# _store_hcenter()
4098#
4099# Store the horizontal centering HCENTER BIFF record.
4100#
4101sub _store_hcenter {
4102
4103 my $self = shift;
4104
4105 my $record = 0x0083; # Record identifier
4106 my $length = 0x0002; # Bytes to follow
4107
4108 my $fHCenter = $self->{_hcenter}; # Horizontal centering
4109
4110 my $header = pack("vv", $record, $length);
4111 my $data = pack("v", $fHCenter);
4112
4113 $self->_prepend($header, $data);
4114}
4115
4116
4117###############################################################################
4118#
4119# _store_vcenter()
4120#
4121# Store the vertical centering VCENTER BIFF record.
4122#
4123sub _store_vcenter {
4124
4125 my $self = shift;
4126
4127 my $record = 0x0084; # Record identifier
4128 my $length = 0x0002; # Bytes to follow
4129
4130 my $fVCenter = $self->{_vcenter}; # Horizontal centering
4131
4132 my $header = pack("vv", $record, $length);
4133 my $data = pack("v", $fVCenter);
4134
4135 $self->_prepend($header, $data);
4136}
4137
4138
4139###############################################################################
4140#
4141# _store_margin_left()
4142#
4143# Store the LEFTMARGIN BIFF record.
4144#
4145sub _store_margin_left {
4146
4147 my $self = shift;
4148
4149 my $record = 0x0026; # Record identifier
4150 my $length = 0x0008; # Bytes to follow
4151
4152 my $margin = $self->{_margin_left}; # Margin in inches
4153
4154 my $header = pack("vv", $record, $length);
4155 my $data = pack("d", $margin);
4156
4157 if ($self->{_byte_order}) { $data = reverse $data }
4158
4159 $self->_prepend($header, $data);
4160}
4161
4162
4163###############################################################################
4164#
4165# _store_margin_right()
4166#
4167# Store the RIGHTMARGIN BIFF record.
4168#
4169sub _store_margin_right {
4170
4171 my $self = shift;
4172
4173 my $record = 0x0027; # Record identifier
4174 my $length = 0x0008; # Bytes to follow
4175
4176 my $margin = $self->{_margin_right}; # Margin in inches
4177
4178 my $header = pack("vv", $record, $length);
4179 my $data = pack("d", $margin);
4180
4181 if ($self->{_byte_order}) { $data = reverse $data }
4182
4183 $self->_prepend($header, $data);
4184}
4185
4186
4187###############################################################################
4188#
4189# _store_margin_top()
4190#
4191# Store the TOPMARGIN BIFF record.
4192#
4193sub _store_margin_top {
4194
4195 my $self = shift;
4196
4197 my $record = 0x0028; # Record identifier
4198 my $length = 0x0008; # Bytes to follow
4199
4200 my $margin = $self->{_margin_top}; # Margin in inches
4201
4202 my $header = pack("vv", $record, $length);
4203 my $data = pack("d", $margin);
4204
4205 if ($self->{_byte_order}) { $data = reverse $data }
4206
4207 $self->_prepend($header, $data);
4208}
4209
4210
4211###############################################################################
4212#
4213# _store_margin_bottom()
4214#
4215# Store the BOTTOMMARGIN BIFF record.
4216#
4217sub _store_margin_bottom {
4218
4219 my $self = shift;
4220
4221 my $record = 0x0029; # Record identifier
4222 my $length = 0x0008; # Bytes to follow
4223
4224 my $margin = $self->{_margin_bottom}; # Margin in inches
4225
4226 my $header = pack("vv", $record, $length);
4227 my $data = pack("d", $margin);
4228
4229 if ($self->{_byte_order}) { $data = reverse $data }
4230
4231 $self->_prepend($header, $data);
4232}
4233
4234
4235###############################################################################
4236#
4237# merge_cells($first_row, $first_col, $last_row, $last_col)
4238#
4239# This is an Excel97/2000 method. It is required to perform more complicated
4240# merging than the normal align merge in Format.pm
4241#
4242sub merge_cells {
4243
4244 my $self = shift;
4245
4246 # Check for a cell reference in A1 notation and substitute row and column
4247 if ($_[0] =~ /^\D/) {
4248 @_ = $self->_substitute_cellref(@_);
4249 }
4250
4251 my $record = 0x00E5; # Record identifier
4252 my $length = 0x000A; # Bytes to follow
4253
4254 my $cref = 1; # Number of refs
4255 my $rwFirst = $_[0]; # First row in reference
4256 my $colFirst = $_[1]; # First col in reference
4257 my $rwLast = $_[2] || $rwFirst; # Last row in reference
4258 my $colLast = $_[3] || $colFirst; # Last col in reference
4259
4260
4261 # Excel doesn't allow a single cell to be merged
4262 return if $rwFirst == $rwLast and $colFirst == $colLast;
4263
4264 # Swap last row/col with first row/col as necessary
4265 ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
4266 ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
4267
4268 my $header = pack("vv", $record, $length);
4269 my $data = pack("vvvvv", $cref,
4270 $rwFirst, $rwLast,
4271 $colFirst, $colLast);
4272
4273 $self->_append($header, $data);
4274}
4275
4276
4277###############################################################################
4278#
4279# merge_range($row1, $col1, $row2, $col2, $string, $format, $encoding)
4280#
4281# This is a wrapper to ensure correct use of the merge_cells method, i.e., write
4282# the first cell of the range, write the formatted blank cells in the range and
4283# then call the merge_cells record. Failing to do the steps in this order will
4284# cause Excel 97 to crash.
4285#
4286sub merge_range {
4287
4288 my $self = shift;
4289
4290 # Check for a cell reference in A1 notation and substitute row and column
4291 if ($_[0] =~ /^\D/) {
4292 @_ = $self->_substitute_cellref(@_);
4293 }
4294 croak "Incorrect number of arguments" if @_ != 6 and @_ != 7;
4295 croak "Format argument is not a format object" unless ref $_[5];
4296
4297 my $rwFirst = $_[0];
4298 my $colFirst = $_[1];
4299 my $rwLast = $_[2];
4300 my $colLast = $_[3];
4301 my $string = $_[4];
4302 my $format = $_[5];
4303 my $encoding = $_[6] ? 1 : 0;
4304
4305
4306 # Temp code to prevent merged formats in non-merged cells.
4307 my $error = "Error: refer to merge_range() in the documentation. " .
4308 "Can't use previously non-merged format in merged cells";
4309
4310 croak $error if $format->{_used_merge} == -1;
4311 $format->{_used_merge} = 0; # Until the end of this function.
4312
4313
4314 # Set the merge_range property of the format object. For BIFF8+.
4315 $format->set_merge_range();
4316
4317 # Excel doesn't allow a single cell to be merged
4318 croak "Can't merge single cell" if $rwFirst == $rwLast and
4319 $colFirst == $colLast;
4320
4321 # Swap last row/col with first row/col as necessary
4322 ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
4323 ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
4324
4325 # Write the first cell
4326 if ($encoding) {
4327 $self->write_utf16be_string($rwFirst, $colFirst, $string, $format);
4328 }
4329 else {
4330 $self->write ($rwFirst, $colFirst, $string, $format);
4331 }
4332
4333 # Pad out the rest of the area with formatted blank cells.
4334 for my $row ($rwFirst .. $rwLast) {
4335 for my $col ($colFirst .. $colLast) {
4336 next if $row == $rwFirst and $col == $colFirst;
4337 $self->write_blank($row, $col, $format);
4338 }
4339 }
4340
4341 $self->merge_cells($rwFirst, $colFirst, $rwLast, $colLast);
4342
4343 # Temp code to prevent merged formats in non-merged cells.
4344 $format->{_used_merge} = 1;
4345
4346}
4347
4348
4349###############################################################################
4350#
4351# _store_print_headers()
4352#
4353# Write the PRINTHEADERS BIFF record.
4354#
4355sub _store_print_headers {
4356
4357 my $self = shift;
4358
4359 my $record = 0x002a; # Record identifier
4360 my $length = 0x0002; # Bytes to follow
4361
4362 my $fPrintRwCol = $self->{_print_headers}; # Boolean flag
4363
4364 my $header = pack("vv", $record, $length);
4365 my $data = pack("v", $fPrintRwCol);
4366
4367 $self->_prepend($header, $data);
4368}
4369
4370
4371###############################################################################
4372#
4373# _store_print_gridlines()
4374#
4375# Write the PRINTGRIDLINES BIFF record. Must be used in conjunction with the
4376# GRIDSET record.
4377#
4378sub _store_print_gridlines {
4379
4380 my $self = shift;
4381
4382 my $record = 0x002b; # Record identifier
4383 my $length = 0x0002; # Bytes to follow
4384
4385 my $fPrintGrid = $self->{_print_gridlines}; # Boolean flag
4386
4387 my $header = pack("vv", $record, $length);
4388 my $data = pack("v", $fPrintGrid);
4389
4390 $self->_prepend($header, $data);
4391}
4392
4393
4394###############################################################################
4395#
4396# _store_gridset()
4397#
4398# Write the GRIDSET BIFF record. Must be used in conjunction with the
4399# PRINTGRIDLINES record.
4400#
4401sub _store_gridset {
4402
4403 my $self = shift;
4404
4405 my $record = 0x0082; # Record identifier
4406 my $length = 0x0002; # Bytes to follow
4407
4408 my $fGridSet = not $self->{_print_gridlines}; # Boolean flag
4409
4410 my $header = pack("vv", $record, $length);
4411 my $data = pack("v", $fGridSet);
4412
4413 $self->_prepend($header, $data);
4414
4415}
4416
4417
4418###############################################################################
4419#
4420# _store_guts()
4421#
4422# Write the GUTS BIFF record. This is used to configure the gutter margins
4423# where Excel outline symbols are displayed. The visibility of the gutters is
4424# controlled by a flag in WSBOOL. See also _store_wsbool().
4425#
4426# We are all in the gutter but some of us are looking at the stars.
4427#
4428sub _store_guts {
4429
4430 my $self = shift;
4431
4432 my $record = 0x0080; # Record identifier
4433 my $length = 0x0008; # Bytes to follow
4434
4435 my $dxRwGut = 0x0000; # Size of row gutter
4436 my $dxColGut = 0x0000; # Size of col gutter
4437
4438 my $row_level = $self->{_outline_row_level};
4439 my $col_level = 0;
4440
4441
4442 # Calculate the maximum column outline level. The equivalent calculation
4443 # for the row outline level is carried out in set_row().
4444 #
4445 foreach my $colinfo (@{$self->{_colinfo}}) {
4446 # Skip cols without outline level info.
4447 next if @{$colinfo} < 6;
4448 $col_level = @{$colinfo}[5] if @{$colinfo}[5] > $col_level;
4449 }
4450
4451
4452 # Set the limits for the outline levels (0 <= x <= 7).
4453 $col_level = 0 if $col_level < 0;
4454 $col_level = 7 if $col_level > 7;
4455
4456
4457 # The displayed level is one greater than the max outline levels
4458 $row_level++ if $row_level > 0;
4459 $col_level++ if $col_level > 0;
4460
4461 my $header = pack("vv", $record, $length);
4462 my $data = pack("vvvv", $dxRwGut, $dxColGut, $row_level, $col_level);
4463
4464 $self->_prepend($header, $data);
4465
4466}
4467
4468
4469###############################################################################
4470#
4471# _store_wsbool()
4472#
4473# Write the WSBOOL BIFF record, mainly for fit-to-page. Used in conjunction
4474# with the SETUP record.
4475#
4476sub _store_wsbool {
4477
4478 my $self = shift;
4479
4480 my $record = 0x0081; # Record identifier
4481 my $length = 0x0002; # Bytes to follow
4482
4483 my $grbit = 0x0000; # Option flags
4484
4485 # Set the option flags
4486 $grbit |= 0x0001; # Auto page breaks visible
4487 $grbit |= 0x0020 if $self->{_outline_style}; # Auto outline styles
4488 $grbit |= 0x0040 if $self->{_outline_below}; # Outline summary below
4489 $grbit |= 0x0080 if $self->{_outline_right}; # Outline summary right
4490 $grbit |= 0x0100 if $self->{_fit_page}; # Page setup fit to page
4491 $grbit |= 0x0400 if $self->{_outline_on}; # Outline symbols displayed
4492
4493
4494 my $header = pack("vv", $record, $length);
4495 my $data = pack("v", $grbit);
4496
4497 $self->_prepend($header, $data);
4498}
4499
4500
4501###############################################################################
4502#
4503# _store_hbreak()
4504#
4505# Write the HORIZONTALPAGEBREAKS BIFF record.
4506#
4507sub _store_hbreak {
4508
4509 my $self = shift;
4510
4511 # Return if the user hasn't specified pagebreaks
4512 return unless @{$self->{_hbreaks}};
4513
4514 # Sort and filter array of page breaks
4515 my @breaks = $self->_sort_pagebreaks(@{$self->{_hbreaks}});
4516
4517 my $record = 0x001b; # Record identifier
4518 my $cbrk = scalar @breaks; # Number of page breaks
4519 my $length = 2 + 6*$cbrk; # Bytes to follow
4520
4521
4522 my $header = pack("vv", $record, $length);
4523 my $data = pack("v", $cbrk);
4524
4525 # Append each page break
4526 foreach my $break (@breaks) {
4527 $data .= pack("vvv", $break, 0x0000, 0x00ff);
4528 }
4529
4530 $self->_prepend($header, $data);
4531}
4532
4533
4534###############################################################################
4535#
4536# _store_vbreak()
4537#
4538# Write the VERTICALPAGEBREAKS BIFF record.
4539#
4540sub _store_vbreak {
4541
4542 my $self = shift;
4543
4544 # Return if the user hasn't specified pagebreaks
4545 return unless @{$self->{_vbreaks}};
4546
4547 # Sort and filter array of page breaks
4548 my @breaks = $self->_sort_pagebreaks(@{$self->{_vbreaks}});
4549
4550 my $record = 0x001a; # Record identifier
4551 my $cbrk = scalar @breaks; # Number of page breaks
4552 my $length = 2 + 6*$cbrk; # Bytes to follow
4553
4554
4555 my $header = pack("vv", $record, $length);
4556 my $data = pack("v", $cbrk);
4557
4558 # Append each page break
4559 foreach my $break (@breaks) {
4560 $data .= pack("vvv", $break, 0x0000, 0xffff);
4561 }
4562
4563 $self->_prepend($header, $data);
4564}
4565
4566
4567###############################################################################
4568#
4569# _store_protect()
4570#
4571# Set the Biff PROTECT record to indicate that the worksheet is protected.
4572#
4573sub _store_protect {
4574
4575 my $self = shift;
4576
4577 # Exit unless sheet protection has been specified
4578 return unless $self->{_protect};
4579
4580 my $record = 0x0012; # Record identifier
4581 my $length = 0x0002; # Bytes to follow
4582
4583 my $fLock = $self->{_protect}; # Worksheet is protected
4584
4585 my $header = pack("vv", $record, $length);
4586 my $data = pack("v", $fLock);
4587
4588 $self->_prepend($header, $data);
4589}
4590
4591
4592###############################################################################
4593#
4594# _store_obj_protect()
4595#
4596# Set the Biff OBJPROTECT record to indicate that objects are protected.
4597#
4598sub _store_obj_protect {
4599
4600 my $self = shift;
4601
4602 # Exit unless sheet protection has been specified
4603 return unless $self->{_protect};
4604
4605 my $record = 0x0063; # Record identifier
4606 my $length = 0x0002; # Bytes to follow
4607
4608 my $fLock = $self->{_protect}; # Worksheet is protected
4609
4610 my $header = pack("vv", $record, $length);
4611 my $data = pack("v", $fLock);
4612
4613 $self->_prepend($header, $data);
4614}
4615
4616
4617###############################################################################
4618#
4619# _store_password()
4620#
4621# Write the worksheet PASSWORD record.
4622#
4623sub _store_password {
4624
4625 my $self = shift;
4626
4627 # Exit unless sheet protection and password have been specified
4628 return unless $self->{_protect} and defined $self->{_password};
4629
4630 my $record = 0x0013; # Record identifier
4631 my $length = 0x0002; # Bytes to follow
4632
4633 my $wPassword = $self->{_password}; # Encoded password
4634
4635 my $header = pack("vv", $record, $length);
4636 my $data = pack("v", $wPassword);
4637
4638 $self->_prepend($header, $data);
4639}
4640
4641
4642#
4643# Note about compatibility mode.
4644#
4645# Excel doesn't require every possible Biff record to be present in a file.
4646# In particular if the indexing records INDEX, ROW and DBCELL aren't present
4647# it just ignores the fact and reads the cells anyway. This is also true of
4648# the EXTSST record. Gnumeric and OOo also take this approach. This allows
4649# WriteExcel to ignore these records in order to minimise the amount of data
4650# stored in memory. However, other third party applications that read Excel
4651# files often expect these records to be present. In "compatibility mode"
4652# WriteExcel writes these records and tries to be as close to an Excel
4653# generated file as possible.
4654#
4655# This requires additional data to be stored in memory until the file is
4656# about to be written. This incurs a memory and speed penalty and may not be
4657# suitable for very large files.
4658#
4659
4660
4661
4662###############################################################################
4663#
4664# _store_table()
4665#
4666# Write cell data stored in the worksheet row/col table.
4667#
4668# This is only used when compatibity_mode() is in operation.
4669#
4670# This method writes ROW data, then cell data (NUMBER, LABELSST, etc) and then
4671# DBCELL records in blocks of 32 rows. This is explained in detail (for a
4672# change) in the Excel SDK and in the OOo Excel file format doc.
4673#
4674sub _store_table {
4675
4676 my $self = shift;
4677
4678 return unless $self->{_compatibility};
4679
4680 # Offset from the DBCELL record back to the first ROW of the 32 row block.
4681 my $row_offset = 0;
4682
4683 # Track rows that have cell data or modified by set_row().
4684 my @written_rows;
4685
4686
4687 # Write the ROW records with updated max/min col fields.
4688 #
4689 for my $row (0 .. $self->{_dim_rowmax} -1) {
4690 # Skip unless there is cell data in row or the row has been modified.
4691 next unless $self->{_table}->[$row] or $self->{_row_data}->{$row};
4692
4693 # Store the rows with data.
4694 push @written_rows, $row;
4695
4696 # Increase the row offset by the length of a ROW record;
4697 $row_offset += 20;
4698
4699 # The max/min cols in the ROW records are the same as in DIMENSIONS.
4700 my $col_min = $self->{_dim_colmin};
4701 my $col_max = $self->{_dim_colmax};
4702
4703 # Write a user specified ROW record (modified by set_row()).
4704 if ($self->{_row_data}->{$row}) {
4705 # Rewrite the min and max cols for user defined row record.
4706 my $packed_row = $self->{_row_data}->{$row};
4707 substr $packed_row, 6, 4, pack('vv', $col_min, $col_max);
4708 $self->_append($packed_row);
4709 }
4710 else {
4711 # Write a default Row record if there isn't a user defined ROW.
4712 $self->_write_row_default($row, $col_min, $col_max);
4713 }
4714
4715
4716
4717 # If 32 rows have been written or we are at the last row in the
4718 # worksheet then write the cell data and the DBCELL record.
4719 #
4720 if (@written_rows == 32 or $row == $self->{_dim_rowmax} -1) {
4721
4722 # Offsets to the first cell of each row.
4723 my @cell_offsets;
4724 push @cell_offsets, $row_offset - 20;
4725
4726 # Write the cell data in each row and sum their lengths for the
4727 # cell offsets.
4728 #
4729 for my $row (@written_rows) {
4730 my $cell_offset = 0;
4731
4732 for my $col (@{$self->{_table}->[$row]}) {
4733 next unless $col;
4734 $self->_append($col);
4735 my $length = length $col;
4736 $row_offset += $length;
4737 $cell_offset += $length;
4738 }
4739 push @cell_offsets, $cell_offset;
4740 }
4741
4742 # The last offset isn't required.
4743 pop @cell_offsets;
4744
4745 # Stores the DBCELL offset for use in the INDEX record.
4746 push @{$self->{_db_indices}}, $self->{_datasize};
4747
4748 # Write the DBCELL record.
4749 $self->_store_dbcell($row_offset, @cell_offsets);
4750
4751 # Clear the variable for the next block of rows.
4752 @written_rows = ();
4753 @cell_offsets = ();
4754 $row_offset = 0;
4755 }
4756 }
4757}
4758
4759
4760###############################################################################
4761#
4762# _store_dbcell()
4763#
4764# Store the DBCELL record using the offset calculated in _store_table().
4765#
4766# This is only used when compatibity_mode() is in operation.
4767#
4768sub _store_dbcell {
4769
4770 my $self = shift;
4771 my $row_offset = shift;
4772 my @cell_offsets = @_;
4773
4774
4775 my $record = 0x00D7; # Record identifier
4776 my $length = 4 + 2 * @cell_offsets; # Bytes to follow
4777
4778
4779 my $header = pack 'vv', $record, $length;
4780 my $data = pack 'V', $row_offset;
4781 $data .= pack 'v', $_ for @cell_offsets;
4782
4783 $self->_append($header, $data);
4784}
4785
4786
4787###############################################################################
4788#
4789# _store_index()
4790#
4791# Store the INDEX record using the DBCELL offsets calculated in _store_table().
4792#
4793# This is only used when compatibity_mode() is in operation.
4794#
4795sub _store_index {
4796
4797 my $self = shift;
4798
4799 return unless $self->{_compatibility};
4800
4801 my @indices = @{$self->{_db_indices}};
4802 my $reserved = 0x00000000;
4803 my $row_min = $self->{_dim_rowmin};
4804 my $row_max = $self->{_dim_rowmax};
4805
4806 my $record = 0x020B; # Record identifier
4807 my $length = 16 + 4 * @indices; # Bytes to follow
4808
4809 my $header = pack 'vv', $record, $length;
4810 my $data = pack 'VVVV', $reserved,
4811 $row_min,
4812 $row_max,
4813 $reserved;
4814
4815 for my $index (@indices) {
4816 $data .= pack 'V', $index + $self->{_offset} + 20 + $length +4;
4817 }
4818
4819 $self->_prepend($header, $data);
4820
4821}
4822
4823
4824###############################################################################
4825#
4826# insert_chart($row, $col, $chart, $x, $y, $scale_x, $scale_y)
4827#
4828# Insert a chart into a worksheet. The $chart argument should be a Chart
4829# object or else it is assumed to be a filename of an external binary file.
4830# The latter is for backwards compatibility.
4831#
4832sub insert_chart {
4833
4834 my $self = shift;
4835
4836 # Check for a cell reference in A1 notation and substitute row and column
4837 if ($_[0] =~ /^\D/) {
4838 @_ = $self->_substitute_cellref(@_);
4839 }
4840
4841 my $row = $_[0];
4842 my $col = $_[1];
4843 my $chart = $_[2];
4844 my $x_offset = $_[3] || 0;
4845 my $y_offset = $_[4] || 0;
4846 my $scale_x = $_[5] || 1;
4847 my $scale_y = $_[6] || 1;
4848
4849 croak "Insufficient arguments in insert_chart()" unless @_ >= 3;
4850
4851 if ( ref $chart ) {
4852 # Check for a Chart object.
4853 croak "Not a Chart object in insert_chart()"
4854 unless $chart->isa( 'Spreadsheet::WriteExcel::Chart' );
4855
4856 # Check that the chart is an embedded style chart.
4857 croak "Not a embedded style Chart object in insert_chart()"
4858 unless $chart->{_embedded};
4859
4860 }
4861 else {
4862
4863 # Assume an external bin filename.
4864 croak "Couldn't locate $chart in insert_chart(): $!" unless -e $chart;
4865 }
4866
4867 $self->{_charts}->{$row}->{$col} = [
4868 $row,
4869 $col,
4870 $chart,
4871 $x_offset,
4872 $y_offset,
4873 $scale_x,
4874 $scale_y,
4875 ];
4876
4877}
4878
4879# Older method name for backwards compatibility.
4880*embed_chart = *insert_chart;
4881
4882###############################################################################
4883#
4884# insert_image($row, $col, $filename, $x, $y, $scale_x, $scale_y)
4885#
4886# Insert an image into the worksheet.
4887#
4888sub insert_image {
4889
4890 my $self = shift;
4891
4892 # Check for a cell reference in A1 notation and substitute row and column
4893 if ($_[0] =~ /^\D/) {
4894 @_ = $self->_substitute_cellref(@_);
4895 }
4896
4897 my $row = $_[0];
4898 my $col = $_[1];
4899 my $image = $_[2];
4900 my $x_offset = $_[3] || 0;
4901 my $y_offset = $_[4] || 0;
4902 my $scale_x = $_[5] || 1;
4903 my $scale_y = $_[6] || 1;
4904
4905 croak "Insufficient arguments in insert_image()" unless @_ >= 3;
4906 croak "Couldn't locate $image: $!" unless -e $image;
4907
4908 $self->{_images}->{$row}->{$col} = [
4909 $row,
4910 $col,
4911 $image,
4912 $x_offset,
4913 $y_offset,
4914 $scale_x,
4915 $scale_y,
4916 ];
4917
4918}
4919
4920# Older method name for backwards compatibility.
4921*insert_bitmap = *insert_image;
4922
4923
4924###############################################################################
4925#
4926# _position_object()
4927#
4928# Calculate the vertices that define the position of a graphical object within
4929# the worksheet.
4930#
4931# +------------+------------+
4932# | A | B |
4933# +-----+------------+------------+
4934# | |(x1,y1) | |
4935# | 1 |(A1)._______|______ |
4936# | | | | |
4937# | | | | |
4938# +-----+----| BITMAP |-----+
4939# | | | | |
4940# | 2 | |______________. |
4941# | | | (B2)|
4942# | | | (x2,y2)|
4943# +---- +------------+------------+
4944#
4945# Example of a bitmap that covers some of the area from cell A1 to cell B2.
4946#
4947# Based on the width and height of the bitmap we need to calculate 8 vars:
4948# $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2.
4949# The width and height of the cells are also variable and have to be taken into
4950# account.
4951# The values of $col_start and $row_start are passed in from the calling
4952# function. The values of $col_end and $row_end are calculated by subtracting
4953# the width and height of the bitmap from the width and height of the
4954# underlying cells.
4955# The vertices are expressed as a percentage of the underlying cell width as
4956# follows (rhs values are in pixels):
4957#
4958# x1 = X / W *1024
4959# y1 = Y / H *256
4960# x2 = (X-1) / W *1024
4961# y2 = (Y-1) / H *256
4962#
4963# Where: X is distance from the left side of the underlying cell
4964# Y is distance from the top of the underlying cell
4965# W is the width of the cell
4966# H is the height of the cell
4967#
4968# Note: the SDK incorrectly states that the height should be expressed as a
4969# percentage of 1024.
4970#
4971sub _position_object {
4972
4973 my $self = shift;
4974
4975 my $col_start; # Col containing upper left corner of object
4976 my $x1; # Distance to left side of object
4977
4978 my $row_start; # Row containing top left corner of object
4979 my $y1; # Distance to top of object
4980
4981 my $col_end; # Col containing lower right corner of object
4982 my $x2; # Distance to right side of object
4983
4984 my $row_end; # Row containing bottom right corner of object
4985 my $y2; # Distance to bottom of object
4986
4987 my $width; # Width of image frame
4988 my $height; # Height of image frame
4989
4990 ($col_start, $row_start, $x1, $y1, $width, $height) = @_;
4991
4992
4993 # Adjust start column for offsets that are greater than the col width
4994 while ($x1 >= $self->_size_col($col_start)) {
4995 $x1 -= $self->_size_col($col_start);
4996 $col_start++;
4997 }
4998
4999 # Adjust start row for offsets that are greater than the row height
5000 while ($y1 >= $self->_size_row($row_start)) {
5001 $y1 -= $self->_size_row($row_start);
5002 $row_start++;
5003 }
5004
5005
5006 # Initialise end cell to the same as the start cell
5007 $col_end = $col_start;
5008 $row_end = $row_start;
5009
5010 $width = $width + $x1;
5011 $height = $height + $y1;
5012
5013
5014 # Subtract the underlying cell widths to find the end cell of the image
5015 while ($width >= $self->_size_col($col_end)) {
5016 $width -= $self->_size_col($col_end);
5017 $col_end++;
5018 }
5019
5020 # Subtract the underlying cell heights to find the end cell of the image
5021 while ($height >= $self->_size_row($row_end)) {
5022 $height -= $self->_size_row($row_end);
5023 $row_end++;
5024 }
5025
5026 # Bitmap isn't allowed to start or finish in a hidden cell, i.e. a cell
5027 # with zero eight or width.
5028 #
5029 return if $self->_size_col($col_start) == 0;
5030 return if $self->_size_col($col_end) == 0;
5031 return if $self->_size_row($row_start) == 0;
5032 return if $self->_size_row($row_end) == 0;
5033
5034 # Convert the pixel values to the percentage value expected by Excel
5035 $x1 = $x1 / $self->_size_col($col_start) * 1024;
5036 $y1 = $y1 / $self->_size_row($row_start) * 256;
5037 $x2 = $width / $self->_size_col($col_end) * 1024;
5038 $y2 = $height / $self->_size_row($row_end) * 256;
5039
5040 # Simulate ceil() without calling POSIX::ceil().
5041 $x1 = int($x1 +0.5);
5042 $y1 = int($y1 +0.5);
5043 $x2 = int($x2 +0.5);
5044 $y2 = int($y2 +0.5);
5045
5046 return( $col_start, $x1,
5047 $row_start, $y1,
5048 $col_end, $x2,
5049 $row_end, $y2
5050 );
5051}
5052
5053
5054###############################################################################
5055#
5056# _size_col($col)
5057#
5058# Convert the width of a cell from user's units to pixels. Excel rounds the
5059# column width to the nearest pixel. If the width hasn't been set by the user
5060# we use the default value. If the column is hidden we use a value of zero.
5061#
5062sub _size_col {
5063
5064 my $self = shift;
5065 my $col = $_[0];
5066
5067 # Look up the cell value to see if it has been changed
5068 if (exists $self->{_col_sizes}->{$col}) {
5069 my $width = $self->{_col_sizes}->{$col};
5070
5071 # The relationship is different for user units less than 1.
5072 if ($width < 1) {
5073 return int($width *12);
5074 }
5075 else {
5076 return int($width *7 ) +5;
5077 }
5078 }
5079 else {
5080 return 64;
5081 }
5082}
5083
5084
5085###############################################################################
5086#
5087# _size_row($row)
5088#
5089# Convert the height of a cell from user's units to pixels. By interpolation
5090# the relationship is: y = 4/3x. If the height hasn't been set by the user we
5091# use the default value. If the row is hidden we use a value of zero. (Not
5092# possible to hide row yet).
5093#
5094sub _size_row {
5095
5096 my $self = shift;
5097 my $row = $_[0];
5098
5099 # Look up the cell value to see if it has been changed
5100 if (exists $self->{_row_sizes}->{$row}) {
5101 if ($self->{_row_sizes}->{$row} == 0) {
5102 return 0;
5103 }
5104 else {
5105 return int (4/3 * $self->{_row_sizes}->{$row});
5106 }
5107 }
5108 else {
5109 return 17;
5110 }
5111}
5112
5113
5114###############################################################################
5115#
5116# _store_zoom($zoom)
5117#
5118#
5119# Store the window zoom factor. This should be a reduced fraction but for
5120# simplicity we will store all fractions with a numerator of 100.
5121#
5122sub _store_zoom {
5123
5124 my $self = shift;
5125
5126 # If scale is 100 we don't need to write a record
5127 return if $self->{_zoom} == 100;
5128
5129 my $record = 0x00A0; # Record identifier
5130 my $length = 0x0004; # Bytes to follow
5131
5132 my $header = pack("vv", $record, $length );
5133 my $data = pack("vv", $self->{_zoom}, 100);
5134
5135 $self->_append($header, $data);
5136}
5137
5138
5139###############################################################################
5140#
5141# write_utf16be_string($row, $col, $string, $format)
5142#
5143# Write a Unicode string to the specified row and column (zero indexed).
5144# $format is optional.
5145# Returns 0 : normal termination
5146# -1 : insufficient number of arguments
5147# -2 : row or column out of range
5148# -3 : long string truncated to 255 chars
5149#
5150sub write_utf16be_string {
5151
5152 my $self = shift;
5153
5154 # Check for a cell reference in A1 notation and substitute row and column
5155 if ($_[0] =~ /^\D/) {
5156 @_ = $self->_substitute_cellref(@_);
5157 }
5158
5159 if (@_ < 3) { return -1 } # Check the number of args
5160
5161 my $record = 0x00FD; # Record identifier
5162 my $length = 0x000A; # Bytes to follow
5163
5164 my $row = $_[0]; # Zero indexed row
5165 my $col = $_[1]; # Zero indexed column
5166 my $strlen = length($_[2]);
5167 my $str = $_[2];
5168 my $xf = _XF($self, $row, $col, $_[3]); # The cell format
5169 my $encoding = 0x1;
5170 my $str_error = 0;
5171
5172 # Check that row and col are valid and store max and min values
5173 return -2 if $self->_check_dimensions($row, $col);
5174
5175 # Limit the utf16 string to the max number of chars (not bytes).
5176 if ($strlen > 32767* 2) {
5177 $str = substr($str, 0, 32767*2);
5178 $str_error = -3;
5179 }
5180
5181
5182 my $num_bytes = length $str;
5183 my $num_chars = int($num_bytes / 2);
5184
5185
5186 # Check for a valid 2-byte char string.
5187 croak "Uneven number of bytes in Unicode string" if $num_bytes % 2;
5188
5189
5190 # Change from UTF16 big-endian to little endian
5191 $str = pack "v*", unpack "n*", $str;
5192
5193
5194 # Add the encoding and length header to the string.
5195 my $str_header = pack("vC", $num_chars, $encoding);
5196 $str = $str_header . $str;
5197
5198
5199 if (not exists ${$self->{_str_table}}->{$str}) {
5200 ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
5201 }
5202
5203
5204 ${$self->{_str_total}}++;
5205
5206
5207 my $header = pack("vv", $record, $length);
5208 my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
5209
5210 # Store the data or write immediately depending on the compatibility mode.
5211 if ($self->{_compatibility}) {
5212 $self->{_table}->[$row]->[$col] = $header . $data;
5213 }
5214 else {
5215 $self->_append($header, $data);
5216 }
5217
5218 return $str_error;
5219}
5220
5221
5222###############################################################################
5223#
5224# write_utf16le_string($row, $col, $string, $format)
5225#
5226# Write a UTF-16LE string to the specified row and column (zero indexed).
5227# $format is optional.
5228# Returns 0 : normal termination
5229# -1 : insufficient number of arguments
5230# -2 : row or column out of range
5231# -3 : long string truncated to 255 chars
5232#
5233sub write_utf16le_string {
5234
5235 my $self = shift;
5236
5237 # Check for a cell reference in A1 notation and substitute row and column
5238 if ($_[0] =~ /^\D/) {
5239 @_ = $self->_substitute_cellref(@_);
5240 }
5241
5242 if (@_ < 3) { return -1 } # Check the number of args
5243
5244 my $record = 0x00FD; # Record identifier
5245 my $length = 0x000A; # Bytes to follow
5246
5247 my $row = $_[0]; # Zero indexed row
5248 my $col = $_[1]; # Zero indexed column
5249 my $str = $_[2];
5250 my $format = $_[3]; # The cell format
5251
5252
5253 # Change from UTF16 big-endian to little endian
5254 $str = pack "v*", unpack "n*", $str;
5255
5256
5257 return $self->write_utf16be_string($row, $col, $str, $format);
5258}
5259
5260
5261# Older method name for backwards compatibility.
5262*write_unicode = *write_utf16be_string;
5263*write_unicode_le = *write_utf16le_string;
5264
5265
5266
5267###############################################################################
5268#
5269# _store_autofilters()
5270#
5271# Function to iterate through the columns that form part of an autofilter
5272# range and write Biff AUTOFILTER records if a filter expression has been set.
5273#
5274sub _store_autofilters {
5275
5276 my $self = shift;
5277
5278 # Skip all columns if no filter have been set.
5279 return unless $self->{_filter_on};
5280
5281 my (undef, undef, $col1, $col2) = @{$self->{_filter_area}};
5282
5283 for my $i ($col1 .. $col2) {
5284 # Reverse order since records are being pre-pended.
5285 my $col = $col2 -$i;
5286
5287 # Skip if column doesn't have an active filter.
5288 next unless $self->{_filter_cols}->{$col};
5289
5290 # Retrieve the filter tokens and write the autofilter records.
5291 my @tokens = @{$self->{_filter_cols}->{$col}};
5292 $self->_store_autofilter($col, @tokens);
5293 }
5294}
5295
5296
5297###############################################################################
5298#
5299# _store_autofilter()
5300#
5301# Function to write worksheet AUTOFILTER records. These contain 2 Biff Doper
5302# structures to represent the 2 possible filter conditions.
5303#
5304sub _store_autofilter {
5305
5306 my $self = shift;
5307
5308 my $record = 0x009E;
5309 my $length = 0x0000;
5310
5311 my $index = $_[0];
5312 my $operator_1 = $_[1];
5313 my $token_1 = $_[2];
5314 my $join = $_[3]; # And/Or
5315 my $operator_2 = $_[4];
5316 my $token_2 = $_[5];
5317
5318 my $top10_active = 0;
5319 my $top10_direction = 0;
5320 my $top10_percent = 0;
5321 my $top10_value = 101;
5322
5323 my $grbit = $join;
5324 my $optimised_1 = 0;
5325 my $optimised_2 = 0;
5326 my $doper_1 = '';
5327 my $doper_2 = '';
5328 my $string_1 = '';
5329 my $string_2 = '';
5330
5331 # Excel used an optimisation in the case of a simple equality.
5332 $optimised_1 = 1 if $operator_1 == 2;
5333 $optimised_2 = 1 if defined $operator_2 and $operator_2 == 2;
5334
5335
5336 # Convert non-simple equalities back to type 2. See _parse_filter_tokens().
5337 $operator_1 = 2 if $operator_1 == 22;
5338 $operator_2 = 2 if defined $operator_2 and $operator_2 == 22;
5339
5340
5341 # Handle a "Top" style expression.
5342 if ($operator_1 >= 30) {
5343 # Remove the second expression if present.
5344 $operator_2 = undef;
5345 $token_2 = undef;
5346
5347 # Set the active flag.
5348 $top10_active = 1;
5349
5350 if ($operator_1 == 30 or $operator_1 == 31) {
5351 $top10_direction = 1;
5352 }
5353
5354 if ($operator_1 == 31 or $operator_1 == 33) {
5355 $top10_percent = 1;
5356 }
5357
5358 if ($top10_direction == 1) {
5359 $operator_1 = 6
5360 }
5361 else {
5362 $operator_1 = 3
5363 }
5364
5365 $top10_value = $token_1;
5366 $token_1 = 0;
5367 }
5368
5369
5370 $grbit |= $optimised_1 << 2;
5371 $grbit |= $optimised_2 << 3;
5372 $grbit |= $top10_active << 4;
5373 $grbit |= $top10_direction << 5;
5374 $grbit |= $top10_percent << 6;
5375 $grbit |= $top10_value << 7;
5376
5377 ($doper_1, $string_1) = $self->_pack_doper($operator_1, $token_1);
5378 ($doper_2, $string_2) = $self->_pack_doper($operator_2, $token_2);
5379
5380 my $data = pack 'v', $index;
5381 $data .= pack 'v', $grbit;
5382 $data .= $doper_1;
5383 $data .= $doper_2;
5384 $data .= $string_1;
5385 $data .= $string_2;
5386
5387 $length = length $data;
5388 my $header = pack('vv', $record, $length);
5389
5390 $self->_prepend($header, $data);
5391}
5392
5393
5394###############################################################################
5395#
5396# _pack_doper()
5397#
5398# Create a Biff Doper structure that represents a filter expression. Depending
5399# on the type of the token we pack an Empty, String or Number doper.
5400#
5401sub _pack_doper {
5402
5403 my $self = shift;
5404
5405 my $operator = $_[0];
5406 my $token = $_[1];
5407
5408 my $doper = '';
5409 my $string = '';
5410
5411
5412 # Return default doper for non-defined filters.
5413 if (not defined $operator) {
5414 return ($self->_pack_unused_doper, $string);
5415 }
5416
5417
5418 if ($token =~ /^blanks|nonblanks$/i) {
5419 $doper = $self->_pack_blanks_doper($operator, $token);
5420 }
5421 elsif ($operator == 2 or
5422 $token !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
5423 {
5424 # Excel treats all tokens as strings if the operator is equality, =.
5425
5426 $string = $token;
5427
5428 my $encoding = 0;
5429 my $length = length $string;
5430
5431 # Handle utf8 strings in perl 5.8.
5432 if ($] >= 5.008) {
5433 require Encode;
5434
5435 if (Encode::is_utf8($string)) {
5436 $string = Encode::encode("UTF-16BE", $string);
5437 $encoding = 1;
5438 }
5439 }
5440
5441 $string = pack('C', $encoding) . $string;
5442 $doper = $self->_pack_string_doper($operator, $length);
5443 }
5444 else {
5445 $string = '';
5446 $doper = $self->_pack_number_doper($operator, $token);
5447 }
5448
5449 return ($doper, $string);
5450}
5451
5452
5453###############################################################################
5454#
5455# _pack_unused_doper()
5456#
5457# Pack an empty Doper structure.
5458#
5459sub _pack_unused_doper {
5460
5461 my $self = shift;
5462
5463 return pack 'C10', (0x0) x 10;
5464}
5465
5466
5467###############################################################################
5468#
5469# _pack_blanks_doper()
5470#
5471# Pack an Blanks/NonBlanks Doper structure.
5472#
5473sub _pack_blanks_doper {
5474
5475 my $self = shift;
5476
5477 my $operator = $_[0];
5478 my $token = $_[1];
5479 my $type;
5480
5481 if ($token eq 'blanks') {
5482 $type = 0x0C;
5483 $operator = 2;
5484
5485 }
5486 else {
5487 $type = 0x0E;
5488 $operator = 5;
5489 }
5490
5491
5492 my $doper = pack 'CCVV', $type, # Data type
5493 $operator, #
5494 0x0000, # Reserved
5495 0x0000; # Reserved
5496 return $doper;
5497}
5498
5499
5500###############################################################################
5501#
5502# _pack_string_doper()
5503#
5504# Pack an string Doper structure.
5505#
5506sub _pack_string_doper {
5507
5508 my $self = shift;
5509
5510 my $operator = $_[0];
5511 my $length = $_[1];
5512 my $doper = pack 'CCVCCCC', 0x06, # Data type
5513 $operator, #
5514 0x0000, # Reserved
5515 $length, # String char length.
5516 0x0, 0x0, 0x0; # Reserved
5517 return $doper;
5518}
5519
5520
5521###############################################################################
5522#
5523# _pack_number_doper()
5524#
5525# Pack an IEEE double number Doper structure.
5526#
5527sub _pack_number_doper {
5528
5529 my $self = shift;
5530
5531 my $operator = $_[0];
5532 my $number = $_[1];
5533 $number = pack 'd', $number;
5534 $number = reverse $number if $self->{_byte_order};
5535
5536 my $doper = pack 'CC', 0x04, $operator;
5537 $doper .= $number;
5538
5539 return $doper;
5540}
5541
5542
5543#
5544# Methods related to comments and MSO objects.
5545#
5546
5547
5548###############################################################################
5549#
5550# _prepare_images()
5551#
5552# Turn the HoH that stores the images into an array for easier handling.
5553#
5554sub _prepare_images {
5555
5556 my $self = shift;
5557
5558 my $count = 0;
5559 my @images;
5560
5561
5562 # We sort the images by row and column but that isn't strictly required.
5563 #
5564 my @rows = sort {$a <=> $b} keys %{$self->{_images}};
5565
5566 for my $row (@rows) {
5567 my @cols = sort {$a <=> $b} keys %{$self->{_images}->{$row}};
5568
5569 for my $col (@cols) {
5570 push @images, $self->{_images}->{$row}->{$col};
5571 $count++;
5572 }
5573 }
5574
5575 $self->{_images} = {};
5576 $self->{_images_array} = \@images;
5577
5578 return $count;
5579}
5580
5581
5582###############################################################################
5583#
5584# _prepare_comments()
5585#
5586# Turn the HoH that stores the comments into an array for easier handling.
5587#
5588sub _prepare_comments {
5589
5590 my $self = shift;
5591
5592 my $count = 0;
5593 my @comments;
5594
5595
5596 # We sort the comments by row and column but that isn't strictly required.
5597 #
5598 my @rows = sort {$a <=> $b} keys %{$self->{_comments}};
5599
5600 for my $row (@rows) {
5601 my @cols = sort {$a <=> $b} keys %{$self->{_comments}->{$row}};
5602
5603 for my $col (@cols) {
5604 push @comments, $self->{_comments}->{$row}->{$col};
5605 $count++;
5606 }
5607 }
5608
5609 $self->{_comments} = {};
5610 $self->{_comments_array} = \@comments;
5611
5612 return $count;
5613}
5614
5615
5616###############################################################################
5617#
5618# _prepare_charts()
5619#
5620# Turn the HoH that stores the charts into an array for easier handling.
5621#
5622sub _prepare_charts {
5623
5624 my $self = shift;
5625
5626 my $count = 0;
5627 my @charts;
5628
5629
5630 # We sort the charts by row and column but that isn't strictly required.
5631 #
5632 my @rows = sort {$a <=> $b} keys %{$self->{_charts}};
5633
5634 for my $row (@rows) {
5635 my @cols = sort {$a <=> $b} keys %{$self->{_charts}->{$row}};
5636
5637 for my $col (@cols) {
5638 push @charts, $self->{_charts}->{$row}->{$col};
5639 $count++;
5640 }
5641 }
5642
5643 $self->{_charts} = {};
5644 $self->{_charts_array} = \@charts;
5645
5646 return $count;
5647}
5648
5649
5650###############################################################################
5651#
5652# _store_images()
5653#
5654# Store the collections of records that make up images.
5655#
5656sub _store_images {
5657
5658 my $self = shift;
5659
5660 my $record = 0x00EC; # Record identifier
5661 my $length = 0x0000; # Bytes to follow
5662
5663 my @ids = @{$self->{_object_ids }};
5664 my $spid = shift @ids;
5665
5666 my @images = @{$self->{_images_array}};
5667 my $num_images = scalar @images;
5668
5669 my $num_filters = $self->{_filter_count};
5670 my $num_comments = @{$self->{_comments_array}};
5671 my $num_charts = @{$self->{_charts_array }};
5672
5673 # Skip this if there aren't any images.
5674 return unless $num_images;
5675
5676 for my $i (0 .. $num_images-1) {
5677 my $row = $images[$i]->[0];
5678 my $col = $images[$i]->[1];
5679 my $name = $images[$i]->[2];
5680 my $x_offset = $images[$i]->[3];
5681 my $y_offset = $images[$i]->[4];
5682 my $scale_x = $images[$i]->[5];
5683 my $scale_y = $images[$i]->[6];
5684 my $image_id = $images[$i]->[7];
5685 my $type = $images[$i]->[8];
5686 my $width = $images[$i]->[9];
5687 my $height = $images[$i]->[10];
5688
5689 $width *= $scale_x if $scale_x;
5690 $height *= $scale_y if $scale_y;
5691
5692
5693 # Calculate the positions of image object.
5694 my @vertices = $self->_position_object( $col,
5695 $row,
5696 $x_offset,
5697 $y_offset,
5698 $width,
5699 $height
5700 );
5701
5702 if ($i == 0) {
5703 # Write the parent MSODRAWIING record.
5704 my $dg_length = 156 + 84*($num_images -1);
5705 my $spgr_length = 132 + 84*($num_images -1);
5706
5707 $dg_length += 120 *$num_charts;
5708 $spgr_length += 120 *$num_charts;
5709
5710 $dg_length += 96 *$num_filters;
5711 $spgr_length += 96 *$num_filters;
5712
5713 $dg_length += 128 *$num_comments;
5714 $spgr_length += 128 *$num_comments;
5715
5716
5717
5718 my $data = $self->_store_mso_dg_container($dg_length);
5719 $data .= $self->_store_mso_dg(@ids);
5720 $data .= $self->_store_mso_spgr_container($spgr_length);
5721 $data .= $self->_store_mso_sp_container(40);
5722 $data .= $self->_store_mso_spgr();
5723 $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
5724 $data .= $self->_store_mso_sp_container(76);
5725 $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
5726 $data .= $self->_store_mso_opt_image($image_id);
5727 $data .= $self->_store_mso_client_anchor(2, @vertices);
5728 $data .= $self->_store_mso_client_data();
5729
5730 $length = length $data;
5731 my $header = pack("vv", $record, $length);
5732 $self->_append($header, $data);
5733
5734 }
5735 else {
5736 # Write the child MSODRAWIING record.
5737 my $data = $self->_store_mso_sp_container(76);
5738 $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
5739 $data .= $self->_store_mso_opt_image($image_id);
5740 $data .= $self->_store_mso_client_anchor(2, @vertices);
5741 $data .= $self->_store_mso_client_data();
5742
5743 $length = length $data;
5744 my $header = pack("vv", $record, $length);
5745 $self->_append($header, $data);
5746
5747
5748 }
5749
5750 $self->_store_obj_image($i+1);
5751 }
5752
5753 $self->{_object_ids}->[0] = $spid;
5754}
5755
5756
5757
5758###############################################################################
5759#
5760# _store_charts()
5761#
5762# Store the collections of records that make up charts.
5763#
5764sub _store_charts {
5765
5766 my $self = shift;
5767
5768 my $record = 0x00EC; # Record identifier
5769 my $length = 0x0000; # Bytes to follow
5770
5771 my @ids = @{$self->{_object_ids}};
5772 my $spid = shift @ids;
5773
5774 my @charts = @{$self->{_charts_array}};
5775 my $num_charts = scalar @charts;
5776
5777 my $num_filters = $self->{_filter_count};
5778 my $num_comments = @{$self->{_comments_array}};
5779
5780 # Number of objects written so far.
5781 my $num_objects = @{$self->{_images_array}};
5782
5783 # Skip this if there aren't any charts.
5784 return unless $num_charts;
5785
5786 for my $i (0 .. $num_charts-1 ) {
5787 my $row = $charts[$i]->[0];
5788 my $col = $charts[$i]->[1];
5789 my $chart = $charts[$i]->[2];
5790 my $x_offset = $charts[$i]->[3];
5791 my $y_offset = $charts[$i]->[4];
5792 my $scale_x = $charts[$i]->[5];
5793 my $scale_y = $charts[$i]->[6];
5794 my $width = 526;
5795 my $height = 319;
5796
5797 $width *= $scale_x if $scale_x;
5798 $height *= $scale_y if $scale_y;
5799
5800 # Calculate the positions of chart object.
5801 my @vertices = $self->_position_object( $col,
5802 $row,
5803 $x_offset,
5804 $y_offset,
5805 $width,
5806 $height
5807 );
5808
5809
5810 if ($i == 0 and not $num_objects) {
5811 # Write the parent MSODRAWIING record.
5812 my $dg_length = 192 + 120*($num_charts -1);
5813 my $spgr_length = 168 + 120*($num_charts -1);
5814
5815 $dg_length += 96 *$num_filters;
5816 $spgr_length += 96 *$num_filters;
5817
5818 $dg_length += 128 *$num_comments;
5819 $spgr_length += 128 *$num_comments;
5820
5821
5822 my $data = $self->_store_mso_dg_container($dg_length);
5823 $data .= $self->_store_mso_dg(@ids);
5824 $data .= $self->_store_mso_spgr_container($spgr_length);
5825 $data .= $self->_store_mso_sp_container(40);
5826 $data .= $self->_store_mso_spgr();
5827 $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
5828 $data .= $self->_store_mso_sp_container(112);
5829 $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
5830 $data .= $self->_store_mso_opt_chart();
5831 $data .= $self->_store_mso_client_anchor(0, @vertices);
5832 $data .= $self->_store_mso_client_data();
5833
5834 $length = length $data;
5835 my $header = pack("vv", $record, $length);
5836 $self->_append($header, $data);
5837
5838 }
5839 else {
5840 # Write the child MSODRAWIING record.
5841 my $data = $self->_store_mso_sp_container(112);
5842 $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
5843 $data .= $self->_store_mso_opt_chart();
5844 $data .= $self->_store_mso_client_anchor(0, @vertices);
5845 $data .= $self->_store_mso_client_data();
5846
5847 $length = length $data;
5848 my $header = pack("vv", $record, $length);
5849 $self->_append($header, $data);
5850
5851
5852 }
5853
5854 $self->_store_obj_chart($num_objects+$i+1);
5855 $self->_store_chart_binary($chart);
5856 }
5857
5858
5859 # Simulate the EXTERNSHEET link between the chart and data using a formula
5860 # such as '=Sheet1!A1'.
5861 # TODO. Won't work for external data refs. Also should use a more direct
5862 # method.
5863 #
5864 my $formula = "='$self->{_name}'!A1";
5865 $self->store_formula($formula);
5866
5867 $self->{_object_ids}->[0] = $spid;
5868}
5869
5870
5871###############################################################################
5872#
5873# _store_chart_binary
5874#
5875# Add the binary data for a chart. This could either be from a Chart object
5876# or from an external binary file (for backwards compatibility).
5877#
5878sub _store_chart_binary {
5879
5880 my $self = shift;
5881 my $chart = $_[0];
5882 my $tmp;
5883
5884
5885 if ( ref $chart ) {
5886 $chart->_close();
5887 my $tmp = $chart->get_data();
5888 $self->_append( $tmp );
5889 }
5890 else {
5891
5892 my $filehandle = FileHandle->new( $chart )
5893 or die "Couldn't open $chart in insert_chart(): $!.\n";
5894
5895 binmode( $filehandle );
5896
5897 while ( read( $filehandle, $tmp, 4096 ) ) {
5898 $self->_append( $tmp );
5899 }
5900 }
5901}
5902
5903
5904###############################################################################
5905#
5906# _store_filters()
5907#
5908# Store the collections of records that make up filters.
5909#
5910sub _store_filters {
5911
5912 my $self = shift;
5913
5914 my $record = 0x00EC; # Record identifier
5915 my $length = 0x0000; # Bytes to follow
5916
5917 my @ids = @{$self->{_object_ids}};
5918 my $spid = shift @ids;
5919
5920 my $filter_area = $self->{_filter_area};
5921 my $num_filters = $self->{_filter_count};
5922
5923 my $num_comments = @{$self->{_comments_array}};
5924
5925 # Number of objects written so far.
5926 my $num_objects = @{$self->{_images_array}}
5927 + @{$self->{_charts_array}};
5928
5929 # Skip this if there aren't any filters.
5930 return unless $num_filters;
5931
5932
5933 my ($row1, $row2, $col1, $col2) = @$filter_area;
5934
5935 for my $i (0 .. $num_filters-1 ) {
5936
5937 my @vertices = ( $col1 +$i,
5938 0,
5939 $row1,
5940 0,
5941 $col1 +$i +1,
5942 0,
5943 $row1 +1,
5944 0);
5945
5946 if ($i == 0 and not $num_objects) {
5947 # Write the parent MSODRAWIING record.
5948 my $dg_length = 168 + 96*($num_filters -1);
5949 my $spgr_length = 144 + 96*($num_filters -1);
5950
5951 $dg_length += 128 *$num_comments;
5952 $spgr_length += 128 *$num_comments;
5953
5954
5955 my $data = $self->_store_mso_dg_container($dg_length);
5956 $data .= $self->_store_mso_dg(@ids);
5957 $data .= $self->_store_mso_spgr_container($spgr_length);
5958 $data .= $self->_store_mso_sp_container(40);
5959 $data .= $self->_store_mso_spgr();
5960 $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
5961 $data .= $self->_store_mso_sp_container(88);
5962 $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
5963 $data .= $self->_store_mso_opt_filter();
5964 $data .= $self->_store_mso_client_anchor(1, @vertices);
5965 $data .= $self->_store_mso_client_data();
5966
5967 $length = length $data;
5968 my $header = pack("vv", $record, $length);
5969 $self->_append($header, $data);
5970
5971 }
5972 else {
5973 # Write the child MSODRAWIING record.
5974 my $data = $self->_store_mso_sp_container(88);
5975 $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
5976 $data .= $self->_store_mso_opt_filter();
5977 $data .= $self->_store_mso_client_anchor(1, @vertices);
5978 $data .= $self->_store_mso_client_data();
5979
5980 $length = length $data;
5981 my $header = pack("vv", $record, $length);
5982 $self->_append($header, $data);
5983
5984
5985 }
5986
5987 $self->_store_obj_filter($num_objects+$i+1, $col1 +$i);
5988 }
5989
5990
5991 # Simulate the EXTERNSHEET link between the filter and data using a formula
5992 # such as '=Sheet1!A1'.
5993 # TODO. Won't work for external data refs. Also should use a more direct
5994 # method.
5995 #
5996 my $formula = "='$self->{_name}'!A1";
5997 $self->store_formula($formula);
5998
5999 $self->{_object_ids}->[0] = $spid;
6000}
6001
6002
6003###############################################################################
6004#
6005# _store_comments()
6006#
6007# Store the collections of records that make up cell comments.
6008#
6009# NOTE: We write the comment objects last since that makes it a little easier
6010# to write the NOTE records directly after the MSODRAWIING records.
6011#
6012sub _store_comments {
6013
6014 my $self = shift;
6015
6016 my $record = 0x00EC; # Record identifier
6017 my $length = 0x0000; # Bytes to follow
6018
6019 my @ids = @{$self->{_object_ids}};
6020 my $spid = shift @ids;
6021
6022 my @comments = @{$self->{_comments_array}};
6023 my $num_comments = scalar @comments;
6024
6025 # Number of objects written so far.
6026 my $num_objects = @{$self->{_images_array}}
6027 + $self->{_filter_count}
6028 + @{$self->{_charts_array}};
6029
6030 # Skip this if there aren't any comments.
6031 return unless $num_comments;
6032
6033 for my $i (0 .. $num_comments-1) {
6034
6035 my $row = $comments[$i]->[0];
6036 my $col = $comments[$i]->[1];
6037 my $str = $comments[$i]->[2];
6038 my $encoding = $comments[$i]->[3];
6039 my $visible = $comments[$i]->[6];
6040 my $color = $comments[$i]->[7];
6041 my @vertices = @{$comments[$i]->[8]};
6042 my $str_len = length $str;
6043 $str_len /= 2 if $encoding; # Num of chars not bytes.
6044 my $formats = [[0, 9], [$str_len, 0]];
6045
6046
6047 if ($i == 0 and not $num_objects) {
6048 # Write the parent MSODRAWIING record.
6049 my $dg_length = 200 + 128*($num_comments -1);
6050 my $spgr_length = 176 + 128*($num_comments -1);
6051
6052 my $data = $self->_store_mso_dg_container($dg_length);
6053 $data .= $self->_store_mso_dg(@ids);
6054 $data .= $self->_store_mso_spgr_container($spgr_length);
6055 $data .= $self->_store_mso_sp_container(40);
6056 $data .= $self->_store_mso_spgr();
6057 $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
6058 $data .= $self->_store_mso_sp_container(120);
6059 $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
6060 $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
6061 $data .= $self->_store_mso_client_anchor(3, @vertices);
6062 $data .= $self->_store_mso_client_data();
6063
6064 $length = length $data;
6065 my $header = pack("vv", $record, $length);
6066 $self->_append($header, $data);
6067
6068 }
6069 else {
6070 # Write the child MSODRAWIING record.
6071 my $data = $self->_store_mso_sp_container(120);
6072 $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
6073 $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
6074 $data .= $self->_store_mso_client_anchor(3, @vertices);
6075 $data .= $self->_store_mso_client_data();
6076
6077 $length = length $data;
6078 my $header = pack("vv", $record, $length);
6079 $self->_append($header, $data);
6080
6081
6082 }
6083
6084 $self->_store_obj_comment($num_objects+$i+1);
6085 $self->_store_mso_drawing_text_box();
6086 $self->_store_txo($str_len);
6087 $self->_store_txo_continue_1($str, $encoding);
6088 $self->_store_txo_continue_2($formats);
6089 }
6090
6091
6092 # Write the NOTE records after MSODRAWIING records.
6093 for my $i (0 .. $num_comments-1) {
6094
6095 my $row = $comments[$i]->[0];
6096 my $col = $comments[$i]->[1];
6097 my $author = $comments[$i]->[4];
6098 my $author_enc = $comments[$i]->[5];
6099 my $visible = $comments[$i]->[6];
6100
6101 $self->_store_note($row, $col, $num_objects+$i+1,
6102 $author, $author_enc, $visible);
6103 }
6104}
6105
6106
6107###############################################################################
6108#
6109# _store_mso_dg_container()
6110#
6111# Write the Escher DgContainer record that is part of MSODRAWING.
6112#
6113sub _store_mso_dg_container {
6114
6115 my $self = shift;
6116
6117 my $type = 0xF002;
6118 my $version = 15;
6119 my $instance = 0;
6120 my $data = '';
6121 my $length = $_[0];
6122
6123
6124 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6125}
6126
6127
6128###############################################################################
6129#
6130# _store_mso_dg()
6131#
6132# Write the Escher Dg record that is part of MSODRAWING.
6133#
6134sub _store_mso_dg {
6135
6136 my $self = shift;
6137
6138 my $type = 0xF008;
6139 my $version = 0;
6140 my $instance = $_[0];
6141 my $data = '';
6142 my $length = 8;
6143
6144 my $num_shapes = $_[1];
6145 my $max_spid = $_[2];
6146
6147 $data = pack "VV", $num_shapes, $max_spid;
6148
6149 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6150}
6151
6152
6153###############################################################################
6154#
6155# _store_mso_spgr_container()
6156#
6157# Write the Escher SpgrContainer record that is part of MSODRAWING.
6158#
6159sub _store_mso_spgr_container {
6160
6161 my $self = shift;
6162
6163 my $type = 0xF003;
6164 my $version = 15;
6165 my $instance = 0;
6166 my $data = '';
6167 my $length = $_[0];
6168
6169
6170 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6171}
6172
6173
6174###############################################################################
6175#
6176# _store_mso_sp_container()
6177#
6178# Write the Escher SpContainer record that is part of MSODRAWING.
6179#
6180sub _store_mso_sp_container {
6181
6182 my $self = shift;
6183
6184 my $type = 0xF004;
6185 my $version = 15;
6186 my $instance = 0;
6187 my $data = '';
6188 my $length = $_[0];
6189
6190
6191 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6192}
6193
6194
6195###############################################################################
6196#
6197# _store_mso_spgr()
6198#
6199# Write the Escher Spgr record that is part of MSODRAWING.
6200#
6201sub _store_mso_spgr {
6202
6203 my $self = shift;
6204
6205 my $type = 0xF009;
6206 my $version = 1;
6207 my $instance = 0;
6208 my $data = pack "VVVV", 0, 0, 0, 0;
6209 my $length = 16;
6210
6211
6212 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6213}
6214
6215
6216###############################################################################
6217#
6218# _store_mso_sp()
6219#
6220# Write the Escher Sp record that is part of MSODRAWING.
6221#
6222sub _store_mso_sp {
6223
6224 my $self = shift;
6225
6226 my $type = 0xF00A;
6227 my $version = 2;
6228 my $instance = $_[0];
6229 my $data = '';
6230 my $length = 8;
6231
6232 my $spid = $_[1];
6233 my $options = $_[2];
6234
6235 $data = pack "VV", $spid, $options;
6236
6237 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6238}
6239
6240
6241###############################################################################
6242#
6243# _store_mso_opt_comment()
6244#
6245# Write the Escher Opt record that is part of MSODRAWING.
6246#
6247sub _store_mso_opt_comment {
6248
6249 my $self = shift;
6250
6251 my $type = 0xF00B;
6252 my $version = 3;
6253 my $instance = 9;
6254 my $data = '';
6255 my $length = 54;
6256
6257 my $spid = $_[0];
6258 my $visible = $_[1];
6259 my $colour = $_[2] || 0x50;
6260
6261
6262 # Use the visible flag if set by the user or else use the worksheet value.
6263 # Note that the value used is the opposite of _store_note().
6264 #
6265 if (defined $visible) {
6266 $visible = $visible ? 0x0000 : 0x0002;
6267 }
6268 else {
6269 $visible = $self->{_comments_visible} ? 0x0000 : 0x0002;
6270 }
6271
6272
6273 $data = pack "V", $spid;
6274 $data .= pack "H*", '0000BF00080008005801000000008101' ;
6275 $data .= pack "C", $colour;
6276 $data .= pack "H*", '000008830150000008BF011000110001' .
6277 '02000000003F0203000300BF03';
6278 $data .= pack "v", $visible;
6279 $data .= pack "H*", '0A00';
6280
6281
6282 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6283}
6284
6285
6286###############################################################################
6287#
6288# _store_mso_opt_image()
6289#
6290# Write the Escher Opt record that is part of MSODRAWING.
6291#
6292sub _store_mso_opt_image {
6293
6294 my $self = shift;
6295
6296 my $type = 0xF00B;
6297 my $version = 3;
6298 my $instance = 3;
6299 my $data = '';
6300 my $length = undef;
6301 my $spid = $_[0];
6302
6303 $data = pack 'v', 0x4104; # Blip -> pib
6304 $data .= pack 'V', $spid;
6305 $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
6306 $data .= pack 'V', 0x00010000;
6307 $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
6308 $data .= pack 'V', 0x00080000;
6309
6310
6311 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6312}
6313
6314
6315###############################################################################
6316#
6317# _store_mso_opt_chart()
6318#
6319# Write the Escher Opt record that is part of MSODRAWING.
6320#
6321sub _store_mso_opt_chart {
6322
6323 my $self = shift;
6324
6325 my $type = 0xF00B;
6326 my $version = 3;
6327 my $instance = 9;
6328 my $data = '';
6329 my $length = undef;
6330
6331 $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
6332 $data .= pack 'V', 0x01040104;
6333
6334 $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
6335 $data .= pack 'V', 0x00080008;
6336
6337 $data .= pack 'v', 0x0181; # Fill Style -> fillColor
6338 $data .= pack 'V', 0x0800004E ;
6339
6340 $data .= pack 'v', 0x0183; # Fill Style -> fillBackColor
6341 $data .= pack 'V', 0x0800004D;
6342
6343 $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
6344 $data .= pack 'V', 0x00110010;
6345
6346 $data .= pack 'v', 0x01C0; # Line Style -> lineColor
6347 $data .= pack 'V', 0x0800004D;
6348
6349 $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
6350 $data .= pack 'V', 0x00080008;
6351
6352 $data .= pack 'v', 0x023F; # Shadow Style -> fshadowObscured
6353 $data .= pack 'V', 0x00020000;
6354
6355 $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
6356 $data .= pack 'V', 0x00080000;
6357
6358
6359 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6360}
6361
6362
6363###############################################################################
6364#
6365# _store_mso_opt_filter()
6366#
6367# Write the Escher Opt record that is part of MSODRAWING.
6368#
6369sub _store_mso_opt_filter {
6370
6371 my $self = shift;
6372
6373 my $type = 0xF00B;
6374 my $version = 3;
6375 my $instance = 5;
6376 my $data = '';
6377 my $length = undef;
6378
6379
6380
6381 $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
6382 $data .= pack 'V', 0x01040104;
6383
6384 $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
6385 $data .= pack 'V', 0x00080008;
6386
6387 $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
6388 $data .= pack 'V', 0x00010000;
6389
6390 $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
6391 $data .= pack 'V', 0x00080000;
6392
6393 $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
6394 $data .= pack 'V', 0x000A0000;
6395
6396
6397 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6398}
6399
6400
6401###############################################################################
6402#
6403# _store_mso_client_anchor()
6404#
6405# Write the Escher ClientAnchor record that is part of MSODRAWING.
6406#
6407sub _store_mso_client_anchor {
6408
6409 my $self = shift;
6410
6411 my $type = 0xF010;
6412 my $version = 0;
6413 my $instance = 0;
6414 my $data = '';
6415 my $length = 18;
6416
6417 my $flag = shift;
6418
6419 my $col_start = $_[0]; # Col containing upper left corner of object
6420 my $x1 = $_[1]; # Distance to left side of object
6421
6422 my $row_start = $_[2]; # Row containing top left corner of object
6423 my $y1 = $_[3]; # Distance to top of object
6424
6425 my $col_end = $_[4]; # Col containing lower right corner of object
6426 my $x2 = $_[5]; # Distance to right side of object
6427
6428 my $row_end = $_[6]; # Row containing bottom right corner of object
6429 my $y2 = $_[7]; # Distance to bottom of object
6430
6431 $data = pack "v9", $flag,
6432 $col_start, $x1,
6433 $row_start, $y1,
6434 $col_end, $x2,
6435 $row_end, $y2;
6436
6437
6438
6439 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6440}
6441
6442
6443###############################################################################
6444#
6445# _store_mso_client_data()
6446#
6447# Write the Escher ClientData record that is part of MSODRAWING.
6448#
6449sub _store_mso_client_data {
6450
6451 my $self = shift;
6452
6453 my $type = 0xF011;
6454 my $version = 0;
6455 my $instance = 0;
6456 my $data = '';
6457 my $length = 0;
6458
6459
6460 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6461}
6462
6463
6464###############################################################################
6465#
6466# _store_obj_comment()
6467#
6468# Write the OBJ record that is part of cell comments.
6469#
6470sub _store_obj_comment {
6471
6472 my $self = shift;
6473
6474 my $record = 0x005D; # Record identifier
6475 my $length = 0x0034; # Bytes to follow
6476
6477 my $obj_id = $_[0]; # Object ID number.
6478 my $obj_type = 0x0019; # Object type (comment).
6479 my $data = ''; # Record data.
6480
6481 my $sub_record = 0x0000; # Sub-record identifier.
6482 my $sub_length = 0x0000; # Length of sub-record.
6483 my $sub_data = ''; # Data of sub-record.
6484 my $options = 0x4011;
6485 my $reserved = 0x0000;
6486
6487 # Add ftCmo (common object data) subobject
6488 $sub_record = 0x0015; # ftCmo
6489 $sub_length = 0x0012;
6490 $sub_data = pack "vvvVVV", $obj_type, $obj_id, $options,
6491 $reserved, $reserved, $reserved;
6492 $data = pack("vv", $sub_record, $sub_length);
6493 $data .= $sub_data;
6494
6495
6496 # Add ftNts (note structure) subobject
6497 $sub_record = 0x000D; # ftNts
6498 $sub_length = 0x0016;
6499 $sub_data = pack "VVVVVv", ($reserved) x 6;
6500 $data .= pack("vv", $sub_record, $sub_length);
6501 $data .= $sub_data;
6502
6503
6504 # Add ftEnd (end of object) subobject
6505 $sub_record = 0x0000; # ftNts
6506 $sub_length = 0x0000;
6507 $data .= pack("vv", $sub_record, $sub_length);
6508
6509
6510 # Pack the record.
6511 my $header = pack("vv", $record, $length);
6512
6513 $self->_append($header, $data);
6514
6515}
6516
6517
6518###############################################################################
6519#
6520# _store_obj_image()
6521#
6522# Write the OBJ record that is part of image records.
6523#
6524sub _store_obj_image {
6525
6526 my $self = shift;
6527
6528 my $record = 0x005D; # Record identifier
6529 my $length = 0x0026; # Bytes to follow
6530
6531 my $obj_id = $_[0]; # Object ID number.
6532 my $obj_type = 0x0008; # Object type (Picture).
6533 my $data = ''; # Record data.
6534
6535 my $sub_record = 0x0000; # Sub-record identifier.
6536 my $sub_length = 0x0000; # Length of sub-record.
6537 my $sub_data = ''; # Data of sub-record.
6538 my $options = 0x6011;
6539 my $reserved = 0x0000;
6540
6541 # Add ftCmo (common object data) subobject
6542 $sub_record = 0x0015; # ftCmo
6543 $sub_length = 0x0012;
6544 $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
6545 $reserved, $reserved, $reserved;
6546 $data = pack 'vv', $sub_record, $sub_length;
6547 $data .= $sub_data;
6548
6549
6550 # Add ftCf (Clipboard format) subobject
6551 $sub_record = 0x0007; # ftCf
6552 $sub_length = 0x0002;
6553 $sub_data = pack 'v', 0xFFFF;
6554 $data .= pack 'vv', $sub_record, $sub_length;
6555 $data .= $sub_data;
6556
6557 # Add ftPioGrbit (Picture option flags) subobject
6558 $sub_record = 0x0008; # ftPioGrbit
6559 $sub_length = 0x0002;
6560 $sub_data = pack 'v', 0x0001;
6561 $data .= pack 'vv', $sub_record, $sub_length;
6562 $data .= $sub_data;
6563
6564
6565 # Add ftEnd (end of object) subobject
6566 $sub_record = 0x0000; # ftNts
6567 $sub_length = 0x0000;
6568 $data .= pack 'vv', $sub_record, $sub_length;
6569
6570
6571 # Pack the record.
6572 my $header = pack('vv', $record, $length);
6573
6574 $self->_append($header, $data);
6575
6576}
6577
6578
6579###############################################################################
6580#
6581# _store_obj_chart()
6582#
6583# Write the OBJ record that is part of chart records.
6584#
6585sub _store_obj_chart {
6586
6587 my $self = shift;
6588
6589 my $record = 0x005D; # Record identifier
6590 my $length = 0x001A; # Bytes to follow
6591
6592 my $obj_id = $_[0]; # Object ID number.
6593 my $obj_type = 0x0005; # Object type (chart).
6594 my $data = ''; # Record data.
6595
6596 my $sub_record = 0x0000; # Sub-record identifier.
6597 my $sub_length = 0x0000; # Length of sub-record.
6598 my $sub_data = ''; # Data of sub-record.
6599 my $options = 0x6011;
6600 my $reserved = 0x0000;
6601
6602 # Add ftCmo (common object data) subobject
6603 $sub_record = 0x0015; # ftCmo
6604 $sub_length = 0x0012;
6605 $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
6606 $reserved, $reserved, $reserved;
6607 $data = pack 'vv', $sub_record, $sub_length;
6608 $data .= $sub_data;
6609
6610 # Add ftEnd (end of object) subobject
6611 $sub_record = 0x0000; # ftNts
6612 $sub_length = 0x0000;
6613 $data .= pack 'vv', $sub_record, $sub_length;
6614
6615
6616 # Pack the record.
6617 my $header = pack('vv', $record, $length);
6618
6619 $self->_append($header, $data);
6620
6621}
6622
6623
6624
6625
6626###############################################################################
6627#
6628# _store_obj_filter()
6629#
6630# Write the OBJ record that is part of filter records.
6631#
6632sub _store_obj_filter {
6633
6634 my $self = shift;
6635
6636 my $record = 0x005D; # Record identifier
6637 my $length = 0x0046; # Bytes to follow
6638
6639 my $obj_id = $_[0]; # Object ID number.
6640 my $obj_type = 0x0014; # Object type (combo box).
6641 my $data = ''; # Record data.
6642
6643 my $sub_record = 0x0000; # Sub-record identifier.
6644 my $sub_length = 0x0000; # Length of sub-record.
6645 my $sub_data = ''; # Data of sub-record.
6646 my $options = 0x2101;
6647 my $reserved = 0x0000;
6648
6649 # Add ftCmo (common object data) subobject
6650 $sub_record = 0x0015; # ftCmo
6651 $sub_length = 0x0012;
6652 $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
6653 $reserved, $reserved, $reserved;
6654 $data = pack 'vv', $sub_record, $sub_length;
6655 $data .= $sub_data;
6656
6657 # Add ftSbs Scroll bar subobject
6658 $sub_record = 0x000C; # ftSbs
6659 $sub_length = 0x0014;
6660 $sub_data = pack 'H*', '0000000000000000640001000A00000010000100';
6661 $data .= pack 'vv', $sub_record, $sub_length;
6662 $data .= $sub_data;
6663
6664
6665 # Add ftLbsData (List box data) subobject
6666 $sub_record = 0x0013; # ftLbsData
6667 $sub_length = 0x1FEE; # Special case (undocumented).
6668
6669
6670 # If the filter is active we set one of the undocumented flags.
6671 my $col = $_[1];
6672
6673 if ($self->{_filter_cols}->{$col}) {
6674 $sub_data = pack 'H*', '000000000100010300000A0008005700';
6675 }
6676 else {
6677 $sub_data = pack 'H*', '00000000010001030000020008005700';
6678 }
6679
6680 $data .= pack 'vv', $sub_record, $sub_length;
6681 $data .= $sub_data;
6682
6683
6684 # Add ftEnd (end of object) subobject
6685 $sub_record = 0x0000; # ftNts
6686 $sub_length = 0x0000;
6687 $data .= pack 'vv', $sub_record, $sub_length;
6688
6689 # Pack the record.
6690 my $header = pack('vv', $record, $length);
6691
6692 $self->_append($header, $data);
6693}
6694
6695
6696###############################################################################
6697#
6698# _store_mso_drawing_text_box()
6699#
6700# Write the MSODRAWING ClientTextbox record that is part of comments.
6701#
6702sub _store_mso_drawing_text_box {
6703
6704 my $self = shift;
6705
6706 my $record = 0x00EC; # Record identifier
6707 my $length = 0x0008; # Bytes to follow
6708
6709
6710 my $data = $self->_store_mso_client_text_box();
6711 my $header = pack("vv", $record, $length);
6712
6713 $self->_append($header, $data);
6714}
6715
6716
6717###############################################################################
6718#
6719# _store_mso_client_text_box()
6720#
6721# Write the Escher ClientTextbox record that is part of MSODRAWING.
6722#
6723sub _store_mso_client_text_box {
6724
6725 my $self = shift;
6726
6727 my $type = 0xF00D;
6728 my $version = 0;
6729 my $instance = 0;
6730 my $data = '';
6731 my $length = 0;
6732
6733
6734 return $self->_add_mso_generic($type, $version, $instance, $data, $length);
6735}
6736
6737
6738###############################################################################
6739#
6740# _store_txo()
6741#
6742# Write the worksheet TXO record that is part of cell comments.
6743#
6744sub _store_txo {
6745
6746 my $self = shift;
6747
6748 my $record = 0x01B6; # Record identifier
6749 my $length = 0x0012; # Bytes to follow
6750
6751 my $string_len = $_[0]; # Length of the note text.
6752 my $format_len = $_[1] || 16; # Length of the format runs.
6753 my $rotation = $_[2] || 0; # Options
6754 my $grbit = 0x0212; # Options
6755 my $reserved = 0x0000; # Options
6756
6757 # Pack the record.
6758 my $header = pack("vv", $record, $length);
6759 my $data = pack("vvVvvvV", $grbit, $rotation, $reserved, $reserved,
6760 $string_len, $format_len, $reserved);
6761
6762 $self->_append($header, $data);
6763
6764}
6765
6766
6767###############################################################################
6768#
6769# _store_txo_continue_1()
6770#
6771# Write the first CONTINUE record to follow the TXO record. It contains the
6772# text data.
6773#
6774sub _store_txo_continue_1 {
6775
6776 my $self = shift;
6777
6778 my $record = 0x003C; # Record identifier
6779 my $string = $_[0]; # Comment string.
6780 my $encoding = $_[1] || 0; # Encoding of the string.
6781
6782
6783 # Split long comment strings into smaller continue blocks if necessary.
6784 # We can't let BIFFwriter::_add_continue() handled this since an extra
6785 # encoding byte has to be added similar to the SST block.
6786 #
6787 # We make the limit size smaller than the _add_continue() size and even
6788 # so that UTF16 chars occur in the same block.
6789 #
6790 my $limit = 8218;
6791 while (length($string) > $limit) {
6792 my $tmp_str = substr($string, 0, $limit, "");
6793
6794 my $data = pack("C", $encoding) . $tmp_str;
6795 my $length = length $data;
6796 my $header = pack("vv", $record, $length);
6797
6798 $self->_append($header, $data);
6799 }
6800
6801 # Pack the record.
6802 my $data = pack("C", $encoding) . $string;
6803 my $length = length $data;
6804 my $header = pack("vv", $record, $length);
6805
6806 $self->_append($header, $data);
6807
6808}
6809
6810
6811###############################################################################
6812#
6813# _store_txo_continue_2()
6814#
6815# Write the second CONTINUE record to follow the TXO record. It contains the
6816# formatting information for the string.
6817#
6818sub _store_txo_continue_2 {
6819
6820 my $self = shift;
6821
6822 my $record = 0x003C; # Record identifier
6823 my $length = 0x0000; # Bytes to follow
6824 my $formats = $_[0]; # Formatting information
6825
6826
6827 # Pack the record.
6828 my $data = '';
6829
6830 for my $a_ref (@$formats) {
6831 $data .= pack "vvV", $a_ref->[0], $a_ref->[1], 0x0;
6832 }
6833
6834 $length = length $data;
6835 my $header = pack("vv", $record, $length);
6836
6837
6838 $self->_append($header, $data);
6839
6840}
6841
6842
6843###############################################################################
6844#
6845# _store_note()
6846#
6847# Write the worksheet NOTE record that is part of cell comments.
6848#
6849sub _store_note {
6850
6851 my $self = shift;
6852
6853 my $record = 0x001C; # Record identifier
6854 my $length = 0x000C; # Bytes to follow
6855
6856 my $row = $_[0];
6857 my $col = $_[1];
6858 my $obj_id = $_[2];
6859 my $author = $_[3] || $self->{_comments_author};
6860 my $author_enc = $_[4] || $self->{_comments_author_enc};
6861 my $visible = $_[5];
6862
6863
6864 # Use the visible flag if set by the user or else use the worksheet value.
6865 # The flag is also set in _store_mso_opt_comment() but with the opposite
6866 # value.
6867 if (defined $visible) {
6868 $visible = $visible ? 0x0002 : 0x0000;
6869 }
6870 else {
6871 $visible = $self->{_comments_visible} ? 0x0002 : 0x0000;
6872 }
6873
6874
6875 # Get the number of chars in the author string (not bytes).
6876 my $num_chars = length $author;
6877 $num_chars /= 2 if $author_enc;
6878
6879
6880 # Null terminate the author string.
6881 $author .= "\0";
6882
6883
6884 # Pack the record.
6885 my $data = pack("vvvvvC", $row, $col, $visible, $obj_id,
6886 $num_chars, $author_enc);
6887
6888 $length = length($data) + length($author);
6889 my $header = pack("vv", $record, $length);
6890
6891 $self->_append($header, $data, $author);
6892}
6893
6894
6895###############################################################################
6896#
6897# _comment_params()
6898#
6899# This method handles the additional optional parameters to write_comment() as
6900# well as calculating the comment object position and vertices.
6901#
6902sub _comment_params {
6903
6904 my $self = shift;
6905
6906 my $row = shift;
6907 my $col = shift;
6908 my $string = shift;
6909
6910 my $default_width = 128;
6911 my $default_height = 74;
6912
6913 my %params = (
6914 author => '',
6915 author_encoding => 0,
6916 encoding => 0,
6917 color => undef,
6918 start_cell => undef,
6919 start_col => undef,
6920 start_row => undef,
6921 visible => undef,
6922 width => $default_width,
6923 height => $default_height,
6924 x_offset => undef,
6925 x_scale => 1,
6926 y_offset => undef,
6927 y_scale => 1,
6928 );
6929
6930
6931 # Overwrite the defaults with any user supplied values. Incorrect or
6932 # misspelled parameters are silently ignored.
6933 %params = (%params, @_);
6934
6935
6936 # Ensure that a width and height have been set.
6937 $params{width} = $default_width if not $params{width};
6938 $params{height} = $default_height if not $params{height};
6939
6940
6941 # Check that utf16 strings have an even number of bytes.
6942 if ($params{encoding}) {
6943 croak "Uneven number of bytes in comment string"
6944 if length($string) % 2;
6945
6946 # Change from UTF-16BE to UTF-16LE
6947 $string = pack 'v*', unpack 'n*', $string;
6948 }
6949
6950 if ($params{author_encoding}) {
6951 croak "Uneven number of bytes in author string"
6952 if length($params{author}) % 2;
6953
6954 # Change from UTF-16BE to UTF-16LE
6955 $params{author} = pack 'v*', unpack 'n*', $params{author};
6956 }
6957
6958
6959 # Handle utf8 strings in perl 5.8.
6960 if ($] >= 5.008) {
6961 require Encode;
6962
6963 if (Encode::is_utf8($string)) {
6964 $string = Encode::encode("UTF-16LE", $string);
6965 $params{encoding} = 1;
6966 }
6967
6968 if (Encode::is_utf8($params{author})) {
6969 $params{author} = Encode::encode("UTF-16LE", $params{author});
6970 $params{author_encoding} = 1;
6971 }
6972 }
6973
6974
6975 # Limit the string to the max number of chars (not bytes).
6976 my $max_len = 32767;
6977 $max_len *= 2 if $params{encoding};
6978
6979 if (length($string) > $max_len) {
6980 $string = substr($string, 0, $max_len);
6981 }
6982
6983
6984 # Set the comment background colour.
6985 my $color = $params{color};
6986 $color = &Spreadsheet::WriteExcel::Format::_get_color($color);
6987 $color = 0x50 if $color == 0x7FFF; # Default color.
6988 $params{color} = $color;
6989
6990
6991 # Convert a cell reference to a row and column.
6992 if (defined $params{start_cell}) {
6993 my ($row, $col) = $self->_substitute_cellref($params{start_cell});
6994 $params{start_row} = $row;
6995 $params{start_col} = $col;
6996 }
6997
6998
6999 # Set the default start cell and offsets for the comment. These are
7000 # generally fixed in relation to the parent cell. However there are
7001 # some edge cases for cells at the, er, edges.
7002 #
7003 if (not defined $params{start_row}) {
7004
7005 if ($row == 0 ) {$params{start_row} = 0 }
7006 elsif ($row == 65533) {$params{start_row} = 65529 }
7007 elsif ($row == 65534) {$params{start_row} = 65530 }
7008 elsif ($row == 65535) {$params{start_row} = 65531 }
7009 else {$params{start_row} = $row -1}
7010 }
7011
7012 if (not defined $params{y_offset}) {
7013
7014 if ($row == 0 ) {$params{y_offset} = 2 }
7015 elsif ($row == 65533) {$params{y_offset} = 4 }
7016 elsif ($row == 65534) {$params{y_offset} = 4 }
7017 elsif ($row == 65535) {$params{y_offset} = 2 }
7018 else {$params{y_offset} = 7 }
7019 }
7020
7021 if (not defined $params{start_col}) {
7022
7023 if ($col == 253 ) {$params{start_col} = 250 }
7024 elsif ($col == 254 ) {$params{start_col} = 251 }
7025 elsif ($col == 255 ) {$params{start_col} = 252 }
7026 else {$params{start_col} = $col +1}
7027 }
7028
7029 if (not defined $params{x_offset}) {
7030
7031 if ($col == 253 ) {$params{x_offset} = 49 }
7032 elsif ($col == 254 ) {$params{x_offset} = 49 }
7033 elsif ($col == 255 ) {$params{x_offset} = 49 }
7034 else {$params{x_offset} = 15 }
7035 }
7036
7037
7038 # Scale the size of the comment box if required.
7039 if ($params{x_scale}) {
7040 $params{width} = $params{width} * $params{x_scale};
7041 }
7042
7043 if ($params{y_scale}) {
7044 $params{height} = $params{height} * $params{y_scale};
7045 }
7046
7047
7048 # Calculate the positions of comment object.
7049 my @vertices = $self->_position_object( $params{start_col},
7050 $params{start_row},
7051 $params{x_offset},
7052 $params{y_offset},
7053 $params{width},
7054 $params{height}
7055 );
7056
7057 return(
7058 $row,
7059 $col,
7060 $string,
7061 $params{encoding},
7062 $params{author},
7063 $params{author_encoding},
7064 $params{visible},
7065 $params{color},
7066 [@vertices]
7067 );
7068}
7069
7070
7071
7072#
7073# DATA VALIDATION
7074#
7075
7076###############################################################################
7077#
7078# data_validation($row, $col, {...})
7079#
7080# This method handles the interface to Excel data validation.
7081# Somewhat ironically the this requires a lot of validation code since the
7082# interface is flexible and covers a several types of data validation.
7083#
7084# We allow data validation to be called on one cell or a range of cells. The
7085# hashref contains the validation parameters and must be the last param:
7086# data_validation($row, $col, {...})
7087# data_validation($first_row, $first_col, $last_row, $last_col, {...})
7088#
7089# Returns 0 : normal termination
7090# -1 : insufficient number of arguments
7091# -2 : row or column out of range
7092# -3 : incorrect parameter.
7093#
7094sub data_validation {
7095
7096 my $self = shift;
7097
7098 # Check for a cell reference in A1 notation and substitute row and column
7099 if ($_[0] =~ /^\D/) {
7100 @_ = $self->_substitute_cellref(@_);
7101 }
7102
7103 # Check for a valid number of args.
7104 if (@_ != 5 && @_ != 3) { return -1 }
7105
7106 # The final hashref contains the validation parameters.
7107 my $param = pop;
7108
7109 # Make the last row/col the same as the first if not defined.
7110 my ($row1, $col1, $row2, $col2) = @_;
7111 if (!defined $row2) {
7112 $row2 = $row1;
7113 $col2 = $col1;
7114 }
7115
7116 # Check that row and col are valid without storing the values.
7117 return -2 if $self->_check_dimensions($row1, $col1, 1, 1);
7118 return -2 if $self->_check_dimensions($row2, $col2, 1, 1);
7119
7120
7121 # Check that the last parameter is a hash list.
7122 if (ref $param ne 'HASH') {
7123 carp "Last parameter '$param' in data_validation() must be a hash ref";
7124 return -3;
7125 }
7126
7127 # List of valid input parameters.
7128 my %valid_parameter = (
7129 validate => 1,
7130 criteria => 1,
7131 value => 1,
7132 source => 1,
7133 minimum => 1,
7134 maximum => 1,
7135 ignore_blank => 1,
7136 dropdown => 1,
7137 show_input => 1,
7138 input_title => 1,
7139 input_message => 1,
7140 show_error => 1,
7141 error_title => 1,
7142 error_message => 1,
7143 error_type => 1,
7144 other_cells => 1,
7145 );
7146
7147 # Check for valid input parameters.
7148 for my $param_key (keys %$param) {
7149 if (not exists $valid_parameter{$param_key}) {
7150 carp "Unknown parameter '$param_key' in data_validation()";
7151 return -3;
7152 }
7153 }
7154
7155 # Map alternative parameter names 'source' or 'minimum' to 'value'.
7156 $param->{value} = $param->{source} if defined $param->{source};
7157 $param->{value} = $param->{minimum} if defined $param->{minimum};
7158
7159 # 'validate' is a required parameter.
7160 if (not exists $param->{validate}) {
7161 carp "Parameter 'validate' is required in data_validation()";
7162 return -3;
7163 }
7164
7165
7166 # List of valid validation types.
7167 my %valid_type = (
7168 'any' => 0,
7169 'any value' => 0,
7170 'whole number' => 1,
7171 'whole' => 1,
7172 'integer' => 1,
7173 'decimal' => 2,
7174 'list' => 3,
7175 'date' => 4,
7176 'time' => 5,
7177 'text length' => 6,
7178 'length' => 6,
7179 'custom' => 7,
7180 );
7181
7182
7183 # Check for valid validation types.
7184 if (not exists $valid_type{lc($param->{validate})}) {
7185 carp "Unknown validation type '$param->{validate}' for parameter " .
7186 "'validate' in data_validation()";
7187 return -3;
7188 }
7189 else {
7190 $param->{validate} = $valid_type{lc($param->{validate})};
7191 }
7192
7193
7194 # No action is required for validation type 'any'.
7195 # TODO: we should perhaps store 'any' for message only validations.
7196 return 0 if $param->{validate} == 0;
7197
7198
7199 # The list and custom validations don't have a criteria so we use a default
7200 # of 'between'.
7201 if ($param->{validate} == 3 || $param->{validate} == 7) {
7202 $param->{criteria} = 'between';
7203 $param->{maximum} = undef;
7204 }
7205
7206 # 'criteria' is a required parameter.
7207 if (not exists $param->{criteria}) {
7208 carp "Parameter 'criteria' is required in data_validation()";
7209 return -3;
7210 }
7211
7212
7213 # List of valid criteria types.
7214 my %criteria_type = (
7215 'between' => 0,
7216 'not between' => 1,
7217 'equal to' => 2,
7218 '=' => 2,
7219 '==' => 2,
7220 'not equal to' => 3,
7221 '!=' => 3,
7222 '<>' => 3,
7223 'greater than' => 4,
7224 '>' => 4,
7225 'less than' => 5,
7226 '<' => 5,
7227 'greater than or equal to' => 6,
7228 '>=' => 6,
7229 'less than or equal to' => 7,
7230 '<=' => 7,
7231 );
7232
7233 # Check for valid criteria types.
7234 if (not exists $criteria_type{lc($param->{criteria})}) {
7235 carp "Unknown criteria type '$param->{criteria}' for parameter " .
7236 "'criteria' in data_validation()";
7237 return -3;
7238 }
7239 else {
7240 $param->{criteria} = $criteria_type{lc($param->{criteria})};
7241 }
7242
7243
7244 # 'Between' and 'Not between' criteria require 2 values.
7245 if ($param->{criteria} == 0 || $param->{criteria} == 1) {
7246 if (not exists $param->{maximum}) {
7247 carp "Parameter 'maximum' is required in data_validation() " .
7248 "when using 'between' or 'not between' criteria";
7249 return -3;
7250 }
7251 }
7252 else {
7253 $param->{maximum} = undef;
7254 }
7255
7256
7257
7258 # List of valid error dialog types.
7259 my %error_type = (
7260 'stop' => 0,
7261 'warning' => 1,
7262 'information' => 2,
7263 );
7264
7265 # Check for valid error dialog types.
7266 if (not exists $param->{error_type}) {
7267 $param->{error_type} = 0;
7268 }
7269 elsif (not exists $error_type{lc($param->{error_type})}) {
7270 carp "Unknown criteria type '$param->{error_type}' for parameter " .
7271 "'error_type' in data_validation()";
7272 return -3;
7273 }
7274 else {
7275 $param->{error_type} = $error_type{lc($param->{error_type})};
7276 }
7277
7278
7279 # Convert date/times value if required.
7280 if ($param->{validate} == 4 || $param->{validate} == 5) {
7281 if ($param->{value} =~ /T/) {
7282 my $date_time = $self->convert_date_time($param->{value});
7283
7284 if (!defined $date_time) {
7285 carp "Invalid date/time value '$param->{value}' " .
7286 "in data_validation()";
7287 return -3;
7288 }
7289 else {
7290 $param->{value} = $date_time;
7291 }
7292 }
7293 if (defined $param->{maximum} && $param->{maximum} =~ /T/) {
7294 my $date_time = $self->convert_date_time($param->{maximum});
7295
7296 if (!defined $date_time) {
7297 carp "Invalid date/time value '$param->{maximum}' " .
7298 "in data_validation()";
7299 return -3;
7300 }
7301 else {
7302 $param->{maximum} = $date_time;
7303 }
7304 }
7305 }
7306
7307
7308 # Set some defaults if they haven't been defined by the user.
7309 $param->{ignore_blank} = 1 if !defined $param->{ignore_blank};
7310 $param->{dropdown} = 1 if !defined $param->{dropdown};
7311 $param->{show_input} = 1 if !defined $param->{show_input};
7312 $param->{show_error} = 1 if !defined $param->{show_error};
7313
7314
7315 # These are the cells to which the validation is applied.
7316 $param->{cells} = [[$row1, $col1, $row2, $col2]];
7317
7318 # A (for now) undocumented parameter to pass additional cell ranges.
7319 if (exists $param->{other_cells}) {
7320
7321 push @{$param->{cells}}, @{$param->{other_cells}};
7322 }
7323
7324 # Store the validation information until we close the worksheet.
7325 push @{$self->{_validations}}, $param;
7326}
7327
7328
7329###############################################################################
7330#
7331# _store_validation_count()
7332#
7333# Store the count of the DV records to follow.
7334#
7335# Note, this could be wrapped into _store_dv() but we may require separate
7336# handling of the object id at a later stage.
7337#
7338sub _store_validation_count {
7339
7340 my $self = shift;
7341
7342 my $dv_count = @{$self->{_validations}};
7343 my $obj_id = -1;
7344
7345 return unless $dv_count;
7346
7347 $self->_store_dval($obj_id , $dv_count);
7348}
7349
7350
7351###############################################################################
7352#
7353# _store_validations()
7354#
7355# Store the data_validation records.
7356#
7357sub _store_validations {
7358
7359 my $self = shift;
7360
7361 return unless scalar @{$self->{_validations}};
7362
7363 for my $param (@{$self->{_validations}}) {
7364 $self->_store_dv( $param->{cells},
7365 $param->{validate},
7366 $param->{criteria},
7367 $param->{value},
7368 $param->{maximum},
7369 $param->{input_title},
7370 $param->{input_message},
7371 $param->{error_title},
7372 $param->{error_message},
7373 $param->{error_type},
7374 $param->{ignore_blank},
7375 $param->{dropdown},
7376 $param->{show_input},
7377 $param->{show_error},
7378 );
7379 }
7380}
7381
7382
7383###############################################################################
7384#
7385# _store_dval()
7386#
7387# Store the DV record which contains the number of and information common to
7388# all DV structures.
7389#
7390sub _store_dval {
7391
7392 my $self = shift;
7393
7394 my $record = 0x01B2; # Record identifier
7395 my $length = 0x0012; # Bytes to follow
7396
7397 my $obj_id = $_[0]; # Object ID number.
7398 my $dv_count = $_[1]; # Count of DV structs to follow.
7399
7400 my $flags = 0x0004; # Option flags.
7401 my $x_coord = 0x00000000; # X coord of input box.
7402 my $y_coord = 0x00000000; # Y coord of input box.
7403
7404
7405 # Pack the record.
7406 my $header = pack('vv', $record, $length);
7407 my $data = pack('vVVVV', $flags, $x_coord, $y_coord, $obj_id, $dv_count);
7408
7409 $self->_append($header, $data);
7410}
7411
7412
7413###############################################################################
7414#
7415# _store_dv()
7416#
7417# Store the DV record that specifies the data validation criteria and options
7418# for a range of cells..
7419#
7420sub _store_dv {
7421
7422 my $self = shift;
7423
7424 my $record = 0x01BE; # Record identifier
7425 my $length = 0x0000; # Bytes to follow
7426
7427 my $flags = 0x00000000; # DV option flags.
7428
7429 my $cells = $_[0]; # Aref of cells to which DV applies.
7430 my $validation_type = $_[1]; # Type of data validation.
7431 my $criteria_type = $_[2]; # Validation criteria.
7432 my $formula_1 = $_[3]; # Value/Source/Minimum formula.
7433 my $formula_2 = $_[4]; # Maximum formula.
7434 my $input_title = $_[5]; # Title of input message.
7435 my $input_message = $_[6]; # Text of input message.
7436 my $error_title = $_[7]; # Title of error message.
7437 my $error_message = $_[8]; # Text of input message.
7438 my $error_type = $_[9]; # Error dialog type.
7439 my $ignore_blank = $_[10]; # Ignore blank cells.
7440 my $dropdown = $_[11]; # Display dropdown with list.
7441 my $input_box = $_[12]; # Display input box.
7442 my $error_box = $_[13]; # Display error box.
7443 my $ime_mode = 0; # IME input mode for far east fonts.
7444 my $str_lookup = 0; # See below.
7445
7446 # Set the string lookup flag for 'list' validations with a string array.
7447 if ($validation_type == 3 && ref $formula_1 eq 'ARRAY') {
7448 $str_lookup = 1;
7449 }
7450
7451 # The dropdown flag is stored as a negated value.
7452 my $no_dropdown = not $dropdown;
7453
7454 # Set the required flags.
7455 $flags |= $validation_type;
7456 $flags |= $error_type << 4;
7457 $flags |= $str_lookup << 7;
7458 $flags |= $ignore_blank << 8;
7459 $flags |= $no_dropdown << 9;
7460 $flags |= $ime_mode << 10;
7461 $flags |= $input_box << 18;
7462 $flags |= $error_box << 19;
7463 $flags |= $criteria_type << 20;
7464
7465 # Pack the validation formulas.
7466 $formula_1 = $self->_pack_dv_formula($formula_1);
7467 $formula_2 = $self->_pack_dv_formula($formula_2);
7468
7469 # Pack the input and error dialog strings.
7470 $input_title = $self->_pack_dv_string($input_title, 32 );
7471 $error_title = $self->_pack_dv_string($error_title, 32 );
7472 $input_message = $self->_pack_dv_string($input_message, 255);
7473 $error_message = $self->_pack_dv_string($error_message, 255);
7474
7475 # Pack the DV cell data.
7476 my $dv_count = scalar @$cells;
7477 my $dv_data = pack 'v', $dv_count;
7478 for my $range (@$cells) {
7479 $dv_data .= pack 'vvvv', $range->[0],
7480 $range->[2],
7481 $range->[1],
7482 $range->[3];
7483 }
7484
7485 # Pack the record.
7486 my $data = pack 'V', $flags;
7487 $data .= $input_title;
7488 $data .= $error_title;
7489 $data .= $input_message;
7490 $data .= $error_message;
7491 $data .= $formula_1;
7492 $data .= $formula_2;
7493 $data .= $dv_data;
7494
7495 my $header = pack('vv', $record, length $data);
7496
7497 $self->_append($header, $data);
7498}
7499
7500
7501###############################################################################
7502#
7503# _pack_dv_string()
7504#
7505# Pack the strings used in the input and error dialog captions and messages.
7506# Captions are limited to 32 characters. Messages are limited to 255 chars.
7507#
7508sub _pack_dv_string {
7509
7510 my $self = shift;
7511
7512 my $string = $_[0];
7513 my $max_length = $_[1];
7514
7515 my $str_length = 0;
7516 my $encoding = 0;
7517
7518 # The default empty string is "\0".
7519 if (!defined $string || $string eq '') {
7520 $string = "\0";
7521 }
7522
7523 # Excel limits DV captions to 32 chars and messages to 255.
7524 if (length $string > $max_length) {
7525 $string = substr($string, 0, $max_length);
7526 }
7527
7528 $str_length = length $string;
7529
7530 # Handle utf8 strings in perl 5.8.
7531 if ($] >= 5.008) {
7532 require Encode;
7533
7534 if (Encode::is_utf8($string)) {
7535 $string = Encode::encode("UTF-16LE", $string);
7536 $encoding = 1;
7537 }
7538 }
7539
7540 return pack('vC', $str_length, $encoding) . $string;
7541}
7542
7543
7544###############################################################################
7545#
7546# _pack_dv_formula()
7547#
7548# Pack the formula used in the DV record. This is the same as an cell formula
7549# with some additional header information. Note, DV formulas in Excel use
7550# relative addressing (R1C1 and ptgXxxN) however we use the Formula.pm's
7551# default absolute addressing (A1 and ptgXxx).
7552#
7553sub _pack_dv_formula {
7554
7555 my $self = shift;
7556
7557 my $formula = $_[0];
7558 my $encoding = 0;
7559 my $length = 0;
7560 my $unused = 0x0000;
7561 my @tokens;
7562
7563 # Return a default structure for unused formulas.
7564 if (!defined $formula || $formula eq '') {
7565 return pack('vv', 0, $unused);
7566 }
7567
7568 # Pack a list array ref as a null separated string.
7569 if (ref $formula eq 'ARRAY') {
7570 $formula = join "\0", @$formula;
7571 $formula = qq("$formula");
7572 }
7573
7574 # Strip the = sign at the beginning of the formula string
7575 $formula =~ s(^=)();
7576
7577 # Parse the formula using the parser in Formula.pm
7578 my $parser = $self->{_parser};
7579
7580 # In order to raise formula errors from the point of view of the calling
7581 # program we use an eval block and re-raise the error from here.
7582 #
7583 eval { @tokens = $parser->parse_formula($formula) };
7584
7585 if ($@) {
7586 $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
7587 croak $@; # Re-raise the error
7588 }
7589 else {
7590 # TODO test for non valid ptgs such as Sheet2!A1
7591 }
7592 # Force 2d ranges to be a reference class.
7593 s/_range2d/_range2dR/ for @tokens;
7594 s/_name/_nameR/ for @tokens;
7595
7596 # Parse the tokens into a formula string.
7597 $formula = $parser->parse_tokens(@tokens);
7598
7599
7600 return pack('vv', length $formula, $unused) . $formula;
7601}
7602
7603
7604
7605
7606
76071;
7608
7609
7610__END__
7611
7612
7613=head1 NAME
7614
7615Worksheet - A writer class for Excel Worksheets.
7616
7617=head1 SYNOPSIS
7618
7619See the documentation for Spreadsheet::WriteExcel
7620
7621=head1 DESCRIPTION
7622
7623This module is used in conjunction with Spreadsheet::WriteExcel.
7624
7625=head1 AUTHOR
7626
7627John McNamara jmcnamara@cpan.org
7628
7629=head1 COPYRIGHT
7630
7631© MM-MMX, John McNamara.
7632
7633All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
7634