[Http-webtest-commits] CVS: HTTP-WebTest/lib/HTTP/WebTest/Plugin Click.pm,NONE,1.1

[Ilya M. <m_...@us...>]

Update of /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin
In directory usw-pr-cvs1:/tmp/cvs-serv25857/lib/HTTP/WebTest/Plugin

Added Files:
	Click.pm 
Log Message:
Added


--- NEW FILE: Click.pm ---
# $Id: Click.pm,v 1.1 2002/02/21 01:43:35 m_ilya Exp $

package HTTP::WebTest::Plugin::Click;

=head1 NAME

HTTP::WebTest::Plugin::Click - Click buttons and links on web page

=head1 SYNOPSIS

Not Applicable

=head1 DESCRIPTION

=cut

use strict;
use HTML::TokeParser;
use URI;

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

=head1 TEST PARAMETERS

=for pod_merge copy params

=head2 click_button

=head2 click_link

=cut

sub param_types {
    return q(click_button scalar
             click_link   scalar);
}

sub prepare_request {
    my $self = shift;

    $self->validate_params(qw(click_button click_link));

    # get current request object
    my $request = $self->webtest->last_request;

    # get number of previous test if any
    my $prev_test_num = $self->webtest->last_test_num - 1;
    return if $prev_test_num < 0;

    # get previous response object
    my $response = $self->webtest->tests->[$prev_test_num]->response;

    # no response - nothing to do
    return unless defined $response;

    # do nothing unless it is HTML
    return unless $response->content_type eq 'text/html';

    # get various params we handle
    my $button = $self->test_param('click_button');
    my $link   = $self->test_param('click_link');

    if(defined $link) {
	my $content = $response->content;
	my $base = $response->base;
	my $link = $self->find_link(base => $base,
				    content_ref => \$content,
				    pattern => $link);

	$request->uri($link) if defined $link;
    }
}

sub find_link {
    my $self = shift;
    my %param = @_;

    my $base        = $param{base};
    my $content_ref = $param{content_ref};
    my $pattern     = $param{pattern};

    # look for matching link and base tag
    my $parser = HTML::TokeParser->new($content_ref);
    my $link = undef;
    while(my $token = $parser->get_tag(qw(a base))) {
	my $uri = $token->[1]{href};
	next unless defined $uri;
	if($token->[0] eq 'base') {
	    $base = $uri;
	} elsif($token->[0] eq 'a') {
	    my $text = $parser->get_trimmed_text('/a');
	    if($text =~ /$pattern/i) {
		$link = $uri;
		last;
	    }
	}
    }

    # we haven't found anything
    return undef unless defined $link;

    # return link
    return URI->new_abs($link, $base);
}

=head1 COPYRIGHT

Copyright (c) 2001,2002 Ilya Martynov. All rights reserved.

This module is free software.  It may be used, redistributed and/or
modified under the terms of the Perl Artistic License.

=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>

=cut

1;