#
# dweather - a distributed weather station
#
-# copyright (c) 2012 Dirk Koopman G1TLH
+# Copyright (c) 2012-2014 Dirk Koopman G1TLH
#
#
use strict;
use warnings;
+use 5.01001;
use lib qw(. ./blib ./lib ./DWeather/lib);
use DWeather::Debug;
use AnyEvent;
-my $sigint = AnyEvent->signal (signal => "INT", cb => sub { my $sig = shift; terminate("on signal $sig")});
-my $sigterm = AnyEvent->signal (signal => "TERM", cb => sub { my $sig = shift; terminate("on signal $sig")});
-
dbginit();
dbg("*** dweather started");
-my $cv = AnyEvent->condvar;
-my @res = $cv->recv;
-
exit 0;
#
# 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 DWeather::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+)/ );
+$VERSION = 1.23;
use strict;
use vars qw(%dbglevel $fp);
+use 5.01001;
-use DWeather::Logger;
+use SMGLog ();
use Carp qw(cluck);
+use Time::HiRes qw(gettimeofday);
%dbglevel = ();
$fp = undef;
);
}
+dbginit();
+
sub dbg
{
- my $t = time;
- my $ts = sprintf("%02d:%02d:%02d", (gmtime($t))[2,1,0]);
+ my ($t,$ut) = gettimeofday;
+ my $ts = sprintf "%02d:%02d:%02d:%03d", (gmtime($t))[2,1,0], $ut/1000;
for (@_) {
my $r = $_;
chomp $r;
my @l = split /\n/, $r;
for (@l) {
- s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
+ s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
# print "$_\n" if defined \*STDOUT;
$fp->writeunix($t, "$ts $_");
}
$SIG{__DIE__} = sub { dbg($@, Carp::longmess(@_)); };
}
- $fp = DWeather::Logger->new('debug', 'log', 'd') unless $fp;
+ $fp = SMGLog->new('debug', 'log', 'd');
}
sub dbgclose
@ISA = qw(Exporter);
@EXPORT = qw(Log LogDbg);
+$VERSION = 1.20;
use strict;
$log = undef;
$path = './logs';
+my %open;
+
+init();
+
# make the Log() export use this default file
sub init
{
- my $default_dir = shift || 'sys_log';
- $log = __PACKAGE__->new($default_dir) unless $log;
+ $log = __PACKAGE__->new("sys_log");
}
# create a log object that contains all the useful info needed
mkpath($dir, 0, 0777) unless -d $dir;
die "cannot create or access $dir $!" unless -d $dir;
- return bless $ref, $pkg;
+ my $self = bless $ref, $pkg;
+ $open{$self} = $self;
+ return $self;
+}
+
+sub mode
+{
+ my $self = shift;
+ $self->{mode} = shift if @_;
+ return $self->{mode};
}
# open the appropriate data file
$self->{fn} = sprintf "$self->{prefix}/$year/%02d%02d", $month, $day;
$self->{fn} .= ".$self->{suffix}" if $self->{suffix};
- $self->{mode} = $mode || 'r';
+ $self->{mode} = $mode || 'a+';
my $fh = new IO::File $self->{fn}, $mode, 0666;
return unless $fh;
- $fh->autoflush(1) if $mode ne 'r'; # make it autoflushing if writable
+ $fh->autoflush(0) if $mode ne 'r'; # disable autoflushing if writable
$self->{fh} = $fh;
$self->{year} = $year;
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} $!";
+ if (!$self->{fh} || $self->{mode} ne "r" || $dayno != $self->{dayno}) {
+ $self->open($dayno, "a+") or confess "can't open $self->{fn} $!";
}
return $self->{fh}->print("$line\n");
sub DESTROY
{
my $self = shift;
+
+ delete $open{$self};
undef $self->{fh}; # close the filehandle
delete $self->{fh} if $self->{fh};
}
+sub flush
+{
+ $_[0]->{fh}->flush if $_[0]->{fh};
+}
+
+sub flushall
+{
+ foreach my $v (values %open) {
+ $v->flush;
+ }
+}
+
+sub flush_all { goto &flushall }
+
+
sub Log
{
my $l = ref $_[0] ? shift : $log;
sub LogDbg
{
Log(@_);
- DWeather::Debug::dbg(@_) if DWeather::Debug::isdbg('chan');
+ Debug::dbg(@_) if Debug::isdbg('chan');
}
-init();
-
1;
# Module to do serial handling on perl FileHandles
#
-use strict;
-
package DWeather::Serial;
use POSIX qw(:termios_h);
use Fcntl;
+use Scalar::Util qw(weaken);
-use AnyEvent;
-use base qw(AnyEvent::Handle);
+@ISA = qw(IO::File);
+$VERSION = 1.3;
+
+use strict;
-# Linux-specific Baud-Rates (for reference really)
+# Linux-specific Baud-Rates
use constant B57600 => 0010001;
use constant B115200 => 0010002;
use constant B230400 => 0010003;
use constant B460800 => 0010004;
use constant CRTSCTS => 020000000000;
-#
-# my $h = DWeather::Serial->new("/dev/ttyXXX", 19200 [,cs7] [,odd] [,rtscts]);
-#
-# all parameters are optional
-#
-# you are expected to add AE callbacks as required, all this module
-# does is create the AE::Handle and associates an IO::File handle with it
-#
-# default is /dev/ttyS0, 9600 8N1 no handshaking
-#
-# the tty is set to raw mode.
-#
-# returns a subclassed AE::Handle
-#
sub new
{
my $pkg = shift;
my $class = ref $pkg || $pkg;
my $device = shift || "/dev/ttyS0";
- my $fh = IO::File->new($device, O_RDWR|O_NOCTTY|O_EXCL|O_NDELAY) || return;
- my $self = $class->new(fh => $fh);
+ 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} = $self->{ORIGTERM}->getattr(fileno($fh));
- $term->getattr(fileno($fh));
+ $$self->{ORIGTERM} = POSIX::Termios->new();
+ my $term = POSIX::Termios->new();
+ $$self->{ORIGTERM}->getattr(fileno($self));
+ $term->getattr(fileno($self));
my ($speed) = grep {/^\d+$/} @_;
- $speed ||= 9600;
my $baud;
{
no strict 'refs';
$cflag |= CRTSCTS if grep /rtscts$/, $@;
$term->setcflag($cflag); $term->setlflag($lflag);
$term->setoflag($oflag); $term->setiflag($iflag);
- $term->setattr(fileno($fh), TCSANOW);
- $self->{device} = $device;
- $self->{speed} = $speed;
+ $term->setattr(fileno($self), TCSANOW);
+ $$self->{TERM} = $term;
+
return $self;
}
sub getattr
{
my $self = shift;
- $self->{TERM}->getattr(fileno($self->fh));
- return $self->{TERM};
+ $$self->{TERM}->getattr;
+ return $$self->{TERM};
}
sub setattr
{
my $self = shift;
- my $attr = shift || $self->{TERM};
- $attr->setattr(fileno($self->fh), &POSIX::TCSANOW);
+ my $attr = shift || $$self->{TERM};
+ $attr->setattr(fileno($self), &POSIX::TCSANOW) if fileno($self);
+}
+
+sub close
+{
+ my $self = shift;
+ $self->setattr(delete $$self->{ORIGTERM}) if fileno($self) && $$self->{ORIGTERM};
+ $self->SUPER::close;
}
sub DESTROY
{
my $self = shift;
- $self->setattr($self->{ORIGTERM});
+ if (exists $$self->{ORIGTERM}) {
+ $self->close;
+ }
}
1;
# $h{Rain_Rate} = sprintf("%0.1f",unpack("s", substr $blk,41,2) * $rain_mult)+0;
$rain = $h{Rain_Day} = sprintf("%0.1f", unpack("s", substr $blk,50,2) * $rain_mult)+0;
- $h{Rain} = ($rain >= $last_rain ? $rain - $last_rain : $rain) if $loop_count;
+ my $delta_rain = $h{Rain} = ($rain >= $last_rain ? $rain - $last_rain : $rain) if $loop_count;
$last_rain = $rain;
# what sort of packet is it?
$last_rain_min = $last_rain_hour = $rain;
$j = $json->encode(\%h);
+
$s = qq|{"t":$ts,"h":$j}|;
$last_hour = int($ts/3600)*3600;
$last_min = int($ts/60)*60;
$last_rain_min = $rain;
$j = $json->encode(\%h);
+
$s = qq|{"t":$ts,"m":$j}|;
$last_min = int($ts/60)*60;
@min = ();
projects / dweather.git / commitdiff