1 package WWW
::Mechanize
::Script
::Plugin
::RegexMatchTest
;
6 use parent
qw(WWW::Mechanize::Script::Plugin);
8 # ABSTRACT: check for required/forbidden text via regular expression in response
10 use Params
::Util
qw(_ARRAY0);
12 our $VERSION = '0.001_003';
18 return qw(regex_forbid regex_require);
23 my ( $self, $check, $mech ) = @_;
25 my $regex_require = $self->get_check_value( $check, "regex_require" );
26 my $regex_forbid = $self->get_check_value( $check, "regex_forbid" );
27 my $ignore_case = $self->get_check_value_as_bool( $check, "ignore_case" );
28 my $content = $mech->is_html() ?
$mech->text() : $mech->content();
30 defined($regex_require)
31 and ref($regex_require) ne "ARRAY"
32 and $regex_require = [$regex_require];
33 defined($regex_forbid) and ref($regex_forbid) ne "ARRAY" and $regex_forbid = [$regex_forbid];
37 my $case_ign = $ignore_case ?
"(?i)" : "";
39 foreach my $regex_line ( @
{$regex_require} )
41 if ( $content !~ m/$case_ign$regex_line/ )
43 my $err_code = $self->get_check_value( $check, "regex_require_code" ) // 1;
44 $code = &{ $check->{compute_code
} }( $code, $err_code );
45 push( @match_fails, $regex_line );
51 . join( ", ", map { "'" . $_ . "'" } @match_fails )
52 . " not found in received content" );
55 foreach my $regex_line ( @
{$regex_forbid} )
57 if ( $content =~ m/$case_ign$regex_line/ )
59 my $err_code = $self->get_check_value( $check, "regex_forbid_code" ) // 1;
60 $code = &{ $check->{compute_code
} }( $code, $err_code );
61 push( @match_fails, $regex_line );
67 . join( ", ", map { "'" . $_ . "'" } @match_fails )
68 . " found in received content" );
72 return ( $code, @msg );