Mini Shell

#============================================================= -*-perl-*-
#
# t/tiedhash.t
#
# Template script testing variable via a tied hash.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1996-2001 Andy Wardley.  All Rights Reserved.
# Copyright (C) 1998-2001 Canon Research Centre Europe Ltd.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id$
#
#========================================================================

use strict;
use warnings;
# should not prove be responsible for this?
use lib qw( blib/lib blib/arch lib ../blib/lib ../blib/arch ../lib );
use Template::Test;
use Template::Stash;
use Template::Config;
use File::Spec;

# MacOS Catalina won't allow Dynaloader to load from relative paths
# Error: file system relative paths not allowed in hardened program
@INC = map { File::Spec->rel2abs($_) } @INC;

our $DEBUG = grep(/-d/, @ARGV);
our $STORE_PREFIX = '';
our $FETCH_PREFIX = '';

# only run the test when compiled with Template::Stash
if ( $Template::Config::STASH ne 'Template::Stash::XS' ) {
    skip_all('Template::Config is not using Template::Stash::XS');
}

require Template::Stash::XS;

#------------------------------------------------------------------------
package My::Tied::Hash;
use Tie::Hash;
use base 'Tie::StdHash';

sub FETCH {
    my ($hash, $key) = @_;
    print STDERR "FETCH($key)\n" if $main::DEBUG;
    my $val = $hash->{ $key };
    return $val ? (ref $val ? $val : "$main::FETCH_PREFIX$val") : undef;
}

sub STORE { 
    my ($hash, $key, $val) = @_; 
    print STDERR "STORE($key, $val)\n" if $main::DEBUG;
    $hash->{ $key } = ref $val ? $val : "$main::STORE_PREFIX$val";
}

#------------------------------------------------------------------------
package My::Tied::List;
use Tie::Array;
use base 'Tie::StdArray';

sub FETCH {
    my ($list, $n) = @_;
    print STDERR "FETCH from list [$n]\n" if $main::DEBUG;
    my $val = $list->[ $n ];
    return $val ? (ref $val ? $val : "$main::FETCH_PREFIX$val") : undef;
}

sub STORE {
    my ($list, $n, $val) = @_;
    print STDERR "STORE to list [$n => $val]\n" if $main::DEBUG;
    $list->[$n] = ref $val ? $val : "$main::STORE_PREFIX$val";
}

#------------------------------------------------------------------------
package main;


# setup a tied hash and a tied list
my @list;
tie @list, 'My::Tied::List';
push(@list, 10, 20, 30);

my %hash = (a => 'alpha');
tie %hash, 'My::Tied::Hash';
$hash{ a } = 'alpha';
$hash{ b } = 'bravo';
$hash{ zero } = 0;
$hash{ one } = 1;

# now turn on the prefixes so we can track items going in 
# and out of the tied hash/list
$FETCH_PREFIX = 'FETCH:';
$STORE_PREFIX = 'STORE:';

my $data = {
    hash => \%hash,
    list => \@list,
};
my $stash_perl = Template::Stash->new($data);
my $stash_xs   = Template::Stash::XS->new($data);
my $tt = [
    perl => Template->new( STASH => $stash_perl ),
    xs   => Template->new( STASH => $stash_xs ),
];
test_expect(\*DATA, $tt);

__DATA__

#------------------------------------------------------------------------
# first try with the Perl stash
#------------------------------------------------------------------------

# hash tests

-- test --
[% hash.a %]
-- expect --
FETCH:alpha

-- test --
[% hash.b %]
-- expect --
FETCH:bravo

-- test --
ready
set:[% hash.c = 'cosmos' %]
go:[% hash.c %]
-- expect --
ready
set:
go:FETCH:STORE:cosmos

-- test --
[% hash.foo.bar = 'one' -%]
[% hash.foo.bar %]
-- expect --
one

# list tests

-- test --
[% list.0 %]
-- expect --
FETCH:10

-- test --
[% list.first %]-[% list.last %]
-- expect --
FETCH:10-FETCH:30

-- test --
[% list.push(40); list.last %]
-- expect --
FETCH:40

-- test --
[% list.4 = 50; list.4 %]
-- expect --
FETCH:STORE:50


#------------------------------------------------------------------------
# now try using the XS stash
#------------------------------------------------------------------------

# hash tests

-- test --
-- use xs --
[% hash.a %]
-- expect --
FETCH:alpha

-- test --
[% hash.b %]
-- expect --
FETCH:bravo

-- test --
[% hash.c = 'crazy'; hash.c %]
-- expect --
FETCH:STORE:crazy

-- test --
[% DEFAULT hash.c = 'more crazy'; hash.c %]
-- expect --
FETCH:STORE:crazy

-- test --
[% hash.wiz = 'woz' -%]
[% hash.wiz %]
-- expect --
FETCH:STORE:woz

-- test --
[% DEFAULT hash.zero = 'nothing';
   hash.zero
%]
-- expect --
FETCH:STORE:nothing

-- test --
before: [% hash.one %]
after: [% DEFAULT hash.one = 'solitude';
   hash.one
%]
-- expect --
before: FETCH:1
after: FETCH:1

-- test --
[% hash.foo = 10; hash.foo = 20; hash.foo %]
-- expect --
FETCH:STORE:20

# this test should create an intermediate hash
-- test --
[% DEFAULT hash.person = { };
   hash.person.name  = 'Arthur Dent';
   hash.person.email = 'dent@tt2.org'; 
-%]
name:  [% hash.person.name %]
email: [% hash.person.email %]
-- expect --
name:  Arthur Dent
email: dent@tt2.org


# list tests

-- test --
[% list.0 %]
-- expect --
FETCH:10

-- test --
[% list.first %]-[% list.last %]
-- expect --
FETCH:10-FETCH:STORE:50

-- test --
[% list.push(60); list.last %]
-- expect --
FETCH:60

-- test --
[% list.5 = 70; list.5 %]
-- expect --
FETCH:STORE:70

-- test --
[% DEFAULT list.5 = 80; list.5 %]
-- expect --
FETCH:STORE:70

-- test --
[% list.10 = 100; list.10 %]
-- expect --
FETCH:STORE:100

-- test --
[% stuff = [ ];
   stuff.0 = 'some stuff';
   stuff.0
-%]
-- expect --
some stuff