Method calls ignore subroutine prototypes, so you can safely delete them.

search_tag() is awfully long. I'd decompose it into several helper methods.

You have several blocks that could be shortened. I'd write this:

if (!defined ($tag_search) &&  !defined ($attr_search))
{
    $ok = 0;
    return($ok, "No values for tag searched");
}
[download]

as

return (0, "No values for tag searched")
    unless defined $tag_search and defined $attr_search;
[download]

As well, you can fetch a single element from an array reference more idiomatically:

my $tag   = @{$tagstruct}[0];
# versus
my $tag   = $tagstruct->[0];
[download]

There are some exit conditions inside your loop that seem to be known before you enter the loop. In this case, you're better off not looping at all. I think if you extracted a few methods the control flow would be more clear and you might see what I think I see. (Or I might not really see it :).

Within check_response(), you have two nearly-identical loops. I'd rather write:

use HTML::TokeParser;

my @forbid  = $self->test_tags( 'tag_forbid', $content, $case_re );
push @ret, ['Forbidden tag and attribute', @results] if @forbid;

my @require = $self->test_tags( 'tag_require', $content, $case_re );
push @ret, ['Required tag and attribute', @results] if @require;

sub test_tags
{
    my ($self, $tag_type, $content, $case_re) = @_;

    my $page = HTML::TokeParser->new(\$content);

    my @results;
    for my $tag_struct (@{$self->test_param( $tag_type, [] )})
    {
        my ($ok, $result) = search_tag( $page, $case_re, %{ $tag_struc
+t });
        push @results, $self->test_result($ok, $result);
    }

    return @results;
}
[download]

I'd rather pass $tag_struct directly, but that'd change the API and I'm not going to do that right now.

If I may be so bold as to suggest that you check out one of my modules, HTML::TokeParser::Simple. I am looking at the following and I think you can make it clearer:

  my $tag   = @{$tagstruct}[0];
  if ($tag =~ m!/!)
  {
    #print "endtag";
    next;
  }
  my %attrhash= %{@{$tagstruct}[1]};
  my @attrarr = @{@{$tagstruct}[2]};
[download]

With the "simple" version of TokeParser, the array structure remains exactly the same. This ensures that you can use the same interface, but gradually upgrade to something more legible:

  if ($tagstruct->is_end_tag)
  {
    #print "endtag";
    next;
  }
  my %attrhash= %{$tagstruct->return_attr};
  my @attrarr = @{$tagstruct->return_attrseq};
[download]

I am a big fan of self-documenting code and with this module, you no longer have to try and memorize array indices.

Cheers,
Ovid

New address of my CGI Course.
Silence is Evil (feel free to copy and distribute widely - note copyright text)

search_tag() is a part of private API and there is very little sense to document it in POD. In fact there is no need to document in POD any subs in this module because they are either private or public methods which are already documented in base class (HTTP::WebTest::Plugin).

--
Ilya Martynov, ilya@iponweb.net
CTO IPonWEB (UK) Ltd
Quality Perl Programming and Unix Support UK managed @ offshore prices - http://www.iponweb.net
Personal website - http://martynov.org

package HTTP::WebTest::Plugin::TagAttTest;

use vars qw($VERSION);
$VERSION = '0.05';
=head1 NAME

HTTP::WebTest::Plugin::TagAttTest - Test by tag and attribute existenc
+e

=head1 SYNOPSIS

Not Applicable

=head1 DESCRIPTION

This plugin allows to forbid or require tags and/or attributes in a we
+b page.

=cut

use strict;
use base qw(HTTP::WebTest::Plugin);


#use HTTP::Status;

=head1 TEST PARAMETERS

=for pod_merge copy params

=head2 ignore_case

Determines if case is important.

=head3 Allowed values

C<yes>,C<no>

=head3 Default value

C<no>

=head2 tag_require

