Gecko [ dp-client.com ]

Name	Size	Permission
lib	[ DIR ]	drwxr-xr-x
test	[ DIR ]	drwxr-xr-x
vmethods	[ DIR ]	drwxr-xr-x
README	3.15 KB	-rw-r--r--
anycase.t	2.16 KB	-rw-r--r--
args.t	2.41 KB	-rw-r--r--
assert.t	2.53 KB	-rw-r--r--
base.t	3.58 KB	-rw-r--r--
binop.t	4.82 KB	-rw-r--r--
block.t	2.71 KB	-rw-r--r--
block_duplicate.t	476 B	-rw-r--r--
blocks.t	2.2 KB	-rw-r--r--
capture.t	1.59 KB	-rw-r--r--
case.t	1.46 KB	-rw-r--r--
cgi.t	2.11 KB	-rw-r--r--
chomp.t	7.71 KB	-rw-r--r--
compile1.t	2.12 KB	-rw-r--r--
compile2.t	2.67 KB	-rw-r--r--
compile3.t	3.75 KB	-rw-r--r--
compile4.t	2.38 KB	-rw-r--r--
compile5.t	3.28 KB	-rw-r--r--
config.t	6.46 KB	-rw-r--r--
constants.t	5.07 KB	-rw-r--r--
context.t	5.87 KB	-rw-r--r--
datafile.t	1.63 KB	-rw-r--r--
date.t	6.73 KB	-rw-r--r--
date_offset.t	2.17 KB	-rw-r--r--
debug.t	3.86 KB	-rw-r--r--
directive.t	4.76 KB	-rw-r--r--
directry.t	5.48 KB	-rw-r--r--
document.t	3.57 KB	-rw-r--r--
dumper.t	1.34 KB	-rw-r--r--
error.t	953 B	-rw-r--r--
evalperl.t	3.73 KB	-rw-r--r--
exception.t	1.52 KB	-rw-r--r--
factory.t	1.4 KB	-rw-r--r--
file.t	2.87 KB	-rw-r--r--
fileline.t	2.96 KB	-rw-r--r--
filter.t	17.76 KB	-rw-r--r--
foreach.t	10.32 KB	-rw-r--r--
format.t	1.8 KB	-rw-r--r--
html.t	2.51 KB	-rw-r--r--
image.t	2.22 KB	-rw-r--r--
include.t	6.04 KB	-rw-r--r--
iterator.t	3.67 KB	-rw-r--r--
leak.t	5.01 KB	-rw-r--r--
list.t	4.41 KB	-rw-r--r--
macro.t	2.93 KB	-rw-r--r--
math.t	1.22 KB	-rw-r--r--
math_rand.t	476 B	-rw-r--r--
mtime-zero.t	1.04 KB	-rw-r--r--
object.t	7.23 KB	-rw-r--r--
outline.t	2.29 KB	-rw-r--r--
output.t	2.66 KB	-rw-r--r--
parser.t	4.74 KB	-rw-r--r--
parser2.t	981 B	-rw-r--r--
plugins.t	6.12 KB	-rw-r--r--
plusfile.t	1.91 KB	-rw-r--r--
pod.t	2.05 KB	-rw-r--r--
prefix.t	1.46 KB	-rw-r--r--
proc.t	867 B	-rw-r--r--
process-relative.t	2.05 KB	-rw-r--r--
process.t	1.88 KB	-rw-r--r--
process_dir.t	1.84 KB	-rw-r--r--
provider.t	11.08 KB	-rw-r--r--
ref.t	1.63 KB	-rw-r--r--
scalar.t	2.56 KB	-rw-r--r--
service.t	5.07 KB	-rw-r--r--
skel.t	947 B	-rw-r--r--
stash-xs-unicode.t	1.83 KB	-rw-r--r--
stash-xs.t	8.23 KB	-rw-r--r--
stash.t	7.91 KB	-rw-r--r--
stashc.t	1.6 KB	-rw-r--r--
stop.t	2.53 KB	-rw-r--r--
strcat.t	758 B	-rw-r--r--
strict.t	1.52 KB	-rw-r--r--
string.t	7.38 KB	-rw-r--r--
switch.t	3.83 KB	-rw-r--r--
table.t	2.68 KB	-rw-r--r--
tags.t	3.43 KB	-rw-r--r--
template.t	1.49 KB	-rw-r--r--
text.t	2.89 KB	-rw-r--r--
throw.t	1.94 KB	-rw-r--r--
tiedhash.t	5.09 KB	-rw-r--r--
trace_vars.t	1.11 KB	-rw-r--r--
try.t	9.83 KB	-rw-r--r--
unicode.t	4.55 KB	-rw-r--r--
url.t	4.08 KB	-rw-r--r--
vars.t	11.36 KB	-rw-r--r--
varsv1.t	8.96 KB	-rw-r--r--
view.t	17.43 KB	-rw-r--r--
while.t	3.18 KB	-rw-r--r--
wrap.t	2.65 KB	-rw-r--r--
wrapper.t	3.95 KB	-rw-r--r--
zz-plugin-cycle.t	1.36 KB	-rw-r--r--
zz-plugin-leak-gh-213.t	2.77 KB	-rw-r--r--
zz-plugin-leak-rt-46691.t	2.95 KB	-rw-r--r--
zz-plugin-leak.t	2.02 KB	-rw-r--r--
zz-pmv.t	1.15 KB	-rw-r--r--
zz-pod-coverage.t	1.64 KB	-rw-r--r--
zz-pod-kwalitee.t	776 B	-rw-r--r--
zz-stash-xs-leak.t	1.59 KB	-rw-r--r--
zz-url2.t	3.72 KB	-rw-r--r--

