File Coverage

blib/lib/Dispatch/Declare.pm

Criterion	Covered	Total	%
statement	31	39	79.4
branch	5	10	50.0
condition	0	4	0.0
subroutine	8	10	80.0
pod	4	4	100.0
total	48	67	71.6

package Dispatch::Declare;

use warnings;
use strict;
use Carp;

our $VERSION = '0.1.2';

sub import {
    no strict 'refs';
    *{ caller() . '::declare' }      = \&declare;
    *{ caller() . '::declare_once' } = \&declare;
    *{ caller() . '::undeclare' }    = \&undeclare;
    *{ caller() . '::run' }          = \&run;
    *{ caller() . '::dispatch' }     = \&dispatch;
}

my $stash = {};
my $once  = {};

sub declare($&) {
    my $key  = shift;
    my $code = shift;

    carp('Cannot modify declare_once field') && return
      if exists $once->{ uc $key };

    $stash->{ uc $key } = $code;
}

sub undeclare($) {
    my $key = shift;

    delete $stash->{ uc $key } if exists $stash->{ uc $key };
}

sub declare_once($&) {
    my $key  = shift;
    my $code = shift;

    carp('Cannot modify declare_once field') && return
      if exists $once->{ uc $key };
    declare $key => sub { $code };
    $once->{ uc $key }++;

    return 1;
}

sub run {
    my $key = shift;
    if ( exists $stash->{ uc $key } ) {
        return $stash->{ uc $key }->(@_);
    }
    elsif ( exists $stash->{'DEFAULT'} ) {
        return $stash->{'DEFAULT'}->(@_);
    }
}

*dispatch = *run;

1;    # Magic true value required at end of module
__END__