# Create a user agent object
use strict;
use warnings;
use Tk;
use Tk::EasyGUI qw(
	column_of_entries
	row_of_buttons
	entries_accept
	entries_rollback
	entries_to_string
);
use Config; # Know what OS this is.
use LWP::UserAgent; # So can fetch HTTP pages to parse.
my $ua = LWP::UserAgent->new; # Ditto.

# Don't confuse stupider-than-average firewalls with new idea.
# Obtained from http://www.psychedelix.com/agents/index.shtml
$ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; bgft)');

# Select file path base depending on OS.
my $path_base = $Config::Config{'osname'} =~ /Win/i ? 'C:/' : '~/';
my ($VERSION) = '$Revision: 0.02 $' =~ m{ \$Revision: \s+ (\S+) }xm;
my $mw = Tk::EasyGUI::init("Barrometer - $VERSION", \&append_log);
my %baro = (
	bp           => 0,
	bp_at_sl     => 0,
	elevation    => 640,
	update_site  => 0,
	update_time  => 0,
	wx_url_major => q{http://www.crh.noaa.gov/forecast/MapClick.php?},
	wx_url_minor => q{CityName=Zeeland&state=MI&site=GRR},
	path_log     => $path_base . q{barometer.log},
);

# http://www.crh.noaa.gov/forecast/MapClick.php?CityName=Zeeland&state=MI&site=GRR

# Create an LWP request of NOAA web page to parse.
my $req = HTTP::Request->new(
	GET => $baro{wx_url_major} . $baro{wx_url_minor},
);
$req->header(Accept => "text/html, */*;q=0.1");

# Adjust displayed barometer reading.
sub baro_adj {
	$baro{bp_at_sl}  = $_[0] if defined $_[0];
	$baro{elevation} = $_[1] if defined $_[1];
	$baro{bp} = sprintf
		'%2.2f',
		$baro{bp_at_sl}
		* (1 - ( 6.8753 * 10 ** -6 * $baro{elevation} ))
	 	** 5.2559;
	return $baro{bp};
}

# Designate N rows of Label/Entry widgets.
my @tk_ent = (
	{ show_feedback   => 1,
	  label_width     => 10,
	  entry_width     => 40,
	}, # Your attribs. Empty hash or none is okay.
	['In Hg Comp',   'r',   \$baro{bp},       0, 40, 2],
	['In Hg at SL',  'r',   \$baro{bp_at_sl}, 0, 40, 2],
	['Elevation',    'i',   \$baro{elevation}, -200, 29_035],  # Death Valley to Mt. Everest
	['Where',        's',   \$baro{update_site}],
	['When',         's',   \$baro{update_time}],
	['Log File',     'ps',  \$baro{path_log}],
);

my $wgt_1 = column_of_entries( $mw, 'Parameters', \@tk_ent ); # Build widgets.

# Designate a labeled row of button widgets.
my @tk_btn = (
	{ label_width     => 10,
	  frame_relief    => 'flat',
	  frame_pack_side => 'top' }, # Optional attribs. Empty hash okay.

	[ 'Submit', sub { submit_entries($wgt_1) },  # Label and action.
	  'gray', 'yellow'                           # In-active and active colors.
	],
	[ 'Exit',   sub { exit MainLoop },   # Label and action. Default colors.
	],
);

my $wgt_2 = row_of_buttons( $mw, 'Actions', \@tk_btn ); # Build widgets.

# Action for submit button.
sub submit_entries {
	my $wgt = shift;
	entries_accept($wgt);
	get_baro_rdg();
}

get_baro_rdg(); # Get first time.
$mw->repeat(1_000 * 60 * 10, sub {get_baro_rdg()}); # Get at intervals after.

MainLoop;

# When is it now?
sub current_DTG {
	my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst )
		= localtime(time);
	my $dtg = sprintf( "%04d-%02d-%02d %02d:%02d:%02d",
		$year + 1900, $mon + 1, $mday, $hour, $min, $sec );
	return $dtg;
}

