Page Loading Times Test

#!/usr/bin/perl # # The contents of this file are subject to the Mozilla Public # License Version 1.1 (the "License"); you may not use this file # except in compliance with the License. You may obtain a copy of # the License at http://www.mozilla.org/MPL/ # # Software distributed under the License is distributed on an "AS # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or # implied. See the License for the specific language governing # rights and limitations under the License. # # The Original Code is Mozilla page-loader test, released Aug 5, 2001 # # The Initial Developer of the Original Code is Netscape # Communications Corporation. Portions created by Netscape are # Copyright (C) 2001 Netscape Communications Corporation. All # Rights Reserved. # # Contributor(s): # John Morrison , original author # # use strict; use CGI::Request; use CGI::Carp qw(fatalsToBrowser); use Time::HiRes qw(gettimeofday tv_interval); use POSIX qw(strftime); use DBI; # list of test pages, JS to insert, httpbase, filebase, etc. use PageData; use vars qw(%params $req $cgi $dbh $pagedata $gStartNow $gStartNowStr $gResponseNow $gLogging); $gStartNow = [gettimeofday]; # checkpoint the time $gStartNowStr = strftime "%Y%m%d%H%M%S", localtime; $gLogging = 1; $req = new CGI::Request; # get the HTTP/CGI request $cgi = $req->cgi; $pagedata = PageData->new; setDefaultParams(); #XXXdebugcrap #warn $params{index}, " ", $params{maxidx}; if (!defined($req->param('delay'))) { # give the user a form to pick options (but note that going # to "loader.pl?delay=1000" immediately starts the test run outputForm(); } elsif (!$req->param('id')) { initialize(); # do redirect to start the cycle } elsif ($params{index} > $params{maxidx}) { redirectToReport(); # the test is over; spit out a summary markTestAsComplete(); # close the meta table entry } elsif (!isRequestStale()) { outputPage(); # otherwise, keep dishing out pages updateDataBase(); # client has the response; now write out stats to db } # cleanup $req = undef; $dbh->disconnect() if $dbh; # not strictly required (ignored in some cases anyways) logMessage(sprintf("Page load server responded in %3d msec, total time %3d msec, pid: %d", 1000*tv_interval($gStartNow, $gResponseNow), 1000*tv_interval($gStartNow), $$)) if $gResponseNow; # log only when a test page has been dished out exit 0; ####################################################################### sub logMessage { print STDERR strftime("[%a %b %d %H:%M:%S %Y] ", localtime), @_, "\n" if $gLogging; } sub isRequestStale { my $limit = 30*60; # 30 minutes, although if we never stalled on mac I'd make it 3 minutes my $ts = decodeHiResTime($params{s_ts}); my $delta = tv_interval($ts, $gStartNow); return undef if $delta < $limit; # otherwise, punt this request print "Content-type: text/html\n\n"; print <<"ENDOFHTML"; Page Loading Times Test

The timestamp on the request is too old to continue:
s_ts=$params{s_ts} was $delta seconds ago. Limit is $limit seconds.

