5 use Device::SerialPort;
8 my $devname = "/dev/davis";
14 my $connectionInfo="dbi:$dbsort:$db";
15 $connectionInfo .= ":$host" if $host;
17 # make connection to database
18 my %attr = ( PrintError => 0, RaiseError => 0 );
19 my $dbh = DBI->connect($connectionInfo,$userid,$passwd,\%attr) or die "Couldn't connect to database: " . DBI->errstr;
28 my $ob = Device::SerialPort->new ($devname) || die;
30 $ob->user_msg(1); # misc. warnings
31 $ob->error_msg(1); # hardware and data errors
35 #$ob->parity_enable(1); # for any parity except "none"
38 $ob->handshake('none');
39 $ob->read_const_time(15000); # ultimate timeout (15 seconds)
40 $ob->write_settings||die"setting failed";
44 $ob->write("\n"); # initial wake
47 $ob->write("\n"); # wake for real
48 $ob->read_interval(600); # wait for a max of 600ms
49 ($count, $result) = $ob->read(10); # read up to 10 chars
50 if ($result eq "\n\r") {
51 print "awoke on attempt $attempts :)\n";
55 print "wake error on attempt $attempts :(\n";
58 dienice("failed to wake device - tried $attempts times") unless $attempts<6;
61 $ob->write("LAMPS 0\n");
62 $ob->read_interval(300); # wait for a max of 300ms
63 ($count, $result) = $ob->read(8); # read up to 8 chars
64 $result=~s/(\r|\n)//g;
65 if ($result eq "OK") {
66 print "lamps on :)\n";
69 dienice("lamp error '$result'");
76 print "$ref->[2]:$ref->[1]:$ref->[0] $ref->[3]/$ref->[4]/$ref->[5]\n";
83 get_loop(); # if you do anything after here - you need to wake up the device again
84 print "** do something else\n";
86 $ob->write("\r"); # wake
87 $ob->read_interval(500); # wait for a max of 300ms
88 my ($count, $result) = $ob->read(4096); # read any crap up to 4096 chars
91 #print "count=$count $result\n";
92 #for(my $i=0; $i<$count; $i++)
93 #{ printf("%02d ",ord(substr($result,$i,1))); }
95 #$ob->write("WRD\x12\x4d\n");
111 my $loo = substr $blk,0,3;
112 unless ( $loo eq 'LOO') {
113 warn("Block invalid loo -> $loo\n"); return "";
117 #$hsh{'next_rec'} = unpack("s", substr $blk,5,2);
119 $hsh{'Barometric_Trend'} = unpack("C", substr $blk,3,1);
120 $hsh{'Barometric_Trend_txt'} = $bar_trend{$hsh{'Barometric_Trend'}};
121 $t = unpack("s", substr $blk,7,2) / 1000;
122 # $hsh{'Barometric_Press_hg'} = $t;
123 $hsh{'Barometric_Press_mb'} = sprintf("%.2f",$t*33.8637526);
126 $t = unpack("s", substr $blk,9,2) / 10;
127 # $hsh{'Air_Temp_Inside_f'} = $t;
128 $hsh{'Air_Temp_Inside_c'} = sprintf("%.1f",($t - 32) * 5/9);
129 my $tf = unpack("s", substr $blk,12,2) / 10;
130 # $hsh{'Air_Temp_Outside_f'} = $tf;
131 $hsh{'Air_Temp_Outside_c'} = sprintf("%.1f",($tf - 32) * 5/9);
133 $hsh{'Wind_Speed_mph'} = unpack("C", substr $blk,14,1);
134 # $hsh{'Wind_Speed_mps'} = sprintf("%.1f",$hsh{'Wind_Speed_mph'}*0.44704);
135 $hsh{'Wind_Speed_10min_Avg_mph'} = unpack("C", substr $blk,15,1);
136 # $hsh{'Wind_Speed_10min_Avg_mps'} = sprintf("%.1f",$hsh{'Wind_Speed_10min_Avg_mph'}*0.44704);
137 $hsh{'Wind_Dir'} = unpack("s", substr $blk,16,2);
140 $hsh{'Humidity_Outside'} = unpack("C", substr $blk,33,1);
141 $hsh{'Humidity_Inside'} = unpack("C", substr $blk,11,1);
142 $hsh{'Dew_Point'} = dew_point($tf, $hsh{'Humidity_Outside'});
144 # $hsh{'UV'} = unpack("C", substr $blk,43,1);
145 # $hsh{'Solar'} = unpack("s", substr $blk,44,2); # watt/m**2
147 $hsh{'Rain_Rate'} = (unpack("s", substr $blk,41,2) / 100) * 25.4; # Inches per hr converted to mm
148 $hsh{'Rain_Storm'} = (unpack("s", substr $blk,46,2) / 100) * 25.4; # Inches per storm
149 #$hsh{'Storm_Date'} = unpack("s", substr $blk,48,2); # Need to parse data (not sure what this is)
150 $hsh{'Rain_Day'} = (unpack("s", substr $blk,50,2)/100) * 25.4;
151 $hsh{'Rain_Month'} = (unpack("s", substr $blk,52,2)/100) * 25.4;
152 $hsh{'Rain_Year'} = (unpack("s", substr $blk,54,2)/100) * 25.4;
154 $hsh{'ET_Day'} = unpack("s", substr $blk,56,2)/1000;
155 $hsh{'ET_Month'} = unpack("s", substr $blk,58,2)/100;
156 $hsh{'ET_Year'} = unpack("s", substr $blk,60,2)/100;
158 #$hsh{'Alarms_Inside'} = unpack("b8", substr $blk,70,1);
159 #$hsh{'Alarms_Rain'} = unpack("b8", substr $blk,70,1);
160 #$hsh{'Alarms_Outside'} = unpack("b8", substr $blk,70,1);
162 $hsh{'Batt_Transmitter'} = unpack("C", substr $blk,86,1); # * 0.005859375
163 $hsh{'Batt_Console'} = unpack("s", substr $blk,87,2) * 0.005859375;
165 $hsh{'Forecast_Icon'} = unpack("C", substr $blk,89,1);
166 $hsh{'Forecast_Rule'} = unpack("C", substr $blk,90,1);
168 $hsh{'Sunrise'} = sprintf( "%04d", unpack("S", substr $blk,91,2) );
169 $hsh{'Sunrise'} =~ s/(\d{2})(\d{2})/$1:$2/;
170 $hsh{'Sunset'} = sprintf( "%04d", unpack("S", substr $blk,93,2) );
171 $hsh{'Sunset'} =~ s/(\d{2})(\d{2})/$1:$2/;
173 #my $nl = ord substr $blk,95,1;
174 #my $cr = ord substr $blk,96,1;
176 my $crc = unpack "%n", substr($blk,97,2);
177 my $crc_calc = CRC_CCITT($blk);
183 print "CRC check failed for LOOP data!\n";
186 #delete @hsh{'crc', 'crc_calc', 'next_rec'};
187 #delete($hsh{crc})||die"cant delete crc";
188 #delete($hsh{crc_calc})||die"cant delete crc_calc";
189 #delete($hsh{next_rec})||die"cant delete next_rec";
198 # Using the simplified approximation for dew point
199 # Accurate to 1 degree C for humidities > 50 %
200 # http://en.wikipedia.org/wiki/Dew_point
202 my $dew_point = $temp - ( (100 - $rh)/5 );
209 # Expects packed data...
210 my $data_str = shift @_;
213 my @lst = split //, $data_str;
214 foreach my $data (@lst) {
215 my $data = unpack("c",$data);
218 my $index = $crc >> 8 ^ $data;
219 my $lhs = $crc_table[$index];
220 #print "lhs=$lhs, crc=$crc\n";
221 my $rhs = ($crc << 8) & 0xFFFF;
234 0x0, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7,
235 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef,
236 0x1231, 0x210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6,
237 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de,
238 0x2462, 0x3443, 0x420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485,
239 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d,
240 0x3653, 0x2672, 0x1611, 0x630, 0x76d7, 0x66f6, 0x5695, 0x46b4,
241 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc,
242 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x840, 0x1861, 0x2802, 0x3823,
243 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b,
244 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0xa50, 0x3a33, 0x2a12,
245 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a,
246 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0xc60, 0x1c41,
247 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49,
248 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0xe70,
249 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78,
250 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f,
251 0x1080, 0xa1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067,
252 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e,
253 0x2b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256,
254 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d,
255 0x34e2, 0x24c3, 0x14a0, 0x481, 0x7466, 0x6447, 0x5424, 0x4405,
256 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c,
257 0x26d3, 0x36f2, 0x691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634,
258 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab,
259 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x8e1, 0x3882, 0x28a3,
260 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a,
261 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0xaf1, 0x1ad0, 0x2ab3, 0x3a92,
262 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9,
263 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0xcc1,
264 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8,
265 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0xed1, 0x1ef0
268 $bar_trend{-60} = "Falling Rapidly";
269 $bar_trend{196} = "Falling Rapidly";
270 $bar_trend{-20} = "Falling Slowly";
271 $bar_trend{236} = "Falling Slowly";
272 $bar_trend{0} = "Steady";
273 $bar_trend{20} = "Rising Slowly";
274 $bar_trend{60} = "Rising Rapidly";
279 $ob->write("GETTIME\n");
280 $ob->read_interval(200);
281 my($cnt_in, $str) = $ob->read(9);
283 dienice("read error cnt_in=$cnt_in, str='$str'");
286 my $ck = CRC_CCITT(substr($str,1,9));
288 warn "checksum error"; return 0;
290 my @rsp_lst = split //, $str;
292 @rsp_lst = map ord, @rsp_lst;
298 my $s_time = [ localtime() ];
301 $ob->write("SETTIME\n");
302 $ob->read_interval(300);
303 my ($cnt_in, $str) = $ob->read(1);
306 warn "SETTIME not set ack $ack !"; return 0;
308 my ($sec, $min, $hour, $day, $mon, $yr) = @{$s_time};
309 $str = join "", map chr, ($sec, $min, $hour, $day, $mon, $yr);
310 my $ck = CRC_CCITT($str);
311 $str = $str . pack("n",$ck);
313 ($cnt_in, $str) = $ob->read(1);
314 if ( ord($str) != 6 ) {
315 warn "SETTIME not set!"; return 0;
317 sleep 3; # The console seems to need to some time here...
322 print "** get loop at ", scalar localtime, "\n";
324 $ob->write("LOOP $loops\n");
325 $ob->read_interval(0);
326 ($count, $result) = $ob->read(1);
327 for (my $i=0; $i<$loops; $i+=1) {
339 $ob->read_interval(0);
340 ($count, $result) = $ob->read(99);
342 print "loop error - got $count bytes, expected 99\n";
345 print "LOOP data received\n";
347 if (ord(substr($result,0,1))==6) {
348 $result=substr($result,1);
351 my $rc=parse_loop_blck($result);
354 } # bad crc so goto next
355 foreach my $key (sort keys %hsh) {
356 print "$key = $hsh{$key}\n";
359 my $stmt = 'INSERT INTO current (Date_Time,' . join(',', keys %hsh) . ') VALUES (NOW(),' . join(',', ('?') x keys %hsh) . ')';
361 $dbh->do( $stmt, undef, values %hsh);
370 #my $self = shift @_;
371 open(DMP,">dump.txt");
372 my $vDateStamp = shift @_;
373 my $vTimeStamp = shift @_;
375 # If not date/time stamp then assume 0 which will down load the entire archive
376 unless ( $vDateStamp ) {
379 unless ( $vTimeStamp ) {
383 #my $port_obj = $self->{'port_obj'};
385 my $datetime = pack("ss",$vDateStamp, $vTimeStamp);
387 my $crc = CRC_CCITT($datetime);
388 my $cmd = pack("ssn",$vDateStamp,$vTimeStamp,$crc);
390 #-----------------------
391 #my $str = unpack("H*", $cmd);
392 #$str =~ s/(\w{2})/$1 /g;
393 # Documentation is wrong! The example should be <0xC6><0x06><0xA2><0x03> in section X
394 #print "cmd : $str \n";exit;
395 #-----------------------
397 #sleep 2; # Needed after loop
400 # Ok let's start the communication sequence....
401 my $cnt_out = $ob->write("DMPAFT\n");
403 warn "write failed\n";
407 $ob->read_interval(300);
408 my ($cnt_in, $str) = $ob->read(1);
412 warn "Ack not received on DMPAFT command: $ack"; exit -1;
415 $cnt_out = $ob->write($cmd);
417 warn "write failed\n";
420 ($cnt_in, $str) = $ob->read(7);
422 $ack = ord substr($str,0,1);
424 my $ls = unpack("H20",substr($str,1,4) );
425 $ls =~ s/(\w{2})/$1 /g;
427 my $pages = unpack("s",substr($str,1,2) );
428 my $rec_start = unpack("s",substr($str,3,2) );
430 $crc = CRC_CCITT(substr($str,1,6) );
432 print "Pages = $pages : rec = $rec_start Datestamp $vDateStamp $crc\n";
434 $cnt_out = $ob->write( pack("h", 0x06) );
436 #if ($pages == 513 ) { return -1 }
439 foreach my $page (1..$pages) {
441 $ob->read_interval(0);
442 my ($cnt_in, $str) = $ob->read($page_sz); #,3
443 printf("len=%s\n",length($str));
444 if ($cnt_in!=$page_sz) {
445 dienice("hmm, dmpaft only got $cnt_in bytes. was expecting $page_sz");
447 print "Page $page\n";
448 #print DMP $str,"\n";
449 #print "ACK receipt of page $page\n";
450 #$ob->write( pack("h", 0x06) );
452 my $calc_crc = CRC_CCITT($str);
453 my $crc = unpack "%n", substr($str,265,2);
454 print "page crc=$crc, calc_crc=$calc_crc\n";
459 foreach my $rec ( 0..4 ) {
460 if ( ($page == 1) && ($rec < $rec_start ) ) {
462 } # Find the right starting point...
464 my $start_ptr = 1 + ($rec * $rec_sz );
465 my $rec_str = substr($str, $start_ptr ,52);
467 #print "$start_ptr \t > " . unpack( "h*", $rec_str) . "\n";
469 my $date = substr($rec_str,0,2);
470 my $date_curr = unpack "s", $date;
472 # Check if we have wrapped...
473 if ( $date_curr < $date_prev ) {
476 $date_prev = $date_curr;
478 $hsh{'date_stamp'} = $date_curr;
479 $hsh{'time_stamp'} = unpack "s", substr($rec_str,2,2);
481 $hsh{'day'} = unpack( "c", $date & pack("c",0x1F) );
482 $hsh{'month'} = ( $hsh{'date_stamp'} >> 5) & 0xF;
483 $hsh{'year'} = ( $hsh{'date_stamp'} >> 9) + 2000;
485 $hsh{'hour'} = sprintf("%02d", int ( $hsh{'time_stamp'} / 100 ));
487 $hsh{'min'} = $hsh{'time_stamp'} - ($hsh{'hour'} * 100);
488 $hsh{'min'} = sprintf("%02d", $hsh{'min'});
490 $hsh{'time_stamp_fmt'} = "$hsh{'hour'}:$hsh{'min'}:00";
491 $hsh{'date_stamp_fmt'} = "$hsh{'year'}_$hsh{'month'}_$hsh{'day'}";
493 #$hsh{'unixtime'} = timelocal(0,$hsh{min}, $hsh{hour}, $hsh{day}, $hsh{month}-1, $hsh{year}-1900);
495 $hsh{'Air_Temp'} = unpack("s", substr($rec_str,4,2)) / 10;
496 $hsh{'Air_Temp_Hi'} = unpack("s", substr($rec_str,6,2)) / 10;
497 $hsh{'Air_Temp_Lo'} = unpack("s", substr($rec_str,8,2)) / 10;
498 $hsh{'Rain_Clicks'} = unpack("s", substr($rec_str,10,2));
499 $hsh{'Rain_Rate'} = unpack("s", substr($rec_str,12,2)) / 100; # Inches per hour
500 $hsh{'Barometric_Press'} = unpack("s", substr $rec_str,14,2) / 1000;
501 $hsh{'Solar'} = unpack("s", substr $rec_str,16,2); # watt/m**2
502 $hsh{'Wind_Samples'} = unpack("s", substr $rec_str,18,2);
503 $hsh{'Air_Temp_Inside'} = unpack("s", substr $rec_str,20,2) / 10;
505 $hsh{'Relative_Humidity_Inside'} = unpack("C", substr $rec_str,22,1);
506 $hsh{'Relative_Humidity'} = unpack("C", substr $rec_str,23,1);
508 $hsh{'Wind_Speed'} = unpack("C", substr($rec_str,24,1));
509 $hsh{'Wind_Gust_Max'} = unpack("C", substr($rec_str,25,1));
510 $hsh{'Wind_Dir_Max'} = unpack("C", substr($rec_str,26,1));
511 $hsh{'Wind_Dir'} = unpack("C", substr($rec_str,27,1));
513 $hsh{'UV'} = unpack("C", substr($rec_str,28,1)) / 10;
514 $hsh{'ET'} = unpack("C", substr($rec_str,29,1)) / 1000;
516 $hsh{'Solar_Max'} = unpack("s", substr($rec_str,30,2));
517 $hsh{'UV_Max'} = unpack("C", substr($rec_str,32,1));
519 $hsh{'Forecast_Rule'} = unpack("C", substr($rec_str,33,1));
521 # $hsh{'Dew_Point'} = _dew_point($hsh{'Air_Temp'},$hsh{'Relative_Humidity'});
523 # Miscellaneous others omitted for now
525 print "date> $hsh{'Air_Temp'} $hsh{'time_stamp'} $hsh{'time_stamp_fmt'} $hsh{'date_stamp'} $hsh{'date_stamp_fmt'}\n";
528 push @arc_rec_lst, {%hsh};
531 #$in = <STDIN>; # Testing step through facility
532 #if ($in =~ /q/i ) { $port_obj->write( pack("h", 0x1B) ); last; }
533 #else { $port_obj->write( pack("h", 0x06) ); }
534 print "ACK receipt of page\n";
535 $ob->write( pack("h", 0x06) );
541 package Device::SerialPort;