File Coverage

blib/lib/Class/Adapter/Clear.pm
Criterion Covered Total %
statement 13 13 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 18 100.0


line stmt bran cond sub pod time code
1             package Class::Adapter::Clear;
2              
3             =pod
4              
5             =head1 NAME
6              
7             Class::Adapter::Clear - A handy base Adapter class that makes no changes
8              
9             =head1 SYNOPSIS
10              
11             B
12              
13             # Load and create the CGI
14             use CGI;
15             $q = new CGI;
16            
17             # Create the page
18             print $q->header, # HTTP Header
19             $q->start_html('hello world'), # Start the page
20             $q->h1('hello world'), # Hello World!
21             $q->end_html; # End the page
22              
23             B
24              
25             # Load and create the CGI
26             use CGI;
27             $q = new CGI;
28            
29             # Convert to an Adapter
30             use Class::Adapter::Clear;
31             $q = new Class::Adapter::Clear( $q );
32            
33             # Create the page
34             print $q->header, # HTTP Header
35             $q->start_html('hello world'), # Start the page
36             $q->h1('hello world'), # Hello World!
37             $q->end_html; # End the page
38              
39             B
40              
41             package My::CGI;
42            
43             use base 'Class::Adapter::Clear';
44            
45             # Optional - Create the thing we are decorating auto-magically
46             sub new {
47             my $class = shift;
48            
49             # Create the object we are decorating
50             my $query = CGI->new(@_);
51            
52             # Wrap it in the Adapter
53             $class->SUPER::new($query);
54             }
55            
56             # Decorate the h1 method to change what is created
57             sub h1 {
58             my $self = shift;
59             my $str = shift;
60            
61             # Do something before the real method call
62             if ( defined $str and $str eq 'hello world' ) {
63             $str = 'Hello World!';
64             }
65            
66             $self->_OBJECT_->($str, @_);
67             }
68            
69             =head1 DESCRIPTION
70              
71             C provides the base class for creating one common
72             type of L classes. For more power, move up to
73             L.
74              
75             On it's own C passes all methods through to the same
76             method in the parent object with the same parameters, responds to
77             C<-Eisa> like the parent object, and responds to C<-Ecan> like
78             the parent object.
79              
80             It looks like a C, and it quacks like a C.
81              
82             On this base, you simple implement whatever method you want to do
83             something special to.
84              
85             # Different method, same parameters
86             sub method1 {
87             my $self = shift;
88             $self->_OBJECT_->method2(@_); # Call a different method
89             }
90            
91             # Same method, different parameters
92             sub method1 {
93             my $self = shift;
94             $self->_OBJECT_->method1( lc($_[0]) ); # Lowercase the param
95             }
96            
97             # Same method, same parameters, tweak the result
98             sub method1 {
99             my $self = shift;
100             my $rv = $self->_OBJECT_->method1(@_);
101             $rv =~ s/\n/
\n/g; # Add line-break HTML tags at each newline
102             return $rv;
103             }
104              
105             As you can see, the advantage of this full-scale I approach,
106             compared to inheritance, or function wrapping (see L), is
107             that you have complete and utter freedom to do anything you might need
108             to do, without stressing the Perl inheritance model or doing anything
109             unusual or tricky with C references.
110              
111             You may never need this much power. But when you need it, you B
112             need it.
113              
114             As an aside, Class::Adapter::Clear is implemented with the following
115             L formula.
116              
117             use Class::Adapter::Builder
118             ISA => '_OBJECT_',
119             AUTOLOAD => 1;
120              
121             =head1 METHODS
122              
123             =head2 new $object
124              
125             As does the base L class, the default C constructor
126             takes a single object as argument and creates a new object which holds the
127             passed object.
128              
129             Returns a new C object, or C if you do not pass
130             in an object.
131              
132             =cut
133              
134 2     2   76194 use 5.005;
  2         10  
  2         84  
135 2     2   11 use strict;
  2         4  
  2         85  
136             use Class::Adapter::Builder
137 2         13 ISA => '_OBJECT_',
138 2     2   1462 AUTOLOAD => 1;
  2         3  
139              
140 2     2   13 use vars qw{$VERSION};
  2         3  
  2         119  
141             BEGIN {
142 2     2   68 $VERSION = '1.07';
143             }
144              
145             1;
146              
147             =pod
148              
149             =head1 SUPPORT
150              
151             Bugs should be reported via the CPAN bug tracker at
152              
153             L
154              
155             For other issues, contact the author.
156              
157             =head1 AUTHOR
158              
159             Adam Kennedy Eadamk@cpan.orgE
160              
161             =head1 SEE ALSO
162              
163             L, L
164              
165             =head1 COPYRIGHT
166              
167             Copyright 2005 - 2011 Adam Kennedy.
168              
169             This program is free software; you can redistribute
170             it and/or modify it under the same terms as Perl itself.
171              
172             The full text of the license can be found in the
173             LICENSE file included with this module.
174              
175             =cut