File Coverage

lib/Template/Plugin/Procedural.pm
Criterion Covered Total %
statement 31 33 93.9
branch 4 10 40.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 43 51 84.3


line stmt bran cond sub pod time code
1             #==============================================================================
2             #
3             # Template::Plugin::Procedural
4             #
5             # DESCRIPTION
6             # A Template Plugin to provide a Template Interface to Data::Dumper
7             #
8             # AUTHOR
9             # Mark Fowler
10             #
11             # COPYRIGHT
12             # Copyright (C) 2002 Mark Fowler. All Rights Reserved
13             #
14             # This module is free software; you can redistribute it and/or
15             # modify it under the same terms as Perl itself.
16             #
17             #==============================================================================
18              
19             package Template::Plugin::Procedural;
20              
21 1     1   567 use strict;
  1         1  
  1         60  
22 1     1   6 use warnings;
  1         2  
  1         48  
23 1     1   7 use base 'Template::Plugin';
  1         2  
  1         388  
24              
25             our $VERSION = 1.17;
26             our $DEBUG = 0 unless defined $DEBUG;
27             our $AUTOLOAD;
28              
29             #------------------------------------------------------------------------
30             # load
31             #------------------------------------------------------------------------
32              
33             sub load {
34 2     2 1 5 my ($class, $context) = @_;
35              
36             # create a proxy namespace that will be used for objects
37 2         6 my $proxy = "Template::Plugin::" . $class;
38              
39             # okay, in our proxy create the autoload routine that will
40             # call the right method in the real class
41 1     1   5 no strict "refs";
  1         2  
  1         263  
42 2 50       3 unless( defined( *{ $proxy . "::AUTOLOAD" } ) ) {
  2         11  
43 2         18 *{ $proxy . "::AUTOLOAD" } = sub {
44             # work out what the method is called
45 5     5   110 $AUTOLOAD =~ s!^.*::!!;
46              
47 5 50       13 print STDERR "Calling '$AUTOLOAD' in '$class'\n"
48             if $DEBUG;
49              
50             # look up the sub for that method (but in a OO way)
51 5         40 my $uboat = $class->can($AUTOLOAD);
52              
53             # if it existed call it as a subroutine, not as a method
54 5 50       15 if ($uboat) {
55 5         8 shift @_;
56 5         16 return $uboat->(@_);
57             }
58              
59 0 0       0 print STDERR "Eeek, no such method '$AUTOLOAD'\n"
60             if $DEBUG;
61              
62 0         0 return "";
63 2         15 };
64             }
65              
66             # create a simple new method that simply returns a blessed
67             # scalar as the object.
68 2 50       4 unless( defined( *{ $proxy . "::new" } ) ) {
  2         13  
69 2         10 *{ $proxy . "::new" } = sub {
70 2     2   3 my $this;
71 2         15 return bless \$this, $_[0];
72 2         7 };
73             }
74              
75 2         7 return $proxy;
76             }
77              
78             1;
79              
80             __END__