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 25     25   1519461 use 5.014;
  25         120  
2              
3             $Mojo::UserAgent::Mockable::Request::Compare::VERSION = '1.59';
4             # VERSION
5              
6             # ABSTRACT: Helper class for Mojo::UserAgent::Mockable that compares two Mojo::Message::Request instances
7              
8              
9             use Carp;
10 25     25   149 use Mojo::Base -base;
  25         44  
  25         1373  
11 25     25   522 use Mojo::URL;
  25         148083  
  25         140  
12 25     25   4924 use Safe::Isa qw{$_isa};
  25         12182  
  25         199  
13 25     25   2955  
  25         2056  
  25         15849  
14             has compare_result => '';
15             has ignore_headers => sub { [] };
16             has ignore_body => '';
17             has ignore_userinfo => '';
18              
19             my ($self, $r1, $r2) = @_;
20            
21 238     238 1 91671 if (!$r1->$_isa('Mojo::Message::Request')) {
22             my $reftype = ref $r1;
23 238 50       936 croak qq{Cannot compare $reftype to Mojo::Message::Request};
24 0         0 }
25 0         0
26             if (!$r2->$_isa('Mojo::Message::Request')) {
27             my $reftype = ref $r2;
28 238 50       4514 croak qq{Cannot compare Mojo::Message::Request to $reftype};
29 0         0 }
30 0         0  
31             if ( $r1->method ne $r2->method ) {
32             $self->compare_result( sprintf q{Method mismatch: got '%s', expected '%s'}, $r1->method, $r2->method );
33 238 100       3137 return 0;
34 1         8 }
35 1         18  
36             if ( !$self->_compare_url( $r1->url, $r2->url ) ) {
37             return 0;
38 237 100       2168 }
39 137         617  
40             if ( !$self->ignore_body && $r1->body ne $r2->body ) {
41             $self->compare_result('Body mismatch');
42 100 100 100     376 return 0;
43 3         108 }
44 3         30  
45             if ($self->ignore_headers ne 'all') {
46             my $h1 = $r1->headers->to_hash;
47 97 100       5030 my $h2 = $r2->headers->to_hash;
48 26         112  
49 26         2308 for my $header (@{$self->ignore_headers}) {
50             delete $h1->{$header};
51 26         1831 delete $h2->{$header};
  26         66  
52 10         49 }
53 10         20  
54             if (scalar keys %{$h1} ne scalar keys %{$h2}) {
55             $self->compare_result('Header count mismatch');
56 26 100       98 return 0;
  26         72  
  26         89  
57 2         7 }
58 2         20  
59             for my $header (keys %{$h1}) {
60             if (!defined $h2->{$header}) {
61 24         46 $self->compare_result(qq{Header "$header" mismatch: header not present in both requests.'});
  24         71  
62 155 100       256 return 0;
63 1         5 }
64 1         11  
65             if ($h1->{$header} ne $h2->{$header}) {
66             no warnings qw/uninitialized/;
67 154 100       333 $self->compare_result(qq{Header "$header" mismatch: got '$h1->{$header}', expected '$h2->{$header}'});
68 25     25   183 return 0;
  25         80  
  25         5246  
69 1         9 }
70 1         12 }
71             }
72              
73             $self->compare_result('');
74             return 1;
75 93         729 }
76 93         720  
77             my ($self, $u1, $u2) = @_;
78              
79             if (!ref $u1) {
80 237     237   1794 $u1 = Mojo::URL->new($u1);
81             }
82 237 50       676 $u1 = $u1->to_abs;
83 0         0  
84             if (!ref $u2) {
85 237         906 $u2 = Mojo::URL->new($u2);
86             }
87 237 100       22082 $u2 = $u2->to_abs;
88 1         4  
89             no warnings qw/uninitialized/;
90 237         691 for my $key (qw/scheme userinfo host port fragment/) {
91             my $ignore = sprintf 'ignore_%s', $key;
92 25     25   174 next if $self->can($ignore) && $self->$ignore;
  25         56  
  25         11247  
93 237         17527  
94 1135         2844 my $val1 = $u1->$key;
95 1135 50 66     4112 my $val2 = $u2->$key;
96             if ($val1 ne $val2) {
97 1135         3654 $self->compare_result(qq{URL $key mismatch: got "$val1", expected "$val2"});
98 1135         4160 return 0;
99 1135 100       4445 }
100 22         101 }
101 22         214
102             my $p1 = Mojo::Path->new($u1->path);
103             my $p2 = Mojo::Path->new($u2->path);
104             if ($p1->to_string ne $p2->to_string) {
105 215         721 my $val1 = $p1->to_string;
106 215         4317 my $val2 = $p2->to_string;
107 215 100       3678 $self->compare_result(qq{URL path mismatch: got "$val1", expected "$val2"});
108 5         1067 return 0;
109 5         334 }
110 5         449  
111 5         60 my $q1 = $u1->query->to_hash;
112             my $q2 = $u2->query->to_hash;
113              
114 210         35429 if (scalar keys %{$q1} != scalar keys %{$q2}) {
115 210         18555 my $count1 = scalar keys %{$q1};
116             my $count2 = scalar keys %{$q2};
117 210 100       62911  
  210         517  
  210         771  
118 2         3 $self->compare_result(qq{URL query mismatch: parameter count mismatch: $count1 != $count2});
  2         4  
119 2         3 return 0;
  2         3  
120             }
121 2         10 for my $key (keys %{$q1}) {
122 2         25 my $val1 = $q1->{$key};
123             my $val2 = $q2->{$key};
124 208         379  
  208         735  
125 913         1357 if ( ref $val2 eq 'ARRAY' ){
126 913         1392 $val1 = join(",", sort { $a cmp $b } @{$val1});
127             $val2 = join(",", sort { $a cmp $b } @{$val2});
128 913 100       1666 }
129 1         2  
  1         5  
  1         5  
130 1         3 if ($val1 ne $val2) {
  1         3  
  1         2  
131             $self->compare_result(qq{URL query mismatch: for key "$key", got "$val1", expected "$val2"});
132             return 0;
133 913 100       2458 }
134 108         851 }
135 108         1726 use warnings qw/uninitialized/;
136              
137             return 1;
138 25     25   182 }
  25         54  
  25         2097  
139              
140 100         1066 1;
141              
142              
143             =pod
144              
145             =encoding UTF-8
146              
147             =head1 NAME
148              
149             Mojo::UserAgent::Mockable::Request::Compare - Helper class for Mojo::UserAgent::Mockable that compares two Mojo::Message::Request instances
150              
151             =head1 VERSION
152              
153             version 1.59
154              
155             =head1 ATTRIBUTES
156              
157             =head2 compare_result
158              
159             The result of the last compare operation. It is only populated when two requests B<do not> match.
160              
161             =head2 ignore_userinfo
162              
163             Set this to a true value to ignore a mismatch in the L<userinfo|Mojo::URL/userinfo> portion of a transaction URL.
164              
165             =head2 ignore_body
166              
167             Set this to a true value to ignore a mismatch in the bodies of the two compared transactions
168              
169             =head1 METHODS
170              
171             =head2 compare
172              
173             Compare two instances of L<Mojo::Message::Request>.
174              
175             =head1 AUTHOR
176              
177             Kit Peters <popefelix@cpan.org>
178              
179             =head1 COPYRIGHT AND LICENSE
180              
181             This software is copyright (c) 2022 by Kit Peters.
182              
183             This is free software; you can redistribute it and/or modify it under
184             the same terms as the Perl 5 programming language system itself.
185              
186             =cut