view release on metacpan or  search on metacpan

lib/Device/WS2500PC.pm  view on Meta::CPAN

# # *** Library for interfacing the serial port of the WS2500PC Adapter      ***
# # *** Produced by German Distributor ELV                                   ***
# # ****************************************************************************
# # *** This program is free software; you can redistribute it and/or modify ***
# # *** it under the terms of the GNU General Public License as published by ***
# # *** the Free Software Foundation; either version 2 of the License, or    ***
# # *** (at your option) any later version.                                  ***
# # ****************************************************************************
# # *** History: 0.99   Initial release                                      ***
# # ***          0.99a  Bugfix in distribution                               ***
# # ***          0.99b  Bugfix for reading other sensors than temp1-temp8    ***
# # ***                 ws2500_GetDatasetBulk() added                        *** 
# # ****************************************************************************



# ********************************************************
# *** Imports
# ********************************************************
use strict;
use warnings;
use Carp;
use Device::SerialPort qw(:PARAM :STAT 0.07);
use Time::HiRes        qw (sleep);
use Time::Local        qw(timelocal); 



# ********************************************************
# *** Package Definition
# ********************************************************
require Exporter;
use vars qw (@EXPORT @EXPORT_OK @ISA);
@ISA       = qw (Exporter);
@EXPORT    = qw (ws2500_GetTime ws2500_GetStatus ws2500_GetDataset ws2500_NextDataset);
@EXPORT_OK = qw (ws2500_FirstDataset ws2500_SetDebug ws2500_InterfaceInit ws2500_GetDatasetBulk);
 


# ********************************************************
# *** Prototypes and global variables 
# ********************************************************
sub printhex              ($);
sub send_Command;
sub read_Response         ($;$);
sub init_Interface        ($);
sub close_Interface       ();
sub ws2500_GetTime        ($;$);
sub ws2500_GetStatus      ($;$);
sub ws2500_GetDataset;
sub ws2500_GetDatasetBulk ($;$;$);
sub ws2500_NextDataset;
sub ws2500_FirstDataset   ($);
sub ws2500_SetDebug       ($);
sub ws2500_InterfaceTest  ($);
sub ws2500_InterfaceInit  ($;$);

our %data;
%data = ('debug'=>0, 'maxrepeat'=>10,
	 'commands'=>{'ACTIVATE'=>'0', 'DCF'=>'1', 'NEXTSET'=>'2', 'FIRSTSET'=>'3', 'GETSET'=>'4', 'STATUS'=>'5',
	              'INTERFACETEST'=>'CTST', 'INTERFACEINIT'=>'D'},
	 'markers'=>{'SOH'=>"\x01", 'STX'=>"\x02", 'ETX'=>"\x03", 'EOT'=>"\x04", 
	             'ENQ'=>"\x05", 'ACK'=>"\x06", 
		     'DLE'=>"\x10", 'DC2'=>"\x12", 'DC3'=>"\x13",
		     'NAK'=>"\x15"});
our $VERSION = "0.99";



# ********************************************************
# *** Internal package routines 
# ********************************************************

# Returns a string in the form 2A E3 <STX>
# The special markers used in this interface (like STX=02) are replaced by
# the proper identifier. Only used by the debug messages.
# Params: data    The message to print
# Return: string  A string in the format described above
sub printhex ($) {
	my $data = shift;
	my $result = '';

	return "<no data>" if $data eq '';

	for (my $x=0;$x<length($data);$x++) { 
		my $char = substr($data,$x,1);
		my $printed = 0;

		foreach (keys %{$data{'markers'}}) {
			if ($char eq $data{'markers'}->{$_} and !$printed) {
				$result.=sprintf("<%s> ",$_);
				$printed=1;
			}
		}
		$result.=sprintf("%02X ",ord($char)) unless $printed;
	}

	return $result;
}

