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);
 }