$location Weather Forecast Chart

#!/usr/local/bin/perl5.8.8 ############################################### # wgraph.html (parsed as cgi) # http://www.panix.com/~steveo/cgi/wgraph.html # prints weather forecast graphs # # by Steven M. O'Neill # steveo@panix.com # March 3, 2004 ############################################### use CGI::Carp qw(fatalsToBrowser); #debug only use LWP::UserAgent; my $query = $ENV{QUERY_STRING}; $query =~ s/city=//; &parse_query_string_and_set_vars; my $ua = LWP::UserAgent->new; $ua->timeout(9); my $response = $ua->get($URL); unless ($response->is_success) { print "Content-type: text/html\n\n"; print "

"; print "

Sorry

"; print "The source data, located at $URL, is not available now.

Please try again later."; print "

Please visit the NYC MetroCard Bonus Calculator."; exit; } @lines = split (/\n/, $response->content); #if ( $#lines < 50 ) { #this is because some PFMs are using
instead of newlines if ($lines[0] =~ /html/) { foreach (@lines) { if (/^\/) { @lines = split (/\/); last; } } } $start = 0; foreach (@lines) { $_ =~ s/^ //; if ($start) { last if (/^ *\$\$$/); if ( /^ *\d{3,4} [AP]M/ ) { # this is the timestamp line # so compare to timestamp file $timestamp = $_; $counterfile = "$lcloc/timestamp"; # &lock_file; #keep it locked until you generate the png, (or skip it) # if ($locked==1) { if (1) { open (CTR, "<$counterfile") or die "can't open file: $!"; chomp (@old_timestamp = ); #file should always be one line long if ($timestamp eq $old_timestamp[0]) { $skip_png = 1; } else { # it's a new file # close CTR or die $!; `echo $timestamp > $counterfile`; } } else { &print_lock_timeout; } #end if locked }#end timestamp regex close CTR; #if it's open... if ( /^$tz 3HRLY\s*((\d{2} )*\d{2}$)/i ) { #always 2-digit $precip .= $_ . "\n"; @times = split (/\s+/,$1); next; } if ( /^TEMP\s{9}([\d\s-]+)$/i ) { #1-3 chars, signed integer if ($temps[0]) { $on_temps2 = 1; #flag for this case @temps2 = &split_values; $on_temps2 = 0; } else { @temps = &split_values; } next; } if ( /^DATE\s{9}([\d\s\w\/]+)$/i ) { $tail = $1; if ($1 =~ /\d\s{12}\w/) { $precip .= "$_\n"; } else { $precip2 .= "$_\n"; } @tempor = split /\s\s+/, $tail ; push @dates, @tempor; next; } if ( /^DEWPT\s{8}([\d\s-]+)$/i ) { if ($dewpts[0]) { $on_temps2 = 1; @dewpts2 = &split_values; $on_temps2 = 0; } else { @dewpts = &split_values; } next; } if ( /^RH\s{11}([\d\s]+)$/ ) { @rhs = &split_values; next; } if ( /^WIND DIR\s*(([NWSE]{1,2} {1,2})*[NWSE]{1,2}$)/i ){ @dirs = split (/\s+/,$1); # $precip .= $_ . "\n"; next; } if ( /^WIND SPD\s{5}([\d\s]+)$/i ) { @speeds = &split_values; next; } if ( /^CLOUDS/i) { $precip .= $_ ."\n"; $getprecip = 1; next; } if ( /^AVG CLOUDS/i) { $precip2 .= $_ ."\n"; $getprecip2 = 1; next; } # if ( /^POP 12HR\s{5}\s*((\d{1,3}\s{9,11})+\d{1,3}$)/ ) { #1st POP 12HR # @pops = split (/\s+/,$1); # $getprecip = 1; # next; # } if ( /^$tz 6HRLY\s*((\d{2} +)*\d{2}$)/i ) { #always 2-digit $precip2 .= $_ . "\n"; @times2 = split (/\s+/,$1); # @times2 = split (/ /,$1); next; } if (/^MIN.MAX\s{7}\s*((\d{1,3}\s*)+\d{1,3}$)/i ) { next; } if (/^WIND CHILL/i or /^$/) { #sometimes it's wind chill, $getprecip = 0; # sometimes a blank line next; } if ($getprecip) { unless ( /^SNOW 12HR\s{5}(.*)$/i) { $precip .= $_ . "\n"; } else { #if it's a SNOW 12HR line $precip .= $_ . "\n" if ($1 =~ /[1-9]/); # don't add non-zero # snow amounts } $print_precip = 1; next; } if ($getprecip2) { $precip2 .= $_ . "\n" unless (/^$/); $print_precip2 = 1; } } else { $start = 1 if (/^$caploc/i); } } #end foreach (@lines) #unless ($skip_png) { unless (0) { $diff = $#times - $#temps; for $i (1..$diff) { #sometimes all the times aren't filled, so #shift some out if there are more temps than times shift (@times); } $max_y = 0; $min_y = 0; #distribute @pops, start at end for ($i = $#times; $i>=0; $i--) { if ( ($times[$i] == 06) or ($times[$i] == 18)) { $current = pop @pops if (defined $pops[0]); #if there's anything left in the #array, pop off last, & remember it # $max_y = $current if ($current > $max_y); #check for max_y while we're here } $spaced_pops[$i] = $current; } $i=0; #find max and min vals for y axis foreach $temp (@temps) { if ($temp < $min_y) { $min_y = $temp} else { #if not neg, could be max $max_y = $temp if ($temp > $max_y);} $max_y = $speeds[$i] if ($speeds[$i] > $max_y); #never < 0 if ($dewpts[$i] < $min_y) { $min_y = $dewpts[$i]} else { $max_y = $dewpts[$i] if ($dewpts[$i] > $max_y);} # $max_y = $rhs[$i] if ($rhs[$i] > $max_y); #never < 0 ++$i; } $max_y += 10 - ($max_y % 10); #round up to nearest 10 $min_y -= ($min_y % 10) if ($min_y < 0); #round down to nearest 10 &print_background; &print_graph; &print_second_graph }# end unless skip #unlink("$counterfile.lock") or die $!;# remove the lock, we're done with it &print_page; #end main #################### #################### sub print_graph { use CGI ':standard'; use GD; use GD::Graph::lines; # All of the arrays should same number of entries. #my @data = (\@times,\@temps,\@speeds,\@dewpts,\@spaced_pops,\@rhs); #my @data = (\@times,\@temps,\@speeds,\@dewpts,\@spaced_pops); my @data = (\@times,\@temps,\@speeds,\@dewpts); #print "Content-type: text/plain\n\n"; #print "times\ttemps\tspeeds\tdewpts\tspaced_pops\trhs"; #print "$#times\t$#temps\t$#speeds\t$#dewpts\t$#spaced_pops\t$#rhs"; my $mygraph = GD::Graph::lines->new(750, 525); $mygraph->set( x_label => "$dates[1] $dates[2] $dates[3]", y_label => '', # title => "Forecast Data for $location", y_max_value => "$max_y", y_min_value => "$min_y", y_long_ticks => '1', show_values => '1', line_width => '3', dclrs => [ qw(lred lgreen dpink lyellow lorange)], transparent => '0', bgclr => 'lgray', #white, lgray, gray, dgray, black, lblue, blue, dblue, gold, #lyellow, yellow, dyellow, lgreen, green, dgreen, lred, red, #dred, lpurple, purple, dpurple, lorange, orange, pink, dpink, #marine, cyan, lbrown, dbrown -- the possible colors logo => "$lcloc/${lcloc}_background.png", # some more options I might set, if I wanted # cumulate => '1', # x_labels_vertical => '1', # y_tick_number => '10', # transparent => '0', # bgclr => 'dgreen', # fgclr => 'green', # labelclr => 'white', # axislabelclr => 'white', legendclr =>'white', valuesclr => 'white', # textclr => 'white', ) or warn $mygraph->error; #$mygraph->set_legend("temperature (F)","wind speed (MPH)","dew point (F)","chance of precip. (%)","rel. humidity (%)"); #$mygraph->set_legend("temperature (F)","wind speed (MPH)","dew point (F)","12 h. chance of precip. (%)"); $mygraph->set_legend("temperature (F)","wind speed (MPH)","dew point (F)"); $mygraph->set_title_font(gdLargeFont); $mygraph->set_legend_font(gdSmallFont); #sometimes we see a brooklyn print "Location: wgraph.html\n\n" if ( $lcloc eq 'brooklyn' && !defined($times[0]) ); # (see 'man GD::Graph' for more options you could set) if (!defined($times[0])) { print "Content-type: text/html\n\n"; print "

"; print "$URL is returning invalid or
strangely formatted data. Please try again later."; print "

"; exit; } my $myimage = $mygraph->plot(\@data) or die $mygraph->error; open OUT, ">$lcloc/$lcloc.png" or die; print OUT $myimage->png; } #end sub ######################## sub print_page { chomp $precip; chomp $precip2; chomp $timestamp; $precip = "" unless ($print_precip); $precip2 = "" unless ($print_precip2); print "Content-type: text/html\n\n"; print < $location Weather Forecast Chart

Weather Forecast Graph for $location

$timestamp

$precip





$precip2

Source data: $URL

Key to Abbreviations: PFM/AFM User's Guide EOF print "

"; $init = "M." if ($skip_png); print "Program by Steven $init O'Neill"; print <

More Forecast Charts:
Bath, ME
Baltimore
Bennington, VT
Boston
Chicago
Hartford
Houston
New York
Orlando
Philadelphia
San Francisco
Seattle
Cincinnati

Send email to request other cities: steveo [at] panix [dot] com.

NYC Weather Links:
NOAA's Hourly Weather Graph (Similar to this page; more options.)
NOAA NYC Forecast
NOAA NYC Current Readings
NOAA "Zone" Forecast for NYC
Intellicast NYC Radar Loop

Is it Friday Yet? | NYC MetroCard Bonus Calculator | Home Page

EOF } #end sub print_page ##################### sub split_values { $template = ""; #if ($on_temps2) { #there's extra spaces in the 2nd temp line if (0) { #have to use unpack, in case of 100+ temps foreach $val (@times2) { if ($val eq '06') { #this is always the wide field $template .= "a5" } else { $template .= "a3" } } } else { # for lines other than the 2nd temp line # fields are always 3 spaces wide # $template .= "a3" for (1.. (length ($1) / 3) ) ; } #@array = unpack ("$template", $1); $line = $1; @array = split /\s+/, $line; foreach $field (@array) { $field =~ s/ //g; } while ($array[0] eq "") { shift @array; } while ($array[$#array] eq "") { pop @array; } return @array; }#end sub split_values ###################### sub lock_file { # Lock the counter file. This is a quick-and-dirty implementation of nfs-safe # locking derived from Alexis' nfslock.c code. It assumes that any lock older # than 20 seconds is stale and breaks it. $locked=0;# Assume locking failure. Will be set to 1 when we succeed $ltmp="$counterfile.lck.$$";# First, make a temporary uniquely-named file. open(LTMP, ">$ltmp") || die "Can't create counter lock-temp file: $!\n"; select(LTMP);# Force immediate writes on LTMP so the mod time... $|=1;# ...will change after each "print LTMP" below. select(STDOUT); # Now, try up to ten times to link it to the lock file foreach $i (1..10) { print LTMP ".";# force current mod time on file if (link ($ltmp, "$counterfile.lock")) {# got it $locked=1; last } else { # Check age of lock. Use the mtime of $ltmp as "now" $countertime=(stat("$counterfile.lock"))[10]; $ltmptime=(stat($ltmp))[10]; if ($countertime < $ltmptime - 20) { # The lockfile is more than 20 seconds old # so break it, it must be stale unlink "$counterfile.lock" or die $!; } sleep (int(rand(4)+1));# wait 1-4 seconds } } close LTMP; unlink($ltmp);# remove the temp file } # end sub ###################### sub print_lock_timeout { print "Content-type: text/plain\n\n"; print "Sorry, the operation has timed out -- please try again."; exit; } # end sub ###################### sub print_background { #this draws the arrows for wind speed # create a new image $im = new GD::Image(750,525); #close PNG; # allocate some colors $grey = $im->colorAllocate(160,160,160); #sets background color $ltgrey = $im->colorAllocate(200,200,200); $white = $im->colorAllocate(255,255,255); $green = $im->colorAllocate(0,255,0); # make the background transparent and interlaced $im->transparent($white); # $im->interlaced('true'); # Create a brush $brush = new GD::Image(2,2) or die $!; $white = $brush->colorAllocate(255,255,255); # $green = $brush->colorAllocate(0,255,0); $black = $brush->colorAllocate(0,0,0); $brush->transparent($white); #$image->arc($cx,$cy,$width,$height,$start,$end,$color) #$circular_brush->arc(0,0,3,3,0,360,$green); $brush->filledRectangle(0,0,2,2,$black) ; # Set the brush $im->setBrush($brush); $x = 750; $y_init = 475; #starting position $ticks = $#times + 1; #index of last + 1 $spaces = $ticks + 1; #fenceposts + 1 $degree = 504 / ($max_y - $min_y); #pixels per degree (or other unit) $offset = ((750-19)/$spaces); $i=0; #make rectangles for alternation -- should be 4 spaces long # $last_times = $times[$#times]; # $first_times = $times[0]; # $rt_sp = 6 if $last_times == '18'; # $rt_sp = 3 if $last_times == '06'; # $rt_sp = 8 if $last_times == '03'; # # $im->filledRectangle(750-(($rt_sp+4)*$offset),21,750-($offset*$rt_sp),473,$ltgrey); # $im->filledRectangle(750-(($rt_sp+12)*$offset),21,750-($offset*($rt_sp+8)),473,$ltgrey); #loop thru @speeds, start at end for ($i = $#speeds; $i>=0; $i--) { $speed = $speeds[$i]; $x -= $offset; $y = $y_init - ($speed*$degree) - 20; #move up 20 to get away from the pt. $y += ($min_y * $degree) if ($min_y < 0); #move up to zero #if $min_y is negative if ($dirs[$i] eq "W") { $x2 = $x + $speed; $y2 = $y; &make_poly($x2+3,$y2,$x2,$y2-3,$x2,$y2+3)} #draw little triangle if ($dirs[$i] eq "E") { $x2 = $x - $speed; $y2 = $y; &make_poly($x2-3,$y2,$x2,$y2-3,$x2,$y2+3)} if ($dirs[$i] eq "S") { $x2 = $x ; $y2 = $y - $speed; &make_poly($x2,$y2-3,$x2-3,$y2,$x2+3,$y2)} if ($dirs[$i] eq "N") { $x2 = $x ; $y2 = $y + $speed; &make_poly($x2,$y2+3,$x2-3,$y2,$x2+3,$y2)} if ($dirs[$i] eq "SW") { $x2 = $x + ($speed/sqrt(2)) ; $y2 = $y - ($speed/sqrt(2)) ; &make_poly($x2-2,$y2-2,$x2+2,$y2+2,$x2+2,$y2-2)} if ($dirs[$i] eq "SE") { $x2 = $x - ($speed/sqrt(2)) ; $y2 = $y - ($speed/sqrt(2)) ; &make_poly($x2-2,$y2+2,$x2-2,$y2-2,$x2+2,$y2-2)} if ($dirs[$i] eq "NE") { $x2 = $x - ($speed/sqrt(2)) ; $y2 = $y + ($speed/sqrt(2)) ; &make_poly($x2-2,$y2-2,$x2+2,$y2+2,$x2-2,$y2+2)} if ($dirs[$i] eq "NW") { $x2 = $x + ($speed/sqrt(2)) ; $y2 = $y + ($speed/sqrt(2)) ; &make_poly($x2-2,$y2+2,$x2+2,$y2+2,$x2+2,$y2-2)} $im->line($x,$y,$x2,$y2,gdBrushed) ; #draw the line for the speed vector } # make sure we are writing to a binary stream binmode STDOUT; open BACKGD, ">$lcloc/${lcloc}_background.png" or die $!; # Convert the image to PNG and print it to the file print BACKGD $im->png; close BACKGD or die $!; } #end sub ##################### sub make_poly { my($pt1, $pt2, $pt3, $pt4, $pt5, $pt6) = @_; #print "\n$pt1, $pt2, $pt3, $pt4, $pt5, $pt6"; # make a polygon $poly = new GD::Polygon; $poly->addPt($pt1,$pt2); $poly->addPt($pt3,$pt4); $poly->addPt($pt5,$pt6); # draw the polygon, filling it with a color $im->filledPolygon($poly,$green); } sub print_second_graph { for $i (0..4) {shift @dates;} #first 4 values are no good now my $extraspace = ''; $max_y = -400; $min_y = 400; $i = 0; foreach $temp (@temps2) { if ($temp > $max_y) { $max_y = $temp; } elsif ($temp < $min_y) { $min_y = $temp; } if ($dewpts2[$i] > $max_y) { $max_y = $dewpts2[$i]; } elsif ($dewpts2[$i] < $min_y) { $min_y = $dewpts2[$i]; } ++$i; } $max_y += 5 - ($max_y % 5); #round up to nearest 10 $min_y -= ($min_y % 5) if ($min_y > 0); $min_y -= ($min_y % 10) if ($min_y < 0); #round down to nearest 10 $days = $#dates + 1 ; $extraspace = ' ' if ($days == 5); my @data = (\@times2,\@temps2,\@dewpts2); my $mygraph = GD::Graph::lines->new(750, 175); $mygraph->set( x_label => "$dates[0] $dates[1] $dates[2] $dates[3] $extraspace $dates[4] ", y_label => '', title => "Forecast for Next $days Days", y_max_value => "$max_y", y_min_value => "$min_y", y_long_ticks => '1', show_values => '1', line_width => '3', dclrs => [ qw(lred dpink lyellow lorange)], bgclr => '$ltgrey', logo => "background_2.png", transparent => '0', bgclr => 'lgray', ) or warn $mygraph->error; $mygraph->set_legend("temperature (F)","dew point (F)"); $mygraph->set_title_font(gdLargeFont); $mygraph->set_legend_font(gdSmallFont); # (see 'man GD::Graph' for more options you could set) my $myimage = $mygraph->plot(\@data) or die $mygraph->error; open OUT, ">$lcloc/${lcloc}_2.png" or die; print OUT $myimage->png; } #end sub sub parse_query_string_and_set_vars { if ($query =~ /^seattle/i) { #$URL = 'http://kamala.cod.edu/wa/latest.fous51.KSEW.html'; $URL = 'http://www.nws.noaa.gov/data/SEW/PFMSEW'; $location="Seattle"; $lcloc='seattle'; $caploc='SEATTLE'; $sel_seattle = 'selected'; $tz = 'P[DS]T'; } elsif ($query =~ /^boston/i) { #$URL = 'http://kamala.cod.edu/ri/latest.fous51.KBOX.html'; #$URL = 'http://www.nws.noaa.gov/data/BOX/PFMBOX'; $URL = 'http://forecast.weather.gov/product.php?site=CRH&product=PFM&issuedby=BOX'; $location="Boston"; $lcloc='boston'; # $caploc='BOSTON|EASTERN ESSEX'; $caploc='BOSTON|SUFFOLK MA|EASTERN ESSEX'; $sel_boston = 'selected'; $tz = 'E[DS]T'; } elsif ($query =~ /^chicago/i) { $URL = 'http://forecast.weather.gov/product.php?site=CRH&product=PFM&issuedby=LOT'; $location="Chicago"; $lcloc='chicago'; $caploc='CHICAGO'; $sel_chicago = 'selected'; $tz = 'C[DS]T'; } elsif ($query =~ /^sanfrancisco/i) { $URL = 'http://forecast.weather.gov/product.php?site=CRH&product=PFM&issuedby=MTR'; $location="San Francisco"; $lcloc='sanfrancisco'; $caploc='SAN FRANCISCO'; $sel_sanfrancisco = 'selected'; $tz = 'P[DS]T'; } elsif ($query =~ /^hartford/i) { $URL = 'http://www.weather.gov/data/BOX/AFMBOX'; $location="Hartford"; $lcloc='hartford'; $caploc='WINDSOR LAKES|HARTFORD'; $sel_hartford = 'selected'; $tz = 'E[DS]T'; } elsif ($query =~ /^houston/i) { $URL = 'http://forecast.weather.gov/product.php?site=CRH&product=PFM&issuedby=HGX'; $location="Houston"; $lcloc='houston'; $caploc='HOUSTON|Intercontinental'; $sel_houston = 'selected'; $tz = 'C[DS]T'; } elsif ($query =~ /^orlando/i) { # $URL = 'http://kamala.cod.edu/fl/latest.fous52.KMLB.html'; #$URL = 'http://www.srh.noaa.gov/mlb/cgi-bin/productviewer.php?product=PFMMLB&version=0'; $URL = 'http://forecast.weather.gov/product.php?site=NWS&issuedby=MLB&product=PFM&format=txt&version=1&glossary=1'; $location="Orlando, FL"; $lcloc='orlando'; $caploc='ORLANDO'; $sel_orlando = 'selected'; $tz = 'E[DS]T'; } elsif ($query =~ /^bath/i) { $URL = 'http://www.nws.noaa.gov/data/GYX/AFMGYX'; $location="Bath, ME"; $lcloc='bath'; $caploc='.*BATH'; $sel_bath = 'selected'; $tz = 'E[DS]T'; } elsif ($query =~ /^philadelphia/i) { #$URL = 'http://kamala.cod.edu/pa/latest.fous51.KPHI.html'; $URL = 'http://www.nws.noaa.gov/data/PHI/PFMPHI'; $location="Philadelphia"; $lcloc='philadelphia'; $caploc='PHILADELPHIA'; $sel_philadelphia = 'selected'; $tz = 'E[DS]T'; } elsif ($query =~ /^bennington/i) { $URL = 'http://www.nws.noaa.gov/data/ALY/AFMALY'; $location="Bennington, VT"; $lcloc='bennington'; $caploc='BENNINGTON'; $sel_bennington = "selected"; $tz = 'E[DS]T'; } elsif ($query =~ /^rutland/i) { $URL = 'http://www.nws.noaa.gov/data/BTV/AFMBTV'; $location="Rutland, VT"; $lcloc='rutland'; $caploc='EASTERN RUTLAND'; $tz = 'E[DS]T'; } elsif ($query =~ /^baltimore/i) { $URL = 'http://www.nws.noaa.gov/data/LWX/AFMLWX'; $location="Baltimore"; $lcloc='baltimore'; $caploc='.*BALTIMORE(-|$)'; $sel_baltimore="selected"; $tz = 'E[DS]T'; } elsif ($query =~ /^brooklyn/i) { $URL = 'http://www.nws.noaa.gov/data/OKX/AFMOKX'; $location="Brooklyn"; $lcloc='brooklyn'; $caploc='KINGS'; $tz = 'E[DS]T'; } elsif ($query =~ /^cincinnati/i) { $URL = 'http://www.nws.noaa.gov/data/ILN/PFMILN'; $location="Cincinnati"; $lcloc='cincinnati'; $caploc='CINCINNATI'; $sel_cincinnati="selected"; $tz = 'E[DS]T'; } elsif ($query =~ /^dallas/i) { $URL = 'http://forecast.weather.gov/product.php?site=CRH&product=PFM&issuedby=FWD'; $location="Dallas, TX"; $lcloc='dallas'; $caploc='DFW'; $sel_dallas="selected"; $tz = 'C[DS]T'; } elsif ($query =~ /^test/i) { $URL = 'http://www.panix.com/~steveo/cgi/test/AFMOKX.2'; $location="Test"; $lcloc='test'; $caploc='BRONX|NEW YORK'; $tz = 'E[DS]T'; } else { #default is New York # $URL = 'http://www.nwnws.noaa.gov/data/OKX/AFMOKX'; # $URL = 'http://kamala.cod.edu/ct/latest.fous51.KOKX.html'; $URL ='http://www.nws.noaa.gov/data/OKX/AFMOKX'; $URL ='https://forecast.weather.gov/product.php?site=NWS&issuedby=OKX&product=PFM&format=CI&version=1&glossary=1&highlight=off'; $URL ='http://forecast.weather.gov/product.php?site=CRH&product=AFM&issuedby=OKX'; $location="New York City"; $lcloc='ny'; $caploc='Bronx|New York|Hudson'; # remember, it's the string to look for in the input file $sel_newyork = 'selected'; $tz = 'E[DS]T'; } }#end parse_query_string_and_set_vars ######################### # vim:syntax=perl