package Class::LazyObject;

use strict;
use warnings;

use Carp qw();

our $VERSION = 0.09_030;

use vars '$AUTOLOAD';

#We want to inflate calls to methods defined in UNIVERSAL, but we impl
+icitly inherit from UNIVERSAL.
#As long as we predeclare the methods here, they will override those i
+n UNIVERSAL, but since they are never defined, AUTOLOAD will be calle
+d:
use subs grep {defined UNIVERSAL::can(__PACKAGE__, $_)} keys %UNIVERSA
+L::;

sub AUTOLOAD
{
    my $self = $_[0]; #don't shift it, since we will need to access th
+is directly later.

    $AUTOLOAD =~ /.*::(\w+)/;    
    my $method = $1;
    
    my $class_method = (ref($self) || $self).'::Methods';#call all cla
+ss methods on this.
    
    if (($method eq 'new') && !ref($self))
    {
        #new was called on a class, rather than an object, so we shoul
+d actually construct ourselves, rather than passing this to whatever 
+we're proxying.
        return $class_method->new(@_);
    }
    
    ref($self) or return $class_method->$method(@_[ 1 .. $#_ ]); #If t
+his was called as a class method, pass it on to ::Methods but don't p
+ass OUR package name.
    
    print "Lazy...\n" if $class_method->get_classdata('debug');
    
    my $object; #this is the object we will eventually replace ourselv
+es with.
    
    if ( ref($$self) && UNIVERSAL::isa($$self, $class_method->get_clas
+sdata('class')) )
    {
        $object = $$self;
    }
    else
    {
        $object = $class_method->get_classdata('inflate')->($class_met
+hod->get_classdata('class'), $$self);
        $$self = $object; #don't create this again.
    }
    
    $_[0] = $object; #replace ourselves with the object.
        
    goto (
             UNIVERSAL::can($_[0], $method) || 
             $class_method->_prepareAUTOLOADRef($_[0], ref($_[0]).'::'
+.$method) || #UNIVERSAL::can can't detect if a method is AUTOLOADed, 
+so we have to.
             Carp::croak(sprintf qq{Can\'t locate object method "%s" v
+ia package "%s" }, $method, ref $_[0] )#Error message stolen from Cla
+ss::WhiteHole
         );
}    

sub DESTROY
{
    #You won't AUTOLOAD this! Muahahaha!
}


#class method to see whether something is lazy?
#class methods for original isa and can

#---------
package Class::LazyObject::Methods;
#stick all of our class methods here so we don't pollute Class::LazyOb
+ject's namespace.
#everything in this class should be called as class methods, NOT objec
+t methods.

use Carp::Clan '^Class::LazyObject(::|$)';
use Class::Data::TIN  qw(get_classdata);
use Class::ISA;

sub _findAUTOLOADPackage
{
    #Takes 1 argument, either an object or the name of a package.
    #Returns the name of the package containing the sub AUTOLOAD that 
+would be called when $first_arg->AUTOLOAD was called
    #In other words, it traverses the inheritance hierarchy the same w
+ay Perl does until it finds an AUTOLOAD, and returns the name of the 
+package containing the AUTOLOAD.
    #Returns undef if AUTOLOAD is not in the inheritance hierarchy.
    
    shift;#Don't care about our package name.
    
    my $object_or_package = shift;
    my $orig_class = ref($object_or_package) || $object_or_package;
    
    return undef unless UNIVERSAL::can($orig_class, 'AUTOLOAD');
    
    my @classes = (Class::ISA::self_and_super_path($orig_class), 'UNIV
+ERSAL');
    
    my $package;
    foreach my $class (@classes)
    {
        no strict 'refs';#Symbol table munging ahead
        $package = $class;
        last if defined(*{$package.'::AUTOLOAD';}{CODE});
    }
    
    return $package;
}

sub _prepareAUTOLOADRef
{
    #Takes 2 arguments:
    #    either an object or the name of a package
    #    the fully qualified method name to make AUTOLOAD think it was
+ called as a result of
    #Sets the appropriate package's $AUTOLOAD so that when the AUTOLOA
+D method is called on the first argument, it will think it was called
+ as a result of a call to the method specified by the second argument
+.
    #Returns the result of (UNIVERSAL::can($first_arg, 'AUTOLOAD'));
    
    my $class = shift;

    my ($object, $method) = @_;
    
    if (UNIVERSAL::can($object, 'AUTOLOAD'))#no point in doing any of 
+this if it can't AUTOLOAD.
    {
        my $package = $class->_findAUTOLOADPackage($object);
        
        {
            no strict 'refs';
            *{$package.'::AUTOLOAD'} = \$method;
        }
    }
    
    return UNIVERSAL::can($object, 'AUTOLOAD');
}

#defaults, these are overridable when someone calls ->inherit
Class::Data::TIN->new(__PACKAGE__,
    inflate => sub {return $_[0]->new_inflate($_[1]);},
    debug   => 1,
    );

sub inherit
{
    #calls to Class::LazyObject->inherit are forwarded here.
    
    my $class = shift; #don't care about our own package name.
    my %params = @_;
    
    my @required_params = qw(inflated_class deflated_class);
    
    foreach my $param (@required_params)
    {
        carp "You did not pass '$param', which is a required parameter
+." unless exists $params{$param};
    }
    
    my %param_map = ( #keys are key names in the parameters passed to 
+this function. Values are corrisponding class data names.
        inflated_class => 'class'
        );
        
    my %class_data = %params;
    delete @class_data{keys %param_map, 'deflated_class'};#we'll stick
+ these in with their appropriate names:
    @class_data{values %param_map} = @params{keys %param_map};#pass th
+e parameters whose names have changed
    
    
    my $method_package = $params{deflated_class}.'::Methods';
    
    {
        no strict 'refs'; #more symbol table munging
        push(@{$method_package.'::ISA'}, __PACKAGE__); #Create a packa
+ge to hold all the methods, that inherits from THIS class, or add thi
+s class to its inheritance if it does exist.  #Should this be $class 
+instead of __PACKAGE__
        #^Push is used instead of unshift so that someone can override
+ their ::Methods package with its own inheritence hierarchy, and meth
+ods will be called here only AFTER Perl finds they don't exist in the
+ overridden ISA.
    }
    
    Class::Data::TIN->new($method_package, %class_data);
}

sub new
{
    my ($own_package, $class, $id) = @_;#first argument is this method
+'s, class, not the lazy object's
    
    if (ref($id) && UNIVERSAL::isa($id, $own_package->get_classdata('c
+lass')))
    {
        croak "A Lazy Object's ID cannot be a an object of same class 
+(or of a class inherited from the one) it is proxying!";
    }

    return bless \$id, $class;
}        

1;

#LAUNDRY LIST:
 #LAZYNESS, impatience, hubris
 #should we document the $AUTOLOAD persistence thingy as a caveat?
 #CALLING AUTOLOAD on inflate
 #CAVEAT: can't distinguish between no id and an id of undef.
 #  -solve by storing a Class::LazyObject::NoID object instead of unde
+f?
 #Does goto propogate scalar/list context?
 #Lvalue subs?
__END__

=head1 NAME

Class::LazyObject - Deferred object construction

=head1 SYNOPSIS

    use Class::LazyObject;
    
    package Bob::Class::LazyObject;
    our @ISA = 'Class::LazyObject';
    
    Class::LazyObject->inherit(
        deflated_class => __PACKAGE__,
        inflated_class => 'Bob'
        inflate => sub {
                       my ($class, $id) = @_;
                       return $class->new($id);
                   }
        );  
    
    package main;
    
    my @bobs;
    foreach (0..10_000)#make 10 thousand lazy Bobs
    {
        push @bobs, Bob::Class::LazyObject->new($_);
    }
    
    # @bobs now contains lazy objects, not real Bobs.
    # No Bob objects have been constructed yet.
    
    my $single = $bobs[rand @bobs]; #rand returned 10
    
    $single->string;#returns 10.
    #Single is now an actual Bob object. Only one
    #Bob object has been constructed.
    
    
    package Bob;
    #It's really expensive to create Bob objects.
    
    sub string
    {
        #return the scalar passed to ->new()
    }
    
    #other Bob methods here

=head1 DESCRIPTION

Class::LazyObject allows you to create lazy objects. A lazy object hol
+ds the
place of another object, (Called the "inflated object"). The lazy obje
+ct turns
into the inflated object ("inflates") only after a method is called on
+ the lazy
object. After that, any variables holding the lazy object will hold th
+e inflated
object.

In other words, you can treat a lazy object just like the object it's 
+holding
the place of, and it won't turn into a real object until necessary. Th
+is also
means that the real object won't be constructed until necessary.

A lazy object takes up less memory than most other objects (it's even 
+smaller
than a blessed empty hash). Constructing a lazy object is also likely 
+to be
computationally cheaper than constructing an inflated object (especial
+ly if a
database is involved).

A lazy object can hold a scalar (called the "ID") that is passed to th
+e
constructor for the inflated object.

Note that I believe I've coined the term "lazy object".


=head1 WHY

When would you want to use lazy objects? Any time you have a large num
+ber of
objects, but you will only need to use some of them and throw the rest
+ of them
away.

=head2 Example

For example, say you have a class C<Word>.  A Word has a name, a part 
+of speech,
and a definition. Word's constructor is passed a name, and then it fet
+ches the
other information about the word from a database (which is a dictionar
+y and so
has thousands of words). C<$word_object-E<gt>others_with_this_pos()> r
+eturns an
array of all Words in the database with the same part of speech as $wo
+rd_object.

If you only want to pick 4 words at random that have the same part of 
+speech as
$word_object, hundreds of unnecessary Word objects might be created by
C<others_with_this_pos()>. Each of them would require information to b
+e
retrieved from the database, and stored in memory, only to be destroye
+d when the
array goes out of scope.

It would be much more efficient if C<others_with_this_pos()> returned 
+an array
of lazy objects, whose IDs were word names. Lazy objects take up less 
+memory
than Word objects and do not require a trip to the database when they 
+are
constructed. The 4 lazy objects that are actually used would turn into
+ Word
objects automatically when necessary.

=head2 But wait!

"But wait," you say, "that example doesn't make any sense!
C<others_with_this_pos()> should just return an array of word names. J
+ust pass
these word names to C<Word>'s constructor!"

Well, I don't know about you, but I use object orientation because I w
+ant to be
able to ignore implementation details. So if I ask for words, I want W
+ord
objects, not something else representing Word objects. I want to be ab
+le to call
methods on those Word objects.

C<Class::LazyObject> lets you have objects that are almost as small as
+ scalars
holding the word names. These objects can be treated exactly like Word
+ objects.
Once you call a method on any one of them, it suddenly B<is> a word ob
+ject.
Better yet, you don't have to know about any of this to use the lazy W
+ord
objects. As far as you know, they B<are> word objects.


=head1 SETUP

You need to create a lazy object class for each regular class you want
+ to
inflate to.

=over 4

=item 1. Create a class to hold lazy objects that inflate to a particu
+lar class.

    package Bob::Class::LazyObject;

Note that a package whose name is your package name with ::Methods app
+ended
(C<Bob::Class::LazyObject::Methods> for this example) is also automati
+cally
created by Class::LazyObject, so don't use a package with that name fo
+r
anything.


=item 2. Make the class inherit from Class::LazyObject.

    package Bob::Class::LazyObject;
    our @ISA = 'Class::LazyObject';


=item 3. Do some configuration

Call C<Class::LazyObject-E<gt>inherit()>.

It takes a series of named parameters (a hash). The only two required 
+parameters
are C<deflated_class> and C<inflated_class>. See L<"inherit"> for more
information.

    package Bob::Class::LazyObject;
    our @ISA = 'Class::LazyObject';
    
    Class::LazyObject->inherit(
        deflated_class => __PACKAGE__,
        inflated_class => 'Bob'
        );

When you call C<Class::LazyObject-E<gt>inherit()>, Class::LazyObject s
+ets some
class data in your lazy object class.

=item 4. Create an inflation constructor in the inflated class

In the class that the lazy object will inflate to, define a class meth
+od
C<new_inflate>.  This is called with a single parameter, the ID passed
+ to
C<Class::LazyObject-E<gt>new> when this particular lazy object was cre
+ated. (If
no ID was passed, C<undef> is passed to C<new_inflate>.) This method s
+hould be a
constructor for your class. It must return an object of the inflated c
+lass, or
of a class that inherits from the inflated class. (Unless the object i
+sa the
inflated class, bad things will happen.)

If you wish to have the inflation constructor be named something other
+ than
C<new_inflate>, or want it to be called in different way, see 
L<"THE INFLATE SUB">.

The reason C<new_inflate> is called by default rather than just C<new>
+ is so
that you can write C<new> to return lazy objects, unbeknownst to its c
+aller.

=back

That's all it takes to set up a lazy object class.

=head1 CLASS METHODS

Now that you've set up a lazy object class (if you haven't, see L<"SET
+UP">), how
do you actually make use of it?

The methods here are all class methods, and they must all be called on
+ a class
inherited from C<Class::LazyObject>. If you want to know about object 
+methods
instead, look at L<"OBJECT METHODS">.

=head2 C<new>

    new(ID)
    new()

C<Class::LazyObject-E<gt>new> takes one optional scalar parameter, the
+ object's
ID. This ID is passed to the inflation constructor when the lazy objec
+t
inflates.

Note that the ID I<cannot> be an object of the same class (or any clas
+s that
inherits from the class) that the lazy object inflates to.

=head2 C<inherit>

    inherit(deflated_class => __PACKAGE__, inflated_class => CLASS)
    
    inherit(deflated_class => __PACKAGE__, inflated_class => CLASS,
        inflate => CODE); #Optional

C<Class::LazyObject-E<gt>inherit> should only be called by any class t
+hat
inherits from Class::LazyObject. It takes a hash of named arguments. O
+nly the
C<deflated_class> and C<inflated_class> arguments are required. The ar
+guments
are:

=over 4

=item deflated_class

B<Required>. The package the lazy object should be in before inflating
+, in other
words, the class that's calling C<inherit>. You should almost always j
+ust set
this to C<__PACKAGE__>.

=item inflated_class

B<Required>. The package the lazy object should inflate into.

=item inflate

B<Optional>. Takes a reference to a subroutine. This subroutine will b
+e called
when the lazy object inflates. See L<"THE INFLATE SUB"> for more infor
+mation.
This allows you to override the default inflation behavior. By default
+, when a
lazy object inflates, C<Inflated::Class-E<gt>new_inflate> is called an
+d passed
the lazy object's ID as an argument.

=back

=head1 OBJECT METHODS

None, except an AUTOLOAD that catches calls to any other methods.

Calling any method on a lazy object will inflate it and call that meth
+od on the
inflated object.

=head1 THE INFLATE SUB

You should pass a reference to a sub as the value of the C<inflate> pa
+rameter of
L<the C<inherit> class method|"inherit">. This sub is called when the 
+lazy
object needs to be inflated.

The inflate sub is passed two parameters: the name of the class to inf
+late into,
and the ID passed to the lazy object's constructor.

The inflate sub should return a newly constructed object.

If you supply an inflate parameter to inherit, you override the defaul
+t inflate
sub, which is:

    sub {my ($class, $id) = @_; return $class->new_inflate($id);}

But you could define your inflate sub to do whatever you want. 


=head1 IMPLEMENTATION

A lazy object is a blessed scalar containing the ID to be passed to th
+e
inflation constructor. AUTOLOAD is used to intercept calls to methods.
+ When a
method is called on a lazy object, it calls the inflation constructor 
+on the
neccesary class, and sets $_[0] to the newly created object, replacing
+ the lazy
object with the full object. The full object is also stored in the ble
+ssed
scalar, so that if any other variables hold references to the lazy obj
+ect, they
can be given the already created full object when they call a method o
+n the lazy
object.

Additional chicanery takes place so that calls to methods inherited fr
+om
C<UNIVERSAL> are intercepted, and so that C<AUTOLOAD>ed methods of the
+ inflated
object are called correctly.

=head1 CAVEATS

=head2 The ID cannot be an object of the same class as the inflated cl
+ass or any class that inherits from the inflated class.

=head2 The C<DESTROY> method does not cause inflation.

There's no way (either that, or it's very difficult) to tell whether t
+he
C<DESTROY> method has been explicitly invoked on a lazy object, or whe
+ther Perl
is just trying to destroy the object. It is, however, unlikely that yo
+u would
need to explicitly call C<DESTROY> on any of your objects anyway. I ma
+y later
add capability to change this behavior.

=head2 C<use Class::LazyObject> B<after> C<use>ing any module that put
+s subs in C<UNIVERSAL>.

C<Class::LazyObject> has to do extra work to handle calls on lazy obje
+cts to
methods defined in C<UNIVERSAL>. It does this work when you C<use
Class::LazyObject>. Therefore, if you add any subs to C<UNIVERSAL> (wi
+th
C<UNIVERSAL::exports>, C<UNIVERSAL::moniker>, or C<UNIVERSAL::require>
+, for
example), only C<use Class::LazyObject> B<afterwards>.

=head2 Explicitly calling C<AUTOLOAD> on a lazy object may not do what
+ you expect.

If you never explictly call C<$a_lazy_object-E<gt>AUTOLOAD>, this cave
+at does
not apply to you. (Calling C<AUTOLOAD>ed methods, on the other hand, i
+s fine.)

If you set $AUTOLOAD in a package with a hardcoded value (because you 
+think you
know in which package the AUTOLOAD sub is defined for a particular cla
+ss) and
then call C<$a_lazy_object-E<gt>AUTOLOAD>, the object will inflate, bu
+t a
different method will be called on the inflated object than you intend
+ed. If
you're trying to spoof calls to AUTOLOAD, you should really be searchi
+ng through
the inheritance heirarchy of the object (with the help of something li
+ke
Class::ISA) until you find the package that the object's AUTOLOAD meth
+od is
defined in, and then set that package's $AUTOLOAD. (In fact, Class::La
+zyObject
does this kind of AUTOLOAD search itself.)

I will most likely revise this caveat to make more sense.

=head1 BUGS

(The difference between bugs and L<caveats|"CAVEATS"> is that I plan t
+o fix the
bugs.)

=head2 Objects with C<overload>ed operators

Currently, lazy objects will not intercept overloaded operators. This 
+means that
if your inflated object uses overloaded operators, you cannot use a la
+zy object
in its place. This may be fixed in future versions by using a combinat
+ion of
C<nomethod> and C<overload::Method>. See L<overload> to learn more abo
+ut
overloaded operators.

=head2 C<UNIVERSAL::isa> and C<UNIVERSAL::can>

Currently, C<UNIVERSAL::isa($a_lazy_object,
'Class::The::Lazy::Object::Inflates::To')> is false, though
C<$a_lazy_object-E<gt>isa> will do the right thing. Similarly,
C<UNIVERSAL::can($a_lazy_object, 'method')> won't work like it's suppo
+sed to,
but C<$a_lazy_object-E<gt>can> I<will> work correctly. This may be fix
+ed in a
future release.

=head2 Objects implementing C<tie>d datatypes

C<Class::LazyObject> has not yet been tested with objects that implime
+nt C<tie>d
datatypes. It may very well work, and then again, it may not. Explicit
+ support
may be added in a future release. See L<perltie> to learn more about C
+<tie>s.

=head1 AUTHOR

Daniel C. Axelrod, daxelrod@cpan.org

=head1 SEE ALSO

=head2 http://perlmonks.org/index.pl?node_id=279940

Fergal Daly had the idea for lazy objects before I did. Note that I ha
+d the idea
independently, but subsequently discovered his posting.

=head2 L<Class::Data::TIN>

=head2 L<Class::ISA>


=head1 COPYRIGHT

Copyright (c) 2003, Daniel C. Axelrod. All Rights Reserved.

This program is free software; you can redistribute it and/or modify i
+t under
the same terms as Perl itself.

=cut
[download]