ENDOFHTML return 1; # it's stale } sub initialize { updateMetaTable(); createDataSetTable(); # start the test by bouncing off of an echo page my $script = $cgi->var("SCRIPT_NAME"); my $server = $cgi->var("SERVER_NAME"); my $prot = "http://"; #XXX need a way to check/set 'https' my $me = $prot . $server . $script; $script =~ /^(.*\/).*$/; my $loc = "Location: ". $prot . $server . $1 . "echo.pl?"; for (qw(id index maxcyc delay replace nocache timeout)) { $loc .= "$_=$params{$_}\&"; } $loc .= "url=" . $me; print $loc, "\n\n"; } sub redirectToReport { # n.b., can also add '&sort=1' to get a time sorted list my $prot = "http://"; my $loc = "Location: " . $prot . $cgi->var("SERVER_NAME"); $cgi->var("SCRIPT_NAME") =~ /^(.*\/).*$/; $loc .= $1 . "report.pl?id=" . $params{id}; print $loc, "\n\n"; } sub generateTestId { # use the epoch time, in hex, plus a two-character random. return sprintf "%8X%02X", time(), int(256*rand()); } sub setDefaultParams { $params{id} = $req->param('id') || generateTestId(); # "unique" id for this run $params{index} = $req->param('index') || 0; # request index for the test $params{maxcyc} = defined($req->param('maxcyc')) ? $req->param('maxcyc') : 3; # max visits (zero-based count) $params{delay} = $req->param('delay') || 1000; # setTimeout on the next request (msec) $params{replace} = $req->param('replace') || 0; # use Location.replace (1) or Location.href (0) $params{nocache} = $req->param('nocache') || 0; # serve content via uncacheable path $params{c_part} = $req->param('c_part') || 0; # client time elapsed; page head to onload (msec) $params{c_intvl} = $req->param('c_intvl') || 0; # client time elapsed; onload to onload event (msec) $params{c_ts} = $req->param('c_ts') || 0; # client timestamp (.getTime()) (msec) $params{content} = $req->param('content') || "UNKNOWN"; # name of content page for this data $params{s_ts} = $req->param('s_ts') || undef; # server timestamp; no default $params{timeout} = $req->param('timeout') || 30000; # msec; timer will cancel stalled page loading $params{maxidx} = ($params{maxcyc}+1) * $pagedata->length; # total pages loads to be done $params{curidx} = $params{index} % $pagedata->length; # current request index into page list $params{curcyc} = int(($params{index}-1) / $pagedata->length); # current "cycle" (visit) } sub outputPage { my $relpath = $pagedata->url($params{curidx}); my $file = $pagedata->filebase . $relpath; open (HTML, "<$file") || die "Can't open file: $file, $!"; my $hook = "\n"; my $basepath = $pagedata->httpbase; $basepath =~ s#^(.*?)(/base/)$#$1/nocache$2# if ($params{nocache}); $hook .= ""; my $magic = $pagedata->magicString; my $content = ""; while () { s/$magic/$hook/; $content .= $_; } # N.B., these two cookie headers are obsolete, since I pass server info in # JS now, to work around a bug in winEmbed with document.cookie. But # since I _was_ sending two cookies as part of the test, I have to keep # sending two cookies (at least for now, and it's not a bad thing to test) #XXX other headers to test/use? $gResponseNow = [gettimeofday]; # for logging { # turn on output autoflush, locally in this block local $| = 1; print "Set-Cookie: moztest_SomeRandomCookie1=somerandomstring\n"; print "Set-Cookie: moztest_SomeRandomCookie2=somerandomstring\n"; print "Content-type: text/html\n\n"; print $content; } return; } sub encodeHiResTime { my $timeref = shift; return unless ref($timeref); return $$timeref[0] . "-" . $$timeref[1]; } sub decodeHiResTime { my $timestr = shift; return [ split('-', $timestr) ]; } sub elapsedMilliSeconds { my ($r_time, $timestr) = @_; return "NaN" unless $timestr; my $delta = tv_interval( [ split('-', $timestr) ], $r_time ); my $delta = int(($delta*1000) - $params{delay}); # adjust for delay (in msec) return $delta; } sub updateDataBase { connectToDataBase(); # (may already be cached) updateMetaTable(); updateDataSetTable() unless $params{c_part} == -1; # the initial request } sub connectToDataBase { # don't reconnect if already connected. (Other drivers provide this # for free I think, but not this one). if (!ref($dbh)) { $dbh = DBI->connect("DBI:CSV:f_dir=./db", {RaiseError => 1, AutoCommit => 1}) || die "Cannot connect: " . $DBI::errstr; } } # # Holds the individual page load data for this id. # # (Of course, this should really be a single table for all datasets, but # that was becoming punitively slow with DBD::CSV. I could have moved to # a "real" database, but I didn't want to make that a requirement for # installing this on another server and using this test (e.g., install a # few modules and you can run this; no sql installation/maintenance required). # At some point though, I may switch to some sql db, but hopefully still allow # this to be used with a simple flat file db. (Hmm, maybe I should try a *dbm # as a compromise (disk based but indexed)). # sub createDataSetTable { my $table = "t" . $params{id}; return if -f "db/$table"; # don't create it if it exists logMessage("createDataSetTable:\tdb/$table"); connectToDataBase(); # cached my ($sth, $sql); $sql = qq{ CREATE TABLE $table (DATETIME CHAR(14), ID CHAR(10), INDEX INTEGER, CUR_IDX INTEGER, CUR_CYC INTEGER, C_PART INTEGER, S_INTVL INTEGER, C_INTVL INTEGER, CONTENT CHAR(128) ) }; $sth = $dbh->prepare($sql); $sth->execute(); $sth->finish(); return 1; } # # holds the information about all test runs # sub createMetaTable { my $table = shift; return if -f "db/$table"; # don't create it if it exists logMessage("createMetaTable:\tdb/$table"); my ($sth, $sql); $sql = qq{ CREATE TABLE $table (DATETIME CHAR(14), LASTPING CHAR(14), ID CHAR(8), INDEX INTEGER, CUR_IDX INTEGER, CUR_CYC INTEGER, CUR_CONTENT CHAR(128), STATE INTEGER, BLESSED INTEGER, MAXCYC INTEGER, MAXIDX INTEGER, REPLACE INTEGER, NOCACHE INTEGER, DELAY INTEGER, REMOTE_USER CHAR(16), HTTP_USER_AGENT CHAR(128), REMOTE_ADDR CHAR(15), USER_EMAIL CHAR(32), USER_COMMENT CHAR(256) ) }; $sth = $dbh->prepare($sql); $sth->execute(); $sth->finish(); warn 'created meta table'; return 1; } sub updateMetaTable { connectToDataBase(); # if not already connected my $table = "tMetaTable"; createMetaTable($table); # just returns if already created my ($sth, $sql); $sql = qq{ SELECT INDEX, MAXCYC, MAXIDX, REPLACE, NOCACHE, DELAY, REMOTE_USER, HTTP_USER_AGENT, REMOTE_ADDR FROM $table WHERE ID = "$params{id}" }; $sth = $dbh->prepare($sql); $sth->execute(); my @dataset = (); while (my @data = $sth->fetchrow_array()) { push @dataset, {index => shift @data, maxcyc => shift @data, maxidx => shift @data, replace => shift @data, nocache => shift @data, delay => shift @data, remote_user => shift @data, http_user_agent => shift @data, remote_addr => shift @data }; } $sth->finish(); warn "More than one ID: $params{id} ??" if scalar(@dataset) > 1; if (scalar(@dataset) == 0) { # this is a new dataset and id initMetaTableRecord($table); return; } #XXX need to check that values are sane, and not update if they don't # match certain params. This should not happen in a normal test run. # However, if a test url was bookmarked or in history, I might get bogus # data collected after the fact. But I have a stale date set on the URL, # so that is good enough for now. # my $ref = shift @dataset; # check some $ref->{foo} $sql = qq{ UPDATE $table SET LASTPING = ?, INDEX = ?, CUR_IDX = ?, CUR_CYC = ?, CUR_CONTENT = ?, STATE = ? WHERE ID = "$params{id}" }; $sth = $dbh->prepare($sql); $sth->execute($gStartNowStr, $params{index}-1, # (index-1) is complete; (index) in progress ($params{curidx}-1) % $pagedata->length, $params{curcyc}, $params{content}, 'OPEN' ); $sth->finish(); } sub markTestAsComplete { connectToDataBase(); # if not already connected my $table = "tMetaTable"; createMetaTable($table); # just returns if already created my ($sth, $sql); #XXX should probably check if this ID exists first $sql = qq{ UPDATE $table SET STATE = "COMPLETE" WHERE ID = "$params{id}" }; $sth = $dbh->prepare($sql); $sth->execute(); $sth->finish(); } sub initMetaTableRecord { # we know this record doesn't exist, so put in the initial values my $table = shift; my ($sth, $sql); $sql = qq{ INSERT INTO $table (DATETIME, LASTPING, ID, INDEX, CUR_IDX, CUR_CYC, CUR_CONTENT, STATE, BLESSED, MAXCYC, MAXIDX, REPLACE, NOCACHE, DELAY, REMOTE_USER, HTTP_USER_AGENT, REMOTE_ADDR, USER_EMAIL, USER_COMMENT ) VALUES (?,?,?,?, ?,?,?,?, ?,?,?,?, ?,?,?,?, ?,?,?) }; $sth = $dbh->prepare($sql); $sth->execute($gStartNowStr, $gStartNowStr, $params{id}, $params{index}-1, ($params{curidx}-1) % $pagedata->length, $params{curcyc}, $params{content}, "INIT", 0, $params{maxcyc}, $params{maxidx}, $params{replace}, $params{nocache}, $params{delay}, $cgi->var("REMOTE_USER"), $cgi->var("HTTP_USER_AGENT"), $cgi->var("REMOTE_ADDR"), "", "" ); $sth->finish(); } sub updateDataSetTable { my $table = shift; my $table = "t" . $params{id}; my ($sth, $sql); $sql = qq{ INSERT INTO $table (DATETIME, ID, INDEX, CUR_IDX, CUR_CYC, C_PART, S_INTVL, C_INTVL, CONTENT ) VALUES (?,?,?,?, ?,?,?,?,?) }; my $s_intvl = elapsedMilliSeconds( $gStartNow, $params{s_ts} ); $sth = $dbh->prepare($sql); $sth->execute($gStartNowStr, $params{id}, $params{index}-1, ($params{curidx}-1) % $pagedata->length, $params{curcyc}, $params{c_part}, $s_intvl, $params{c_intvl}, $req->param('content'), ); $sth->finish(); } sub outputForm { my @prog = split('/', $0); my $prog = $prog[$#prog]; print "Content-type: text/html\n\n"; print <<"ENDOFHTML"; Page Loading Times Test

Page Loading Times Test

Last updated: Jan 03, 2001 Questions/Author: John Morrison

Page-load to Page-load Delay (msec): (Use 1000. Be nice.)
Number of test cycles to run:
How long to wait before cancelling (msec): (Don't change this unless on a very slow link, or very slow machine.)

You can visit the content that will be loaded, minus the embedded javascript, by clicking on any of the links below.

ENDOFHTML my $i; print "\n"; for ($i=0; $i<$pagedata->length; $i++) { print "\n" if (($i+1)%4 == 0); } print "" if (($i+1)%4 != 0); print "

"; print $pagedata->name($i); print "\n"; print "

\n"; return; }