view release on metacpan or  search on metacpan

t/15_tt_view.t  view on Meta::CPAN

# The tests used here where originally written by Andy Wardley
# They have been modified to work with this testing framework
# The following is the original Copyright notice included with
# the t/view.t document that these tests were taken from.
#
# Tests the 'View' plugin.
#
# Written by Andy Wardley <abw@kfs.org>
#
# Copyright (C) 2000 Andy Wardley. All Rights Reserved.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# Id: view.t 131 2001-06-14 13:20:12Z abw
#
#========================================================================

our ($module, $N, $is_tt, $compile_perl);
BEGIN {
    $module = 'Template::Alloy';
    if (grep {/tt/i} @ARGV) {
        $module = 'Template';
    }
    $is_tt = $module eq 'Template';
    $N = ! $is_tt ? 105 : 53;
};

use strict;
use Test::More tests => $N;

use_ok($module);

my $skipped;
SKIP: {
    if (! eval { require Template::View } || ! $Template::View::VERSION) {
        $skipped = 1;
        skip("Template::View is not installed - skipping Template::View integration tests", $N - 1);
    } elsif (! UNIVERSAL::isa('Template::View', 'Template::Base')) {
        $skipped = 1;
        skip("Template::View doesn't appear to be from the Template Toolkit installation - skipping Template::View integration tests", $N - 1);
    } elsif ($Template::View::VERSION < 2.14) {
        $skipped = 1;
        skip("Template::View is not recent version - skipping Template::View integration tests", $N - 1);
    } elsif ($Template::View::VERSION >= 3) {
        $skipped = 1;
        skip("Template::View seems to be an experimental version - skipping Template::View integration tests", $N - 1);
    }
};
exit if $skipped;


sub process_ok { # process the value and say if it was ok
    my $str  = shift;
    my $test = shift;
    my $vars = shift || {};
    my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
    push @$conf, (COMPILE_PERL => $compile_perl) if $compile_perl;
    my $obj  = shift || $module->new(@$conf); # new object each time
    my $out  = '';
    my $line = (caller)[2];
    delete $vars->{'tt_config'};

    $obj->process(\$str, $vars, \$out);
    my $ok = ref($test) ? $out =~ $test : $out eq $test;
    if ($ok) {
        ok(1, "Line $line   \"$str\" => \"$out\"");
        return $obj;
    } else {
        ok(0, "Line $line   \"$str\"");
        warn "# Was:\n$out\n# Should've been:\n$test\n";
        print $obj->error if $obj->can('error');
        print $obj->dump_parse_tree(\$str) if $obj->can('dump_parse_tree');
        exit;
    }
}

### This next section of code is verbatim from Andy's code
#------------------------------------------------------------------------
{
package Foo;

sub new {
    my $class = shift;
    bless { @_ }, $class;
}

sub present {
    my $self = shift;
    return '{ ' . join(', ', map { "$_ => $self->{ $_ }" } 
		       sort keys %$self) . ' }';
}

sub reverse {
    my $self = shift;
    return '{ ' . join(', ', map { "$_ => $self->{ $_ }" } 
		       reverse sort keys %$self) . ' }';
}
}
#------------------------------------------------------------------------
{
package Blessed::List;

sub as_list {
    my $self = shift;
    return @$self;
}
}
#------------------------------------------------------------------------

my $vars = {
    foo => Foo->new( pi => 3.14, e => 2.718 ),
    blessed_list => bless([ "Hello", "World" ], 'Blessed::List'),
};


for $compile_perl (($is_tt) ? (0) : (0, 1)) {
    my $is_compile_perl = "compile perl ($compile_perl)";

###----------------------------------------------------------------###
### These are Andy's tests coded as Paul's process_oks