summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl.straw/lib/Class/Loader.pm
blob: ccb7251dab9432e0f5abb8196cfa395d80a70118 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
#!/usr/bin/perl -sw
##
## Class::Loader
##
## Copyright (c) 2001, Vipul Ved Prakash.  All rights reserved.
## This code is free software; you can redistribute it and/or modify
## it under the same terms as Perl itself.
##
## $Id: Loader.pm,v 2.2 2001/07/18 20:21:39 vipul Exp $

package Class::Loader;
use Data::Dumper;
use vars qw($VERSION);

($VERSION)  = '$Revision: 2.03 $' =~ /\s(\d+\.\d+)\s/; 
my %MAPS = ();

sub new { 
    return bless {}, shift;
}


sub _load { 

    my ($self, $field, @source) = @_;
    if ((scalar @source) % 2) { 
        unshift @source, $field;
        $field = ""
    }

    local ($name, $module, $constructor, $args);
    my %source = @source;
    my $class = ref $self || $self;
    my $object;

    for (keys %source) { ${lc($_)} = $source{$_} }

    if ($name) { 
        my $classmap = $self->_retrmap ($class) || return;
        my $map = $$classmap{$name} || return;
        for (keys %$map) { ${lc($_)} = $$map{$_} };
    } 

    if ($module) { 
        unless (eval "require $module") { 
            if ($source{CPAN}) { 
                require CPAN; CPAN->import;
                my $obj = CPAN::Shell->expand ('Module', $module);
                return unless $obj;
                $obj->install; 
                eval "require $module" || return;
            } else { return }
        }
        $constructor ||= 'new';
        if ($args) { 
            my $topass = __prepare_args ($args);
            $object = eval "$module->$constructor($topass)" or return;
            undef $topass; undef $args;
        } else { $object = eval "$module->$constructor" or return }
    } else { return }

    return $field ? $$self{$field} = $object : $object

}


sub _storemap { 
    my ($self, %map) = @_;
    my $class = ref $self;
    for (keys %map) { $MAPS{$class}{$_} = $map{$_} }
}


sub _retrmap { 
    my ($self) = @_; 
    my $class = ref $self;
    return $MAPS{$class} if $MAPS{$class};
    return;
}


sub __prepare_args { 

    my $topass = Dumper shift;
    $topass =~ s/\$VAR1 = \[//; 
    $topass =~ s/];\s*//g; 
    $topass =~ m/(.*)/s;
    $topass = $1;
    return $topass;

}

1;

=head1 NAME

Class::Loader - Load modules and create objects on demand.

=head1 VERSION

    $Revision: 2.2 $
    $Date: 2001/07/18 20:21:39 $

=head1 SYNOPSIS

    package Web::Server;
    use Class::Loader; 
    @ISA = qw(Class::Loader);
    
    $self->_load( 'Content_Handler', { 
                             Module => "Filter::URL",
                        Constructor => "new",
                               Args => [ ],
                         } 
                );
    

=head1 DESCRIPTION

Certain applications like to defer the decision to use a particular module
till runtime. This is possible in perl, and is a useful trick in
situations where the type of data is not known at compile time and the
application doesn't wish to pre-compile modules to handle all types of
data it can work with. Loading modules at runtime can also provide
flexible interfaces for perl modules. Modules can let the programmer
decide what modules will be used by it instead of hard-coding their names.

Class::Loader is an inheritable class that provides a method, _load(),
to load a module from disk and construct an object by calling its
constructor. It also provides a way to map modules names and
associated metadata with symbolic names that can be used in place of
module names at _load().

=head1 METHODS

=over 4

=item B<new()>

A basic constructor. You can use this to create an object of
Class::Loader, in case you don't want to inherit Class::Loader.

=item B<_load()>

_load() loads a module and calls its constructor. It returns the newly
constructed object on success or a non-true value on failure. The first
argument can be the name of the key in which the returned object is
stored. This argument is optional. The second (or the first) argument is a
hash which can take the following keys:

=over 4

=item B<Module>

This is name of the class to load. (It is not the module's filename.)

=item B<Name> 

Symbolic name of the module defined with _storemap(). Either one of Module
or Name keys must be present in a call to _load().

=item B<Constructor>

Name of the Module constructor. Defaults to "new".

=item B<Args>

A reference to the list of arguments for the constructor. _load() calls
the constructor with this list. If no Args are present, _load() will call
the constructor without any arguments.

=item B<CPAN>

If the Module is not installed on the local system, _load() can fetch &
install it from CPAN provided the CPAN key is present. This functionality
assumes availability of a pre-configured CPAN shell.

=back

=item B<_storemap()>

Class::Loader maintains a class table that maps symbolic names to
parameters accepted by _load(). It takes a hash as argument whose keys are
symbolic names and value are hash references that contain a set of _load()
arguments. Here's an example:

    $self->_storemap ( "URL" => { Module => "Filter::URL", 
                                  Constructor => "foo", 
                                  Args => [qw(bar baz)], 
                                }
                     );

    # time passes...

    $self->{handler} = $self->_load ( Name => 'URL' );

=item B<_retrmap()>

_retrmap() returns the entire map stored with Class::Loader. Class::Loader
maintains separate maps for different classes, and _retrmap() returns the
map valid in the caller class.

=back

=head1 SEE ALSO

AnyLoader(3)

=head1 AUTHOR

Vipul Ved Prakash, E<lt>mail@vipul.netE<gt>

=head1 LICENSE

Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. This code is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=cut