File Coverage

lib/Template/Plugin/Scalar.pm
Criterion Covered Total %
statement 46 47 97.8
branch 6 10 60.0
condition n/a
subroutine 11 11 100.0
pod 2 3 66.6
total 65 71 91.5


line stmt bran cond sub pod time code
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
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              
20             package Template::Plugin::Scalar;
21 1     1   5 use base 'Template::Plugin';
  1         2  
  1         458  
22 1     1   7 use strict;
  1         2  
  1         29  
23 1     1   7 use warnings;
  1         2  
  1         25  
24 1     1   6 use Template::Exception;
  1         2  
  1         22  
25 1     1   7 use Scalar::Util qw();
  1         2  
  1         618  
26              
27             our $VERSION = 1.00;
28             our $MONAD = 'Template::Monad::Scalar';
29             our $EXCEPTION = 'Template::Exception';
30             our $AUTOLOAD;
31              
32             sub load {
33 1     1 1 2 my $class = shift;
34 1         2 my $context = shift;
35              
36             # define .scalar vmethods for hash and list objects
37 1         6 $context->define_vmethod( hash => scalar => \&scalar_monad );
38 1         5 $context->define_vmethod( list => scalar => \&scalar_monad );
39              
40 1         5 return $class;
41             }
42              
43             sub 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 3     3 0 53 $MONAD->new(shift);
49             }
50              
51             sub new {
52 3     3 1 8 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 3         19 my $self = bless {
56             _CONTEXT => $context,
57             }, $class;
58 3         17 return $self;
59             }
60              
61             sub AUTOLOAD {
62 1     1   4 my $self = shift;
63 1         3 my $item = $AUTOLOAD;
64 1         7 $item =~ s/.*:://;
65 1 50       5 return if $item eq 'DESTROY';
66            
67             # lookup the named values
68 1         14 my $stash = $self->{ _CONTEXT }->stash;
69 1         4 my $value = $stash->{ $item };
70              
71 1 50       10 if (! defined $value) {
    50          
72 0         0 die $EXCEPTION->new( scalar => "undefined value for scalar call: $item" );
73             }
74             elsif (ref $value eq 'CODE') {
75 1         7 $value = $value->(@_);
76             }
77 1         15 return $value;
78             }
79              
80              
81             package Template::Monad::Scalar;
82              
83             our $EXCEPTION = 'Template::Exception';
84             our $AUTOLOAD;
85              
86             sub new {
87 3     3   7 my ($class, $this) = @_;
88 3         67 bless \$this, $class;
89             }
90              
91             sub AUTOLOAD {
92 3     3   5 my $self = shift;
93 3         8 my $this = $$self;
94 3         7 my $item = $AUTOLOAD;
95 3         19 $item =~ s/.*:://;
96 3 50       11 return if $item eq 'DESTROY';
97              
98 3         6 my $method;
99 3 100       15 if (Scalar::Util::blessed($this)) {
100             # lookup the method...
101 2         15 $method = $this->can($item);
102             }
103             else {
104 1         10 die $EXCEPTION->new( scalar => "invalid object method: $item" );
105             }
106              
107             # ...and call it in scalar context
108 2         10 my $result = $method->($this, @_);
109              
110 2         17 return $result;
111             }
112              
113             1;
114              
115             __END__