diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Class/Loader.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Class/Loader.pm | 221 |
1 files changed, 221 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Class/Loader.pm b/Master/tlpkg/tlperl0/lib/Class/Loader.pm new file mode 100755 index 00000000000..ccb7251dab9 --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/Class/Loader.pm @@ -0,0 +1,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 + + |