1#============================================================= -*-Perl-*-
2#
3# Template::Plugin::Scalar
4#
5# DESCRIPTION
6#   Template Toolkit plugin module which allows you to call object methods
7#   in scalar context.
8#
9# AUTHOR
10#   Andy Wardley   <abw@wardley.org>
11#
12# COPYRIGHT
13#   Copyright (C) 2008 Andy Wardley.  All Rights Reserved.
14#
15#   This module is free software; you can redistribute it and/or
16#   modify it under the same terms as Perl itself.
17#
18#============================================================================
19
20package Template::Plugin::Scalar;
21use base 'Template::Plugin';
22use strict;
23use warnings;
24use Template::Exception;
25use Scalar::Util qw();
26
27our $VERSION   = 1.00;
28our $MONAD     = 'Template::Monad::Scalar';
29our $EXCEPTION = 'Template::Exception';
30our $AUTOLOAD;
31
32sub load {
33    my $class   = shift;
34    my $context = shift;
35
36    # define .scalar vmethods for hash and list objects
37    $context->define_vmethod( hash => scalar => \&scalar_monad );
38    $context->define_vmethod( list => scalar => \&scalar_monad );
39
40    return $class;
41}
42
43sub scalar_monad {
44    # create a .scalar monad which wraps the hash- or list-based object
45    # and delegates any method calls back to it, calling them in scalar
46    # context, e.g. foo.scalar.bar becomes $MONAD->new($foo)->bar and
47    # the monad calls $foo->bar in scalar context
48    $MONAD->new(shift);
49}
50
51sub new {
52    my ($class, $context, @args) = @_;
53    # create a scalar plugin object which will lookup a variable subroutine
54    # and call it.  e.g. scalar.foo results in a call to foo() in scalar context
55    my $self = bless {
56        _CONTEXT => $context,
57    }, $class;
58    return $self;
59}
60
61sub AUTOLOAD {
62    my $self = shift;
63    my $item = $AUTOLOAD;
64    $item =~ s/.*:://;
65    return if $item eq 'DESTROY';
66
67    # lookup the named values
68    my $stash = $self->{ _CONTEXT }->stash;
69    my $value = $stash->{ $item };
70
71    if (! defined $value) {
72        die $EXCEPTION->new( scalar => "undefined value for scalar call: $item" );
73    }
74    elsif (ref $value eq 'CODE') {
75        $value = $value->(@_);
76    }
77    return $value;
78}
79
80
81package Template::Monad::Scalar;
82
83our $EXCEPTION = 'Template::Exception';
84our $AUTOLOAD;
85
86sub new {
87    my ($class, $this) = @_;
88    bless \$this, $class;
89}
90
91sub AUTOLOAD {
92    my $self = shift;
93    my $this = $$self;
94    my $item = $AUTOLOAD;
95    $item =~ s/.*:://;
96    return if $item eq 'DESTROY';
97
98    my $method;
99    if (Scalar::Util::blessed($this)) {
100        # lookup the method...
101        $method = $this->can($item);
102    }
103    else {
104        die $EXCEPTION->new( scalar => "invalid object method: $item" );
105    }
106
107    # ...and call it in scalar context
108    my $result = $method->($this, @_);
109
110    return $result;
111}
112
1131;
114
115__END__
116
117=head1 NAME
118
119Template::Plugin::Scalar - call object methods in scalar context
120
121=head1 SYNOPSIS
122
123    [% USE scalar %]
124
125    # TT2 calls object methods in array context by default
126    [% object.method %]
127
128    # force it to use scalar context
129    [% object.scalar.method %]
130
131    # also works with subroutine references
132    [% scalar.my_sub_ref %]
133
134=head1 DESCRIPTION
135
136The Template Toolkit calls user-defined subroutines and object methods
137using Perl's array context by default.  This plugin module provides a way
138for you to call subroutines and methods in scalar context.
139
140=head1 AUTHOR
141
142Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
143
144=head1 COPYRIGHT
145
146Copyright (C) 2008 Andy Wardley.  All Rights Reserved.
147
148This module is free software; you can redistribute it and/or
149modify it under the same terms as Perl itself.
150
151=head1 SEE ALSO
152
153L<Template::Plugin>
154
155=cut
156
157# Local Variables:
158# mode: perl
159# perl-indent-level: 4
160# indent-tabs-mode: nil
161# End:
162#
163# vim: expandtab shiftwidth=4:
164