# Append an entry to the log file.
sub append_log {
	my $txt = shift;
	my $mesg = current_DTG() . " $txt \n";
	my $LOG;
	my $path_log = ref $wgt_1->{'to'}->{'Log File'}
		? ${$wgt_1->{'to'}->{'Log File'}}
		: $wgt_1->{'to'}->{'Log File'};
	if (open $LOG, qq|>>$path_log| ) {
		print $LOG $mesg;
		close $LOG;
		$wgt_1->{'fm'}->{'Feedback'} =
			qq{Okay! Entries appended to '$path_log' };
	} else {
		$wgt_1->{'fm'}->{'Feedback'} =
			qq{Oops! Cannot append to log '$path_log': $! };
	}
}


=pod  Sample Excerpt to be RegEx'd for Time and Location

<td><span class="blue1">Holland, Tulip City Airport</span><br>Last Update on Feb 1, 1:53 pm EST<br><br></td></tr><tr>

=cut

=pod Sample Excerpt to be RegEx'd for Barrometer

<td><b>Barometer</b>:</td>
<td align="right" nowrap>29.72&quot; (1007.3 mb)</td>

=cut

# Parse out baro reading or give error message.
sub get_baro_rdg {
	my $res = $ua->request($req);
	if ($res->is_success) {
		my @lines = split /\n/, $res->content;
		for my $i (0..$#lines) {
			next unless $lines[$i] =~ m/(Last Update on)|(Barometer)/i;
			if ($lines[$i] =~ /<td><span class="\w+">(.*)<\/span><br>Last Update on (.*)<br><br>+/) {
				$baro{update_site} = $1;
				$baro{update_time} = $2;
			} elsif ($lines[$i+1] =~ /<td align="right" nowrap>(\d+\.\d+)&quot;/) {
				update_widgets($wgt_1, $1);
				# show_on_cli();
			}
		}
		unless (
				$baro{update_site} =~ m/[a-z]+/i # Has place name, not just a zero.
				&&
				$baro{update_time} =~ m/[a-z]+/i # Has month and zone, not just a zero.
			) {
			error_response(
				'Web page did not parse as expected. '
				. 'Check URL for change-of-format. '
				. 'Re-edit script RegEx in sub get_baro_rdg() to match if changed. '
			);
		}
	} else {
		error_response( $res->status_line );
	}
}

# Pass changed info through to widgets.
sub update_widgets {
	my ($wgt, $baro) = @_;
	baro_adj($1);
	entries_rollback($wgt, $wgt->{to}, $wgt->{fm}, 'white');

	# Log string of entries prefixed 'Readings: ' excluding the 'Log File' entry.
	append_log(
		'Baro Readings: '
		. entries_to_string($wgt, $wgt->{to}, 'Log File')
	);
}

# Deal with an error message.
sub error_response {
	my $oops_msg = shift;
	append_log($oops_msg);
	$wgt_1->{'fm'}->{'Feedback'} = qq{Oops! $oops_msg};
}

# For testing purposes only.
sub show_on_cli {
	print "Airport barometer reading of $baro{bp_at_sl} compensated for ";
	print "$baro{elevation} feet is $baro{bp}\n";
	print "Reading taken from $baro{update_site} at $baro{update_time}\n";
}

=pod

Formula used for calculating corrected baro pressure
BP = SLBP * (1 - [ 6.8753*10**-6 * A ])**5.2559

BP: Local Barometric Pressure (In. Hg)
SLBP: Barometric Pressure Corrected to Sea Level (In. Hg)
A: Altitude (Feet), Holland’s altitude is 640 feet above sea level

Altitude Compensation Equation
Ref.
	American Society of Heating,
	Refrigeration and Air-Conditioning Engineers, Inc.
	1997 ASHRAE Handbook - Fundamentals, Inch-Pound Edition

	Perry, R.H.,
	Green, D.W., and Maloney,
	J.O. 1984.
	Chapter 6. Psychrometrics.
	Perry’s Chemical Engineers’ Handbook.

=cut