{
$Magpie::Matcher::VERSION = '1.131290';
}
#ABSTRACT: Multi-purpose Dispatcher Magic
use Moose;
use Scalar::Util qw(reftype);
has plack_request => (
is => 'ro',
isa => 'Plack::Request',
required => 1,
);
has match_candidates => (
traits => ['Array'],
is => 'rw',
isa => 'ArrayRef[ArrayRef]',
default => sub { [] },
handles => {
add_candidates => 'push',
},
);
has accept_matrix => (
traits => ['Array'],
is => 'rw',
isa => 'ArrayRef[ArrayRef]',
default => sub { [] },
);
sub make_map {
my $self = shift;
my $candidates = $self->match_candidates;
my $req = $self->plack_request;
my $env = $req->env;
my $path = $req->path_info;
my $out = {};
# this is expensive, so only do it once
my $accept_variant = HTTP::Negotiate::choose($self->accept_matrix, $req->headers);
foreach my $frame (@{ $candidates }) {
#warn "frame " . Dumper($frame);
my $match_type = $frame->[0];
my $token = $frame->[3] || '__default__';
$out->{$token} ||= [];
if ($match_type eq 'STRING') {
push @{$out->{$token}}, @{$frame->[2]} if $frame->[1] eq $path;
}
elsif ($match_type eq 'REGEXP' || ($match_type eq 'SCALAR' && re::is_regexp($frame->[0]) == 1 )) {
push @{$out->{$token}}, @{$frame->[2]} if $path =~ /$frame->[1]/;
}
elsif ($match_type eq 'CODE') {
my $temp = $frame->[1]->($env);
push @{$out->{$token}}, @{$temp};
}
elsif ($match_type eq 'HASH') {
my $rules = $frame->[1];
my $matched = 0;
foreach my $k (keys %{$rules} ) {
last unless defined $env->{$k};
my $val = $rules->{$k};
my $val_type = reftype $val;
if ($val_type &&
( $val_type eq 'REGEXP' || ($val_type eq 'SCALAR' && re::is_regexp($val) == 1 ))
) {
$matched++ if $env->{$k} =~ m/$val/;
}
else {
$matched++ if qq($env->{$k}) eq qq($val);
}
}
push @{$out->{$token}}, @{$frame->[2]} if $matched == scalar keys %{$rules};
}
elsif ($match_type eq 'AUTO') {
push @{$out->{$token}}, @{$frame->[2]};
}
elsif ($match_type eq 'ACCEPT') {
push @{$out->{$token}}, @{$frame->[2]} if length $accept_variant && $frame->[1] eq $accept_variant;
}
else {
warn "I don't know how to match '$match_type', skipping.\n"
}
}
return $out;
}
sub construct_pipeline {
my $self = shift;
my $tokenized = shift;
unless ($tokenized) {
$tokenized = ['__default__'];
}
my @new = ();
my $map = $self->make_map;
my @tokens = keys( %{$map} );
foreach my $step ( @{$tokenized} ) {
if ( grep { $_ eq $step } @tokens ) {
push @new, @{$map->{$step}};
}
else {
push @new, $step;
}
}
return \@new;
}
#SEEALSO: Magpie
1;
__END__
=pod
=head1 NAME
Magpie::Matcher - Multi-purpose Dispatcher Magic
=head1 VERSION
version 1.131290
=head1 AUTHORS
=over 4
=item *
Kip Hampton <kip.hampton@tamarou.com>
=item *
Chris Prather <chris.prather@tamarou.com>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by Tamarou, LLC.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut