File Coverage

lib/Spreadsheet/Write.pm
Criterion Covered Total %
statement 62 78 79.4
branch 14 30 46.6
condition 5 12 41.6
subroutine 11 17 64.7
pod 6 8 75.0
total 98 145 67.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Spreadsheet::Write - Simplified writer for CSV or XLS (MS Excel'97) files
4              
5             =head1 SYNOPSIS
6              
7             # EXCEL spreadsheet
8              
9             use Spreadsheet::Write;
10              
11             my $h=Spreadsheet::Write->new(
12             file => 'spreadsheet.xls',
13             format => 'xls',
14             sheet => 'Products',
15             styles => {
16             money => '($#,##0_);($#,##0)',
17             },
18             );
19              
20             $h->addrow('foo',{
21             content => 'bar',
22             type => 'number',
23             style => 'money',
24             font_weight => 'bold',
25             font_color => 42,
26             bg_color => 'gray',
27             font_face => 'Times New Roman',
28             font_size => 20,
29             align => 'center',
30             valign => 'vcenter',
31             font_decoration => 'strikeout',
32             font_style => 'italic',
33             });
34             $h->addrow('foo2','bar2');
35             $h->freeze(1,0);
36              
37             # CSV file
38              
39             use Spreadsheet::Write;
40              
41             my $h=Spreadsheet::Write->new(
42             file => 'file.csv',
43             encoding => 'iso8859',
44             );
45             die $h->error() if $h->error;
46             $h->addrow('foo','bar');
47              
48             =head1 DESCRIPTION
49              
50             C writes files in CSV, XLS (Microsoft Excel 97),
51             and potentially other formats. It is especially suitable for building
52             various dumps and reports where rows are built in sequence, one after
53             another.
54              
55             =head1 METHODS
56              
57             =cut
58              
59             ###############################################################################
60             package Spreadsheet::Write;
61              
62             require 5.008_009;
63              
64 1     1   14469 use strict;
  1         2  
  1         20  
65 1     1   390 use IO::File;
  1         5202  
  1         691  
66              
67             our $VERSION='1.01';
68              
69             sub version {
70 0     0 0 0 return $VERSION;
71             }
72              
73             ###############################################################################
74              
75             =head2 new ()
76              
77             $spreadsheet = Spreadsheet::Write->new(
78             file => 'table.xls',
79             styles => {
80             mynumber => '#,##0.00',
81             }
82             );
83              
84             Creates a new spreadsheet object. It takes a list of options. The
85             following are valid:
86              
87             file filename of the new spreadsheet or an IO handle (mandatory)
88             encoding encoding of output file (optional, csv format only)
89             format format of spreadsheet - 'csv', 'xls', or 'auto' (default)
90             sheet Sheet name (optional, not supported by some formats)
91             styles Defines cell formatting shortcuts (optional)
92              
93             If file format is 'auto' (or omitted), the format is guessed from the
94             filename extention. If impossible to guess the format defaults to 'csv'.
95              
96             An IO-like handle can be given as 'file' argument (IO::File, IO::Scalar,
97             etc). In this case the format argument is mandatory.
98              
99             Default styles are:
100             header => {
101             font_weight => 'bold',
102             type => 'string',
103             },
104             ntext => {
105             format => '@',
106             type => 'string',
107             },
108             money => {
109             format => '$#,##0.00;-$#,##0.00',
110             },
111              
112             =cut
113              
114             sub new(@) {
115 4     4 1 83542 my $proto = shift;
116 4 50       27 my $args=ref($_[0]) eq 'HASH' ? $_[0] : {@_};
117              
118 4   0     18 my $filename=$args->{'file'} || $args->{'filename'} || die 'No file given';
119              
120 4   50     14 my $format=$args->{'format'} || 'auto';
121 4 50       13 if($format eq 'auto') {
122 0 0       0 die "Need a 'format' argument for IO-handle in 'file'" if ref $filename;
123 0 0       0 $format=($filename=~/.*\.(.+?)$/) ? lc($1) : 'csv';
124             }
125              
126             # Some commonly used styles
127             #
128 4         6 my %parm=%{$args};
  4         18  
129 4   50     33 $parm{'styles'}->{'ntext'}||={
130             format => '@',
131             type => 'string',
132             };
133 4   50     22 $parm{'styles'}->{'header'}||={
134             font_weight => 'bold',
135             type => 'string',
136             };
137 4   50     19 $parm{'styles'}->{'money'}||={
138             format => '$#,##0.00;-$#,##0.00',
139             };
140              
141             # CPAN ownership of Spreadsheet::Write::CSV and a number of other
142             # simpler names belongs to Toby Inkman, with Spreadsheet::Wright
143             # clone.
144             #
145             my $implementation={
146             csv => 'WriteCSV',
147             xls => 'WriteXLS',
148 4         16 }->{lc $format};
149              
150 4 50       12 $implementation ||
151             die "Format $format is not supported";
152              
153 4         14 $implementation=join('::',(__PACKAGE__,$implementation));
154              
155 1     1   617 eval "use $implementation;";
  1     1   4  
  1     1   30  
  1     1   5  
  1         2  
  1         12  
  1         318  
  1         3  
  1         14  
  1         4  
  1         2  
  1         10  
  4         223  
156 4 50       13 die $@ if $@;
157              
158 4         18 return $implementation->new(%parm);
159             }
160              
161             ###############################################################################
162              
163             sub DESTROY {
164 4     4   981 my $self=shift;
165             ### print STDERR "DESTROY: ".ref($self)."\n";
166 4         21 $self->close();
167             }
168              
169             ###############################################################################
170              
171             sub error {
172 0     0 0 0 my $self=shift;
173 0         0 return $self->{'_ERROR'};
174             }
175              
176             ###############################################################################
177              
178             sub _open($) {
179 14     14   16 my $self=shift;
180              
181 14 50       29 $self->{'_CLOSED'} && die "Can't reuse a closed spreadsheet";
182              
183 14         17 my $fh=$self->{'_FH'};
184              
185 14 100       21 if(!$fh) {
186 4   50     12 my $filename=$self->{'_FILENAME'} || return undef;
187              
188 4 50       9 if(ref($filename)) {
189 0         0 $fh=$filename;
190 0         0 $self->{'_EXT_HANDLE'}=1;
191             }
192             else {
193 4         23 $fh=new IO::File;
194 4 50       148 $fh->open($filename,"w") || die "Can't open file $filename for writing: $!";
195 4         449 $fh->binmode(':utf8');
196             }
197             }
198              
199 14         67 $self->{'_FH'}=$fh;
200              
201 14         32 return $self->_prepare;
202             }
203              
204             ###############################################################################
205              
206       0     sub _prepare {
207             # no-op by default
208             }
209              
210             ###############################################################################
211              
212             =head2 addrow(arg1,arg2,...)
213              
214             Adds a row into the spreadsheet. Takes arbitrary number of
215             arguments. Arguments represent cell values and may be strings or hash
216             references. If an argument is a hash reference, it takes the following
217             structure:
218              
219             content value to put into the cell
220             style formatting style, as defined in new(), scalar or array-ref
221             type type of the content (defaults to 'auto')
222             format number format (see Spreadsheet::WriteExcel for details)
223             font_weight weight of font. Only valid value is 'bold'
224             font_style style of font. Only valid value is 'italic'
225             font_decoration 'underline' or 'strikeout' (or both, space separated)
226             font_face font of column; default is 'Arial'
227             font_color color of font (see Spreadsheet::WriteExcel for color values)
228             font_size size of font
229             bg_color color of background (see Spreadsheet::WriteExcel for color values)
230             align alignment
231             valign vertical alignment
232             width column width, excel units (only makes sense once per column)
233             height row height, excel units (only makes sense once per row)
234             comment hidden comment for the cell, where supported
235              
236             Styles can be used to assign default values for any of these formatting
237             parameters thus allowing easy global changes. Other parameters specified
238             override style definitions.
239              
240             Example:
241              
242             my $sp=Spreadsheet::Write->new(
243             file => 'employees.xls',
244             styles => {
245             header => { font_weight => 'bold' },
246             },
247             );
248             $sp->addrow(
249             { content => 'First Name', font_weight => 'bold' },
250             { content => 'Last Name', font_weight => 'bold' },
251             { content => 'Age', style => 'header' },
252             );
253             $sp->addrow("John","Doe",34);
254             $sp->addrow("Susan","Smith",28);
255              
256             Note that in this example all header cells will have identical
257             formatting even though some use direct formats and one uses
258             style.
259              
260             If you want to store text that looks like a number you might want to use
261             { type => 'string', format => '@' } arguments. By default the type detection is automatic,
262             as done by for instance L write() method.
263              
264             It is also possible to supply an array reference in the 'content'
265             parameter of the extended format. It means to use the same formatting
266             for as many cells as there are elements in this array. Useful for
267             creating header rows. For instance, the above example can be rewritten
268             as:
269              
270             $sp->addrow(
271             { style => 'header',
272             content => [ 'First Name','Last Name','Age' ],
273             }
274             );
275              
276             Not all styling options are supported in all formats. Where they are not
277             supported they are safely ignored.
278              
279             =cut
280              
281             sub addrow (@) {
282 12     12 1 115 my $self = shift;
283 12 50       36 $self->_open() || return undef;
284              
285 12         12 my @cells;
286              
287 12         20 foreach my $item (@_) {
288 28 100       47 if (ref $item eq 'HASH') {
289 20 100       32 if (ref $item->{'content'} eq 'ARRAY') {
290 12         11 foreach my $i (@{ $item->{'content'} }) {
  12         19  
291 32         95 my %newitem = %$item;
292 32         45 $newitem{'content'} = $i;
293 32         49 push @cells, \%newitem;
294             }
295             }
296             else {
297 8         11 push @cells, $item;
298             }
299             }
300             else {
301 8         19 push @cells, { content => $item };
302             }
303             }
304              
305 12         28 return $self->_add_prepared_row(@cells);
306             }
307              
308             ###############################################################################
309              
310             =head2 addrows([$cell1A,$cell1B,...],[$cell2A,$cell2B,...],...)
311              
312             Shortcut for adding multiple rows.
313              
314             Each argument is an arrayref representing a row.
315              
316             Any argument that is not a reference (i.e. a scalar) is taken to be the
317             title of a new worksheet.
318              
319             =cut
320              
321             sub addrows (@) {
322 0     0 1 0 my $self=shift;
323              
324 0         0 foreach my $row (@_) {
325 0 0       0 if (ref $row eq 'ARRAY') {
    0          
326 0         0 $self->addrow(@$row);
327             }
328             elsif (!ref $row) {
329 0         0 $self->addsheet($row);
330             }
331             else {
332 0         0 warn "Unsupported row format '".ref($row)."'";
333             }
334             }
335              
336 0         0 return $self;
337             }
338              
339             ###############################################################################
340              
341             =head2 addsheet(name)
342              
343             Adds a new sheet into the document and makes it active. Subsequent
344             addrow() calls will add rows to that new sheet.
345              
346             For CSV format this call is NOT ignored, but produces a fatal error
347             currently.
348              
349             =cut
350              
351             sub addsheet ($$) {
352 0     0 1 0 die (((caller(0))[3])." - pure virtual method called");
353             }
354              
355             ###############################################################################
356              
357             =head2 freeze($row, $col, $top_row, $left_col))
358              
359             Sets a freeze-pane at the given position, equivalent to Spreadsheet::WriteExcel->freeze_panes().
360             Ignored for CSV files.
361              
362             =cut
363              
364             sub freeze (@) {
365 2     2 1 11 return shift;
366             }
367              
368             ###############################################################################
369              
370             =head2 close ()
371              
372             Finalizes the spreadsheet and closes the file. It is a good idea
373             to call this method explicitly instead of relying on perl's garbage
374             collector because for many formats the file may be in an unusable
375             state until this method is called.
376              
377             Once a spreadsheet is closed, calls to addrow() will fail.
378              
379             =cut
380              
381             sub close {
382             ### print STDERR "0: ".join("/",map { $_ || 'UNDEF' } caller(0))."\n";
383             ### print STDERR "1: ".join("/",map { $_ || 'UNDEF' } caller(1))."\n";
384             ### print STDERR "2: ".join("/",map { $_ || 'UNDEF' } caller(2))."\n";
385             ### print STDERR "3: ".join("/",map { $_ || 'UNDEF' } caller(3))."\n";
386 0     0 1   die (((caller(0))[3])." - pure virtual method called");
387             }
388              
389             ###############################################################################
390              
391             1;
392             __END__