# Sends a command to the interface
# This subroutine only encodes and sends a message, it does not care wether
# the sent message has been received/acknowledged or not
# Params: token  A command from $data{'commands'}
#         param  An optional parameter containing additional data
# Return: 1      Always true
sub send_Command {
	my $token = shift;
	my ($checksum,$message,$command,$param);
	
	# Is this a valid command, when not die as this is an internal error
	die "Unknown command '$token'" unless exists $data{'commands'}->{$token};
	$param='';
	$param = shift if scalar @_;
	$command = $data{'commands'}->{$token}.$param;

	# Checksum is negative sum of command value, Bit 7 always set
	foreach (split //, $command) { $checksum+=ord($_); }
	$checksum = (0x100-($checksum & 0xFF)) | 0x80;
	
	# Build message and write to port

lib/Device/WS2500PC.pm  view on Meta::CPAN

	my %firstdataset;

	for (my $x=0;$x<$bulkcount;$x++) {
		if ($x==0) {
			# Request first dataset
			# As we supply the 'noclose' param the connection to the interface stays
			# open an we can request additional datasets without reestablishing the connection
			my $res = ws2500_GetDataset ($port,\%firstdataset,'next','noclose');
			# Check for errors
			if ($res and $firstdataset{'valid'} and $firstdataset{'dataset'}->{'status'} eq 'dataset') {
				push @bulkdata, $firstdataset{'dataset'};
			} else {
				last;
			}
		} else {
			# Further datasets, use the firstdataset as base
			my %result = %firstdataset;
			delete $result{'dataset'};
			my $res = ws2500_GetDataset ($port,\%result,'next','noinit');
			# Check for errors
			if ($res and $result{'valid'} and $result{'dataset'}->{'status'} eq 'dataset') {
				push @bulkdata, $result{'dataset'};
			} else {
				$firstdataset{'valid'} = $result{'valid'};	
				last;
			}
		}
	}
	# Prepare the result
	$$result{'valid'}     = $firstdataset{'valid'};
	$$result{'interface'} = $firstdataset{'interface'};
	$$result{'sensors'}   = $firstdataset{'sensors'};
	# Save the bulkdata
	$$result{'bulk'} = \@bulkdata;
	$$result{'bulkcount'} = scalar @bulkdata;

	close_Interface;

	return 1;
}


# Test Interface
# This function does not work and is not properly documented. See inline comments below
# Params: port  The port to use, e.g. /dev/ttyS0
# Return: 0     Always false, as it does not work
sub ws2500_InterfaceTest ($) {
	my $port = shift;
	my %response;
	my $valid = 0;

	return 0;

	# This doesn't seem to work. Acoording to the docu we have to send either
	# 'C' or 'CTST'. However both variants fail, and there is either no data
	# received at all, or gibberish. Furthermore the interface is not reset.
	# If anyone has a clear documentation how to activate this (and what to
	# to with it), please send them.
#	return 0 unless init_Interface ($port);
#	for (my $x=0;$x<$data{'maxrepeat'};$x++) {
#		send_Command ('INTERFACETEST');
#		sleep (0.04);
#		read_Response (1,\%response);
#		if ($response{'ok'} and $response{'message'} eq $data{'markers'}->{'ACK'}) {
#			$valid=1;
#			last;
#		}
#	}
#	close_Interface;
#
#	return 1 if $valid; 
#	return 0;
}

# Initialize the interface we new data
# Params: port  The port to sent the data, e.g. /dev/ttyS0
#         data  A hash-reference containing the configuration, see below
# Return: 0|1   True upon success, else False
# The configuration-hash must contain following keys:
# {first}        Minutes to wait after init to resume normal operation, 0..63 minutes
# {interval}     The interval in minutes to record data, 2..63 minutes
# {addr-rain}    The address of the rain sensor, 0..7
# {addr-wind}    The address of the wind sensor, 0..7
# {addr-inside}  The address of the inside sensor, 0..7
# {addr-light}   The address of the light sensor, 0..7
# {version}      The protocal version to use: 1 (V1.1) or 2 (V1.2)
sub ws2500_InterfaceInit ($;$) {
	my $port = shift;
	my $data = shift;
	my %response;
	my $valid = 0;
	my $message;

	# {'first'=>12,'interval'=>3,'addr-rain'=>7,'addr-wind'=>7,'addr-inside'=>7,'addr-ligth'=>7,'version'});

	# Prepare the message (4 Bytes)
	# First some checks if the data is correct
	foreach my $token (qw (first interval addr-rain addr-wind addr-inside addr-light version)) {
		croak "Token '$token' missing in configuration hash" unless exists $$data{$token};
		croak "Token '$token' is not a number ('$$data{'$token'}') " unless $$data{$token}=~ /^\d+$/;
	}
	# Some sanity checks 
	croak "First interval 'first' must be between 0 and 63"        if $$data{'first'}<0 or $$data{'first'}>63;
	croak "Recording interval 'interval' must be between 2 and 63" if $$data{'interval'}<2 or $$data{'interval'}>63;
	foreach my $token (qw (addr-rain addr-wind addr-inside addr-light)) {
		croak "Sensor address for '$token' must be between 0 and 7" if $$data{$token}<0 or $$data{$token}>7;
	}
	croak "Version must be either 1 (V1.1) or 2 (V1.2)" if $$data{'version'}<1 or $$data{'version'}>2;

	# Put everything together
	my $addr1 = $$data{'addr-rain'} + ($$data{'addr-wind'} << 4) + 0x80;
	$addr1|=0x8 if $$data{'version'}==1;
	my $addr2 = $$data{'addr-light'} + ($$data{'addr-inside'} << 4) + 0x80;
	# Now build the message
	$message = chr($$data{'first'}).chr($$data{'interval'}).chr($addr1).chr($addr2);

	# Send the command
	return 0 unless init_Interface ($port);
	for (my $x=0;$x<$data{'maxrepeat'};$x++) {
		send_Command ('INTERFACEINIT',$message);
		read_Response (1,\%response);