5adcf6bc2904690de7b7b30a83ec8a7a0996abe9 galt Tue Aug 21 00:01:25 2018 -0700 changing cse subdomain to soe diff --git src/test/hgTest.pl src/test/hgTest.pl index d98d68d..e9814db 100755 --- src/test/hgTest.pl +++ src/test/hgTest.pl @@ -1,451 +1,451 @@ #!/usr/bin/perl -w # # hgTest.pl: parameterizable test for hg CGI tools. # See usage for a description of parameters. # # Figure out path of executable so we can add perllib to the path. use FindBin qw($Bin); use lib "$Bin/perllib"; use TrackDb; use WebTest; use LWP::UserAgent; # use LWP::Debug qw(+); use HTTP::Cookies; use HTML::Form; use Getopt::Long; use Carp; use strict; # # Default behaviors, changeable by command line args: # my $webserv = $ENV{HOST}; $webserv = 'hgwdev' if (! defined $webserv); my $db = 'hg10'; my $cookies = 'y'; my $sid = 'n'; my $rand = 0; my $sleep = 0; my $verbose = 0; my $debug = 0; # Hard-coded behaviors: my $basename = $0; $basename =~ s@.*/@@; -my $domain = '.cse.ucsc.edu'; +my $domain = '.soe.ucsc.edu'; my $cookieFile = '/tmp/hgTestCookies'; my @hgTsearch = ('Chr7', '20p13', 'chr3:1-1000000', 'D16S3046', 'D22S586;D22S43', 'AA205474', # these are in testplan but not hg10: 'ctg13698', 'AP001670', 'AF083811', 'PRNP', 'pseudogene mRNA', 'homeobox caudal', 'valyl-tRNA', 'zinc finger', 'kruppel zinc finger', 'huntington', 'zahler', 'Evans,J.E.', 'chr22:15673184-15700410'); my @hgTsearchBad = ('chr25', # these don't return err: 'Evans JE', 'chr3:1-123456780', ''); my @hgTwidths = (1, 100, 320, 900, 3000); my @hgTwidthsBad = (-1, 0, 10000, 'a', '+', '\P', ''); my $hgsid = 0; my $nasty = 0; if ($nasty) { # This breaks at 100: push @hgTsearchBad, &bufferAttack(100); # I went up to 65536 on this one and it just wouldn't die: push @hgTwidthsBad, &bufferAttack(1024); } my $tests = 'hgTracks:hgTrackUi:hgGateway:hgc:hgBlat:hgConvCoords:hgText'; # # usage: Print help message and exit, happy or unhappy. # sub usage { print STDERR "Usage: $basename [-webserv h] [-db d] [-cookies y/n] [-sid y/n] [-rand N] [-sleep N] [-help] [-v] -webserv h: Use h as the target web server. Default: $webserv. [h can be a colon-separated list.] -db d: Use db as the genome database. Default: $db. [d can be a colon-separated list.] -cookies y/n: Whether to use cookies. Default: $cookies. -sleep N: Sleep N seconds between queries. Default: $sleep. -sid y/n: Whether to use session ID. Default: $sid. Not implemented! -rand N: Generate N randomized queries. Default: $rand. Not implemented! -help: Print this message. -verbose: Print lots of debugging output. "; exit(@_); } # end usage ########################################################################### # # Parse & process command line args # # GetOptions will put command line args here: use vars qw/ $opt_webserv $opt_db $opt_cookies $opt_sid $opt_rand $opt_sleep $opt_help $opt_verbose /; my $ok = GetOptions("webserv=s", "db=s", "cookies=s", "sid=s", "rand=i", "sleep=i", "help", "verbose"); &usage(1) if (! $ok); &usage(0) if ($opt_help); $webserv = $opt_webserv if ($opt_webserv); my @webservs = split(/:/, $webserv); foreach my $h (@webservs) { # cookies don't work if the web server host is given without # a domain; somewhere along the way, .local is appended if no # domain, e.g. hgwdev-->hgwdev.local. Anyway, this fixes it: $h .= $domain if ($h !~ /\./); } $db = $opt_db if ($opt_db); my @dbs = split(/:/, $db); $cookies = $opt_cookies if (defined $opt_cookies); $sid = $opt_sid if (defined $opt_sid); $rand = $opt_rand if (defined $opt_rand); $sleep = $opt_sleep if (defined $opt_sleep); $verbose = $opt_verbose if (defined $opt_verbose); $verbose = 1 if ($debug); print " $basename parameters: --------------------- webservs: @webservs dbs: @dbs cookies?: $cookies sleep: $sleep sid?: $sid rand: $rand " if ($verbose); # booleanize $cookies and $sid for convenience $cookies = ($cookies =~ m/^[yt]/i) ? 1 : 0; $sid = ($sid =~ m/^[yt]/i) ? 1 : 0; ########################################################################### # # Initialize helper objects. # # Create HTTP UserAgent, init cookies if specified. my $ua = LWP::UserAgent->new; if ($cookies) { $ua->cookie_jar(HTTP::Cookies->new(file => $cookieFile, autosave => 1)); print "\nSet up cookie jar in $cookieFile\n\n" if ($verbose); } # Pass the UserAgent handle to our web tester. my $webTest = new WebTest($ua, $sleep, $verbose, $debug); # Make some configs for the webTester. my $expectFail = {'mustMatch' => ['(sorry|error|can\'t|Please go back)']}; my $expectPass = {'mustNotMatch' => ['(sorry|error|can\'t)']}; my $expectHgTU = {'mustNotMatch' => ['not found']}; # this isn't used, but I'll leave it here as an example of using mult. pat's: my $expectHgTr = {'mustNotMatch' => ['(sorry|error|can\'t)'], 'mustMatch' => ['UCSC Genome Browser on .* Freeze'], }; ########################################################################### # # For each webserv & db, test all the CGI tools on all the tracks.... # my $totalGood = 0; my $totalBad = 0; foreach my $webserv (@webservs) { foreach my $db (@dbs) { if ($tests =~ /hgGateway/) { my ($good, $bad) = &hgGateway($webTest, $webserv, $db); $totalGood += $good; $totalBad += $bad; } if ($tests =~ /hgTracks/) { my ($good, $bad) = &hgTracks($webTest, $webserv, $db); $totalGood += $good; $totalBad += $bad; } if ($tests =~ /hgTrackUi/) { my ($good, $bad) = &hgTrackUi($webTest, $webserv, $db); $totalGood += $good; $totalBad += $bad; } } # each db } # each webserv print "Summary: $totalGood successful queries, $totalBad failures.\n"; ########################################################################### # # hgTrackUi query generator. # sub hgTrackUi { my $webTest = shift; my $webserv = shift; my $db = shift; confess "too few args" if (! defined $db); confess "too many args" if (defined shift); my ($good, $bad) = (0, 0); my $tdb = new TrackDb($db); my @tracks = $tdb->getTrackNames(); $tdb->DESTROY(); # why wait for perl... foreach my $track (@tracks) { my $page = "http://$webserv/cgi-bin/hgTrackUi"; my $query = "db=$db&g=$track&c=stub"; $webTest->configure($expectHgTU); my $ok = $webTest->checkPage($page, $query); $ok ? $good++ : $bad++; } # each trackName return($good, $bad); } # end hgTrackUi ########################################################################### # # hgGateway query generator. # sub hgGateway { my $webTest = shift; my $webserv = shift; my $db = shift; confess "too few args" if (! defined $db); confess "too many args" if (defined shift); my $page = "http://$webserv/cgi-bin/hgGateway"; my $query = "db=$db"; $webTest->configure($expectPass); my $ok = $webTest->checkPage($page, $query); $ok ? return(1, 0) : return(0, 1); } # end hgGateway ########################################################################### # # hgTracks # sub hgTracks { my $webTest = shift; my $webserv = shift; my $db = shift; confess "too few args" if (! defined $db); confess "too many args" if (defined shift); my ($good, $bad) = (0, 0); my $page = "http://$webserv/cgi-bin/hgTracks"; # # If using cookies, do a cartReset here so we get consistent # results from run to run! (All the button-clicking below # was causing some runs to start with hideAll...) # &cartReset($webserv) if ($cookies); # # some bounds-checking on position and width inputs: # # expect to find matches for all these items: $webTest->configure($expectPass); foreach my $search (@hgTsearch) { my $query = "db=$db&position=$search&pix=100"; $query .= "&hgsid=$hgsid" if ($sid =~ m/^[yt]/i); my $ok = $webTest->checkPage($page, $query); $ok ? $good++ : $bad++; } # but not these items: $webTest->configure($expectFail); foreach my $search (@hgTsearchBad) { my $query = "db=$db&position=$search&pix=100"; $query .= "&hgsid=$hgsid" if ($sid =~ m/^[yt]/i); my $ok = $webTest->checkPage($page, $query); $ok ? $good++ : $bad++; } # expect good and bad widths to return OK: $webTest->configure($expectPass); my $search = 'chr1:1-10'; foreach my $width (@hgTwidths, @hgTwidthsBad) { my $query = "db=$db&position=$search&pix=$width"; $query .= "&hgsid=$hgsid" if ($sid =~ m/^[yt]/i); my $ok = $webTest->checkPage($page, $query); $ok ? $good++ : $bad++; } # # Now feed in some nice simple inputs, parse the returned page # into a form & links, and play with the form. # my $query = "db=$db&position=chr22:15550662-15822931&pix=100"; my $html = $webTest->getPage($page, $query); $webTest->configure($expectPass); if (defined $html) { if (open(OUT, ">/tmp/vanilla.out")) { print OUT $html; close(OUT); } # click every submit button on this page. my $form = HTML::Form->parse($html, $page); if (! defined $form) { $bad++; print "Couldn't parse $page?$query text!\n"; return ($good, $bad); } my @inputs = $form->inputs(); print "hgTracks: Checking " . scalar(@inputs) . " form inputs.\n" if ($verbose); foreach my $i (@inputs) { print $i->type() . ' -> ' . $i->name() . "\n" if ($debug); if ($i->type() eq 'submit') { my $req = $form->click($i->name()); my $ok = $webTest->checkRequest($req); $ok ? $good++ : $bad++; } } # follow every link on this page. my @links = &getLinks($html); print "hgTracks: Checking " . scalar(@links) . " links.\n" if ($verbose); foreach my $l (@links) { # hacky way to split up the link, but it'll have to do for now. my ($page, $query); if ($l =~ /^([\w\.\:\/\-\_]+)\?(.+)$/) { $page = $1; $query = $2; } else { $page = $l; } if ($page !~ /^http:/) { # hacky way to fix relative URL or ignore link. next if ($page !~ s/^.*cgi\-bin/http\:\/\/$webserv\/cgi\-bin/); } my $ok = $webTest->checkPage($page, $query); $ok ? $good++ : $bad++; } # do another cartReset before starting this test: &cartReset($webserv) if ($cookies); # # Jim's recommended sequece: # - click hideAll. # - then, starting from that page: # - for each track: # - select dense, then click submit # - select full, then click submit # click every submit button on this page. my $i = $form->find_input('hgt.hideAll'); if (! defined $i) { print "DOH! Couldn't find hgt.hideAll in this:\n$html\n"; return ($good, $bad); } my $req = $form->click($i->name()); my $newhtml = $webTest->getRequest($req); if (defined $newhtml) { if (open(OUT, ">/tmp/hideall.out")) { print OUT $newhtml; close(OUT); } my $newform = HTML::Form->parse($newhtml, $page); my @newinputs = $newform->inputs(); foreach my $n (@newinputs) { if ($n->type() eq 'option') { # dense check if (grep /dense/, $n->possible_values()) { $newform->value($n->name(), 'dense'); my $req = $newform->click('submit'); my $ok = $webTest->checkRequest($req); $ok ? $good++ : $bad++; } # full check if (grep /full/, $n->possible_values()) { $newform->value($n->name(), 'full'); $req = $newform->click('submit'); $ok = $webTest->checkRequest($req); $ok ? $good++ : $bad++; } } } } else { print "Couldn't get html for vanilla+hideAll page?!\n" if ($verbose); $bad++; } } else { print "Couldn't get html for vanilla starting page?!\n" if ($verbose); $bad++; } return($good, $bad); } # end hgTracks ########################################################################### # # hgBlat # ########################################################################### # # hgConvCoords # ########################################################################### # # hgText # # # bufferAttack: make a string of the specified length. # sub bufferAttack { my $length = shift; confess "too few args" if (! defined $length); confess "too many args" if (defined shift); my $str = 'b'; while (length($str) < $length) { $str .= $str; } $str = substr($str, 0, $length); return($str); } # # getLinks: return a list of all HREF's in the input text: # sub getLinks { my $html = shift; confess "too few args" if (! defined $html); confess "too many args" if (defined shift); my $copy = $html; my @links = (); while ($copy =~ s/[hH][rR][eE][fF]\s*=\s*[\"\']([^\"\']+)[\"\']//) { push @links, $1; } return @links; } # end getLinks # # cartReset: run cgi-bin/cartReset to clean the user-interface slate. # sub cartReset { my $webserv = shift; confess "too few args" if (! defined $webserv); confess "too many args" if (defined shift); my $p = "http://$webserv/cgi-bin/cartReset"; $webTest->getPage($p); }