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 |