# ====================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Delay
#   Author: Jason Rhinelander
#   CVS Info :                          
#   $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