Code Editor : object.t

#============================================================= -*-perl-*-
# t/object.t
#
# Template script testing code bindings to objects.
#
# 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::Exception;
use Template::Test;
$^W = 1;

$Template::Test::DEBUG = 0;

#------------------------------------------------------------------------
# definition of test object class
#------------------------------------------------------------------------

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

sub die {
    die "barfed up\n";
}

package TestObject;

our $AUTOLOAD;

sub new {
    my ($class, $params) = @_;
    $params ||= {};

bless {
        PARAMS  => $params,
        DAYS    => [ qw( Monday Tuesday Wednesday Thursday 
                         Friday Saturday Sunday ) ],
        DAY     => 0,
        'public'   => 314,
        '.private' => 425,
        '_hidden'  => 537,
    }, $class;
}

sub yesterday {
    my $self = shift;
    return "Love was such an easy game to play...";
}

sub today {
    my $self = shift;
    return "Live for today and die for tomorrow.";
}

sub tomorrow {
    my ($self, $dayno) = @_;
    $dayno = $self->{ DAY }++
        unless defined $dayno;
    $dayno %= 7;
    return $self->{ DAYS }->[$dayno];
}

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

sub concat {
    my $self = shift;
    local $" = ', ';
    $self->{ PARAMS }->{ args } = "ARGS: @_";
}

sub _private {
    my $self = shift;
    die "illegal call to private method _private()\n";
}

sub AUTOLOAD {
    my ($self, @params) = @_;
    my $name = $AUTOLOAD;
    $name =~ s/.*:://;
    return if $name eq 'DESTROY';

my $value = $self->{ PARAMS }->{ $name };
    if (ref($value) eq 'CODE') {
        return &$value(@params);
    }
    elsif (@params) {
        return $self->{ PARAMS }->{ $name } = shift @params;
    }
    else {
        return $value;
    }
}

#------------------------------------------------------------------------
# another object for testing auto-stringification
#------------------------------------------------------------------------

package Stringy;

use overload '""' => 'stringify', fallback => 1;

sub new {
    my ($class, $text) = @_;
    bless \$text, $class;
}

sub stringify {
    my $self = shift;
    return "stringified '$$self'";
}

#------------------------------------------------------------------------
# Another object for tracking down a bug with DBIx::Class where TT is 
# causing the numification operator to be called.  Matt S Trout suggests
# we've got a truth test somewhere that should be a defined but that 
# doesn't appear to be the case...
# http://rt.cpan.org/Ticket/Display.html?id=23763
#------------------------------------------------------------------------

package Numbersome;

use overload 
    '""' => 'stringify',
    '0+' => 'numify', 
    fallback => 1;

