Excel::Template::Context - Excel::Template::Context documentation

package Excel::Template::Context;

use strict;

BEGIN {
    use vars qw(@ISA);
    @ISA = qw(Excel::Template::Base);

    use Excel::Template::Base;
}

use Excel::Template::Format;

# This is a helper object. It is not instantiated by the user, nor does it
# represent an XML node. Rather, every container will use this object to
# maintain the context for its children.

my %isAbsolute = map { $_ => ~~1 } qw(
    ROW
    COL
);

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    $self->{ACTIVE_WORKSHEET} = undef;
    $self->{FORMAT_OBJECT}    = Excel::Template::Format->new;
    $self->{ACTIVE_FORMAT}    = $self->{FORMAT_OBJECT}->blank_format($self);
    $self->{WORKSHEET_NAMES}  = undef;

    $self->{__MARKS} = {};

    # Removed NAME_MAP until I figure out what the heck it's for
    for (qw( STACK PARAM_MAP ))
    {
        next if defined $self->{$_} && ref $self->{$_} eq 'ARRAY';
        $self->{$_} = [];
    }

    $self->{$_} = 0 for keys %isAbsolute;

    return $self;
}

sub use_unicode { $_[0]->{UNICODE} && 1 }

sub _find_param_in_map
{
    my $self = shift;
    my ($map, $param, $depth) = @_;
    $param = uc $param;
    $depth ||= 0;

    my ($val, $found);
    for my $map (reverse @{$self->{$map}})
    {
        next unless exists $map->{$param};
        $depth--, next if $depth;

        $found = ~~1;
        $val = $map->{$param};
        last;
    }

    die "Parameter '$param' not found\n"
        if !$found && $self->{DIE_ON_NO_PARAM};

    return $val;
}

sub param
{
    my $self = shift;
    $self->_find_param_in_map(
        'PARAM_MAP',
        @_,
    );
}

#sub named_param
#{
#    my $self = shift;
#    $self->_find_param_in_map(
#        'NAME_MAP',
#        @_,
#    );
#}

sub resolve
{
    my $self = shift;
    my ($obj, $key, $depth) = @_;
    $key = uc $key;
    $depth ||= 0;

    my $obj_val = $obj->{$key};

    $obj_val = $self->param($1)
        if $obj_val =~ /^\$(\S+)$/o;

#GGG Remove this once NAME_MAP is working
#    $obj_val = $self->named_param($1)
#        if $obj_val =~ /^\\(\S+)$/o;

#GGG Does this adequately test values to make sure they're legal??
    # A value is defined as:
    #    1) An optional operator (+, -, *, or /)
    #    2) A decimal number

#GGG Convert this to use //x
    my ($op, $val) = $obj_val =~ m/^\s*([\+\*\/\-])?\s*([\d.]*\d)\s*$/oi;

    # Unless it's a relative value, we have what we came for.
    return $obj_val unless $op;

    my $prev_val = $isAbsolute{$key}
        ? $self->{$key}
        : $self->get($obj, $key, $depth + 1);

    return $obj_val unless defined $prev_val;
    return $prev_val unless defined $obj_val;

    # Prevent divide-by-zero issues.
    return $prev_val if $op eq '/' and $val == 0;

    my $new_val;
    for ($op)
    {
        /^\+$/ && do { $new_val = ($prev_val + $val); last; };
        /^\-$/ && do { $new_val = ($prev_val - $val); last; };
        /^\*$/ && do { $new_val = ($prev_val * $val); last; };
        /^\/$/ && do { $new_val = ($prev_val / $val); last; };

        die "Unknown operator '$op' in arithmetic resolve\n";
    }

    return $new_val if defined $new_val;
    return;
}

sub enter_scope
{
    my $self = shift;
    my ($obj) = @_;

    push @{$self->{STACK}}, $obj;

    for my $key (keys %isAbsolute)
    {
        next unless exists $obj->{$key};
        $self->{$key} = $self->resolve($obj, $key);
    }

    return ~~1;
}

sub exit_scope
{
    my $self = shift;
    my ($obj, $no_delta) = @_;

    unless ($no_delta)
    {
        my $deltas = $obj->deltas($self);
        $self->{$_} += $deltas->{$_} for keys %$deltas;
    }

    pop @{$self->{STACK}};

    return ~~1;
}

sub get
{
    my $self = shift;
    my ($dummy, $key, $depth) = @_;
    $depth ||= 0;
    $key = uc $key;

    return unless @{$self->{STACK}};

    my $obj = $self->{STACK}[-1];

    return $self->{$key} if $isAbsolute{$key};

    my $val = undef;
    my $this_depth = $depth;
    foreach my $e (reverse @{$self->{STACK}})
    {
        next unless exists $e->{$key};
        next if $this_depth-- > 0;

        $val = $self->resolve($e, $key, $depth);
        last;
    }

    $val = $self->{$key} unless defined $val;
    return $val unless defined $val;

    return $self->param($1, $depth) if $val =~ /^\$(\S+)$/o;

    return $val;
}

sub active_format
{
    my $self = shift;
    
    $self->{ACTIVE_FORMAT} = $_[0]
        if @_;

    $self->{ACTIVE_FORMAT};
}

sub new_worksheet
{
    my $self = shift;
    my ($worksheet) = @_;

    $self->{ROW} = $self->{COL} = 0;
    $self->{REFERENCES} = {};

    my $name = $self->get( $worksheet, 'NAME' );

    if ( defined $name && length $name )
    {
        if ( exists $self->{WORKSHEET_NAMES}{$name} )
        {
            $name = '';
        }
        else
        {
            $self->{WORKSHEET_NAMES}{$name} = undef;
        }
    }
    else
    {
        $name = '';
    }

    return $self->active_worksheet(
        $self->{XLS}->add_worksheet( $name ),
    );
}

sub mark
{
    my $self = shift;

    if ( @_ > 1 )
    {
        my %args = @_;

        @{$self->{__MARKS}}{keys %args} = values %args;
    }

    return $self->{__MARKS}{$_[0]}
}

sub active_worksheet
{
    my $self = shift;
    
    $self->{ACTIVE_WORKSHEET} = $_[0]
        if @_;

    $self->{ACTIVE_WORKSHEET};
}

sub add_reference
{
    my $self = shift;
    my ($ref, $row, $col) = @_;

    $self->{REFERENCES}{$ref} ||= [];

    push @{$self->{REFERENCES}{$ref}}, [ $row, $col ];

    return ~~1;
}

sub get_all_references
{
    my $self = shift;
    my $ref = uc shift;

    $self->{REFERENCES}{$ref} ||= [];

    return @{ $self->{REFERENCES}{$ref} };
}

sub get_last_reference
{
    my $self = shift;
    my $ref = uc shift;

    $self->{REFERENCES}{$ref} ||= [];

    return @{ $self->{REFERENCES}{$ref}[-1] };
}

sub format_object { $_[0]{FORMAT_OBJECT} }

1;
__END__