File Coverage

blib/lib/Class/Adapter/Clear.pm

Criterion	Covered	Total	%
statement	8	8	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	11	11	100.0

package Class::Adapter::Clear;
# ABSTRACT: A handy base Adapter class that makes no changes

#pod =pod
#pod
#pod =head1 SYNOPSIS
#pod
#pod B
#pod
#pod   # Load and create the CGI
#pod   use CGI;
#pod   $q = new CGI;
#pod
#pod   # Create the page
#pod   print $q->header,                    # HTTP Header
#pod         $q->start_html('hello world'), # Start the page
#pod         $q->h1('hello world'),         # Hello World!
#pod         $q->end_html;                  # End the page
#pod
#pod B
#pod
#pod   # Load and create the CGI
#pod   use CGI;
#pod   $q = new CGI;
#pod
#pod   # Convert to an Adapter
#pod   use Class::Adapter::Clear;
#pod   $q = new Class::Adapter::Clear( $q );
#pod
#pod   # Create the page
#pod   print $q->header,                    # HTTP Header
#pod         $q->start_html('hello world'), # Start the page
#pod         $q->h1('hello world'),         # Hello World!
#pod         $q->end_html;                  # End the page
#pod
#pod B
#pod
#pod   package My::CGI;
#pod
#pod   use base 'Class::Adapter::Clear';
#pod
#pod   # Optional - Create the thing we are decorating auto-magically
#pod   sub new {
#pod       my $class = shift;
#pod
#pod       # Create the object we are decorating
#pod       my $query = CGI->new(@_);
#pod
#pod       # Wrap it in the Adapter
#pod       $class->SUPER::new($query);
#pod   }
#pod
#pod   # Decorate the h1 method to change what is created
#pod   sub h1 {
#pod   	my $self = shift;
#pod   	my $str  = shift;
#pod
#pod     # Do something before the real method call
#pod     if ( defined $str and $str eq 'hello world' ) {
#pod     	$str = 'Hello World!';
#pod     }
#pod
#pod     $self->_OBJECT_->($str, @_);
#pod   }
#pod
#pod =head1 DESCRIPTION
#pod
#pod C provides the base class for creating one common
#pod type of L classes. For more power, move up to
#pod L.
#pod
#pod On it's own C passes all methods through to the same
#pod method in the parent object with the same parameters, responds to
#pod C<-Eisa> like the parent object, and responds to C<-Ecan> like
#pod the parent object.
#pod
#pod It looks like a C, and it quacks like a C.
#pod
#pod On this base, you simple implement whatever method you want to do
#pod something special to.
#pod
#pod   # Different method, same parameters
#pod   sub method1 {
#pod       my $self = shift;
#pod       $self->_OBJECT_->method2(@_); # Call a different method
#pod   }
#pod
#pod   # Same method, different parameters
#pod   sub method1 {
#pod       my $self = shift;
#pod       $self->_OBJECT_->method1( lc($_[0]) ); # Lowercase the param
#pod   }
#pod
#pod   # Same method, same parameters, tweak the result
#pod   sub method1 {
#pod       my $self = shift;
#pod       my $rv = $self->_OBJECT_->method1(@_);
#pod       $rv =~ s/\n/\n/g; # Add line-break HTML tags at each newline
#pod       return $rv;
#pod   }
#pod
#pod As you can see, the advantage of this full-scale I approach,
#pod compared to inheritance, or function wrapping (see L), is
#pod that you have complete and utter freedom to do anything you might need
#pod to do, without stressing the Perl inheritance model or doing anything
#pod unusual or tricky with C references.
#pod
#pod You may never need this much power. But when you need it, you B
#pod need it.
#pod
#pod As an aside, Class::Adapter::Clear is implemented with the following
#pod L formula.
#pod
#pod   use Class::Adapter::Builder
#pod       ISA      => '_OBJECT_',
#pod       AUTOLOAD => 1;
#pod
#pod =head1 METHODS
#pod
#pod =head2 new $object
#pod
#pod As does the base L class, the default C constructor
#pod takes a single object as argument and creates a new object which holds the
#pod passed object.
#pod
#pod Returns a new C object, or C if you do not pass
#pod in an object.
#pod
#pod =cut

use 5.005;
use strict;
use Class::Adapter::Builder
	ISA      => '_OBJECT_',
	AUTOLOAD => 1;

our $VERSION = '1.09';

1;

__END__