
package Text::Wigwam::Globals;

    use strict;
    use warnings;
    our $VERSION = '0.01';

    use Text::Wigwam::Globals::Snapshot;

    use constant    EFSTACK => 0;
    use constant    EFNAME  => 1;
    use constant    EFSCOPE => 2;
    use constant    EFFATAL => 3;

    use constant    NO_EFLAG => 0;
    use constant    IS_EFLAG => 1;
    use constant    IS_SUBST => 2;
    use constant    IS_FATAL => 3;

sub new {
    my ($class, @scopes) = @_;
    my $scope = {};
    map { $scope->{$_} = [] } (
        @scopes,
        qw(
            LOCAL
            BLOCK
            GLOBAL
            TEMPLATE
        ),
    );
    return bless {
        EFLAGS => [],
        SCOPE  => $scope,
    }, ref $class || $class;
}

sub eflag {
    my $eflags = $_[0]->{EFLAGS};
    local $_;
    $_->[EFSTACK][0] and return $_->[EFNAME] for @$eflags;
    return;
}

sub eflag_info {
    my ($globals) = @_;
    my $efname = $globals->eflag
      or return;
    return (
        $efname,
        $globals->get_global($efname),
        @{$globals->{NAME}{$efname}}{qw/ SCOPE SUBST FATAL /}
    );
}

sub new_global { _new_global( @_[0..3], NO_EFLAG ) }
sub new_eflag  { _new_global( @_[0..3], IS_EFLAG ) }
sub new_fatal  { _new_global( @_[0..3], IS_FATAL ) }
sub new_subst  { _new_global( @_[0..3], IS_SUBST ) }

#sub is_fatal   {
#    my ($globals, $name) = @_;
#    return $globals->{NAME}{$name}{FATAL};
#}

# Declare a new global variable
# $self->new_global( scope, name, default, eflag )

sub _new_global {
    my ($globals, $scope, $name, $default, $eflag) = @_;
    return if $globals->global_exists($name);
    my $new_stack = [ $default ];
    die "Invalid scope '$scope'"
      unless exists $globals->{SCOPE}{$scope};
    push(
        @{$globals->{SCOPE}{$scope}},
        {
         STACK => $new_stack,
         DEFAULT => $default,
         NAME => $name,
        }
    );
    $globals->{NAME}{$name} = {
        STACK   => $new_stack,
        SCOPE   => $scope,
        DEFAULT => $default,
        FATAL   =>  ($eflag == IS_FATAL) ? 1 : 0,
        SUBST   =>  ($eflag == IS_SUBST) ? 1 : 0,
    };
    push(
        @{ $globals->{EFLAGS} },
        [
          $new_stack,
          $name,
          $scope,
          ($eflag == IS_FATAL) ? 1 : 0,
        ]
    ) if $eflag;
    return;
}

sub list_eflags {
    my ($globals) = @_;
    my @eflags;
    local $_;
    push( @eflags, $_->[EFNAME] ) for @{$globals->{EFLAGS}};
    return @eflags;
}

sub reset_eflags {
    my ($globals) = @_;
    my @eflags = $globals->list_eflags;
    $globals->del_global( @eflags );
    $globals->add_global( @eflags );
}

sub list_globals { return keys %{$_[0]->{NAME}} }

# Remove a global, or a list of globals. This may not be useful unless
# Wigwam is being used in a persistent environment such as mod_perl.
# $self->kill_global( name1, name2... )

sub kill_global {
    my ($globals, @names) = @_;
    my $count;
    foreach my $name (@names){
        my $scname = $globals->{NAME}{$name}{SCOPE};
        delete $globals->{NAME}{$name};

         # Hunt & kill the scope entry (** unverified **)
        $count = 0;
        foreach my $scope ( @{$globals->{SCOPE}{$scname}} ){
            if( $scope->{NAME} eq $name ){
                splice( @{$globals->{SCOPE}{$scname}}, $count, 1 );
                last;
            }
            ++$count;
        }

         # Hunt & kill the eflag entry
        $count = 0;
        foreach my $eflag ( @{$globals->{EFLAGS}} ){
            if( $eflag->[EFNAME] eq $name ){
                splice( @{$globals->{EFLAGS}}, $count, 1 );
                last;
            }
            ++$count;
        }
    }
}

sub destroy {
    my ($self) = @_;
    $self->kill_global( keys %{$self->{NAME}} );
}

# Test whether the specified global is defined and return its scope if it is.
# $self->global_exists( name )

sub global_exists { return $_[0]->{NAME}{$_[1]}{SCOPE} if exists $_[0]->{NAME}{$_[1]} }

# Change the value of a global variable in the current scope.
# $self->set_global( name, value )

sub set_global { return $_[0]->{NAME}{$_[1]}{STACK}[0] = $_[2] }

# Return the current value of a global variable within its current scope.
# $self->get_global( name )

sub get_global { return $_[0]->{NAME}{$_[1]}{STACK}[0] }
#sub get_global {
#    warn "Unknown global ".$_[1] unless exists $_[0]->{NAME}{$_[1]};
#    return $_[0]->{NAME}{$_[1]}{STACK}[0]
#}

sub get_global_ref {
    my ($globals, @names) = @_;
    unless (wantarray) {
        my $stack = $globals->{NAME}{$names[0]}{STACK};
        return ref $stack->[0] ? $stack->[0] : \($stack->[0]);
    };
    my @grefs;
    for my $name (@names){
        my $stack = $globals->{NAME}{$name}{STACK};
        push(
            @grefs =>
            ref $stack->[0] ? $stack->[0] : \($stack->[0]),
        );
    }
    return @grefs;
}

# Enter a new scope by pushing default values onto each stack in the scope.
# $self->inc_scope( scope )

sub inc_scope {
    my ($globals, $nscope) = @_;
    my $scope = $globals->{SCOPE}{$nscope}
      or die "Invalid scope '$nscope'";
    local $_;
    unshift(
        @{$_->{STACK}},
        $_->{DEFAULT}
    ) for @$scope;
    return;
}

# Exit scope by popping all stacks in the scope.
# $self->dec_scope( scope )

sub dec_scope {
    my $scope = $_[0]->{SCOPE}{$_[1]};
    local $_;
    shift @{$_->{STACK}} for @$scope;
    return;
}

# Creates a new global instance, then sets and returns the given value.
# $self->push_global( name, value )

sub push_global {
    my ($self, $name, $value) = @_;
    $self->add_global( $name );
    return $self->set_global($name, $value );
}

# Enter a new scope by pushing default values onto each specific globals.
# $self->add_global( name1, name2,... )

sub add_global {
    my ($globals, @names) = @_;
    for my $name (@names){
        unless( $globals->global_exists($name) ){
             # vivify as LOCAL if not previously defined
            $globals->new_global( LOCAL => $name );
            next;
        }
        unshift(
            @{$globals->{NAME}{$name}{STACK}},
            $globals->{NAME}{$name}{DEFAULT}
        );
    }
    return;
}

# Exit scope by popping the stacks for the specified globals.
# $self->del_global( name1, name2,... )

sub del_global {
    my $globals = shift->{NAME};
    local $_;
    shift @{ $globals->{$_}{STACK} } for (@_);
    return;
}

sub snapshot {
    my ($globals, $maxdepth) = @_;
    return Text::Wigwam::Globals::Snapshot->freeze($globals, $maxdepth);
}

1;

__END__

