I thought about doing it but it's just too large to be practical. Maybe a bit of the more interesting code can do instead. Here's the code for the web proxy that generates the perl scripts that reproduce user behavior:

(Note that the generated script uses a module called NetscapeLikeUA; this is a subclass of LWP::UserAgent that will follow redirects after POST requests, unlike the standard dictates but as Netscape does --see the sourcforge tarball for it)

#!/usr/bin/perl -w use strict; use HTTP::Daemon; use LWP::UserAgent; use Data::Dumper; use URI::Escape qw(uri_unescape uri_escape); $Data::Dumper::Varname = 'req'; $Data::Dumper::Purity = 1; use RoboWeb::Util qw(pristine_please); my $listen_port = 8080; my $logfile = '/tmp/proxy_log'; sub _gen_page_fetch { my $request = shift; my $path = $request->uri->path(); my $url = $request->uri->as_string(); # we don't test for images being there. return unless ($path !~ /(gif|jpg|jpeg)$/); # don't save the cookies $request->header('Cookie' => ''); my $req_code = Dumper $request; $req_code = uri_escape($req_code); open LOG, ">>$logfile" or die "could not open $logfile"; print LOG "# print STDERR \"fetching $url\\n\\n\";\n\n"; print LOG "\$req_code = uri_unescape(q{$req_code\});\n"; print LOG "eval(\$req_code);\n"; print LOG "die \"badly frozen request \$!\" if \$\@;\n"; print LOG "\$cookie_jar->add_cookie_header(\$req1);\n"; print LOG "\$resp = \$ua->request(\$req1);\n"; print LOG "die \"could not fetch URL $url\" unless(\$resp->is_succ +ess());\n"; print LOG "\$cookie_jar->extract_cookies(\$resp);\n"; print LOG "\$html = \$resp->content();\n"; print LOG "#print STDERR \$html;\n"; print LOG "#print STDERR \"\\n\\n\", '*' x 70, \"\\n\\n\";"; print LOG "\n\n\n\n"; close LOG; } sub _start_rec { &pristine_please; open LOG, ">$logfile" or die "could not open $logfile"; print LOG "#!/usr/bin/perl -w\n\n"; print LOG "use RoboWeb::NetscapeLikeUA;\n"; print LOG "use HTTP::Cookies;\n"; print LOG "use URI::http;\n"; print LOG "use URI::Escape qw(uri_unescape);\n\n"; print LOG "print \"1..__REPLACE_NUM_TESTS__\\n\";\n\n"; print LOG "my (\$req1, \$resp, \$html);\n"; print LOG "my \$cookie_jar = HTTP::Cookies->new;\n"; print LOG "my \$ua = RoboWeb::NetscapeLikeUA->new;\n\n\n"; close LOG; } sub _end_rec { my $filename = shift; $filename =~ s/\W//g; $filename = $filename || 'HERE_I_AM'; $filename .= '.t'; open LOG, "$logfile" or die "could not open $logfile"; open OUTF, ">$filename" or die "could not open /tmp/$filename"; my $text; { local $/ = undef; # slurp mode $text = <LOG>; close LOG; } my $i = 1; $i++ while $text =~ s/__REPLACE_ME__/$i/; $i--; $text =~ s/__REPLACE_NUM_TESTS__/$i/; print OUTF $text; close OUTF; print "Created file: $filename\n"; } sub _must_match { my $path = shift; open LOG, ">>$logfile" or die "could not open $logfile"; print LOG "print 'not ' unless \$html =~ $path;\n"; print LOG "print \"ok __REPLACE_ME__\\n\";\n\n\n"; close LOG; } sub _must_not_match { my $path = shift; open LOG, ">>$logfile" or die "could not open $logfile"; print LOG "print 'not ' unless \$html !~ $path;\n"; print LOG "print \"ok __REPLACE_ME__\\n\";\n\n\n"; close LOG; } my ($req, $resp, $html); my $ua = LWP::UserAgent->new; my $d = new HTTP::Daemon LocalPort => $listen_port; print "I'll be your proxy today. Please contact me at: <URL:", $d->url +, ">\n"; while (my $c = $d->accept) { while (my $r = $c->get_request) { my $serv = $r->uri->host; my $path = $r->uri->path; my $port = $r->uri->port; print STDERR "Getting $serv - $path - $port\n"; if($serv =~ /start_rec$/i) { _start_rec(); } elsif($serv =~ /end_rec$/i) { _end_rec($path); } elsif($serv =~ /must_match$/i) { _must_match($path); } elsif($serv =~ /must_not_match$/i) { _must_not_match($path); } elsif($serv =~ /pristine$/i) { &pristine_please; } else { # proxy code # XXX change port of the request $resp = $ua->request($r); _gen_page_fetch($r); $c->send_response($resp); } } $c->close; undef($c); }
Regards,

Gregorovius


In reply to Re: (gregorovius) Web Application Test Suite Generator by gregorovius
in thread Web Application Test Suite Generator by gregorovius

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":