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