view release on metacpan or  search on metacpan

t/02_cache.t  view on Meta::CPAN

# -*- Mode: Perl; -*-

=head1 NAME

02_cache.t - Test caching features

=cut

use 5.006;
our ($n_tests, $has_encode);
BEGIN {
    if (eval { require Encode; require utf8 }) {
        $has_encode = 1;
    }

    $n_tests = 193;
    $n_tests += 12 if $has_encode;
};

use strict;
use Test::More tests => $n_tests;
use constant test_taint => 0 && eval { require Taint::Runtime };

if (! eval { require File::Path }) {
    SKIP: {
        skip("File::Path not installed, skipping tests", $n_tests);
    };
    exit;
}

my $module = 'Template::Alloy';
use_ok($module);

Taint::Runtime::taint_start() if test_taint;

my $name = "bar.tt";

### find a place to allow for testing
my $test_dir = $0 .'.test_dir';
END { if($test_dir){ flush_dir($test_dir); rmdir($test_dir)  || die "Couldn't rmdir $test_dir: $!"} }
mkdir $test_dir, 0755;
ok(-d $test_dir, "Got a test dir up and running");

### find a place to allow for testing
my $test_dir2 = $0 .'.test_dir2';
END { if($test_dir2){flush_dir($test_dir2); rmdir $test_dir2  || die "Couldn't rmdir $test_dir2: $!"} }
mkdir $test_dir2, 0755;
ok(-d $test_dir2, "Got a test dir up and running");

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

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, (INCLUDE_PATH => $test_dir);
    my $obj  = shift || $module->new(@$conf); # new object each time
    my $out  = '';
    my $line = (caller)[2];
    delete $vars->{'tt_config'};

    Taint::Runtime::taint(\$str) if test_taint;

    $obj->process_simple($str, $vars, \$out);
    my $ok = ref($test) ? $out =~ $test : $out eq $test;
    if ($ok) {
        ok(1, "Line $line   \"".(ref($str) ? $$str : $str)."\" => \"$out\"");
        return $obj;
    } else {
        ok(0, "Line $line   \"".(ref($str) ? $$str : $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;
    }
}

sub pristine {
    my $contents = shift || "[% blue %]BAR";
    my $encoding = shift;

    if ($encoding) {
        $contents = Encode::encode( $encoding, $contents );
    }

    $Template::Alloy::GLOBAL_CACHE = {};
    flush_dir($test_dir);
    flush_dir($test_dir2);

    if (! ref $name) {
        my $fh;
        open($fh, ">$test_dir/$name") || die "Couldn't open $name in $test_dir: $!";
        print $fh $contents;
        close $fh;
    }
}

sub flush_dir {
    my $dir = shift;
    opendir(my $dh, $dir) || die "Couldn't open $dir: $!";
    my @files = map { "$dir/$_"} grep {! /^\.\.?$/} readdir $dh;
#    print "Unlinking (@files) in $dir\n";
    File::Path::rmtree($_) foreach @files;
}

sub test_cache {
    my ($file, $pkg, $line) = caller;

    my $not_ok;
    foreach my $i (0 .. $#_) {
        my $ref = $_[$i] || return;
        my $_line = $line + $i;
        my ($dir, $name, $exists) = @$ref;
        if ($exists) {
            my $ok = -e "$dir/$name";
            ok($ok, "Line $_line: Found $name in $dir");
            $not_ok++ if ! $ok;
        } else {
            my $ok = ! -e "$dir/$name";