############################################################### # # Part2: Tim # ############################################################### # # # May 6, 1997 # TLSzeliga # WEB98 # Perl subroutines to build tables for web98 # Input: Two Perl Lists # RegionList # ProductList # Files: Canned text for TableTitle # output: HTML Code for tables # ################################################################# sub TableTitle { local($region, $t,$BaseName, $header) = @_; $region =~ tr /a-z/A-Z/; $header =~ tr /a-z/A-Z/; printf("

\n"); print " \n",$region, $header; print "
\n"; printf " 
"; printf("",$region,$t); printf "%s : %s
\n"; #printf("
Available product: %s %s
\n",$region,$header); } # sub open_table { printf ("\n"); } # sub table_header { local($ext_key,%ext_types) = @_ ; $colspan = $#{$ext_types{$ext_key}} +1; # printf("\n\n99999: $colspan $ext_key : @{ $ext_types{$ext_key} }\n"); printf("\n \n \n \n \n \n \n \n \n"); for $i ( @{$ext_types{$ext_key}} ) { &table_cell($Legend{$i},"#000000"); } &close_row; } # # This routine needs the filename and location sub td_link { local($Text, $Link) = @_; printf "\n", $Text, $Link; } # # This routine needs only the filename. sub td_only { local($Text) = @_; printf "\n",$Text; } # # This routine needs only the filename. sub table_cell { local($Text,$Color) = @_; printf " \n \n"; } # sub open_row { printf ("\n"); } # sub close_row { printf ("\n"); } # sub open_html { local($title) = @_; printf (""); printf ("\n"); printf ("\n"); printf "%s\n", $title; printf ("\n"); printf ("\n"); } # sub close_table { printf ("
\n

Date

\n 		\n

Format

\n
\ \;%s %s \n

$Text

