lib/WWW/Mechanize/Script/Plugin/TextMatchTest.pm

   1 package WWW::Mechanize::Script::Plugin::TextMatchTest;
   2
   3 use strict;
   4 use warnings;
   5
   6 use parent qw(WWW::Mechanize::Script::Plugin);
   7
   8 # ABSTRACT: check for required/forbidden text in response
   9
  10 use Params::Util qw(_ARRAY0);
  11
  12 our $VERSION = '0.001_004';
  13
  14 use 5.014;
  15
  16 =method check_value_names()
  17
  18 Returns qw(text_forbid text_require).
  19
  20 =cut
  21
  22 sub check_value_names
  23 {
  24     return qw(text_forbid text_require);
  25 }
  26
  27 =method check_response(\%check,$mech)
  28
  29 This method checks whether any line of I<text_forbid> is found in received
  30 content (and accumulates I<text_forbid_code> into I<$code> when found) or
  31 any line of I<text_require> missing in content (and accumulates
  32 I<text_forbid_code> into I<$code> when missing).
  33
  34 In case of an HTML response, the received content is rendered into plain
  35 text before searching for matches.
  36
  37 Return the accumulated I<$code> and appropriate constructed message, if
  38 any match approval failed.
  39
  40 =cut
  41
  42 sub check_response
  43 {
  44     my ( $self, $check, $mech ) = @_;
  45
  46     my $text_require = $self->get_check_value( $check, "text_require" );
  47     my $text_forbid  = $self->get_check_value( $check, "text_forbid" );
  48     my $ignore_case = $self->get_check_value_as_bool( $check, "ignore_case" );
  49     my $content = $mech->is_html() ? $mech->text() : $mech->content();
  50
  51     defined($text_require) and ref($text_require) ne "ARRAY" and $text_require = [$text_require];
  52     defined($text_forbid)  and ref($text_forbid)  ne "ARRAY" and $text_forbid  = [$text_forbid];
  53
  54     my @match_fails;
  55     my $code = 0;
  56     my $case_ign = $ignore_case ? "(?i)" : "";
  57     my @msg;
  58     foreach my $text_line ( @{$text_require} )
  59     {
  60         if ( $content !~ m/$case_ign\Q$text_line\E/ )
  61         {
  62             my $err_code = $self->get_check_value( $check, "text_require_code" ) // 1;
  63             $code = &{ $check->{compute_code} }( $code, $err_code );
  64             push( @match_fails, $text_line );
  65         }
  66     }
  67     @match_fails
  68       and push( @msg,
  69                     "required text "
  70                   . join( ", ", map { "'" . $_ . "'" } @match_fails )
  71                   . " not found in received content" );
  72
  73     @match_fails = ();
  74     foreach my $text_line ( @{$text_forbid} )
  75     {
  76         if ( $content =~ m/$case_ign\Q$text_line\E/ )
  77         {
  78             my $err_code = $self->get_check_value( $check, "text_forbid_code" ) // 1;
  79             $code = &{ $check->{compute_code} }( $code, $err_code );
  80             push( @match_fails, $text_line );
  81         }
  82     }
  83     @match_fails
  84       and push( @msg,
  85                     "forbidden text "
  86                   . join( ", ", map { "'" . $_ . "'" } @match_fails )
  87                   . " found in received content" );
  88
  89     if ( $code or @msg )
  90     {
  91         return ( $code, @msg );
  92     }
  93
  94     return (0);
  95 }
  96
  97 1;