File Coverage

blib/lib/DNS/BL/cmds/connect.pm

Criterion	Covered	Total	%
statement	34	41	82.9
branch	3	8	37.5
condition			n/a
subroutine	10	10	100.0
pod	1	1	100.0
total	48	60	80.0

package DNS::BL::cmds::connect;

use DNS::BL;

use 5.006001;
use strict;
use warnings;

use vars qw/@ISA/;

@ISA = qw/DNS::BL::cmds/;

use Carp;

our $VERSION = '0.00_01';
$VERSION = eval $VERSION;  # see L

# Preloaded methods go here.

=pod

=head1 NAME

DNS::BL::cmds::connect - Implement the connect command for DNS::BL

=head1 SYNOPSIS

  use DNS::BL::cmds::connect;

=head1 DESCRIPTION

This module implements the connect command, to be used by
L. This command uses a backend class to perform low level
operations on the L stable storage.

The following methods are implemented by this module:

=over

=item C<-Eexecute()>

See L for information on this method's purpose.

The connect command follows a syntax such as

  connect  ...

Where  must be defined in a class such as

  DNS::BL::cmds::connect::

This class will be Cd and then, its C method invoked
following the same protocol outlined in L. The B
token will be removed before invoking the C method of the
specific class.

Any prior C information will be destroyed before attempting
the C.

=cut

sub execute
{
    my $bl	= shift;
    my $command	= shift;

    unless (@_)
    {
	return wantarray ? (&DNS::BL::DNSBL_ESYNTAX(),
			    "Must supply a back end type (dbi, etc)")
	    : &DNS::BL::DNSBL_ESYNTAX();
    }

    my $type	= shift;

    # Start by removing any previous handler. _connect is used to store
    # a possible reference to an object or handle
    {
	no strict 'refs';
	$bl->set('_' . $_, undef) for qw(_connect read match write
					 erase commit);
    }

    # Attempt to load the required module
    eval "use " . __PACKAGE__ . "::$type;";

    if ($@)
    {
	return wantarray ? (&DNS::BL::DNSBL_ESYNTAX(),
			    "Failed to connect to $type: $@")
	    : &DNS::BL::DNSBL_ESYNTAX();

    }

    # If succesful, eat the 'connect' token and pass control
    # to the corresponding class
    {
	no strict 'refs';
	my $name = __PACKAGE__ . "::${type}::execute";
	return *{$name}->($bl, $type, @_);
    }
};

1;
__END__