package Text::Xslate::PP::State; # implement tx_state_t
use Any::Moose;

use Text::Xslate::Util qw(neat p $DEBUG);
use Text::Xslate::PP;
use Text::Xslate::PP::Const qw(
    TXframe_NAME TXframe_RETADDR TXframe_OUTPUT
    TX_VERBOSE_DEFAULT);

if(!Text::Xslate::PP::_PP_ERROR_VERBOSE()) {
    our @CARP_NOT = qw(
        Text::Xslate::PP::Opcode
        Text::Xslate::PP::Booter
        Text::Xslate::PP::Method
    );
}

has vars => (
    is => 'rw',
);

has tmpl => (
    is => 'rw',
);

has engine => (
    is => 'rw',
    weak_ref => 1,
);

has frame => (
    is => 'rw',
);

has current_frame => (
    is => 'rw',
);

# opinfo is integrated into code
#has info => (
#    is => 'rw',
#);

has code => (
    is  => 'rw',
);

has code_len => (
    is => 'rw',
);

has symbol => (
    is => 'rw',
);

has local_stack => (
    is => 'rw',
);

has encoding => (
    is       => 'ro',
    init_arg => undef,
    lazy     => 1,
    default  => sub {
        require Encode;
        return Encode::find_encoding('UTF-8');
    },
);

sub fetch {
    # my ( $st, $var, $key, $frame, $line ) = @_;
    my $ret;

    if ( Scalar::Util::blessed($_[1]) ) {
        my $key = $_[2];
        $ret = eval { $_[1]->$key() };
        $_[0]->error( [ $_[3], $_[4] ], "%s", $@ ) if $@;
    }
    elsif ( ref $_[1] eq 'HASH' ) {
        if ( defined $_[2] ) {
            $ret = $_[1]->{ $_[2] };
        }
        else {
            $_[0]->warn( [ $_[3], $_[4] ], "Use of nil as a field key" );
        }
    }
    elsif ( ref $_[1] eq 'ARRAY' ) {
        if ( Scalar::Util::looks_like_number($_[2]) ) {
            $ret = $_[1]->[ $_[2] ];
        }
        else {
            $_[0]->warn( [ $_[3], $_[4] ], "Use of %s as an array index", neat( $_[2] ) );
        }
    }
    elsif ( $_[1] ) {
        $_[0]->error( [ $_[3], $_[4] ], "Cannot access %s (%s is not a container)", neat($_[2]), neat($_[1]) );
    }
    else {
        $_[0]->warn( [ $_[3], $_[4] ], "Use of nil to access %s", neat( $_[2] ) );
    }

    return $ret;
}

sub fetch_symbol {
    my ( $st, $name, $context ) = @_;

    my $symbol_table = $st->symbol;
    if ( !exists $symbol_table->{ $name } ) {
        if(defined $context) {
            my($frame, $line) = @{$context};
            if ( defined $line ) {
                $st->{ pc } = $line;
                $st->frame->[ $st->current_frame ]->[ TXframe_NAME ] = $frame;
            }
        }
        Carp::croak( sprintf( "Undefined symbol %s", $name ) );
    }

    return $symbol_table->{ $name };
}

sub localize {
    my($st, $key, $newval) = @_;
    my $vars       = $st->vars;
    my $preeminent = exists $vars->{$key};
    my $oldval     = delete $vars->{$key};

    my $cleanup = $preeminent
        ? sub { $vars->{$key} = $oldval; return }
        : sub { delete $vars->{$key};    return };

    push @{ $st->{local_stack} ||= [] },
        bless($cleanup, 'Text::Xslate::PP::Guard');

    $vars->{$key} = $newval;
    return;
}

sub push_frame {
    my ( $st, $name, $retaddr ) = @_;

    if ( $st->current_frame > 100 ) {
        Carp::croak("Macro call is too deep (> 100)");
    }

    my $new = $st->frame->[ $st->current_frame( $st->current_frame + 1 ) ]
        ||= [];
    $new->[ TXframe_NAME ]    = $name;
    $new->[ TXframe_RETADDR ] = $retaddr;
    return $new;
}

sub pop_frame {
    my( $st, $replace_output ) = @_;
    $st->current_frame( $st->current_frame - 1 );
    if($replace_output) {
        my $top = $st->frame->[ $st->current_frame + 1];
        ($st->{output}, $top->[ TXframe_OUTPUT ])
            = ($top->[ TXframe_OUTPUT ], $st->{output});
    }

    return;
}

sub pad {
    return $_[0]->{frame}->[ $_[0]->{current_frame} ];
}

sub op_arg {
    $_[0]->{ code }->[ $_[0]->{ pc } ]->{ arg };
}

sub print {
    my($st, $sv, $frame_and_line) = @_;
    if ( ref( $sv ) eq Text::Xslate::PP::TXt_RAW ) {
        if(defined ${$sv}) {
            $st->{output} .=
                (utf8::is_utf8($st->{output}) && !utf8::is_utf8(${$sv}))
                 ? $st->encoding->decode(${$sv})
                 : ${$sv};
        }
        else {
            $st->warn($frame_and_line, "Use of nil to print" );
        }
    }
    elsif ( defined $sv ) {
        $sv =~ s/($Text::Xslate::PP::html_metachars)/$Text::Xslate::PP::html_escape{$1}/xmsgeo;
        $st->{output} .=
            (utf8::is_utf8($st->{output}) && !utf8::is_utf8($sv))
             ? $st->encoding->decode($sv)
             : $sv;
    }
    else {
        $st->warn( $frame_and_line, "Use of nil to print" );
    }
    return;
}

sub _doerror {
    my ( $st, $context, $fmt, @args ) = @_;
    if(defined $context) { # hack to share it with PP::Booster and PP::Opcode
        my($frame, $line) = @{$context};
        if ( defined $line ) {
            $st->{ pc } = $line;
            $st->frame->[ $st->current_frame ]->[ TXframe_NAME ] = $frame;
        }
    }
    Carp::carp( sprintf( $fmt, @args ) );
    return;
}

sub warn :method {
    my $st = shift;
    if( $st->engine->{verbose} > TX_VERBOSE_DEFAULT ) {
        $st->_doerror(@_);
    }
    return;
}


sub error :method {
    my $st = shift;
    if( $st->engine->{verbose} >= TX_VERBOSE_DEFAULT ) {
        $st->_doerror(@_);
    }
    return;
}

sub bad_arg {
    my $st = shift;
    unshift @_, undef if @_ == 1; # hack to share it with PP::Booster and PP::Opcode
    my($context, $name) = @_;
    return $st->error($context, "Wrong number of arguments for %s", $name);
}

no Any::Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__


=head1 NAME

Text::Xslate::PP::State - Text::Xslate pure-Perl virtual machine state

=head1 DESCRIPTION

This module is used by Text::Xslate::PP internally.

=head1 SEE ALSO

L<Text::Xslate>

L<Text::Xslate::PP>

=head1 AUTHOR

Makamaka Hannyaharamitu E<lt>makamaka at cpan.orgE<gt>

Text::Xslate was written by Fuji, Goro (gfx).

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2010 by Makamaka Hannyaharamitu (makamaka).

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut