Commit | Line | Data |
d0eafc11 |
1 | package Excel::Template::Context; |
2 | |
3 | use strict; |
4 | |
5 | BEGIN { |
6 | use vars qw(@ISA); |
7 | @ISA = qw(Excel::Template::Base); |
8 | |
9 | use Excel::Template::Base; |
10 | } |
11 | |
12 | use Excel::Template::Format; |
13 | |
14 | # This is a helper object. It is not instantiated by the user, nor does it |
9ee3aea0 |
15 | # represent an XML node. Rather, every container will use this object to |
d0eafc11 |
16 | # maintain the context for its children. |
17 | |
8c63e224 |
18 | my %isAbsolute = map { $_ => ~~1 } qw( |
d0eafc11 |
19 | ROW |
20 | COL |
21 | ); |
22 | |
23 | sub new |
24 | { |
25 | my $class = shift; |
26 | my $self = $class->SUPER::new(@_); |
27 | |
28 | $self->{ACTIVE_WORKSHEET} = undef; |
9ee3aea0 |
29 | $self->{FORMAT_OBJECT} = Excel::Template::Format->new; |
30 | $self->{ACTIVE_FORMAT} = $self->{FORMAT_OBJECT}->blank_format($self); |
37513eae |
31 | $self->{WORKSHEET_NAMES} = undef; |
d0eafc11 |
32 | |
8fd01531 |
33 | $self->{__MARKS} = {}; |
34 | |
e976988f |
35 | # Removed NAME_MAP until I figure out what the heck it's for |
36 | for (qw( STACK PARAM_MAP )) |
c11fa570 |
37 | { |
d01e4722 |
38 | next if defined $self->{$_} && ref $self->{$_} eq 'ARRAY'; |
c11fa570 |
39 | $self->{$_} = []; |
40 | } |
d0eafc11 |
41 | |
42 | $self->{$_} = 0 for keys %isAbsolute; |
43 | |
44 | return $self; |
45 | } |
46 | |
8c63e224 |
47 | sub use_unicode { $_[0]->{UNICODE} && 1 } |
48 | |
d0eafc11 |
49 | sub _find_param_in_map |
50 | { |
51 | my $self = shift; |
52 | my ($map, $param, $depth) = @_; |
53 | $param = uc $param; |
54 | $depth ||= 0; |
55 | |
37513eae |
56 | my ($val, $found); |
d0eafc11 |
57 | for my $map (reverse @{$self->{$map}}) |
58 | { |
59 | next unless exists $map->{$param}; |
60 | $depth--, next if $depth; |
61 | |
8c63e224 |
62 | $found = ~~1; |
d0eafc11 |
63 | $val = $map->{$param}; |
64 | last; |
65 | } |
66 | |
67 | die "Parameter '$param' not found\n" |
68 | if !$found && $self->{DIE_ON_NO_PARAM}; |
69 | |
70 | return $val; |
71 | } |
72 | |
73 | sub param |
74 | { |
75 | my $self = shift; |
76 | $self->_find_param_in_map( |
77 | 'PARAM_MAP', |
78 | @_, |
79 | ); |
80 | } |
81 | |
e976988f |
82 | #sub named_param |
83 | #{ |
84 | # my $self = shift; |
85 | # $self->_find_param_in_map( |
86 | # 'NAME_MAP', |
87 | # @_, |
88 | # ); |
89 | #} |
d0eafc11 |
90 | |
91 | sub resolve |
92 | { |
93 | my $self = shift; |
94 | my ($obj, $key, $depth) = @_; |
95 | $key = uc $key; |
96 | $depth ||= 0; |
97 | |
98 | my $obj_val = $obj->{$key}; |
99 | |
100 | $obj_val = $self->param($1) |
101 | if $obj_val =~ /^\$(\S+)$/o; |
102 | |
103 | #GGG Remove this once NAME_MAP is working |
104 | # $obj_val = $self->named_param($1) |
105 | # if $obj_val =~ /^\\(\S+)$/o; |
106 | |
107 | #GGG Does this adequately test values to make sure they're legal?? |
108 | # A value is defined as: |
109 | # 1) An optional operator (+, -, *, or /) |
110 | # 2) A decimal number |
111 | |
112 | #GGG Convert this to use //x |
8fd01531 |
113 | my ($op, $val) = $obj_val =~ m/^\s*([\+\*\/\-])?\s*([\d.]*\d)\s*$/oi; |
d0eafc11 |
114 | |
115 | # Unless it's a relative value, we have what we came for. |
116 | return $obj_val unless $op; |
117 | |
118 | my $prev_val = $isAbsolute{$key} |
119 | ? $self->{$key} |
120 | : $self->get($obj, $key, $depth + 1); |
121 | |
122 | return $obj_val unless defined $prev_val; |
123 | return $prev_val unless defined $obj_val; |
124 | |
125 | # Prevent divide-by-zero issues. |
9ee3aea0 |
126 | return $prev_val if $op eq '/' and $val == 0; |
d0eafc11 |
127 | |
128 | my $new_val; |
129 | for ($op) |
130 | { |
131 | /^\+$/ && do { $new_val = ($prev_val + $val); last; }; |
132 | /^\-$/ && do { $new_val = ($prev_val - $val); last; }; |
133 | /^\*$/ && do { $new_val = ($prev_val * $val); last; }; |
134 | /^\/$/ && do { $new_val = ($prev_val / $val); last; }; |
135 | |
136 | die "Unknown operator '$op' in arithmetic resolve\n"; |
137 | } |
138 | |
139 | return $new_val if defined $new_val; |
140 | return; |
141 | } |
142 | |
143 | sub enter_scope |
144 | { |
145 | my $self = shift; |
146 | my ($obj) = @_; |
147 | |
148 | push @{$self->{STACK}}, $obj; |
149 | |
150 | for my $key (keys %isAbsolute) |
151 | { |
152 | next unless exists $obj->{$key}; |
153 | $self->{$key} = $self->resolve($obj, $key); |
154 | } |
155 | |
8c63e224 |
156 | return ~~1; |
d0eafc11 |
157 | } |
158 | |
159 | sub exit_scope |
160 | { |
161 | my $self = shift; |
162 | my ($obj, $no_delta) = @_; |
163 | |
164 | unless ($no_delta) |
165 | { |
166 | my $deltas = $obj->deltas($self); |
167 | $self->{$_} += $deltas->{$_} for keys %$deltas; |
168 | } |
169 | |
170 | pop @{$self->{STACK}}; |
171 | |
8c63e224 |
172 | return ~~1; |
d0eafc11 |
173 | } |
174 | |
175 | sub get |
176 | { |
177 | my $self = shift; |
178 | my ($dummy, $key, $depth) = @_; |
179 | $depth ||= 0; |
180 | $key = uc $key; |
181 | |
182 | return unless @{$self->{STACK}}; |
183 | |
184 | my $obj = $self->{STACK}[-1]; |
185 | |
186 | return $self->{$key} if $isAbsolute{$key}; |
187 | |
188 | my $val = undef; |
189 | my $this_depth = $depth; |
190 | foreach my $e (reverse @{$self->{STACK}}) |
191 | { |
192 | next unless exists $e->{$key}; |
193 | next if $this_depth-- > 0; |
194 | |
195 | $val = $self->resolve($e, $key, $depth); |
196 | last; |
197 | } |
198 | |
199 | $val = $self->{$key} unless defined $val; |
200 | return $val unless defined $val; |
201 | |
202 | return $self->param($1, $depth) if $val =~ /^\$(\S+)$/o; |
203 | |
204 | return $val; |
205 | } |
206 | |
207 | sub active_format |
208 | { |
209 | my $self = shift; |
210 | |
211 | $self->{ACTIVE_FORMAT} = $_[0] |
212 | if @_; |
213 | |
214 | $self->{ACTIVE_FORMAT}; |
215 | } |
216 | |
217 | sub new_worksheet |
218 | { |
219 | my $self = shift; |
37513eae |
220 | my ($worksheet) = @_; |
d0eafc11 |
221 | |
222 | $self->{ROW} = $self->{COL} = 0; |
37513eae |
223 | $self->{REFERENCES} = {}; |
224 | |
225 | my $name = $self->get( $worksheet, 'NAME' ); |
226 | |
227 | if ( defined $name && length $name ) |
228 | { |
229 | if ( exists $self->{WORKSHEET_NAMES}{$name} ) |
230 | { |
231 | $name = ''; |
232 | } |
233 | else |
234 | { |
235 | $self->{WORKSHEET_NAMES}{$name} = undef; |
236 | } |
237 | } |
238 | else |
239 | { |
240 | $name = ''; |
241 | } |
d0eafc11 |
242 | |
8fd01531 |
243 | return $self->active_worksheet( |
37513eae |
244 | $self->{XLS}->add_worksheet( $name ), |
d0eafc11 |
245 | ); |
246 | } |
247 | |
8fd01531 |
248 | sub mark |
249 | { |
250 | my $self = shift; |
251 | |
252 | if ( @_ > 1 ) |
253 | { |
254 | my %args = @_; |
255 | |
256 | @{$self->{__MARKS}}{keys %args} = values %args; |
257 | } |
258 | |
259 | return $self->{__MARKS}{$_[0]} |
260 | } |
261 | |
d0eafc11 |
262 | sub active_worksheet |
263 | { |
264 | my $self = shift; |
265 | |
266 | $self->{ACTIVE_WORKSHEET} = $_[0] |
267 | if @_; |
268 | |
269 | $self->{ACTIVE_WORKSHEET}; |
270 | } |
271 | |
37513eae |
272 | sub add_reference |
273 | { |
274 | my $self = shift; |
275 | my ($ref, $row, $col) = @_; |
276 | |
277 | $self->{REFERENCES}{$ref} ||= []; |
278 | |
279 | push @{$self->{REFERENCES}{$ref}}, [ $row, $col ]; |
280 | |
8c63e224 |
281 | return ~~1; |
37513eae |
282 | } |
283 | |
284 | sub get_all_references |
285 | { |
286 | my $self = shift; |
287 | my $ref = uc shift; |
288 | |
289 | $self->{REFERENCES}{$ref} ||= []; |
290 | |
291 | return @{ $self->{REFERENCES}{$ref} }; |
292 | } |
293 | |
294 | sub get_last_reference |
295 | { |
296 | my $self = shift; |
297 | my $ref = uc shift; |
298 | |
299 | $self->{REFERENCES}{$ref} ||= []; |
300 | |
301 | return @{ $self->{REFERENCES}{$ref}[-1] }; |
302 | } |
303 | |
9ee3aea0 |
304 | sub format_object { $_[0]{FORMAT_OBJECT} } |
305 | |
d0eafc11 |
306 | 1; |
307 | __END__ |
308 | |
309 | =head1 NAME |
310 | |
311 | Excel::Template::Context |
312 | |
313 | =head1 PURPOSE |
314 | |
c11fa570 |
315 | This is a helper node that provides the global context for the nodes do their processing within. It provides attribute scoping, parameter resolution, and other very nice things. |
316 | |
317 | Documentation is provided for if you wish to subclass another node. |
318 | |
d0eafc11 |
319 | =head1 NODE NAME |
320 | |
c11fa570 |
321 | None |
322 | |
d0eafc11 |
323 | =head1 INHERITANCE |
324 | |
c11fa570 |
325 | None |
326 | |
d0eafc11 |
327 | =head1 ATTRIBUTES |
328 | |
c11fa570 |
329 | None |
330 | |
d0eafc11 |
331 | =head1 CHILDREN |
332 | |
c11fa570 |
333 | None |
334 | |
d0eafc11 |
335 | =head1 AFFECTS |
336 | |
c11fa570 |
337 | Everything |
338 | |
d0eafc11 |
339 | =head1 DEPENDENCIES |
340 | |
c11fa570 |
341 | None |
342 | |
343 | =head1 METHODS |
344 | |
345 | =head2 active_format |
346 | |
347 | =head2 active_worksheet |
348 | |
349 | =head2 add_reference |
350 | |
9ee3aea0 |
351 | =head2 format_object |
352 | |
c11fa570 |
353 | =head2 get |
354 | |
355 | =head2 get_all_references |
356 | |
357 | =head2 get_last_reference |
358 | |
8fd01531 |
359 | =head2 mark |
c11fa570 |
360 | |
361 | =head2 new_worksheet |
362 | |
363 | =head2 param |
364 | |
365 | =head2 use_unicode |
d0eafc11 |
366 | |
367 | =head1 AUTHOR |
368 | |
c09684ff |
369 | Rob Kinyon (rob.kinyon@gmail.com) |
d0eafc11 |
370 | |
371 | =head1 SEE ALSO |
372 | |
373 | =cut |