File Coverage

blib/lib/Mojo/UserAgent/Mockable/Request/Compare.pm
Criterion Covered Total %
statement 103 108 95.3
branch 30 34 88.2
condition 5 6 83.3
subroutine 10 10 100.0
pod 1 1 100.0
total 149 159 93.7


line stmt bran cond sub pod time code
1 23     23   1735076 use 5.014;
  23         130  
2              
3             package Mojo::UserAgent::Mockable::Request::Compare;
4             $Mojo::UserAgent::Mockable::Request::Compare::VERSION = '1.57';
5             # VERSION
6              
7             # ABSTRACT: Helper class for Mojo::UserAgent::Mockable that compares two Mojo::Message::Request instances
8              
9              
10 23     23   150 use Carp;
  23         49  
  23         1563  
11 23     23   639 use Mojo::Base -base;
  23         176024  
  23         161  
12 23     23   5089 use Mojo::URL;
  23         12989  
  23         172  
13 23     23   3608 use Safe::Isa qw{$_isa};
  23         2554  
  23         13606  
14              
15             has compare_result => '';
16             has ignore_headers => sub { [] };
17             has ignore_body => '';
18             has ignore_userinfo => '';
19              
20             sub compare {
21 168     168 1 137609 my ($self, $r1, $r2) = @_;
22            
23 168 50       658 if (!$r1->$_isa('Mojo::Message::Request')) {
24 0         0 my $reftype = ref $r1;
25 0         0 croak qq{Cannot compare $reftype to Mojo::Message::Request};
26             }
27            
28 168 50       3125 if (!$r2->$_isa('Mojo::Message::Request')) {
29 0         0 my $reftype = ref $r2;
30 0         0 croak qq{Cannot compare Mojo::Message::Request to $reftype};
31             }
32              
33 168 100       2250 if ( $r1->method ne $r2->method ) {
34 1         10 $self->compare_result( sprintf q{Method mismatch: got '%s', expected '%s'}, $r1->method, $r2->method );
35 1         19 return 0;
36             }
37              
38 167 100       1698 if ( !$self->_compare_url( $r1->url, $r2->url ) ) {
39 83         409 return 0;
40             }
41              
42 84 100 100     327 if ( !$self->ignore_body && $r1->body ne $r2->body ) {
43 3         132 $self->compare_result('Body mismatch');
44 3         55 return 0;
45             }
46              
47 81 100       4188 if ($self->ignore_headers ne 'all') {
48 30         122 my $h1 = $r1->headers->to_hash;
49 30         2725 my $h2 = $r2->headers->to_hash;
50              
51 30         2251 for my $header (@{$self->ignore_headers}) {
  30         73  
52 10         56 delete $h1->{$header};
53 10         22 delete $h2->{$header};
54             }
55              
56 30 100       115 if (scalar keys %{$h1} ne scalar keys %{$h2}) {
  30         81  
  30         128  
57 2         11 $self->compare_result('Header count mismatch');
58 2         25 return 0;
59             }
60              
61 28         51 for my $header (keys %{$h1}) {
  28         86  
62 176 100       333 if (!defined $h2->{$header}) {
63 1         33 $self->compare_result(qq{Header "$header" mismatch: header not present in both requests.'});
64 1         18 return 0;
65             }
66              
67 175 100       397 if ($h1->{$header} ne $h2->{$header}) {
68 23     23   201 no warnings qw/uninitialized/;
  23         54  
  23         5394  
69 1         7 $self->compare_result(qq{Header "$header" mismatch: got '$h1->{$header}', expected '$h2->{$header}'});
70 1         13 return 0;
71             }
72             }
73             }
74              
75 77         544 $self->compare_result('');
76 77         659 return 1;
77             }
78              
79             sub _compare_url {
80 167     167   1242 my ($self, $u1, $u2) = @_;
81              
82 167 50       487 if (!ref $u1) {
83 0         0 $u1 = Mojo::URL->new($u1);
84             }
85 167         655 $u1 = $u1->to_abs;
86              
87 167 100       18181 if (!ref $u2) {
88 1         7 $u2 = Mojo::URL->new($u2);
89             }
90 167         575 $u2 = $u2->to_abs;
91              
92 23     23   183 no warnings qw/uninitialized/;
  23         52  
  23         11156  
93 167         14958 for my $key (qw/scheme userinfo host port fragment/) {
94 785         2129 my $ignore = sprintf 'ignore_%s', $key;
95 785 50 66     3177 next if $self->can($ignore) && $self->$ignore;
96              
97 785         2768 my $val1 = $u1->$key;
98 785         3350 my $val2 = $u2->$key;
99 785 100       3447 if ($val1 ne $val2) {
100 22         115 $self->compare_result(qq{URL $key mismatch: got "$val1", expected "$val2"});
101 22         238 return 0;
102             }
103             }
104            
105 145         454 my $p1 = Mojo::Path->new($u1->path);
106 145         3300 my $p2 = Mojo::Path->new($u2->path);
107 145 100       2811 if ($p1->to_string ne $p2->to_string) {
108 5         1220 my $val1 = $p1->to_string;
109 5         427 my $val2 = $p2->to_string;
110 5         475 $self->compare_result(qq{URL path mismatch: got "$val1", expected "$val2"});
111 5         83 return 0;
112             }
113              
114 140         27079 my $q1 = $u1->query->to_hash;
115 140         16514 my $q2 = $u2->query->to_hash;
116              
117 140 100       43103 if (scalar keys %{$q1} != scalar keys %{$q2}) {
  140         452  
  140         507  
118 2         5 my $count1 = scalar keys %{$q1};
  2         5  
119 2         4 my $count2 = scalar keys %{$q2};
  2         5  
120              
121 2         12 $self->compare_result(qq{URL query mismatch: parameter count mismatch: $count1 != $count2});
122 2         31 return 0;
123             }
124 138         273 for my $key (keys %{$q1}) {
  138         489  
125 572         1037 my $val1 = $q1->{$key};
126 572         991 my $val2 = $q2->{$key};
127              
128 572 100       1178 if ( ref $val2 eq 'ARRAY' ){
129 1         3 $val1 = join(",", sort { $a cmp $b } @{$val1});
  1         5  
  1         7  
130 1         2 $val2 = join(",", sort { $a cmp $b } @{$val2});
  1         4  
  1         3  
131             }
132              
133 572 100       1624 if ($val1 ne $val2) {
134 54         423 $self->compare_result(qq{URL query mismatch: for key "$key", got "$val1", expected "$val2"});
135 54         971 return 0;
136             }
137             }
138 23     23   526 use warnings qw/uninitialized/;
  23         58  
  23         2413  
139              
140 84         948 return 1;
141             }
142              
143             1;
144              
145             __END__
146              
147             =pod
148              
149             =encoding UTF-8
150              
151             =head1 NAME
152              
153             Mojo::UserAgent::Mockable::Request::Compare - Helper class for Mojo::UserAgent::Mockable that compares two Mojo::Message::Request instances
154              
155             =head1 VERSION
156              
157             version 1.57
158              
159             =head1 ATTRIBUTES
160              
161             =head2 compare_result
162              
163             The result of the last compare operation. It is only populated when two requests B<do not> match.
164              
165             =head2 ignore_userinfo
166              
167             Set this to a true value to ignore a mismatch in the L<userinfo|Mojo::URL/userinfo> portion of a transaction URL.
168              
169             =head2 ignore_body
170              
171             Set this to a true value to ignore a mismatch in the bodies of the two compared transactions
172              
173             =head1 METHODS
174              
175             =head2 compare
176              
177             Compare two instances of L<Mojo::Message::Request>.
178              
179             =head1 AUTHOR
180              
181             Kit Peters <popefelix@gmail.com>
182              
183             =head1 COPYRIGHT AND LICENSE
184              
185             This software is copyright (c) 2019 by Kit Peters.
186              
187             This is free software; you can redistribute it and/or modify it under
188             the same terms as the Perl 5 programming language system itself.
189              
190             =cut