164 lines
3.7 KiB
Perl
164 lines
3.7 KiB
Perl
#============================================================= -*-Perl-*-
|
|
#
|
|
# Template::Plugin::Scalar
|
|
#
|
|
# DESCRIPTION
|
|
# Template Toolkit plugin module which allows you to call object methods
|
|
# in scalar context.
|
|
#
|
|
# AUTHOR
|
|
# Andy Wardley <abw@wardley.org>
|
|
#
|
|
# COPYRIGHT
|
|
# Copyright (C) 2008 Andy Wardley. All Rights Reserved.
|
|
#
|
|
# This module is free software; you can redistribute it and/or
|
|
# modify it under the same terms as Perl itself.
|
|
#
|
|
#============================================================================
|
|
|
|
package Template::Plugin::Scalar;
|
|
use base 'Template::Plugin';
|
|
use strict;
|
|
use warnings;
|
|
use Template::Exception;
|
|
use Scalar::Util qw();
|
|
|
|
our $VERSION = '3.009';
|
|
our $MONAD = 'Template::Monad::Scalar';
|
|
our $EXCEPTION = 'Template::Exception';
|
|
our $AUTOLOAD;
|
|
|
|
sub load {
|
|
my $class = shift;
|
|
my $context = shift;
|
|
|
|
# define .scalar vmethods for hash and list objects
|
|
$context->define_vmethod( hash => scalar => \&scalar_monad );
|
|
$context->define_vmethod( list => scalar => \&scalar_monad );
|
|
|
|
return $class;
|
|
}
|
|
|
|
sub scalar_monad {
|
|
# create a .scalar monad which wraps the hash- or list-based object
|
|
# and delegates any method calls back to it, calling them in scalar
|
|
# context, e.g. foo.scalar.bar becomes $MONAD->new($foo)->bar and
|
|
# the monad calls $foo->bar in scalar context
|
|
$MONAD->new(shift);
|
|
}
|
|
|
|
sub new {
|
|
my ($class, $context, @args) = @_;
|
|
# create a scalar plugin object which will lookup a variable subroutine
|
|
# and call it. e.g. scalar.foo results in a call to foo() in scalar context
|
|
my $self = bless {
|
|
_CONTEXT => $context,
|
|
}, $class;
|
|
return $self;
|
|
}
|
|
|
|
sub AUTOLOAD {
|
|
my $self = shift;
|
|
my $item = $AUTOLOAD;
|
|
$item =~ s/.*:://;
|
|
return if $item eq 'DESTROY';
|
|
|
|
# lookup the named values
|
|
my $stash = $self->{ _CONTEXT }->stash;
|
|
my $value = $stash->{ $item };
|
|
|
|
if (! defined $value) {
|
|
die $EXCEPTION->new( scalar => "undefined value for scalar call: $item" );
|
|
}
|
|
elsif (ref $value eq 'CODE') {
|
|
$value = $value->(@_);
|
|
}
|
|
return $value;
|
|
}
|
|
|
|
|
|
package Template::Monad::Scalar;
|
|
|
|
our $EXCEPTION = 'Template::Exception';
|
|
our $AUTOLOAD;
|
|
|
|
sub new {
|
|
my ($class, $this) = @_;
|
|
bless \$this, $class;
|
|
}
|
|
|
|
sub AUTOLOAD {
|
|
my $self = shift;
|
|
my $this = $$self;
|
|
my $item = $AUTOLOAD;
|
|
$item =~ s/.*:://;
|
|
return if $item eq 'DESTROY';
|
|
|
|
my $method;
|
|
if (Scalar::Util::blessed($this)) {
|
|
# lookup the method...
|
|
$method = $this->can($item);
|
|
}
|
|
else {
|
|
die $EXCEPTION->new( scalar => "invalid object method: $item" );
|
|
}
|
|
|
|
# ...and call it in scalar context
|
|
my $result = $method->($this, @_);
|
|
|
|
return $result;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Template::Plugin::Scalar - call object methods in scalar context
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
[% USE scalar %]
|
|
|
|
# TT2 calls object methods in array context by default
|
|
[% object.method %]
|
|
|
|
# force it to use scalar context
|
|
[% object.scalar.method %]
|
|
|
|
# also works with subroutine references
|
|
[% scalar.my_sub_ref %]
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The Template Toolkit calls user-defined subroutines and object methods
|
|
using Perl's array context by default. This plugin module provides a way
|
|
for you to call subroutines and methods in scalar context.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (C) 2008 Andy Wardley. All Rights Reserved.
|
|
|
|
This module is free software; you can redistribute it and/or
|
|
modify it under the same terms as Perl itself.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Template::Plugin>
|
|
|
|
=cut
|
|
|
|
# Local Variables:
|
|
# mode: perl
|
|
# perl-indent-level: 4
|
|
# indent-tabs-mode: nil
|
|
# End:
|
|
#
|
|
# vim: expandtab shiftwidth=4:
|