Mr.X

#============================================================= -*-perl-*-
#
# t/varsv1.t
#
# Template script testing variable use with version 1 compatibility.
# In version 1, leading '$' on variables were ignored.
# 
# 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::Constants qw( :status );
$^W = 1;

$Template::Test::DEBUG = 0;

# sample data
my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, 
    $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z) = 
	qw( alpha bravo charlie delta echo foxtrot golf hotel india 
	    juliet kilo lima mike november oscar papa quebec romeo 
	    sierra tango umbrella victor whisky x-ray yankee zulu );

my @days   = qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday );
my $day    = -1;
my $count  = 0;
my $params = { 
    'a' => $a,
    'b' => $b,
    'c' => $c,
    'd' => $d,
    'e' => $e,
    'f' => {
	'g' => $g,
	'h' => $h,
	'i' => {
	    'j' => $j,
	    'k' => $k,
	},
    },
    'l' => $l,
    'r' => $r,
    's' => $s,
    't' => $t,
    'w' => $w,
    'n'      => sub { $count },
    'up'     => sub { ++$count },
    'down'   => sub { --$count },
    'reset'  => sub { $count = shift(@_) || 0 },
    'undef'  => sub { undef },
    'zero'   => sub { 0 },
    'one'    => sub { 'one' },
    'halt'   => sub { die Template::Exception->new('stop', 'stopped') },
    'join'   => sub { join(shift, @_) },
    'split'  => sub { my $s = shift; $s = quotemeta($s); 
		     my @r = split(/$s/, shift); \@r },
    'magic'  => {
	'chant' => 'Hocus Pocus',
	'spell' => sub { join(" and a bit of ", @_) },
    }, 
    'day'    => {
	'prev' => \&yesterday,
	'this' => \&today,
	'next' => \&tomorrow,
    },
    'belief'   => \&belief,
    'people'   => sub { return qw( Tom Dick Larry ) },
    "letter$a" => "'$a'",

    # don't define a 'z' - DEFAULT test relies on its non-existance
};

my $tt = [ default => Template->new({ 
	       INTERPOLATE => 1, 
	       ANYCASE     => 1,
	       V1DOLLAR    => 1,
	   }),
	   notcase => Template->new({ 
	       INTERPOLATE => 1, 
	       V1DOLLAR    => 0,
	   }) ];

test_expect(\*DATA, $tt, $params);

#------------------------------------------------------------------------
# subs 
#------------------------------------------------------------------------

sub yesterday {
    return "All my troubles seemed so far away...";
}

sub today {
    my $when = shift || 'Now';
    return "$when it looks as though they're here to stay.";
}

sub tomorrow {
    my $dayno = shift;
    unless (defined $dayno) {
	$day++;
	$day %= 7;
	$dayno = $day;
    }
    return $days[$dayno];
}

sub belief {
    my @beliefs = @_;
    my $b = join(' and ', @beliefs);
    $b = '<nothing>' unless length $b;
    return "Oh I believe in $b.";
}

__DATA__

#------------------------------------------------------------------------
# GET 
#------------------------------------------------------------------------

-- test --
[% a %]
[% $a %]
[% GET b %]
[% GET $b %]
[% get c %]
[% get $c %]
-- expect --
alpha
alpha
bravo
bravo
charlie
charlie

-- test --
[% b %] [% $b %] [% GET b %] [% GET $b %]
-- expect --
bravo bravo bravo bravo

-- test --
$a $b ${c} ${d} [% $e %]
-- expect --
alpha bravo charlie delta echo

-- test --
[% letteralpha %]
[% ${"letter$a"} %]
[% GET ${"letter$a"} %]
-- expect --
'alpha'
'alpha'
'alpha'

-- test --
[% f.g %] [% $f.g %] [% $f.$g %]
-- expect --
golf golf golf

-- test --
[% GET f.h %] [% get $f.h %] [% get f.${'h'} %] [% get $f.${'h'} %]
-- expect --
hotel hotel hotel hotel

-- test --
$f.h ${f.g} ${f.h}.gif
-- expect --
hotel golf hotel.gif

-- test --
[% f.i.j %] [% $f.i.j %] [% f.$i.j %] [% f.i.$j %] [% $f.$i.$j %]
-- expect --
juliet juliet juliet juliet juliet

-- test --
[% f.i.j %] [% $f.i.j %] [% GET f.i.j %] [% GET $f.i.j %]
-- expect --
juliet juliet juliet juliet

-- test --
[% get $f.i.k %]
-- expect --
kilo

-- test --
[% f.i.j %] $f.i.k [% f.${'i'}.${"j"} %] ${f.i.k}.gif
-- expect --
juliet kilo juliet kilo.gif

-- test --
[% 'this is literal text' %]
[% GET 'so is this' %]
[% "this is interpolated text containing $r and $f.i.j" %]
[% GET "$t?" %]
[% "<a href=\"${f.i.k}.html\">$f.i.k</a>" %]
-- expect --
this is literal text
so is this
this is interpolated text containing romeo and juliet
tango?
<a href="kilo.html">kilo</a>

-- test --
[% name = "$a $b $w" -%]
Name: $name
-- expect --
Name: alpha bravo whisky

