From 3083449b22d2ee8f3cd6f78f74f5993d43d76a3f Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sun, 28 Dec 2014 21:04:15 +0000 Subject: [PATCH] start a real(ish) dweather webapp --- Loop.pm | 550 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ dweather | 138 ++++++++++++++ 2 files changed, 688 insertions(+) create mode 100755 Loop.pm create mode 100755 dweather diff --git a/Loop.pm b/Loop.pm new file mode 100755 index 0000000..ce96d96 --- /dev/null +++ b/Loop.pm @@ -0,0 +1,550 @@ +#!/usr/bin/perl + +package Loop; + +use strict; + +use v5.10.1; + +use Serial; +use Mojo::IOLoop; +use Mojo::IOLoop::Stream; +use JSON; +use Debug; +use SMGLog; +use Math::Round qw(nearest); + +use constant pi => 3.14159265358979; + +our $json = JSON->new->canonical(1); + +our @crc_table = ( + 0x0, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7, + 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef, + 0x1231, 0x210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6, + 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de, + 0x2462, 0x3443, 0x420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485, + 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d, + 0x3653, 0x2672, 0x1611, 0x630, 0x76d7, 0x66f6, 0x5695, 0x46b4, + 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc, + 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x840, 0x1861, 0x2802, 0x3823, + 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b, + 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0xa50, 0x3a33, 0x2a12, + 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a, + 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0xc60, 0x1c41, + 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49, + 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0xe70, + 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78, + 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f, + 0x1080, 0xa1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067, + 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e, + 0x2b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256, + 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d, + 0x34e2, 0x24c3, 0x14a0, 0x481, 0x7466, 0x6447, 0x5424, 0x4405, + 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c, + 0x26d3, 0x36f2, 0x691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634, + 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab, + 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x8e1, 0x3882, 0x28a3, + 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a, + 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0xaf1, 0x1ad0, 0x2ab3, 0x3a92, + 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9, + 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0xcc1, + 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8, + 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0xed1, 0x1ef0 + ); + +our %bar_trend; + +$bar_trend{-60} = "Falling Rapidly"; +$bar_trend{196} = "Falling Rapidly"; +$bar_trend{-20} = "Falling Slowly"; +$bar_trend{236} = "Falling Slowly"; +$bar_trend{0} = "Steady"; +$bar_trend{20} = "Rising Slowly"; +$bar_trend{60} = "Rising Rapidly"; + +our $ending = 0; + +$SIG{TERM} = $SIG{INT} = sub {++$ending; Mojo::IOLoop->stop;}; +$SIG{HUP} = 'IGNORE'; + +sub new +{ + my $pkg = shift; + my $class = ref $pkg || $pkg; + my $self = bless {}, $class; + $self->{poll_interval} ||= 2.5; + $self->{rain_mult} ||= 0.2; # 0.1 or 0.2 mm or 0.01 inches + $self->{devname} ||= "/dev/davis"; + $self->{datafn} ||= ".loop_data"; + $self->{state} ||= "ready"; + + open $self->{dataf}, "+>>", $self->{dataf} or die "cannot open $self->{dataf} $!"; + $self->{dataf}->autoflush(1); + $self->read_ld; + + dbg "last_min: " . scalar gmtime($self->{ld}->{last_min}); + dbg "last_hour: " . scalar gmtime($self->{ld}->{last_hour}); + + return $self; +} + +sub start +{ + $self->{did} = Mojo::IOLoop->recurring(1 => sub {$dlog->flushall}); + do_reopen($self->{devname}); +} + +sub stop +{ + $self->write_ld; + close $self->{dataf} if $self->{dataf}; + delete $self->{dataf}; +} + +sub DESTROY +{ + my $self = shift; + $self->stop if $self->{dataf}; +} + +sub on_read +{ + my ($self, $d) = @_; + $self->{buf} .= $d; + $d =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; + dbg "read added '$d' buf lth=" . length $self->{buf} if isdbg 'raw'; + if ($self->{state} eq 'waitnl' && $self->{buf} =~ /[\cJ\cM]+/) { + dbg "Got \\n" if isdbg 'state'; + Mojo::IOLoop->remove($self->{tid}) if $self->{tid}; + delete $self->{tid}; + delete $self->{buf}; + $self->{nlcount} = 0; + $self->{ser}->write("LPS 1 1\n"); + $self->chgstate("waitloop"); + } elsif ($self->{state} eq "waitloop") { + if ($self->{buf} =~ /\x06/) { + dbg "Got ACK 0x06" if isdbg 'state'; + $self->chgstate('waitlooprec'); + delete $self->{buf}; + } + } elsif ($self->{state} eq 'waitlooprec') { + if (length $self->{buf} >= 99) { + dbg "got loop record" if isdbg 'chan'; + $self->chgstate(''); + $self->process; + delete $self->{buf}; + } + } +} + +sub start_loop +{ + my $self = shift; + + $self->{nlcount} = 1; + dbg "start_loop writing $self->{nlcount} \\n" if isdbg 'state'; + $self->{ser}->write("\n"); + Mojo::IOLoop->remove($self->{tid}) if $self->{tid}; + undef $self->{tid}; + $self->{tid} = Mojo::IOLoop->recurring(0.6 => sub { + if (++$self->{nlcount} > 10) { + dbg "\\n count > 10, closing connection" if isdbg 'chan'; + do_reopen($self->{devname}); + return; + } + dbg "writing $self->{nlcount} \\n" if isdbg 'state'; + $self->{ser}->write("\n"); + }); + $self->chgstate("waitnl"); +} + +sub chgstate +{ + my $self = shift; + dbg "state '$self->{state}' -> '$_[0]'" if isdbg 'state'; + $self->{state} = $_[0]; +} + +sub do_reopen +{ + my $self = shift; + my $name = shift; + dbg "do reopen on '$name' ending $ending"; + unless ($ending) { + $self->{ser} = do_open($name); + start_loop(); + $self->chgstate(''); + $self->{nlcount} = 0; + Mojo::IOLoop->next_tick(sub {do_reopen { + } while (_); }) unless Mojo::IOLoop->is_running; + } +} + +sub do_open +{ + my $self = shift; + my $name = shift; + + $self->{ser}->close if $self->{ser}; + undef $self->{ser}; + + my $ob = Serial->new($name, 19200) || die "$name $!\n"; + dbg "streaming $name fileno(" . fileno($ob) . ")" if isdbg 'chan'; + + my $self->{ser} = Mojo::IOLoop::Stream->new($ob); + $self->{ser}->on(error=>sub {dbg "serial $_[1]"; do_reopen($name) unless $ending}); + $self->{ser}->on(close=>sub {dbg "serial closing"; do_reopen($name) unless $ending}); + $self->{ser}->on(timeout=>sub {dbg "serial timeout";}); + $self->{ser}->on(read=>sub {on_read(@_)}); + $self->{ser}->start; + + Mojo::IOLoop->remove($self->{tid}) if $self->{tid}; + undef $self->{tid}; + Mojo::IOLoop->remove($self->{rid}) if $self->{rid}; + undef $self->{rid}; + $self->{rid} = Mojo::IOLoop->recurring($self->{poll_interval} => sub { + start_loop() if !$self->{state}; + }); + $self->chgstate(''); + $self->{nlcount} = 0; + + return $self->{ser}; +} + +sub process +{ + my $self = shift; + my $blk = $self->{buf}; + my $loo = substr $blk,0,3; + unless ( $loo eq 'LOO') { + dbg "Block invalid loo -> $loo" if isdbg 'chan'; return; + } + + my $tmp; + my $rain; + my %h; + + my $crc_calc = CRC_CCITT($blk); + + if ($crc_calc==0) { + + # Common ones + $tmp = unpack("s", substr $blk,7,2) / 1000; + $h{Pressure} = nearest(1, in2mb($tmp)); + + $tmp = unpack("s", substr $blk,9,2) / 10; + $h{Temp_In} = nearest(0.1, f2c($tmp)); + + $tmp = unpack("s", substr $blk,12,2) / 10; + $h{Temp_Out} = nearest(0.1, f2c($tmp)); + + $tmp = unpack("C", substr $blk,14,1); + $h{Wind} = nearest(0.1, mph2mps($tmp)); + $h{Dir} = unpack("s", substr $blk,16,2)+0; + + my $wind = {w => $h{Wind}, d => $h{Dir}}; + push @{$self->{ld}->{wind_min}}, $wind; + + $h{Humidity_Out} = unpack("C", substr $blk,33,1)+0; + $h{Humidity_In} = unpack("C", substr $blk,11,1)+0; + + $tmp = unpack("C", substr $blk,43,1)+0; + $h{UV} = $tmp unless $tmp >= 255; + $tmp = unpack("s", substr $blk,44,2)+0; # watt/m**2 + $h{Solar} = $tmp unless $tmp >= 32767; + + # $h{Rain_Rate} = nearest(0.1,unpack("s", substr $blk,41,2) * $self->{rain_mult}); + $rain = $h{Rain_Day} = nearest(0.1, unpack("s", substr $blk,50,2) * $self->{rain_mult}); + my $delta_rain = $h{Rain} = nearest(0.1, ($rain >= $self->{ld}->{last_rain} ? $rain - $self->{ld}->{last_rain} : $rain)) if $self->{loop_count}; + $self->{ld}->{last_rain} = $rain; + + # what sort of packet is it? + my $sort = unpack("C", substr $blk,4,1); + if ($sort) { + + # Newer LOOP2 packet + $tmp = unpack("C", substr $blk,18,2); + # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp/10)); + $tmp = unpack("C", substr $blk,20,2); + # $h{Wind_Avg_2} = nearest(0.1,mph2mps($tmp/10)); + $tmp = unpack("C", substr $blk,22,2); + # $h{Wind_Gust_10} = nearest(0.1,mph2mps($tmp/10)); + + # $h{Dir_Avg_10} = unpack("C", substr $blk,24,2)+0; + $tmp = unpack("C", substr $blk,30,2); + $h{Dew_Point} = nearest(0.1, f2c($tmp)); + + } else { + + # Older LOOP packet + $tmp = unpack("C", substr $blk,15,1); + # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp)); + $h{Dew_Point} = nearest(0.1, dew_point($h{Temp_Out}, $h{Humidity_Out})); + $h{Rain_Month} = nearest(0.1, unpack("s", substr $blk,52,2) * $self->{rain_mult}); + $h{Rain_Year} = nearest(0.1, unpack("s", substr $blk,54,2) * $self->{rain_mult}); + } + + my $ts = time; + my $s; + if ($ts >= $self->{ld}->{last_hour} + 3600) { + $h{Pressure_Trend} = unpack("C", substr $blk,3,1); + $h{Pressure_Trend_txt} = $bar_trend{$h{Pressure_Trend}}; + $h{Batt_TX_OK} = (unpack("C", substr $blk,86,1)+0) ^ 1; + $h{Batt_Console} = nearest(0.01, unpack("s", substr $blk,87,2) * 0.005859375); + $h{Forecast_Icon} = unpack("C", substr $blk,89,1); + $h{Forecast_Rule} = unpack("C", substr $blk,90,1); + $h{Sunrise} = sprintf( "%04d", unpack("S", substr $blk,91,2) ); + $h{Sunrise} =~ s/(\d{2})(\d{2})/$1:$2/; + $h{Sunset} = sprintf( "%04d", unpack("S", substr $blk,93,2) ); + $h{Sunset} =~ s/(\d{2})(\d{2})/$1:$2/; + + if ($self->{loop_count}) { # i.e not the first + my $a = wind_average(scalar @{$self->{ld}->{wind_hour}} ? @{$self->{ld}->{wind_hour}} : {w => $h{Wind}, d => $h{Dir}}); + + $h{Wind_1h} = nearest(0.1, $a->{w}); + $h{Dir_1h} = nearest(0.1, $a->{d}); + + $a = wind_average(@{$self->{ld}->{wind_min}}); + $h{Wind_1m} = nearest(0.1, $a->{w}); + $h{Dir_1m} = nearest(1, $a->{d}); + + ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = $self->calc_rain($rain); + } + $self->{ld}->{last_rain_min} = $self->{ld}->{last_rain_hour} = $rain; + + $s = genstr($ts, 'h', \%h); + + $self->{ld}->{last_hour} = int($ts/3600)*3600; + $self->{ld}->{last_min} = int($ts/60)*60; + @{$self->{ld}->{wind_hour}} = (); + @{$self->{ld}->{wind_min}} = (); + + write_ld(); + + } elsif ($ts >= $self->{ld}->{last_min} + 60) { + my $a = wind_average(@{$self->{ld}->{wind_min}}); + my %save; + + push @{$self->{ld}->{wind_hour}}, $a; + + if ($self->{loop_count}) { # i.e not the first + my $rm; + + $h{Wind_1m} = nearest(0.1, $a->{w}); + $h{Dir_1m} = nearest(1, $a->{d}); + ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = $self->calc_rain($rain); + } + $self->{ld}->{last_rain_min} = $rain; + + $s = genstr($ts, 'm', \%h); + + $self->{ld}->{last_min} = int($ts/60)*60; + @{$self->{ld}->{wind_min}} = (); + + write_ld(); + + } else { + my $o = gen_hash_diff($self->{ld}->{last_h}, \%h); + if ($o) { + $s = genstr($ts, 'r', $o); + } + else { + dbg "loop rec not changed" if isdbg 'chan'; + } + } + output_str($s) if $s; + $self->{ld}->{last_h} = \%h; + ++$self->{loop_count}; + } else { + dbg "CRC check failed for LOOP data!"; + } + return; +} + +sub genstr +{ + my $ts = shift; + my $let = shift; + my $h = shift; + + my $j = $json->encode($h); + my ($sec,$min,$hr) = (gmtime $ts)[0,1,2]; + my $tm = sprintf "%02d:%02d:%02d", $hr, $min, $sec; + + return qq|{"tm":"$tm","t":$ts,"$let":$j}|; +} + +sub output_str +{ + my $s = shift; + dbg $s; +# say $s; + $dlog->writenow($s); +} + +sub gen_hash_diff +{ + my $last = shift; + my $now = shift; + my %o; + my $count; + + while (my ($k, $v) = each %$now) { + if ($last->{$k} ne $now->{$k}) { + $o{$k} = $v; + ++$count; + } + } + return $count ? \%o : undef; +} + +sub dew_point +{ + my $temp = shift @_; + my $rh = shift @_; + + # Using the simplified approximation for dew point + # Accurate to 1 degree C for humidities > 50 % + # http://en.wikipedia.org/wiki/Dew_point + + my $dewpoint = $temp - ((100 - $rh) / 5); + + # this is the more complete one (which doesn't work) + #my $a = 6.1121; + #my $b = 18.678; + #my $c = 257.14; + #my $ytrh = log(($rh/100) + ($b * $temp) / ($c + $temp)); + #my $dewpoint = ($c * $ytrh) / ($b - $ytrh); + + return $dewpoint; +} + +sub CRC_CCITT +{ + # Expects packed data... + my $data_str = shift @_; + + my $crc = 0; + my @lst = split //, $data_str; + foreach my $data (@lst) { + my $data = unpack("c",$data); + + my $crc_prev = $crc; + my $index = $crc >> 8 ^ $data; + my $lhs = $crc_table[$index]; + #print "lhs=$lhs, crc=$crc\n"; + my $rhs = ($crc << 8) & 0xFFFF; + $crc = $lhs ^ $rhs; + + + } + + return $crc; +} + +sub f2c +{ + return ($_[0] - 32) * 5/9; +} + +sub mph2mps +{ + return $_[0] * 0.44704; +} + +sub in2mb +{ + return $_[0] * 33.8637526; +} + +sub wind_average +{ + my ($sindir, $cosdir, $wind); + my $count; + + foreach my $r (@_) { + $wind += $r->{w}; + $sindir += sin(d2r($r->{d})) * $r->{w}; + $cosdir += cos(d2r($r->{d})) * $r->{w}; + ++$count; + } + + my $avhdg = r2d(atan2($sindir, $cosdir)); + $avhdg += 360 if $avhdg < 0; + return {w => nearest(0.1,$wind / $count), d => nearest(0.1,$avhdg)}; +} + +# radians to degrees +sub r2d +{ + my $n = shift; + return ($n / pi) * 180; +} + +# degrees to radians +sub d2r +{ + my $n = shift; + return ($n / 180) * pi; +} + +sub calc_rain +{ + my $self = shift; + my $rain = shift; + + $self->{ld}->{rain24} ||= []; + + my $Rain_1h = nearest(0.1, $rain >= $self->{ld}->{last_rain_hour} ? $rain - $self->{ld}->{last_rain_hour} : $rain); # this is the rate for this hour, so far + my $rm = $rain >= $self->{ld}->{last_rain_min} ? $rain - $self->{ld}->{last_rain_min} : $rain; + my $Rain_1m = nearest(0.1, $rm); + push @{$self->{ld}->{rain24}}, $Rain_1m; + $self->{ld}->{rain_24} += $rm; + while (@{$self->{ld}->{rain24}} > 24*60) { + $self->{ld}->{rain_24} -= shift @{$self->{ld}->{rain24}}; + } + my $Rain_24h = nearest(0.1, $self->{ld}->{rain_24}); + return ($Rain_1m, $Rain_1h, $Rain_24h); +} + +sub read_ld +{ + my $self = shift; + + return unless $self->{dataf}; + + seek $self->{dataf}, 0, 0; + my $s = <$self->{dataf}>; + chomp $s; + dbg "read loop data: $s" if isdbg 'json'; + $ld = $json->decode($s) if length $s; + + # sort out rain stats + my $c; + if (($c = @{$self->{ld}->{rain24}}) < 24*60) { + my $diff = 24*60 - $c; + unshift @{$self->{ld}->{rain24}}, 0 for 0 .. $diff; + } + my $rain; + $rain += $_ for @{$self->{ld}->{rain24}}; + $self->{ld}->{rain_24} = nearest(0.1, $rain); + delete $self->{ld}->{hour}; + delete $self->{ld}->{min}; +} + +sub write_ld +{ + my $self = shift; + + return unless $self->{dataf}; + + seek $self->{dataf}, 0, 0; + truncate $self->{dataf}, 0; + $self->{ld}->{ts} = time; + my $s = $json->encode($ld); + dbg "write loop data: $s" if isdbg 'json'; + print $self->{dataf} "$s\n"; +} + +1; diff --git a/dweather b/dweather new file mode 100755 index 0000000..75e2c4e --- /dev/null +++ b/dweather @@ -0,0 +1,138 @@ +#!/usr/bin/perl +use strict; + +use v5.10.1; + +use Mojolicious::Lite; +use Loop; +use Debug; +use SMGLog; + +our $dlog; # the day log +our $loop; # the Davis VP2 driver + +helper debug_start => sub { + dbginit(); + if (@ARGV) { + dbgadd(@ARGV); + } + dbgadd('chan'); + + dbg '***'; + dbg "*** starting $0"; + dbg '***'; +}; + +helper debug_stop => sub { + dbg '***'; + dbg "*** ending $0"; + dbg '***'; +}; + +helper loop_start => sub { + $loop = Loop->new; + $loop->start; +}; + +helper loop_stop => sub { + $loop->stop; +}; + +helper dlog_start => sub { + $dlog = SMGLog->new("day"); +}; + + +helper dlog_stop => sub { + $dlog->close; +}; + +# setup base route +any '/' => sub { + my $c = shift; + $c->render('index'); +}; + +# WebSocket weather service +websocket '/weather_data' => sub { + my $c = shift; + + # Opened + $c->app->log->debug('WebSocket opened.'); + dbg 'WebSocket opened' if isdbg 'chan'; + + # Increase inactivity timeout for connection a bit + $c->inactivity_timeout(60*60); + + # Incoming message + $c->on( + message => sub { + my ($c, $msg) = @_; + dbg "websocket: $msg" if isdbg 'chan'; + }, + json => sub { + my ($c, $msg) = @_; + dbg "websocket: $msg" if isdbg 'chan'; + } + ); + + # Closed + $c->on(finish => sub { + my ($c, $code, $reason) = @_; + $c->app->log->debug("WebSocket closed with status $code."); + dbg 'WebSocket closed with status $code' if isdbg 'chan'; + }); + + $c->render; + +}; + +app->debug_start; +app->dlog_start; +app->loop_start; + +app->start; + +app->loop_stop; +app->dlog_stop; +app->debug_stop; + +exit 0; + + +__DATA__ +@@ index.html.ep + + + DWeather + + +

DWeather

+ + + -- 2.34.1