A required tag. This is an array of hashs such as C<< require_tag => [
+{tag=>"script", tag_text=>"spam", attr=>"language",attr_text=>"javasc
+ript"}] >>

See also the L</TAG HASH> for a more detailed explaination.


=head3 Allowed values

list of hashes

=head3 Default value

None   (will generate a failed test)

=head2  forbid_tag


A forbidden tag.    This is an array of hashs such as C<< forbid_tag =
+> [{tag=>"script",attr=>"language",attr_text=>"javascript"}] >>

See also the L</TAG HASH> for a more detailed explaination.


=head3 Allowed values

list of hashes

=head3 Default value

None   (will generate a failed test)

=head1 TAG HASH


=head2 tag

tag to forbid

=head2 attr

attribute to forbid


=head2 attr_text

regular expression or text. If text, will do a substring search.


=head2 tag_text

regular expression or text. If text, will do a substring search.

Note that if an element is missing, it will not be considered. So some
+thing like
C<require_tag => [{tag=>"title"}]> will assure that a page has a title
+ tag, but the
title tag could be blank.


=cut


sub param_types {
    return q(use_case yesno
            tag_forbid list
        tag_require list);
}

sub get_tag($ $)
{
    my ($page, $tag_name) = @_;
    if (!defined($tag_name))
    {
        return ($page->get_tag) ;
    }
    else
    {
        my $res =  $page->get_tag($tag_name);
        return ($res);
    }
}
sub find_attributes
{

    my( $ok, @attrarr, $attr_search, %attrhash, $attr_text_search, $ca
+se_re) = @_;
    for my $attribute (@attrarr)
    {
        #this isn't as simple as for tags, because we can't get just c
+ertain attributes.
        #the code can be shortened by combining the two if's, but it w
+as giving me a 
        #headache figuring out all of the possibilities, so I left it 
+for readability.
        #case 6
        if (!defined($attr_search))
        {
            my $attr_content = $attrhash{$attribute};
            $ok = 0 if ($attr_content =~ /$case_re\Q$attr_text_search\
+E/);
        }

        #case 4
          if  (!(defined ($attr_text_search)) and ($attribute eq $attr
+_search))
        {
            $ok = 0;
        }
        #case 5
           else 
        {
            my $attr_content = $attrhash{$attribute};
            $ok = 0 if ($attr_content =~ /$case_re\Q$attr_text_search\
+E/);
           }
    }
}

sub search_tag
{
    my $ok = 1;
    my ($page,$case_re, %tag_search_struct) = @_;
    chomp (%tag_search_struct);
    my $tag_search = $tag_search_struct{"tag"};
    undef $tag_search if ($tag_search eq ''); #an undefined tag causes
+ it to loop through all tags.
    my $tag_text_search = $tag_search_struct{"tag_text"};
    my $attr_search = $tag_search_struct{"attr"};
    undef $attr_search if ($attr_search eq '');
    my $attr_text_search = $tag_search_struct{"attr_text"};
    my @results=();
        
    return(0, "No values for tag searched") unless (defined ($tag_sear
+ch) or  defined ($attr_search));
    #at this point we start looking for tags
    #there are 6 main cases
    #1, looking for a tag
    #2, looking for a specific tag containing some specific text
    #3, looking for any tag containing some specific text
    #4, looking for an attribute
    #5, looking for an attribute containing some specifice text
    #6, looking for any attribute containing some specific text
    # these can be combined
    while ( my $tagstruct = get_tag($page,$tag_search) )
    {
        my $tag   = $tagstruct->[0];
        next if ($tag =~ m!/!);
        my %attrhash= %{$tagstruct->[1]};
        my @attrarr = @{$tagstruct->[2]};
        #the tag exists so we want to see if the contents match
        #case 1
        $ok = 0 if (defined ($tag_search) and !defined ($tag_text_sear
+ch)); #if we didn't search a tag, we should continue with the success
+ assumption

        #case 2 or 3
        if  ( defined ($tag_text_search) )
        {
            my $tag_content = $page->get_text;           
            $ok = 0 if ($tag_content =~ /$case_re\Q$tag_text_search\E/
+);
        }

        #this quits if we hit case 1, 2 or 3 and we aren't looking for
+ cases 4, 5 or 6
        last if (  (!defined ($attr_search) &&  !defined ($attr_text_s
+earch)) &&  !($ok));
        
        #look for cases 4, 5, 6
        $ok = find_attributes( $ok, @attrarr, $attr_search, %attrhash,
+ $attr_text_search, $case_re);
        
        #if $ok is 0, one of cases 4,5 or 6 must have failed.
        last if ($ok == 0);       
    }
    return ($ok,  "tag: " . $tag_search . ", tag text: " . $tag_text_s
+earch . ", attribute: " . $attr_search . ", attribute text: " . $attr
+_text_search);
}

sub test_tags
{
    my ($self, $tag_type, $content, $case_re) = @_;
    use HTML::TokeParser;
    my $page = HTML::TokeParser->new(\$content);

    my @results;
    for my $tag_struct (@{$self->test_param( $tag_type, [] )})
    {
        my ($ok, $result) = search_tag( $page, $case_re, %{ $tag_struc
+t });
        push @results, $self->test_result($ok, $result);
    }

    return @results;
}


sub check_response {
    my $self = shift;
    
    # response content   
    my $content = $self->webtest->current_response->content;   
    $self->validate_params(qw(ignore_case
        tag_forbid tag_require));
    
    # ignore case or not?
    my $ignore_case = $self->yesno_test_param('ignore_case');
    my $case_re = $ignore_case ? '(?i)' : '';
    
    # clean test results  
    my @results = ();
    my @ret = (); 
    
    # check for forbidden tag and attribute

    my @forbid  = test_tags($self, 'tag_forbid', $content, $case_re );
    push @ret, ['Forbidden tag and attribute', @results] if @forbid;

    my @require = test_tags( $self,'tag_require', $content, $case_re )
+;
    push @ret, ['Required tag and attribute', @results] if @require;
    return @ret;
}





=head1 COPYRIGHT

Copyright (c) 2003-2004 Edward Fancher.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<HTTP::WebTest|HTTP::WebTest>

L<HTTP::WebTest::API|HTTP::WebTest::API>

L<HTTP::WebTest::Plugin|HTTP::WebTest::Plugin>

L<HTTP::WebTest::Plugins|HTTP::WebTest::Plugins>


L<HTTP::WebTest::Plugins|HTTP::WebTest::Plugins::TextMatchTest>

=cut

1;
[download]