-- test --
[% join('--', a b, c, f.i.j) %]
-- expect --
alpha--bravo--charlie--juliet

-- test --
[% text = 'The cat sat on the mat' -%]
[% FOREACH word = split(' ', text) -%]<$word> [% END %]
-- expect --
<The> <cat> <sat> <on> <the> <mat> 

-- test -- 
[% magic.chant %] [% GET magic.chant %]
[% magic.chant('foo') %] [% GET $magic.chant('foo') %]
-- expect --
Hocus Pocus Hocus Pocus
Hocus Pocus Hocus Pocus

-- test -- 
<<[% magic.spell %]>>
[% magic.spell(a b c) %]
-- expect --
<<>>
alpha and a bit of bravo and a bit of charlie

-- test --
[% one %] [% one('two', 'three') %] [% one(2 3) %]
-- expect --
one one one

-- test --
[% day.prev %]
[% day.this %]
[% belief('yesterday') %]
-- expect --
All my troubles seemed so far away...
Now it looks as though they're here to stay.
Oh I believe in yesterday.

-- test --
Yesterday, $day.prev
$day.this
${belief('yesterday')}
-- expect --
Yesterday, All my troubles seemed so far away...
Now it looks as though they're here to stay.
Oh I believe in yesterday.

-- test --
-- use notcase --
[% day.next %]
$day.next
-- expect --
Monday
Tuesday

-- test --
[% FOREACH [ 1 2 3 4 5 ] %]$day.next [% END %]
-- expect --
Wednesday Thursday Friday Saturday Sunday 

-- test --
-- use default --
before
[% halt %]
after

-- expect --
before

#------------------------------------------------------------------------
# CALL 
#------------------------------------------------------------------------

-- test --
before [% CALL a %]a[% CALL b %]n[% CALL c %]d[% CALL d %] after
-- expect --
before and after

-- test --
..[% CALL undef %]..
-- expect --
....

-- test --
..[% CALL zero %]..
-- expect --
....

-- test --
..[% n %]..[% CALL n %]..
-- expect --
..0....

-- test --
..[% up %]..[% CALL up %]..[% n %]
-- expect --
..1....2

-- test --
[% CALL reset %][% n %]
-- expect --
0

-- test --
[% CALL reset(100) %][% n %]
-- expect --
100

#------------------------------------------------------------------------
# SET 
#------------------------------------------------------------------------

-- test --
[% a = a %] $a
[% a = b %] $a
[% a = $c %] $a
[% $a = d %] $a
[% $a = $e %] $a
-- expect --
 alpha
 bravo
 charlie
 delta
 echo

-- test -- 
[% SET a = a %] $a
[% SET a = b %] $a
[% SET a = $c %] $a
[% SET $a = d %] $a
[% SET $a = $e %] $a
-- expect --
 alpha
 bravo
 charlie
 delta
 echo

-- test --
[% a = b
   b = c
   c = d
   d = e
%][% a %] [% b %] [% c %] [% d %]
-- expect --
bravo charlie delta echo

-- test --
[% SET
   a = c
   b = d
   c = e
%]$a $b $c
-- expect --
charlie delta echo

-- test --
[% a = f.g %] $a
[% a = $f.h %] $a
[% a = f.i.j %] $a
[% a = $f.i.k %] $a
-- expect --
 golf
 hotel
 juliet
 kilo

-- test --
[% f.g = r %] $f.g
[% $f.h = $r %] $f.h
[% f.i.j = $s %] $f.i.j
[% $f.i.k = f.i.j %] ${f.i.k}
-- expect --
 romeo
 romeo
 sierra
 sierra

-- test --
[% user = {
    id = 'abw'
    name = 'Andy Wardley'
    callsign = "[-$a-$b-$w-]"
   }
-%]
${user.id} ${ user.id } $user.id ${user.id}.gif
[% message = "$b: ${ user.name } (${user.id}) ${ user.callsign }" -%]
MSG: $message
-- expect --
abw abw abw abw.gif
MSG: bravo: Andy Wardley (abw) [-alpha-bravo-whisky-]

-- test --
[% product = {
     id   => 'XYZ-2000',
     desc => 'Bogon Generator',
     cost => 678,
   }
-%]
The $product.id $product.desc costs \$${product.cost}.00
-- expect --
The XYZ-2000 Bogon Generator costs $678.00

#------------------------------------------------------------------------
# DEFAULT
#------------------------------------------------------------------------

-- test --
[% a %]
[% DEFAULT a = b -%]
[% a %]
-- expect --
alpha
alpha

-- test --
[% a = '' -%]
[% DEFAULT a = b -%]
[% a %]
-- expect --
bravo

-- test --
[% a = ''   b = '' -%]
[% DEFAULT 
   a = c
   b = d
   z = r
-%]
[% a %] [% b %] [% z %]
-- expect --
charlie delta romeo


#------------------------------------------------------------------------
# 'global' vars
#------------------------------------------------------------------------

-- test --
[% global.version = '3.14' -%]
Version: [% global.version %]
-- expect --
Version: 3.14

