Mini Shell

#============================================================= -*-perl-*-
#
# t/provider.t
#
# Test the Template::Provider module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1996-2000 Andy Wardley.  All Rights Reserved.
# Copyright (C) 1998-2000 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 lib qw( ./lib ../lib );
use Template::Test;
use Template::Config;
use Template::Provider;
use Cwd 'abs_path';

$^W = 1;
my $DEBUG = grep(/-d/, @ARGV);
$Template::Test::DEBUG = 0;
use Template::Constants qw( :debug );
$Template::Provider::DEBUG = $DEBUG ? DEBUG_PROVIDER | DEBUG_CALLER : 0;
#$Template::Parser::DEBUG = 1;
#$Template::Directive::PRETTY = 1;

# uncommenting the next line should cause test 43 to fail because
# the provider doesn't stat the file.
# $Template::Provider::STAT_TTL = 10;

my $factory = 'Template::Config';

# script may be being run in distribution root or 't' directory
my $dir     = -d 't' ? 't/test/src' : 'test/src';
my $lib     = -d 't' ? 't/test/lib' : 'test/lib';
my $file    = 'foo';
my $relfile = "./$dir/$file";
my $absfile = abs_path($dir) . '/' . $file;
my $newfile = "$dir/foobar";
my $vars = {
    file    => $file,
    relfile => $relfile,
    absfile => $absfile,
    fixfile => \&update_file,
};


#------------------------------------------------------------------------
# This is used to test that source files are automatically reloaded
# when updated on disk.  we call it first to write a template file, 
# which is then included in one of the -- test --  sections below.
# Then we call update_file() (via the 'fixfile' variable) and 
# include it again to see if the new file contents were loaded.
#------------------------------------------------------------------------

sub update_file {
    local *FP;
    sleep(2);     # ensure file time stamps are different
    open(FP, ">", $newfile) || die "$newfile: $!\n";
    print(FP @_) || die "failed to write $newfile: $!\n";
    close(FP);
}

update_file('This is the old content');


#------------------------------------------------------------------------
# instantiate a bunch of providers, using various different techniques, 
# with different load options but sharing the same parser;  then set them
# to work fetching some files and check they respond as expected
#------------------------------------------------------------------------

my $parser = $factory->parser(POST_CHOMP => 1)
    || die $factory->error();
ok( $parser );

my $provinc = $factory->provider(
    INCLUDE_PATH => $dir, 
    PARSER => $parser,
    TOLERANT => 1
) || die $factory->error();
ok( $provinc );

my $provabs = $factory->provider({ 
    ABSOLUTE => 1, 
    PARSER => $parser, 
}) || die $factory->error();
ok( $provabs );

my $provrel = Template::Provider->new({ 
    RELATIVE => 1, 
    PARSER => $parser, 
}) || die $Template::Provider::ERROR;
ok( $provrel );

ok( $provinc->{ PARSER } == $provabs->{ PARSER } );
ok( $provabs->{ PARSER } == $provrel->{ PARSER } );

banner('matrix');

ok( delivered( $provinc, $file    ) );
ok(  declined( $provinc, $absfile ) );
ok(  declined( $provinc, $relfile ) );

ok(  declined( $provabs, $file    ) );
ok( delivered( $provabs, $absfile ) );
ok(    denied( $provabs, $relfile ) );

ok(  declined( $provrel, $file    ) );
ok(    denied( $provrel, $absfile ) );
ok( delivered( $provrel, $relfile ) );


sub delivered {
    my ($provider, $file) = @_;
    my ($result, $error) = $provider->fetch($file);
    my $nice_result = defined $result ? $result : '<undef>';
    my $nice_error  = defined $error  ? $error : '<undef>';
#    print STDERR "$provider->fetch($file) -> [$nice_result] [$nice_error]\n"
#	if $DEBUG;
    return ! $error;
}

sub declined {
    my ($provider, $file) = @_;
    my ($result, $error) = $provider->fetch($file);
    my $nice_result = defined $result ? $result : '<undef>';
    my $nice_error  = defined $error  ? $error : '<undef>';
#    print STDERR "$provider->fetch($file) -> [$nice_result] [$nice_error]\n"
#	if $DEBUG;
    return ($error == Template::Constants::STATUS_DECLINED);
}

