The LaCrosse Technology WS-2010-13 PC Interface: PERL on a PC

|

If you stumbled across this blog looking for information on the WS-2010-13 PC interface, then, man! are you in luck!

A previous entry here shows the code I use with an mbed processor to do the posting to a database on a webserver. If you have a Linux or Windows box, however, the code below might do you a bit of good. If not, then… well, keep hacking!

(Note: I just discovered that Feedbin mangles the code a bit. If you’re getting the code via an RSS reader, you might not be seeing the code in its entirety. Visit the source article for an unadulterated copy of the code.)


#!/usr/bin/perl -w
#


# WeatherStationInterface.cpp
# An interface for the LaCrosse Technology WS-2010-13 PC Interface.

# Copyright (C)2012 William N. Eccles

# Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
# documentation files (the "Software"), to deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit
# persons to whom the Software is furnished to do so, subject to the following conditions:

# The above copyright notice and this permission notice shall be includied in all copies or substiantial portions of the
# Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
# ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECITON WITH
# THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.


use Win32::SerialPort;
use LWP::UserAgent;

# found these items somehwere--maybe it was from the original LCT docs, but I'm not sure
#define SOH 0x01
#define STX 0x02
#define ETX 0x03
#define EOT 0x04
#define ENQ 0x05
#define ACK 0x06
#define DLE 0x10
#define DC2 0x12
#define DC3 0x13
#define NAK 0x15

# command:     
# @commands = (
#   "\x01\x30\xcf\x04", # '0' = Poll DCF time 
#   "\x01\x31\xce\x04", # '1' = Request dataset 
#   "\x01\x32\xcd\x04", # '2' = Select next dataset 
#   "\x01\x33\xcc\x04", # '3' = Activate 9 temperature sensors 
#   "\x01\x34\xcb\x04", # '4' = Activate 16 temperature sensors 
#   "\x01\x35\xca\x04", # '5' = Request status 
#   "\x01\x36\x53\xc9\x04"  # '6' = Set interval time 
# );

# some utility routines

# return the high nybble of a byte in the low nybble

sub H {
    my( $byte )= $_[0];
    return $byte>>4;
}

# retun an usigned high nybble of a byte in the low nybble
sub HS {
    my( $byte )= $_[0];
    return ($byte >> 4) & 0x07;
}

# return the sign of a byte
sub S {
    my( $byte )= $_[0];
    $byte = ($byte & 0x0F) >> 3;
    return (($byte==1) ? -1 : 1);
}

# return the low nybble of a byte
sub L {
    my( $byte )= $_[0];
    $byte = ($byte & 0x0F);
    return $byte;
}

# return an unsigned low nybble of a byte
sub LS {
    my( $byte ) = $_[0];
    $byte = ($byte & 0x07);
    return $byte;
}

# make the WS2010 sleep. Show a debug message while we're at it.
sub gotosleep {

    print "telling WS2010 to sleep.\n";
    $ob->dtr_active(F);
    return;
}

# wake up the WS2010. Print lots of debugging stuff while doing it.
sub wakeup {

    # make a low->high transition on DTR to let WS2010 know we're here.

    $ob->rts_active(No);
    $ob->dtr_active(F);
    $ob->dtr_active(T);

    ($count, $result) = $ob->read(2);

    $count = length($result);
# debug
    print "Wokeup WS2010 and received ",$count," characters.\n";        
    print join(" ",unpack("C*",$result)),"\n";
# gubed

    @return = unpack("C*",$result);

# debug
    if (@return!=1) {
        warn "Invalid number of characters received on wakeup.\n";
    }

    if ($return[0]!=3) {
        warn "WS2010 returned invalid wakeup signal. \n";
    } else {
        print "WS2010 is ready.\n";
    }
# gubed
}


#
# main program
#

print "Opening serial port...\n";

# for now, we'll assume that some other program (such as WS-2010 PC) has been
# used to set the polling interval and number of sensors. We'll write one
# that will be used someday.
# The problem is that if you do this every time this program is run, it
# clears the history stored in the WS2010. I think it's just a matter of
# sending command #3 (or #4) and #6. Come to think of it, I don't think
# I've ever recorded and examined this transaction.  

# open the com port
$ob = Win32::SerialPort->new ('COM1');

die "Can't open serial port COM1: $^E\n" unless ($ob);

