]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
5 | # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC | |
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); | |
55 | ||
56 | require RT::Test; | |
57 | require Test::More; | |
58 | ||
59 | sub new { | |
60 | my ($class, @args) = @_; | |
61 | ||
62 | push @args, app => $RT::Test::TEST_APP if $RT::Test::TEST_APP; | |
63 | my $self = $class->SUPER::new(@args); | |
64 | $self->cookie_jar(HTTP::Cookies->new); | |
65 | ||
66 | return $self; | |
67 | } | |
68 | ||
69 | sub get_ok { | |
70 | my $self = shift; | |
71 | my $url = shift; | |
72 | if ( $url =~ s!^/!! ) { | |
73 | $url = $self->rt_base_url . $url; | |
74 | } | |
75 | my $rv = $self->SUPER::get_ok($url, @_); | |
76 | Test::More::diag( "Couldn't get $url" ) unless $rv; | |
77 | return $rv; | |
78 | } | |
79 | ||
80 | sub rt_base_url { | |
81 | return $RT::Test::existing_server if $RT::Test::existing_server; | |
82 | return "http://localhost:" . RT->Config->Get('WebPort') . RT->Config->Get('WebPath') . "/"; | |
83 | } | |
84 | ||
85 | sub login { | |
86 | my $self = shift; | |
87 | my $user = shift || 'root'; | |
88 | my $pass = shift || 'password'; | |
89 | my %args = @_; | |
90 | ||
91 | $self->logout if $args{logout}; | |
92 | ||
93 | my $url = $self->rt_base_url; | |
94 | $self->get($url . "?user=$user;pass=$pass"); | |
95 | unless ( $self->status == 200 ) { | |
96 | Test::More::diag( "error: status is ". $self->status ); | |
97 | return 0; | |
98 | } | |
99 | unless ( $self->content =~ m/Logout/i ) { | |
100 | Test::More::diag("error: page has no Logout"); | |
101 | return 0; | |
102 | } | |
103 | unless ( $self->content =~ m{<span class="current-user">\Q$user\E</span>}i ) { | |
104 | Test::More::diag("Page has no user name"); | |
105 | return 0; | |
106 | } | |
107 | return 1; | |
108 | } | |
109 | ||
110 | sub logout { | |
111 | my $self = shift; | |
112 | ||
113 | my $url = $self->rt_base_url; | |
114 | $self->get($url); | |
115 | Test::More::diag( "error: status is ". $self->status ) | |
116 | unless $self->status == 200; | |
117 | ||
118 | if ( $self->content =~ /Logout/i ) { | |
119 | $self->follow_link( text => 'Logout' ); | |
120 | Test::More::diag( "error: status is ". $self->status ." when tried to logout" ) | |
121 | unless $self->status == 200; | |
122 | } | |
123 | else { | |
124 | return 1; | |
125 | } | |
126 | ||
127 | $self->get($url); | |
128 | if ( $self->content =~ /Logout/i ) { | |
129 | Test::More::diag( "error: couldn't logout" ); | |
130 | return 0; | |
131 | } | |
132 | return 1; | |
133 | } | |
134 | ||
135 | sub goto_ticket { | |
136 | my $self = shift; | |
137 | my $id = shift; | |
138 | unless ( $id && int $id ) { | |
139 | Test::More::diag( "error: wrong id ". defined $id? $id : '(undef)' ); | |
140 | return 0; | |
141 | } | |
142 | ||
143 | my $url = $self->rt_base_url; | |
144 | $url .= "Ticket/Display.html?id=$id"; | |
145 | $self->get($url); | |
146 | unless ( $self->status == 200 ) { | |
147 | Test::More::diag( "error: status is ". $self->status ); | |
148 | return 0; | |
149 | } | |
150 | return 1; | |
151 | } | |
152 | ||
153 | sub goto_create_ticket { | |
154 | my $self = shift; | |
155 | my $queue = shift; | |
156 | ||
157 | my $id; | |
158 | if ( ref $queue ) { | |
159 | $id = $queue->id; | |
160 | } elsif ( $queue =~ /^\d+$/ ) { | |
161 | $id = $queue; | |
162 | } else { | |
163 | die "not yet implemented"; | |
164 | } | |
165 | ||
166 | $self->get($self->rt_base_url . 'Ticket/Create.html?Queue='.$id); | |
167 | ||
168 | return 1; | |
169 | } | |
170 | ||
171 | sub get_warnings { | |
172 | my $self = shift; | |
173 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
174 | ||
175 | # We clone here so that when we fetch warnings, we don't disrupt the state | |
176 | # of the test's mech. If we reuse the original mech then you can't | |
177 | # test warnings immediately after fetching page XYZ, then fill out | |
178 | # forms on XYZ. This is because the most recently fetched page has changed | |
179 | # from XYZ to /__test_warnings, which has no form. | |
180 | my $clone = $self->clone; | |
181 | return unless $clone->get_ok('/__test_warnings'); | |
182 | ||
183 | use Storable 'thaw'; | |
184 | ||
185 | my @warnings = @{ thaw $clone->content }; | |
186 | return @warnings; | |
187 | } | |
188 | ||
189 | sub warning_like { | |
190 | my $self = shift; | |
191 | my $re = shift; | |
192 | my $name = shift; | |
193 | ||
194 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
195 | ||
196 | my @warnings = $self->get_warnings; | |
197 | if (@warnings == 0) { | |
198 | Test::More::fail("no warnings emitted; expected 1"); | |
199 | return 0; | |
200 | } | |
201 | elsif (@warnings > 1) { | |
202 | Test::More::fail(scalar(@warnings) . " warnings emitted; expected 1"); | |
203 | for (@warnings) { | |
204 | Test::More::diag("got warning: $_"); | |
205 | } | |
206 | return 0; | |
207 | } | |
208 | ||
209 | return Test::More::like($warnings[0], $re, $name); | |
210 | } | |
211 | ||
212 | sub next_warning_like { | |
213 | my $self = shift; | |
214 | my $re = shift; | |
215 | my $name = shift; | |
216 | ||
217 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
218 | ||
219 | if (@{ $self->{stashed_server_warnings} || [] } == 0) { | |
220 | my @warnings = $self->get_warnings; | |
221 | if (@warnings == 0) { | |
222 | Test::More::fail("no warnings emitted; expected 1"); | |
223 | return 0; | |
224 | } | |
225 | $self->{stashed_server_warnings} = \@warnings; | |
226 | } | |
227 | ||
228 | my $warning = shift @{ $self->{stashed_server_warnings} }; | |
229 | return Test::More::like($warning, $re, $name); | |
230 | } | |
231 | ||
232 | sub no_warnings_ok { | |
233 | my $self = shift; | |
234 | my $name = shift || "no warnings emitted"; | |
235 | ||
236 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
237 | ||
238 | my @warnings = $self->get_warnings; | |
239 | ||
240 | Test::More::is(@warnings, 0, $name); | |
241 | for (@warnings) { | |
242 | Test::More::diag("got warning: $_"); | |
243 | } | |
244 | ||
245 | return @warnings == 0 ? 1 : 0; | |
246 | } | |
247 | ||
248 | sub no_leftover_warnings_ok { | |
249 | my $self = shift; | |
250 | ||
251 | my $name = shift || "no leftover warnings"; | |
252 | ||
253 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
254 | ||
255 | # we clear the warnings because we don't want to break later tests | |
256 | # in case there *are* leftover warnings | |
257 | my @warnings = splice @{ $self->{stashed_server_warnings} || [] }; | |
258 | ||
259 | Test::More::is(@warnings, 0, $name); | |
260 | for (@warnings) { | |
261 | Test::More::diag("leftover warning: $_"); | |
262 | } | |
263 | ||
264 | return @warnings == 0 ? 1 : 0; | |
265 | } | |
266 | ||
267 | sub ticket_status { | |
268 | my $self = shift; | |
269 | my $id = shift; | |
270 | ||
271 | $self->display_ticket( $id); | |
272 | my ($got) = ($self->content =~ m{Status:\s*</td>\s*<td[^>]*?class="value"[^>]*?>\s*([\w ]+?)\s*</td>}ism); | |
273 | unless ( $got ) { | |
274 | Test::More::diag("Error: couldn't find status value on the page, may be regexp problem"); | |
275 | } | |
276 | return $got; | |
277 | } | |
278 | ||
279 | sub ticket_status_is { | |
280 | my $self = shift; | |
281 | my $id = shift; | |
282 | my $status = shift; | |
283 | my $desc = shift || "Status of the ticket #$id is '$status'"; | |
284 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
285 | return Test::More::is($self->ticket_status( $id), $status, $desc); | |
286 | } | |
287 | ||
288 | sub get_ticket_id { | |
289 | my $self = shift; | |
290 | my $content = $self->content; | |
291 | my $id = 0; | |
292 | if ($content =~ /.*Ticket (\d+) created.*/g) { | |
293 | $id = $1; | |
294 | } | |
295 | elsif ($content =~ /.*No permission to view newly created ticket #(\d+).*/g) { | |
296 | Test::More::diag("\nNo permissions to view the ticket.\n") if($ENV{'TEST_VERBOSE'}); | |
297 | $id = $1; | |
298 | } | |
299 | return $id; | |
300 | } | |
301 | ||
302 | sub set_custom_field { | |
303 | my $self = shift; | |
304 | my $queue = shift; | |
305 | my $cf_name = shift; | |
306 | my $val = shift; | |
307 | ||
308 | my $field_name = $self->custom_field_input( $queue, $cf_name ) | |
309 | or return 0; | |
310 | ||
311 | $self->field($field_name, $val); | |
312 | return 1; | |
313 | } | |
314 | ||
315 | sub custom_field_input { | |
316 | my $self = shift; | |
317 | my $queue = shift; | |
318 | my $cf_name = shift; | |
319 | ||
320 | my $cf_obj = RT::CustomField->new( $RT::SystemUser ); | |
321 | $cf_obj->LoadByName( Queue => $queue, Name => $cf_name ); | |
322 | unless ( $cf_obj->id ) { | |
323 | Test::More::diag("Can not load custom field '$cf_name' in queue '$queue'"); | |
324 | return undef; | |
325 | } | |
326 | my $cf_id = $cf_obj->id; | |
327 | ||
328 | my ($res) = | |
329 | grep /^Object-RT::Ticket-\d*-CustomField-$cf_id-Values?$/, | |
330 | map $_->name, | |
331 | $self->current_form->inputs; | |
332 | unless ( $res ) { | |
333 | Test::More::diag("Can not find input for custom field '$cf_name' #$cf_id"); | |
334 | return undef; | |
335 | } | |
336 | return $res; | |
337 | } | |
338 | ||
339 | sub check_links { | |
340 | my $self = shift; | |
341 | my %args = @_; | |
342 | ||
343 | my %has = map {$_ => 1} @{ $args{'has'} }; | |
344 | my %has_no = map {$_ => 1} @{ $args{'has_no'} }; | |
345 | ||
346 | local $Test::Builder::Level = $Test::Builder::Level + 1; | |
347 | ||
348 | my @found; | |
349 | ||
350 | my @links = $self->followable_links; | |
351 | foreach my $text ( grep defined && length, map $_->text, @links ) { | |
352 | push @found, $text if $has_no{ $text }; | |
353 | delete $has{ $text }; | |
354 | } | |
355 | if ( @found || keys %has ) { | |
356 | Test::More::ok( 0, "expected links" ); | |
357 | Test::More::diag( "didn't expect, but found: ". join ', ', map "'$_'", @found ) | |
358 | if @found; | |
359 | Test::More::diag( "didn't find, but expected: ". join ', ', map "'$_'", keys %has ) | |
360 | if keys %has; | |
361 | return 0; | |
362 | } | |
363 | return Test::More::ok( 1, "expected links" ); | |
364 | } | |
365 | ||
366 | sub DESTROY { | |
367 | my $self = shift; | |
368 | if ( !$RT::Test::Web::DESTROY++ ) { | |
369 | $self->no_warnings_ok; | |
370 | } | |
371 | } | |
372 | ||
373 | 1; |