File Coverage

blib/lib/Device/WxM2.pm
Criterion Covered Total %
statement 52 748 6.9
branch 3 234 1.2
condition 1 9 11.1
subroutine 9 80 11.2
pod 0 70 0.0
total 65 1141 5.7


line stmt bran cond sub pod time code
1             ##################################
2             ###### Wx Monitor-II #############
3             ##################################
4             package Device::WxM2;
5 1     1   37786 use warnings;
  1         3  
  1         37  
6 1     1   7 use strict;
  1         1  
  1         37  
7 1     1   7 use Carp;
  1         6  
  1         112  
8 1     1   1329 use Device::SerialPort;
  1         60682  
  1         67  
9              
10 1     1   17 use vars qw($VERSION);
  1         4  
  1         154  
11             $VERSION = '1.03';
12              
13             ### Device Driver For the Davis Weather Monitor II, a personal weather station
14             ### Copyright (C) 2003 Mark Mabry
15             ###
16             ### This program is free software; you can redistribute it and/or modify
17             ### it under the terms of the GNU General Public License as published by
18             ### the Free Software Foundation; either version 2 of the License, or
19             ### (at your option) any later version.
20             ###
21             ### This program is distributed in the hope that it will be useful,
22             ### but WITHOUT ANY WARRANTY; without even the implied warranty of
23             ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24             ### GNU General Public License for more details.
25             ###
26             ### You should have received a copy of the GNU General Public License
27             ### along with this program; if not, write to the Free Software
28             ### Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
29             ###
30              
31             ### Motivation: I wrote this so I could log data from my weather
32             ### station using a Linux box that already ran a firewall and mail
33             ### server, so was powered up all the time already. The Davis Weather
34             ### Monitor II only comes with software that runs on Windoze.
35              
36             ### Any updated versions may be obtained from the CPAN site.
37             ### Contact me with any bugs/suggestions at mmabry@cpan.org
38              
39             ### My weather station web page is
40             ### http://home.comcast.net/~mark.mabry/Hermes_Wx.html
41              
42             ### This driver depends on the Device::SerialPort Perl driver found on
43             ### CPAN. You must install it in your @INC path. The standard CPAN
44             ### install will be fine.
45              
46              
47             =head1 NAME
48              
49             B - Davis Weather Monitor II Station device driver
50              
51             =head1 SYNOPSYS
52              
53              
54             use Device::WxM2;
55              
56             =head2 Constructor
57              
58             my $ws = new Device::WxM2 ("/dev/ttyS0");
59              
60             =head2 Destructor
61              
62             undef $ws;
63              
64             =head2 Archive Retrieval and Logging Functions
65              
66             my @wxArchiveImage = $ws->getArcImg($archivePtr);
67             my @currentWx = $ws->getSensorImage;
68             my $void = $ws->archiveCurImage();
69             my $status = $ws->updateArchiveFromPtr($lastArchivedPtr, $file);
70             my $status = $ws->batchRetrieveArchives($x, $filename);
71             my $void = $ws->printRawLogHeader();
72             my $ptr = $ws->getNewPtr;
73             my $ptr = $ws->getLastPtr;
74             my $ptr = $ws->getOldPtr;
75             my $status = $ws->setLastArcTime($time_in_minutes_since_midnight);
76             my $minutes_since_midnight = $ws->getLastArcTime;
77              
78             =head2 Individual Access Functions
79              
80             my $outside_temp = $ws->getOutsideTemp;
81             my $inside_temp = $ws->getInsideTemp;
82             my $dewpoint = $ws->getDewPoint;
83             my $wind_speed = $ws->getWindSpeed;
84             my $wind_dir = $ws->getWindDir;
85             my ($windHi, $hour, $min, $mon, $day) = $ws->getHiWind;
86             my ($dewHi, $hour, $min, $mon, $day) = $ws->getHiDewPoint;
87             my ($dewLo, $hour, $min, $mon, $day) = $ws->getLoDewPoint;
88             my ($wndChLo, $hour, $min, $mon, $day) = $ws->getLoWindChill;
89             my ($temp, $hour, $min, $mon, $day) = $ws->getHiInsideTemp;
90             my ($temp, $hour, $min, $mon, $day) = $ws->getLoInsideTemp;
91             my ($temp, $hour, $min, $mon, $day) = $ws->getHiOutsideTemp;
92             my ($temp, $hour, $min, $mon, $day) = $ws->getLoOutsideTemp;
93             my ($hum, $hour, $min, $mon, $day) = $ws->getHiInsideHumidity;
94             my ($hum, $hour, $min, $mon, $day) = $ws->getLoInsideHumidity;
95             my ($hum, $hour, $min, $mon, $day) = $ws->getHiOutsideHumidity;
96             my ($hum, $hour, $min, $mon, $day) = $ws->getLoOutsideHumidity;
97              
98             my $rainfall_float = $ws->getYearlyRain;
99             my $rainfall_float = $ws->getDailyRain;
100             my $bp_float = $ws->getBarometricPressure;
101             my $value = $ws->getBaroCal;
102             my ($hour, $minute, $second) = $ws->getTime;
103             my ($month, $day) = $ws->getDate;
104              
105             my $status = $ws->setTime($hour_24_format, $min);
106             my $status = $ws->clearHiWind;
107             my $status = $ws->clearHiDewPoint;
108             my $status = $ws->clearLoDewPoint;
109             my $status = $ws->clearLoWindChill;
110             my $status = $ws->clearHiLoOutTemp;
111             my $status = $ws->clearHiLoInTemp;
112             my $status = $ws->clearHiLoOutHum;
113             my $status = $ws->clearHiLoInHum;
114             my $status = $ws->clearDailyRain;
115             my $status = $ws->clearYearlyRain;
116              
117             =head2 Configuration Functions
118              
119             my $void = $ws->setArchiveLogFilename($filename);
120             my $filename = $ws->getArchiveLogFilename();
121             my $void = $ws->setStationDescription("text");
122             my $string = $ws->getStationDescription();
123             my $void = $ws->setSerialPortReadTime($timeout_value_in_milliseconds);
124             my $void = $ws->configPort();
125             my $timeout_value_in_milliseconds = $ws->getSerialPortReadTime();
126             my $status = $ws->setArchivePeriod($time_in_minutes);
127             my $time_in_minutes = $ws->getArchivePeriod();
128             my $status = $ws->setLastArcTime($time_in_minutes);
129             my $time_in_minutes = $ws->getLastArcTime();
130              
131              
132             =head1 DESCRIPTION
133              
134             =head2 Installation
135              
136             This driver depends on the Device::SerialPort Perl driver found on
137             CPAN. You must install it somewhere on the @INC list, so that wxm2.pm
138             can call it with 'use'. The standard CPAN install works fine.
139              
140             To install WxM2, use:
141              
142             perl Makefile.PL
143             make
144             make test
145             make install
146              
147             For all the regression tests to pass, your Davis Weather Monitor II
148             must be operating and connected to your computer's serial port.
149             The test will query you for the name of the serial port. It will
150             also ask if you weather station is operating and connected. If it
151             is not, the regression test will skip 5 of the 8 tests. You can
152             re-run the regression test at any time with either:
153              
154             make test
155              
156             OR
157              
158             perl -w test.pl
159              
160             =head2 Setup
161              
162             To use the WxM2 driver, simply create a class object with 'new', ie.
163              
164             $ws = new Device::WxM2("/dev/ttyS0");
165              
166             The only parameter to C<&new> is the port to which your weather station
167             is connected. The constructor initializes all the class variables
168             and configures the Device::SerialPort parameters for the Davis
169             Weather Station.
170              
171             Note: I found that I had to fiddle with a parameter in the SerialPort,
172             called 'read_const_time', which is like a timeout value when
173             waiting for read data. I found that the value needed to be
174             increased significantly for the WxM2. I use 5000 (units are
175             milliseconds) and this is the default setting in this package.
176             Should you need to change it, use
177             B<&setSerialPortReadTime>(time_in_millseconds). Then call
178             B<&configPort>, which puts the new setting into effect.
179              
180             If you want to change to archive period, use B<&setArchivePeriod> and
181             B<&getArchivePeriod>. Just remember that if you screw up the values,
182             you station's archive will behave strangely until you fix it.
183              
184             Use B<&getLastArcTime> and B<&setLastArcTime> to establish the time at which
185             the archives are captured into the weather station's archive
186             memory.
187              
188             =head2 Individual Access Functions
189              
190             There are a bunch of individual functions that retrieve one weather
191             value from the weather station, such as b<&getOutsideTemp>. These are
192             fairly self-explanatory.
193              
194             =head2 Archive Retrieval and Logging Functions
195              
196             There are 2 primary archive retrieval functions:
197              
198             &getArcImg - get Archive Image
199             &getSensorImage - get the "live" sensor data image
200              
201             B<&getArcImg> retrieves the archive image at the address given to it as
202             a parameter. To retrieve the most recent archived image, use this:
203              
204             my $lastPtr = $ws->getLastPtr;
205             my @archiveData = $ws->getArcImg($lastPtr);
206              
207             B<&getArcImg> takes the archive data, reformats it where necessary,
208             stores the results in class variables, and returns an array of the
209             data.
210              
211             @array= ($avgInsideTempInArchivePeriod,
212             $averageOutsideTempInArchivePeriod,
213             $outsideTempMaximumInPeriod,
214             $outsideTempMinimumInPeriod,
215             $barometricPressure,
216             $avgWindSpeedInPeriod,
217             $avgWindDirInPeriod,
218             $maxWindGustInPeriod,
219             $rainInPeriod,
220             $insideHumidity,
221             $outsideHumidity,
222             $monthOfSample,
223             $dayOfSample,
224             $hourOfSample,
225             $minuteOfSample,
226             $outsideTempHumIndex,
227             $outsideTempHumIndexMaximum,
228             $avgWindChill,
229             $windChillMinimum);
230              
231             B<&getSensorImage> enables a continuous streaming of "live" weather
232             data from the Davis Wx Station. I've found this stream to be very
233             easy to get out of sync, so this funcion reads a single block, stops
234             the streaming, and flushes the serial receive buffer. The data
235             returned by this function are the current values and not average
236             values within a sample period, like &getArcImg returns. The array
237             returned is as follows:
238              
239             @array = ($insideTemp,
240             $outsideTemp,
241             $windSpeed,
242             $windDirection,
243             $barometricPressure,
244             $insideHumidity,
245             $outsideHumidity,
246             $totalRainfallToday);
247              
248             There are 4 configuration functions for logging the archive data:
249              
250             &setArchiveLogFilename - set the name of the log file to write
251             archive data
252             &getArchiveLogFilename - returns the name of the log file
253             &setStationDescription - sets the station description text (used by
254             &printRawLogHeader)
255             &getStationDescription - returns the station description string
256              
257             Use B<&setArchiveLogFilename> to set the log file name. It is used by
258             all logging function calls in the class.
259              
260             There are two logging functions:
261            
262             &archiveCurImage - Writes the periodic data samples to a file
263             &printRawLogHeader - Prints Header for the periodic samples log file
264              
265             B<&archiveCurImage> writes the data samples held in the class variables
266             to a filename passed in as its only parameter. For example,
267              
268             $ws->archiveCurImage();
269              
270             will write the data samples as 1 line of data in the file
271             B<&getArchiveLogFilename>.
272              
273             B<&printRawLogHeader> writes a header for the data samples into the
274             filename in B<&getArchiveLogFilename>. The second line of the header for your
275             weather station description. Set it with
276             B<&setStationDescription>("description"). Typically it contains the
277             name and location of the weather station.
278              
279             The function B<&batchRetrieveArchives> is handy for retrieving multiple
280             archived images from the WxM2's archive memory. I use it primarily
281             after an extended power outage, but there are lots of other reasons to
282             use it. Us is at follows:
283              
284             $ws->batchRetrieveArchives($number, $filename);
285              
286             where $number is the number of archives to retrieve starting with the most
287             recent and counting back. And $filename is the string for the file to
288             write all the archive to.
289              
290             The function B<&updateArchiveFromPtr> is a low-level function that retrieves archives from an initial pointer value. B<&batchRetrieveArchives> is a user-friendly front-end for this funtion. In most all cases B<&batchRetrieveArchives> should be used. Just in case, you can use B<&updateArchiveFromPtr> as follows:
291              
292             $ws->updateArchiveFromPtr($lastArchivePtr, $file);
293              
294             where $lastArchivePtr is the address of the last archive image that
295             you read. &updateArchiveFromPtr will call &getArcImg and
296             &archiveCurImage for each address between $lastArchivePtr and the
297             currently active archive image. It will NOT return the image at
298             $lastArchivePtr or the currently active image, only the ones in
299             between. $file is a filename in which all the output will be
300             written.
301              
302             =head1 KNOWN LIMITATIONS AND BUGS
303              
304             This driver is primarily for archive retrieval, so things like alarm
305             functions on the WxM2 are not implemented.
306              
307             B<&getSensorImage> data tends to get out of sync or overflow the receive
308             buffer, so it currently terminates the intended nearly infinite stream
309             of data after 1 complete block.
310              
311             =head1 HISTORY / CHANGES
312              
313             Version 1.03 - added getInsideTemp, getWindSpeed, getWindDir, and
314             getBarometricPressure functions. Fixed barometer calibration bug.
315              
316             Version 1.02 - added barometer calibration and bug fix in
317             batchRetrieveArchives.
318              
319             Version 1.00 is the first public version. I have been using it for
320             about 2 years, and it seems stable.
321              
322             =head1 AUTHOR
323              
324             Mark Mabry: mmabry@cpan.org
325              
326             =head2 NOTE
327              
328             If you use, or even try out, this software, please drop me a short
329             email at mmabry@cpan.org, to let me know that others are using it.
330              
331             =head1 SEE ALSO
332              
333             Device::SerialPort
334              
335             =head1 ACKNOWLEDGEMENTS
336              
337             Thanks to Davis Instruments for publishing the reference
338             specifications needed to access the Weather Monitor II.
339              
340             Chris Snell added the getInsideTemp, getWindSpeed, and getWindDir functions.
341              
342             Wayne Hahn fixed a bug in a pack call that popped up in Perl 5.8. He also
343             added a sleep 1 to getSensorImage command to get it to run smoothly.
344              
345             =head1 COPYRIGHT
346              
347             Copyright (C) 2003, 2004 Mark Mabry. All rights reserved.
348              
349             This program is free software; you can redistribute it and/or modify
350             it under the terms of the GNU public license.
351              
352             =cut
353              
354 1     1   999 use FileHandle;
  1         4252  
  1         6  
