The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
package Class::Delay;
require Class::Delay::Message;
our $VERSION = '0.02';

sub import {
    my $package = caller;
    my $class   = shift;
    my %args    = @_;

    my @delayed;
    my @methods = @{ $args{methods} };
    my $return  = $args{return} || 1;
    for my $method (@methods) {
        no strict 'refs';
        *{"$package\::$method"} = sub {
            push @delayed, Class::Delay::Message->new({
                package    => $package,
                method     => $method,
                args       => [ @_ ],
                is_trigger => 0,
            });
            return $return;
        };
    }

    my $reorder = $args{reorder};
    my @triggers = @{ $args{release} };
    for my $method (@triggers) {
        my $sub = sub {
            my $self = shift;
            # delete our placeholders
            for my $method (@methods, @triggers) {
                no strict 'refs';
                local *newglob;
                *{"$package\::$method"} = *newglob;
            }

            push @delayed, Class::Delay::Message->new({
                package    => $package,
                method     => $method,
                args       => [ $self, @_ ],
                is_trigger => 1,
            });

            @delayed = $reorder->( @delayed ) if $reorder;
            # redispatch them in their new order
            $_->resume for @delayed;
            return $return;
        };

        no strict 'refs';
        *{"$package\::$method"} = $sub;
    }
}

1;
__END__

=head1 NAME

Class::Delay - delay method dispatch until a trigerring event

=head1 SYNOPSIS

 package PrintOut;
 sub write {
    my $self = shift;
    print "printing: ", @_, "\n";
 }
 sub flush {
    print "flushed\n";
 }

 package DelayedPrint;
 use base 'PrintOut';
 use Class::Delay
    methods => [ 'write' ],
    release => [ 'flush' ];

 package main;

 DelayedPrint->write( "we'll write this later" ); # won't get through
                                                  # to PrintOuts 'write' yet
 DelayedPrint->write( "this too" );
 DelayedPrint->flush;  # all of the queued call are dispatched
 DelayedPrint->write( "this won't be delayed" );

=head1 DESCRIPTION

Class::Delay provides a mechanism for the delay of method dispatch
until a triggering method is called.

You simply define a proxy class, and then call on the module to set up
a set of methods that will defer.

=head2 Options

The use statement takes the following options when generate the
proxying behaviour.

=over

=item methods

An array reference naming the methods to delay until a trigger event.

=item return

What a delayed method will return, defaults to 1.

=item release

An array reference naming the methods to ise as triggering events.

=item reorder

A subroutine that will be passed the all the delayed messages as
L<Class::Delay::Message> objects.  The routine should return these in
the order that the messagages are to be deilvered.

For example, if we want to ensure our trigger event arrives before the
rest of the events we may do something like this:

 use Class::Delay
    methods => [qw( foo bar baz )],
    release => [qw( quux squirkle )],
    reorder => sub { sort { $b->is_trigger <=> $a->is_trigger } @_ };

=back

An extended example of this module is in L<Mariachi::DBI> which uses
the module to delay database setup until the final of the database is
known.

=head1 AUTHOR

Richard Clamp <richardc@unixbeard.net>

=head1 COPYRIGHT

Copyright (C) 2003 Richard Clamp. All Rights Reserved.

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

=cut