sub denied {
    my ($provider, $file) = @_;
    my ($result, $error) = $provider->fetch($file);
#    print STDERR "$provider->fetch($file) -> [$result] [$error]\n"
#	if $DEBUG;
    return ($error == Template::Constants::STATUS_ERROR);
}

#------------------------------------------------------------------------
# Test if can fetch from a file handle
#------------------------------------------------------------------------

my $ttglob = Template->new || die "$Template::ERROR\n";
ok( $ttglob, 'Created template for glob test' );

# Make sure we have a multi-line template file so $/ is tested.
my $glob_file = abs_path($dir) . '/baz';

open GLOBFILE, '<', $glob_file or die "Failed to open '$absfile': $!";
my $outstr = '';

$ttglob->process( \*GLOBFILE, { a => 'globtest' }, \$outstr ) || die $ttglob->error;

close GLOBFILE;

my $glob_expect = "This is the baz file, a: globtest\n";

my $ok = $glob_expect eq $outstr;

ok( $ok, $ok ? 'Fetch template from file handle' : <<EOF );
template text did not match template from file handle
MATCH FAILED
expect: $glob_expect
output: $outstr
EOF


#------------------------------------------------------------------------
# now we'll fold those providers up into some Template objects that
# we can pass to text_expect() to do some template driven testing
#------------------------------------------------------------------------

my $ttinc = Template->new( LOAD_TEMPLATES => [ $provinc ] )
    || die "$Template::ERROR\n";
ok( $ttinc );

my $ttabs = Template->new( LOAD_TEMPLATES => [ $provabs ] )
    || die "$Template::ERROR\n";
ok( $ttabs );

my $ttrel = Template->new( LOAD_TEMPLATES => [ $provrel ] )
    || die "$Template::ERROR\n";
ok( $ttrel );


#------------------------------------------------------------------------
# here's a test of the dynamic path capability.  we'll define a handler
# sub and an object to return a dynamic list of paths
#------------------------------------------------------------------------

package My::DPaths;

sub new {
    my ($class, @paths) = @_;
    bless \@paths, $class;
}
sub paths {
    my $self = shift;
    return [ @$self ];
}

package main;

sub dpaths {
    return [ "$lib/one", "$lib/two" ],
}

# this one is designed to test the $MAX_DIRS runaway limit
$Template::Provider::MAX_DIRS = 42;

sub badpaths {
    return [ \&badpaths ],
}

my $dpaths = My::DPaths->new("$lib/two", "$lib/one");

my $ttd1 = Template->new({
    INCLUDE_PATH => [ \&dpaths, $dir ],
    PARSER => $parser,
}) || die "$Template::ERROR\n";
ok( $ttd1, 'dynamic path (sub) template object created' );

my $ttd2 = Template->new({
    INCLUDE_PATH => [ $dpaths, $dir ],
    PARSER => $parser,
}) || die "$Template::ERROR\n";
ok( $ttd1, 'dynamic path (obj) template object created' );

my $ttd3 = Template->new({
    INCLUDE_PATH => [ \&badpaths ],
    PARSER => $parser,
}) || die "$Template::ERROR\n";
ok( $ttd3, 'dynamic path (bad) template object created' );


my $uselist = [ 
    ttinc  => $ttinc, 
    ttabs  => $ttabs, 
    ttrel  => $ttrel,
	ttd1   => $ttd1, 
    ttd2   => $ttd2, 
    ttdbad => $ttd3 ];

test_expect(\*DATA, $uselist, $vars);


__DATA__
-- test --
-- use ttinc --
[% TRY %]
[% INCLUDE foo %]
[% INCLUDE $relfile %]
[% CATCH file %]
Error: [% error.type %] - [% error.info.split(': ').1 %]
[% END %]
-- expect --
This is the foo file, a is Error: file - not found


-- test --
[% TRY %]
[% INCLUDE foo %]
[% INCLUDE $absfile %]
[% CATCH file %]
Error: [% error.type %] - [% error.info.split(': ').1 %]
[% END %]
-- expect --
This is the foo file, a is Error: file - not found


