forester/archive/perl/nph-riowebserver

   1 #! /usr/bin/perl -W
   2
   3 # nph-riowebserver.pl
   4 # -------------------
   5 #
   6 # Copyright (C) 2002 Washington University School of Medicine
   7 # and Howard Hughes Medical Institute
   8 # All rights reserved
   9 #
  10 # Created: 02/18/02
  11 # Author: Christian M. Zmasek
  12 # zmasek@genetics.wustl.edu
  13 # http://www.genetics.wustl.edu/eddy/people/zmasek/
  14 #
  15 # Last modified: 02/20/02
  16
  17
  18 use strict;
  19 use CGI;
  20 use queue;
  21
  22
  23 my $RIOPL                         = "/home/rio/forester/perl/rio4P.pl";
  24 my $JAVA                          = "/home/rio/j2sdk1.4.0/bin/java";
  25 my $TEST_NHX                      = $JAVA." -cp /home/rio/forester/java forester.tools.testNHX";
  26 my $TEMPDIR                       = "/home/rio/rws_temp";
  27 my $SPECIESTREE                   = "/home/rio/forester/data/species/tree_of_life_bin_1-4.nhx";
  28 my $SPECIESLIST                   = "/home/rio/forester/data/species/tree_of_life_bin_1-4_species_list";
  29 my $hmm_search_url_A              = "http://pfam.wustl.edu/cgi-bin/nph-hmmsearch?protseq=";
  30 my $hmm_search_url_B               = "&search_mode=merge&cutoff_strategy=ga";
  31
  32 my $RIO_ALN_DIRECTORY             = "/data/rio/ALNs/";
  33 my $RIO_NBD_DIRECTORY             = "/data/rio/NBDs/";
  34 my $ALIGN_FILE_SUFFIX             = ".aln";
  35 my $ALIGN_NBD_FILE                = ".nbd";
  36 my $DIR_FOR_TREES                 = "/var/www/html/trees/";                # Directory for NHX files to be read by ATV applet
  37 my $URL_FOR_TREES                 = "http://forester.wustl.edu/trees/";    # URL base for NHX files to be read by ATV applet
  38 my $CODE_BASE_FOR_ATV_APPLET      = "http://forester.wustl.edu/applets/";  # URL for ATV applet (jar file)
  39 my $TARGET_FILES_IN_DIR_FOR_TREES = 100; # If the number of nhx files in $DIR_FOR_TREES is lager then $MAX_FILES_IN_DIR_FOR_TREES
  40 my $MAX_FILES_IN_DIR_FOR_TREES    = 120; # the oldest files will be deleted until the number is down to $TARGET_FILES_IN_DIR_FOR_TREES.
  41 my $O_THRESHOLD_DEFAULT           = 0;
  42 my $SN_THRESHOLD_DEFAULT          = 0;
  43 my $U_THRESHOLD_DEFAULT           = 50;
  44 my $SEED_FOR_RANDOM_DEFAULT       = 41;
  45 my $SORT_DEFAULT                  = 12;
  46 my $MIN_SIZE                      = 5;         # Minimal size (in chars) for input files
  47 my $MAX_SIZE                      = 10000;     # Maximal size (in chars) for input files
  48 my $MAX_LINES                     = 1000;      # Maximal lines for input files
  49 my $RIO_OPTIONS                   = "U=60 Y=2 X=2 Z=2 I C E x +";
  50 my $CONTACT                       = "zmasek\@genetics.wustl.edu";
  51 my $VERSION                       = "0.3";
  52
  53
  54 my $o_threshold       = 0;
  55 my $sn_threshold      = 0;
  56 my $u_threshold       = 0;
  57 my $seed_for_random   = 0;
  58 my $sort              = 0;
  59 my $size_d            = 0;
  60 my $size_c            = 0;
  61 my $entry_time        = 0;
  62 my $njobs             = 0;
  63 my $njobs_thisuser    = 0;
  64 my $user_defined_tree = 0;
  65
  66
  67
  68 my $query             = "";
  69 my $query_seq         = "";
  70 my $query_seq_file    = "";
  71 my $tree_file         = "";
  72 my $pfam_domain       = "";
  73 my $species           = "";
  74 my $output_tree       = "";
  75 my $output_up         = "";
  76 my $remote_addr       = "";
  77 my $oneline           = "";
  78 my $aln               = "";
  79 my $speciestree       = "";
  80 my $output            = "";
  81 my $query_sequence    = ""; # To be submitted to hmmsearch website, if necessary.
  82 my $link_to_hmmsearch = "";
  83
  84 my @lines          = ();
  85 my %Species_names_hash = ();
  86
  87
  88 $| = 1;
  89
  90 $query = new CGI;
  91
  92
  93 $query_seq       = $query->param( 'query_seq' );
  94 $query_seq_file  = $query->upload( 'query_seq_file' );
  95 $pfam_domain     = $query->param( 'pfam_domain' );
  96 $species         = $query->param( 'species' );
  97 $o_threshold     = $query->param( 'o_threshold' );
  98 $sn_threshold    = $query->param( 'sn_threshold' );
  99 $u_threshold     = $query->param( 'u_threshold' );
 100 $seed_for_random = $query->param( 'seed_for_random' );
 101 $output_up       = $query->param( 'output_up' );
 102 $sort            = $query->param( 'sort_priority' );
 103 $tree_file       = $query->upload( 'tree_file' );
 104
 105 $remote_addr = $ENV{ REMOTE_ADDR };
 106
 107
 108 # NPH header
 109 # ----------
 110 print $query->header( -status=>"200 OK",
 111                       -server=>"$ENV{ SERVER_SOFTWARE }",
 112                       -nph=>1 );
 113
 114
 115
 116
 117 # Prints the first HTML
 118 # ---------------------
 119 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/1999/REC-html401-19991224/loose.dtd\">\n";
 120 print "<HTML>\n";
 121 print "<HEAD>\n";
 122 print "<TITLE>[ RIO SERVER | phylogenomic analysis of a protein sequence ]</TITLE>\n";
 123 print "<META HTTP-EQUIV = \"Content-Type\" CONTENT = \"text/html; charset=iso-8859-1\" >\n";
 124 print "<LINK REL = \"stylesheet\"\n";
 125 print " TYPE = \"text/css\"\n";
 126 print " HREF = \"http://forester.wustl.edu/style_rio_server2.css\">\n";
 127
 128 &print_ATV_JavaScript();
 129
 130 print "</HEAD>\n";
 131 print "<BODY>\n";
 132
 133 &print_navbar();
 134
 135
 136
 137 # Reads in, cleans up and checks
 138 # ------------------------------
 139
 140 if ( ( !defined( $query_seq_file ) && !defined( $query_seq ) )
 141 ||   ( $query_seq_file !~ /\w+/ && $query_seq !~ /\w+/ ) ) {
 142     &nph_user_error( "need to specify a sequence file or submit a sequence directly" );
 143 }
 144
 145 if ( $query_seq_file =~ /\w+/ && $query_seq =~ /\w+/ ) {
 146     &nph_user_error( "cannot specify a sequence file and submit a sequence directly" );
 147 }
 148
 149
 150 if ( $query_seq_file =~ /\w+/ ) {
 151     # Reading in from file
 152     &readInFile( $query_seq_file );
 153 }
 154 else {
 155     # "cut and paste"
 156     @lines = split( /^/, $query_seq );
 157 }
 158
 159
 160 if ( $lines[ 0 ] =~ /^\s*>/ ) { # FASTA
 161     shift( @lines );
 162 }
 163
 164
 165 foreach $oneline ( @lines ) {
 166     $size_d += length( $oneline );
 167     if ( $size_d > $MAX_SIZE ) {
 168         &nph_user_error( "query sequence is too long (>$MAX_SIZE)" );
 169     }
 170     $oneline =~ s/[^A-Za-z]//g;
 171     $size_c += length( $oneline );
 172 }
 173 if ( $size_c < $MIN_SIZE ) {
 174     &nph_user_error( "query sequence is too short (<$MIN_SIZE)" );
 175 }
 176
 177
 178 # Writes a temp file for the query sequence
 179 open( PROT, ">$TEMPDIR/$$.query" ) || &nph_fatal_error( "failed to open temp query file" );
 180 foreach $oneline ( @lines ) {
 181     print PROT $oneline;
 182     $query_sequence .= $oneline;
 183 }
 184 close( PROT );
 185
 186 if ( !defined( $species ) || $species !~ /\w+/ || length( $species ) < 2 ) {
 187     &nph_user_error( "need to specify the species of the query sequence" );
 188 }
 189
 190 $link_to_hmmsearch = "<A HREF=\"$hmm_search_url_A".$query_sequence."$hmm_search_url_B\" TARGET=\"_blank\"> >> click here to perform hmmsearch on query sequence << </A>";
 191
 192 if ( !defined( $pfam_domain ) || $pfam_domain !~ /\w+/ || length( $pfam_domain ) < 1 ) {
 193     &nph_user_error( "need to specify a name for a pfam domain of the query sequence<BR>$link_to_hmmsearch" );
 194 }
 195
 196 if ( length( $species ) > 5 ) {
 197     &nph_user_error( "invalid species name" );
 198 }
 199 $species =~ s/[^A-Za-z0-9]//g;
 200 if ( length( $species ) < 2 ) {
 201     &nph_user_error( "invalid species name" );
 202 }
 203
 204 if ( length( $pfam_domain ) > 40 ) {
 205     &nph_user_error( "invalid pfam domain name<BR>$link_to_hmmsearch" );
 206 }
 207 $pfam_domain =~ s/[\s,;\.><\|\\\/\(\)!@\#\$%&\*\^=]//g;
 208 if ( length( $pfam_domain ) < 1 ) {
 209     &nph_user_error( "invalid pfam domain name<BR>$link_to_hmmsearch" );
 210 }
 211
 212 if ( defined( $tree_file ) && $tree_file =~ /\w+/ ) {
 213     $user_defined_tree = 1;
 214 }
 215
 216 $species =~ tr/a-z/A-Z/;
 217
 218 if ( $user_defined_tree != 1 ) {
 219     &checkForPresenceOfSpecies( $species );
 220 }
 221
 222 $aln = $RIO_ALN_DIRECTORY.$pfam_domain.$ALIGN_FILE_SUFFIX;
 223
 224 if ( &checkForTextFilePresence( $aln ) != 1 ) {
 225    &nph_user_error( "no pairwise distances precalculated for pfam domain \"$pfam_domain\"<BR>$link_to_hmmsearch" );
 226 }
 227
 228
 229 if ( checkForNumberBetween0and100( $o_threshold ) != 1 ) {
 230    $o_threshold = $O_THRESHOLD_DEFAULT;
 231 }
 232 if ( checkForNumberBetween0and100( $sn_threshold ) != 1 ) {
 233    $sn_threshold = $SN_THRESHOLD_DEFAULT;
 234 }
 235 if ( checkForNumberBetween0and100( $u_threshold ) != 1 ) {
 236    $u_threshold = $U_THRESHOLD_DEFAULT;
 237 }
 238 if ( !defined( $seed_for_random ) || $seed_for_random !~ /\d/
 239 || $seed_for_random =~ /\D/ || $seed_for_random > 10000 || $seed_for_random < 0 ) {
 240    $seed_for_random = $SEED_FOR_RANDOM_DEFAULT;
 241 }
 242 if ( !defined( $sort )
 243 || $sort > 16 || $sort < 12 ) {
 244    $sort = $SORT_DEFAULT;
 245 }
 246
 247 if ( defined( $output_up ) && $output_up eq "yes" ) {
 248    $RIO_OPTIONS .= " p";
 249 }
 250 else {
 251    $u_threshold = -1;
 252 }
 253
 254
 255
 256
 257
 258
 259
 260
 261 # User defined species tree is dealt with here
 262 # --------------------------------------------
 263
 264 if ( $user_defined_tree == 1 ) {
 265     &readInFile( $tree_file );
 266     $size_d = 0;
 267     $size_c = 0;
 268     foreach $oneline ( @lines ) {
 269         $size_d += length( $oneline );
 270         if ( $size_d > $MAX_SIZE ) {
 271             &nph_user_error( "user defined species tree file is too long (>$MAX_SIZE)" );
 272         }
 273         $oneline =~ s/;\|,<>\s//g;
 274         $oneline =~ tr/a-z/A-Z/;
 275
 276         $size_c += length( $oneline );
 277     }
 278     if ( $size_c < $MIN_SIZE ) {
 279         &nph_user_error( "user defined species tree file is too short (<$MIN_SIZE)" );
 280     }
 281
 282     open( TREE, ">$TEMPDIR/$$.tree" ) || &nph_fatal_error( "failed to open temp species tree file" );
 283     foreach $oneline ( @lines ) {
 284         print TREE $oneline;
 285     }
 286     close( TREE );
 287
 288     $speciestree = "$TEMPDIR/$$.tree";
 289     system( "$TEST_NHX $speciestree" )
 290     && nph_user_error( "user defined species tree is not in proper NHX format (or is unrooted, or contains multifurcations) $!" );
 291
 292 }
 293 else {
 294     $speciestree = $SPECIESTREE;
 295 }
 296
 297
 298
 299 # Join the queue, using queue.pm API
 300 # ----------------------------------
 301
 302 $entry_time = time;
 303
 304 ( $njobs, $njobs_thisuser ) = &queue::CheckQueue( "rioqueue", $remote_addr, $TEMPDIR );
 305 if ( $njobs > 5 ) {
 306     &nph_user_error("The server is currently swamped, with $njobs searches in the queue.<BR>Please come back later! Sorry.");
 307 }
 308 if ( $njobs_thisuser > 0 ) {
 309     &nph_user_error( "We already have $njobs_thisuser searches in the queue from
 310     your IP address ($remote_addr). Please wait until some or all of them
 311     finish.<BR>If you think you got this message in error, wait a minute or so and
 312     resubmit your job. You probably hit your browser's stop button after you
 313     started a search - but that doesn't stop our compute cluster, it just breaks
 314     your connection to us. You won't be able to start a new search until the
 315     cluster's done." );
 316 }
 317 if ( $njobs > 0 ) {
 318     print_waiting_message( $njobs );
 319 }
 320 &queue::WaitInQueue( "rioqueue", $remote_addr, $TEMPDIR, $$, 10 ); # wait with ten-second granularity.
 321
 322
 323
 324
 325 # Prints "waiting" header
 326 # -----------------------
 327
 328 my $number_of_seqs = &getNumberOfSeqsFromNBDfile( $RIO_NBD_DIRECTORY.$pfam_domain.$ALIGN_NBD_FILE );
 329 my $estimated_time = &estimateTime( $number_of_seqs );
 330
 331 print( "<H4 class = \"messages\"> RIO: Starting search. Estimated time: $estimated_time seconds per domain (assuming all rio nodes are running). Please wait...</H4>\n" );
 332
 333
 334
 335
 336 # Runs RIO
 337 # --------
 338
 339 &run_rio( $pfam_domain,           # domain
 340           "$TEMPDIR/$$.query",    # query file name
 341           "$TEMPDIR/$$.outfile",  # output file name
 342           "QUERY_$species",       # name for query
 343           $speciestree,           # species tree
 344           $RIO_OPTIONS,           # more options
 345           "$TEMPDIR/$$",          # temp file
 346           $o_threshold,
 347           $sn_threshold,
 348           $u_threshold,
 349           $seed_for_random,
 350           $sort );
 351
 352
 353
 354 # Done
 355 # ----
 356
 357 &showATVlinks();
 358
 359
 360
 361 # Cleanup
 362 unlink( "$TEMPDIR/$$.query", "$TEMPDIR/$$.tree" );
 363
 364 $output .= "<P> &nbsp </P>\n";
 365
 366 # Leaves the queue in an orderly fashion.
 367 &queue::RemoveFromQueue( "rioqueue", $remote_addr, $TEMPDIR, $$ );
 368
 369 print( $output );
 370
 371 &print_footer();
 372
 373 &removeFiles( $DIR_FOR_TREES, $TARGET_FILES_IN_DIR_FOR_TREES, $MAX_FILES_IN_DIR_FOR_TREES );
 374
 375 exit( 0 );
 376
 377
 378
 379
 380
 381
 382
 383
 384 # Methods
 385 # -------
 386
 387
 388
 389 # Last modified: 02/19/02
 390 sub run_rio {
 391
 392     my $pfam_name              = $_[ 0 ];
 393     my $query_file             = $_[ 1 ];
 394     my $output_file            = $_[ 2 ];
 395     my $name_for_query         = $_[ 3 ];
 396     my $species_tree_file      = $_[ 4 ];
 397     my $more_options           = $_[ 5 ];
 398     my $tmp_file_rio           = $_[ 6 ];
 399     my $t_o                    = $_[ 7 ];
 400     my $t_sn                   = $_[ 8 ];
 401     my $t_u                    = $_[ 9 ];
 402     my $seed                   = $_[ 10 ];
 403     my $sort                   = $_[ 11 ];
 404
 405     my $start_time = time;
 406
 407     my $options_for_rio = "";
 408
 409     $options_for_rio .= ( " A=".$pfam_name );
 410     $options_for_rio .= ( " Q=".$query_file );
 411     $options_for_rio .= ( " O=".$output_file );
 412     $options_for_rio .= ( " N=".$name_for_query );
 413     $options_for_rio .= ( " S=".$species_tree_file );
 414     $options_for_rio .= ( " j=".$tmp_file_rio );
 415     $options_for_rio .= ( " L=".$t_o );
 416     $options_for_rio .= ( " B=".$t_sn );
 417     if ( $t_u != -1 ) {
 418        $options_for_rio .= ( " v=".$t_u );
 419     }
 420     $options_for_rio .= ( " y=".$seed );
 421     $options_for_rio .= ( " P=".$sort );
 422     $options_for_rio .= ( " ".$more_options );
 423
 424     $output = `$RIOPL 1 $options_for_rio`;
 425
 426     if ( $? != 0 ) {
 427         nph_rio_error();
 428     }
 429     my $finish_time = time;
 430     my $wait_time  = $finish_time - $entry_time;
 431     my $cpu_time   = $finish_time - $start_time;
 432
 433
 434
 435     # Logs the results.
 436     my $date = `date`;
 437     chop( $date );
 438     open ( LOGFILE, ">>$TEMPDIR/log") || &nph_fatal_error( "could not open log file" );
 439     flock( LOGFILE, 2 );
 440     print LOGFILE "$date queue: $njobs wait: $wait_time true_cpu: $cpu_time pid: $$ addr: $ENV{'REMOTE_ADDR'} host: $ENV{'REMOTE_HOST'} pfam: $pfam_name\n";
 441     flock( LOGFILE, 8 );
 442     close ( LOGFILE );
 443
 444     return;
 445
 446 } ## run_rio
 447
 448
 449
 450
 451 # Reads a file into "@lines"
 452 # Last modified: 02/19/02
 453 sub readInFile {
 454     my $file = $_[ 0 ];
 455     my $l    = 0;
 456     my $s    = 0;
 457     @lines   = ();
 458
 459     $file =~ s/;\|,<>&\s//g;
 460
 461     while( <$file> ) {
 462         $s += length( $_ );
 463         if ( $s > $MAX_SIZE ) {
 464             &nph_user_error( "query sequence is too long (>$MAX_SIZE)" );
 465         }
 466         $l++;
 467         if ( $l > $MAX_LINES ) {
 468             &nph_user_error( "file has too many lines (>$MAX_LINES)" );
 469         }
 470
 471         push( @lines, $_ );
 472
 473     }
 474
 475 } ## readInFile
 476
 477
 478
 479
 480 # Reads in (SWISS-PROT) species names from a file.
 481 # Names must be separated by newlines.
 482 # Lines beginning with "#" are ignored.
 483 # A possible "=" and everything after is ignored.
 484 # One argument: species-names-file name
 485 # Last modified: 02/19/02
 486 sub readSpeciesNamesFile {
 487     my $infile = $_[ 0 ];
 488     my $return_line = "";
 489     my $species     = "";
 490
 491     open( IN_RSNF, "$infile" ) || &nph_fatal_error( "could not open species list" );
 492     while ( $return_line = <IN_RSNF> ) {
 493         if ( $return_line !~ /^\s*#/ && $return_line =~ /(\S+)/ ) {
 494             $species = $1;
 495             $species =~ s/=.+//;
 496             $Species_names_hash{ $species } = "";
 497         }
 498     }
 499     close( IN_RSNF );
 500
 501     return;
 502 } ## readSpeciesNamesFile
 503
 504
 505
 506 # Last modified: 02/19/02
 507 sub checkForNumberBetween0and100 {
 508
 509     my $x = $_[ 0 ];
 510
 511     if ( !defined( $x ) || $x !~ /\d/ || $x =~ /\D/ || $x > 100 || $x < 0 ) {
 512         return 0;
 513     }
 514     else {
 515         return 1;
 516     }
 517
 518 } ## checkForNumberBetween0and100
 519
 520
 521
 522 # Last modified: 02/19/02
 523 sub getNumberOfSeqsFromNBDfile {
 524     my $infile             = $_[ 0 ];
 525     my $return_line        = "";
 526     my $number_of_seqs     = 0;
 527
 528     open( C, "$infile" ) || &nph_fatal_error( "could not open NBD file" );
 529     while ( $return_line = <C> ) {
 530         if ( $return_line =~ /^\s*(\d+)\s*$/ ) {
 531             $number_of_seqs = $1;
 532             last;
 533         }
 534     }
 535     close( C );
 536     return $number_of_seqs;
 537
 538 } ## getNumberOfSeqsFromNBDfile
 539
 540
 541
 542 # Last modified: 02/19/02
 543 sub print_waiting_message {
 544
 545     my $njobs = $_[ 0 ];
 546
 547     print( "<H4 class = \"messages\">\n" );
 548     print( "RIO: There are $njobs searches queued ahead of you on the RIO server. Please wait...\n" );
 549     print( "</H4>\n" );
 550
 551     return;
 552
 553 } ## print_waiting_message
 554
 555
 556
 557 # Last modified: 02/19/02
 558 sub checkForPresenceOfSpecies {
 559
 560     my $species            = $_[ 0 ];
 561
 562     &readSpeciesNamesFile( $SPECIESLIST );
 563     unless( exists( $Species_names_hash{ $species } ) ) {
 564         &nph_user_error( "species \"$species\" not present in currently used species tree" );
 565     }
 566
 567     return;
 568 } ## checkForPresenceOfSepecies
 569
 570
 571
 572 # Last modified: 02/19/02
 573 sub checkForTextFilePresence {
 574
 575     my $file = $_[ 0 ];
 576
 577     if ( ( -s $file ) && ( -f $file ) && ( -T $file ) ) {
 578         return 1;
 579     }
 580     else {
 581         return 0;
 582     }
 583
 584 } ## checkForTextFilePresence
 585
 586
 587
 588
 589
 590 # Last modified: 02/19/02
 591 sub print_footer {
 592
 593     &print_navbar();
 594     &print_contact();
 595     print( "</BODY>\n" );
 596     print( "</HTML>\n" );
 597
 598     return;
 599
 600 } ## print_footer
 601
 602
 603
 604 # Last modified: 02/19/02
 605 sub print_navbar {
 606
 607     print( "<HR NOSHADE COLOR=\"#FF3300\">\n" );
 608     print( "<P class = \"nomargins\">\n" );
 609     print( "<B>RIO $VERSION</B> \n" );
 610     print( "<A HREF=\"http://www.rio.wustl.edu/\">phylogenomic analysis of a protein sequence</A> | " );
 611     print( "<A HREF=\"http://www.rio.wustl.edu/help.html\" TARGET=\"_blank\">help</A> | " );
 612     print( "<A HREF=\"http://www.genetics.wustl.edu/eddy/forester/\" TARGET=\"_blank\">forester/rio home</A> | " );
 613     print( "<A HREF=\"http://pfam.wustl.edu/\" TARGET=\"_blank\">pfam</A>\n" );
 614     print( "</P class = \"nomargins\">\n" );
 615     print( "<HR NOSHADE COLOR=\"#FF3300\">\n" );
 616
 617     return;
 618
 619 } ## print_navbar
 620
 621
 622
 623 # Last modified: 02/19/02
 624 sub print_contact {
 625
 626     print( "<P>comments, questions, flames? email <A HREF = \"mailto:$CONTACT\">$CONTACT</A></P>\n" );
 627
 628     return;
 629
 630 } ## print_contact
 631
 632
 633
 634 # Last modified: 02/19/02
 635 sub showATVlinks {
 636
 637     my $domain_no = 0;
 638
 639     if ( -s "$TEMPDIR/$$.outfile.rio.nhx" ) {
 640        $domain_no = 1;
 641        system( "mv", "$TEMPDIR/$$.outfile.rio.nhx", $DIR_FOR_TREES )
 642        && &nph_fatal_error( "could not mv $TEMPDIR/$$.outfile.rio.nhx" );
 643     }
 644     elsif ( -s "$TEMPDIR/$$.outfile.rio-1.nhx" ) {
 645         $domain_no = 1;
 646         while ( -s "$TEMPDIR/$$.outfile.rio-$domain_no.nhx" ) {
 647             system( "mv", "$TEMPDIR/$$.outfile.rio-$domain_no.nhx", $DIR_FOR_TREES )
 648             && &nph_fatal_error( "could not mv $TEMPDIR/$$.outfile.rio-$domain_no.nhx.nhx" );
 649             $domain_no++;
 650         }
 651
 652     }
 653
 654
 655     if ( $domain_no == 1 ) {
 656         $output .= "<P>&nbsp</P>\n";
 657         $output .= "<TABLE BORDER=\"0\" CELLPADDING=\"1\"\n";
 658         $output .= "<TR><TD><FORM>\n";
 659         $output .= "<INPUT TYPE=BUTTON VALUE=\"view tree\" onClick=\"openWin( '$URL_FOR_TREES$$.outfile.rio.nhx' )\">\n";
 660         $output .= "</FORM></TD><TD>\n";
 661         $output .= "<A HREF=\"$URL_FOR_TREES$$.outfile.rio.nhx\" TARGET=\"_blank\">download NHX file describing this tree</A></TD></TR>\n";
 662         $output .= "</TABLE>\n";
 663     }
 664     elsif ( $domain_no > 1 ) {
 665         $output .= "<P>&nbsp</P>\n";
 666         $output .= "<TABLE BORDER=\"0\" CELLPADDING=\"1\"\n";
 667         for ( my $x = 1; $x < $domain_no; $x++ ) {
 668             $output .= "<TR><TD><FORM>\n";
 669             $output .= "<INPUT TYPE=BUTTON VALUE=\"view tree for domain #$x\" onClick=\"openWin( '$URL_FOR_TREES$$.outfile.rio-$x.nhx' )\">\n";
 670             $output .= "</FORM></TD><TD>\n";
 671             $output .= "<A HREF=\"$URL_FOR_TREES$$.outfile.rio-$x.nhx\" TARGET=\"_blank\">download NHX file for domain #$x</A></TD></TR>\n";
 672         }
 673         $output .= "</TABLE>\n";
 674     }
 675
 676     return;
 677
 678 } ## showATVlinks
 679
 680
 681 # Removes output tree (NHX) files if more than $_[ 2 ] in $_[ 0 ]
 682 # Removes until  $_[ 1 ] are left
 683 # Last modified: 02/19/02
 684 sub removeFiles {
 685
 686     my $dir    = $_[ 0 ];
 687     my $target = $_[ 1 ];
 688     my $max    = $_[ 2 ];
 689
 690     my $files = &countFilesInDir( $dir );
 691
 692     if ( $files > $max ) {
 693
 694        my $diff = $files - $target;
 695
 696        for ( my $i = 0; $i < $diff; $i++ ) {
 697            &removeOldestFile( $dir );
 698        }
 699     }
 700
 701     return;
 702 } ## removeFiles
 703
 704
 705
 706 # Last modified: 02/19/02
 707 sub countFilesInDir {
 708
 709     my $dir  = $_[ 0 ];
 710     my $file = "";
 711     my $c    = 0;
 712
 713     opendir( DIR, $dir ) || &nph_fatal_error( "could not open dir $dir" );
 714     while( defined ( $file = readdir( DIR ) ) ) {
 715         unless ( $file =~ /\d/ ) {
 716             next;
 717         }
 718         $c++;
 719     }
 720     closedir( DIR );
 721
 722     return( $c );
 723
 724 } ## countFilesInDir
 725
 726
 727
 728 # Last modified: 02/19/02
 729 sub removeOldestFile {
 730     my $dir           = $_[ 0 ];
 731     my $file          = "";
 732     my $oldest        = "";
 733     my $smallest_time = 0;
 734     my $time          = 0;
 735     my $first         = 1;
 736
 737     opendir( DIR, $dir ) || &nph_fatal_error( "could not open dir $dir" );
 738     while( defined ( $file = readdir( DIR ) ) ) {
 739         unless ( $file =~ /\d/ ) {
 740             next;
 741         }
 742         $file =~ /(\d+)/;
 743         $time = $1;
 744         if ( $first == 1 ) {
 745             $first = 0;
 746             $smallest_time = $time;
 747             $oldest = $file
 748         }
 749         elsif ( $time < $smallest_time ) {
 750             $smallest_time = $time;
 751             $oldest = $file;
 752         }
 753     }
 754     closedir( DIR );
 755
 756     unlink( $dir.$oldest ) || &nph_fatal_error( "could not delete $oldest" );
 757
 758     return;
 759
 760 } ## removeOldestFile
 761
 762
 763
 764 # Last modified: 02/19/02
 765 sub print_ATV_JavaScript {
 766
 767 print <<END;
 768
 769 <SCRIPT language="JavaScript">
 770 <!-- hide
 771 function openWin( u ) {
 772   atv_window = open("", "atv_window", "width=300,height=150,status=no,toolbar=no,menubar=no,resizable=yes");
 773
 774   // open document for further output
 775   atv_window.document.open();
 776
 777   // create document
 778   atv_window.document.writeln( "<HTML><HEAD><TITLE>ATV</TITLE></HEAD>" );
 779   atv_window.document.writeln( "<BODY TEXT =\\"#FF3300\\" BGCOLOR =\\"#000000\\">" );
 780   atv_window.document.writeln( "<FONT FACE = \\"VERDANA, HELVETICA, ARIAL\\">" );
 781   atv_window.document.writeln( "<CENTER><B>" );
 782   atv_window.document.writeln( "Please do not close this window<BR>as long as you want to use ATV" );
 783   atv_window.document.writeln( "<APPLET CODEBASE = \\"$CODE_BASE_FOR_ATV_APPLET\\" ARCHIVE = \\"ATVapplet.jar\\"" );
 784   atv_window.document.writeln( " CODE = \\"forester.atv_awt.ATVapplet.class\\"" );
 785   atv_window.document.writeln( " WIDTH = 200 HEIGHT = 50>" );
 786   atv_window.document.writeln( "<PARAM NAME = url_of_tree_to_load" );
 787   atv_window.document.writeln( " VALUE = " + u + ">" );
 788   atv_window.document.writeln( "</APPLET>" );
 789   atv_window.document.writeln( "</BODY></HTML>" );
 790
 791
 792   // close the document - (not the window! flushes buffer)
 793   atv_window.document.close();
 794 }
 795 // -->
 796 </SCRIPT>
 797
 798 END
 799
 800     return;
 801
 802 } ## print_ATV_JavaScript
 803
 804
 805
 806 # Last modified: 02/19/02
 807 sub estimateTime {
 808     my $number_of_seqs = $_[ 0 ];
 809     my $estimated_time = 0;
 810     if ( $number_of_seqs <= 50 ) {
 811         $estimated_time = 15;
 812     }
 813     elsif ( $number_of_seqs <= 100 ) {
 814         $estimated_time = 20;
 815     }
 816     elsif ( $number_of_seqs <= 150 ) {
 817         $estimated_time = 30;
 818     }
 819     elsif ( $number_of_seqs <= 200 ) {
 820         $estimated_time = 35;
 821     }
 822     elsif ( $number_of_seqs <= 250 ) {
 823         $estimated_time = 40;
 824     }
 825     elsif ( $number_of_seqs <= 300 ) {
 826         $estimated_time = 60;
 827     }
 828     elsif ( $number_of_seqs <= 400 ) {
 829         $estimated_time = 100;
 830     }
 831     elsif ( $number_of_seqs <= 500 ) {
 832         $estimated_time = 160;
 833     }
 834     elsif ( $number_of_seqs <= 600 ) {
 835         $estimated_time = 390;
 836     }
 837     elsif ( $number_of_seqs <= 700 ) {
 838         $estimated_time = 530;
 839     }
 840     elsif ( $number_of_seqs <= 800 ) {
 841         $estimated_time = 750;
 842     }
 843     elsif ( $number_of_seqs <= 900 ) {
 844         $estimated_time = 850;
 845     }
 846     else {
 847         $estimated_time = $number_of_seqs;
 848     }
 849     return $estimated_time;
 850 } ## estimateTime
 851
 852
 853
 854 # Last modified: 02/19/02
 855 sub nph_rio_error {
 856
 857     my $mesg = $_[ 0 ];
 858
 859     &queue::RemoveFromQueue( "rioqueue", $remote_addr, $TEMPDIR, $$ );
 860
 861     unlink( "$TEMPDIR/$$.query", "$TEMPDIR/$$.tree" );
 862
 863
 864
 865     if ( $user_defined_tree == 1 ) {
 866         print( "<H4 class=\"error\">RIO error</H4>\n" );
 867         print( "<P><B>[the RIO analysis appearently died]</B></P>\n" );
 868         print( "<P><B>the most likely source of this error is an invalid user defined species tree</B></P>\n" );
 869     }
 870     else {
 871         print( "<H4 class=\"error\">RIO server fatal error</H4>\n" );
 872         print( "<P>[the RIO analysis appearently died for unknown reasons]</P>\n" );
 873         print( "<P><B>This type of error should not happen</B></P>\n" );
 874         print( "<P>\n" );
 875         print( "We may have logged it automatically, but we would appreciate it if you would also notify us at\n" );
 876         print( "<A HREF = \"mailto:$CONTACT\">$CONTACT</A>\n" );
 877         print( "</P>\n" );
 878     }
 879     print( "<P> &nbsp</P>\n" );
 880
 881     &print_footer();
 882     system( "rm -r $TEMPDIR/$$"."0" );
 883     die;
 884
 885 } ## nph_fatal_error
 886
 887
 888
 889 # Last modified: 02/19/02
 890 sub nph_fatal_error {
 891
 892     my $mesg = $_[ 0 ];
 893
 894     &queue::RemoveFromQueue( "rioqueue", $remote_addr, $TEMPDIR, $$ );
 895
 896     unlink( "$TEMPDIR/$$.query", "$TEMPDIR/$$.tree" );
 897
 898     print( "<H4 class=\"error\">RIO server fatal error</H4>\n" );
 899     print( "<P>[$mesg : $!]</P>\n" );
 900     print( "<P><B>This type of error should not happen</B></P>\n" );
 901     print( "<P>\n" );
 902     print( "We may have logged it automatically, but we would appreciate it if you would also notify us at\n" );
 903     print( "<A HREF = \"mailto:$CONTACT\">$CONTACT</A>\n" );
 904     print( "</P>\n" );
 905     print( "<P> &nbsp</P>\n" );
 906
 907
 908     &print_footer();
 909     die;
 910
 911 } ## nph_fatal_error
 912
 913
 914
 915 # Last modified: 02/19/02
 916 sub nph_user_error {
 917
 918     my $mesg = $_[ 0 ];
 919
 920     &queue::RemoveFromQueue( "rioqueue", $remote_addr, $TEMPDIR, $$ );
 921
 922     unlink( "$TEMPDIR/$$.query", "$TEMPDIR/$$.tree" );
 923
 924     print( "<H4 class=\"error\">user error</H4>\n" );
 925     print( "<P>\n" );
 926     print( "<B>$mesg</B>\n" );
 927     print( "</P>\n" );
 928     print( "<P> &nbsp</P>\n" );
 929
 930
 931     &print_footer();
 932
 933     die "nph-riowebserver handled: $mesg";
 934
 935 } ## nph_user_error
 936
 937
 938
 939