9 use Mojo::IOLoop::Stream;
10 use Mojo::Transaction::WebSocket;
11 #use Mojo::JSON qw(decode_json encode_json);
15 use Math::Round qw(nearest);
17 use Data::Random qw(rand_chars);
20 use constant pi => 3.14159265358979;
22 my $devname = "/dev/davis";
23 my $datafn = ".loop_data";
26 my $poll_interval = 2.5;
27 my $rain_mult = 0.2; # 0.1 or 0.2 mm or 0.01 inches
35 my $ser; # the serial port Mojo::IOLoop::Stream
39 our $json = JSON->new->canonical(1);
40 our $WS = {}; # websocket connections
44 our $loop_count; # how many LOOPs we have done, used as start indicator
47 0x0, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7,
48 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef,
49 0x1231, 0x210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6,
50 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de,
51 0x2462, 0x3443, 0x420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485,
52 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d,
53 0x3653, 0x2672, 0x1611, 0x630, 0x76d7, 0x66f6, 0x5695, 0x46b4,
54 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc,
55 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x840, 0x1861, 0x2802, 0x3823,
56 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b,
57 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0xa50, 0x3a33, 0x2a12,
58 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a,
59 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0xc60, 0x1c41,
60 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49,
61 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0xe70,
62 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78,
63 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f,
64 0x1080, 0xa1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067,
65 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e,
66 0x2b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256,
67 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d,
68 0x34e2, 0x24c3, 0x14a0, 0x481, 0x7466, 0x6447, 0x5424, 0x4405,
69 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c,
70 0x26d3, 0x36f2, 0x691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634,
71 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab,
72 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x8e1, 0x3882, 0x28a3,
73 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a,
74 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0xaf1, 0x1ad0, 0x2ab3, 0x3a92,
75 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9,
76 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0xcc1,
77 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8,
78 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0xed1, 0x1ef0
83 $bar_trend{-60} = "Falling Rapidly";
84 $bar_trend{196} = "Falling Rapidly";
85 $bar_trend{-20} = "Falling Slowly";
86 $bar_trend{236} = "Falling Slowly";
87 $bar_trend{0} = "Steady";
88 $bar_trend{20} = "Rising Slowly";
89 $bar_trend{60} = "Rising Rapidly";
93 $SIG{TERM} = $SIG{INT} = sub {++$ending; Mojo::IOLoop->stop;};
97 # WebSocket weather service
98 websocket '/weather' => sub {
104 app->log->debug('WebSocket opened.');
105 dbg 'WebSocket opened' if isdbg 'chan';
108 # send historical data
109 $c->send($ld->{lasthour_h}) if exists $ld->{lasthour_h};
110 $c->send($ld->{lastmin_h}) if exists $ld->{lastmin_h};
112 # send the last 24 hour's worth of data to the graph
113 my $lg = SMGLog->new('day');
115 my $dayno = int($tnow/86400);
116 send_history($c, $lg, $tnow, $_) for ($dayno-1, $dayno);
119 $c->inactivity_timeout(3615);
125 dbg "websocket: text $msg" if isdbg 'chan';
129 dbg "websocket: json $msg" if isdbg 'chan';
134 $c->on(finish => sub {
135 my ($c, $code, $reason) = @_;
136 app->log->debug("WebSocket closed with status $code.");
137 dbg "websocket closed with status $code" if isdbg 'chan';
142 get '/' => {template => 'index'};
152 dbg "*** starting $0";
157 our $dlog = SMGLog->new("day");
158 dbg "before next tick";
159 Mojo::IOLoop->next_tick(sub { loop() });
160 dbg "before app start";
162 dbg "after app start";
165 $dataf->close if $dataf;
169 # move all the files along one
170 cycle_loop_data_files();
178 ##################################################################################
182 dbg "last_min: " . scalar gmtime($ld->{last_min});
183 dbg "last_hour: " . scalar gmtime($ld->{last_hour});
185 $did = Mojo::IOLoop->recurring(1 => sub {$dlog->flushall});
196 $d =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
197 dbg "read added '$d' buf lth=" . length $buf if isdbg 'raw';
198 if ($state eq 'waitnl' && $buf =~ /[\cJ\cM]+/) {
199 dbg "Got \\n" if isdbg 'state';
200 Mojo::IOLoop->remove($tid) if $tid;
204 $ser->write("LPS 1 1\n");
205 chgstate("waitloop");
206 } elsif ($state eq "waitloop") {
207 if ($buf =~ /\x06/) {
208 dbg "Got ACK 0x06" if isdbg 'state';
209 chgstate('waitlooprec');
212 } elsif ($state eq 'waitlooprec') {
213 if (length $buf >= 99) {
214 dbg "got loop record" if isdbg 'chan';
225 dbg "start_loop writing $nlcount \\n" if isdbg 'state';
227 Mojo::IOLoop->remove($tid) if $tid;
229 $tid = Mojo::IOLoop->recurring(0.6 => sub {
230 if (++$nlcount > 10) {
231 dbg "\\n count > 10, closing connection" if isdbg 'chan';
235 dbg "writing $nlcount \\n" if isdbg 'state';
243 dbg "state '$state' -> '$_[0]'" if isdbg 'state';
250 dbg "do reopen on '$name' ending $ending";
252 $ser = do_open($name);
256 Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
267 my $ob = Serial->new($name, 19200) || die "$name $!\n";
268 dbg "streaming $name fileno(" . fileno($ob) . ")" if isdbg 'chan';
270 my $ser = Mojo::IOLoop::Stream->new($ob);
271 $ser->on(error=>sub {dbg "serial $_[1]"; do_reopen($name) unless $ending});
272 $ser->on(close=>sub {dbg "serial closing"; do_reopen($name) unless $ending});
273 $ser->on(timeout=>sub {dbg "serial timeout";});
274 $ser->on(read=>sub {on_read(@_)});
277 Mojo::IOLoop->remove($tid) if $tid;
279 Mojo::IOLoop->remove($rid) if $rid;
281 $rid = Mojo::IOLoop->recurring($poll_interval => sub {
282 start_loop() if !$state;
296 my $loo = substr $blk,0,3;
297 unless ( $loo eq 'LOO') {
298 dbg "Block invalid loo -> $loo" if isdbg 'chan'; return;
306 my $crc_calc = CRC_CCITT($blk);
311 $tmp = unpack("s", substr $blk,7,2) / 1000;
312 $h{Pressure} = nearest(1, in2mb($tmp));
314 $tmp = unpack("s", substr $blk,9,2) / 10;
315 $h{Temp_In} = nearest(0.1, f2c($tmp));
317 $temp = nearest(0.1, f2c(unpack("s", substr $blk,12,2) / 10));
318 $h{Temp_Out} = $temp;
319 if ($temp > 75 || $temp < -75) {
320 dbg "LOOP Temperature out of range ($temp), record ignored";
324 $tmp = unpack("C", substr $blk,14,1);
325 $h{Wind} = nearest(0.1, mph2mps($tmp));
326 $h{Dir} = unpack("s", substr $blk,16,2)+0;
328 my $wind = {w => $h{Wind}, d => $h{Dir}};
329 $wind = 0 if $wind == 255;
330 push @{$ld->{wind_min}}, $wind;
332 $tmp = int(unpack("C", substr $blk,33,1)+0);
334 dbg "LOOP Outside Humidity out of range ($tmp), record ignored";
337 $h{Humidity_Out} = $tmp;
338 $tmp = int(unpack("C", substr $blk,11,1)+0);
340 dbg "LOOP Inside Humidity out of range ($tmp), record ignored";
343 $h{Humidity_In} = $tmp;
346 $tmp = unpack("C", substr $blk,43,1)+0;
347 $h{UV} = $tmp unless $tmp >= 255;
348 $tmp = unpack("s", substr $blk,44,2)+0; # watt/m**2
349 $h{Solar} = $tmp unless $tmp >= 32767;
351 # $h{Rain_Rate} = nearest(0.1,unpack("s", substr $blk,41,2) * $rain_mult);
352 $rain = $h{Rain_Day} = nearest(0.1, unpack("s", substr $blk,50,2) * $rain_mult);
353 my $delta_rain = $h{Rain} = nearest(0.1, ($rain >= $ld->{last_rain} ? $rain - $ld->{last_rain} : $rain)) if $loop_count;
354 $ld->{last_rain} = $rain;
356 # what sort of packet is it?
357 my $sort = unpack("C", substr $blk,4,1);
361 $tmp = unpack("C", substr $blk,18,2);
362 # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp/10));
363 $tmp = unpack("C", substr $blk,20,2);
364 # $h{Wind_Avg_2} = nearest(0.1,mph2mps($tmp/10));
365 $tmp = unpack("C", substr $blk,22,2);
366 # $h{Wind_Gust_10} = nearest(0.1,mph2mps($tmp/10));
368 # $h{Dir_Avg_10} = unpack("C", substr $blk,24,2)+0;
369 $tmp = unpack("C", substr $blk,30,2);
370 $h{Dew_Point} = nearest(0.1, f2c($tmp));
375 $tmp = unpack("C", substr $blk,15,1);
376 # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp));
377 $h{Dew_Point} = nearest(0.1, dew_point($h{Temp_Out}, $h{Humidity_Out}));
378 $h{Rain_Month} = nearest(0.1, unpack("s", substr $blk,52,2) * $rain_mult);
379 $h{Rain_Year} = nearest(0.1, unpack("s", substr $blk,54,2) * $rain_mult);
384 my $dayno = int($ts/86400);
385 if ($dayno > $ld->{last_day}) {
386 $ld->{Temp_Out_Max} = $ld->{Temp_Out_Min} = $temp;
387 $ld->{Temp_Out_Max_T} = $ld->{Temp_Out_Min_T} = clocktime($ts, 0);
388 $ld->{last_day} = $dayno;
390 cycle_loop_data_files();
392 if ($temp > $ld->{Temp_Out_Max}) {
393 $ld->{Temp_Out_Max} = $temp;
394 $ld->{Temp_Out_Max_T} = clocktime($ts, 0);
397 if ($temp < $ld->{Temp_Out_Min}) {
398 $ld->{Temp_Out_Min} = $temp;
399 $ld->{Temp_Out_Min_T} = clocktime($ts, 0);
403 if ($ts >= $ld->{last_hour} + 1800) {
404 $h{Pressure_Trend} = unpack("C", substr $blk,3,1);
405 $h{Pressure_Trend_txt} = $bar_trend{$h{Pressure_Trend}};
406 $h{Batt_TX_OK} = (unpack("C", substr $blk,86,1)+0) ^ 1;
407 $h{Batt_Console} = nearest(0.01, unpack("s", substr $blk,87,2) * 0.005859375);
408 $h{Forecast_Icon} = unpack("C", substr $blk,89,1);
409 $h{Forecast_Rule} = unpack("C", substr $blk,90,1);
410 $h{Sunrise} = sprintf( "%04d", unpack("S", substr $blk,91,2) );
411 $h{Sunrise} =~ s/(\d{2})(\d{2})/$1:$2/;
412 $h{Sunset} = sprintf( "%04d", unpack("S", substr $blk,93,2) );
413 $h{Sunset} =~ s/(\d{2})(\d{2})/$1:$2/;
414 $h{Temp_Out_Max} = $ld->{Temp_Out_Max};
415 $h{Temp_Out_Min} = $ld->{Temp_Out_Min};
416 $h{Temp_Out_Max_T} = $ld->{Temp_Out_Max_T};
417 $h{Temp_Out_Min_T} = $ld->{Temp_Out_Min_T};
420 if ($loop_count) { # i.e not the first
421 my $a = wind_average(scalar @{$ld->{wind_hour}} ? @{$ld->{wind_hour}} : {w => $h{Wind}, d => $h{Dir}});
423 $h{Wind_1h} = nearest(0.1, $a->{w});
424 $h{Dir_1h} = nearest(0.1, $a->{d});
426 $a = wind_average(@{$ld->{wind_min}});
427 $h{Wind_1m} = nearest(0.1, $a->{w});
428 $h{Dir_1m} = nearest(1, $a->{d});
430 ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = calc_rain($rain);
432 $ld->{last_rain_min} = $ld->{last_rain_hour} = $rain;
435 $s = genstr($ts, 'h', \%h);
436 $ld->{lasthour_h} = $s;
438 $ld->{last_hour} = int($ts/1800)*1800;
439 $ld->{last_min} = int($ts/60)*60;
440 @{$ld->{wind_hour}} = ();
441 @{$ld->{wind_min}} = ();
443 output_str($s, 1) if $s;
446 } elsif ($ts >= $ld->{last_min} + 60) {
447 my $a = wind_average(@{$ld->{wind_min}});
450 push @{$ld->{wind_hour}}, $a;
452 if ($loop_count) { # i.e not the first
455 $h{Wind_1m} = nearest(0.1, $a->{w});
456 $h{Dir_1m} = nearest(1, $a->{d});
457 ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = calc_rain($rain);
459 $ld->{last_rain_min} = $rain;
461 $h{Temp_Out_Max} = $ld->{Temp_Out_Max};
462 $h{Temp_Out_Min} = $ld->{Temp_Out_Min};
463 $h{Temp_Out_Max_T} = $ld->{Temp_Out_Max_T};
464 $h{Temp_Out_Min_T} = $ld->{Temp_Out_Min_T};
467 $s = genstr($ts, 'm', \%h);
468 $ld->{lastmin_h} = $s;
470 $ld->{last_min} = int($ts/60)*60;
471 @{$ld->{wind_min}} = ();
473 output_str($s, 1) if $s;
477 my $o = gen_hash_diff($ld->{last_h}, \%h);
479 $s = genstr($ts, 'r', $o);
482 dbg "loop rec not changed" if isdbg 'chan';
484 output_str($s, 0) if $s;
489 dbg "CRC check failed for LOOP data!";
500 my $j = $json->encode($h);
501 my $tm = clocktime($ts, $let eq 'r' ? 1 : 0);
502 return qq|{"tm":"$tm","t":$ts,"$let":$j}|;
509 my ($sec,$min,$hr) = (gmtime $ts)[0,1,2];
512 $s = sprintf "%02d:%02d:%02d", $hr, $min, $sec;
514 $s = sprintf "%02d:%02d", $hr, $min;
526 $dlog->writenow($s) if $logit;
527 foreach my $ws (keys $WS) {
544 while (my ($k, $v) = each %$now) {
545 if (!exists $last->{$k} || $last->{$k} ne $now->{$k}) {
550 return $count ? \%o : undef;
558 # Using the simplified approximation for dew point
559 # Accurate to 1 degree C for humidities > 50 %
560 # http://en.wikipedia.org/wiki/Dew_point
562 my $dewpoint = $temp - ((100 - $rh) / 5);
564 # this is the more complete one (which doesn't work)
568 #my $ytrh = log(($rh/100) + ($b * $temp) / ($c + $temp));
569 #my $dewpoint = ($c * $ytrh) / ($b - $ytrh);
576 # Expects packed data...
577 my $data_str = shift @_;
580 my @lst = split //, $data_str;
581 foreach my $data (@lst) {
582 my $data = unpack("c",$data);
585 my $index = $crc >> 8 ^ $data;
586 my $lhs = $crc_table[$index];
587 #print "lhs=$lhs, crc=$crc\n";
588 my $rhs = ($crc << 8) & 0xFFFF;
599 return ($_[0] - 32) * 5/9;
604 return $_[0] * 0.44704;
609 return $_[0] * 33.8637526;
614 my ($sindir, $cosdir, $wind);
619 $sindir += sin(d2r($r->{d})) * $r->{w};
620 $cosdir += cos(d2r($r->{d})) * $r->{w};
624 my $avhdg = r2d(atan2($sindir, $cosdir));
625 $avhdg += 360 if $avhdg < 0;
626 return {w => nearest(0.1,$wind / $count), d => nearest(0.1,$avhdg)};
633 return ($n / pi) * 180;
640 return ($n / 180) * pi;
647 $ld->{rain24} ||= [];
649 my $Rain_1h = nearest(0.1, $rain >= $ld->{last_rain_hour} ? $rain - $ld->{last_rain_hour} : $rain); # this is the rate for this hour, so far
650 my $rm = nearest(0.1, $rain >= $ld->{last_rain_min} ? $rain - $ld->{last_rain_min} : $rain);
651 my $Rain_1m = nearest(0.1, $rm);
652 push @{$ld->{rain24}}, $Rain_1m;
653 $ld->{rain_24} += $rm;
654 while (@{$ld->{rain24}} > 24*60) {
655 $ld->{rain_24} -= shift @{$ld->{rain24}};
657 my $Rain_24h = nearest(0.1, $ld->{rain_24});
658 return ($Rain_1m, $Rain_1h, $Rain_24h);
664 $dataf = IO::File->new("+>> $datafn") or die "cannot open $datafn $!";
665 $dataf->autoflush(1);
671 dbg "read loop data: $s" if isdbg 'json';
672 $ld = $json->decode($s) if length $s;
674 # sort out rain stats
676 if ($ld->{rain24} && ($c = @{$ld->{rain24}}) < 24*60) {
677 my $diff = 24*60 - $c;
678 unshift @{$ld->{rain24}}, 0 for 0 .. $diff;
683 $rain += $_ for @{$ld->{rain24}};
686 $ld->{rain_24} = nearest(0.1, $rain);
694 $dataf = IO::File->new("+>> $datafn") or die "cannot open $datafn $!";
695 $dataf->autoflush(1);
701 my $s = $json->encode($ld);
702 dbg "write loop data: $s" if isdbg 'json';
706 sub cycle_loop_data_files
708 $dataf->close if $dataf;
711 rename "$datafn.oooo", "$datafn.ooooo";
712 rename "$datafn.ooo", "$datafn.oooo";
713 rename "$datafn.oo", "$datafn.ooo";
714 rename "$datafn.o", "$datafn.oo";
715 copy $datafn, "$datafn.o";
724 if ($lg->open($dayno, 'r+')) {
725 while (my $l = $lg->read) {
726 next unless $l =~ /,"h":/;
727 my ($t) = $l =~ /"t":(\d+)/;
728 if ($t && $t >= $tnow-86400) {