]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
403d7b0b | 5 | # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC |
84fb5b46 MKG |
6 | # <sales@bestpractical.com> |
7 | # | |
8 | # (Except where explicitly superseded by other copyright notices) | |
9 | # | |
10 | # | |
11 | # LICENSE: | |
12 | # | |
13 | # This work is made available to you under the terms of Version 2 of | |
14 | # the GNU General Public License. A copy of that license should have | |
15 | # been provided with this software, but in any event can be snarfed | |
16 | # from www.gnu.org. | |
17 | # | |
18 | # This work is distributed in the hope that it will be useful, but | |
19 | # WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
21 | # General Public License for more details. | |
22 | # | |
23 | # You should have received a copy of the GNU General Public License | |
24 | # along with this program; if not, write to the Free Software | |
25 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
26 | # 02110-1301 or visit their web page on the internet at | |
27 | # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. | |
28 | # | |
29 | # | |
30 | # CONTRIBUTION SUBMISSION POLICY: | |
31 | # | |
32 | # (The following paragraph is not intended to limit the rights granted | |
33 | # to you to modify and distribute this software under the terms of | |
34 | # the GNU General Public License and is only of importance to you if | |
35 | # you choose to contribute your changes and enhancements to the | |
36 | # community by submitting them to Best Practical Solutions, LLC.) | |
37 | # | |
38 | # By intentionally submitting any modifications, corrections or | |
39 | # derivatives to this work, or any other work intended for use with | |
40 | # Request Tracker, to Best Practical Solutions, LLC, you confirm that | |
41 | # you are the copyright holder for those contributions and you grant | |
42 | # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, | |
43 | # royalty-free, perpetual, license to use, copy, create derivative | |
44 | # works based on those contributions, and sublicense and distribute | |
45 | # those contributions and any derivatives thereof. | |
46 | # | |
47 | # END BPS TAGGED BLOCK }}} | |
48 | ||
49 | package RT::Test::Web; | |
50 | ||
51 | use strict; | |
52 | use warnings; | |
53 | ||
54 | use base qw(Test::WWW::Mechanize); | |
b5747ff2 | 55 | use Scalar::Util qw(weaken); |
84fb5b46 | 56 | |
b5747ff2 | 57 | BEGIN { require RT::Test; } |
84fb5b46 MKG |
58 | require Test::More; |
59 | ||
b5747ff2 MKG |
60 | my $instance; |
61 | ||
84fb5b46 MKG |
62 | sub new { |
63 | my ($class, @args) = @_; | |
64 | ||
65 | push @args, app => $RT::Test::TEST_APP if $RT::Test::TEST_APP; | |
b5747ff2 MKG |
66 | my $self = $instance = $class->SUPER::new(@args); |
67 | weaken $instance; | |
84fb5b46 MKG |
68 | $self->cookie_jar(HTTP::Cookies->new); |
69 | ||
70 | return $self; | |
71 | } | |
72 | ||
73 | sub get_ok { | |
74 | my $self = shift; | |
75 | my $url = shift; | |
76 | if ( $url =~ s!^/!! ) { | |
77 | $url = $self->rt_base_url . $url; | |
78 | } | |
79 | my $rv = $self->SUPER::get_ok($url, @_); | |
80 | Test::More::diag( "Couldn't get $url" ) unless $rv; | |
81 | return $rv; | |
82 | } | |
83 | ||
84 | sub rt_base_url { | |
85 | return $RT::Test::existing_server if $RT::Test::existing_server; | |
86 | return "http://localhost:" . RT->Config->Get('WebPort') . RT->Config->Get('WebPath') . "/"; | |
87 | } | |
88 | ||
89 | sub login { | |
90 | my $self = shift; | |
91 | my $user = shift || 'root'; | |
92 | my $pass = shift || 'password'; | |
93 | my %args = @_; | |
94 | ||
95 | $self->logout if $args{logout}; | |
96 | ||
97 | my $url = $self->rt_base_url; | |
98 | $self->get($url . "?user=$user;pass=$pass"); | |
99 | unless ( $self->status == 200 ) { | |
100 | Test::More::diag( "error: status is ". $self->status ); | |
101 | return 0; | |
102 | } | |
103 | unless ( $self->content =~ m/Logout/i ) { | |
104 | Test::More::diag("error: page has no Logout"); | |
105 | return 0; | |
106 | } | |
b5747ff2 | 107 | RT::Interface::Web::EscapeUTF8(\$user); |
84fb5b46 MKG |
108 | unless ( $self->content =~ m{<span class="current-user">\Q$user\E</span>}i ) { |
109 | Test::More::diag("Page has no user name"); | |
110 | return 0; | |
111 | } | |
112 | return 1; | |
113 | } | |
114 | ||
115 | sub logout { | |
116 | my $self = shift; | |
117 | ||
118 | my $url = $self->rt_base_url; | |
119 | $self->get($url); | |
120 | Test::More::diag( "error: status is ". $self->status ) | |
121 | unless $self->status == 200; | |
122 | ||
123 | if ( $self->content =~ /Logout/i ) { | |
124 | $self->follow_link( text => 'Logout' ); | |
125 | Test::More::diag( "error: status is ". $self->status ." when tried to logout" ) | |
126 | unless $self->status == 200; | |
127 | } | |
128 | else { | |
129 | return 1; | |
130 | } | |
131 | ||
132 | $self->get($url); | |
133 | if ( $self->content =~ /Logout/i ) { | |
134 | Test::More::diag( "error: couldn't logout" ); | |
135 | return 0; | |
136 | } | |
137 | return 1; | |
138 | } | |
139 | ||
140 | sub goto_ticket { | |
141 | my $self = shift; | |
142 | my $id = shift; | |
143 | unless ( $id && int $id ) { | |
144 | Test::More::diag( "error: wrong id ". defined $id? $id : '(undef)' ); | |
145 | return 0; | |
146 | } | |
147 | ||
148 | my $url = $self->rt_base_url; | |
149 | $url .= "Ticket/Display.html?id=$id"; | |
150 | $self->get($url); | |
151 | unless ( $self->status == 200 ) { | |
152 | Test::More::diag( "error: status is ". $self->status ); | |
153 | return 0; | |
154 | } | |
155 | return 1; | |
156 | } | |
157 | ||
158 | sub goto_create_ticket { | |
159 | my $self = shift; | |
160 | my $queue = shift; | |
161 | ||
162 | my $id; | |
163 | if ( ref $queue ) { | |
164 | $id = $queue->id; | |
165 | } elsif ( $queue =~ /^\d+$/ ) { | |
166 | $id = $queue; | |
167 | } else { | |
168 | die "not yet implemented"; | |
169 | } | |
170 | ||
171 | $self->get($self->rt_base_url . 'Ticket/Create.html?Queue='.$id); | |
172 | ||
173 | return 1; | |
174 | } | |
175 | ||
176 | sub get_warnings { | |
177 | my $self = shift; | |
178 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
179 | ||
180 | # We clone here so that when we fetch warnings, we don't disrupt the state | |
181 | # of the test's mech. If we reuse the original mech then you can't | |
182 | # test warnings immediately after fetching page XYZ, then fill out | |
183 | # forms on XYZ. This is because the most recently fetched page has changed | |
184 | # from XYZ to /__test_warnings, which has no form. | |
185 | my $clone = $self->clone; | |
186 | return unless $clone->get_ok('/__test_warnings'); | |
187 | ||
188 | use Storable 'thaw'; | |
189 | ||
190 | my @warnings = @{ thaw $clone->content }; | |
191 | return @warnings; | |
192 | } | |
193 | ||
194 | sub warning_like { | |
195 | my $self = shift; | |
196 | my $re = shift; | |
197 | my $name = shift; | |
198 | ||
199 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
200 | ||
201 | my @warnings = $self->get_warnings; | |
202 | if (@warnings == 0) { | |
203 | Test::More::fail("no warnings emitted; expected 1"); | |
204 | return 0; | |
205 | } | |
206 | elsif (@warnings > 1) { | |
207 | Test::More::fail(scalar(@warnings) . " warnings emitted; expected 1"); | |
208 | for (@warnings) { | |
209 | Test::More::diag("got warning: $_"); | |
210 | } | |
211 | return 0; | |
212 | } | |
213 | ||
214 | return Test::More::like($warnings[0], $re, $name); | |
215 | } | |
216 | ||
217 | sub next_warning_like { | |
218 | my $self = shift; | |
219 | my $re = shift; | |
220 | my $name = shift; | |
221 | ||
222 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
223 | ||
224 | if (@{ $self->{stashed_server_warnings} || [] } == 0) { | |
225 | my @warnings = $self->get_warnings; | |
226 | if (@warnings == 0) { | |
227 | Test::More::fail("no warnings emitted; expected 1"); | |
228 | return 0; | |
229 | } | |
230 | $self->{stashed_server_warnings} = \@warnings; | |
231 | } | |
232 | ||
233 | my $warning = shift @{ $self->{stashed_server_warnings} }; | |
234 | return Test::More::like($warning, $re, $name); | |
235 | } | |
236 | ||
237 | sub no_warnings_ok { | |
238 | my $self = shift; | |
239 | my $name = shift || "no warnings emitted"; | |
240 | ||
241 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
242 | ||
243 | my @warnings = $self->get_warnings; | |
244 | ||
245 | Test::More::is(@warnings, 0, $name); | |
246 | for (@warnings) { | |
247 | Test::More::diag("got warning: $_"); | |
248 | } | |
249 | ||
250 | return @warnings == 0 ? 1 : 0; | |
251 | } | |
252 | ||
253 | sub no_leftover_warnings_ok { | |
254 | my $self = shift; | |
255 | ||
256 | my $name = shift || "no leftover warnings"; | |
257 | ||
258 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
259 | ||
260 | # we clear the warnings because we don't want to break later tests | |
261 | # in case there *are* leftover warnings | |
262 | my @warnings = splice @{ $self->{stashed_server_warnings} || [] }; | |
263 | ||
264 | Test::More::is(@warnings, 0, $name); | |
265 | for (@warnings) { | |
266 | Test::More::diag("leftover warning: $_"); | |
267 | } | |
268 | ||
269 | return @warnings == 0 ? 1 : 0; | |
270 | } | |
271 | ||
272 | sub ticket_status { | |
273 | my $self = shift; | |
274 | my $id = shift; | |
275 | ||
276 | $self->display_ticket( $id); | |
277 | my ($got) = ($self->content =~ m{Status:\s*</td>\s*<td[^>]*?class="value"[^>]*?>\s*([\w ]+?)\s*</td>}ism); | |
278 | unless ( $got ) { | |
279 | Test::More::diag("Error: couldn't find status value on the page, may be regexp problem"); | |
280 | } | |
281 | return $got; | |
282 | } | |
283 | ||
284 | sub ticket_status_is { | |
285 | my $self = shift; | |
286 | my $id = shift; | |
287 | my $status = shift; | |
288 | my $desc = shift || "Status of the ticket #$id is '$status'"; | |
289 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
290 | return Test::More::is($self->ticket_status( $id), $status, $desc); | |
291 | } | |
292 | ||
293 | sub get_ticket_id { | |
294 | my $self = shift; | |
295 | my $content = $self->content; | |
296 | my $id = 0; | |
297 | if ($content =~ /.*Ticket (\d+) created.*/g) { | |
298 | $id = $1; | |
299 | } | |
300 | elsif ($content =~ /.*No permission to view newly created ticket #(\d+).*/g) { | |
301 | Test::More::diag("\nNo permissions to view the ticket.\n") if($ENV{'TEST_VERBOSE'}); | |
302 | $id = $1; | |
303 | } | |
304 | return $id; | |
305 | } | |
306 | ||
307 | sub set_custom_field { | |
308 | my $self = shift; | |
309 | my $queue = shift; | |
310 | my $cf_name = shift; | |
311 | my $val = shift; | |
312 | ||
313 | my $field_name = $self->custom_field_input( $queue, $cf_name ) | |
314 | or return 0; | |
315 | ||
316 | $self->field($field_name, $val); | |
317 | return 1; | |
318 | } | |
319 | ||
320 | sub custom_field_input { | |
321 | my $self = shift; | |
322 | my $queue = shift; | |
323 | my $cf_name = shift; | |
324 | ||
325 | my $cf_obj = RT::CustomField->new( $RT::SystemUser ); | |
326 | $cf_obj->LoadByName( Queue => $queue, Name => $cf_name ); | |
327 | unless ( $cf_obj->id ) { | |
328 | Test::More::diag("Can not load custom field '$cf_name' in queue '$queue'"); | |
329 | return undef; | |
330 | } | |
331 | my $cf_id = $cf_obj->id; | |
332 | ||
333 | my ($res) = | |
334 | grep /^Object-RT::Ticket-\d*-CustomField-$cf_id-Values?$/, | |
335 | map $_->name, | |
336 | $self->current_form->inputs; | |
337 | unless ( $res ) { | |
338 | Test::More::diag("Can not find input for custom field '$cf_name' #$cf_id"); | |
339 | return undef; | |
340 | } | |
341 | return $res; | |
342 | } | |
343 | ||
344 | sub check_links { | |
345 | my $self = shift; | |
346 | my %args = @_; | |
347 | ||
348 | my %has = map {$_ => 1} @{ $args{'has'} }; | |
349 | my %has_no = map {$_ => 1} @{ $args{'has_no'} }; | |
350 | ||
351 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
352 | ||
353 | my @found; | |
354 | ||
355 | my @links = $self->followable_links; | |
356 | foreach my $text ( grep defined && length, map $_->text, @links ) { | |
357 | push @found, $text if $has_no{ $text }; | |
358 | delete $has{ $text }; | |
359 | } | |
360 | if ( @found || keys %has ) { | |
361 | Test::More::ok( 0, "expected links" ); | |
362 | Test::More::diag( "didn't expect, but found: ". join ', ', map "'$_'", @found ) | |
363 | if @found; | |
364 | Test::More::diag( "didn't find, but expected: ". join ', ', map "'$_'", keys %has ) | |
365 | if keys %has; | |
366 | return 0; | |
367 | } | |
368 | return Test::More::ok( 1, "expected links" ); | |
369 | } | |
370 | ||
371 | sub DESTROY { | |
372 | my $self = shift; | |
373 | if ( !$RT::Test::Web::DESTROY++ ) { | |
374 | $self->no_warnings_ok; | |
375 | } | |
376 | } | |
377 | ||
b5747ff2 MKG |
378 | END { |
379 | return unless $instance; | |
380 | return if RT::Test->builder->{Original_Pid} != $$; | |
381 | $instance->no_warnings_ok if !$RT::Test::Web::DESTROY++; | |
382 | } | |
383 | ||
84fb5b46 | 384 | 1; |