File Coverage

lib/Class/Loader.pm
Criterion Covered Total %
statement 46 57 80.7
branch 13 24 54.2
condition 5 11 45.5
subroutine 6 7 85.7
pod 1 1 100.0
total 71 100 71.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -sw
2             ##
3             ## Class::Loader
4             ##
5             ## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved.
6             ## This code is free software; you can redistribute it and/or modify
7             ## it under the same terms as Perl itself.
8             ##
9             ## $Id: Loader.pm,v 2.2 2001/07/18 20:21:39 vipul Exp $
10              
11             package Class::Loader;
12 3     3   172 use Data::Dumper;
  3         30  
  3         76  
13 3     3   56 use vars qw($VERSION);
  3         27  
  3         44  
14              
15             ($VERSION)  = '$Revision: 2.03 $' =~ /\s(\d+\.\d+)\s/;
16             my %MAPS = ();
17              
18             sub new {
19 0     0 1 0     return bless {}, shift;
20             }
21              
22              
23             sub _load {
24              
25 5     5   992     my ($self, $field, @source) = @_;
26 5 100       64     if ((scalar @source) % 2) {
27 2         22         unshift @source, $field;
28 2         23         $field = ""
29                 }
30              
31 5         51     local ($name, $module, $constructor, $args);
32 5         60     my %source = @source;
33 5   33     61     my $class = ref $self || $self;
34 5         44     my $object;
35              
36 5         54     for (keys %source) { ${lc($_)} = $source{$_} }
  10         90  
  10         113  
37              
38 5 100       61     if ($name) {
39 1   33     16         my $classmap = $self->_retrmap ($class) || return;
40 1   33     13         my $map = $$classmap{$name} || return;
41 1         12         for (keys %$map) { ${lc($_)} = $$map{$_} };
  2         18  
  2         24  
42                 }
43              
44 5 50       53     if ($module) {
45 5 50       360         unless (eval "require $module") {
46 0 0       0             if ($source{CPAN}) {
47 0         0                 require CPAN; CPAN->import;
  0         0  
48 0         0                 my $obj = CPAN::Shell->expand ('Module', $module);
49 0 0       0                 return unless $obj;
50 0         0                 $obj->install;
51 0 0       0                 eval "require $module" || return;
52 0         0             } else { return }
53                     }
54 5   100     145         $constructor ||= 'new';
55 5 100       67         if ($args) {
56 2         25             my $topass = __prepare_args ($args);
57 2 50       124             $object = eval "$module->$constructor($topass)" or return;
58 2         23             undef $topass; undef $args;
  2         20  
59 3 50       154         } else { $object = eval "$module->$constructor" or return }
60 0         0     } else { return }
61              
62 5 100       105     return $field ? $$self{$field} = $object : $object
63              
64             }
65              
66              
67             sub _storemap {
68 1     1   129     my ($self, %map) = @_;
69 1         10     my $class = ref $self;
70 1         12     for (keys %map) { $MAPS{$class}{$_} = $map{$_} }
  1         17  
71             }
72              
73              
74             sub _retrmap {
75 2     2   30     my ($self) = @_;
76 2         19     my $class = ref $self;
77 2 50       28     return $MAPS{$class} if $MAPS{$class};
78 0         0     return;
79             }
80              
81              
82             sub __prepare_args {
83              
84 2     2   30     my $topass = Dumper shift;
85 2         21     $topass =~ s/\$VAR1 = \[//;
86 2         62     $topass =~ s/];\s*//g;
87 2         25     $topass =~ m/(.*)/s;
88 2         28     $topass = $1;
89 2         24     return $topass;
90              
91             }
92              
93             1;
94              
95             =head1 NAME
96            
97             Class::Loader - Load modules and create objects on demand.
98            
99             =head1 VERSION
100            
101             $Revision: 2.2 $
102             $Date: 2001/07/18 20:21:39 $
103            
104             =head1 SYNOPSIS
105            
106             package Web::Server;
107             use Class::Loader;
108             @ISA = qw(Class::Loader);
109            
110             $self->_load( 'Content_Handler', {
111             Module => "Filter::URL",
112             Constructor => "new",
113             Args => [ ],
114             }
115             );
116            
117            
118             =head1 DESCRIPTION
119            
120             Certain applications like to defer the decision to use a particular module
121             till runtime. This is possible in perl, and is a useful trick in
122             situations where the type of data is not known at compile time and the
123             application doesn't wish to pre-compile modules to handle all types of
124             data it can work with. Loading modules at runtime can also provide
125             flexible interfaces for perl modules. Modules can let the programmer
126             decide what modules will be used by it instead of hard-coding their names.
127            
128             Class::Loader is an inheritable class that provides a method, _load(),
129             to load a module from disk and construct an object by calling its
130             constructor. It also provides a way to map modules names and
131             associated metadata with symbolic names that can be used in place of
132             module names at _load().
133            
134             =head1 METHODS
135            
136             =over 4
137            
138             =item B<new()>
139            
140             A basic constructor. You can use this to create an object of
141             Class::Loader, in case you don't want to inherit Class::Loader.
142            
143             =item B<_load()>
144            
145             _load() loads a module and calls its constructor. It returns the newly
146             constructed object on success or a non-true value on failure. The first
147             argument can be the name of the key in which the returned object is
148             stored. This argument is optional. The second (or the first) argument is a
149             hash which can take the following keys:
150            
151             =over 4
152            
153             =item B<Module>
154            
155             This is name of the class to load. (It is not the module's filename.)
156            
157             =item B<Name>
158            
159             Symbolic name of the module defined with _storemap(). Either one of Module
160             or Name keys must be present in a call to _load().
161            
162             =item B<Constructor>
163            
164             Name of the Module constructor. Defaults to "new".
165            
166             =item B<Args>
167            
168             A reference to the list of arguments for the constructor. _load() calls
169             the constructor with this list. If no Args are present, _load() will call
170             the constructor without any arguments.
171            
172             =item B<CPAN>
173            
174             If the Module is not installed on the local system, _load() can fetch &
175             install it from CPAN provided the CPAN key is present. This functionality
176             assumes availability of a pre-configured CPAN shell.
177            
178             =back
179            
180             =item B<_storemap()>
181            
182             Class::Loader maintains a class table that maps symbolic names to
183             parameters accepted by _load(). It takes a hash as argument whose keys are
184             symbolic names and value are hash references that contain a set of _load()
185             arguments. Here's an example:
186            
187             $self->_storemap ( "URL" => { Module => "Filter::URL",
188             Constructor => "foo",
189             Args => [qw(bar baz)],
190             }
191             );
192            
193             # time passes...
194            
195             $self->{handler} = $self->_load ( Name => 'URL' );
196            
197             =item B<_retrmap()>
198            
199             _retrmap() returns the entire map stored with Class::Loader. Class::Loader
200             maintains separate maps for different classes, and _retrmap() returns the
201             map valid in the caller class.
202            
203             =back
204            
205             =head1 SEE ALSO
206            
207             AnyLoader(3)
208            
209             =head1 AUTHOR
210            
211             Vipul Ved Prakash, E<lt>mail@vipul.netE<gt>
212            
213             =head1 LICENSE
214            
215             Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. This code is
216             free software; you can redistribute it and/or modify it under the same
217             terms as Perl itself.
218            
219             =cut
220              
221              
222