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 |
15 | # represent an XML object. Rather, every container will use this object to |
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; |
29 | $self->{ACTIVE_FORMAT} = Excel::Template::Format->blank_format($self); |
37513eae |
30 | $self->{WORKSHEET_NAMES} = undef; |
d0eafc11 |
31 | |
32 | UNIVERSAL::isa($self->{$_}, 'ARRAY') || ($self->{$_} = []) |
33 | for qw( STACK PARAM_MAP NAME_MAP ); |
34 | |
35 | $self->{$_} = 0 for keys %isAbsolute; |
36 | |
37 | return $self; |
38 | } |
39 | |
8c63e224 |
40 | sub use_unicode { $_[0]->{UNICODE} && 1 } |
41 | |
d0eafc11 |
42 | sub _find_param_in_map |
43 | { |
44 | my $self = shift; |
45 | my ($map, $param, $depth) = @_; |
46 | $param = uc $param; |
47 | $depth ||= 0; |
48 | |
37513eae |
49 | my ($val, $found); |
d0eafc11 |
50 | for my $map (reverse @{$self->{$map}}) |
51 | { |
52 | next unless exists $map->{$param}; |
53 | $depth--, next if $depth; |
54 | |
8c63e224 |
55 | $found = ~~1; |
d0eafc11 |
56 | $val = $map->{$param}; |
57 | last; |
58 | } |
59 | |
60 | die "Parameter '$param' not found\n" |
61 | if !$found && $self->{DIE_ON_NO_PARAM}; |
62 | |
63 | return $val; |
64 | } |
65 | |
66 | sub param |
67 | { |
68 | my $self = shift; |
69 | $self->_find_param_in_map( |
70 | 'PARAM_MAP', |
71 | @_, |
72 | ); |
73 | } |
74 | |
75 | sub named_param |
76 | { |
77 | my $self = shift; |
78 | $self->_find_param_in_map( |
79 | 'NAME_MAP', |
80 | @_, |
81 | ); |
82 | } |
83 | |
84 | sub resolve |
85 | { |
86 | my $self = shift; |
87 | my ($obj, $key, $depth) = @_; |
88 | $key = uc $key; |
89 | $depth ||= 0; |
90 | |
91 | my $obj_val = $obj->{$key}; |
92 | |
93 | $obj_val = $self->param($1) |
94 | if $obj_val =~ /^\$(\S+)$/o; |
95 | |
96 | #GGG Remove this once NAME_MAP is working |
97 | # $obj_val = $self->named_param($1) |
98 | # if $obj_val =~ /^\\(\S+)$/o; |
99 | |
100 | #GGG Does this adequately test values to make sure they're legal?? |
101 | # A value is defined as: |
102 | # 1) An optional operator (+, -, *, or /) |
103 | # 2) A decimal number |
104 | |
105 | #GGG Convert this to use //x |
106 | my ($op, $val) = $obj_val =~ m!^\s*([\+\*\/\-])?\s*([\d.]*\d)\s*$!oi; |
107 | |
108 | # Unless it's a relative value, we have what we came for. |
109 | return $obj_val unless $op; |
110 | |
111 | my $prev_val = $isAbsolute{$key} |
112 | ? $self->{$key} |
113 | : $self->get($obj, $key, $depth + 1); |
114 | |
115 | return $obj_val unless defined $prev_val; |
116 | return $prev_val unless defined $obj_val; |
117 | |
118 | # Prevent divide-by-zero issues. |
119 | return $val if $op eq '/' and $val == 0; |
120 | |
121 | my $new_val; |
122 | for ($op) |
123 | { |
124 | /^\+$/ && do { $new_val = ($prev_val + $val); last; }; |
125 | /^\-$/ && do { $new_val = ($prev_val - $val); last; }; |
126 | /^\*$/ && do { $new_val = ($prev_val * $val); last; }; |
127 | /^\/$/ && do { $new_val = ($prev_val / $val); last; }; |
128 | |
129 | die "Unknown operator '$op' in arithmetic resolve\n"; |
130 | } |
131 | |
132 | return $new_val if defined $new_val; |
133 | return; |
134 | } |
135 | |
136 | sub enter_scope |
137 | { |
138 | my $self = shift; |
139 | my ($obj) = @_; |
140 | |
141 | push @{$self->{STACK}}, $obj; |
142 | |
143 | for my $key (keys %isAbsolute) |
144 | { |
145 | next unless exists $obj->{$key}; |
146 | $self->{$key} = $self->resolve($obj, $key); |
147 | } |
148 | |
8c63e224 |
149 | return ~~1; |
d0eafc11 |
150 | } |
151 | |
152 | sub exit_scope |
153 | { |
154 | my $self = shift; |
155 | my ($obj, $no_delta) = @_; |
156 | |
157 | unless ($no_delta) |
158 | { |
159 | my $deltas = $obj->deltas($self); |
160 | $self->{$_} += $deltas->{$_} for keys %$deltas; |
161 | } |
162 | |
163 | pop @{$self->{STACK}}; |
164 | |
8c63e224 |
165 | return ~~1; |
d0eafc11 |
166 | } |
167 | |
168 | sub get |
169 | { |
170 | my $self = shift; |
171 | my ($dummy, $key, $depth) = @_; |
172 | $depth ||= 0; |
173 | $key = uc $key; |
174 | |
175 | return unless @{$self->{STACK}}; |
176 | |
177 | my $obj = $self->{STACK}[-1]; |
178 | |
179 | return $self->{$key} if $isAbsolute{$key}; |
180 | |
181 | my $val = undef; |
182 | my $this_depth = $depth; |
183 | foreach my $e (reverse @{$self->{STACK}}) |
184 | { |
185 | next unless exists $e->{$key}; |
186 | next if $this_depth-- > 0; |
187 | |
188 | $val = $self->resolve($e, $key, $depth); |
189 | last; |
190 | } |
191 | |
192 | $val = $self->{$key} unless defined $val; |
193 | return $val unless defined $val; |
194 | |
195 | return $self->param($1, $depth) if $val =~ /^\$(\S+)$/o; |
196 | |
197 | return $val; |
198 | } |
199 | |
200 | sub active_format |
201 | { |
202 | my $self = shift; |
203 | |
204 | $self->{ACTIVE_FORMAT} = $_[0] |
205 | if @_; |
206 | |
207 | $self->{ACTIVE_FORMAT}; |
208 | } |
209 | |
210 | sub new_worksheet |
211 | { |
212 | my $self = shift; |
37513eae |
213 | my ($worksheet) = @_; |
d0eafc11 |
214 | |
215 | $self->{ROW} = $self->{COL} = 0; |
37513eae |
216 | $self->{REFERENCES} = {}; |
217 | |
218 | my $name = $self->get( $worksheet, 'NAME' ); |
219 | |
220 | if ( defined $name && length $name ) |
221 | { |
222 | if ( exists $self->{WORKSHEET_NAMES}{$name} ) |
223 | { |
224 | $name = ''; |
225 | } |
226 | else |
227 | { |
228 | $self->{WORKSHEET_NAMES}{$name} = undef; |
229 | } |
230 | } |
231 | else |
232 | { |
233 | $name = ''; |
234 | } |
d0eafc11 |
235 | |
236 | $self->active_worksheet( |
37513eae |
237 | $self->{XLS}->add_worksheet( $name ), |
d0eafc11 |
238 | ); |
239 | } |
240 | |
241 | sub active_worksheet |
242 | { |
243 | my $self = shift; |
244 | |
245 | $self->{ACTIVE_WORKSHEET} = $_[0] |
246 | if @_; |
247 | |
248 | $self->{ACTIVE_WORKSHEET}; |
249 | } |
250 | |
37513eae |
251 | sub add_reference |
252 | { |
253 | my $self = shift; |
254 | my ($ref, $row, $col) = @_; |
255 | |
256 | $self->{REFERENCES}{$ref} ||= []; |
257 | |
258 | push @{$self->{REFERENCES}{$ref}}, [ $row, $col ]; |
259 | |
8c63e224 |
260 | return ~~1; |
37513eae |
261 | } |
262 | |
263 | sub get_all_references |
264 | { |
265 | my $self = shift; |
266 | my $ref = uc shift; |
267 | |
268 | $self->{REFERENCES}{$ref} ||= []; |
269 | |
270 | return @{ $self->{REFERENCES}{$ref} }; |
271 | } |
272 | |
273 | sub get_last_reference |
274 | { |
275 | my $self = shift; |
276 | my $ref = uc shift; |
277 | |
278 | $self->{REFERENCES}{$ref} ||= []; |
279 | |
280 | return @{ $self->{REFERENCES}{$ref}[-1] }; |
281 | } |
282 | |
d0eafc11 |
283 | 1; |
284 | __END__ |
285 | |
286 | =head1 NAME |
287 | |
288 | Excel::Template::Context |
289 | |
290 | =head1 PURPOSE |
291 | |
292 | =head1 NODE NAME |
293 | |
294 | =head1 INHERITANCE |
295 | |
296 | =head1 ATTRIBUTES |
297 | |
298 | =head1 CHILDREN |
299 | |
300 | =head1 AFFECTS |
301 | |
302 | =head1 DEPENDENCIES |
303 | |
304 | =head1 USAGE |
305 | |
306 | =head1 AUTHOR |
307 | |
c09684ff |
308 | Rob Kinyon (rob.kinyon@gmail.com) |
d0eafc11 |
309 | |
310 | =head1 SEE ALSO |
311 | |
312 | =cut |