--- /dev/null
+*.old
+blib
--- /dev/null
+Revision history for Perl extension DWeather.
+
+0.01 Thu Apr 12 16:55:53 2012
+ - original version; created by h2xs 1.23 with options
+ -X -b 5.8.1 -O DWeather
+
--- /dev/null
+Changes
+Makefile.PL
+MANIFEST
+README
+t/DWeather.t
+lib/DWeather.pm
--- /dev/null
+use 5.008001;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'DWeather',
+ VERSION_FROM => 'lib/DWeather.pm', # finds $VERSION
+ PREREQ_PM => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/DWeather.pm', # retrieve abstract from module
+ AUTHOR => 'Dirk Koopman <djk@>') : ()),
+);
--- /dev/null
+DWeather version 0.01
+=====================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2012 by Dirk Koopman
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.4 or,
+at your option, any later version of Perl 5 you may have available.
+
+
--- /dev/null
+package DWeather;
+
+use 5.008001;
+use strict;
+use warnings;
+
+require Exporter;
+use AutoLoader qw(AUTOLOAD);
+
+our @ISA = qw(Exporter);
+
+our $VERSION = '0.01';
+
+
+# Preloaded methods go here.
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+# Below is stub documentation for your module. You'd better edit it!
+
+=head1 NAME
+
+DWeather - A Distributed Weather Station
+
+=head1 SYNOPSIS
+
+ use DWeather;
+
+=head1 DESCRIPTION
+
+This is a distributed weather station that takes data from various weather
+station hardware (such as Davis VantagePro 2) and allows one to distribute
+a normalised form of that data around more than one place and then display
+it, hopefully nicely, in a web browser from a builtin web server.
+
+=head2 EXPORT
+
+None.
+
+=head1 SEE ALSO
+
+Davis Vantage documentation: L<http://www.davisnet.com/support/weather/downloads/software_direct.asp?SoftCat=4&SoftwareID=172>
+and L<http://www.davisnet.com/support/weather/downloads/software_direct.asp?SoftCat=4&SoftwareID=40>
+
+=head1 AUTHOR
+
+Dirk Koopman, E<lt>djk@tobit.co.ukE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2012 by Dirk Koopman
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.4 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
--- /dev/null
+#
+# The system variables - those indicated will need to be changed to suit your
+# circumstances (and callsign)
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id: Debug.pm,v 1.1 2001/05/18 14:02:10 djk Exp $
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+
+package Debug;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck carp);
+$VERSION = sprintf( "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/ );
+
+use strict;
+use vars qw(%dbglevel $fp);
+
+use SMGLog ();
+use Carp qw(cluck);
+
+%dbglevel = ();
+$fp = undef;
+
+# Avoid generating "subroutine redefined" warnings with the following
+# hack (from CGI::Carp):
+if (!defined $DB::VERSION) {
+ local $^W=0;
+ eval qq( sub confess {
+ \$SIG{__DIE__} = 'DEFAULT';
+ Debug::dbg(\$@, Carp::shortmess(\@_));
+ exit(-1);
+ }
+ sub croak {
+ \$SIG{__DIE__} = 'DEFAULT';
+ Debug::dbg(\$@, Carp::longmess(\@_));
+ exit(-1);
+ }
+ sub carp { Debug::dbg(Carp::shortmess(\@_)); }
+ sub cluck { Debug::dbg(Carp::longmess(\@_)); }
+ );
+
+ CORE::die(Carp::shortmess($@)) if $@;
+} else {
+ eval qq( sub confess { Carp::confess(\@_); }
+ sub cluck { Carp::cluck(\@_); }
+ sub carp { Carp::cluck(\@_); }
+ );
+}
+
+dbginit();
+
+sub dbg
+{
+ my $t = time;
+ my $ts = sprintf("%02d:%02d:%02d", (gmtime($t))[2,1,0]);
+ for (@_) {
+ my $r = $_;
+ chomp $r;
+ my @l = split /\n/, $r;
+ for (@l) {
+ s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
+# print "$_\n" if defined \*STDOUT;
+ $fp->writeunix($t, "$ts $_");
+ }
+ }
+}
+
+sub dbginit
+{
+ # add sig{__DIE__} handling
+ if (!defined $DB::VERSION) {
+ $SIG{__WARN__} = sub { dbg($@, Carp::shortmess(@_)); };
+ $SIG{__DIE__} = sub { dbg($@, Carp::longmess(@_)); };
+ }
+
+ $fp = SMGLog->new('debug', 'dat', 'd');
+}
+
+sub dbgclose
+{
+ $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT';
+ $fp->close() if $fp;
+ undef $fp;
+}
+
+sub dbgdump
+{
+ my $m = shift;
+
+ foreach my $l (@_) {
+ my $p = $m;
+ for (my $o = 0; $o < length $l; $o += 16) {
+ my $c = substr $l, $o, 16;
+ my $h = unpack "H*", $c;
+ $c =~ s/[\x00-\x1f\x7f-\xff]/./g;
+ my $left = 16 - length $c;
+ $h .= ' ' x (2 * $left) if $left > 0;
+ dbg($p . sprintf("%4d:", $o) . "$h $c");
+ $p = ' ' x (length $p);
+ }
+ }
+}
+
+sub dbgadd
+{
+ my $entry;
+
+ foreach $entry (@_) {
+ $dbglevel{$entry} = 1;
+ }
+}
+
+sub dbgsub
+{
+ my $entry;
+
+ foreach $entry (@_) {
+ delete $dbglevel{$entry};
+ }
+}
+
+sub dbglist
+{
+ return keys (%dbglevel);
+}
+
+sub isdbg
+{
+ return undef unless $fp;
+ return $dbglevel{$_[0]};
+}
+
+sub shortmess
+{
+ return Carp::shortmess(@_);
+}
+
+sub longmess
+{
+ return Carp::longmess(@_);
+}
+
+1;
+__END__
+
+
+
+
+
+
+
--- /dev/null
+#
+# the general purpose logging machine
+#
+# This module is designed to allow you to log stuff in SMG format
+#
+# The idea is that you give it a prefix which is a directory and then
+# the system will log stuff to a directory structure which looks like:-
+#
+# ./logs/<prefix>/yyyy/mmdd.[log|<optional suffix]
+#
+# Routines are provided to read these files in and to append to them
+#
+# Copyright (c) - 1998-2007 Dirk Koopman G1TLH
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+
+package SMGLog;
+
+use IO::File;
+use Exporter;
+use Carp;
+use File::Path;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(Log LogDbg);
+
+use strict;
+
+use vars qw($log $path);
+$log = undef;
+$path = './logs';
+
+init();
+
+# make the Log() export use this default file
+sub init
+{
+ $log = SMGLog->new("sys_log");
+}
+
+# create a log object that contains all the useful info needed
+# prefix is the main directory off of the data directory
+# suffix is the suffix after the month/day
+sub new
+{
+ my ($pkg, $prefix, $suffix) = @_;
+ my $ref = {};
+ my $dir = "$path/$prefix";
+ $ref->{prefix} = $dir;
+ $ref->{suffix} = $suffix || 'log';
+
+ # make sure the directory exists
+ mkpath($dir, 0, 0777) unless -d $dir;
+ die "cannot create or access $dir $!" unless -d $dir;
+
+ return bless $ref, $pkg;
+}
+
+# open the appropriate data file
+sub open
+{
+ my ($self, $dayno, $mode) = @_;
+
+ my ($year, $month, $day) = (gmtime($dayno * 86400))[5,4,3];
+ $year += 1900;
+ $month += 1;
+
+ # if we are writing, check that the directory exists
+ if (defined $mode) {
+ my $dir = "$self->{prefix}/$year";
+ mkdir($dir, 0777) if ! -e $dir;
+ }
+
+ $self->{fn} = sprintf "$self->{prefix}/$year/%02d%02d", $month, $day;
+ $self->{fn} .= ".$self->{suffix}" if $self->{suffix};
+
+ $self->{mode} = $mode || 'r';
+
+ my $fh = new IO::File $self->{fn}, $mode, 0666;
+ return unless $fh;
+
+ $fh->autoflush(1) if $mode ne 'r'; # make it autoflushing if writable
+ $self->{fh} = $fh;
+
+ $self->{year} = $year;
+ $self->{month} = $month;
+ $self->{day} = $day;
+ $self->{dayno} = $dayno;
+
+# DXDebug::dbg("dxlog", "opening $self->{fn}\n");
+
+ return $self->{fh};
+}
+
+# open the previous log file in sequence
+sub openprev
+{
+ my $self = shift;
+ return $self->open($self->{dayno} - 1, @_);
+}
+
+# open the next log file in sequence
+sub opennext
+{
+ my $self = shift;
+ return $self->open($self->{dayno} + 1, @_);
+}
+
+# write (actually append) to a file, opening new files as required
+sub write
+{
+ my ($self, $dayno, $line) = @_;
+ if (!$self->{fh} ||
+ $self->{mode} ne ">>" ||
+ $dayno != $self->{dayno}) {
+ $self->open($dayno, ">>") or confess "can't open $self->{fn} $!";
+ }
+
+ return $self->{fh}->print("$line\n");
+}
+
+# read a line from an opened file
+sub read
+{
+ my $self = shift;
+ confess "can't read $self->{fh} $!" unless $self->{fh};
+ return $self->{fh}->getline;
+}
+
+# write (actually append) using the current date to a file, opening new files as required
+sub writenow
+{
+ my ($self, $line) = @_;
+ my $dayno = int (time / 86400);
+ return $self->write($dayno, $line);
+}
+
+# write (actually append) using a unix time to a file, opening new files as required
+sub writeunix
+{
+ my ($self, $t, $line) = @_;
+ my $dayno = int ($t / 86400);
+ return $self->write($dayno, $line);
+}
+
+# close the log file handle
+sub close
+{
+ my $self = shift;
+ undef $self->{fh}; # close the filehandle
+ delete $self->{fh};
+}
+
+sub DESTROY
+{
+ my $self = shift;
+ undef $self->{fh}; # close the filehandle
+ delete $self->{fh} if $self->{fh};
+}
+
+sub Log
+{
+ my $l = ref $_[0] ? shift : $log;
+ return unless $l;
+ my $t = time;
+ my $ts = sprintf("%02d:%02d:%02d", (gmtime($t))[2,1,0]);
+ $l->writeunix($t, "$ts $_") for @_;
+}
+
+sub LogDbg
+{
+ Log(@_);
+ Debug::dbg(@_) if Debug::isdbg('chan');
+}
+
+1;
--- /dev/null
+#
+# Module to do serial handling on perl FileHandles
+#
+
+use strict;
+
+package Serial;
+
+use POSIX qw(:termios_h);
+use Fcntl;
+
+our @ISA = qw(IO::File);
+
+
+# Linux-specific Baud-Rates
+use constant B57600 => 0010001;
+use constant B115200 => 0010002;
+use constant B230400 => 0010003;
+use constant B460800 => 0010004;
+use constant CRTSCTS => 020000000000;
+
+sub new
+{
+ my $pkg = shift;
+ my $class = ref $pkg || $pkg;
+ my $device = shift || "/dev/ttyS0";
+
+ my $self = $pkg->SUPER::new($device, O_RDWR|O_NOCTTY|O_EXCL|O_NDELAY) || return;
+
+ # get my attributes
+ $$self->{ORIGTERM} = POSIX::Termios->new();
+ my $term = $$self->{TERM} = POSIX::Termios->new();
+ $$self->{ORIGTERM}->getattr(fileno($self));
+ $term->getattr(fileno($self));
+ my ($speed) = grep {/^\d+$/} @_;
+ my $baud;
+ {
+ no strict 'refs';
+ $baud = &{'POSIX::B' . $speed};
+ }
+ $term->setispeed($baud);
+ $term->setospeed($baud);
+
+ my $cflag = $term->getcflag(); my $lflag = $term->getlflag();
+ my $oflag = $term->getoflag(); my $iflag = $term->getiflag();
+
+ # set raw
+ ########################################################################
+ $iflag &= ~(IGNBRK|BRKINT|PARMRK|ISTRIP|INLCR|IGNCR|ICRNL|IXON);
+ $oflag &= ~OPOST;
+ $lflag &= ~(ECHO|ECHONL|ICANON|ISIG);
+ $cflag &= ~(CSIZE|PARENB|HUPCL);
+ #########################################################################
+ #
+
+ $cflag |= CLOCAL|CREAD;
+ $cflag |= (grep {/^cs7$/i} @_) ? CS7 : CS8;
+ if (my ($parity) = grep {/^(odd|even)$/i} $@) {
+ $cflag |= PARENB;
+ $cflag |= PARODD if $parity =~ /odd/i;
+ }
+ $cflag |= CRTSCTS if grep /rtscts$/, $@;
+ $term->setcflag($cflag); $term->setlflag($lflag);
+ $term->setoflag($oflag); $term->setiflag($iflag);
+ $term->setattr(fileno($self), TCSANOW);
+ return $self;
+}
+
+sub getattr
+{
+ my $self = shift;
+ $$self->{TERM}->getattr;
+ return $$self->{TERM};
+}
+
+sub setattr
+{
+ my $self = shift;
+ my $attr = shift || $$self->{TERM};
+ $attr->setattr(fileno($self), &POSIX::TCSANOW);
+}
+
+sub close
+{
+ my $self = shift;
+ $self->setattr($$self->{ORIGTERM});
+ $self->SUPER::close;
+}
+
+1;
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl DWeather.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+BEGIN { use_ok('DWeather') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
projects / dweather.git / commitdiff