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;
300 if ($temp > 75 || $temp < -75) {
301 dbg "LOOP Temperature out of range ($temp), record ignored";
305 $tmp = unpack("C", substr $blk,14,1);
306 $h{Wind} = nearest(0.1, mph2mps($tmp));
307 $h{Dir} = unpack("s", substr $blk,16,2)+0;
309 my $wind = {w => $h{Wind}, d => $h{Dir}};
310 $wind = 0 if $wind == 255;
311 push @{$ld->{wind_min}}, $wind;
313 $tmp = int(unpack("C", substr $blk,33,1)+0);
315 dbg "LOOP Outside Humidity out of range ($tmp), record ignored";
318 $h{Humidity_Out} = $tmp;
319 $tmp = int(unpack("C", substr $blk,11,1)+0);
321 dbg "LOOP Inside Humidity out of range ($tmp), record ignored";
324 $h{Humidity_In} = $tmp;
327 $tmp = unpack("C", substr $blk,43,1)+0;
328 $h{UV} = $tmp unless $tmp >= 255;
329 $tmp = unpack("s", substr $blk,44,2)+0; # watt/m**2
330 $h{Solar} = $tmp unless $tmp >= 32767;
332 # $h{Rain_Rate} = nearest(0.1,unpack("s", substr $blk,41,2) * $rain_mult);
333 $rain = $h{Rain_Day} = nearest(0.1, unpack("s", substr $blk,50,2) * $rain_mult);
334 my $delta_rain = $h{Rain} = nearest(0.1, ($rain >= $ld->{last_rain} ? $rain - $ld->{last_rain} : $rain)) if $loop_count;
335 $ld->{last_rain} = $rain;
337 # what sort of packet is it?
338 my $sort = unpack("C", substr $blk,4,1);
342 $tmp = unpack("C", substr $blk,18,2);
343 # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp/10));
344 $tmp = unpack("C", substr $blk,20,2);
345 # $h{Wind_Avg_2} = nearest(0.1,mph2mps($tmp/10));
346 $tmp = unpack("C", substr $blk,22,2);
347 # $h{Wind_Gust_10} = nearest(0.1,mph2mps($tmp/10));
349 # $h{Dir_Avg_10} = unpack("C", substr $blk,24,2)+0;
350 $tmp = unpack("C", substr $blk,30,2);
351 $h{Dew_Point} = nearest(0.1, f2c($tmp));
356 $tmp = unpack("C", substr $blk,15,1);
357 # $h{Wind_Avg_10} = nearest(0.1,mph2mps($tmp));
358 $h{Dew_Point} = nearest(0.1, dew_point($h{Temp_Out}, $h{Humidity_Out}));
359 $h{Rain_Month} = nearest(0.1, unpack("s", substr $blk,52,2) * $rain_mult);
360 $h{Rain_Year} = nearest(0.1, unpack("s", substr $blk,54,2) * $rain_mult);
365 my $dayno = int($ts/86400);
366 if ($dayno > $ld->{last_day}) {
367 $ld->{Temp_Out_Max} = $ld->{Temp_Out_Min} = $temp;
368 $ld->{last_day} = $dayno;
370 $ld->{Temp_Out_Max} = $temp if $temp > $ld->{Temp_Out_Max};
371 $ld->{Temp_Out_Min} = $temp if $temp < $ld->{Temp_Out_Min};
373 if ($ts >= $ld->{last_hour} + 1800) {
374 $h{Pressure_Trend} = unpack("C", substr $blk,3,1);
375 $h{Pressure_Trend_txt} = $bar_trend{$h{Pressure_Trend}};
376 $h{Batt_TX_OK} = (unpack("C", substr $blk,86,1)+0) ^ 1;
377 $h{Batt_Console} = nearest(0.01, unpack("s", substr $blk,87,2) * 0.005859375);
378 $h{Forecast_Icon} = unpack("C", substr $blk,89,1);
379 $h{Forecast_Rule} = unpack("C", substr $blk,90,1);
380 $h{Sunrise} = sprintf( "%04d", unpack("S", substr $blk,91,2) );
381 $h{Sunrise} =~ s/(\d{2})(\d{2})/$1:$2/;
382 $h{Sunset} = sprintf( "%04d", unpack("S", substr $blk,93,2) );
383 $h{Sunset} =~ s/(\d{2})(\d{2})/$1:$2/;
384 $h{Temp_Out_Max} = $ld->{Temp_Out_Max};
385 $h{Temp_Out_Min} = $ld->{Temp_Out_Min};
387 if ($loop_count) { # i.e not the first
388 my $a = wind_average(scalar @{$ld->{wind_hour}} ? @{$ld->{wind_hour}} : {w => $h{Wind}, d => $h{Dir}});
390 $h{Wind_1h} = nearest(0.1, $a->{w});
391 $h{Dir_1h} = nearest(0.1, $a->{d});
393 $a = wind_average(@{$ld->{wind_min}});
394 $h{Wind_1m} = nearest(0.1, $a->{w});
395 $h{Dir_1m} = nearest(1, $a->{d});
397 ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = calc_rain($rain);
399 $ld->{last_rain_min} = $ld->{last_rain_hour} = $rain;
401 $s = genstr($ts, 'h', \%h);
403 $ld->{last_hour} = int($ts/1800)*1800;
404 $ld->{last_min} = int($ts/60)*60;
405 @{$ld->{wind_hour}} = ();
406 @{$ld->{wind_min}} = ();
410 } elsif ($ts >= $ld->{last_min} + 60) {
411 my $a = wind_average(@{$ld->{wind_min}});
414 push @{$ld->{wind_hour}}, $a;
416 if ($loop_count) { # i.e not the first
419 $h{Wind_1m} = nearest(0.1, $a->{w});
420 $h{Dir_1m} = nearest(1, $a->{d});
421 ($h{Rain_1m}, $h{Rain_1h}, $h{Rain_24h}) = calc_rain($rain);
423 $ld->{last_rain_min} = $rain;
425 $h{Temp_Out_Max} = $ld->{Temp_Out_Max};
426 $h{Temp_Out_Min} = $ld->{Temp_Out_Min};
428 $s = genstr($ts, 'm', \%h);
430 $ld->{last_min} = int($ts/60)*60;
431 @{$ld->{wind_min}} = ();
436 my $o = gen_hash_diff($ld->{last_h}, \%h);
438 $s = genstr($ts, 'r', $o);
441 dbg "loop rec not changed" if isdbg 'chan';
444 output_str($s) if $s;
448 dbg "CRC check failed for LOOP data!";
459 my $j = $json->encode($h);
460 my ($sec,$min,$hr) = (gmtime $ts)[0,1,2];
461 my $tm = sprintf "%02d:%02d:%02d", $hr, $min, $sec;
463 return qq|{"tm":"$tm","t":$ts,"$let":$j}|;
481 while (my ($k, $v) = each %$now) {
482 if ($last->{$k} ne $now->{$k}) {
487 return $count ? \%o : undef;
495 # Using the simplified approximation for dew point
496 # Accurate to 1 degree C for humidities > 50 %
497 # http://en.wikipedia.org/wiki/Dew_point
499 my $dewpoint = $temp - ((100 - $rh) / 5);
501 # this is the more complete one (which doesn't work)
505 #my $ytrh = log(($rh/100) + ($b * $temp) / ($c + $temp));
506 #my $dewpoint = ($c * $ytrh) / ($b - $ytrh);
513 # Expects packed data...
514 my $data_str = shift @_;
517 my @lst = split //, $data_str;
518 foreach my $data (@lst) {
519 my $data = unpack("c",$data);
522 my $index = $crc >> 8 ^ $data;
523 my $lhs = $crc_table[$index];
524 #print "lhs=$lhs, crc=$crc\n";
525 my $rhs = ($crc << 8) & 0xFFFF;
536 return ($_[0] - 32) * 5/9;
541 return $_[0] * 0.44704;
546 return $_[0] * 33.8637526;
551 my ($sindir, $cosdir, $wind);
556 $sindir += sin(d2r($r->{d})) * $r->{w};
557 $cosdir += cos(d2r($r->{d})) * $r->{w};
561 my $avhdg = r2d(atan2($sindir, $cosdir));
562 $avhdg += 360 if $avhdg < 0;
563 return {w => nearest(0.1,$wind / $count), d => nearest(0.1,$avhdg)};
570 return ($n / pi) * 180;
577 return ($n / 180) * pi;
584 $ld->{rain24} ||= [];
586 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
587 my $rm = nearest(0.1, $rain >= $ld->{last_rain_min} ? $rain - $ld->{last_rain_min} : $rain);
588 my $Rain_1m = nearest(0.1, $rm);
589 push @{$ld->{rain24}}, $Rain_1m;
590 $ld->{rain_24} += $rm;
591 while (@{$ld->{rain24}} > 24*60) {
592 $ld->{rain_24} -= shift @{$ld->{rain24}};
594 my $Rain_24h = nearest(0.1, $ld->{rain_24});
595 return ($Rain_1m, $Rain_1h, $Rain_24h);
600 return unless $dataf;
605 dbg "read loop data: $s" if isdbg 'json';
606 $ld = $json->decode($s) if length $s;
608 # sort out rain stats
610 if (($c = @{$ld->{rain24}}) < 24*60) {
611 my $diff = 24*60 - $c;
612 unshift @{$ld->{rain24}}, 0 for 0 .. $diff;
615 $rain += $_ for @{$ld->{rain24}};
616 $ld->{rain_24} = nearest(0.1, $rain);
623 return unless $dataf;
628 my $s = $json->encode($ld);
629 dbg "write loop data: $s" if isdbg 'json';
639 <head><title>DWeather</title></head>
643 if ("WebSocket" in window) {
644 ws = new WebSocket('<%= url_for('index')->to_abs %>');
645 //ws = new WebSocket();
647 if(typeof(ws) !== 'undefined') {
648 ws.onmessage = function (event) {
649 document.body.innerHTML += JSON.parse(event.data).test;
651 ws.onopen = function (event) {
652 ws.send(JSON.stringify({weather: 'WebSocket support works! ♥'}));
656 document.body.innerHTML += 'Browser does not support WebSockets.';
659 var ws = new WebSocket('<%= url_for('weather')->to_abs %>');
662 ws.onmessage = function(event) {
663 document.body.innerHTML += event.data + '<br/>';