File Coverage

blib/lib/CGI/Application/Plugin/AnyCGI.pm

Criterion	Covered	Total	%
statement	12	57	21.0
branch	0	20	0.0
condition	0	5	0.0
subroutine	4	7	57.1
pod	1	1	100.0
total	17	90	18.8

## -------------------------------------------------------------------
## C::A::Plugin
##--------------------------------------------------------------------

package CGI::Application::Plugin::AnyCGI;
use strict;
use warnings;

=pod

=head1 NAME

CGI::Application::Plugin::AnyCGI - Use your favourite CGI::* module
with CGI::Application (instead of CGI.pm)

=head1 VERSION

Version 0.02

=cut

$CGI::Application::Plugin::AnyCGI::VERSION = '0.02';

## to enable debugging, set this to "1" or any other "true" value
$CGI::Application::Plugin::AnyCGI::DEBUG = 0;

our ( @ISA, $AUTOLOAD );

=pod

=head1 SYNOPSIS

In your L-based module:

    use base 'CGI::Application';
    use CGI::Application::Plugin::AnyCGI;

    sub cgiapp_get_query() {
        my $self = shift;
        return CGI::Application::Plugin::AnyCGI->new(
            cgi_modules => [ qw/ CGI::Minimal CGI::Simple / ],
            ## any other options given here are passed to the
            ## loaded CGI::* module
        );
    }


=head1 DESCRIPTION

This module allows to use (nearly) any CGI.pm compatible CGI::* module
with L. Just give a list of your preferred modules by
using the C option with L(). The modules are checked
in the same order they appear, so see it as a list of fallbacks.

If none of the modules in the C list can be loaded, the
Plugin silently loads L as a final fallback.

If a method is called that is not provided by the module currently in
use, it will be silently loaded from L. This may eat up
the "performance boost" you could have expected by using any other
CGI::* module for your application, but on the other hand you don't
have to worry about incompatibilities. ;)


=head1 METHODS

=head2 new

This is the only (public) method C provides. The one
and only parameter C uses is C.

=head3 Calling new() without any further options

If no additional options are passed, C returns an
instance of itself, with the loaded module pushed at it's @ISA. (So,
it acts as an empty subclass, just adding it's C method to
it's parent.)

B

    CGI::Application::Plugin::AnyCGI->new(
        cgi_modules => [ qw/ CGI::Minimal CGI::Simple / ]
    );

...returns an instance of CGI::Application::Plugin::AnyCGI, which
inherits all methods of C or C (or, as a
final fallback, of C).

=head3 Calling new() with further options

If you pass any options, an instance of the loaded CGI::* module is
created, passing all options (except C) to the
constructor. C then imports it's C method
to the loaded module, returning the instance it created.

Example:

    CGI::Application::Plugin::AnyCGI->new(
        cgi_modules => [ qw/ CGI::Simple / ],
        { 'foo'=>'1', 'bar'=>[2,3,4] }
    );

...creates an instance of C, passing some params for
initializing, and returns this instance to the caller.

B As the different CGI::* modules don't take the same
arguments to C, this may not work as expected, so it may be better
not to use this option.

=cut

#-------------------------------------------------------------------
# METHOD:     new
# + author:   Bianka Martinovic
# + reviewed: Bianka Martinovic
# + purpose:
#-------------------------------------------------------------------
sub new {
    my $caller = shift;
    my $class  = ref($caller) || $caller;

    my %args   = (
        cgi_modules => [ 'CGI::Minimal' ],
        @_
    );

    my $module;
    my $loaded;

    TRY:
    {
        foreach $module ( @{$args{'cgi_modules'}} ) {

            $CGI::Application::Plugin::AnyCGI::DEBUG and
                __PACKAGE__->_debug( "Trying module $module" );

            eval "use $module";

            if ( ! $@ ) {
                push @ISA, $module;
                $loaded = $module;
                $CGI::Application::Plugin::AnyCGI::DEBUG and
                    __PACKAGE__->_debug( "Loaded module $module" );
                last TRY;
            }

        }
    }   # TRY:

    unless ( $loaded ) {
        ## Fallback to CGI.pm (included in Perl Core)
        $CGI::Application::Plugin::AnyCGI::DEBUG and
            __PACKAGE__->_debug( "Fallback to CGI.pm" );
        eval "use CGI qw/:standard/";
        push @ISA, 'CGI';
        $loaded = 'CGI';
    }

    $CGI::Application::Plugin::AnyCGI::DEBUG and
        __PACKAGE__->_debug( "CGI module loaded: " . $loaded );

    delete $args{'cgi_modules'};

    if ( %args ) {
        my $self = $loaded->new( %args );
        no strict 'refs';
        *{ $loaded . '::AUTOLOAD' } = *CGI::Application::Plugin::AnyCGI::AUTOLOAD;
        return $self;
    }
    else {
        return bless {}, $class;
    }

}   # --- end sub new ---


#-------------------------------------------------------------------
#                  + + + + + PRIVATE + + + + +
#-------------------------------------------------------------------

=pod

=head1 DEBUGGING

This module provides some internal debugging. Any debug messages go to
STDOUT, so beware of enabling debugging when running in a web
environment. (This will end up with "Internal Server Error"s in most
cases.)

There are two ways to enable the debug mode:

=over 4

=item In the module

Find line

    $CGI::Application::Plugin::AnyCGI::DEBUG = 0;

and set it to any "true" value. ("1", "TRUE", ... )

=item From outside the module

Add this line B calling C:

    $CGI::Application::Plugin::AnyCGI::DEBUG = 1;

=back

=cut

#-------------------------------------------------------------------
# METHOD:     _debug
# + author:   Bianka Martinovic
# + reviewed: 07-11-14 Bianka Martinovic
# + purpose:  print out formatted _debug messages
#-------------------------------------------------------------------
sub _debug {
    my $self = shift;
    my $msg  = shift;

    my $dump;
    if ( @_ ) {
        if ( scalar ( @_ ) % 2 == 2 ) {
            %{ $dump } = ( @_ );
        }
        else {
            $dump = \@_;
        }
    }

    my ( $package, $line, $sub ) = (caller())[0,2,3];
    my ( $callerpackage, $callerline, $callersub )
        = (caller(1))[0,2,3];

    $sub ||= '-';

    print "\n",
          join( ' | ', $package, $line, $sub ),
          "\n\tcaller: ",
          join( ' | ', $callerpackage, $callerline, $callersub ),
          "\n\t$msg",
          "\n\n";

    #if ( $dump ) {
    #    print $self->_dump( $dump );
    #}

    return;
}   # --- end sub _debug ---

#-------------------------------------------------------------------
# METHOD:     AUTOLOAD
# + author:   Bianka Martinovic
# + reviewed: Bianka Martinovic
# + purpose:  autoloading methods missing in the current CGI module
#             by using CGI.pm
#-------------------------------------------------------------------
sub AUTOLOAD {
    my $self = shift;
    my ($method) = $AUTOLOAD =~ /^.*::(.*)$/;
    return if ( $method =~ /^DESTROY$/ );
    no strict 'refs';
    eval "use CGI qw/$method/";
    &$method(@_);
}   # --- end sub AUTOLOAD ---

1;

__END__