File Coverage

blib/lib/Spreadsheet/WriteExcel/FromXML.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Spreadsheet::WriteExcel::FromXML;
2 5     5   43026 use strict;
  5         12  
  5         207  
3 5     5   31 use warnings;
  5         10  
  5         394  
4              
5             our $VERSION = '1.1';
6 5     5   29 use Carp qw(confess cluck);
  5         15  
  5         352  
7              
8 5     5   3505 use Spreadsheet::WriteExcel::FromXML::Workbook;
  5         17  
  5         174  
9 5     5   11258 use IO::Scalar;
  0            
  0            
10             use XML::Parser;
11              
12             =head1 NAME
13              
14             Spreadsheet::WriteExcel::FromXML - Create Excel Spreadsheet from XML
15              
16             =head1 SYNOPSIS
17              
18             use strict;
19             use warnings;
20             use Spreadsheet::WriteExcel::FromXML;
21             my $fromxml = Spreadsheet::WriteExcel::FromXML->new( "file.xml" );
22             $fromxml->parse;
23             $fromxml->buildSpreadsheet;
24             $fromxml->writeFile("file.xls");
25             # or
26             my $data = $fromxml->getSpreadsheetData;
27             # then write $data to a file...or do with it as you wish
28              
29             # or, even simpler:
30             my $data = Spreadsheet::WriteExcel::FromXML->BuildSpreadsheet( "file.xml" );
31              
32             # or, even simpler:
33             Spreadsheet::WriteExcel::FromXML->XMLToXLS( "file.xml", "file.xls" );
34              
35             =head1 DESCRIPTION
36              
37             This module uses Spreadsheet::WriteExcel to turn a simple XML data
38             file into a binary Excel XLS file.
39              
40             See also the FromXML.dtd file in the distribution.
41              
42             =head1 API REFERENCE
43              
44             =head2 new([$])
45              
46             Param: XML file name - name of file to be parsed.
47             Return: ToExcel object.
48              
49             Constructor. Optionally takes an XML file name.
50              
51             =cut
52              
53             sub new
54             {
55             my($this,$xmlsource,$bigflag) = @_;
56             my $class = ref($this) || $this;
57             my $self = {};
58             bless $self,$class;
59              
60             $self->_initializeXMLSource($xmlsource) if $xmlsource;
61             $self->bigflag( $bigflag ) if $bigflag;
62              
63             return $self;
64             }
65              
66             sub BuildSpreadsheet
67             {
68             my($this,$file,$bigflag) = @_;
69             my $fromxml = Spreadsheet::WriteExcel::FromXML->new($file,$bigflag);
70             $fromxml->parse;
71             $fromxml->buildSpreadsheet;
72             return $fromxml->getSpreadsheetData;
73             }
74              
75             sub XMLToXLS
76             {
77             my($this,$source,$dest,$bigflag) = @_;
78             my $fromxml = Spreadsheet::WriteExcel::FromXML->new($source,$bigflag);
79             $fromxml->parse;
80             $fromxml->buildSpreadsheet;
81             return $fromxml->writeFile($dest);
82             }
83              
84             =head2 private void _initializeXMLSource($)
85              
86             Param: XML file source (GLOB, IO::Handle, file name or XML as a string [or scalar ref])
87             Return: true
88             Throws: exception if unable to
89              
90             Initializer method to check for existance of the XML file.
91              
92             =cut
93              
94             sub _initializeXMLSource
95             {
96             my($self,$xmlsource) = @_;
97              
98             $self->_closeXMLSource;
99              
100             unless( defined $xmlsource && length($xmlsource) ) {
101             confess "Error, \$xmlsource is a required parameter!\n";
102             }
103              
104             if( UNIVERSAL::isa( $xmlsource, 'IO::Handle' ) || UNIVERSAL::isa( $xmlsource, 'GLOB' ) ) {
105             $self->_debug("_initializeXMLSource: xmlsource:'$xmlsource' was an IO::Handle or GLOB");
106             $self->_xmlfh( $xmlsource );
107             $self->_shouldCloseSource(undef);
108             return 1;
109             }
110              
111             if( '.xml' eq substr($xmlsource, -4) && -r $xmlsource ) {
112             $self->_debug("_initializeXMLSource: xmlsource:'$xmlsource' was a file path.");
113             my $fh;
114             unless( open $fh, $xmlsource ) {
115             confess "Cannot open '$xmlsource' : $!\n";
116             }
117              
118             $self->_xmlfh( $fh );
119             $self->_shouldCloseSource(1);
120             return 1;
121             }
122              
123             if( UNIVERSAL::isa( $xmlsource, 'SCALAR' ) ) {
124             $self->_debug( "_initializeXMLSource: xmlsource:'$xmlsource' was a scalar reference.");
125             my $ioh = IO::Scalar->new( $xmlsource ) or confess "Error setting parsing from string: $!\n";
126             $self->_xmlfh( $ioh );
127             $self->_shouldCloseSource(1);
128             return 1;
129             }
130              
131             # assume a string of XML...
132             if( 0 != index( $xmlsource, '
133             confess "Error: xmlsource wasn't a file handle, glob, or a file ",
134             "in the file system, and xmlsource(",substr($xmlsource,0,64),
135             "...) doesn't look like XML to me (doesn't start with '
136             }
137              
138             $self->_debug( "_initializeXMLSource: xmlsource(",length($xmlsource),") was a string." );
139             my $ioh = IO::Scalar->new( \$xmlsource ) or confess "Error setting parsing from string: $!\n";
140             $self->_xmlfh( $ioh );
141             $self->_shouldCloseSource(1);
142              
143             return 1;
144             }
145              
146             sub _closeXMLSource
147             {
148             my($self) = @_;
149             if( $self->_xmlfh && $self->_shouldCloseSource ) {
150             close( $self->_xmlfh ) or confess "Error closing xmlsource! : $!\n";
151             $self->_xmlfh(undef);
152             }
153             return 1;
154             }
155              
156             sub DESTROY
157             {
158             my($self) = @_;
159             $self->_closeXMLSource;
160             }
161              
162             =head2 parse
163              
164             Param: XML file name or an IO::Handle [optional].
165             Return: true
166             Throws: exception if xmlsource initialization fails, or if parsing fails
167              
168             A method to make the necessary calls to parse the XML file. Remember,
169             if a file handle is passed in the calling code is responsible for
170             closing it.
171              
172             =cut
173              
174             sub parse
175             {
176             my($self,$xmlsource) = @_;
177              
178             $self->_initializeXMLSource( $xmlsource ) if $xmlsource;
179             confess "Error, never initialized with an xml source!\n" unless $self->_xmlfh;
180              
181             $self->_parseXMLFileToTree;
182              
183             my $type = shift @{ $self->_treeData };
184             my $ar = shift @{ $self->_treeData };
185             my $rownum = -1; my $colnum = -1;
186             $self->_processTree( $ar, $type, \$rownum, \$colnum );
187              
188             return 1;
189             }
190              
191             =head2 _parseXMLFileToTree
192              
193             Param: none.
194             Return: true
195              
196             A method to parse an XML file into a tree-style data structure
197             using XML::Parser.
198              
199             =cut
200             sub _parseXMLFileToTree
201             {
202             my($self) = @_;
203              
204             eval {
205             my $p = new XML::Parser( 'Style' => 'Tree' );
206             $self->_treeData( $p->parse( $self->_xmlfh ) );
207              
208             };
209              
210             if($@) {
211             confess "Error calling XML::Parser->parse threw exception: $@";
212             }
213              
214             unless( defined $self->_treeData ) {
215             confess "Error calling XML::Parser->parse. No data was parsed!\n";
216             }
217              
218             return 1;
219             }
220              
221             =head2 _processTree
222              
223             Param: $ar - child xml elements
224             Param: $xmltag - the xml tag name (string)
225             Param: $rownum - the current row number in the internal worksheet
226             Param: $column - the current column number in the current row
227             Param: $rowformat
228             Return: void.
229              
230             A method for taking the tree-style data structure from XML::Parser and
231             sticking the data into our object structure & Spreadsheet::WriteExcel.
232             After this method is called, we have an Excel spreadsheet ready for
233             output.
234              
235             =cut
236              
237             sub _processTree
238             {
239             my($self,$ar,$xmltag,$rownum,$colnum,$rowformat,$rowdatatype,$coldatatype) = @_;
240             my $attr = shift @{ $ar } || {};
241              
242             if( 'workbook' eq $xmltag )
243             {
244             $self->workbook( Spreadsheet::WriteExcel::FromXML::Workbook->new($self->bigflag) );
245             }
246             elsif( 'worksheet' eq $xmltag )
247             {
248             unless( exists $attr->{'title'} && $attr->{'title'} ) {
249             confess "Must define a title attribute for worksheet!\n";
250             }
251             $self->currentWorksheet( $self->workbook->addWorksheet( $attr->{'title'}, $attr->{'landscape'}, $attr->{'paper'}, $attr->{'header'}, $attr->{'header_margin'}, $attr->{'footer'}, $attr->{'footer_margin'} ) );
252             ${ $rownum } = -1; # new worksheet, reset the row count.
253             }
254             elsif( 'row' eq $xmltag )
255             {
256             ++${ $rownum };
257             ${ $colnum } = -1; # new row, reset the column count.
258             $rowformat = undef;
259             $rowdatatype = undef;
260             if( exists $attr->{'format'} )
261             {
262             $rowformat = $attr->{'format'};
263             }
264             if( exists $attr->{'type'} )
265             {
266             $rowdatatype = $attr->{'type'};
267             }
268             }
269             elsif( 'cell' eq $xmltag )
270             {
271             ++${ $colnum };
272             my $tmp = shift @{ $ar };
273             my $data = shift @{ $ar } || '';
274             # Partial DTD validation
275             # if( ref($data) )
276             # {
277             # confess "Unexpected XML syntax. tag should not contain any other tags (row ".(++${$rownum}).", col ".(++${$colnum}).").\n";
278             # }
279              
280             my $format = $rowformat || undef;
281             my $datatype = $rowdatatype || $coldatatype || 'string';
282             if( exists $attr->{'format'} )
283             {
284             $format = $attr->{'format'};
285             }
286             if( exists $attr->{'type'} )
287             {
288             $datatype = $attr->{'type'};
289             }
290             $self->currentWorksheet->addCell( $data, $datatype, $rownum, $colnum, $format );
291             }
292             elsif( 'format' eq $xmltag )
293             {
294             unless( exists $attr->{'name'} && $attr->{'name'} ) {
295             confess "Must define a name attribute for format!\n";
296             }
297             # $self->_debug( "Adding format ",$attr->{'name'} );;
298             $self->workbook->addFormat( $attr );
299             }
300             # Range implements set_column functionality
301             elsif ('range' eq $xmltag)
302             {
303             unless (exists $attr->{'first_col'}) {
304             confess "Must define a first column for ranges!\n";
305             }
306             $self->currentWorksheet->addRange($attr->{'first_col'}, $attr->{'last_col'},
307             $attr->{'width'}, $attr->{'format'},
308             $attr->{'hidden'}, $attr->{'level'});
309             }
310             elsif ('margins' eq $xmltag)
311             {
312             my $tmp = shift @{ $ar };
313             my $data = shift @{ $ar } || undef;
314             my $lr = $attr->{'lr'} || undef;
315             my $tb = $attr->{'tb'} || undef;
316             my $left = $attr->{'left'} || undef;
317             my $right = $attr->{'right'} || undef;
318             my $top = $attr->{'top'} || undef;
319             my $bottom = $attr->{'bottom'} || undef;
320              
321             $self->currentWorksheet->setMargins($data, $lr, $tb, $left, $right, $top, $bottom);
322             }
323             else
324             {
325             cluck "Unrecognized type '$xmltag'. Ignored.\n";
326             }
327              
328             for( my $i = 0; $i < @{ $ar }; ++$i )
329             {
330             if( 'ARRAY' eq ref( $ar->[$i] ) )
331             {
332             $self->_processTree( $ar->[$i], $ar->[$i-1], $rownum, $colnum, $rowformat, $rowdatatype );
333             }
334             }
335             }
336              
337             sub buildSpreadsheet
338             {
339             my($self) = @_;
340             unless ( $self->workbook ) {
341             confess "Workbook is uninitialized. Did you call parse?\n";
342             }
343             $self->workbook->buildWorkbook;
344             return 1;
345             }
346              
347             =head2 writeFile($)
348              
349             Param: filename - file name to output Excel data to.
350             Return: true/false
351             Throws: exception if unable to open the file.
352              
353             writeFile takes a file name and writes the XLS data from the internal buffer
354             to the specified file.
355              
356             =cut
357              
358             sub writeFile
359             {
360             my($self,$filename) = @_;
361             unless( $filename ) {
362             confess "Must pass writeFile a file name.\n";
363             }
364              
365             $self->_debug("writing to file: $filename");
366             my $fh;
367             unless( open $fh, '>', $filename ) {
368             confess "Cannot open '$filename': $!\n";
369             }
370             binmode $fh;
371             print $fh $self->getSpreadsheetData;
372             close $fh;
373             return 1;
374             }
375              
376             =head2 getSpreadsheetData
377              
378             Once the spreadsheet has been generated, this method returns the
379             binary representation of the spreadsheet.
380              
381             =cut
382              
383             sub getSpreadsheetData
384             {
385             my($self) = @_;
386             return $self->workbook->getSpreadsheetData;
387             }
388              
389             =head2 workbook([$])
390              
391             Get/set method to reference our Workbook object.
392              
393             =cut
394              
395             sub workbook { @_>1 ? $_[0]->{'_workbook'} = $_[1] : $_[0]->{'_workbook'}; }
396              
397             sub currentWorksheet { @_>1 ? $_[0]->{'_currentWorksheet'} = $_[1] : $_[0]->{'_currentWorksheet'}; }
398             sub currentWorkbook { @_>1 ? $_[0]->{'_currentWorkbook'} = $_[1] : $_[0]->{'_currentWorkbook'}; }
399              
400             =head2 _treeData([$])
401              
402             Get/set method for the raw XML tree data.
403              
404             =cut
405             sub _treeData { @_>1 ? $_[0]->{'_treeData'} = $_[1] : $_[0]->{'_treeData'}; }
406              
407              
408             =head2 _xmlfh([$])
409              
410             Get/set method for the XML file that is being parsed.
411              
412             =cut
413             sub _xmlfh { @_>1 ? $_[0]->{'_xmlfh'} = $_[1] : $_[0]->{'_xmlfh'}; }
414              
415              
416             {my $debug = 0;
417             sub debug { @_>1 ? $debug = $_[1] : $debug; }
418             sub _debug
419             {
420             my($self,@msg) = @_;
421             return undef unless $debug;
422             my($p,$f,$l) = caller();
423             print "$p->$f($l): ",@msg,"\n";
424             }
425             }
426              
427              
428             sub _shouldCloseSource { @_>1 ? $_[0]->{'_shouldCloseSource'} = $_[1] : $_[0]->{'_shouldCloseSource'}; }
429              
430             =head2 bigflag([$])
431              
432             Get/set method for large (>7mb) Excel spreadsheets. If set, the code will make the
433             appriopriate calls to build a spreadsheet >7mb. This requires a patch to
434             OLE::Storage_Lite.
435              
436             =cut
437             sub bigflag { @_>1 ? $_[0]->{'_bigflag'} = $_[1] : $_[0]->{'_bigflag'}; }
438              
439             1;
440              
441              
442             =head1 SEE ALSO
443              
444             SpreadSheet::WriteExcel
445             SpreadSheet::WriteExcel::FromDB
446             OLE::Storage_Lite
447              
448             =head1 AUTHORS
449              
450             W. Justin Bedard juice [at] lerch.org
451              
452             Kyle R. Burton mortis [at] voicenet.com, krburton [at] cpan.org
453              
454             Brendan W. McAdams bwmcadams [at] cpan.org
455              
456             =cut