181 lines
6.3 KiB
Perl
181 lines
6.3 KiB
Perl
# ====================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Delay
|
|
# Author: Jason Rhinelander
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: Delay.pm,v 1.4 2004/01/13 01:35:15 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ====================================================================
|
|
#
|
|
# Description:
|
|
# Generic delayed-loading module wrapper.
|
|
#
|
|
|
|
package GT::Delay;
|
|
use strict;
|
|
use Carp();
|
|
|
|
my %Delayed;
|
|
|
|
sub GT::Delay {
|
|
# We don't define any subroutines in GT::Delay, since even ->new should be
|
|
# allowed in some circumstances. Takes three arguments - the package to load
|
|
# (i.e. 'GT::SQL'), the type of blessed reference used for that object ('HASH',
|
|
# 'ARRAY', and 'SCALAR' are supported), and any number of arguments to pass
|
|
# into the ->new method of the package.
|
|
#
|
|
my ($package, $type, @args) = @_;
|
|
$type ||= 'HASH';
|
|
$type eq 'HASH' || $type eq 'ARRAY' || $type eq 'SCALAR' or Carp::croak('Unknown bless type: ' . $type . '. See the GT::Delay manpage');
|
|
|
|
my $self = bless($type eq 'HASH' ? {} : $type eq 'ARRAY' ? [] : \my $foo);
|
|
$Delayed{$self} = [$package, $type, \@args];
|
|
$self;
|
|
}
|
|
|
|
AUTOLOAD {
|
|
# When a method is called we create a real object, copy it into $self, and
|
|
# rebless $self into the package. This has to be done to get around a case
|
|
# such as: my $foo = GT::Delay(...); my $bar = $foo; $bar->meth;
|
|
# Even changing $_[0] would not affect $foo, and if $foo was used would result
|
|
# in _two_ of the delayed modules.
|
|
#
|
|
my $self = $_[0];
|
|
my ($package, $type, $args) = @{delete $Delayed{$self}};
|
|
|
|
(my $module = $package) =~ s|::|/|g;
|
|
$module .= '.pm';
|
|
require $module;
|
|
|
|
my $copy = $package->new(@$args);
|
|
|
|
eval {
|
|
if ($type eq 'HASH') { %$self = %$copy }
|
|
elsif ($type eq 'ARRAY') { @$self = @$copy }
|
|
else { $$self = $$copy }
|
|
};
|
|
|
|
$@ and Carp::croak("$package type does not appear to be $type. Delayed loading failed");
|
|
|
|
bless $self, ref $copy;
|
|
|
|
my $method = substr($GT::Delay::AUTOLOAD, rindex($GT::Delay::AUTOLOAD, ':') + 1);
|
|
if (my $subref = $self->can($method)) {
|
|
goto &$subref;
|
|
}
|
|
elsif ($self->can('AUTOLOAD')) {
|
|
shift;
|
|
$self->$method(@_);
|
|
}
|
|
else {
|
|
Carp::croak(qq|Can't locate object method "$method" via package "| . ref($self) . '"');
|
|
}
|
|
}
|
|
|
|
DESTROY {
|
|
delete $Delayed{$_[0]} if exists $Delayed{$_[0]};
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Delay - Generic delayed module loading
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use GT::Delay;
|
|
|
|
my $obj = GT::Delay('GT::Foo', 'HASH', foo => "bar", bar => 12);
|
|
|
|
... # time passes without using $obj
|
|
|
|
$obj->method();
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module provides a simple way to handle delayed module loading in a fairly
|
|
generic way. Your object will only be a very lightweight GT::Delay object
|
|
until you call a method on it, at which point the desired module will be loaded,
|
|
your object will be changed into an object of the desired type.
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
There is only one usable function provided by this module, GT::Delay() (not
|
|
GT::Delay::Delay as this module attempts to leave the GT::Delay namespace as
|
|
empty as possible).
|
|
|
|
=head2 GT::Delay
|
|
|
|
GT::Delay is used to create a new delayed object. It takes at least two
|
|
arguments. The first is the package to load, such as 'GT::Foo' to require
|
|
GT/Foo.pm and create a new GT::Foo object. The second is the type of blessed
|
|
data structure a 'GT::Foo' object really is. This can be one of either 'HASH',
|
|
'ARRAY', or 'SCALAR'. Any additional arguments are kept and passed in as
|
|
arguments to the new() method of the object when created.
|
|
|
|
The object type ('HASH', 'ARRAY', or 'SCALAR') is needed is to get around a
|
|
caveat of references - if $a and $b both point to the same reference, $b cannot
|
|
be changed from $a - which makes it impossible to just get a new object and
|
|
replace $_[0] with that object, because although that would change one of
|
|
either $a or $b, it wouldn't change the other and you could easily end up with
|
|
two separate objects. When a method is called, the new object is created, then
|
|
copied into the original object which is then reblessed into the desired
|
|
package. This doesn't change either $a or $b, but rather changes the reference
|
|
they point to. You have to pass the object type because the reference must be
|
|
reblessed, but the underlying data type cannot change. Unfortunately, this
|
|
approach has a few caveats of its own, listed below.
|
|
|
|
=head1 CAVEATS and LIMITATIONS
|
|
|
|
Modules that are created by a method other than new() are not supported.
|
|
|
|
Modules that use a namespace different from the module location are not
|
|
supported. For example, a package Foo::Bar::Blah located in Foo/Bar.pm. If
|
|
you have such a module that would benefit from delayed loading, you need to
|
|
rethink your package/filename naming scheme, or not use this module. It _is_
|
|
possible to do this with a hack such as:
|
|
C<$INC{'Foo/Bar/Blah.pm'} = './Foo/Bar.pm';> - but other than for testing,
|
|
doing such a thing is strongly discouraged.
|
|
|
|
Objects cannot have their elements directly accessed - for example,
|
|
C<$obj-E<gt>{foo}>. But, since that is bad practise anyway, it isn't that much
|
|
of a limitation. That said, objects _can_ be accessed directly _after_ any
|
|
method has been called.
|
|
|
|
Modules that store a string or integer form of $self (GT::Config does this to
|
|
store object attributes) will not work, since the working object will not be
|
|
the same object create a new(), but rather a copy.
|
|
|
|
Modules with DESTROY methods that do things to references in $self (for
|
|
example, C<delete $self-E<gt>{foo}-E<gt>{bar}> - though C<delete
|
|
$self-E<gt>{foo}> would be safe) will most likely not work properly as the copy
|
|
is not deep - i.e. references are copied as-is.
|
|
|
|
Along the same lines as the previous point, the first object will be destroyed
|
|
before the first method call goes through, so modules that do things (e.g.
|
|
delete files, close filehandles, etc.) in DESTROY will most likely not work.
|
|
|
|
Any module that doesn't fall into any of the points above will be perfectly
|
|
well supported by this module.
|
|
|
|
=head1 MAINTAINER
|
|
|
|
Jason Rhinelander
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: Delay.pm,v 1.4 2004/01/13 01:35:15 jagerman Exp $
|
|
|
|
=cut
|