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

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

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

Modified Files:
	Click.pm 
Log Message:
Added method find_base

Index: Click.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest/lib/HTTP/WebTest/Plugin/Click.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Click.pm	21 Feb 2002 01:43:35 -0000	1.1
--- Click.pm	24 Mar 2002 11:02:26 -0000	1.2
***************
*** 62,92 ****
  
      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) {
--- 62,113 ----
  
      if(defined $link) {
! 	my $link = $self->find_link(response => $response,
  				    pattern => $link);
  
  	$request->uri($link) if defined $link;
+     } elsif(defined $button) {
+ 	my $base = $self->find_base($request);
+ 	# find form and button name
+ 	my($form, $name) = $self->find_form();
      }
  }
  
+ sub find_base {
+     my $self = shift;
+     my $response = shift;
+ 
+     my $base = $response->base;
+     my $content = $response->content;
+ 
+     # look for base tag inside head tag
+     my $parser = HTML::TokeParser->new(\$content);
+     my $token = $parser->get_tag('head');
+     if(defined $token) {
+ 	$token = $parser->get_tag('base', '/head');
+ 	if($token->[0] eq 'base') {
+ 	    $base = $token->[1]{href};
+ 	}
+     }
+ 
+     return $base;
+ }
+ 
  sub find_link {
      my $self = shift;
      my %param = @_;
  
!     my $response = $param{response};
!     my $pattern  = $param{pattern};
  
!     my $base    = $self->find_base($response);
!     my $content = $response->content;
! 
!     # look for matching link tag
!     my $parser = HTML::TokeParser->new(\$content);
      my $link = undef;
!     while(my $token = $parser->get_tag('a')) {
  	my $uri = $token->[1]{href};
  	next unless defined $uri;
! 	if($token->[0] eq 'a') {
  	    my $text = $parser->get_trimmed_text('/a');
  	    if($text =~ /$pattern/i) {