File Coverage

blib/lib/Excel/Template.pm
Criterion Covered Total %
statement 15 17 88.2
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 21 23 91.3


line stmt bran cond sub pod time code
1             package Excel::Template;
2              
3 29     29   18741 use strict;
  29         46  
  29         1049  
4              
5             BEGIN {
6 29     29   11440 use Excel::Template::Base;
  29         60  
  29         895  
7 29     29   155 use vars qw ($VERSION @ISA);
  29         37  
  29         1865  
8              
9 29     29   52 $VERSION = '0.31_1';
10 29         685 @ISA = qw( Excel::Template::Base );
11             }
12              
13 29     29   136 use File::Basename;
  29         37  
  29         2360  
14 29     29   6548 use XML::Parser;
  0            
  0            
15             use IO::Scalar;
16              
17             use constant RENDER_NML => 'normal';
18             use constant RENDER_BIG => 'big';
19             use constant RENDER_XML => 'xml';
20              
21             my %renderers = (
22             RENDER_NML, 'Spreadsheet::WriteExcel',
23             RENDER_BIG, 'Spreadsheet::WriteExcel::Big',
24             RENDER_XML, 'Spreadsheet::WriteExcelXML',
25             );
26              
27             sub new
28             {
29             my $class = shift;
30             my $self = $class->SUPER::new(@_);
31              
32             $self->{FILE} = $self->{FILENAME}
33             if !defined $self->{FILE} && defined $self->{FILENAME};
34              
35             $self->parse_xml($self->{FILE})
36             if defined $self->{FILE};
37              
38             my @renderer_classes = ( 'Spreadsheet::WriteExcel' );
39              
40             if (exists $self->{RENDERER} && $self->{RENDERER})
41             {
42             if (exists $renderers{ lc $self->{RENDERER} })
43             {
44             unshift @renderer_classes, $renderers{ lc $self->{RENDERER} };
45             }
46             elsif ($^W)
47             {
48             warn "'$self->{RENDERER}' is not recognized\n";
49             }
50             }
51             elsif (exists $self->{BIG_FILE} && $self->{BIG_FILE})
52             {
53             warn "Use of BIG_FILE is deprecated.\n";
54             unshift @renderer_classes, 'Spreadsheet::WriteExcel::Big';
55             }
56              
57             $self->{RENDERER} = undef;
58             foreach my $class (@renderer_classes)
59             {
60             (my $filename = $class) =~ s!::!/!g;
61             eval {
62             require "$filename.pm";
63             $class->import;
64             };
65             if ($@) {
66             warn "Could not find or compile '$class'\n" if $^W;
67             } else {
68             $self->{RENDERER} = $class;
69             last;
70             }
71             }
72              
73             defined $self->{RENDERER} ||
74             die "Could not find a renderer class. Tried:\n\t" .
75             join("\n\t", @renderer_classes) .
76             "\n";
77              
78             $self->{USE_UNICODE} = ~~0
79             if $] >= 5.008;
80              
81             return $self;
82             }
83              
84             sub param
85             {
86             my $self = shift;
87              
88             # Allow an arbitrary number of hashrefs, so long as they're the first things # into param(). Put each one onto the end, de-referenced.
89             push @_, %{shift @_} while ref $_[0] eq 'HASH';
90              
91             (@_ % 2)
92             && die __PACKAGE__, "->param() : Odd number of parameters to param()\n";
93              
94             my %params = @_;
95             $params{uc $_} = delete $params{$_} for keys %params;
96             @{$self->{PARAM_MAP}}{keys %params} = @params{keys %params};
97              
98             return ~~1;
99             }
100              
101             sub write_file
102             {
103             my $self = shift;
104             my ($filename) = @_;
105              
106             my $xls = $self->{RENDERER}->new($filename)
107             || die "Cannot create XLS in '$filename': $!\n";
108              
109             eval {
110             $self->_prepare_output($xls);
111             };
112             print $@ if $@;
113              
114             $xls->close;
115              
116             return if $@;
117              
118             return ~~1;
119             }
120              
121             sub output
122             {
123             my $self = shift;
124              
125             my $output;
126             tie *XLS, 'IO::Scalar', \$output;
127              
128             $self->write_file(\*XLS)
129             or return;
130              
131             return $output;
132             }
133              
134             sub parse_xml
135             {
136             my $self = shift;
137             my ($file) = @_;
138              
139             my @stack;
140             my @parms = (
141             Handlers => {
142             Start => sub {
143             shift;
144              
145             my $name = uc shift;
146              
147             my $node = Excel::Template::Factory->_create_node($name, @_);
148             die "'$name' (@_) didn't make a node!\n" unless defined $node;
149              
150             if ( $node->isa( 'WORKBOOK' ) )
151             {
152             $self->{WORKBOOK} = $node;
153             }
154             elsif ( $node->is_embedded )
155             {
156             return unless @stack;
157            
158             if (exists $stack[-1]{TXTOBJ} &&
159             $stack[-1]{TXTOBJ}->isa('TEXTOBJECT'))
160             {
161             push @{$stack[-1]{TXTOBJ}{STACK}}, $node;
162             }
163            
164             }
165             else
166             {
167             push @{$stack[-1]{ELEMENTS}}, $node
168             if @stack;
169             }
170             push @stack, $node;
171             },
172             Char => sub {
173             shift;
174             return unless @stack;
175              
176             my $parent = $stack[-1];
177              
178             if (
179             exists $parent->{TXTOBJ}
180             &&
181             $parent->{TXTOBJ}->isa('TEXTOBJECT')
182             ) {
183             push @{$parent->{TXTOBJ}{STACK}}, @_;
184             }
185             },
186             End => sub {
187             shift;
188             return unless @stack;
189              
190             pop @stack if $stack[-1]->isa(uc $_[0]);
191             },
192             },
193             );
194              
195             if ( ref $file )
196             {
197             *INFILE = $file;
198             }
199             else
200             {
201             my ($filename, $dirname) = fileparse($file);
202            
203             push @parms, Base => $dirname;
204              
205             eval q{
206             open( INFILE, '<', $file )
207             || die "Cannot open '$file' for reading: $!\n";
208             }; if ( $@ ) {
209             if ( $@ =~ /Too many arguments for open/ ) {
210             open( INFILE, "< $file" )
211             || die "Cannot open '$file' for reading: $!\n";
212             } else {
213             die $@;
214             }
215             }
216             }
217              
218             my $parser = XML::Parser->new( @parms );
219             $parser->parse(do { local $/ = undef; });
220              
221             close INFILE
222             unless ref $file;
223              
224             return ~~1;
225             }
226             *parse = *parse = \&parse_xml;
227              
228             sub _prepare_output
229             {
230             my $self = shift;
231             return unless $self->{WORKBOOK};
232              
233             my ($xls) = @_;
234              
235             my $context = Excel::Template::Factory->_create(
236             'CONTEXT',
237              
238             XLS => $xls,
239             PARAM_MAP => [ $self->{PARAM_MAP} ],
240             UNICODE => $self->{UNICODE},
241             );
242              
243             $self->{WORKBOOK}->render($context);
244              
245             return ~~1;
246             }
247              
248             sub register { shift; Excel::Template::Factory->register(@_) }
249              
250             1;
251             __END__