# setup the serial port. Die with meaningless message if we don't succeed.  
$ob->baudrate(9600) || die "Failed to set the baudrate. Dunno' why.\n";
$ob->parity("even") || die "Failed to set the parity. Dunno' why.\n";
$ob->databits(8) || die "Failed to set the databits. Dunno' why.\n";
$ob->stopbits(2) || die "Failed to set the stopbits. Dunno' why.\n";
$ob->handshake("none") || die "Failed to set the handshake.\n"; 
$ob->write_settings || die "Failed to write settings to port. Dunno' why.\n";

# debug
    my($baudrate) = $ob->baudrate;
    my($parity) = $ob->parity;
    my($databits) = $ob->databits;
    my($stopbits) = $ob->stopbits;
    print "$ob opened at $baudrate/$databits/$parity/$stopbits\n";
# gubed

$ob->read_interval(100);
$ob->read_const_time(5000);

#
# the big loop
# each time through the loop:
#   wait six minutes (unless it's the first time through this loop)
#   open the com port
#   read data and post it until it's all gone
#   close the com port
#
# There's enough debugging stuff in here that I won't bother with labeling it.
# Suffice it to say, it's all the "print" stuff, none of which is required for
# proper operation of the system.

$first = 1;

while (1) {

    if (!$first) {
        print "Sleeping for a long time...\n";
        gotosleep();
        $i=10;
        while ($i>=1) {
            print $i,"...\n";
            sleep(120);
            $i=$i-1;
        }
        print "0.\n";
        sleep(1);

    }
    $first = 0;

    $haveData = 1;


    while ($haveData) {

        # request a data block

        wakeup();

        print "Requesting data.\n";

        $ob->write("\x01\x31\xce\x04");

        ($count, $result) = $ob->read(100);

        $count = length($result);

        print $count," characters returned:\n";

        print join(" ",unpack("C*",$result)),"\n";

        @return = unpack("C*",$result);


        if ((@return==0)||($return[0]!=2)||($return[@return-1]!=3)) {
            warn "Bad dataset received or no data found.\n";
            $ob->purge_rx;
            $haveData = 0; # quit asking for data--give a cooloff time
        } elsif (($return[1]==1)&($return[2]==16)) {
            print "No data available.\n";
            $haveData = 0;
        } else {
            # select the next data block
            print "Requesting next block.\n";
            $ob->write("\x01\x32\xcd\x04");
            ($count, $newresult) = $ob->read(5);
            print $count," characters returned:\n";
            print join(" ",unpack("C*",$newresult)),"\n";
            @newreturn = unpack("C*",$newresult);
            if (($newreturn[2]==16)&($newreturn[1]==1)) {
                print "No dataset ready.\n";
                $haveData = 0; # no data to be had
            }


            # strip out the ENQ escape sequences and leading STX and length, trailing ETX
            @stripped = ();
            for ($i=2; $i<@return-2; $i++) {    
                if ($return[$i]==0x05) {
                    @stripped = (@stripped, $return[$i+1]-0x10);
                    $i++;
                } else {
                    @stripped = (@stripped, $return[$i]);
                }
            }
            print "Dataset read.\n";
            @return = @stripped;
            print join(" ",@return),"\n";


            $db = $return[1]*256+$return[0];
            $dt = $return[3]*256+$return[2];
            ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time-($dt*60));
            $year=1900+$year;
            $mon++;

            printf "dataset %06d %06d %04d/%02d/%02d:%02d%02d\n",$db,$dt,$year,$mon,$mday,$hour,$min;
            $getstr=sprintf("http://example.com/yourQuery.php?loc=12345&dataset=%06d&datetime=%04d-%02d-%02d%%20%02d:%02d:00",$db,$year,$mon,$mday,$hour,$min);

            ($i, $i, $i, @return) = @return;
            # I know, there's probably a better way to do it... strip off header info.

# each reading consists of the reading itself and whether or not it's a new or old value.
# variable names are somewhat consistent with this.

            $t1c = (LS($return[2])*10+H($return[1])+L($return[1])/10)*S(L($return[2]));
            $t1f = 9/5*$t1c+32;
            $h1 = LS($return[3])*16+H($return[2]);
            $n1 = (S(L($return[3]))==-1) ? "NEW" : "OLD";

            if ($t1f>70) {
                $hif = -42.379+2.04901523*$t1f+10.14333127*$h1-0.22475541*$t1f*$h1-
                    ((6.83783e-3)*$t1f*$t1f)-((5.481717e-2)*$h1*$h1)+
                    ((1.22874e-3)*$t1f*$t1f*$h1)+((8.5282e-4)*$t1f*$h1*$h1)-
                    ((1.99e-6)*$t1f*$t1f*$h1*$h1);
                $hic = ($hif-32)*5/9;
            } else {
                $hif = $t1f;
                $hic = $t1c;
            } 
            $getstr .= "&t1=$t1f&h1=$h1&n1=$n1&hif=$hif&hic=$hic";

        #   print "S1: $t1f∫F $h1% $n1\n";
            print "HI: $hif∫F $hic∫C\n"; 

            $tic = (LS($return[29])*10+H($return[28])+L($return[28])/10)*S(L($return[29]));
            $tif = 9/5*$tic+32;
            $hi = LS($return[30])*16+H($return[29]);
            $ni = (S(L($return[30]))==-1) ? "NEW" : "OLD";

            $getstr .= "&ti=$tif&hi=$hi&ni=$ni";

        #   print "IN: $tif∫F $hi% $ni\n";

            $sp = (HS($return[24])*100+L($return[24])*10+H($return[23])+L($return[23])/10)*.6215;
            $dir = (L($return[26])%4)*100+H($return[25])*10+L($return[25]);
            $spreadraw = int(L($return[26])/4);
            if ($spreadraw==1) {
                $spread = 22.5;
            } elsif ($spreadraw==2) {
                $spread = 45;
            } elsif ($spreadraw==3) {
                $spread = 67.5;
            } else {
                $spread = 0;
            }
            $nwin = (S(H($return[24]))==-1) ? "NEW" : "OLD";

            $getstr .= "&sp=$sp&dir=$dir&spread=$spread&nwin=$nwin";

        #   print "WIN: $sp mph at $dir +/- $spread $nwin\n";

            if (($t1f<=50)&($sp>3)) {
                $wc = 35.74+(0.6215*$t1f)-(35.75*($sp**0.16))+(0.4275*$t1f*($sp**0.16));
            } else {
                $wc = $t1f;
            }

            $getstr .= "&wc=$wc";

            $pr = (H($return[27])*100+L($return[27])*10+H($return[26])+200)/33.775;

            $getstr .= "&pr=$pr";

        #   print "PR: $pr hPa\n";
        #   0.0145636 in/count

# rain is a tricky thing. The rain sensor merely counts tips of the seesaw and reports
# that number of counts periodically. It's a 12 bit counter, so there's a challenge
# in the database/reporting program to discover that it's rolled over and has not
# reset through a battery change or fluke. What I've done is determined that
# if the count goes from "high" to "low", where high is currently set to >4080, and
# low is <20, then there was, indeed, a rollover and not a reset. I also store both
# the raw value reported by the rain gage as well as the delta from the last reading
# so that a simple SUM query can be done to get the total rainfall during a given
# period of time.

            $rn = (($return[22]&0x7F)*256+$return[21]);
            $nr = (S(H($return[22]))==-1) ? "NEW" : "OLD";

            $getstr .= "&rn=$rn&nr=$nr";



            $ua = new LWP::UserAgent;
            $ua->agent("EcclesAgent/0.1 ".$ua->agent);

            $httpError = 1;
            while ($httpError) {
                print $getstr,"\n";
                my $req = new HTTP::Request GET => $getstr;
            #   $req->content_type('application/x-www-form-urlencoded');
            #   $req->content('match=www&errors=0');
                my $res = $ua->request($req);
                if ($res->is_success) {
                    print $res->content;
                    $httpError = 0;
                } else {
                    print "HTTP Error\nWaiting to try again...\n";
                    $i=10;
                    while ($i>=1) {
                        print $i,"...\n";
                        sleep(1);
                        $i=$i-1;
                    }
                    print "0.\n";
                    sleep(1);
                }
            }
            undef $req;
            undef $ua;
#

        gotosleep();
sleep(1);
        } # end of massive if statement

#       print "Requesting status.\n";

#       wakeup();
#       $ob->write("\x01\x35\xca\x04");

#       ($count, $result) = $ob->read(100);

#       $count = length($result);

#       print $count," characters returned:\n";

#       print join(" ",unpack("C*",$result)),"\n";


    } # end of while ($havedata)    


} # end of while (1)

undef $ob; # close serial port

Recent Comments