use strict;
use warnings;

#here's where you set up your attribute handlers
use Monks::AttributeDispatcher
  Loud => sub { print "NOISY\n"; }
   , Boom => sub { print "BOOM\n"; }
  ;

#here's where you show off your handlers
sub foo: Loud method {
  print 1;
} 

sub bar : Loud Boom method {
    print "pling.\n";
}   

print "Attributes: ";
print join ', ', attributes::get(\&bar);
print "\n";

##</code><code>##

use strict;
use warnings;
package Monks::AttributeDispatcher;

sub import {
  my $sPackage = shift @_;
  my %hDispatch = ( @_ );

  print "caller=$caller dispatch=<@{[ %hDispatch ]}>\n";

  my $sFetch = "${caller}::FETCH_CODE_ATTRIBUTES";
  *{$sFetch} = sub { return keys %hDispatch; };


  my $sModify = "${caller}::MODIFY_CODE_ATTRIBUTES";
  *{$sModify} = sub {
    my $sPackage = shift @_;
    my $crSub = shift @_;

    foreach my $sAttribute (@_) {
      my $crAttribute = $hDispatch{$sAttribute};
      #print STDERR "attribute=<$sAttribute> sub=<$crAttribute>\n";
      &$crAttribute($sPackage, $crSub, $sAttribute)
        if defined($crAttribute);
    }
    return ();  #indicate all attributes were handled
  }
}




return 1;

##</code><code>##

use strict;
use warnings;

BEGIN {
  sub makeNoise {
    my ($sPackage, $crSub, $sAttribute) = @_;
    print "NOISY $sAttribute\n";
  }
}

use Monks::AttributeDispatcher
  Lion => \&makeNoise
  , Tiger => \&makeNoise
  , Bear => \&makeNoise
   , Boom => sub { print "BOOM\n"; }
  ;

sub foo: Boom {
  print 1;
} 

sub bar : Lion Tiger Bear Boom {
    print "pling.\n";
}