rt/lib/RT/Test/Web.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 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 use Scalar::Util qw(weaken);
  56
  57 BEGIN { require RT::Test; }
  58 require Test::More;
  59
  60 my $instance;
  61
  62 sub new {
  63     my ($class, @args) = @_;
  64
  65     push @args, app => $RT::Test::TEST_APP if $RT::Test::TEST_APP;
  66     my $self = $instance = $class->SUPER::new(@args);
  67     weaken $instance;
  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     }
 107     RT::Interface::Web::EscapeUTF8(\$user);
 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
 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
 384 1;