Skip Menu |

This queue is for tickets about the HTTP-Recorder CPAN distribution.

Report information
The Basics
Id: 20030
Status: open
Priority: 0/
Queue: HTTP-Recorder
People
Owner: Nobody in particular
Requestors: tolga [...] cpanel.net
Cc:
AdminCc:
Bug Information
Severity: Normal
Broken in: (no value)
Fixed in: (no value)

History Show all quoted text
  Wed Jun 21 15:19:32 2006 Guest - Ticket created
Subject: Frame Support and Patch for extra inserted newlines
I use HTTP::Recorder to generate test cases. Then I plug the generated code to my custom test module. I had to make some changes to the original source code to support frames and to be able to check HTML content in the responses. I have been using the SVN tarball that was recommended in the bug reports posted by neuhaus (can't locate object method "query_param...) http://www.bitmistress.org/websvn/dl.php?repname=HTTP%3A%3ARecorder&path=%2Ftrunk%2Flib%2FHTTP%2F&rev=0&isdir=1 The patch files I attached fix an issue where extra newlines get inserted in HTTP::Recorder. This causes a mismatch between WWW::Mechanize::content() (especially format => 'text') output and HTTP::Recorder recorded session. The patch basically removes some newlines. I use HTTP::Recorder as a base class and override modify_response() to keep track of frames as well as log HTML content via my custom logger class. The test code generated via my custom logger class uses the HTML content to verify the HTML responses. The patches also add 'rec-frame' tags and add support to handle 'target' attributes in links. I use these with my custom Logger. The test code generated uses the proper WWW::Mechanize agent that corresponds to the frame. I would appreciate if you could take a look and see if these files are useful. Regards, Tolga Ceylan
  Wed Jun 21 15:24:14 2006 Guest - Correspondence added
The patches did not show up in the original posting. Here we go...
--- HTTP/Recorder/Logger.pm 2006-01-08 14:35:01.000000000 -0600 +++ ../for_diff/HTTP/Recorder/Logger.pm 2006-06-21 13:17:43.000000000 -0500 @@ -90,7 +90,12 @@ @_ ); - $self->Log("get", "'$args{url}'"); + $self->Log( + "get", + "'$args{url}'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } sub FollowLink { @@ -103,14 +108,26 @@ if ($args{text}) { $args{text} =~ s/"/\\"/g; - $self->Log("follow_link", - "text => '$args{text}', n => '$args{index}'"); + $self->Log( + "follow_link", + "text => '$args{text}', n => '$args{index}'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } elsif ($args{url}) { - $self->Log("follow_link", - "url => '$args{url}'"); + $self->Log( + "follow_link", + "url => '$args{url}'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } else { - $self->Log("follow_link", - "n => '$args{index}'"); + $self->Log( + "follow_link", + "n => '$args{index}'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } } @@ -123,26 +140,46 @@ button_name => {}, button_value => {}, button_number => {}, + frame => '', + target => '', @_ ); - $self->SetForm(name => $args{name}, number => $args{number}); + $self->SetForm( + 'name' => $args{'name'}, + 'number' => $args{'number'}, + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); my %fields = %{$args{'fields'}}; + foreach my $field (keys %fields) { if ($fields{$field}{'type'} eq 'checkbox') { - $self->Check(name => $fields{$field}{'name'}, - value => $fields{$field}{'value'}); + $self->Check( + 'name' => $fields{$field}{'name'}, + 'value' => $fields{$field}{'value'}, + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } else { - $self->SetField(name => $fields{$field}{'name'}, - value => $fields{$field}{'value'}); + $self->SetField( + 'name' => $fields{$field}{'name'}, + 'value' => $fields{$field}{'value'}, + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } } + # use click instead of submit - $self->Click(name => $args{name}, - button_name => $args{button_name}, - button_value => $args{button_value}, - button_number => $args{button_number}, + $self->Click( + 'name' => $args{'name'}, + 'button_name' => $args{'button_name'}, + 'button_value' => $args{'button_value'}, + 'button_number' => $args{'button_number'}, + 'frame' => $args{'frame'}, + 'target' => $args{'target'} ); } @@ -153,9 +190,19 @@ ); if ($args{name}) { - $self->Log("form_name", "'$args{name}'"); + $self->Log( + 'form_name', + "'$args{name}'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } else { - $self->Log("form_number", $args{number}); + $self->Log( + 'form_number', + $args{number}, + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } } @@ -167,13 +214,18 @@ @_ ); - return unless $args{name}; + return unless $args{'name'}; # escape single quotes - $args{name} =~ s/'/\\'/g; - $args{value} =~ s/'/\\'/g if $args{value}; + $args{'name'} =~ s/'/\\'/g; + $args{'value'} =~ s/'/\\'/g if $args{'value'}; - $self->Log("field", "'$args{name}', '" . ($args{value} || '') . "'"); + $self->Log( + 'field', + "'$args{name}', '" . ($args{value} || '') . "'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } sub Check { @@ -190,7 +242,12 @@ $args{name} =~ s/'/\\'/g; $args{value} =~ s/'/\\'/g; - $self->Log("tick", "'$args{name}', '$args{value}'"); + $self->Log( + 'tick', + "'$args{name}', '$args{value}'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } sub UnCheck { @@ -207,7 +264,12 @@ $args{name} =~ s/'/\\'/g; $args{value} =~ s/'/\\'/g; - $self->Log("untick", "'$args{name}', '$args{value}'"); + $self->Log( + 'untick', + "'$args{name}', '$args{value}'", + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } sub Submit { @@ -232,7 +294,12 @@ # TODO: also support button value, number # Don't add this until WWW::Mechanize supports it - $self->Log("submit_form", $submitargs); + $self->Log( + 'submit_form', + $submitargs, + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } sub Click { @@ -248,7 +315,12 @@ # TODO: also support button value, number # Don't add this until WWW::Mechanize supports it - $self->Log("click", $clickargs); + $self->Log( + 'click', + $clickargs, + 'frame' => $args{'frame'}, + 'target' => $args{'target'} + ); } 1;
--- HTTP/Recorder.pm 2006-01-08 14:35:01.000000000 -0600 +++ ../for_diff/HTTP/Recorder.pm 2006-06-21 13:24:55.000000000 -0500 @@ -182,6 +182,7 @@ my $request = shift; my $response; + my $frame_name; # make a HTTP::Recorder::Request object my $newrequest = HTTP::Recorder::Request->new(request => $request, @@ -232,6 +233,18 @@ } else { my $values = $newrequest->get_params; my $action = $values->{"$self->{prefix}-action"}; + + # try to get the frame name if target exists, then + # that's our frame name, if not try to use rec-frame + # that we have inserted previously. + # + $frame_name = $values->{"$self->{'prefix'}-target"} + || $values->{"$self->{'prefix'}-frame"}; + if ($frame_name) { + # remove the prefix + $frame_name =~ s/^$self->{'prefix'}//; + } + if ( $self->{ignore_favicon} && $newrequest->uri->path =~ /favicon\.ico$/i) { # don't do anything @@ -268,7 +281,7 @@ # don't try to modify the content unless it's text/html if ($content_type =~ m#^text/html#i) { - $self->modify_response($response); + $self->modify_response($response,$frame_name); } } @@ -284,9 +297,15 @@ # log the actions if ($action eq "follow") { - $self->{logger}->FollowLink(text => $values->{"$self->{prefix}-text"} || "", - index => $values->{"$self->{prefix}-index"} || "", - url => uri_unescape($values->{"$self->{prefix}-url"})); + + $self->{logger}->FollowLink( + 'text' => $values->{"$self->{prefix}-text"} || '', + 'index' => $values->{"$self->{prefix}-index"} || '', + 'url' => uri_unescape($values->{"$self->{prefix}-url"}), + 'target' => $values->{"$self->{prefix}-target"} || '', + 'frame' => $values->{"$self->{prefix}-frame"} || '' + ); + } elsif ($action eq "submitform") { my %fields; my ($btn_name, $btn_value, $btn_number); @@ -321,11 +345,15 @@ } } - $self->{logger}->SetFieldsAndSubmit(name => $values->{"$self->{prefix}-formname"}, - number => $values->{"$self->{prefix}-formnumber"}, - fields => \%fields, - button_name => $btn_name, - button_value => $btn_value); + $self->{logger}->SetFieldsAndSubmit( + 'name' => $values->{"$self->{'prefix'}-formname"}, + 'number' => $values->{"$self->{'prefix'}-formnumber"}, + 'fields' => \%fields, + 'button_name' => $btn_name, + 'button_value' => $btn_value, + 'frame' => $values->{"$self->{'prefix'}-frame"}, + 'target' => $values->{"$self->{'prefix'}-target"} + ); # log a blank line to give the code a little breathing room $self->{logger}->LogLine(); @@ -336,6 +364,12 @@ sub modify_response { my $self = shift; my $response = shift; + + # we'll use this to tag links/forms on this page, so that we + # can figure out which frame is issuing the request later. + # + my $frame_name = shift; + my $formcount = 0; my $formnumber = 0; my $linknumber = 1; @@ -392,22 +427,36 @@ if ($attrs->{'href'} =~ m/^javascript:/i) { $js_href = 1; } else { + my $target = $attrs->{'target'}; if ($tagname eq 'a') { - $attrs->{'href'} = - $self->rewrite_href($attrs->{'href'}, - $text, - $index, - $response->base); + $attrs->{'href'} = $self->rewrite_href( + { 'href' => $attrs->{'href'}, + 'text' => $text, + 'index' => $index, + 'base' => $response->base, + 'target' => $target, + 'frame' => $frame_name, + } + ); + } elsif ($tagname eq 'area') { - $attrs->{'href'} = - $self->rewrite_href($attrs->{'href'}, - '', - $index, - $response->base); + $attrs->{'href'} = $self->rewrite_href( + { 'href' => $attrs->{'href'}, + 'text' => '', + 'index' => $index, + 'base' => $response->base, + 'target' => $target, + 'frame' => $frame_name, + } + ); } elsif ($tagname eq 'link') { - $attrs->{'href'} = - $self->rewrite_linkhref($attrs->{'href'}, - $response->base); + $attrs->{'href'} = $self->rewrite_linkhref( + { 'href' => $attrs->{'href'}, + 'base' => $response->base, + 'target' => $target, + 'frame' => $frame_name, + } + ); } } $linknumber++; @@ -427,7 +476,7 @@ $fieldname = $attrs->{name}; $formfield = ($fieldprefix . '-' . $fieldtype . '-' . $fieldname); - $newcontent .= "<input type=\"hidden\" name=\"$formfield\" value=1>\n"; + $newcontent .= "<input type=\"hidden\" name=\"$formfield\" value=1>"; } } @@ -441,12 +490,18 @@ # - it's not a hidden field $newcontent .= (" ".$attr."=\"".$attrs->{$attr}."\""); } - $newcontent .= (">\n"); + $newcontent .= (">"); if ($tagname eq 'form') { if ($formcount == 1) { - $newcontent .= $self->rewrite_form_content($attrs->{name} || "", - $formnumber, - $response->base); + $newcontent .= $self->rewrite_form_content( + { + 'name' => $attrs->{'name'} || '', + 'number' => $formnumber, + 'url' => $response->base, + 'frame' => $frame_name, + 'target' => $attrs->{'target'} || '', + } + ); } } } elsif (@$token[0] eq 'E') { @@ -455,13 +510,13 @@ if (!$basehref) { $basehref = $response->base; $basehref->scheme('http') if $basehref->scheme eq 'https'; - $newcontent .= "<base href=\"" . $basehref . "\">\n"; + $newcontent .= "<base href=\"" . $basehref . "\">"; } $basehref = ""; $in_head = 0; } $newcontent .= ("</"); - $newcontent .= ($tagname.">\n"); + $newcontent .= ($tagname.">"); if ($tagname eq 'form') { $formcount--; } elsif ($tagname eq 'a' || $tagname eq 'link') { @@ -480,11 +535,14 @@ } sub rewrite_href { - my $self = shift; - my $href = shift || ""; - my $text = shift || ""; - my $index = shift || 1; - my $base = shift; + my ($self, $arg_ref) = @_; + + my $href = $arg_ref->{'href'} || ''; + my $text = $arg_ref->{'text'} || ''; + my $index = $arg_ref->{'index'} || 1; + my $base = $arg_ref->{'base'}; + my $target = $arg_ref->{'target'}; + my $frame = $arg_ref->{'frame'}; my $newhref = new URI($href); my $prefix = $self->{prefix}; @@ -505,13 +563,23 @@ $newhref->query_param_append( "$prefix-text", $text); $newhref->query_param_append( "$prefix-index", $index); + if ($target) { + $newhref->query_param_append( "$prefix-target", $target); + } + if ($frame) { + $newhref->query_param_append( "$prefix-frame", $frame); + } + return $newhref; } sub rewrite_linkhref { - my $self = shift; - my $href = shift || ""; - my $base = shift; + my ($self, $arg_ref) = @_; + + my $href = $arg_ref->{'href'} || ''; + my $base = $arg_ref->{'base'}; + my $target = $arg_ref->{'target'}; + my $frame = $arg_ref->{'frame'}; my $newhref = new URI($href); my $prefix = $self->{prefix}; @@ -525,23 +593,41 @@ # the action (i.e. don't record) $newhref->query_param_append( "$prefix-action", 'norecord'); + if ($target) { + $newhref->query_param_append( "$prefix-target", $target); + } + if ($frame) { + $newhref->query_param_append( "$prefix-frame", $frame); + } + return $newhref; } sub rewrite_form_content { - my $self = shift; - my $name = shift || ""; - my $number = shift; - my $url = shift; + my ($self, $arg_ref) = @_; + + my $name = $arg_ref->{'name'} || ''; + my $number = $arg_ref->{'number'} ; + my $url = $arg_ref->{'url'} ; + my $frame = $arg_ref->{'frame'}; + my $target = $arg_ref->{'target'}; + my $fields; my $https = 1 if ($url->scheme eq 'https'); - $fields .= ("<input type=hidden name=\"$self->{prefix}-action\" value=\"submitform\">\n"); - $fields .= ("<input type=hidden name=\"$self->{prefix}-formname\" value=\"$name\">\n"); - $fields .= ("<input type=hidden name=\"$self->{prefix}-formnumber\" value=\"$number\">\n"); + $fields .= ("<input type=hidden name=\"$self->{prefix}-action\" value=\"submitform\">"); + $fields .= ("<input type=hidden name=\"$self->{prefix}-formname\" value=\"$name\">"); + $fields .= ("<input type=hidden name=\"$self->{prefix}-formnumber\" value=\"$number\">"); + + if ($frame) { + $fields .= ("<input type=hidden name=\"$self->{prefix}-frame\" value=\"$frame\">"); + } + if ($target) { + $fields .= ("<input type=hidden name=\"$self->{prefix}-target\" value=\"$target\">"); + } if ($https) { - $fields .= ("<input type=hidden name=\"$self->{prefix}-https\" value=\"$https\">\n"); + $fields .= ("<input type=hidden name=\"$self->{prefix}-https\" value=\"$https\">"); } return $fields;
package CustomHTTPRecorder; use strict; use warnings; use version; our $VERSION = qv('0.0.1'); use HTTP::Recorder; use Data::Dumper; use HTML::TreeBuilder; use base qw(HTTP::Recorder); sub new { my $class = shift; my $self = $class->SUPER::new(@_); bless $self, $class; $self->{'frames'} = {}; return $self; } sub modify_response { my $self = shift; my $response = shift; my $frame_name = shift || ''; # # check the response if it has frames in it. # if ( $response->is_success() && $response->content() =~ /html/) { my $tree = HTML::TreeBuilder->new(); $tree->parse($response->content()); $tree->eof(); $tree->elementify(); # Record these frames # my @frames = $tree->look_down('_tag','frame'); if (scalar @frames > 0) { foreach my $frame (@frames) { my $name = $frame->attr('name'); my $src = $frame->attr('src'); # check if the src is absolute or relative if ($src =~ m{ \A / }xms ) { # prepend the base url to this. # my $req = $response->request(); if ($req) { my $uri = $req->uri(); if ($uri !~ m{ \A / } ) { # remove excess '/' $uri =~ s/\/$//; $src =~ s/^\///; $src = $uri . '/' . $src; } } } $self->{'frames'}->{$src} = $name; } } } if (!$frame_name) { # # Check if the request for this response corresponds # to any frames recorded before. # my $req = $response->request(); if ($req && $req->uri()) { my $uri = $req->uri(); foreach my $frame_uri (keys %{ $self->{'frames'} }) { if ($frame_uri eq $uri) { $frame_name = $self->{'frames'}->{$frame_uri}; # to prevent accidental matches against this frame url # in subsequent requests (which can actually call the frame # url later) delete this frame record. # delete $self->{'frames'}->{$frame_uri}; } } } } $self->SUPER::modify_response($response,$frame_name); $self->{'logger'}->LogContent($response->content(),$frame_name); return ; } 1;
package CustomHTTPRecorderLogger; use strict; use warnings; use version; our $VERSION = qv('0.0.1'); use Carp; use HTML::TreeBuilder; use HTTP::Recorder::Logger; our @ISA = qw( HTTP::Recorder::Logger); ################################################################ # This is the modified version of the original SUPER::LogContent # It outputs 2 perl lines; a string variable containing the # HTML text, and the regex test line to check the contents. ################################################################ sub LogContent { my $self = shift; my $content = shift; my $frame_name = shift; my $content_txt; my $scriptfile = $self->{'file'}; open my $fh, '>>', $scriptfile || croak "Failed to append to $scriptfile: $!"; # parse the content, and strip the HTML tags, # to convert it to TEXT # # this sucks. Clean this up. There should be a better # way to check if content is HTML if ($content =~ /html/) { my $tree = HTML::TreeBuilder->new(); $tree->parse($content); $tree->eof(); $tree->elementify(); # find frame src, name and id # my @frames = $tree->look_down('_tag','frame'); if (scalar @frames > 0) { print {$fh} "\n#---------------------------------\n"; print {$fh} "# Detected Frames:\n"; foreach my $frame (@frames) { my $name = $frame->attr('name'); print {$fh} "#frame_name = $name\n"; } print {$fh} "#---------------------------------\n"; } else { $content_txt = $tree->as_text(); } $tree->delete; if ($content_txt) { print {$fh} "\n#-------------------------------------\n"; print {$fh} qq{\$match = "$content_txt";\n}; print {$fh} "\n"; if ($frame_name) { print {$fh} "ok(\$agent_hash_ref->{'" .$frame_name ."'}->get_content() =~ m/\$match/ms,\n"; } else { print {$fh} "ok(\$agent->get_content() =~ m/\$match/ms,\n"; } print {$fh} " \'checking if HTML response is ok\');\n"; print {$fh} "#-------------------------------------\n"; } } close $fh || croak "Failed to close $scriptfile: $!"; } ################################################################ # Append the line to the logfile ################################################################ sub _append_log { my ($self, $line) = @_; my $scriptfile = $self->{'file'}; open my $fh, '>>',$scriptfile || croak "Failed to append to $scriptfile: $!"; print {$fh} $line; close $fh || croak "Failed to close $scriptfile: $!"; } ################################################################ # Modified version of SUPER::Log. Calls LogMore ################################################################ sub Log { my $self = shift; my $function = shift; my $args = shift || ''; my %remaining_args = (@_); $self->LogMore( { 'function' => $function, 'args' => $args, 'frame' => $remaining_args{'frame'}, 'target' => $remaining_args{'target'}, } ); } ################################################################ # Modified version of SUPER::Log. Encloses the output in a ok() # call for Test::More and handles frames and target attributes. # ################################################################ sub LogMore { my ($self, $arg_ref) = @_; my $function = $arg_ref->{'function'}; my $args = $arg_ref->{'args'} || ''; # Note the target/frame magic here. Basically, if the results # of the action will be displayed on a specific frame (target # HTML attribute), then we use 'target', but if there's no # target, then we check if we know which frame we are in # using 'frame' argument. # my $frame = $arg_ref->{'target'} || $arg_ref->{'frame'} || ''; return unless $function; my $line; if ($frame) { $line = "ok(\$agent_hash_ref" . q/->{'/ . $frame . q/'}/ . "->${function}(${args}),\n \'Check ${function}\');\n"; } else { $line = "ok(\$agent->${function}(${args}),\n \'Check ${function}\');\n"; } $self->_append_log($line); } ################################################################ # A modified version of SUPER::FollowLink subroutine. # HTTP::Recorder messes up the ordering of links. To fix this, # We should use explicit "url=>" argument in follow_links() instead of # "text=>" or "n=>" . ################################################################ sub FollowLink { my $self = shift; my %args = ( @_); my $function; my $function_args; # we must translate this into 'get' if target is defined. If target # is defined, then this actually means a get in another frame. # if ($args{'target'}) { $function = 'get'; $function_args = "\'$args{'url'}\'"; } else { $function = 'follow_link'; $function_args = "'url' => \'$args{'url'}\'"; } $self->LogMore( { 'function' => $function, 'args' => $function_args, 'frame' => $args{'frame'}, 'target' => $args{'target'}, } ); } 1;
  Wed Jun 21 15:24:18 2006 The RT System itself - Status changed from 'new' to 'open'