355 1     1   404 use vars qw($wxPort);
  1         2  
  1         8850  
356              
357              
358             my $DEBUG = 0;
359              
360             my $quiet = 1;
361             my $sample_offset = 0; # most will set this = 0.
362              
363             my @compass_rose = ("N", "NNE", "NE", "ENE", "E",
364             "ESE", "SE", "SSE", "S", "SSW",
365             "SW", "WSW", "W", "WNW", "NW", "NNW");
366              
367              
368             ###################################################################
369             ## ##
370             ## Setup Functions ##
371             ## ##
372             ###################################################################
373              
374             sub new {
375 0     0 0 0 my $class = shift;
376 0         0 my $portName = shift;
377 0         0 my $self = {};
378              
379 0         0 $wxPort = new Device::SerialPort ($portName, $quiet);
380 0 0       0 unless (defined $wxPort) {
381 0         0 print STDERR "Could not open $portName\n";
382 0         0 return undef;
383             }
384 0         0 bless $self, $class;
385 0         0 $self->_initialize();
386 0         0 $self->{portName} = $portName;
387 0         0 $self->configPort();
388 0         0 $self->setupBaroCal();
389 0         0 return $self;
390             }
391              
392             sub _initialize {
393 0     0   0 my $self = shift;
394              
395             ##
396             ## Class storage variables
397             ##
398             ### Instant Sensor data
399 0         0 $self->{outTemp} = 0;
400 0         0 $self->{inTemp} = 0;
401 0         0 $self->{baro} = 0;
402 0         0 $self->{windSpeed} = 0;
403 0         0 $self->{windDir} = 0;
404 0         0 $self->{windGust} = 0;
405 0         0 $self->{inHum} = 0;
406 0         0 $self->{outHum} = 0;
407 0         0 $self->{rainTotal} = 0;
408              
409 0         0 $self->{avgOutTemp} = 0;
410 0         0 $self->{loTemp} = 0;
411 0         0 $self->{hiTemp} =0;
412 0         0 $self->{avgInTemp} = 0;
413 0         0 $self->{avgWindSpeed} = 0;
414 0         0 $self->{windGust} = 0;
415 0         0 $self->{rainInPrd} = 0;
416 0         0 $self->{date} = "";
417 0         0 $self->{time} = "";
418 0         0 $self->{thi} = 0;
419 0         0 $self->{hiTHI} = 0;
420 0         0 $self->{windChillLo} = 0;
421 0         0 $self->{avgWindDir} = 0;
422             # these are used in both getArcImg and getSensorImage.
423 0         0 $self->{inHum} = 0;
424 0         0 $self->{outHum} = 0;
425              
426 0         0 $self->{dewpoint} = -100;
427 0         0 $self->{avgDewpoint} = -100;
428              
429             # BaroCal
430 0         0 $self->{baroCal} = 0;
431 0         0 $self->{isBaroCalSet} = 0;
432              
433             # Configuration
434 0         0 $self->{portName} = "Not set";
435 0         0 $self->{serialPortReadConstTime} = 5000;
436 0         0 my $year = &whichYear;
437 0         0 $self->{archiveLogFile} = "./wx_$year.log";
438 0         0 $self->{stationDescription} =
439             "Use &setStationDescription(\"text\"); to put your Wx station text here;";
440             }
441              
442             sub configPort {
443 0     0 0 0 my $self = shift;
444              
445             # configure port
446 0         0 $wxPort->user_msg("ON");
447 0         0 $wxPort->error_msg("ON");
448 0         0 $wxPort->databits(8);
449 0         0 $wxPort->baudrate(2400);
450 0         0 $wxPort->parity("none");
451 0         0 $wxPort->stopbits(1);
452 0         0 $wxPort->handshake("rts");
453 0         0 $wxPort->datatype('raw');
454 0 0       0 $wxPort->{"_DEBUG"} = ($DEBUG > 2) ? 1 : 0;
455 0         0 $wxPort->read_const_time($self->{serialPortReadConstTime}); # const time for read (milliseconds)
456 0         0 $wxPort->read_char_time(50); # avg time between read char
457             }
458              
459             sub saveSerialConfig {
460 0     0 0 0 my $self = shift;
461            
462 0 0       0 my $filename = (scalar(@_)) ? shift : "ttyS0_wxport";
463              
464             # save config
465 0 0       0 $wxPort->write_settings || croak "Couldn't write settings\n";
466 0         0 $wxPort->save($filename);
467             }
468              
469             sub setSerialPortReadTime {
470 0     0 0 0 my $self = shift;
471 0         0 $self->{serialPortReadConstTime} = shift;
472             }
473             sub getSerialPortReadTime {
474 0     0 0 0 my $self = shift;
475 0         0 return $self->{serialPortReadConstTime};
476             }
477              
478             sub setArchiveLogFilename {
479 0     0 0 0 my $self = shift;
480 0         0 $self->{archiveLogFile} = shift;
481             }
482              
483             sub getArchiveLogFilename {
484 0     0 0 0 my $self = shift;
485 0         0 return $self->{archiveLogFile};
486             }
487              
488             sub setStationDescription {
489 0     0 0 0 my $self = shift;
490 0         0 $self->{stationDescription} = shift;
491             }
492              
493             sub getStationDescription {
494 0     0 0 0 my $self = shift;
495 0         0 return $self->{stationDescription};
496             }
497              
498             ### Not needed for Weather Monitor II. Other Davis stations may need
499             ### this. Not tested.
500             sub disableCRC {
501 0     0 0 0 my $self = shift;
502             ####################
503             ## This may have to be run the first time only.
504             ###################
505              
506             # turn off CRC
507 0         0 my $crcByte0 = pack "c", 44;
508 0         0 my $crcByte1 = pack "c", 247;
509 0         0 my $crc0 = "CRC0";
510 0         0 my $returnChar = pack "c", 0x0d;
511 0         0 my $count = $wxPort->write($crcByte0);
512 0 0       0 warn "write failed\n" unless ($count);
513 0 0       0 warn "write incomplete\n" if ( $count != length($crcByte0));
514             #print "Write count=$count";
515            
516 0         0 $count = $wxPort->write($crcByte1);
517             #warn "write failed\n" unless ($count);
518             #warn "write incomplete\n" if ( $count != length($crcByte1));
519            
520 0         0 $count = $wxPort->write($crc0);
521 0 0       0 warn "write failed\n" unless ($count);
522 0 0       0 warn "write incomplete\n" if ( $count != length($crc0));
523            
524 0         0 $count = $wxPort->write($returnChar);
525 0 0       0 warn "write failed\n" unless ($count);
526 0 0       0 warn "write incomplete\n" if ( $count != length($returnChar));
527              
528 0 0       0 unless ($wxPort->write_done) {
529 0         0 print "waiting to finish first write\n";
530 0         0 sleep 1;
531             }
532 0         0 $self->_get_ack();
533             }
534              
535             ###################################################################
536             ## ##
537             ## Individual Access Functions ##
538             ## ##
539             ###################################################################
540             sub getOutsideTemp {
541 0     0 0 0 my $self = shift;
542              
543 0         0 my @str_in = $self->read("RRD", 1, 0x20, 4);
544 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
545              
546 0         0 my $outTemp = $self->tempConv(@str_in);
547 0         0 $self->{outTemp} = $outTemp;
548 0         0 return $outTemp;
549             }
550              
551             sub getInsideTemp {
552 0     0 0 0 my $self = shift;
553              
554 0         0 my @str_in = $self->read("RRD", 1, 0x1C, 4);
555 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
556              
557 0         0 my $inTemp = $self->tempConv(@str_in);
558 0         0 $self->{inTemp} = $inTemp;
559 0         0 return $inTemp;
560             }
561              
562             sub getWindSpeed {
563 0     0 0 0 my $self = shift;
564              
565 0         0 my @str_in = $self->read("WRD", 0, 0x5E, 4);
566 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
567              
568             # my $windSpeed = ($str_in[1]*256 + $str_in[0]);
569 0         0 my $windSpeed = $str_in[0];
570 0         0 $self->{windSpeed} = $windSpeed;
571 0         0 return($windSpeed);
572             }
573              
574             sub getWindDir {
575 0     0 0 0 my $self = shift;
576 0         0 my @str_in = $self->read("WRD", 1, 0xB4, 4);
577 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
578              
579 0         0 my $windDir = "$str_in[0]";
580 0         0 $self->{windDir} = $windDir;
581 0         0 return($windDir);
582             }
583              
584              
585             sub getHiWind {
586 0     0 0 0 my $self = shift;
587              
588 0         0 my @str_in = $self->read("WRD", 0, 0x60, 4);
589 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
590              
591 0         0 my $windHi = ($str_in[1]*256 + $str_in[0]);
592 0         0 $self->{windGust} = $windHi;
593 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(0, 0x64, 0, 0x68);
594 0         0 $self->{windGustTime} = $hour . ":" . $min;
595 0         0 $self->{windGustDate} = $mon . "/" . $day;
596 0         0 return ($windHi, $hour, $min, $mon, $day);
597             }
598              
599             sub getDewPoint {
600 0     0 0 0 my $self = shift;
601              
602 0         0 my @str_in = $self->read("WRD", 0, 0x8A, 4);
603 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
604              
605 0         0 my $dew = $self->tempConv(@str_in);
606 0         0 $self->{dewPoint} = $dew;
607 0         0 return $dew;
608             }
609              
610             sub getHiDewPoint {
611 0     0 0 0 my $self = shift;
612              
613 0         0 my @str_in = $self->read("WRD", 0, 0x8E, 4);
614 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
615              
616 0         0 my $dew = $self->tempConv(@str_in);
617 0         0 $self->{DewPointHi} = $dew;
618 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(0, 0x96, 0, 0x9E);
619 0         0 $self->{dewHiTime} = $hour . ":" . $min;
620 0         0 $self->{DewHiDate} = $mon . "/" . $day;
621 0         0 return ($dew, $hour, $min, $mon, $day);
622             }
623              
624             sub getLoDewPoint {
625 0     0 0 0 my $self = shift;
626              
627 0         0 my @str_in = $self->read("WRD", 0, 0x92, 4);
628 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
629              
630 0         0 my $dew = $self->tempConv(@str_in);
631 0         0 $self->{DewPointLo} = $dew;
632 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(0, 0x9A, 0, 0xA1);
633 0         0 $self->{dewLoTime} = $hour . ":" . $min;
634 0         0 $self->{DewLoDate} = $mon . "/" . $day;
635 0         0 return ($dew, $hour, $min, $mon, $day);
636             }
637              
638             sub getLoWindChill {
639 0     0 0 0 my $self = shift;
640              
641 0         0 my @str_in = $self->read("WRD", 0, 0xAC, 4);
642 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
643              
644 0         0 my $wc = $self->tempConv(@str_in);
645 0         0 $self->{WindChillLo} = $wc;
646 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(0, 0xB0, 0, 0xB4);
647 0         0 $self->{WindChillLoTime} = $hour . ":" . $min;
648 0         0 $self->{WindChillLoDate} = $mon . "/" . $day;
649 0         0 return ($wc, $hour, $min, $mon, $day);
650             }
651              
652             sub getHiInsideTemp {
653 0     0 0 0 my $self = shift;
654              
655 0         0 my @str_in = $self->read("WRD", 1, 0x34, 4);
656 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
657              
658 0         0 my $temp = $self->tempConv(@str_in);
659 0         0 $self->{InTempHi} = $temp;
660 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0x3C, 1, 0x44);
661 0         0 $self->{InTempHiTime} = $hour . ":" . $min;
662 0         0 $self->{InTempHiDate} = $mon . "/" . $day;
663 0         0 return ($temp, $hour, $min, $mon, $day);
664             }
665              
666             sub getLoInsideTemp {
667 0     0 0 0 my $self = shift;
668              
669 0         0 my @str_in = $self->read("WRD", 1, 0x138, 4);
670 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
671              
672 0         0 my $temp = $self->tempConv(@str_in);
673 0         0 $self->{InTempLo} = $temp;
674 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0x40, 1, 0x47);
675 0         0 $self->{InTempLoTime} = $hour . ":" . $min;
676 0         0 $self->{InTempLoDate} = $mon . "/" . $day;
677 0         0 return ($temp, $hour, $min, $mon, $day);
678             }
679              
680             sub getHiOutsideTemp {
681 0     0 0 0 my $self = shift;
682              
683 0         0 my @str_in = $self->read("WRD", 1, 0x5A, 4);
684 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
685              
686 0         0 my $temp = $self->tempConv(@str_in);
687 0         0 $self->{OutTempHi} = $temp;
688 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0x62, 1, 0x6A);
689 0         0 $self->{OutTempHiTime} = $hour . ":" . $min;
690 0         0 $self->{OutTempHiDate} = $mon . "/" . $day;
691 0         0 return ($temp, $hour, $min, $mon, $day);
692             }
693              
694             sub getLoOutsideTemp {
695 0     0 0 0 my $self = shift;
696              
697 0         0 my @str_in = $self->read("WRD", 1, 0x5E, 4);
698 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
699              
700 0         0 my $temp = $self->tempConv(@str_in);
701 0         0 $self->{OutTempLo} = $temp;
702 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0x66, 1, 0x6D);
703 0         0 $self->{OutTempLoTime} = $hour . ":" . $min;
704 0         0 $self->{OutTempLoDate} = $mon . "/" . $day;
705 0         0 return ($temp, $hour, $min, $mon, $day);
706             }
707              
708             sub getHiInsideHumidity {
709 0     0 0 0 my $self = shift;
710              
711 0         0 my @str_in = $self->read("WRD", 1, 0x82, 2);
712 0 0       0 return undef unless ($self->_valCheck(1, \@str_in));
713              
714 0         0 my $hum = $str_in[0];
715 0         0 $self->{InHumHi} = $hum;
716 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0x86, 1, 0x8E);
717 0         0 $self->{InHumHiTime} = $hour . ":" . $min;
718 0         0 $self->{InHumHiDate} = $mon . "/" . $day;
719 0         0 return ($hum, $hour, $min, $mon, $day);
720             }
721              
722             sub getLoInsideHumidity {
723 0     0 0 0 my $self = shift;
724              
725 0         0 my @str_in = $self->read("WRD", 1, 0x84, 2);
726 0 0       0 return undef unless ($self->_valCheck(1, \@str_in));
727              
728 0         0 my $hum = $str_in[0];
729 0         0 $self->{InHumLo} = $hum;
730 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0x8A, 1, 0x91);
731 0         0 $self->{InHumLoTime} = $hour . ":" . $min;
732 0         0 $self->{InHumLoDate} = $mon . "/" . $day;
733 0         0 return ($hum, $hour, $min, $mon, $day);
734             }
735             sub getHiOutsideHumidity {
736 0     0 0 0 my $self = shift;
737              
738 0         0 my @str_in = $self->read("WRD", 1, 0x9A, 2);
739 0 0       0 return undef unless ($self->_valCheck(1, \@str_in));
740              
741 0         0 my $hum = $str_in[0];
742 0         0 $self->{OutHumHi} = $hum;
743 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0x9E, 1, 0xA6);
744 0         0 $self->{OutHumHiTime} = $hour . ":" . $min;
745 0         0 $self->{OutHumHiDate} = $mon . "/" . $day;
746 0         0 return ($hum, $hour, $min, $mon, $day);
747             }
748             sub getLoOutsideHumidity {
749 0     0 0 0 my $self = shift;
750              
751 0         0 my @str_in = $self->read("WRD", 1, 0x9C, 2);
752 0 0       0 return undef unless ($self->_valCheck(1, \@str_in));
753              
754 0         0 my $hum = $str_in[0];
755 0         0 $self->{OutHumLo} = $hum;
756 0         0 my ($hour, $min, $mon, $day) = $self->readTimeDate(1, 0xA2, 1, 0xA9);
757 0         0 $self->{OutHumLoTime} = $hour . ":" . $min;
758 0         0 $self->{OutHumLoDate} = $mon . "/" . $day;
759 0         0 return ($hum, $hour, $min, $mon, $day);
760             }
761              
762             sub getYearlyRain {
763 0     0 0 0 my $self = shift;
764            
765 0         0 my @yRainBytes = $self->read("WRD", 1, 0xCE, 4);
766 0 0       0 return undef unless ($self->_valCheck(2, \@yRainBytes));
767              
768 0         0 return ($yRainBytes[1]*256 + $yRainBytes[0])/100;
769             }
770              
771             sub getDailyRain {
772 0     0 0 0 my $self = shift;
773              
774 0         0 my @dRainBytes = $self->read("WRD", 1, 0xD2, 4);
775 0 0       0 return undef unless ($self->_valCheck(2, \@dRainBytes));
776              
777 0         0 return ($dRainBytes[1]*256 + $dRainBytes[0])/100;
778             }
779              
780             sub getBarometricPressure {
781 0     0 0 0 my $self = shift;
782              
783 0         0 my @baroPressure = $self->read("WRD", 1, 0x00, 4);
784 0 0       0 return undef unless ($self->_valCheck(2, \@baroPressure));
785            
786             # raw barometric pressure reading
787 0         0 my $bp = ($baroPressure[1]*256 + $baroPressure[0])/1000;
788              
789             # subtract baroCal factor, if set
790 0 0       0 if ($self->{isBaroCalSet}) {
791 0         0 $bp -= $self->{baroCal};
792             }
793 0         0 return $bp;
794             }
795              
796             sub setupBaroCal {
797 0     0 0 0 my $self = shift;
798              
799 0         0 my $baroCal = $self->getBaroCal;
800 0 0       0 return undef unless (defined $baroCal);
801              
802             # Note, this will not work for places below sea level, since it
803             # assumes the calibration number should be negative
804 0         0 $self->{baroCal} = -(65536 - $baroCal)/1000;
805 0         0 $self->{isBaroCalSet} = 1;
806 0         0 return;
807             }
808              
809             sub unsetBaroCal {
810 0     0 0 0 my $self = shift;
811              
812 0         0 $self->{isBaroCalSet} = 0;
813 0         0 return;
814             }
815              
816             sub getBaroCal {
817 0     0 0 0 my $self = shift;
818              
819 0         0 my @str_in = $self->read("WRD", 2, 0x2C, 4);
820 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
821              
822 0 0       0 printf "BaroCal=%02x%02x\n", $str_in[1], $str_in[0] if $DEBUG > 1;
823 0         0 return ($str_in[1]*256 + $str_in[0]);
824             }
825              
826             sub getTime{
827 0     0 0 0 my $self = shift;
828              
829 0         0 my @str_in = $self->read("WRD", 1, 0xBE, 6);
830 0 0       0 return undef unless ($self->_valCheck(3, \@str_in));
831              
832 0         0 my $second = bcd2dec($str_in[2]);
833 0         0 my $minute = bcd2dec($str_in[1]);
834 0         0 my $hour = bcd2dec($str_in[0]);
835 0 0       0 printf "Time is %d:%02d:%02d\n", $hour, $minute, $second if $DEBUG > 1;
836 0         0 return ($hour, $minute, $second);
837             }
838              
839             sub getDate {
840 0     0 0 0 my $self = shift;
841              
842 0         0 my @str_in = $self->read("WRD", 1, 0xC8, 6);
843 0 0       0 return undef unless ($self->_valCheck(3, \@str_in));
844              
845 0         0 my $month = $str_in[1];
846 0         0 my $day = bcd2dec($str_in[0]);
847 0 0       0 printf "Date is %d/%02d\n", $month, $day if $DEBUG > 1;
848 0         0 return ($month, $day);
849             }
850              
851             sub getArchivePeriod {
852 0     0 0 0 my $self = shift;
853              
854 0         0 my @str_in = $self->read("RRD", 1, 0x3C, 2);
855 0 0       0 return undef unless ($self->_valCheck(1, \@str_in));
856              
857 0         0 my $period = $str_in[0];
858 0 0       0 printf "Archive Period is %d minutes\n", $period if $DEBUG > 1;
859 0         0 return $period;
860             }
861              
862             sub setArchivePeriod {
863 0     0 0 0 my $self = shift;
864 0         0 my $period = shift;
865              
866 0         0 return $self->write("RWR", 1, 0x3C, 2, $period);
867             }
868              
869             sub getLastArcTime {
870 0     0 0 0 my $self = shift;
871              
872 0         0 my @str_in = $self->read("RRD", 1, 0x48, 4);
873 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
874              
875 0         0 my $minutes = $str_in[1] * 256 + $str_in[0];
876 0 0       0 if ($DEBUG > 1) {
877 0         0 printf "last Archive Time is %d minutes since midnight\n",
878             $minutes;
879             }
880 0         0 return $minutes;
881             }
882              
883             sub setLastArcTime {
884 0     0 0 0 my $self = shift;
885 0         0 my $timeInMin = shift;
886              
887 0         0 return $self->write("RWR", 1, 0x48, 4, $timeInMin);
888             }
889              
890             # New Pointer is the address of the Archive image currently in progress.
891             # Output is in hex format.
892             sub getNewPtr {
893 0     0 0 0 my $self = shift;
894 0         0 my @str_in = $self->read("RRD", 1, 0, 4);
895 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
896              
897 0 0       0 printf "NewPtr=%02x%02x\n", $str_in[1], $str_in[0] if $DEBUG > 1;
898 0         0 return sprintf("%02x%02x", $str_in[1], $str_in[0]);
899             }
900              
901             # Returns the most recently completed archive image address.
902             # Output is in decimal.
903             sub getLastPtr {
904 0     0 0 0 my $self = shift;
905              
906 0         0 my $newPtr = hex($self->getNewPtr);
907 0         0 return (($newPtr - 21) & 0xffff);
908             }
909              
910             # Old Pointer is the address of the oldest completed Archive image.
911             sub getOldPtr {
912 0     0 0 0 my $self = shift;
913 0         0 my @str_in = $self->read("RRD", 1, 4, 4);
914 0 0       0 return undef unless ($self->_valCheck(2, \@str_in));
915              
916 0 0       0 printf "OldPtr=%02x%02x\n", $str_in[1], $str_in[0] if $DEBUG > 1;
917 0         0 return sprintf("%02x%02x", $str_in[1], $str_in[0]);
918             }
919              
920             sub clearHiWind {
921 0     0 0 0 my $self = shift;
922 0         0 return $self->write("WWR", 0, 0x60, 4, 0);
923             }
924              
925             sub clearHiDewPoint {
926 0     0 0 0 my $self = shift;
927 0         0 return $self->write("WWR", 0, 0x8E, 4, 0);
928             }
929              
930             sub clearLoDewPoint {
931 0     0 0 0 my $self = shift;
932 0         0 return $self->write("WWR", 0, 0x92, 4, 1200);
933             }
934              
935             sub clearLoWindChill {
936 0     0 0 0 my $self = shift;
937 0         0 return $self->write("WWR", 0, 0xAC, 4, 1200);
938             }
939              
940             sub clearHiLoOutTemp {
941 0     0 0 0 my $self = shift;
942 0 0       0 unless ($self->write("WWR", 1, 0x5A, 4, 0x8080)) {
943 0         0 return 0;
944             }
945 0         0 return $self->write("WWR", 1, 0x5E, 4, 1200)
946             }
947             sub clearHiLoInTemp {
948 0     0 0 0 my $self = shift;
949 0 0       0 unless ($self->write("WWR", 1, 0x34, 4, 0x8080)) {
950 0         0 return 0;
951             }
952 0         0 return $self->write("WWR", 1, 0x38, 4, 1200)
953             }
954             sub clearHiLoOutHum {
955 0     0 0 0 my $self = shift;
956 0 0       0 unless ($self->write("WWR", 1, 0x9A, 2, 0)) {
957 0         0 return 0;
958             }
959 0         0 return $self->write("WWR", 1, 0x9C, 2, 100)
960             }
961             sub clearHiLoInHum {
962 0     0 0 0 my $self = shift;
963 0 0       0 unless ($self->write("WWR", 1, 0x82, 2, 0)) {
964 0         0 return 0;
965             }
966 0         0 return $self->write("WWR", 1, 0x84, 2, 100)
967             }
968              
969             sub clearDailyRain {
970 0     0 0 0 my $self = shift;
971 0         0 return $self->write("WWR", 1, 0xD2, 4, 0);
972             }
973              
974             sub clearYearlyRain {
975 0     0 0 0 my $self = shift;
976 0         0 return $self->write("WWR", 1, 0xCE, 4, 0);
977             }
978              
979             sub setTime {
980 0     0 0 0 my $self = shift;
981 0         0 my $hour = shift; # 24 hour time
982 0         0 my $min = shift;
983              
984 0         0 my $bcdMin = sprintf("%02d", $min);
985 0         0 my $bcdHour = sprintf("%02d", $hour);
986              
987 0         0 my $hexHour = hex $bcdHour;
988 0 0       0 printf "bcdHour=0x%x \n", $hexHour if $DEBUG > 1;
989 0         0 $wxPort->write("WWR");
990 0         0 $wxPort->write(pack "C", 0x23); # 2 nibbles | bank 1 = 3
991 0         0 $wxPort->write(pack "C", 0xBE); # address
992 0         0 $wxPort->write(pack "C", $hexHour);
993 0         0 $wxPort->write(pack "C", 0xD);
994 0         0 $wxPort->write_done;
995 0 0       0 unless ($self->_get_ack()) {
996 0 0       0 print "setTime: Write not accepted\n" if $DEBUG > 0;
997 0         0 return 0;
998             }
999              
1000 0         0 my $hexMin = hex $bcdMin;
1001 0 0       0 printf "bcdMin=0x%x \n", $hexMin if $DEBUG > 1;
1002 0         0 $wxPort->write("WWR");
1003 0         0 $wxPort->write(pack "C", 0x23); # 2 nibbles | bank 1
1004 0         0 $wxPort->write(pack "C", 0xC0); # address
1005 0         0 $wxPort->write(pack "C", $hexMin);
1006 0         0 $wxPort->write(pack "C", 0xD);
1007 0         0 $wxPort->write_done;
1008 0 0       0 unless ($self->_get_ack()) {
1009 0 0       0 print "setTime: Write not accepted\n" if $DEBUG > 0;
1010             }
1011             }
1012              
1013             # sub setBaroCal {
1014             # my $self = shift;
1015              
1016             # $wxPort->write("WWR");
1017             # $wxPort->write(pack "C", 0x44); # address
1018             # $wxPort->write(pack "C", 0x2C);
1019             # $wxPort->write(pack "S", 0x0);
1020             # $wxPort->write(pack "C", 0xD);
1021             # $wxPort->write_done;
1022              
1023             # }
1024              
1025              
1026             ###################################################################
1027             ## ##
1028             ## Archive Retrieval and Logging Functions ##
1029             ## ##
1030             ###################################################################
1031              
1032             sub getArcImg {
1033 0     0 0 0 my $self = shift;
1034 0         0 my $addr = shift;
1035              
1036             # Flush InBuffer
1037 0         0 $wxPort->purge_rx;
1038              
1039 0         0 $wxPort->write("SRD");
1040 0         0 $wxPort->write(pack "S", $addr); # address
1041 0         0 $wxPort->write(pack "C2", 20); # bytes - 1
1042 0         0 $wxPort->write(pack "C", 0xD);
1043 0         0 $wxPort->write_done;
1044 0 0       0 if ($self->_get_ack()) {
1045 0         0 my @str_in = readData(23); # bytes 22,23 unused (don't know why
1046             # 2 extra bytes come back.
1047              
1048              
1049 0         0 my $baro = ($str_in[1]*256 + $str_in[0])/1000;
1050 0 0       0 if ($self->{isBaroCalSet}) {
1051             # substract baroCal, to compensate for lower absolute pressure at
1052             # higher altitudes
1053 0         0 $baro -= $self->{baroCal};
1054             }
1055 0         0 my $rainInPrd = ($str_in[5]*256 + $str_in[4])/100;
1056 0         0 my $inTemp = $self->tempConv($str_in[6], $str_in[7]);
1057 0         0 my $outTemp = $self->tempConv($str_in[8], $str_in[9]);
1058 0         0 my $outTempHi = $self->tempConv($str_in[12], $str_in[13]);
1059 0         0 my $outTempLo = $self->tempConv($str_in[19], $str_in[20]);
1060 0         0 my $wind = $str_in[10];
1061 0         0 my $avgWindDir = $compass_rose[$str_in[11]];
1062 0         0 my $windGust = $str_in[14];
1063 0 0 0     0 if (($windGust == 0) or ($str_in[11] == 255)) {
1064 0         0 $avgWindDir = "--";
1065             }
1066 0         0 my $inHum = $str_in[2];
1067 0         0 my $outHum = $str_in[3];
1068              
1069             # The TimeStamp field in archive records and in the archive
1070             # image consists of 4 bytes that identify the time and date of the
1071             # stored record, or the current time and date on the station. The
1072             # first byte is the hours (0-23) in BCD, the second is the minutes
1073             # (0-60) in BCD, the third is the day of the month (0-31) in BCD,
1074             # and the fourth is the month (1-12) in binary.
1075 0         0 my $hour = &bcd2dec($str_in[15]);
1076 0 0       0 printf "Hour string %s\n", $str_in[15] if ($DEBUG > 1);
1077 0         0 my $min = &bcd2dec($str_in[16]);
1078 0         0 my $day = &bcd2dec($str_in[17]);
1079 0         0 my $mon = $str_in[18] % 16;
1080              
1081             # my wxlink samples at :02 and :32 min. Convert that to :00 and :30.
1082 0         0 $min -= $sample_offset;
1083              
1084             # Calculate THI
1085 0         0 my $outTHI = $self->calcTHI($outTemp, $outHum);
1086 0         0 my $outTHIHi = $self->calcTHI($outTempHi, $outHum);
1087              
1088             # Calculate Wind Chill
1089 0         0 my $windChillLo = $self->windChill($windGust, $outTemp);
1090 0         0 my $windChill = $self->windChill($wind, $outTemp);
1091 0         0 $self->{windChill} = $windChillLo;
1092              
1093              
1094 0 0       0 if ($DEBUG > 0) {
1095 0 0       0 printf "BaroCal is %s set\n", ($self->{isBaroCalSet}) ? "" : "NOT";
1096 0         0 printf "Avg Inside Temp is %f Degrees F\n", $inTemp;
1097 0         0 printf "Avg Outside Temp is %f Degrees F\n", $outTemp;
1098 0         0 printf "Avg Wind speed is %d\n", $wind;
1099 0         0 printf "Avg Wind dir is %s\n", $avgWindDir;
1100 0         0 printf "Barometer reads %f\n", $baro;
1101 0         0 printf "Inside Humidity is %d\n", $inHum;
1102 0         0 printf "Outside Humidity is %d\n", $outHum;
1103 0         0 printf "Rainfall in Period is %f\n", $rainInPrd;
1104 0         0 printf "Wind gusting to %d mph\n", $windGust;
1105 0         0 printf "Timestamp: %d:%02d on the %d day of the %d month\n",
1106             $hour, $min, $day, $mon;
1107 0         0 printf "Outside Hi Temp: %f\n", $outTempHi;
1108 0         0 printf "Outside Lo Temp: %f\n", $outTempLo;
1109 0         0 printf "Outside THI: %f\n", $outTHI;
1110 0         0 printf "Outside Hi THI: %f\n", $outTHIHi;
1111 0         0 printf "Wind Chill: %f Degrees\n", $windChill;
1112 0         0 printf "Min Wind Chill in Period: %f Degrees\n", $windChillLo;
1113 0         0 printf "Date is %d/%02d, Time is %0d:%02d\n", $mon, $day, $hour, $min;
1114 0         0 my($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $wxPort->status;
1115 0         0 printf "OutBytes=%d\n",$OutBytes;
1116 0         0 printf "InBytes=%d\n",$InBytes;
1117             }
1118            
1119 0         0 $self->{avgOutTemp} = sprintf("%02.1f", $outTemp);
1120 0         0 $self->{loTemp} = sprintf("%02.1f", $outTempLo);
1121 0         0 $self->{hiTemp} = sprintf("%02.1f", $outTempHi);
1122 0         0 $self->{avgInTemp} = sprintf("%02.1f",$inTemp);
1123 0         0 $self->{baro} = sprintf("%5.3f", $baro);
1124 0         0 $self->{avgWindSpeed} = $wind;
1125 0         0 $self->{avgWindDir} = $avgWindDir;
1126 0         0 $self->{windGust} = $windGust;
1127 0         0 $self->{rainInPrd} = sprintf("%3.2f", $rainInPrd);
1128 0         0 $self->{inHum} = $inHum;
1129 0         0 $self->{outHum} = $outHum;
1130 0         0 $self->{date} = $mon . "/" . sprintf("%02d",$day);
1131 0         0 $self->{time} = $hour . ":" . sprintf("%02d", $min);
1132 0         0 $self->{thi} = sprintf "%5.1f", $outTHI;
1133 0         0 $self->{hiTHI} = sprintf "%5.1f", $outTHIHi;
1134 0         0 $self->{windChillLo} = sprintf "%5.1f", $windChillLo;
1135              
1136             # Calculate Dewpoint. Don't return it with array, just store it in class vars.
1137 0         0 my $dpt = $self->calcDewPoint();
1138 0         0 $self->{avgDewpoint} = sprintf "%4.1f", $dpt;
1139              
1140 0         0 return ($inTemp, $outTemp, $outTempHi, $outTempLo, $baro,
1141             $wind, $avgWindDir, $windGust, $rainInPrd, $inHum,
1142             $outHum, $mon, $day, $hour, $min, $outTHI, $outTHIHi,
1143             $windChill, $windChillLo);
1144              
1145             } else { # get_ack failed
1146             # print results
1147 0         0 my($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $wxPort->status;
1148 0         0 printf "OutBytes=%d\n",$OutBytes;
1149 0         0 printf "InBytes=%d\n",$InBytes;
1150 0         0 return 0;
1151             }
1152              
1153              
1154             }
1155              
1156             sub batchRetrieveArchives {
1157 0     0 0 0 my ($self, $num, $file) = @_;
1158              
1159 0         0 my $lastPtr = $self->getLastPtr;
1160 0         0 my $sizeOfBatch = 21 * $num;
1161              
1162             # 21 bytes does not divide evenly into 32K bytes. The last valid
1163             # pointer address is 0x7fe3. The next pointer would be 0x7ff8,
1164             # but it would not have the full 21 bytes before wrapping to
1165             # address 0x0. So an additional 8 bytes are subtracted when
1166             # calculating the wrap address.
1167 0         0 my $firstPtr;
1168 0 0       0 if ($sizeOfBatch > $lastPtr) {
1169 0         0 $firstPtr = ($lastPtr - $sizeOfBatch - 8) & 0x7fff;
1170             } else {
1171 0         0 $firstPtr = $lastPtr - $sizeOfBatch;
1172             }
1173 0         0 printf "firstPtr=%d lastPtr=%d\n", $firstPtr, $lastPtr;
1174 0         0 return $self->updateArchiveFromPtr($firstPtr, $file);
1175             }
1176              
1177             sub updateArchiveFromPtr {
1178 0     0 0 0 my ($self, $lastArchivedPtr, $file) = @_;
1179 0         0 my $i;
1180 0         0 my $rdFailed = 0;
1181 0         0 my $newPtrHex = $self->getNewPtr();
1182 0 0       0 return 0 unless defined $newPtrHex;
1183 0         0 my $newPtr = hex($newPtrHex) - 21;
1184            
1185 0         0 $lastArchivedPtr += 21;
1186 0 0       0 if ($lastArchivedPtr > 0x7FFF) {
1187 0         0 $lastArchivedPtr -= 0x7FFF;
1188             }
1189              
1190             # Push $file using local
1191 0         0 local $self->{archiveLogFile} = $file;
1192            
1193 0 0       0 printf "Update from %x to %x\n", $lastArchivedPtr, $newPtr
1194             if $DEBUG > 0;
1195             # test for address wrapping here
1196 0 0       0 if ($newPtr < $lastArchivedPtr) {
1197             # Last valid ptr addr = 0x7fe3. 0x7ff8 is NOT valid.
1198 0         0 for ($i=$lastArchivedPtr; $i < 0x7FF8; $i+=21) {
1199 0 0       0 unless ($self->getArcImg($i)) {
1200 0         0 $rdFailed = 1;
1201 0         0 last;
1202             }
1203 0         0 $self->archiveCurImage();
1204 0 0       0 printf "Archived address %x\n",$i if $DEBUG > 0;
1205             }
1206 0         0 $lastArchivedPtr = 0;
1207             }
1208              
1209 0 0       0 return 0 if $rdFailed;
1210 0         0 for ($i=$lastArchivedPtr; $i <= $newPtr; $i+=21) {
1211 0         0 $self->getArcImg($i);
1212             #unless ($self->getArcImg($i)) {
1213             # return 0;
1214             #}
1215 0         0 $self->archiveCurImage();
1216 0 0       0 printf "Archived address %x\n",$i if $DEBUG > 0;
1217             }
1218 0         0 return 1;
1219             }
1220              
1221             ##
1222             ## `getSensorImage' enables a continuous streaming of 18 byte chunks of
1223             ## weather data from the Davis Wx Station. I've found this stream to be
1224             ## very easy to get out of sync, so this funcion read a single 18 byte chunk,
1225             ## stops the streaming, and flushes the serial Rx buffer
1226             ##
1227             sub getSensorImage {
1228             ##### LOOP ######
1229             # Monitor, Wizard, and Perception Sensor Image:
1230             # start of block 1 byte
1231             # inside temperature 2 bytes
1232             # outside temperature 2 bytes
1233             # wind speed 1 byte
1234             # wind direction 2 bytes
1235             # barometer 2 bytes
1236             # inside humidity 1 byte
1237             # outside humidity 1 byte
1238             # total rain 2 bytes
1239             # not used 2 bytes
1240             # CRC checksum 2 bytes
1241             # --------
1242             # 18 bytes
1243             #################
1244 0     0 0 0 my $self = shift;
1245              
1246 0         0 $wxPort->write("LOOP");
1247             # $wxPort->write(pack "C2", 65535); # doesn't work in perl 5.8
1248 0         0 $wxPort->write(pack "C2", 255, 255);
1249 0         0 $wxPort->write(pack "C", 0xD);
1250              
1251 0 0       0 return undef unless ($self->_get_ack());
1252              
1253 0         0 my ($count, $string_in) = $wxPort->read(16);
1254 0 0 0     0 warn "read unsuccessful\n" unless (($count == 16) && ($DEBUG > 0));
1255              
1256 0         0 my @str_in = unpack "C16", $string_in;
1257 0         0 my $inTemp = $self->tempConv($str_in[1], $str_in[2]);
1258 0         0 my $outTemp = $self->tempConv($str_in[3], $str_in[4]);
1259 0         0 my $baro = ($str_in[9]*256 + $str_in[8])/1000;
1260 0 0       0 if ($self->{isBaroCalSet}) {
1261             # subtract baroCal, to compensate for lower absolute pressure at
1262             # higher altitudes
1263 0         0 $baro -= $self->{baroCal};
1264             }
1265 0         0 my $tot_rain = ($str_in[13]*256 + $str_in[12])/100;
1266 0         0 my $wind = $str_in[5];
1267 0         0 my $windAdjDir = ($str_in[7]*256 + $str_in[6] + 11) % 360;
1268 0         0 my $windDirDegree = $windAdjDir;
1269 0         0 my $windDirDeg16 = int $windDirDegree/22.5;
1270 0         0 my $windDir = $compass_rose[$windDirDeg16];
1271 0         0 my $inHum = $str_in[10];
1272 0         0 my $outHum = $str_in[11];
1273 0 0       0 if ($DEBUG > 1) {
1274 0         0 printf "Inside Temp is %f Degrees F\n", $inTemp;
1275 0         0 printf "Outside Temp is %f Degrees F\n", $outTemp;
1276 0         0 printf "Wind speed is %d\n", $wind;
1277 0         0 printf "Wind dir is %d\n", $windDir;
1278 0         0 printf "Barometer reads %f\n", $baro;
1279 0         0 printf "Inside Humidity is %d%\n", $inHum;
1280 0         0 printf "Outside Humidity is %d%\n", $outHum;
1281 0         0 printf "Total rainfall is %f\n", $tot_rain;
1282             }
1283 0         0 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
1284 0         0 $self->{outTemp} = sprintf("%02.1f", $outTemp);
1285 0         0 $self->{inTemp} = sprintf("%02.1f",$inTemp);
1286 0         0 $self->{baro} = sprintf("%5.3f", $baro);
1287 0         0 $self->{windSpeed} = $wind;
1288 0         0 $self->{windDir} = $windDir;
1289 0         0 $self->{rainTotal} = sprintf("%3.2f", $tot_rain);
1290 0         0 $self->{inHum} = $inHum;
1291 0         0 $self->{outHum} = $outHum;
1292 0         0 $self->{date} = $mon+1 . "/" . sprintf("%02d",$mday);
1293 0         0 $self->{time} = $hour . ":" . sprintf("%02d", $min);
1294              
1295             # Stops loop
1296             #&getOutsideTemp();
1297            
1298             # Wayne Hahn suggested a sleep 1 here to pace the loop.
1299 0         0 sleep 1;
1300              
1301             # issues command and ignore data, ack.
1302 0         0 $wxPort->write("RRD");
1303 0         0 $wxPort->write(pack "C", 1); # bank
1304 0         0 $wxPort->write(pack "C", 0x20); # address
1305 0         0 $wxPort->write(pack "C", 3); # nibbles - 1
1306 0         0 $wxPort->write(pack "C", 0xD);
1307 0         0 $wxPort->write_done;
1308              
1309             # Flush InBuffer
1310 0         0 $wxPort->purge_rx;
1311              
1312             # Return array with all items
1313 0         0 return ($inTemp, $outTemp, $wind, $windDir, $baro, $inHum, $outHum,
1314             $tot_rain);
1315             }
1316              
1317             ###############################################################################
1318             ##
1319             ## Subroutines for the Periodic Data Samples Log
1320             ##
1321             ###############################################################################
1322              
1323             ## Prints Header for the periodic samples log file
1324             sub printRawLogHeader {
1325 0     0 0 0 my $self = shift;
1326             # my $file = shift;
1327              
1328 0         0 my $log = new FileHandle ">>$self->{archiveLogFile}";
1329 0 0       0 unless (defined $log) {
1330 0         0 carp "Could not open $self->{archiveLogFile}";
1331             }
1332 0         0 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
1333              
1334 0         0 printf $log " Wx Log for the Year %d\n", $year+1900;
1335 0         0 print $log "$self->{stationDescription}\n\n";
1336 0         0 print $log " TH Temp Wind Hi Low Hum Dew Wind Temp Hum
1337             Date Time Index Out Chill Temp Temp Out Pt. Speed Hi Dir Rain Bar In In
1338             ----------------------------------------------------------------------------------------------------------\n";
1339              
1340 0         0 $log->close();
1341             }
1342              
1343             ##
1344             ## archiveCurImage
1345             ##
1346             ## Writes the periodic data samples to a file (arg)
1347             ##
1348             sub archiveCurImage {
1349 0     0 0 0 my $self = shift;
1350             # my $file = shift;
1351            
1352 0         0 my $rain = sprintf("%1.2f", $self->{rainTotal});
1353              
1354             ## Note: I'm recording the min wind chill in the period, based on the
1355             ## max wind gust and the average temp in the period
1356 0         0 my @log_data = ($self->{date},
1357             $self->{time},
1358             $self->{thi},
1359             $self->{avgOutTemp},
1360             $self->{windChillLo},
1361             $self->{hiTemp},
1362             $self->{loTemp},
1363             $self->{outHum},
1364             $self->{avgDewpoint},
1365             $self->{avgWindSpeed},
1366             $self->{windGust},
1367             $self->{avgWindDir},
1368             $self->{rainInPrd},
1369             $self->{baro},
1370             $self->{avgInTemp},
1371             $self->{inHum});
1372              
1373             ##
1374             ## format of data lines in periodic samples log file
1375             ##
1376             format LOG =
1377             @<<<< @>>>> @>>>> @>>>> @>>>>> @>>>> @>>>> @>> @>>>> @>>> @>>> @>> @>>>> @<<<<< @>>>> @>>
1378             @log_data
1379             .
1380              
1381 0         0 my $log = new FileHandle ">> $self->{archiveLogFile}";
1382 0 0       0 unless (defined $log) {
1383 0         0 carp "Could not open $self->{archiveLogFile}";
1384             }
1385              
1386 0         0 $log->format_name("LOG");
1387             #$log->format_top_name("LOG_TOP");
1388              
1389 0         0 write $log;
1390 0         0 $log->close;
1391              
1392             }
1393              
1394             ################################################################################
1395             # Weather Calculations (windchill, temp humidity index)
1396             ################################################################################
1397             #
1398             # New US/Can Wind Chill - 11/01/2001
1399             #
1400             # temp in degrees F
1401             # speed in mph
1402             #
1403             sub windChill {
1404 2     2 0 2195 my $self = shift;
1405 2         3 my $speed = shift;
1406 2         4 my $temp = shift;
1407 2         4 my $chill;
1408              
1409 2 50 33     15 if (($speed < 4) || ($temp > 50)) {
1410 0         0 $chill = $temp;
1411             } else {
1412 2         23 my $v016 = $speed ** 0.16;
1413              
1414 2         7 $chill = 35.74 + (0.6215 * $temp) - (35.75 * $v016) +
1415             (0.4275 * $temp * $v016);
1416             }
1417 2         5 return $chill;
1418             }
1419              
1420             # old windchill formula
1421             sub oldWindChill {
1422 0     0 0 0 my $self = shift;
1423 0         0 my $speed = $self->{windSpeed};
1424 0         0 my $temp = $self->{outTemp};
1425 0         0 my $chill;
1426 0         0 my @chillTableOne = (156, 151, 146, 141, 133, 123, 110, 87, 61, 14, 0);
1427 0         0 my @chillTableTwo = (0, 16, 16, 16, 25, 33, 41, 74, 82, 152, 0);
1428              
1429 0 0       0 $speed = 50 if $speed > 50;
1430              
1431 0         0 my $index = int (10 - $speed/5);
1432 0         0 my $cf = $chillTableOne[$index] +
1433             ($chillTableTwo[$index] / 16) * ($speed % 5);
1434 0 0       0 if ($temp < 91.4) {
1435 0         0 $chill = $cf * (($temp - 91.4) / 256) + $temp;
1436             } else {
1437 0         0 $chill = $temp;
1438             }
1439 0         0 return $chill;
1440             }
1441              
1442             sub calcDewPoint {
1443 0     0 0 0 my $self = shift;
1444 0         0 my $temp = $self->{avgOutTemp};
1445 0         0 my $rh = $self->{outHum};
1446 0 0       0 printf "rh=%d temp=%1.1f\n", $rh, $temp if $DEBUG > 0;
1447 0         0 my $tempc = (5.0/9.0)*($temp-32.0);
1448 0         0 my $es = 6.11 * 10.0 ** (7.5 * $tempc / (237.7 + $tempc));
1449 0         0 my $e = ($rh * $es) / 100.0;
1450 0         0 my $dewc = (-430.22 + 237.7 * log($e)) / (19.08 - log($e));
1451 0         0 my $dp = (9.0/5.0) * $dewc + 32;
1452 0 0       0 printf "tempc=%3.1f es=%4.2f e=%4.2f dewc=%3.1f\n",
1453             $tempc, $es, $e, $dewc if $DEBUG > 1;
1454 0 0       0 printf " dp=%3.1f\n", $dp if $DEBUG > 0;
1455 0         0 return $dp;
1456             }
1457              
1458             my @thiTable =
1459             (
1460             [ 61, 63, 63, 64, 66, 66, 68, 68, 70, 70, 70], # 68
1461             [ 63, 64, 65, 65, 67, 67, 69, 69, 71, 71, 72], # 69
1462             [ 65, 65, 66, 66, 68, 68, 70, 70, 72, 72, 74], # 70
1463             [ 66, 66, 67, 67, 69, 69, 71, 71, 73, 73, 75], # 71
1464             [ 67, 67, 68, 69, 70, 71, 72, 72, 74, 74, 76], # 72
1465             [ 68, 68, 69, 71, 71, 73, 73, 74, 75, 75, 77], # 73
1466             [ 69, 69, 70, 72, 72, 74, 74, 76, 76, 76, 78], # 74
1467             [ 70, 71, 71, 73, 73, 75, 75, 77, 77, 78, 79], # 75
1468             [ 71, 72, 73, 74, 74, 76, 76, 78, 79, 80, 80], # 76
1469             [ 72, 73, 75, 75, 75, 77, 77, 79, 81, 81, 82], # 77
1470             [ 74, 74, 76, 76, 77, 78, 79, 80, 82, 83, 84], # 78
1471             [ 75, 75, 77, 77, 79, 79, 81, 81, 83, 85, 87], # 79
1472             [ 76, 76, 78, 78, 80, 80, 82, 83, 85, 87, 90], # 80
1473             [ 77, 77, 79, 79, 81, 81, 83, 85, 87, 89, 93], # 81
1474             [ 78, 78, 80, 80, 82, 83, 84, 87, 89, 92, 96], # 82
1475             [ 79, 79, 81, 81, 83, 85, 85, 89, 91, 95, 99], # 83
1476             [ 79, 80, 81, 82, 84, 86, 87, 91, 94, 98,103], # 84
1477             [ 80, 81, 81, 83, 85, 87, 89, 93, 97,101,108], # 85
1478             [ 81, 82, 82, 84, 86, 88, 91, 95, 99,104,113], # 86
1479             [ 82, 83, 83, 85, 87, 90, 93, 97,102,109,120], # 87
1480             [ 83, 84, 84, 86, 88, 92, 95, 99,105,114,131], # 88
1481             [ 84, 84, 85, 87, 90, 94, 97,102,109,120,144], # 89
1482             [ 84, 85, 86, 89, 92, 95, 99,105,113,128,150], # 90
1483             [ 84, 86, 87, 91, 93, 96,101,108,118,136,150], # 91
1484             [ 85, 87, 88, 92, 94, 98,104,112,124,144,150], # 92
1485             [ 86, 88, 89, 93, 96,100,107,116,130,150,150], # 93
1486             [ 87, 89, 90, 94, 98,102,110,120,137,150,150], # 94
1487             [ 88, 90, 91, 95, 99,104,113,124,144,150,150], # 95
1488             [ 89, 91, 93, 97,101,107,117,128,150,150,150], # 96
1489             [ 90, 92, 95, 99,103,110,121,132,150,150,150], # 97
1490             [ 90, 93, 96,100,105,113,125,150,150,150,150], # 98
1491             [ 90, 94, 97,101,107,116,129,150,150,150,150], # 99
1492             [ 91, 95, 98,103,110,119,133,150,150,150,150], # 100
1493             [ 92, 96, 99,105,112,122,137,150,150,150,150], # 101
1494             [ 93, 97,100,106,114,125,150,150,150,150,150], # 102
1495             [ 94, 98,102,107,117,128,150,150,150,150,150], # 103
1496             [ 95, 99,104,109,120,132,150,150,150,150,150], # 104
1497             [ 95,100,105,111,123,135,150,150,150,150,150], # 105
1498             [ 95,101,106,113,126,150,150,150,150,150,150], # 106
1499             [ 96,102,107,115,130,150,150,150,150,150,150], # 107
1500             [ 97,103,108,117,133,150,150,150,150,150,150], # 108
1501             [ 98,104,110,119,137,150,150,150,150,150,150], # 109
1502             [ 99,105,112,122,142,150,150,150,150,150,150], # 110
1503             [100,106,113,125,150,150,150,150,150,150,150], # 111
1504             [100,107,115,128,150,150,150,150,150,150,150], # 112
1505             [100,108,117,131,150,150,150,150,150,150,150], # 113
1506             [101,109,119,134,150,150,150,150,150,150,150], # 114
1507             [102,110,121,136,150,150,150,150,150,150,150], # 115
1508             [103,111,123,140,150,150,150,150,150,150,150], # 116
1509             [104,112,125,143,150,150,150,150,150,150,150], # 117
1510             [105,113,127,150,150,150,150,150,150,150,150], # 118
1511             [106,114,129,150,150,150,150,150,150,150,150], # 119
1512             [107,116,131,150,150,150,150,150,150,150,150], # 120
1513             [108,117,133,150,150,150,150,150,150,150,150], # 121
1514             [108,118,136,150,150,150,150,150,150,150,150] # 122
1515             );
1516              
1517             ## Temperature Humidity Index
1518             ##
1519             ## Temp in degrees F
1520             ## Humidity is an integer from 0 to 100 inclusive
1521             sub calcTHI {
1522 2     2 0 1093 my $self = shift;
1523 2         3 my $temp = shift;
1524 2         4 my $hum = shift;
1525              
1526 2         5 my $loHumIdx = int $hum/10;
1527 2 50       7 my $hiHumIdx = ($loHumIdx == 10) ? 10 : $loHumIdx + 1;
1528              
1529 2         3 my $t = int $temp - 68;
1530 2         5 my $t_frac = $temp - $t - 68;
1531              
1532 2         3 my ($loTHI, $hiTHI, $lt_thi, $ht_thi, $thi);
1533 2 50       5 if ($t >= 0) {
1534             # low temp thi
1535 2         5 $loTHI = $thiTable[$t][$loHumIdx];
1536 2         3 $hiTHI = $thiTable[$t][$hiHumIdx];
1537 2         5 my $hifract = $hum - $loHumIdx * 10;
1538 2         3 my $lofract = 10 - $hifract;
1539              
1540 2         3 $lt_thi = ($loTHI * $lofract + $hiTHI * $hifract) / 10;
1541              
1542             # hi temp thi
1543 2         5 $loTHI = $thiTable[$t+1][$loHumIdx];
1544 2         3 $hiTHI = $thiTable[$t+1][$hiHumIdx];
1545 2         3 $hifract = $hum - $loHumIdx * 10;
1546 2         3 $lofract = 10 - $hifract;
1547              
1548 2         3 $ht_thi = ($loTHI * $lofract + $hiTHI * $hifract) / 10;
1549              
1550 2         2 $hifract = $t_frac;
1551 2         4 $lofract = 10 - $hifract;
1552 2         4 $thi = ($lt_thi * $lofract + $ht_thi * $hifract) / 10;
1553              
1554 2         8 return $thi;
1555             } else {
1556 0           return $temp;
1557             }
1558             }
1559              
1560             ###############################################################################
1561             ##
1562             ## Utility functions
1563             ##
1564             ###############################################################################
1565              
1566             # Converts BCD format numbers to decimal numbers
1567             sub bcd2dec {
1568 0     0 0   my $byteIn = shift;
1569              
1570 0           my $hexIn = unpack "H2", (pack "C", $byteIn);
1571 0 0         printf "hexIn=%s\n", $hexIn if ($DEBUG > 2);
1572              
1573 0           my @hex_in = split "", $hexIn;
1574 0           my $decOut = $hex_in[0]*10 + $hex_in[1];
1575 0           return $decOut;
1576              
1577             }
1578              
1579             sub tempConv {
1580 0     0 0   my $self = shift;
1581 0           my @t = @_;
1582 0           my $tn;
1583              
1584 0           my $ts = $t[1]*256 + $t[0];
1585 0 0         if ($ts > 32767) {
1586 0           $tn = ((~$ts & 0xFFFF) +1) * -1;
1587 0           return $tn/10;
1588             } else {
1589 0           return $ts/10;
1590             }
1591             }
1592              
1593             # used to retrieve the time and date of the min/max of a reading,
1594             # eg. to get the time/date of the high outside temperature
1595             sub readTimeDate {
1596 0     0 0   my $self = shift;
1597 0           my ($bankTime, $addrTime, $bankDate, $addrDate) = @_;
1598              
1599 0           my @str_in = $self->read("WRD", $bankTime, $addrTime, 4);
1600 0 0         return undef unless ($self->_valCheck(2, \@str_in));
1601              
1602 0           my $hour = &bcd2dec($str_in[0]);
1603 0           my $min = &bcd2dec($str_in[1]);
1604 0           @str_in = $self->read("WRD", $bankDate, $addrDate, 4);
1605 0 0         return undef unless ($self->_valCheck(2, \@str_in));
1606 0           my $day = &bcd2dec($str_in[0]);
1607 0           my $mon = $str_in[1] % 16;
1608 0           return ($hour, $min, $mon, $day);
1609             }
1610              
1611             sub whichYear {
1612 0     0 0   my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
1613 0           $year += 1900;
1614 0           return $year;
1615             }
1616              
1617             ################################################################################
1618             ## Low Level Calls
1619             ##
1620             ## These perform the actual read/write accesses to the Davis Wx Station
1621             ##
1622             ################################################################################
1623              
1624             sub read {
1625 0     0 0   my $self = shift;
1626 0           my ($cmd, $bank, $addr, $nibbles) = @_;
1627 0           my $bankNibble;
1628              
1629 0           $_ = $cmd;
1630             CASE: {
1631 0 0         /WRD/ and do {
  0            
1632 0           $bankNibble = $nibbles * 16;
1633 0 0         $bankNibble += ($bank) ? 4 : 2;
1634            
1635 0 0         printf "bankNibble=%x, addr=%x, cmd=%s\n",
1636             $bankNibble, $addr, $cmd if $DEBUG > 1;
1637 0           $wxPort->write("WRD");
1638 0           $wxPort->write(pack "C", $bankNibble); # 4 nibles | bank 1
1639 0           $wxPort->write(pack "C", $addr); # address
1640 0           $wxPort->write(pack "C", 0xD);
1641 0           $wxPort->write_done;
1642 0           last CASE;
1643             };
1644 0 0         /RRD/ and do {
1645 0           $wxPort->write("RRD");
1646 0           $wxPort->write(pack "C", $bank); # bank
1647 0           $wxPort->write(pack "C", $addr); # address
1648 0           $wxPort->write(pack "C", $nibbles-1); # nibbles - 1
1649 0           $wxPort->write(pack "C", 0xD);
1650 0           $wxPort->write_done;
1651 0           last CASE;
1652             };
1653             }
1654 0 0         if ($self->_get_ack()) {
1655 0           my @str_in = readData($nibbles/2);
1656 0 0         unless ($self->_valCheck($nibbles/2, \@str_in)) {
1657 0           return undef;
1658             }
1659 0           return @str_in;
1660             } else {
1661             # print results
1662 0           my($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $wxPort->status;
1663 0 0         if ($DEBUG > 1) {
1664 0           printf "OutBytes=%d\n",$OutBytes;
1665 0           printf "InBytes=%d\n",$InBytes;
1666             }
1667 0           return undef;
1668             }
1669             }
1670              
1671              
1672             sub write {
1673 0     0 0   my $self = shift;
1674 0           my ($cmd, $bank, $addr, $nibbles, $data) = @_;
1675 0           my $nibbleBank;
1676              
1677 0           $_ = $cmd;
1678             CASE: {
1679 0 0         /WWR/ and do {
  0            
1680 0           $nibbleBank = $nibbles * 16 + 2 * $bank + 1;
1681 0           $wxPort->write("WWR");
1682             # 4 nibles | bank 0=1 for writes
1683 0           $wxPort->write(pack "C", $nibbleBank);
1684 0           $wxPort->write(pack "C", $addr); # address
1685 0           $wxPort->write(pack "S", $data);
1686 0           $wxPort->write(pack "C", 0xD);
1687 0           $wxPort->write_done;
1688 0           last CASE;
1689             };
1690 0 0         /RWR/ and do {
1691 0           my $bankNibble = $bank * 16 + $nibbles;
1692 0           $wxPort->write("RWR");
1693 0           $wxPort->write(pack "C", $bankNibble); # bank|nibble
1694 0           $wxPort->write(pack "C", $addr); # address
1695 0           $wxPort->write(pack "S", $data); # data
1696 0           $wxPort->write(pack "C", 0xD);
1697 0           $wxPort->write_done;
1698 0           last CASE;
1699             };
1700             }
1701 0 0         unless ($self->_get_ack()) {
1702 0 0         print "write failed\n" if $DEBUG > 0;
1703 0           return 0;
1704             }
1705 0           return 1;
1706             }
1707              
1708             sub readData {
1709 0     0 0   my $bytes = shift;
1710              
1711 0           my ($count, $string_in) = $wxPort->read($bytes);
1712 0 0         unless ($count == $bytes) {
1713 0 0         carp "readData: read unsuccessful\n" if $DEBUG > 0;
1714 0           return undef;
1715             }
1716 0           my $packStr = "C" . $bytes;
1717 0           return (unpack $packStr, $string_in);
1718             }
1719              
1720             sub _get_ack {
1721 0     0     my $self = shift;
1722 0           my $j=0;
1723              
1724             ## uses blocking read()
1725 0           my ($count, $gotit) = $wxPort->read(1);
1726            
1727 0 0         if ($count == 0) {
1728 0 0         carp "No data read\n" if $DEBUG > 0;
1729 0 0         printf "read cound is %d\n", $count
1730             if ($DEBUG > 1);
1731 0           return 0;
1732             }
1733              
1734 0           my $readChar = unpack "C", $gotit;
1735 0 0         if ($readChar == 33) {
    0          
    0          
1736 0 0         carp "Got a Neg Ack\n" if $DEBUG > 0;
1737 0 0         printf "readChar=%d..%s.. j=%d\n",$readChar,$readChar, $j
1738             if $DEBUG > 1;
1739 0           return 0;
1740             } elsif ($readChar == 24) {
1741 0 0         carp "Command not understood\n" if $DEBUG > 0;
1742 0 0         printf "readChar=%d..%s.. j=%d\n",$readChar,$readChar, $j
1743             if $DEBUG > 1;
1744 0           return 0;
1745             } elsif ($readChar == 6) {
1746             # Ack received
1747 0           return 1;
1748             } else {
1749 0 0         carp "Didn't match the expected return value\n" if $DEBUG > 0;
1750 0 0         printf "readChar=%d..%s.. j=%d\n",$readChar,$readChar, $j
1751             if $DEBUG > 1;
1752 0           return 0;
1753             }
1754             }
1755              
1756             sub _valCheck {
1757 0     0     my $self = shift;
1758 0           my $len = shift;
1759 0           my $array = shift;
1760              
1761 0 0         if ($len != scalar @$array) {
1762 0           return 0;
1763             }
1764 0           my $i = 0;
1765 0           while ($i < $len) {
1766 0 0         unless (defined $$array[$i++]) {
1767 0           return 0;
1768             }
1769             }
1770 0           return 1;
1771             }
1772              
1773             1;