[perl5.git] / lib / CGI / Switch.pm

package CGI::Switch;
use Carp;
use strict;
use vars qw($VERSION @Pref);
$VERSION = '0.05';
@Pref = qw(CGI::Apache CGI); #default

sub import {
    my($self,@arg) = @_;
    @Pref = @arg if @arg;
}

sub new {
    shift;
    my($file,$pack);
    for $pack (@Pref) {
	($file = $pack) =~ s|::|/|g;
	eval { require "$file.pm"; };
	if ($@) {
#XXX	    warn $@;
	    next;
	} else {
#XXX	    warn "Going to try $pack\->new\n";
	    my $obj;
	    eval {$obj = $pack->new(@_)};
	    if ($@) {
#XXX		warn $@;
	    } else {
		return $obj;
	    }
	}
    }
    Carp::croak "Couldn't load+construct any of @Pref\n";
}

# there's a trick in Lincoln's package that determines the calling
# package.  The reason is to have a filehandle with the same name as
# the filename.  To tell this trick that we are not the calling
# package we have to follow this dirty convention. It's a questionable
# trick imho, but for now I want to have something working
sub isaCGI { 1 }

1;
__END__

=head1 NAME

CGI::Switch - Try more than one constructors and return the first object available

=head1 SYNOPSIS

 
 use CGISwitch;

  -or-

 use CGI::Switch This, That, CGI::XA, Foo, Bar, CGI;

 my $q = new CGI::Switch;

=head1 DESCRIPTION

Per default the new() method tries to call new() in the three packages
Apache::CGI, CGI::XA, and CGI. It returns the first CGI object it
succeeds with.

The import method allows you to set up the default order of the
modules to be tested.

=head1 SEE ALSO

perl(1), Apache(3), CGI(3), CGI::XA(3)

=head1 AUTHOR

Andreas König E<lt>a.koenig@mind.deE<gt>

=cut
Commit	Line	Data
54310121	1	package CGI::Switch;
	2	use Carp;
	3	use strict;
	4	use vars qw($VERSION @Pref);
	5	$VERSION = '0.05';
	6	@Pref = qw(CGI::Apache CGI); #default
	7
	8	sub import {
	9	my($self,@arg) = @_;
	10	@Pref = @arg if @arg;
	11	}
	12
	13	sub new {
	14	shift;
	15	my($file,$pack);
	16	for $pack (@Pref) {
	17	($file = $pack) =~ s\|::\|/\|g;
	18	eval { require "$file.pm"; };
	19	if ($@) {
	20	#XXX warn $@;
	21	next;
	22	} else {
	23	#XXX warn "Going to try $pack\->new\n";
	24	my $obj;
	25	eval {$obj = $pack->new(@_)};
	26	if ($@) {
	27	#XXX warn $@;
	28	} else {
	29	return $obj;
	30	}
	31	}
	32	}
	33	Carp::croak "Couldn't load+construct any of @Pref\n";
	34	}
	35
	36	# there's a trick in Lincoln's package that determines the calling
	37	# package. The reason is to have a filehandle with the same name as
	38	# the filename. To tell this trick that we are not the calling
	39	# package we have to follow this dirty convention. It's a questionable
	40	# trick imho, but for now I want to have something working
	41	sub isaCGI { 1 }
	42
	43	1;
	44	__END__
	45
	46	=head1 NAME
	47
	48	CGI::Switch - Try more than one constructors and return the first object available
	49
	50	=head1 SYNOPSIS
	51
	52
	53	use CGISwitch;
	54
	55	-or-
	56
	57	use CGI::Switch This, That, CGI::XA, Foo, Bar, CGI;
	58
	59	my $q = new CGI::Switch;
	60
	61	=head1 DESCRIPTION
	62
	63	Per default the new() method tries to call new() in the three packages
	64	Apache::CGI, CGI::XA, and CGI. It returns the first CGI object it
65	succeeds with.
66
67	The import method allows you to set up the default order of the
68	modules to be tested.
69
70	=head1 SEE ALSO
71
72	perl(1), Apache(3), CGI(3), CGI::XA(3)
73
74	=head1 AUTHOR
75
76	Andreas König E<lt>a.koenig@mind.deE<gt>
77
78	=cut