Added more tests for conditionals. Need to fix linking in POD. - Intermediate commit!

[p5sagit/Excel-Template.git] / lib / Excel / Template / Context.pm

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 object. 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->{ACTIVE_FORMAT}    = Excel::Template::Format->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 $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] };
}

1;
__END__

=head1 NAME

Excel::Template::Context

=head1 PURPOSE

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.

Documentation is provided for if you wish to subclass another node.

=head1 NODE NAME

None

=head1 INHERITANCE

None

=head1 ATTRIBUTES

None

=head1 CHILDREN

None

=head1 AFFECTS

Everything

=head1 DEPENDENCIES

None

=head1 METHODS

=head2 active_format

=head2 active_worksheet

=head2 add_reference

=head2 get

=head2 get_all_references

=head2 get_last_reference

=head2 mark

=head2 new_worksheet

=head2 param

=head2 use_unicode

=head1 AUTHOR

Rob Kinyon (rob.kinyon@gmail.com)

=head1 SEE ALSO

=cut