package Template::Liquid::Context;
{ $Template::Liquid::Context::VERSION = 'v1.0.0' }
require Template::Liquid::Utility;
require Template::Liquid::Error;

sub new {
    my ($class, $template, %assigns) = @_;
    return bless {scopes   => [\%assigns],
                  template => $template,     # Required
                  errors   => []
    }, $class;
}

sub push {
    my ($s, $context) = @_;
    return
        raise Template::Liquid::Error {type    => 'Stack',
                                       message => 'Cannot push new scope!'
        }
        if scalar @{$s->{'scopes'}} == 100;
    return push @{$s->{'scopes'}}, (defined $context ? $context : {});
}

sub pop {
    my ($s) = @_;
    return
        raise Template::Liquid::Error {type    => 'Stack',
                                       message => 'Cannot pop scope!'
        }
        if scalar @{$s->{'scopes'}} == 1;
    return pop @{$s->{'scopes'}};
}

sub stack {
    my ($s, $block) = @_;
    my $old_scope = $s->{scopes}[-1];
    $s->push();
    $s->merge($old_scope);
    my $result = $block->($s);
    $s->pop;
    return $result;
}

sub merge {
    my ($s, $new) = @_;
    return $s->{'scopes'}->[0] = __merge(reverse $s->{scopes}[-1], $new);
}

sub _merge {    # Deeply merges data structures
    my ($source, $target) = @_;
    my $return = $target;
    for (keys %$source) {
        if ('ARRAY' eq ref $target->{$_}
            && ('ARRAY' eq ref $source->{$_}
                || !ref $source->{$_})
            )
        {   @{$return->{$_}} = [@{$target->{$_}}, @{$source->{$_}}];
        }
        elsif ('HASH' eq ref $target->{$_}
               && ('HASH' eq ref $source->{$_}
                   || !ref $source->{$_})
            )
        {   $return->{$_} = _merge($source->{$_}, $target->{$_});
        }
        else { $return->{$_} = $source->{$_}; }
    }
    return $return;
}
my $merge_precedent;

sub __merge {    # unless right is more interesting, this is a left-
    my $return = $_[1];    # precedent merge function
    $merge_precedent ||= {
        SCALAR => {SCALAR => sub { defined $_[0] ? $_[0] : $_[1] },
                   ARRAY  => sub { $_[1] },
                   HASH   => sub { $_[1] },
        },
        ARRAY => {
            SCALAR => sub {
                [@{$_[0]}, defined $_[1] ? $_[1] : ()];
            },
            ARRAY => sub { [@{$_[0]}] },
            HASH  => sub { [@{$_[0]}, values %{$_[1]}] },
        },
        HASH => {SCALAR => sub { $_[0] },
                 ARRAY  => sub { $_[0] },
                 HASH   => sub { _merge($_[0], $_[1], $_[2]) },
        }
    };
    for my $key (keys %{$_[0]}) {
        my ($left_ref, $right_ref)
            = map { ref($_->{$key}) =~ m[^(HASH|ARRAY)$]o ? $1 : 'SCALAR' }
            ($_[0], $_[1]);

        #warn sprintf '%-12s [%6s|%-6s]', $key, $left_ref, $right_ref;
        $return->{$key} = $merge_precedent->{$left_ref}{$right_ref}
            ->($_[0]->{$key}, $_[1]->{$key});
    }
    return $return;
}

sub resolve {
    my ($s, $path, $val) = @_;
    return if !defined $path;
    return if $path eq '';
    return if $path eq 'null';
    return if $path eq 'nil';
    return if $path eq 'blank';
    return if $path eq 'empty';
    return !1  if $path eq 'false';
    return !!1 if $path eq 'true';
    return $2 if $path =~ m[^(['"])(.+)\1$];
    return [int $s->resolve($1) .. int $s->resolve($2)]
        if $path =~ m[^\((\S+)\.\.(\S+)\)$]o;    # range
    return $1 if $path =~ m[^(\d+(?:[\d\.]+)?)$]o;    # int or bad float
    return $s->resolve($1)->[$2] if $path =~ m'^(.+)\[(.+)\]$'o;
    my @path = split $Template::Liquid::Utility::VariableAttributeSeparator,
        $path;
    my $cursor = \$s->{scopes}[-1];

    while (local $_ = shift @path) {
        my $type = ref $$cursor;
        if ($type eq 'ARRAY') {
            if (scalar @path == 1) {
                return scalar @{$$cursor}    if $path->[0] eq 'size';
                return scalar $$cursor->[0]  if $path->[0] eq 'first';
                return scalar $$cursor->[-1] if $path->[0] eq 'last';
            }
            return unless /^(?:0|[0-9]\d*)\z/o;
            if (scalar @path) { $cursor = \$$cursor->[$_]; next; }
            return defined $val ?
                $$cursor->[$_]
                = $val
                : $$cursor->[$_];
        }
        if (@path && $type) { $cursor = \$$cursor->{$_}; next; }

        #warn $$cursor->{$_} if ref  $$cursor->{$_};
        return defined $val ?
            $$cursor->{$_}
            = $val
            : $type ?
            $type eq 'HASH' ?
            $$cursor->{$_}
            : $type eq 'ARRAY' ?
                $$cursor->[$_]
            : $$cursor->can($_) ?
                $$cursor->$_()
            : do { warn 'Cannot call ' . $_; () }
            : defined $$cursor ?
            $$cursor    # die $path . ' is not a hash/array reference'
            : '';
        return $$cursor->{$_};
    }
}
1;

=cut

=head1 NAME

Template::Liquid::Context - Complex Variable Keeper

=head1 Description

This is really only to be used internally.

=head1 Author

Sanko Robinson <sanko@cpan.org> - http://sankorobinson.com/

CPAN ID: SANKO

=head1 License and Legal

Copyright (C) 2009-2012 by Sanko Robinson E<lt>sanko@cpan.orgE<gt>

This program is free software; you can redistribute it and/or modify it under
the terms of
L<The Artistic License 2.0|http://www.perlfoundation.org/artistic_license_2_0>.
See the F<LICENSE> file included with this distribution or
L<notes on the Artistic License 2.0|http://www.perlfoundation.org/artistic_2_0_notes>
for clarification.

When separated from the distribution, all original POD documentation is
covered by the
L<Creative Commons Attribution-Share Alike 3.0 License|http://creativecommons.org/licenses/by-sa/3.0/us/legalcode>.
See the
L<clarification of the CCA-SA3.0|http://creativecommons.org/licenses/by-sa/3.0/us/>.

=cut