golemwashere has asked for the wisdom of the Perl Monks concerning the following question:
http://212.31.252.200/test/benchmark/1.asp (here I setup an ASP session variable and collect a post param)
http://212.31.252.200/test/benchmark/2.asp (here I should print the session variable ,if the cookie was successfully resent and the POSTed param)
Could you suggest me some fine excape?
many thanks yours
G.
P.S. obviuosly the code skeletorn is not mine, I just lost the reference to the author, I'll postit as soon I find it back. 8)
#!/usr/bin/perl -w use LWP::Parallel::UserAgent; use Time::HiRes qw(gettimeofday tv_interval); use strict; use HTTP::Cookies; use CGI; ###### debug LWP #use LWP::Debug qw(+); ###################################################################### +######## ### # Configuration ### my $nof_parallel_connections = 1; # reqs per session my $nof_requests_total = 1; ## timeout (seconds) my $timeout = 10; ## array of urls to call my @urls = ( 'http://212.31.252.200/test/benchmark/1.asp', 'http://212.31.252.200/test/benchmark/2.asp', ); ## params to POST to the preceeding URLs # encoded # I know this ain't nice but will fix it later my $param1="text1=".&URL_Encode("5 dd"); my @params = ( '', $param1, ); ## use Cookies my $COOKIES=1; # use basic auth my $AUTH=0; my $idauth="golem"; my $pwdauth="washere"; #debug : print pages received my $OUTPUTDEBUG=1; # debug : save errors in out.txt my $ERRDEBUG=0; # debug : print http requests my $REQUEST=0; # cookies variables my $SEENCOOKIE=0; my $cookies = HTTP::Cookies->new; my $savedcookies=""; ###################################################################### +############ ################################################## # Derived Class for latency timing ################################################## package MyParallelAgent; @MyParallelAgent::ISA = qw(LWP::Parallel::UserAgent); use strict; ### # This Is called when connection is opened ### sub on_connect { my ($self, $request, $response, $entry) = @_; # cookies ######## if ($SEENCOOKIE) { print "***********I have seen cookies and I'm using them*********\n" +; # tried all these: #print $savedcookies; $cookies->revert; #$cookies>set_cookie($savedcookies); #$cookies->load(); } $self->{__start_times}->{$entry} = [Time::HiRes::gettimeofday]; } ### # This is called when connection is closed ### sub on_return { my ($self, $request, $response, $entry) = @_; my $start = $self->{__start_times}->{$entry}; $self->{__latency_total} += Time::HiRes::tv_interval($start); # cookies seen for first time if (!($SEENCOOKIE)) { $cookies->extract_cookies($response); $savedcookies=$cookies->as_string(); print "I received this cookie string:\n"; print $savedcookies; $SEENCOOKIE=1; } if ($OUTPUTDEBUG) { print "\n pagina ".$request->url; print "\n****** :\n".$response->content; } ## debug : print errors # if ($ERRDEBUG) { if (!($response->is_success)) { open OUT, ">>out.txt" or die "Cannot open out.txt for write :$!"; print OUT "\n*************** error on: ".$request->url; print OUT "\n*************** error type: ".$response->error_as_HTM +L; print OUT "\n*************** error page from server: ".$response-> +content; close OUT; } } #######################à } sub on_failure { on_return(@_); # Same procedure } ### # Access function for new instance var ### sub get_latency_total { return shift->{__latency_total}; } ################################################## package main; ################################################## ### # Init parallel user agent ### my $ua = MyParallelAgent->new(); $ua->agent("Mozilla/4.76 [en] (Windows NT 5.0; U)"); $ua->max_req($nof_parallel_connections); $ua->redirect(1); # follow redirects #$ua->in_order (1); # segui nell'ordine di registrazione ### # Register all requests ### foreach (1..$nof_requests_total) { # POST params counter my $ct=0; foreach my $url (@urls) { my $request = HTTP::Request->new('POST', $url); $request->content_type('application/x-www-form-urlencoded'); $request->content($params[$ct]); # basic auth if ($AUTH) { $request->authorization_basic($idauth, $pwdauth); } ### debug : print http request if ($REQUEST) { print $request->as_string(); } $ct++; $ua->register($request); } } ### # Launch processes and check time ### my $start_time = [gettimeofday]; my $results = $ua->wait($timeout); my $total_time = tv_interval($start_time); ### # Requests all done, check results ### my $succeeded = 0; my %errors = (); foreach my $entry (values %$results) { my $response = $entry->response(); if($response->is_success()) { $succeeded++; # Another satisfied customer ###### } else { # Error, save the message $response->message("TIMEOUT") unless $response->code(); $errors{$response->message}++; } } ### # Format errors if any from %errors ### my $errors = join(',', map "$_ ($errors{$_})", keys %errors); $errors = "NONE" unless $errors; ### # Format results ### #@urls = map {($_,".")} @urls; my @P = ( "URL(s)" => join("\n", @urls), "Total Requests" => "$nof_requests_total", "Parallel Agents" => $nof_parallel_connections, "Succeeded" => sprintf("$succeeded (%.2f%%)\n", $succeeded * 100 / $nof_requests_to +tal), "Errors" => $errors, "Total Time" => sprintf("%.2f secs\n", $total_time), "Throughput" => sprintf("%.2f Requests/sec\n", $nof_requests_total / $total_time), "Latency" => sprintf("%.2f secs/Request", ($ua->get_latency_total() || 0) / $nof_requests_total), ); my ($left, $right); ### # Print out statistics ### print "\n#################### results #################\n"; foreach (@P) { print "$_ \n"; } exit; # Usage : $URL_encoded = &URL_Encode("$plaintext"); sub URL_Encode { my($text) = $_[0]; # text to URL encode $text=CGI::escape($text); return $text; # return URL encoded text }
Edit Masem 2001-09-17 - Code Tags and other formatting
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Use of cookies in LWP::Parallel
by perrin (Chancellor) on Sep 17, 2001 at 19:11 UTC | |
|
Re: Cookie blues with LWP
by golemwashere (Acolyte) on Sep 17, 2001 at 14:45 UTC |