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 use Params::Util qw(_ARRAY0);
   9
  10 our $VERSION = '0.001_002';
  11
  12 use 5.014;
  13
  14 sub check_value_names
  15 {
  16     return qw(text_forbid text_require);
  17 }
  18
  19 sub check_response
  20 {
  21     my ( $self, $check, $mech ) = @_;
  22
  23     my $text_require = $self->get_check_value( $check, "text_require" );
  24     my $text_forbid  = $self->get_check_value( $check, "text_forbid" );
  25     my $ignore_case = $self->get_check_value_as_bool( $check, "ignore_case" );
  26     my $content = $mech->is_html() ? $mech->text() : $mech->content();
  27
  28     defined($text_require) and ref($text_require) ne "ARRAY" and $text_require = [$text_require];
  29     defined($text_forbid) and ref($text_forbid) ne "ARRAY" and $text_forbid = [$text_forbid];
  30
  31     my @match_fails;
  32     my $code = 0;
  33     my $case_ign = $ignore_case ? "(?i)" : "";
  34     my @msg;
  35     foreach my $text_line ( @{$text_require} )
  36     {
  37         if ( $content !~ m/$case_ign\Q$text_line\E/ )
  38         {
  39             my $err_code = $self->get_check_value( $check, "text_require_code" ) // 1;
  40             $code = &{ $check->{compute_code} }( $code, $err_code );
  41             push( @match_fails, $text_line );
  42         }
  43     }
  44     @match_fails
  45       and push( @msg,
  46                     "required text "
  47                   . join( ", ", map { "'" . $_ . "'" } @match_fails )
  48                   . " not found in received content" );
  49
  50     @match_fails = ();
  51     foreach my $text_line ( @{$text_forbid} )
  52     {
  53         if ( $content =~ m/$case_ign\Q$text_line\E/ )
  54         {
  55             my $err_code = $self->get_check_value( $check, "text_forbid_code" ) // 1;
  56             $code = &{ $check->{compute_code} }( $code, $err_code );
  57             push( @match_fails, $text_line );
  58         }
  59     }
  60     @match_fails
  61       and push( @msg,
  62                     "forbidden text "
  63                   . join( ", ", map { "'" . $_ . "'" } @match_fails )
  64                   . " found in received content" );
  65
  66     if ( $code or @msg )
  67     {
  68         return ( $code, @msg );
  69     }
  70
  71     return (0);
  72 }
  73
  74 1;