File Coverage

blib/lib/Spreadsheet/WriteExcel/BIFFwriter.pm
Criterion Covered Total %
statement 61 87 70.1
branch 7 14 50.0
condition n/a
subroutine 10 12 83.3
pod 0 1 0.0
total 78 114 68.4


line stmt bran cond sub pod time code
1             package Spreadsheet::WriteExcel::BIFFwriter;
2              
3             ###############################################################################
4             #
5             # BIFFwriter - An abstract base class for Excel workbooks and 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              
15 32     32   419 use Exporter;
  32         61  
  32         1348  
16 32     32   164 use strict;
  32         84  
  32         1144  
17              
18              
19              
20              
21              
22              
23              
24 32     32   166 use vars qw($VERSION @ISA);
  32         55  
  32         52717  
25             @ISA = qw(Exporter);
26              
27             $VERSION = '2.40';
28              
29             ###############################################################################
30             #
31             # Class data.
32             #
33             my $byte_order = '';
34             my $BIFF_version = 0x0600;
35              
36              
37             ###############################################################################
38             #
39             # new()
40             #
41             # Constructor
42             #
43             sub new {
44              
45 204     204 0 433 my $class = $_[0];
46              
47 204         1265 my $self = {
48             _byte_order => '',
49             _data => '',
50             _datasize => 0,
51             _limit => 8224,
52             _ignore_continue => 0,
53             };
54              
55 204         572 bless $self, $class;
56 204         616 $self->_set_byte_order();
57 204         615 return $self;
58             }
59              
60              
61             ###############################################################################
62             #
63             # _set_byte_order()
64             #
65             # Determine the byte order and store it as class data to avoid
66             # recalculating it for each call to new().
67             #
68             sub _set_byte_order {
69              
70 204     204   408 my $self = shift;
71              
72 204 100       676 if ($byte_order eq ''){
73             # Check if "pack" gives the required IEEE 64bit float
74 30         83 my $teststr = pack "d", 1.2345;
75 30         126 my @hexdata =(0x8D, 0x97, 0x6E, 0x12, 0x83, 0xC0, 0xF3, 0x3F);
76 30         203 my $number = pack "C8", @hexdata;
77              
78 30 50       155 if ($number eq $teststr) {
    0          
79 30         113 $byte_order = 0; # Little Endian
80             }
81             elsif ($number eq reverse($teststr)){
82 0         0 $byte_order = 1; # Big Endian
83             }
84             else {
85             # Give up. I'll fix this in a later version.
86 0         0 croak ( "Required floating point format not supported " .
87             "on this platform. See the portability section " .
88             "of the documentation."
89             );
90             }
91             }
92 204         6631 $self->{_byte_order} = $byte_order;
93             }
94              
95              
96             ###############################################################################
97             #
98             # _prepend($data)
99             #
100             # General storage function
101             #
102             sub _prepend {
103              
104 2528     2528   3193 my $self = shift;
105 2528         4125 my $data = join('', @_);
106              
107 2528 50       5946 $data = $self->_add_continue($data) if length($data) > $self->{_limit};
108              
109 2528         5958 $self->{_data} = $data . $self->{_data};
110 2528         3287 $self->{_datasize} += length($data);
111              
112 2528         6540 return $data;
113             }
114              
115              
116             ###############################################################################
117             #
118             # _append($data)
119             #
120             # General storage function
121             #
122             sub _append {
123              
124 1257     1257   1466 my $self = shift;
125 1257         2210 my $data = join('', @_);
126              
127 1257 50       3339 $data = $self->_add_continue($data) if length($data) > $self->{_limit};
128              
129 1257         3121 $self->{_data} = $self->{_data} . $data;
130 1257         1725 $self->{_datasize} += length($data);
131              
132 1257         3775 return $data;
133             }
134              
135              
136             ###############################################################################
137             #
138             # _store_bof($type)
139             #
140             # $type = 0x0005, Workbook
141             # $type = 0x0010, Worksheet
142             # $type = 0x0020, Chart
143             #
144             # Writes Excel BOF record to indicate the beginning of a stream or
145             # sub-stream in the BIFF file.
146             #
147             sub _store_bof {
148              
149 196     196   350 my $self = shift;
150 196         299 my $record = 0x0809; # Record identifier
151 196         311 my $length = 0x0010; # Number of bytes to follow
152              
153 196         312 my $version = $BIFF_version;
154 196         293 my $type = $_[0];
155              
156             # According to the SDK $build and $year should be set to zero.
157             # However, this throws a warning in Excel 5. So, use these
158             # magic numbers.
159 196         279 my $build = 0x0DBB;
160 196         272 my $year = 0x07CC;
161              
162 196         248 my $bfh = 0x00000041;
163 196         259 my $sfo = 0x00000006;
164              
165 196         588 my $header = pack("vv", $record, $length);
166 196         569 my $data = pack("vvvvVV", $version, $type, $build, $year, $bfh, $sfo);
167              
168 196         749 $self->_prepend($header, $data);
169             }
170              
171              
172             ###############################################################################
173             #
174             # _store_eof()
175             #
176             # Writes Excel EOF record to indicate the end of a BIFF stream.
177             #
178             sub _store_eof {
179              
180 196     196   288 my $self = shift;
181 196         254 my $record = 0x000A; # Record identifier
182 196         236 my $length = 0x0000; # Number of bytes to follow
183              
184 196         405 my $header = pack("vv", $record, $length);
185              
186 196         652 $self->_append($header);
187             }
188              
189              
190             ###############################################################################
191             #
192             # _add_continue()
193             #
194             # Excel limits the size of BIFF records. In Excel 5 the limit is 2084 bytes. In
195             # Excel 97 the limit is 8228 bytes. Records that are longer than these limits
196             # must be split up into CONTINUE blocks.
197             #
198             # This function take a long BIFF record and inserts CONTINUE records as
199             # necessary.
200             #
201             # Some records have their own specialised Continue blocks so there is also an
202             # option to bypass this function.
203             #
204             sub _add_continue {
205              
206 0     0   0 my $self = shift;
207 0         0 my $data = $_[0];
208 0         0 my $limit = $self->{_limit};
209 0         0 my $record = 0x003C; # Record identifier
210 0         0 my $header;
211             my $tmp;
212              
213             # Skip this if another method handles the continue blocks.
214 0 0       0 return $data if $self->{_ignore_continue};
215              
216             # The first 2080/8224 bytes remain intact. However, we have to change
217             # the length field of the record.
218             #
219 0         0 $tmp = substr($data, 0, $limit, "");
220 0         0 substr($tmp, 2, 2, pack("v", $limit-4));
221              
222             # Strip out chunks of 2080/8224 bytes +4 for the header.
223 0         0 while (length($data) > $limit) {
224 0         0 $header = pack("vv", $record, $limit);
225 0         0 $tmp .= $header;
226 0         0 $tmp .= substr($data, 0, $limit, "");
227             }
228              
229             # Mop up the last of the data
230 0         0 $header = pack("vv", $record, length($data));
231 0         0 $tmp .= $header;
232 0         0 $tmp .= $data;
233              
234 0         0 return $tmp ;
235             }
236              
237              
238             ###############################################################################
239             #
240             # _add_mso_generic()
241             #
242             # Create a mso structure that is part of an Escher drawing object. These are
243             # are used for images, comments and filters. This generic method is used by
244             # other methods to create specific mso records.
245             #
246             # Returns the packed record.
247             #
248             sub _add_mso_generic {
249              
250 196     196   6966 my $self = shift;
251 196         241 my $type = $_[0];
252 196         226 my $version = $_[1];
253 196         208 my $instance = $_[2];
254 196         245 my $data = $_[3];
255 196 100       369 my $length = defined $_[4] ? $_[4] : length($data);
256              
257             # The header contains version and instance info packed into 2 bytes.
258 196         326 my $header = $version | ($instance << 4);
259              
260 196         456 my $record = pack "vvV", $header, $type, $length;
261 196         319 $record .= $data;
262              
263 196         843 return $record;
264             }
265              
266              
267             ###############################################################################
268             #
269             # For debugging
270             #
271             sub _hexout {
272              
273 0     0     my $self = shift;
274              
275 0           print +(caller(1))[3], "\n";
276              
277 0           my $data = join '', @_;
278              
279 0           my @bytes = unpack("H*", $data) =~ /../g;
280              
281 0           while (@bytes > 16) {
282 0           print join " ", splice @bytes, 0, 16;
283 0           print "\n";
284             }
285 0           print join " ", @bytes, "\n\n";
286             }
287              
288              
289              
290             1;
291              
292              
293             __END__