Barely Used Perl Untapped resources of the perl core libraries #20

Example 2

package Dispatch::Declare::Attr;

use strict;
use warnings;

use Attribute::Handlers;

my %stash = ();

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

sub UNIVERSAL::Dispatch : ATTR(CODE) {
    my ( $package, $symbol, $referent, $attr, $data, $phase ) = @_;

    my $name = $data || *$symbol{NAME};

    $stash{ uc $name } = $referent;

}

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

package main;

use Dispatch::Declare::Attr;

print run 'plan9';

sub plan_nine : Dispatch('plan9') {
    return  'Clata verata nicto' . "\n";
}
continued...
Copyright © 2007 Robert Boone