\n
\n"); } # sub close_html { printf ("\n"); printf ("\n"); } # sub html_head { ### TLS modified from cgihandlers.pl html_header() routine; ### remove tag to allow BG colors & LINK colors # # Subroutine html_header sends to Standard Output the necessary # material to form an HTML header for the document to be # returned, the single argument is the TITLE field. local($title) = @_; print "Content-type: text/html\n\n"; print "\n"; printf (""); print "$title\n"; print "\n"; } sub html_body { ### TLS modified from cgihandlers.pl html_header() routine; ### remove tag to allow BG colors & LINK colors # # Subroutine html_header sends to Standard Output the necessary # material to form an HTML header for the document to be # returned, the single argument is the TITLE field. local($textcolor,$bgcolor,$linkcolor,$vlinkcolor,$alinkcolor) = @_; print "\n"); } # # Inputs cwa (county warning areas), member RFC & 2-letter code (twolc) # from db/cwa.cat # sub ReadCWAdb { # # TS - 970523 cribbed from the blue camel, p267 # # # TLS - 970606 - new format for cwa.cat # ## ##twolc | CWA | RFC | TYPE1 | TYPE2 | DIR | NAME ## ## 0a | oun | ab | r | 8 | cwa | Oklahoma City, OK ## 0b | mlb | se | r | 8 | cwa | Melbourne, FL ## 0c | ddc | ab | r | 8 | cwa | Dodge City, KS local($rfc, $cwa, $twolc,$type1,$type2,$cwa_name); $typefile="$dbdir"."/"."cwa.cat"; $typefile =~ tr /A-Z/a-z/; %name_for_cwa=(); %twolc_for_cwa=(); open(TYPEFD,"$typefile") || print "Can not open $typefile \n"; LINE: while ( ) { chop; next LINE if /^#/; next LINE if /^$/; next unless s/^(.*?)|\s*|\s*//; ($twolc,$cwa,$rfc,$type1,$type2,$web_dir,$cwa_name) = split(/\|/,$_); # strip white spaces. $rfc =~ s/\s+//g; $cwa =~ s/\s+//g; $twolc =~ s/\s+//g; # Do not strip spaces from $cwa_name # Associate a two-letter code for each cwa and vice versa # This mapping is 1:1 and onto, so no problem with # duplicate or missing entries. $twolc_for_cwa{$cwa} = $twolc; # Associate a Name for each cwa and vice versa # This mapping is 1:1 and onto, so no problem with # duplicate or missing entries. $name_for_cwa{$cwa} = $cwa_name; # Make a hash of arrays, with set of cwas in each RFC. # This is not 1:1, but it is onto, ie, each cwa is in at least one RFC. push @{ $HoL{$rfc} }, $cwa; } close(TYPEFD); ($HoL, $twolc_for_cwa, $name_for_cwa); ## TLS changed $twolc... to %twolc... ## TLS 970618 changed it back. } ########################### # # query dataBaseName and store query results in Assosciative # arrays: ShefData, GifData, ArzData, ... # # # sub FetchCWAProducts { local($selregion, $selrfc, $pclass, $mindate, $maxdate) = @_; local($data, $fname); local($junk, $ftp,$pub, $products, $region, $rfc, $cwa, $lc3,$fname); $dbfile="$dbdir"."/"."cwa".".db"; $dbfile =~ tr/A-Z/a-z/; open(FD,$dbfile) || (&bailout("Bailing out: can not open $dbfile")) ; ($mindate,$maxdate) = &MinMax($mindate,$maxdate); $selregion =~ tr/A-Z/a-z/; if ( $selrfc ) { $selrfc = "$selrfc"."rfc"; } while ( ) { chop; $data=$_; $rfc=""; if ( $selrfc =~ /rfc/) { ($junk, $ftp,$pub, $products, $region, $rfc, $cwa, $lc3, $fname) = split(/\//,$_); # printf "$junk, $ftp,$pub, $products, $region, $rfc, $cwa, $lc3, $fname
\n"; } $fname =~ s/\s+//g; $type=substr($fname,2,1); $region =~ s/\s+//g; $rfc =~ s/\s+//g; ## $date =~ s/\s+//g; $cwa =~ s/\s+//g; $lc3 =~ s/\s+//g; $none=1; # Take care of wild cards. $Q1=" \"\$pclass\" eq \"$class{$type}\" "; $Q2=" $date >= $mindate && $date <= $maxdate\" "; $Q3=" \"$selregion\" eq \"$region\" "; # printf("Q1=$Q1\n"); # printf("Q2=$Q2\n"); # printf("Q3=$Q3\n"); if ( $selrfc =~ /rfc/ ) { if ( $pclass =~ /$class{$type}/ && $date >= $mindate && $date <= $maxdate && $selregion =~ /$cwa/ && $selrfc =~ /$rfc/ ) { ($BaseName,$ext)=split(/\./,$fname); $ProductList{$BaseName} = 2; ### No date for CWA data, must compute $TwoLetterCode{$BaseName}=substr($BaseName,0,2); $CWA_code{$BaseName}=$lc3; $ProdType{$BaseName}=substr($BaseName,2,1); $JulDay{$BaseName}=substr($BaseName,3,5); $date = &julian($JulDay{$BaseName}); $ProductDate{$BaseName} = $date; } } } close(FD); } sub julian { local($yyjjj) = @_; @lastd = (0,31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365); @month = ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'); $last{'January'} = 31; $last{'February'} = 59; $last{'March'} = 90; $last{'April'} = 120; $last{'May'} = 151; $last{'June'} = 181; $last{'July'} = 212; $last{'August'} = 243; $last{'September'} = 273; $last{'October'} = 304; $last{'November'} = 334; $last{'December'} = 365; # printf ("in Julian: %s\n",$yyjjj); local($yy) = substr($yyjjj, 0, 2) . ''; local($j) = substr($yyjjj, 2, 3) . ''; $mm=1; # printf("Lastd: %s %s %d %s\n", $yy, $j,$mm, $lastd[$mm]); while (($j > $lastd[$mm]) && ($mm<13)) { $dd = $lastd[$mm] - $j + 1; # printf ("in Julian Loop: %s/%s/%s %s\n",$yy,$lastd[$mm],$mm,$dd); $mm++; } $jp1 = $j + 1; $dd = $j - $lastd[--$mm] ; $dfill= (length($dd)<2)?'0':''; $mfill= (length($mm)<2)?'0':''; # printf ("exiting Julian: %d %d %d %d %d\n",$jp1,$j,$lastd[$mm],$dd, $mm); ($yy.$mfill.$mm.$dfill.$dd); } 1;