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.xlsx',
13             sheet => 'Products',
14             styles => {
15             money => '($#,##0_);($#,##0)',
16             },
17             );
18              
19             $h->addrow('foo',{
20             content => 'bar',
21             type => 'number',
22             style => 'money',
23             font_weight => 'bold',
24             font_color => 42,
25             bg_color => 'gray',
26             font_face => 'Times New Roman',
27             font_size => 20,
28             align => 'center',
29             valign => 'vcenter',
30             font_decoration => 'strikeout',
31             font_style => 'italic',
32             });
33             $h->addrow('foo2','bar2');
34             $h->freeze(1,0);
35              
36             # CSV file
37              
38             use Spreadsheet::Write;
39              
40             my $h=Spreadsheet::Write->new(
41             file => 'file.csv',
42             encoding => 'iso8859',
43             );
44             die $h->error() if $h->error;
45             $h->addrow('foo','bar');
46              
47             =head1 DESCRIPTION
48              
49             C writes files in CSV, XLS (Microsoft Excel 97),
50             XLSX (Microsoft Excel 2007), and other formats if their drivers
51             exist. It is especially suitable for building various dumps and reports
52             where rows are built in sequence, one after another.
53              
54             =head1 METHODS
55              
56             =cut
57              
58             ###############################################################################
59             package Spreadsheet::Write;
60              
61             require 5.008_009;
62              
63 1     1   14997 use strict;
  1         1  
  1         23  
64 1     1   368 use IO::File;
  1         5583  
  1         694  
65              
66             our $VERSION='1.02';
67              
68             sub version {
69 0     0 0 0 return $VERSION;
70             }
71              
72             ###############################################################################
73              
74             =head2 new ()
75              
76             $spreadsheet = Spreadsheet::Write->new(
77             file => 'table.xls',
78             styles => {
79             mynumber => '#,##0.00',
80             }
81             );
82              
83             Creates a new spreadsheet object. It takes a list of options. The
84             following are valid:
85              
86             file filename of the new spreadsheet or an IO handle (mandatory)
87             encoding encoding of output file (optional, csv format only)
88             format format of spreadsheet - 'csv', 'xls', 'xlsx', or 'auto' (default)
89             sheet Sheet name (optional, not supported by some formats)
90             styles Defines cell formatting shortcuts (optional)
91              
92             If file format is 'auto' (or omitted), the format is guessed from the
93             filename extention. If impossible to guess the format defaults to 'csv'.
94              
95             An IO-like handle can be given as 'file' argument (IO::File, IO::Scalar,
96             etc). In this case the format argument is mandatory.
97              
98             Default styles are:
99             header => {
100             font_weight => 'bold',
101             type => 'string',
102             },
103             ntext => {
104             format => '@',
105             type => 'string',
106             },
107             money => {
108             format => '$#,##0.00;-$#,##0.00',
109             },
110              
111             =cut
112              
113             sub new(@) {
114 4     4 1 78223 my $proto = shift;
115 4 50       23 my $args=ref($_[0]) eq 'HASH' ? $_[0] : {@_};
116              
117 4   0     15 my $filename=$args->{'file'} || $args->{'filename'} || die 'No file given';
118              
119 4   50     13 my $format=$args->{'format'} || 'auto';
120 4 50       10 if($format eq 'auto') {
121 0 0       0 die "Need a 'format' argument for IO-handle in 'file'" if ref $filename;
122 0 0       0 $format=($filename=~/.*\.(.+?)$/) ? lc($1) : 'csv';
123             }
124              
125             # Some commonly used styles
126             #
127 4         6 my %parm=%{$args};
  4         17  
128 4   50     41 $parm{'styles'}->{'ntext'}||={
129             format => '@',
130             type => 'string',
131             };
132 4   50     26 $parm{'styles'}->{'header'}||={
133             font_weight => 'bold',
134             type => 'string',
135             };
136 4   50     21 $parm{'styles'}->{'money'}||={
137             format => '$#,##0.00;-$#,##0.00',
138             };
139              
140             # CPAN ownership of Spreadsheet::Write::CSV and a number of other
141             # simpler names belongs to Toby Inkman, with Spreadsheet::Wright
142             # clone.
143             #
144             my $implementation={
145             csv => 'WriteCSV',
146             xls => 'WriteXLS',
147             xlsx => 'WriteXLSX',
148 4         22 }->{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   427 eval "use $implementation;";
  1     1   3  
  1     1   13  
  1     1   7  
  1         2  
  1         16  
  1         352  
  1         2  
  1         13  
  1         5  
  1         1  
  1         11  
  4         229  
156 4 50       13 die $@ if $@;
157              
158 4         18 return $implementation->new(%parm);
159             }
160              
161             ###############################################################################
162              
163             sub DESTROY {
164 4     4   1166 my $self=shift;
165             ### print STDERR "DESTROY: ".ref($self)."\n";
166 4         31 $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   14 my $self=shift;
180              
181 14 50       23 $self->{'_CLOSED'} && die "Can't reuse a closed spreadsheet";
182              
183 14         14 my $fh=$self->{'_FH'};
184              
185 14 100       22 if(!$fh) {
186 4   50     9 my $filename=$self->{'_FILENAME'} || return undef;
187              
188 4 50       8 if(ref($filename)) {
189 0         0 $fh=$filename;
190 0         0 $self->{'_EXT_HANDLE'}=1;
191             }
192             else {
193 4         19 $fh=new IO::File;
194 4 50       132 $fh->open($filename,"w") || die "Can't open file $filename for writing: $!";
195 4         420 $fh->binmode(':utf8');
196             }
197             }
198              
199 14         60 $self->{'_FH'}=$fh;
200              
201 14         26 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.xlsx',
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 94 my $self = shift;
283 12 50       27 $self->_open() || return undef;
284              
285 12         14 my @cells;
286              
287 12         21 foreach my $item (@_) {
288 28 100       40 if (ref $item eq 'HASH') {
289 20 100       27 if (ref $item->{'content'} eq 'ARRAY') {
290 12         12 foreach my $i (@{ $item->{'content'} }) {
  12         23  
291 32         74 my %newitem = %$item;
292 32         37 $newitem{'content'} = $i;
293 32         51 push @cells, \%newitem;
294             }
295             }
296             else {
297 8         11 push @cells, $item;
298             }
299             }
300             else {
301 8         13 push @cells, { content => $item };
302             }
303             }
304              
305 12         22 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 12 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__