5 use Device::SerialPort;
9 my $devname = "/dev/davis";
10 my $dbsort = "SQLite";
15 my $connectionInfo="dbi:$dbsort:$db";
16 $connectionInfo .= ":$host" if $host;
18 # make connection to database
19 my %attr = ( PrintError => 0, RaiseError => 0 );
20 my $dbh = DBI->connect($connectionInfo,$userid,$passwd,\%attr) or die "Couldn't connect to database: " . DBI->errstr;
29 my $ob = Device::SerialPort->new ($devname) || die;
31 $ob->user_msg(1); # misc. warnings
32 $ob->error_msg(1); # hardware and data errors
36 #$ob->parity_enable(1); # for any parity except "none"
39 $ob->handshake('none');
40 $ob->read_const_time(15000); # ultimate timeout (15 seconds)
41 $ob->write_settings||die"setting failed";
45 my $hdl = new AnyEvent::Handle(
48 my ($hdl, $fatal, $msg) = @_;
49 AE::log error => $msg;
55 $hdl->push_write("\n"); # kick the serial port
58 #$ob->write("\n"); # initial wake
62 $hdl->push_write("\n"); # wake for real
63 $hdl->push_read(regex => qr<\n\r>, timeout => sub )
64 $ob->read_interval(600); # wait for a max of 600ms
65 ($count, $result) = $ob->read(10); # read up to 10 chars
66 if ($result eq "\n\r") {
67 print "awoke on attempt $attempts :)\n";
71 print "wake error on attempt $attempts :(\n";
74 dienice("failed to wake device - tried $attempts times") unless $attempts<6;
77 $ob->write("LAMPS 0\n");
78 $ob->read_interval(300); # wait for a max of 300ms
79 ($count, $result) = $ob->read(8); # read up to 8 chars
80 $result=~s/(\r|\n)//g;
81 if ($result eq "OK") {
82 print "lamps on :)\n";
85 dienice("lamp error '$result'");
92 print "$ref->[2]:$ref->[1]:$ref->[0] $ref->[3]/$ref->[4]/$ref->[5]\n";
99 get_loop(); # if you do anything after here - you need to wake up the device again
100 print "** do something else\n";
102 $ob->write("\r"); # wake
103 $ob->read_interval(500); # wait for a max of 300ms
104 my ($count, $result) = $ob->read(4096); # read any crap up to 4096 chars
107 #print "count=$count $result\n";
108 #for(my $i=0; $i<$count; $i++)
109 #{ printf("%02d ",ord(substr($result,$i,1))); }
111 #$ob->write("WRD\x12\x4d\n");
127 my $loo = substr $blk,0,3;
128 unless ( $loo eq 'LOO') {
129 warn("Block invalid loo -> $loo\n"); return "";
133 #$hsh{'next_rec'} = unpack("s", substr $blk,5,2);
135 $hsh{'Barometric_Trend'} = unpack("C", substr $blk,3,1);
136 $hsh{'Barometric_Trend_txt'} = $bar_trend{$hsh{'Barometric_Trend'}};
137 $t = unpack("s", substr $blk,7,2) / 1000;
138 # $hsh{'Barometric_Press_hg'} = $t;
139 $hsh{'Barometric_Press_mb'} = sprintf("%.2f",$t*33.8637526);
142 $t = unpack("s", substr $blk,9,2) / 10;
143 # $hsh{'Air_Temp_Inside_f'} = $t;
144 $hsh{'Air_Temp_Inside_c'} = sprintf("%.1f",($t - 32) * 5/9);
145 my $tf = unpack("s", substr $blk,12,2) / 10;
146 # $hsh{'Air_Temp_Outside_f'} = $tf;
147 $hsh{'Air_Temp_Outside_c'} = sprintf("%.1f",($tf - 32) * 5/9);
149 $hsh{'Wind_Speed_mph'} = unpack("C", substr $blk,14,1);
150 # $hsh{'Wind_Speed_mps'} = sprintf("%.1f",$hsh{'Wind_Speed_mph'}*0.44704);
151 $hsh{'Wind_Speed_10min_Avg_mph'} = unpack("C", substr $blk,15,1);
152 # $hsh{'Wind_Speed_10min_Avg_mps'} = sprintf("%.1f",$hsh{'Wind_Speed_10min_Avg_mph'}*0.44704);
153 $hsh{'Wind_Dir'} = unpack("s", substr $blk,16,2);
156 $hsh{'Humidity_Outside'} = unpack("C", substr $blk,33,1);
157 $hsh{'Humidity_Inside'} = unpack("C", substr $blk,11,1);
158 $hsh{'Dew_Point'} = dew_point($tf, $hsh{'Humidity_Outside'});
160 # $hsh{'UV'} = unpack("C", substr $blk,43,1);
161 # $hsh{'Solar'} = unpack("s", substr $blk,44,2); # watt/m**2
163 $hsh{'Rain_Rate'} = (unpack("s", substr $blk,41,2) / 100) * 25.4; # Inches per hr converted to mm
164 $hsh{'Rain_Storm'} = (unpack("s", substr $blk,46,2) / 100) * 25.4; # Inches per storm
165 #$hsh{'Storm_Date'} = unpack("s", substr $blk,48,2); # Need to parse data (not sure what this is)
166 $hsh{'Rain_Day'} = (unpack("s", substr $blk,50,2)/100) * 25.4;
167 $hsh{'Rain_Month'} = (unpack("s", substr $blk,52,2)/100) * 25.4;
168 $hsh{'Rain_Year'} = (unpack("s", substr $blk,54,2)/100) * 25.4;
170 $hsh{'ET_Day'} = unpack("s", substr $blk,56,2)/1000;
171 $hsh{'ET_Month'} = unpack("s", substr $blk,58,2)/100;
172 $hsh{'ET_Year'} = unpack("s", substr $blk,60,2)/100;
174 #$hsh{'Alarms_Inside'} = unpack("b8", substr $blk,70,1);
175 #$hsh{'Alarms_Rain'} = unpack("b8", substr $blk,70,1);
176 #$hsh{'Alarms_Outside'} = unpack("b8", substr $blk,70,1);
178 $hsh{'Batt_Transmitter'} = unpack("C", substr $blk,86,1); # * 0.005859375
179 $hsh{'Batt_Console'} = unpack("s", substr $blk,87,2) * 0.005859375;
181 $hsh{'Forecast_Icon'} = unpack("C", substr $blk,89,1);
182 $hsh{'Forecast_Rule'} = unpack("C", substr $blk,90,1);
184 $hsh{'Sunrise'} = sprintf( "%04d", unpack("S", substr $blk,91,2) );
185 $hsh{'Sunrise'} =~ s/(\d{2})(\d{2})/$1:$2/;
186 $hsh{'Sunset'} = sprintf( "%04d", unpack("S", substr $blk,93,2) );
187 $hsh{'Sunset'} =~ s/(\d{2})(\d{2})/$1:$2/;
189 #my $nl = ord substr $blk,95,1;
190 #my $cr = ord substr $blk,96,1;
192 my $crc = unpack "%n", substr($blk,97,2);
193 my $crc_calc = CRC_CCITT($blk);
199 print "CRC check failed for LOOP data!\n";
202 #delete @hsh{'crc', 'crc_calc', 'next_rec'};
203 #delete($hsh{crc})||die"cant delete crc";
204 #delete($hsh{crc_calc})||die"cant delete crc_calc";
205 #delete($hsh{next_rec})||die"cant delete next_rec";
214 # Using the simplified approximation for dew point
215 # Accurate to 1 degree C for humidities > 50 %
216 # http://en.wikipedia.org/wiki/Dew_point
218 my $dew_point = $temp - ( (100 - $rh)/5 );
225 # Expects packed data...
226 my $data_str = shift @_;
229 my @lst = split //, $data_str;
230 foreach my $data (@lst) {
231 my $data = unpack("c",$data);
234 my $index = $crc >> 8 ^ $data;
235 my $lhs = $crc_table[$index];
236 #print "lhs=$lhs, crc=$crc\n";
237 my $rhs = ($crc << 8) & 0xFFFF;
250 0x0, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7,
251 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef,
252 0x1231, 0x210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6,
253 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de,
254 0x2462, 0x3443, 0x420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485,
255 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d,
256 0x3653, 0x2672, 0x1611, 0x630, 0x76d7, 0x66f6, 0x5695, 0x46b4,
257 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc,
258 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x840, 0x1861, 0x2802, 0x3823,
259 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b,
260 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0xa50, 0x3a33, 0x2a12,
261 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a,
262 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0xc60, 0x1c41,
263 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49,
264 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0xe70,
265 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78,
266 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f,
267 0x1080, 0xa1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067,
268 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e,
269 0x2b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256,
270 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d,
271 0x34e2, 0x24c3, 0x14a0, 0x481, 0x7466, 0x6447, 0x5424, 0x4405,
272 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c,
273 0x26d3, 0x36f2, 0x691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634,
274 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab,
275 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x8e1, 0x3882, 0x28a3,
276 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a,
277 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0xaf1, 0x1ad0, 0x2ab3, 0x3a92,
278 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9,
279 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0xcc1,
280 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8,
281 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0xed1, 0x1ef0
284 $bar_trend{-60} = "Falling Rapidly";
285 $bar_trend{196} = "Falling Rapidly";
286 $bar_trend{-20} = "Falling Slowly";
287 $bar_trend{236} = "Falling Slowly";
288 $bar_trend{0} = "Steady";
289 $bar_trend{20} = "Rising Slowly";
290 $bar_trend{60} = "Rising Rapidly";
295 $ob->write("GETTIME\n");
296 $ob->read_interval(200);
297 my($cnt_in, $str) = $ob->read(9);
299 dienice("read error cnt_in=$cnt_in, str='$str'");
302 my $ck = CRC_CCITT(substr($str,1,9));
304 warn "checksum error"; return 0;
306 my @rsp_lst = split //, $str;
308 @rsp_lst = map ord, @rsp_lst;
314 my $s_time = [ localtime() ];
317 $ob->write("SETTIME\n");
318 $ob->read_interval(300);
319 my ($cnt_in, $str) = $ob->read(1);
322 warn "SETTIME not set ack $ack !"; return 0;
324 my ($sec, $min, $hour, $day, $mon, $yr) = @{$s_time};
325 $str = join "", map chr, ($sec, $min, $hour, $day, $mon, $yr);
326 my $ck = CRC_CCITT($str);
327 $str = $str . pack("n",$ck);
329 ($cnt_in, $str) = $ob->read(1);
330 if ( ord($str) != 6 ) {
331 warn "SETTIME not set!"; return 0;
333 sleep 3; # The console seems to need to some time here...
338 print "** get loop at ", scalar localtime, "\n";
340 $ob->write("LOOP $loops\n");
341 $ob->read_interval(0);
342 ($count, $result) = $ob->read(1);
343 for (my $i=0; $i<$loops; $i+=1) {
355 $ob->read_interval(0);
356 ($count, $result) = $ob->read(99);
358 print "loop error - got $count bytes, expected 99\n";
361 print "LOOP data received\n";
363 if (ord(substr($result,0,1))==6) {
364 $result=substr($result,1);
367 my $rc=parse_loop_blck($result);
370 } # bad crc so goto next
371 foreach my $key (sort keys %hsh) {
372 print "$key = $hsh{$key}\n";
375 my $stmt = 'INSERT INTO current (Date_Time,' . join(',', keys %hsh) . ') VALUES (NOW(),' . join(',', ('?') x keys %hsh) . ')';
377 $dbh->do( $stmt, undef, values %hsh);
386 #my $self = shift @_;
387 open(DMP,">dump.txt");
388 my $vDateStamp = shift @_;
389 my $vTimeStamp = shift @_;
391 # If not date/time stamp then assume 0 which will down load the entire archive
392 unless ( $vDateStamp ) {
395 unless ( $vTimeStamp ) {
399 #my $port_obj = $self->{'port_obj'};
401 my $datetime = pack("ss",$vDateStamp, $vTimeStamp);
403 my $crc = CRC_CCITT($datetime);
404 my $cmd = pack("ssn",$vDateStamp,$vTimeStamp,$crc);
406 #-----------------------
407 #my $str = unpack("H*", $cmd);
408 #$str =~ s/(\w{2})/$1 /g;
409 # Documentation is wrong! The example should be <0xC6><0x06><0xA2><0x03> in section X
410 #print "cmd : $str \n";exit;
411 #-----------------------
413 #sleep 2; # Needed after loop
416 # Ok let's start the communication sequence....
417 my $cnt_out = $ob->write("DMPAFT\n");
419 warn "write failed\n";
423 $ob->read_interval(300);
424 my ($cnt_in, $str) = $ob->read(1);
428 warn "Ack not received on DMPAFT command: $ack"; exit -1;
431 $cnt_out = $ob->write($cmd);
433 warn "write failed\n";
436 ($cnt_in, $str) = $ob->read(7);
438 $ack = ord substr($str,0,1);
440 my $ls = unpack("H20",substr($str,1,4) );
441 $ls =~ s/(\w{2})/$1 /g;
443 my $pages = unpack("s",substr($str,1,2) );
444 my $rec_start = unpack("s",substr($str,3,2) );
446 $crc = CRC_CCITT(substr($str,1,6) );
448 print "Pages = $pages : rec = $rec_start Datestamp $vDateStamp $crc\n";
450 $cnt_out = $ob->write( pack("h", 0x06) );
452 #if ($pages == 513 ) { return -1 }
455 foreach my $page (1..$pages) {
457 $ob->read_interval(0);
458 my ($cnt_in, $str) = $ob->read($page_sz); #,3
459 printf("len=%s\n",length($str));
460 if ($cnt_in!=$page_sz) {
461 dienice("hmm, dmpaft only got $cnt_in bytes. was expecting $page_sz");
463 print "Page $page\n";
464 #print DMP $str,"\n";
465 #print "ACK receipt of page $page\n";
466 #$ob->write( pack("h", 0x06) );
468 my $calc_crc = CRC_CCITT($str);
469 my $crc = unpack "%n", substr($str,265,2);
470 print "page crc=$crc, calc_crc=$calc_crc\n";
475 foreach my $rec ( 0..4 ) {
476 if ( ($page == 1) && ($rec < $rec_start ) ) {
478 } # Find the right starting point...
480 my $start_ptr = 1 + ($rec * $rec_sz );
481 my $rec_str = substr($str, $start_ptr ,52);
483 #print "$start_ptr \t > " . unpack( "h*", $rec_str) . "\n";
485 my $date = substr($rec_str,0,2);
486 my $date_curr = unpack "s", $date;
488 # Check if we have wrapped...
489 if ( $date_curr < $date_prev ) {
492 $date_prev = $date_curr;
494 $hsh{'date_stamp'} = $date_curr;
495 $hsh{'time_stamp'} = unpack "s", substr($rec_str,2,2);
497 $hsh{'day'} = unpack( "c", $date & pack("c",0x1F) );
498 $hsh{'month'} = ( $hsh{'date_stamp'} >> 5) & 0xF;
499 $hsh{'year'} = ( $hsh{'date_stamp'} >> 9) + 2000;
501 $hsh{'hour'} = sprintf("%02d", int ( $hsh{'time_stamp'} / 100 ));
503 $hsh{'min'} = $hsh{'time_stamp'} - ($hsh{'hour'} * 100);
504 $hsh{'min'} = sprintf("%02d", $hsh{'min'});
506 $hsh{'time_stamp_fmt'} = "$hsh{'hour'}:$hsh{'min'}:00";
507 $hsh{'date_stamp_fmt'} = "$hsh{'year'}_$hsh{'month'}_$hsh{'day'}";
509 #$hsh{'unixtime'} = timelocal(0,$hsh{min}, $hsh{hour}, $hsh{day}, $hsh{month}-1, $hsh{year}-1900);
511 $hsh{'Air_Temp'} = unpack("s", substr($rec_str,4,2)) / 10;
512 $hsh{'Air_Temp_Hi'} = unpack("s", substr($rec_str,6,2)) / 10;
513 $hsh{'Air_Temp_Lo'} = unpack("s", substr($rec_str,8,2)) / 10;
514 $hsh{'Rain_Clicks'} = unpack("s", substr($rec_str,10,2));
515 $hsh{'Rain_Rate'} = unpack("s", substr($rec_str,12,2)) / 100; # Inches per hour
516 $hsh{'Barometric_Press'} = unpack("s", substr $rec_str,14,2) / 1000;
517 $hsh{'Solar'} = unpack("s", substr $rec_str,16,2); # watt/m**2
518 $hsh{'Wind_Samples'} = unpack("s", substr $rec_str,18,2);
519 $hsh{'Air_Temp_Inside'} = unpack("s", substr $rec_str,20,2) / 10;
521 $hsh{'Relative_Humidity_Inside'} = unpack("C", substr $rec_str,22,1);
522 $hsh{'Relative_Humidity'} = unpack("C", substr $rec_str,23,1);
524 $hsh{'Wind_Speed'} = unpack("C", substr($rec_str,24,1));
525 $hsh{'Wind_Gust_Max'} = unpack("C", substr($rec_str,25,1));
526 $hsh{'Wind_Dir_Max'} = unpack("C", substr($rec_str,26,1));
527 $hsh{'Wind_Dir'} = unpack("C", substr($rec_str,27,1));
529 $hsh{'UV'} = unpack("C", substr($rec_str,28,1)) / 10;
530 $hsh{'ET'} = unpack("C", substr($rec_str,29,1)) / 1000;
532 $hsh{'Solar_Max'} = unpack("s", substr($rec_str,30,2));
533 $hsh{'UV_Max'} = unpack("C", substr($rec_str,32,1));
535 $hsh{'Forecast_Rule'} = unpack("C", substr($rec_str,33,1));
537 # $hsh{'Dew_Point'} = _dew_point($hsh{'Air_Temp'},$hsh{'Relative_Humidity'});
539 # Miscellaneous others omitted for now
541 print "date> $hsh{'Air_Temp'} $hsh{'time_stamp'} $hsh{'time_stamp_fmt'} $hsh{'date_stamp'} $hsh{'date_stamp_fmt'}\n";
544 push @arc_rec_lst, {%hsh};
547 #$in = <STDIN>; # Testing step through facility
548 #if ($in =~ /q/i ) { $port_obj->write( pack("h", 0x1B) ); last; }
549 #else { $port_obj->write( pack("h", 0x06) ); }
550 print "ACK receipt of page\n";
551 $ob->write( pack("h", 0x06) );
557 package Device::SerialPort;