-- test --
[% TRY %]
[% INSERT foo +%]
[% INSERT $absfile %]
[% CATCH file %]
Error: [% error %]
[% END %]
-- expect --
-- process --
[% TAGS [* *] %]
This is the foo file, a is [% a -%]
Error: file error - [* absfile *]: not found

#------------------------------------------------------------------------

-- test --
-- use ttrel --
[% TRY %]
[% INCLUDE $relfile %]
[% INCLUDE foo %]
[% CATCH file -%]
Error: [% error.type %] - [% error.info %]
[% END %]
-- expect --
This is the foo file, a is Error: file - foo: not found

-- test --
[% TRY %]
[% INCLUDE $relfile -%]
[% INCLUDE $absfile %]
[% CATCH file %]
Error: [% error.type %] - [% error.info.split(': ').1 %]
[% END %]
-- expect --
This is the foo file, a is Error: file - absolute paths are not allowed (set ABSOLUTE option)


-- test --
foo: [% TRY; INSERT foo;      CATCH; "$error\n"; END %]
rel: [% TRY; INSERT $relfile; CATCH; "$error\n"; END +%]
abs: [% TRY; INSERT $absfile; CATCH; "$error\n"; END %]
-- expect --
-- process --
[% TAGS [* *] %]
foo: file error - foo: not found
rel: This is the foo file, a is [% a -%]
abs: file error - [* absfile *]: absolute paths are not allowed (set ABSOLUTE option)

#------------------------------------------------------------------------

-- test --
-- use ttabs --
[% TRY %]
[% INCLUDE $absfile %]
[% INCLUDE foo %]
[% CATCH file %]
Error: [% error.type %] - [% error.info %]
[% END %]
-- expect --
This is the foo file, a is Error: file - foo: not found

-- test --
[% TRY %]
[% INCLUDE $absfile %]
[% INCLUDE $relfile %]
[% CATCH file %]
Error: [% error.type %] - [% error.info.split(': ').1 %]
[% END %]
-- expect --
This is the foo file, a is Error: file - relative paths are not allowed (set RELATIVE option)


-- test --
foo: [% TRY; INSERT foo;      CATCH; "$error\n"; END %]
rel: [% TRY; INSERT $relfile; CATCH; "$error\n"; END %]
abs: [% TRY; INSERT $absfile; CATCH; "$error\n"; END %]
-- expect --
-- process --
[% TAGS [* *] %]
foo: file error - foo: not found
rel: file error - [* relfile *]: relative paths are not allowed (set RELATIVE option)
abs: This is the foo file, a is [% a -%]



#------------------------------------------------------------------------
# test that files updated on disk are automatically reloaded.
#------------------------------------------------------------------------

-- test --
-- use ttinc --
[% INCLUDE foobar %]
-- expect --
This is the old content

-- test --
[% CALL fixfile('This is the new content') %]
[% INCLUDE foobar %]
-- expect --
This is the new content

#------------------------------------------------------------------------
# dynamic path tests 
#------------------------------------------------------------------------

-- test --
-- use ttd1 --
foo: [% PROCESS foo | trim +%]
bar: [% PROCESS bar | trim +%]
baz: [% PROCESS baz a='alpha' | trim %]
-- expect --
foo: This is one/foo
bar: This is two/bar
baz: This is the baz file, a: alpha

-- test --
foo: [% INSERT foo | trim +%]
bar: [% INSERT bar | trim +%]
-- expect --
foo: This is one/foo
bar: This is two/bar

-- test --
-- use ttd2 --
foo: [% PROCESS foo | trim +%]
bar: [% PROCESS bar | trim +%]
baz: [% PROCESS baz a='alpha' | trim %]
-- expect --
foo: This is two/foo
bar: This is two/bar
baz: This is the baz file, a: alpha

-- test --
foo: [% INSERT foo | trim +%]
bar: [% INSERT bar | trim +%]
-- expect --
foo: This is two/foo
bar: This is two/bar

-- test --
-- use ttdbad --
[% TRY; INCLUDE foo; CATCH; e; END %]
-- expect --
file error - INCLUDE_PATH exceeds 42 directories