Someone

package IRC::Parser::Mapped; 

# lay out event trapping, more efficiently WITHIN the parser itself.. so schedualing can be avoided,
# thus, saving CPU time 

use base 'IRC::Parser'; 

use Carp qw(croak); 

use strict;
use warnings;

my $INDEX = 0; 
use constant { 
  PM_OBJECT => $INDEX++,
  PM_ORIGIN => $INDEX++, 
  PM_COMMAND => $INDEX++, 
  PM_TARGET => $INDEX++, 
  PM_ARGS => $INDEX++, 
  PM_TEXT => $INDEX
};

use constant { 
  PM_OK => 1, 
}; 

use constant { 
  PRI_LOW => 10, 
  PRI_NORM => 25, 
  PRI_NORMAL => 25, 
  PRI_HIGH => 50, 
  PRI_CRITICAL => 100
};

use Exporter qw(import); 
our @EXPORT_OK = ((grep {/^(?:PM|PRI)_/} %IRC::Parser::Mapped::), 'handler'); 

our %EXPORT_TAGS = ( 
  constants => [ 
    grep {/^(?:PM|PRI)_/} %IRC::Parser::Mapped::
  ], 
);

$EXPORT_TAGS{all} = \@EXPORT_OK;


our $Map = {};
our $Verbose = 1; 


our $VERSION = '0.9a'; 

sub VERSION { 
  sprintf 
    '%s-%s +%s',
      __PACKAGE__, $VERSION, join '+', keys %$Map;  
} 


#signal('RAW', sub { call($_[PM_COMMAND], \@_); 1; }); #very simple, translate 'RAW' sigs to event map calls


sub handler { 
  my $name = ref $_[0] ? (caller)[0] : shift; 
  ref $_[0] eq 'HASH' 
    or croak "Event map supplied is not a hash reference"; 
  my($stack, $priority) = @_; 
  $priority = PRI_NORM
    unless defined $priority;
  my $tmp = {}; 
  foreach my $e (keys %$stack) { 
    $e =~ /^(?:\d{3}|[a-z]+)$/i 
      or croak "invalid key $e";
    my $handlers = ref $stack->{$e} eq 'ARRAY' ? $stack->{$e}  : [ $stack->{$e} ];  
    ref eq 'CODE'
      or croak "Not a code reference in event '$e'; handler $name"  
        foreach(@$handlers);
    push @{ $tmp->{uc($e)} }, @$handlers; 
  } 
  push @{ $Map->{$name} }, [ $tmp, $priority ]; 
  print "Registered '$name' (Priority: $priority)\n" 
    if $Verbose; 
 # _dump();
} 

# $Map = { 
#   'Some Template' => [ 
#     [ &some_handler, PRI_* ], [ &some_other_handler, PRI_* ], ... 
#   ] 
# } 

sub build { # this is a mess.. 
  @_ >= 1
    or croak "build what?";  
  my $self = shift; 
  exists $Map->{$_} 
    or croak "No such event map '$_'" 
      foreach(@_);
  unshift(@_, keys %$Map) 
    unless @_;  
  my(%exists, @unique);
  foreach my $key (@_) { 
    push @unique, 
      grep {!$exists{$_}++} keys %{ $_->[0] } 
        foreach(@{ $Map->{$key} });
  }
  my $stack = {}; 
  foreach my $event (@unique) { 
    my @current; 
    foreach(@_) { 
      STACK: foreach(@{ $Map->{$_} }) { 
        next STACK 
          unless exists $_->[0]->{$event}; 
        push @current, [ $_->[0]->{$event}, $_->[1] ]; 
      }
    } 
    push @{ $stack->{$event} }, @{ $_->[0] } 
      foreach(sort {$b->[1] <=> $a->[1]} @current);
  }  
  $self->{Stack} = $stack; 
} 

sub _dump { 
  local $\ = "\n"; 
  foreach my $temp (keys %$Map) { 
    print "\n - Template: $temp"; 
    foreach(sort {$b->[1] <=> $a->[1]} @{ $Map->{$temp} }) { 
      my($stack, $pri) = @$_; 
      print "\$stack=$stack\n\$pri=$pri\n";
      foreach(keys %$stack) { 
        print "\tevent: $_ => $stack->{$_}";
        print "\t\t\tsub $_" foreach(@{ $stack->{$_} }); 
      }  
    } 
  } 
  print "-----\n\n\n\n";
} 

# intentionally avoiding overriding the break() method
sub parse { 
  my $self = shift;
  my $command = (my $broken = $self->SUPER::break($_[1]))->[1];  
  $_->($self, @$broken) 
    foreach(@{ $self->{Stack}->{$command} }); 
  $_->($self, @$broken) 
    foreach(@{ $self->{Stack}->{DEBUG} });  
  wantarray() ? @$broken : $broken; 
}

1;