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);
}
[download]

Regards,

Gregorovius

---

---

• Are you posting in the right place? Check out Where do I post X? to know for sure.
• Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:

  <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>

• Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
• Want more info? How to link or How to display code and escape characters are good places to start.