-- test --
Version: [% global.version %]
-- expect --
Version: 3.14

-- test --
[% global.newversion = global.version + 1 -%]
Version: [% global.version %]
Version: [% global.newversion %]
-- expect --
Version: 3.14
Version: 4.14

-- test --
Version: [% global.version %]
Version: [% global.newversion %]
-- expect --
Version: 3.14
Version: 4.14

Name	Type	Size	Permission
lib	Folder		0755
test	Folder		0755
vmethods	Folder		0755
README	File	3.1 KB	0644
anycase.t	File	2.16 KB	0644
args.t	File	2.41 KB	0644
assert.t	File	2.53 KB	0644
base.t	File	3.58 KB	0644
binop.t	File	4.82 KB	0644
block.t	File	2.71 KB	0644
block_duplicate.t	File	476 B	0644
blocks.t	File	2.2 KB	0644
capture.t	File	1.59 KB	0644
case.t	File	1.46 KB	0644
chomp.t	File	7.71 KB	0644
compile1.t	File	2.12 KB	0644
compile2.t	File	2.67 KB	0644
compile3.t	File	3.75 KB	0644
compile4.t	File	2.38 KB	0644
compile5.t	File	3.28 KB	0644
config.t	File	6.46 KB	0644
constants.t	File	5.07 KB	0644
context.t	File	5.87 KB	0644
datafile.t	File	1.81 KB	0644
date.t	File	6.73 KB	0644
date_offset.t	File	2.17 KB	0644
date_utf8.t	File	1.33 KB	0644
debug.t	File	3.86 KB	0644
directive.t	File	4.76 KB	0644
directry.t	File	5.48 KB	0644
document.t	File	3.58 KB	0644
dumper.t	File	1.47 KB	0644
error.t	File	953 B	0644
evalperl.t	File	3.73 KB	0644
exception.t	File	1.52 KB	0644
factory.t	File	1.4 KB	0644
file.t	File	2.87 KB	0644
fileline.t	File	3.16 KB	0644
filter.t	File	17.74 KB	0644
foreach.t	File	10.31 KB	0644
format.t	File	1.78 KB	0644
html.t	File	2.52 KB	0644
image.t	File	2.22 KB	0644
include.t	File	6.04 KB	0644
iterator.t	File	3.67 KB	0644
leak.t	File	5.01 KB	0644
list.t	File	4.41 KB	0644
load_order_vmethods_stash.t	File	192 B	0644
macro.t	File	2.93 KB	0644
math.t	File	1.22 KB	0644
math_rand.t	File	476 B	0644
meta.t	File	881 B	0644
mtime-zero.t	File	1.04 KB	0644
object.t	File	7.23 KB	0644
outline.t	File	2.29 KB	0644
outline_line.t	File	971 B	0644
output.t	File	2.66 KB	0644
parser.t	File	4.74 KB	0644
parser2.t	File	981 B	0644
plugins.t	File	6.12 KB	0644
plusfile.t	File	1.91 KB	0644
pod.t	File	2.05 KB	0644
prefix.t	File	1.46 KB	0644
proc.t	File	867 B	0644
process-relative.t	File	2.05 KB	0644
process.t	File	1.88 KB	0644
process_dir.t	File	1.84 KB	0644
provider.t	File	11.08 KB	0644
ref.t	File	1.63 KB	0644
scalar.t	File	2.56 KB	0644
service.t	File	5.07 KB	0644
skel.t	File	947 B	0644
stash-xs-unicode.t	File	2.03 KB	0644
stash-xs.t	File	8.42 KB	0644
stash.t	File	7.91 KB	0644
stashc.t	File	1.6 KB	0644
stop.t	File	2.72 KB	0644
strcat.t	File	758 B	0644
strict.t	File	1.52 KB	0644
string.t	File	7.38 KB	0644
switch.t	File	3.83 KB	0644
table.t	File	2.68 KB	0644
tags.t	File	3.63 KB	0644
template.t	File	1.49 KB	0644
text.t	File	2.89 KB	0644
throw.t	File	1.94 KB	0644
tiedhash.t	File	5.28 KB	0644
trace_vars.t	File	1.11 KB	0644
try.t	File	9.83 KB	0644
unicode.t	File	4.55 KB	0644
url.t	File	4.06 KB	0644
vars.t	File	11.36 KB	0644
varsv1.t	File	8.96 KB	0644
view.t	File	17.43 KB	0644
while.t	File	3.18 KB	0644
wrap.t	File	2.63 KB	0644
wrapper.t	File	3.95 KB	0644
zz-plugin-cycle.t	File	1.6 KB	0644
zz-plugin-leak-gh-213.t	File	2.77 KB	0644
zz-plugin-leak-rt-46691.t	File	2.95 KB	0644
zz-plugin-leak.t	File	2.02 KB	0644
zz-pmv.t	File	1.15 KB	0644
zz-pod-coverage.t	File	1.64 KB	0644
zz-pod-kwalitee.t	File	776 B	0644
zz-stash-xs-leak.t	File	1.59 KB	0644
zz-url2.t	File	3.71 KB	0644

Upload:

Command:

Filemanager

Server Info

System Info