1 package WWW
::Mechanize
::Script
::Plugin
::TextMatchTest
;
6 use parent
qw(WWW::Mechanize::Script::Plugin);
8 # ABSTRACT: check for required/forbidden text in response
10 use Params
::Util
qw(_ARRAY0);
12 our $VERSION = '0.001_003';
16 =method check_value_names
()
18 Returns
qw(text_forbid text_require).
24 return qw(text_forbid text_require);
27 =method check_response
(\
%check,$mech)
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
).
34 In case of an HTML response
, the received content is rendered into plain
35 text before searching
for matches
.
37 Return the accumulated I
<$code> and appropriate constructed message
, if
38 any match approval failed
.
44 my ( $self, $check, $mech ) = @_;
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();
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];
56 my $case_ign = $ignore_case ?
"(?i)" : "";
58 foreach my $text_line ( @
{$text_require} )
60 if ( $content !~ m/$case_ign\Q$text_line\E/ )
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 );
70 . join( ", ", map { "'" . $_ . "'" } @match_fails )
71 . " not found in received content" );
74 foreach my $text_line ( @
{$text_forbid} )
76 if ( $content =~ m/$case_ign\Q$text_line\E/ )
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 );
86 . join( ", ", map { "'" . $_ . "'" } @match_fails )
87 . " found in received content" );
91 return ( $code, @msg );