view release on metacpan or  search on metacpan

lib/Exporter/Dispatch.pm  view on Meta::CPAN

package Exporter::Dispatch;
use Carp qw(croak);
our $VERSION = 2.10;

sub import {
    my $pkg = (caller)[0];
    if (@_ > 2) {
        croak 'Incorrect import list for Exporter::Dispatch';
    }
    elsif ($_[-1] eq 'create_dptable') {
        *{"${pkg}::create_dptable"} = \&create_dptable;
        return
    }
    elsif ($_[-1] eq 'dptable_alias') {
        *{"${pkg}::dptable_alias"} = sub {
            *{"${pkg}::$_[1]"} = *{"${pkg}::$_[0]"}
        }
    }
    elsif (@_ == 2) {
        croak 'Incorrect import list for Exporter::Dispatch';
    }
    *{"${pkg}::create_dptable"} = sub { create_dptable($pkg) };
}

sub create_dptable {
    my $pkg = shift;
    my %dispatch;
    my @oksymbols = grep {   !/^_/
                          && !/^dptable_alias$/
                          && !/^create_dptable$/
                          && defined *{"${pkg}::$_"}{CODE} }
                    keys %{*{"${pkg}::"}};
    $dispatch{$_} = *{"${pkg}::$_"}{CODE}
        foreach ( @oksymbols );
    return \%dispatch
};

1;

=head1 NAME

Exporter::Dispatch

=head1 ABSTRACT

Simple and modular creation of dispatch tables.

=head1 SYNOPSIS

    package TestPkg;
    use Exporter::Dispatch qw(dptable_alias);
    dptable_alias("sub_a", "sub_aa"); # typeglobbing for dummies;
    
    sub sub_a { ... }
    sub sub_b { ... }
    sub sub_c { ... }
    sub _sub_c_helper { # not part of the table!
        # ...
    }
    
    package main;
    my $table = create_dptable TestPkg; # or TestPkg::create_dptable();
    $table->{'sub_c'}->("Hello!");
    
    # ------------------------------------------------------
    # or