local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Template/Plugin/Scalar.pm

   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
  20 package Template::Plugin::Scalar;
  21 use base 'Template::Plugin';
  22 use strict;
  23 use warnings;
  24 use Template::Exception;
  25 use Scalar::Util qw();
  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     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
  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     $MONAD->new(shift);
  49 }
  50
  51 sub 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
  61 sub 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
  81 package Template::Monad::Scalar;
  82
  83 our $EXCEPTION = 'Template::Exception';
  84 our $AUTOLOAD;
  85
  86 sub new {
  87     my ($class, $this) = @_;
  88     bless \$this, $class;
  89 }
  90
  91 sub 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
 113 1;
 114
 115 __END__
 116
 117 =head1 NAME
 118
 119 Template::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
 136 The Template Toolkit calls user-defined subroutines and object methods
 137 using Perl's array context by default.  This plugin module provides a way
 138 for you to call subroutines and methods in scalar context.
 139
 140 =head1 AUTHOR
 141
 142 Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
 143
 144 =head1 COPYRIGHT
 145
 146 Copyright (C) 2008 Andy Wardley.  All Rights Reserved.
 147
 148 This module is free software; you can redistribute it and/or
 149 modify it under the same terms as Perl itself.
 150
 151 =head1 SEE ALSO
 152
 153 L<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: