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