lib/Excel/Template/Context.pm

   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
 258 Rob Kinyon (rkinyon@columbus.rr.com)
 259
 260 =head1 SEE ALSO
 261
 262 =cut