sub new {
    my ($class, $text) = @_;
    bless \$text, $class;
}

sub numify {
    my $self = shift;
    return "FAIL: numified $$self";
}

sub stringify {
    my $self = shift;
    return "PASS: stringified $$self";
}

sub things {
    return [qw( foo bar baz )];
}

package GetNumbersome;

sub new {
    my ($class, $text) = @_;
    bless { }, $class;
}

sub num {
    Numbersome->new("from GetNumbersome");
}

#------------------------------------------------------------------------
# main 
#------------------------------------------------------------------------

package main;

sub new {
    my ($class, $text) = @_;
    bless \$text, $class;
}

my $objconf = { 
    'a' => 'alpha',
    'b' => 'bravo',
    'w' => 'whisky',
};

my $replace = {
    thing  => TestObject->new($objconf),
    string => Stringy->new('Test String'),
    t1     => T1->new(a => 10),
    num    => Numbersome->new("Numbersome"),
    getnum => GetNumbersome->new,
    %{ callsign() },
};

test_expect(\*DATA, { INTERPOLATE => 1 }, $replace);

#------------------------------------------------------------------------
# test input
#------------------------------------------------------------------------

__DATA__
# test method calling via autoload to get parameters
[% thing.a %] [% thing.a %]
[% thing.b %]
$thing.w
-- expect --
alpha alpha
bravo
whisky

# ditto to set parameters
-- test --
[% thing.c = thing.b -%]
[% thing.c %]
-- expect --
bravo

-- test --
[% thing.concat = thing.b -%]
[% thing.args %]
-- expect --
ARGS: bravo

-- test --
[% thing.concat(d) = thing.b -%]
[% thing.args %]
-- expect --
ARGS: delta, bravo

-- test --
[% thing.yesterday %]
[% thing.today %]
[% thing.belief(thing.a thing.b thing.w) %]
-- expect --
Love was such an easy game to play...
Live for today and die for tomorrow.
Oh I believe in alpha and bravo and whisky.

-- test --
Yesterday, $thing.yesterday
$thing.today
${thing.belief('yesterday')}
-- expect --
Yesterday, Love was such an easy game to play...
Live for today and die for tomorrow.
Oh I believe in yesterday.

-- test --
[% thing.belief('fish' 'chips') %]
[% thing.belief %]
-- expect --
Oh I believe in fish and chips.
Oh I believe in <nothing>.

-- test --
${thing.belief('fish' 'chips')}
$thing.belief
-- expect --
Oh I believe in fish and chips.
Oh I believe in <nothing>.

-- test --
[% thing.tomorrow %]
$thing.tomorrow
-- expect --
Monday
Tuesday

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

#------------------------------------------------------------------------
# test private methods do not get exposed
#------------------------------------------------------------------------
-- test --
before[% thing._private %] mid [% thing._hidden %]after
-- expect --
before mid after

-- test --
[% key = '_private' -%]
[[% thing.$key %]]
-- expect --
[]

-- test --
[% key = '.private' -%]
[[% thing.$key = 'foo' %]]
[[% thing.$key %]]
-- expect --
[]
[]

#------------------------------------------------------------------------
# test auto-stringification
#------------------------------------------------------------------------

-- test --
[% string.stringify %]
-- expect --
stringified 'Test String'

-- test --
[% string %]
-- expect --
stringified 'Test String'

-- test --
[% "-> $string <-" %]
-- expect --
-> stringified 'Test String' <-

-- test --
[% "$string" %]
-- expect --
stringified 'Test String'

-- test --
foo $string bar
-- expect --
foo stringified 'Test String' bar

-- test --
.[% t1.dead %].
-- expect --
..

-- test --
.[% TRY; t1.die; CATCH; error; END %].
-- expect --
.undef error - barfed up
.

#-----------------------------------------------------------------------
# try and pin down the numification bug
#-----------------------------------------------------------------------

-- test --
[% FOREACH item IN num.things -%]
* [% item %]
[% END -%]
-- expect --
* foo
* bar
* baz

-- test --
[% num %]
-- expect --
PASS: stringified Numbersome

-- test --
[% getnum.num %]
-- expect --
PASS: stringified from GetNumbersome

${this.title}

Code Editor : object.t