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 constant pi => 3.14159265358979;
19 my $devname = "/dev/davis";
20 my $datafn = ".loop_data";
23 my $poll_interval = 2.5;
24 my $rain_mult = 0.2; # 0.1 or 0.2 mm or 0.01 inches
32 my $ser; # the serial port Mojo::IOLoop::Stream
34 our $json = JSON->new->canonical(1);
38 our $loop_count; # how many LOOPs we have done, used as start indicator
41 0x0, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7,
42 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef,
43 0x1231, 0x210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6,
44 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de,
45 0x2462, 0x3443, 0x420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485,
46 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d,
47 0x3653, 0x2672, 0x1611, 0x630, 0x76d7, 0x66f6, 0x5695, 0x46b4,
48 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc,
49 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x840, 0x1861, 0x2802, 0x3823,
50 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b,
51 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0xa50, 0x3a33, 0x2a12,
52 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a,
53 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0xc60, 0x1c41,
54 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49,
55 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0xe70,
56 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78,
57 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f,
58 0x1080, 0xa1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067,
59 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e,
60 0x2b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256,
61 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d,
62 0x34e2, 0x24c3, 0x14a0, 0x481, 0x7466, 0x6447, 0x5424, 0x4405,
63 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c,
64 0x26d3, 0x36f2, 0x691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634,
65 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab,
66 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x8e1, 0x3882, 0x28a3,
67 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a,
68 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0xaf1, 0x1ad0, 0x2ab3, 0x3a92,
69 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9,
70 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0xcc1,
71 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8,
72 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0xed1, 0x1ef0
77 $bar_trend{-60} = "Falling Rapidly";
78 $bar_trend{196} = "Falling Rapidly";
79 $bar_trend{-20} = "Falling Slowly";
80 $bar_trend{236} = "Falling Slowly";
81 $bar_trend{0} = "Steady";
82 $bar_trend{20} = "Rising Slowly";
83 $bar_trend{60} = "Rising Rapidly";
87 $SIG{TERM} = $SIG{INT} = sub {++$ending; Mojo::IOLoop->stop;};
93 # WebSocket weather service
94 websocket '/index' => sub {
98 $c->app->log->debug('WebSocket opened.');
99 dbg 'WebSocket opened' if isdbg 'chan';
101 # Increase inactivity timeout for connection a bit
102 $c->inactivity_timeout(300);
108 dbg "websocket: $msg" if isdbg 'chan';
112 dbg "websocket: $msg" if isdbg 'chan';
117 $c->on(finish => sub {
118 my ($c, $code, $reason) = @_;
119 $c->app->log->debug("WebSocket closed with status $code.");
120 dbg 'WebSocket closed with status $code' if isdbg 'chan';
134 dbg "*** starting $0";
137 our $dlog = SMGLog->new("day");
138 dbg "before next tick";
139 Mojo::IOLoop->next_tick(sub { loop() });
140 dbg "before app start";
142 dbg "after app start";
145 close $dataf if $dataf;
153 ##################################################################################
158 open $dataf, "+>>", $datafn or die "cannot open $datafn $!";
159 $dataf->autoflush(1);
163 dbg "last_min: " . scalar gmtime($ld->{last_min});
164 dbg "last_hour: " . scalar gmtime($ld->{last_hour});
166 $did = Mojo::IOLoop->recurring(1 => sub {$dlog->flushall});
177 $d =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
178 dbg "read added '$d' buf lth=" . length $buf if isdbg 'raw';
179 if ($state eq 'waitnl' && $buf =~ /[\cJ\cM]+/) {
180 dbg "Got \\n" if isdbg 'state';
181 Mojo::IOLoop->remove($tid) if $tid;
185 $ser->write("LPS 1 1\n");
186 chgstate("waitloop");
187 } elsif ($state eq "waitloop") {
188 if ($buf =~ /\x06/) {
189 dbg "Got ACK 0x06" if isdbg 'state';
190 chgstate('waitlooprec');
193 } elsif ($state eq 'waitlooprec') {
194 if (length $buf >= 99) {
195 dbg "got loop record" if isdbg 'chan';
206 dbg "start_loop writing $nlcount \\n" if isdbg 'state';
208 Mojo::IOLoop->remove($tid) if $tid;
210 $tid = Mojo::IOLoop->recurring(0.6 => sub {
211 if (++$nlcount > 10) {
212 dbg "\\n count > 10, closing connection" if isdbg 'chan';
216 dbg "writing $nlcount \\n" if isdbg 'state';
224 dbg "state '$state' -> '$_[0]'" if isdbg 'state';
231 dbg "do reopen on '$name' ending $ending";
233 $ser = do_open($name);
237 Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
248 my $ob = Serial->new($name, 19200) || die "$name $!\n";
249 dbg "streaming $name fileno(" . fileno($ob) . ")" if isdbg 'chan';
251 my $ser = Mojo::IOLoop::Stream->new($ob);
252 $ser->on(error=>sub {dbg "serial $_[1]"; do_reopen($name) unless $ending});
253 $ser->on(close=>sub {dbg "serial closing"; do_reopen($name) unless $ending});
254 $ser->on(timeout=>sub {dbg "serial timeout";});
255 $ser->on(read=>sub {on_read(@_)});
258 Mojo::IOLoop->remove($tid) if $tid;
260 Mojo::IOLoop->remove($rid) if $rid;
262 $rid = Mojo::IOLoop->recurring($poll_interval => sub {
263 start_loop() if !$state;
277 my $loo = substr $blk,0,3;
278 unless ( $loo eq 'LOO') {
279 dbg "Block invalid loo -> $loo" if isdbg 'chan'; return;
287 my $crc_calc = CRC_CCITT($blk);
292 $tmp = unpack("s", substr $blk,7,2) / 1000;
293 $h{Pressure} = nearest(1, in2mb($tmp));
295 $tmp = unpack("s", substr $blk,9,2) / 10;
296 $h{Temp_In} = nearest(0.1, f2c($tmp));
298 $temp = nearest(0.1, f2c(unpack("s", substr $blk,12,2) / 10));
299 $h{Temp_Out} = $temp;
301 $tmp = unpack("C", substr $blk,14,1);
302 $h{Wind} = nearest(0.1, mph2mps($tmp));
303 $h{Dir} = unpack("s", substr $blk,16,2)+0;
305 my $wind = {w => $h{Wind}, d => $h{Dir}};
306 push @{$ld->{wind_min}}, $wind;
308 $h{Humidity_Out} = unpack("C", substr $blk,33,1)+0;
309 $h{Humidity_In} = unpack("C", substr $blk,11,1)+0;
311 $tmp = unpack("C", substr $blk,43,1)+0;
312 $h{UV} = $tmp unless $tmp >= 255;
313 $tmp = unpack("s", substr $blk,44,2)+0; # watt/m**2
314 $h{Solar} = $tmp unless $tmp >= 32767;
316 # $h{Rain_Rate} = nearest(0.1,unpack("s", substr $blk,41,2) * $rain_mult);
317 $rain = $h{Rain_Day} = nearest(0.1, unpack("s", substr $blk,50,2) * $rain_mult);
318 my $delta_rain = $h{Rain} = nearest(0.1, ($rain >= $ld->{last_rain} ? $rain - $ld->{last_rain} : $rain)) if $loop_count;
319 $ld->{last_rain} = $rain;
321 # what sort of packet is it?
322 my $sort = unpack("C", substr $blk,4,1);
326 $tmp = unpack("C", substr $blk,18,2);
327 # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp/10));
328 $tmp = unpack("C", substr $blk,20,2);
329 # $h{Wind_Avg_2} = nearest(0.1,mph2mps($tmp/10));
330 $tmp = unpack("C", substr $blk,22,2);
331 # $h{Wind_Gust_10} = nearest(0.1,mph2mps($tmp/10));
333 # $h{Dir_Avg_10} = unpack("C", substr $blk,24,2)+0;
334 $tmp = unpack("C", substr $blk,30,2);
335 $h{Dew_Point} = nearest(0.1, f2c($tmp));
340 $tmp = unpack("C", substr $blk,15,1);
341 # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp));
342 $h{Dew_Point} = nearest(0.1, dew_point($h{Temp_Out}, $h{Humidity_Out}));
343 $h{Rain_Month} = nearest(0.1, unpack("s", substr $blk,52,2) * $rain_mult);
344 $h{Rain_Year} = nearest(0.1, unpack("s", substr $blk,54,2) * $rain_mult);
349 my $dayno = int($ts/86400);
350 if ($dayno > $ld->{last_day}) {
351 $ld->{Temp_Out_Max} = $ld->{Temp_Out_Min} = $temp;
352 $ld->{last_day} = $dayno;
354 $ld->{Temp_Out_Max} = $temp if $temp > $ld->{Temp_Out_Max};
355 $ld->{Temp_Out_Min} = $temp if $temp < $ld->{Temp_Out_Min};
357 if ($ts >= $ld->{last_hour} + 3600) {
358 $h{Pressure_Trend} = unpack("C", substr $blk,3,1);
359 $h{Pressure_Trend_txt} = $bar_trend{$h{Pressure_Trend}};
360 $h{Batt_TX_OK} = (unpack("C", substr $blk,86,1)+0) ^ 1;
361 $h{Batt_Console} = nearest(0.01, unpack("s", substr $blk,87,2) * 0.005859375);
362 $h{Forecast_Icon} = unpack("C", substr $blk,89,1);
363 $h{Forecast_Rule} = unpack("C", substr $blk,90,1);
364 $h{Sunrise} = sprintf( "%04d", unpack("S", substr $blk,91,2) );
365 $h{Sunrise} =~ s/(\d{2})(\d{2})/$1:$2/;
366 $h{Sunset} = sprintf( "%04d", unpack("S", substr $blk,93,2) );
367 $h{Sunset} =~ s/(\d{2})(\d{2})/$1:$2/;
368 $h{Temp_Out_Max} = $ld->{Temp_Out_Max};
369 $h{Temp_Out_Min} = $ld->{Temp_Out_Min};
371 if ($loop_count) { # i.e not the first
372 my $a = wind_average(scalar @{$ld->{wind_hour}} ? @{$ld->{wind_hour}} : {w => $h{Wind}, d => $h{Dir}});
374 $h{Wind_1h} = nearest(0.1, $a->{w});
375 $h{Dir_1h} = nearest(0.1, $a->{d});
377 $a = wind_average(@{$ld->{wind_min}});
378 $h{Wind_1m} = nearest(0.1, $a->{w});
379 $h{Dir_1m} = nearest(1, $a->{d});
381 ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = calc_rain($rain);
383 $ld->{last_rain_min} = $ld->{last_rain_hour} = $rain;
385 $s = genstr($ts, 'h', \%h);
387 $ld->{last_hour} = int($ts/3600)*3600;
388 $ld->{last_min} = int($ts/60)*60;
389 @{$ld->{wind_hour}} = ();
390 @{$ld->{wind_min}} = ();
394 } elsif ($ts >= $ld->{last_min} + 60) {
395 my $a = wind_average(@{$ld->{wind_min}});
398 push @{$ld->{wind_hour}}, $a;
400 if ($loop_count) { # i.e not the first
403 $h{Wind_1m} = nearest(0.1, $a->{w});
404 $h{Dir_1m} = nearest(1, $a->{d});
405 ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = calc_rain($rain);
407 $ld->{last_rain_min} = $rain;
409 $h{Temp_Out_Max} = $ld->{Temp_Out_Max};
410 $h{Temp_Out_Min} = $ld->{Temp_Out_Min};
412 $s = genstr($ts, 'm', \%h);
414 $ld->{last_min} = int($ts/60)*60;
415 @{$ld->{wind_min}} = ();
420 my $o = gen_hash_diff($ld->{last_h}, \%h);
422 $s = genstr($ts, 'r', $o);
425 dbg "loop rec not changed" if isdbg 'chan';
428 output_str($s) if $s;
432 dbg "CRC check failed for LOOP data!";
443 my $j = $json->encode($h);
444 my ($sec,$min,$hr) = (gmtime $ts)[0,1,2];
445 my $tm = sprintf "%02d:%02d:%02d", $hr, $min, $sec;
447 return qq|{"tm":"$tm","t":$ts,"$let":$j}|;
465 while (my ($k, $v) = each %$now) {
466 if ($last->{$k} ne $now->{$k}) {
471 return $count ? \%o : undef;
479 # Using the simplified approximation for dew point
480 # Accurate to 1 degree C for humidities > 50 %
481 # http://en.wikipedia.org/wiki/Dew_point
483 my $dewpoint = $temp - ((100 - $rh) / 5);
485 # this is the more complete one (which doesn't work)
489 #my $ytrh = log(($rh/100) + ($b * $temp) / ($c + $temp));
490 #my $dewpoint = ($c * $ytrh) / ($b - $ytrh);
497 # Expects packed data...
498 my $data_str = shift @_;
501 my @lst = split //, $data_str;
502 foreach my $data (@lst) {
503 my $data = unpack("c",$data);
506 my $index = $crc >> 8 ^ $data;
507 my $lhs = $crc_table[$index];
508 #print "lhs=$lhs, crc=$crc\n";
509 my $rhs = ($crc << 8) & 0xFFFF;
520 return ($_[0] - 32) * 5/9;
525 return $_[0] * 0.44704;
530 return $_[0] * 33.8637526;
535 my ($sindir, $cosdir, $wind);
540 $sindir += sin(d2r($r->{d})) * $r->{w};
541 $cosdir += cos(d2r($r->{d})) * $r->{w};
545 my $avhdg = r2d(atan2($sindir, $cosdir));
546 $avhdg += 360 if $avhdg < 0;
547 return {w => nearest(0.1,$wind / $count), d => nearest(0.1,$avhdg)};
554 return ($n / pi) * 180;
561 return ($n / 180) * pi;
568 $ld->{rain24} ||= [];
570 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
571 my $rm = nearest(0.1, $rain >= $ld->{last_rain_min} ? $rain - $ld->{last_rain_min} : $rain);
572 my $Rain_1m = nearest(0.1, $rm);
573 push @{$ld->{rain24}}, $Rain_1m;
574 $ld->{rain_24} += $rm;
575 while (@{$ld->{rain24}} > 24*60) {
576 $ld->{rain_24} -= shift @{$ld->{rain24}};
578 my $Rain_24h = nearest(0.1, $ld->{rain_24});
579 return ($Rain_1m, $Rain_1h, $Rain_24h);
584 return unless $dataf;
589 dbg "read loop data: $s" if isdbg 'json';
590 $ld = $json->decode($s) if length $s;
592 # sort out rain stats
594 if (($c = @{$ld->{rain24}}) < 24*60) {
595 my $diff = 24*60 - $c;
596 unshift @{$ld->{rain24}}, 0 for 0 .. $diff;
599 $rain += $_ for @{$ld->{rain24}};
600 $ld->{rain_24} = nearest(0.1, $rain);
607 return unless $dataf;
612 my $s = $json->encode($ld);
613 dbg "write loop data: $s" if isdbg 'json';
623 <head><title>DWeather</title></head>
627 if ("WebSocket" in window) {
628 ws = new WebSocket('<%= url_for('index')->to_abs %>');
629 //ws = new WebSocket();
631 if(typeof(ws) !== 'undefined') {
632 ws.onmessage = function (event) {
633 document.body.innerHTML += JSON.parse(event.data).test;
635 ws.onopen = function (event) {
636 ws.send(JSON.stringify({weather: 'WebSocket support works! ♥'}));
640 document.body.innerHTML += 'Browser does not support WebSockets.';
643 var ws = new WebSocket('<%= url_for('weather')->to_abs %>');
646 ws.onmessage = function(event) {
647 document.body.innerHTML += event.data + '<br/>';