File Coverage

blib/lib/Test/Magpie/ArgumentMatcher.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Test::Magpie::ArgumentMatcher;
2             {
3             $Test::Magpie::ArgumentMatcher::VERSION = '0.11';
4             }
5             # ABSTRACT: Various templates to catch arguments
6              
7 2     2   10415 use strict;
  2         6  
  2         69  
8 2     2   11 use warnings;
  2         5  
  2         56  
9              
10 2     2   3829 use Devel::PartialDump;
  2         142899  
  2         17  
11 2     2   544 use Exporter qw( import );
  2         4  
  2         85  
12 2     2   3324 use MooseX::Types::Moose qw( Str CodeRef );
  0            
  0            
13             use Set::Object ();
14             use Test::Magpie::Util;
15              
16             use overload '""' => sub { $_[0]->{name} }, fallback => 1;
17              
18             our @EXPORT_OK = qw(
19             anything
20             custom_matcher
21             hash
22             set
23             type
24             );
25              
26             my $Dumper = Devel::PartialDump->new(pairs => 0);
27              
28             sub anything {
29             return __PACKAGE__->new(
30             name => 'anything()',
31             matcher => sub { return () },
32             );
33             }
34              
35             sub custom_matcher (&;) {
36             my ($test) = @_;
37             return __PACKAGE__->new(
38             name => "custom_matcher($test)",
39             matcher => sub {
40             local $_ = $_[0];
41             $test->(@_) ? () : undef
42             },
43             );
44             }
45              
46             sub hash {
47             my (%template) = @_;
48             return __PACKAGE__->new(
49             name => 'hash(' . $Dumper->dump(%template) . ')',
50             matcher => sub {
51             my %hash = @_;
52             for (keys %template) {
53             if (my $v = delete $hash{$_}) {
54             return unless Test::Magpie::Util::match($v, $template{$_});
55             }
56             else {
57             return;
58             }
59             }
60             return %hash;
61             },
62             );
63             }
64              
65             sub set {
66             my ($take) = Set::Object->new(@_);
67             return __PACKAGE__->new(
68             name => 'set(' . $Dumper->dump(@_) . ')',
69             matcher => sub {
70             return Set::Object->new(@_) == $take ? () : undef;
71             },
72             );
73             }
74              
75             sub type {
76             my ($type) = @_;
77             return __PACKAGE__->new(
78             name => "type($type)",
79             matcher => sub {
80             my ($arg, @in) = @_;
81             $type->check($arg) ? @in : undef
82             },
83             );
84             }
85              
86              
87             sub new {
88             my ($class, %args) = @_;
89             ### assert: defined $args{name}
90             ### assert: defined $args{matcher}
91             ### assert: ref( $args{matcher} ) eq 'CODE'
92              
93             return bless \%args, $class;
94             }
95              
96             sub match {
97             my ($self, @input) = @_;
98             return $self->{matcher}->(@input);
99             }
100              
101             1;
102              
103             __END__
104              
105             =pod
106              
107             =encoding utf-8
108              
109             =head1 NAME
110              
111             Test::Magpie::ArgumentMatcher - Various templates to catch arguments
112              
113             =head1 SYNOPSIS
114              
115             use Test::Magpie;
116             use Test::Magpie::ArgumentMatcher qw( anything );
117              
118             my $mock = mock;
119             $mock->push( button => 'red' );
120              
121             verify($mock)->push(anything);
122              
123             =head1 DESCRIPTION
124              
125             Argument matchers allow you to be more general in your specification to stubs
126             and verification. An argument matcher is an object that takes all remaining
127             paremeters of an invocation, consumes 1 or more, and returns the remaining
128             arguments back. At verification time, a invocation is verified if all arguments
129             have been consumed by all argument matchers.
130              
131             An argument matcher may return C<undef> if the argument does not pass
132             validation.
133              
134             =head2 Custom argument validators
135              
136             An argument validator is just a subroutine that is blessed as
137             C<Test::Magpie::ArgumentMatcher>. You are welcome to subclass this package if
138             you wish to use a different storage system (like a traditional hash-reference),
139             though a single sub routine is normally all you will need.
140              
141             =head2 Default argument matchers
142              
143             This module provides a set of common argument matchers, and will probably handle
144             most of your needs. They are all available for import by name.
145              
146             =head1 METHODS
147              
148             =head2 match @in
149              
150             Match an argument matcher against @in, and return a list of parameters still to
151             be consumed, or undef on validation.
152              
153             =head1 FUNCTIONS
154              
155             =head2 anything
156              
157             Consumes all remaining arguments (even 0) and returns none. This effectively
158             slurps in any remaining arguments and considers them valid. Note, as this
159             consumes I<all> arguments, you cannot use further argument validators after this
160             one. You are, however, welcome to use them before.
161              
162             =head2 custom_matcher { ...code.... }
163              
164             Creates a custom argument matcher for you. This argument matcher is assumed to
165             be the final argument matcher. If this matcher passes (that is, returns a true
166             value), then it is assumed that all remaining arguments have been matched.
167              
168             Custom matchers are code references. You can use $_ to reference to the first
169             argument, but a custom argument matcher may match more than one argument. It is
170             passed the contents of C<@_> that have not yet been matched, in essence.
171              
172             =head2 type $type_constraint
173              
174             Checks that a single value meets a given Moose type constraint. You may want to
175             consider the use of L<MooseX::Types> here for code clarity.
176              
177             =head2 hash %match
178              
179             Does deep comparison on all remaining arguments, and verifies that they meet the
180             specification in C<%match>. Note that this is for hashes, B<not> hash
181             references!
182              
183             =head2 set @values
184              
185             Compares that all remaining arguments match the set of values in C<@values>.
186             This allows you to compare objects out of order.
187              
188             Note: this currently uses real L<Set::Object>s to do the work which means
189             duplicate arguments B<are ignored>. For example C<1, 1, 2> will match C<1, 2>,
190             C<1, 2, 2>. This is probably a bug and I will fix it, but for now I'm mostly
191             waiting for a bug report - sorry!
192              
193             =for Pod::Coverage new match
194              
195             =head1 AUTHORS
196              
197             =over 4
198              
199             =item *
200              
201             Oliver Charles <oliver.g.charles@googlemail.com>
202              
203             =item *
204              
205             Steven Lee <stevenwh.lee@gmail.com>
206              
207             =back
208              
209             =head1 COPYRIGHT AND LICENSE
210              
211             This software is copyright (c) 2013 by Oliver Charles.
212              
213             This is free software; you can redistribute it and/or modify it under
214             the same terms as the Perl 5 programming language system itself.
215              
216             =cut