1package Path::Dispatcher::Rule; 2# ABSTRACT: predicate and codeblock 3 4our $VERSION = '1.08'; 5 6use Moo; 7use MooX::TypeTiny; 8use Types::Standard qw(Bool); 9use Path::Dispatcher::Match; 10 11use constant match_class => "Path::Dispatcher::Match"; 12 13has payload => ( 14 is => 'ro', 15 predicate => 'has_payload', 16); 17 18has prefix => ( 19 is => 'ro', 20 isa => Bool, 21 default => 0, 22); 23 24# support for deprecated "block" attribute 25sub block { shift->payload(@_) } 26sub has_block { shift->has_payload(@_) } 27around BUILDARGS => sub { 28 my $orig = shift; 29 my $self = shift; 30 31 my $args = $self->$orig(@_); 32 $args->{payload} ||= delete $args->{block} 33 if exists $args->{block}; 34 35 return $args; 36}; 37 38sub match { 39 my $self = shift; 40 my $path = shift; 41 my %args = @_; 42 43 my $result; 44 45 if ($self->prefix) { 46 $result = $self->_prefix_match($path); 47 } 48 else { 49 $result = $self->_match($path); 50 } 51 52 return if !$result; 53 54 if (ref($result) ne 'HASH') { 55 die "Results returned from _match must be a hashref"; 56 } 57 58 my $match = $self->match_class->new( 59 path => $path, 60 rule => $self, 61 %{ $args{extra_constructor_args} || {} }, 62 %$result, 63 ); 64 65 return $match; 66} 67 68sub complete { 69 return (); # no completions 70} 71 72sub _prefix_match { 73 my $self = shift; 74 return $self->_match(@_); 75} 76 77sub run { 78 my $self = shift; 79 80 my $payload = $self->payload; 81 82 die "No codeblock to run" if !$payload; 83 die "Payload is not a coderef" if ref($payload) ne 'CODE'; 84 85 $self->payload->(@_); 86} 87 88__PACKAGE__->meta->make_immutable; 89no Moo; 90 911; 92 93__END__ 94 95=pod 96 97=encoding UTF-8 98 99=head1 NAME 100 101Path::Dispatcher::Rule - predicate and codeblock 102 103=head1 VERSION 104 105version 1.08 106 107=head1 SYNOPSIS 108 109 my $rule = Path::Dispatcher::Rule::Regex->new( 110 regex => qr/^quit/, 111 block => sub { die "Program terminated by user.\n" }, 112 ); 113 114 $rule->match("die"); # undef, because "die" !~ /^quit/ 115 116 my $match = $rule->match("quit"); # creates a Path::Dispatcher::Match 117 118 $match->run; # exits the program 119 120=head1 DESCRIPTION 121 122A rule has a predicate and an optional codeblock. Rules can be matched (which 123checks the predicate against the path) and they can be ran (which invokes the 124codeblock). 125 126This class is not meant to be instantiated directly, because there is no 127predicate matching function. Instead use one of the subclasses such as 128L<Path::Dispatcher::Rule::Tokens>. 129 130=head1 ATTRIBUTES 131 132=head2 block 133 134An optional block of code to be run. Please use the C<run> method instead of 135invoking this attribute directly. 136 137=head2 prefix 138 139A boolean indicating whether this rule can match a prefix of a path. If false, 140then the predicate must match the entire path. One use-case is that you may 141want a catch-all rule that matches anything beginning with the token C<ticket>. 142The unmatched, latter part of the path will be available in the match object. 143 144=head1 METHODS 145 146=head2 match path -> match 147 148Takes a path and returns a L<Path::Dispatcher::Match> object if it matched the 149predicate, otherwise C<undef>. The match object contains information about the 150match, such as the results (e.g. for regex, a list of the captured variables), 151the C<leftover> path if C<prefix> matching was used, etc. 152 153=head2 run 154 155Runs the rule's codeblock. If none is present, it throws an exception. 156 157=head1 SUPPORT 158 159Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Path-Dispatcher> 160(or L<bug-Path-Dispatcher@rt.cpan.org|mailto:bug-Path-Dispatcher@rt.cpan.org>). 161 162=head1 AUTHOR 163 164Shawn M Moore, C<< <sartak at bestpractical.com> >> 165 166=head1 COPYRIGHT AND LICENSE 167 168This software is copyright (c) 2020 by Shawn M Moore. 169 170This is free software; you can redistribute it and/or modify it under 171the same terms as the Perl 5 programming language system itself. 172 173=cut 174