From: Dirk Koopman Date: Fri, 18 Jul 2014 21:51:54 +0000 (+0100) Subject: update DWeather::Debug, Logger, Serial X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=86125caccc4bf630c8db18d9377c42b1ec5da428;p=dweather.git update DWeather::Debug, Logger, Serial --- diff --git a/DWeather/dweather b/DWeather/dweather index 3844fcc..b51543b 100644 --- a/DWeather/dweather +++ b/DWeather/dweather @@ -2,12 +2,13 @@ # # 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); @@ -16,15 +17,9 @@ use DWeather::Logger; 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; diff --git a/DWeather/lib/DWeather/Debug.pm b/DWeather/lib/DWeather/Debug.pm index d67b702..594d937 100644 --- a/DWeather/lib/DWeather/Debug.pm +++ b/DWeather/lib/DWeather/Debug.pm @@ -4,8 +4,6 @@ # # 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. # @@ -13,15 +11,18 @@ 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; @@ -52,16 +53,18 @@ if (!defined $DB::VERSION) { ); } +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 $_"); } @@ -76,7 +79,7 @@ sub dbginit $SIG{__DIE__} = sub { dbg($@, Carp::longmess(@_)); }; } - $fp = DWeather::Logger->new('debug', 'log', 'd') unless $fp; + $fp = SMGLog->new('debug', 'log', 'd'); } sub dbgclose diff --git a/DWeather/lib/DWeather/Logger.pm b/DWeather/lib/DWeather/Logger.pm index b8233bf..98fba05 100644 --- a/DWeather/lib/DWeather/Logger.pm +++ b/DWeather/lib/DWeather/Logger.pm @@ -25,6 +25,7 @@ use File::Path; @ISA = qw(Exporter); @EXPORT = qw(Log LogDbg); +$VERSION = 1.20; use strict; @@ -32,11 +33,14 @@ use vars qw($log $path); $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 @@ -54,7 +58,16 @@ sub new 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 @@ -75,12 +88,12 @@ sub open $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; @@ -111,10 +124,8 @@ sub opennext 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"); @@ -155,10 +166,27 @@ sub close 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; @@ -171,9 +199,7 @@ sub Log sub LogDbg { Log(@_); - DWeather::Debug::dbg(@_) if DWeather::Debug::isdbg('chan'); + Debug::dbg(@_) if Debug::isdbg('chan'); } -init(); - 1; diff --git a/DWeather/lib/DWeather/Serial.pm b/DWeather/lib/DWeather/Serial.pm index cbd6cbe..ccf31ca 100644 --- a/DWeather/lib/DWeather/Serial.pm +++ b/DWeather/lib/DWeather/Serial.pm @@ -2,54 +2,39 @@ # 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'; @@ -79,30 +64,39 @@ sub new $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; diff --git a/loop.pl b/loop.pl index a9b7f2d..5fe9594 100755 --- a/loop.pl +++ b/loop.pl @@ -248,7 +248,7 @@ sub process # $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? @@ -311,6 +311,7 @@ sub process $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; @@ -331,6 +332,7 @@ sub process $last_rain_min = $rain; $j = $json->encode(\%h); + $s = qq|{"t":$ts,"m":$j}|; $last_min = int($ts/60)*60; @min = ();