File Coverage

blib/lib/Class/Delay.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	1	2	50.0
condition	1	2	50.0
subroutine	7	7	100.0
pod			n/a
total	49	51	96.0

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__