#!/usr/bin/perl # # Copyright 2001-2008 Daniel Klein, dan@klein.com. All Rights Reserved. # You may make unlimited copies of this code provided: # 1) That this and other entire copyright notices are retained. # 2) That neither the code nor any derivative code is sold for any reason # or amount. If you want to sell it or a derivative work, email me and # we'll work out a royalty fee structure. # # Please let me know that you're using it (you don't *have* to, but I'm curious # about how it is being used!) # # COMPLETE DOCUMENTATION IS AT THE END OF THIS FILE, IN POD FORMAT # use constant VERSION => '$Id: thermd,v 2.67 2008/06/18 00:22:46 root Exp root $'; require 5.7.3; # To get safe signals use strict; use locale; use Carp; use Encode; use POSIX qw(:termios_h :errno_h :locale_h strftime INT_MAX INT_MIN ceil floor); use Fcntl qw(:DEFAULT :flock); use FileHandle; unless ($^O eq "MSWin32") { eval qq{ use Sys::Syslog; }; } use Sys::Hostname; use Search::Dict; use FindBin (); use File::Basename (); use File::Spec; use Socket; use Locale::Maketext; Thermd::I18N->import(); # Until v3.x when we use Thermd::I18N use MIME::Base64; use HTTP::Date; # Must download from CPAN use Config::General qw(ParseConfig); # Must download from CPAN # # Other modules are used inside of eval strings, so that they are not compiled # at every invocation unless they are actually needed. The modules used are: # CGI, CGI::Carp, and Getopt::Long. # # See the POD documentation for a full list of optional modules, depending on # features used. # #+ # Everything that you tune is in the config file - there are no longer any # configuration variables here. #+ # # Set up initialization stuff, first # our $lh = Thermd::I18N->get_handle() or die "Cannot determine language..."; #$lh->fail_with('failure_handler_auto'); $Carp::Verbose = 1; setlocale(LC_ALL, $lh->locale()); # Will get overridden in daemon my $script = File::Basename::basename($0); $SIG{HUP} = $SIG{INT} = $SIG{TERM} = \&get_kicked; our ($opt_annotate, $opt_barometer, $opt_center, $opt_checkconfig, $opt_config, $opt_csv, $opt_current, $opt_daemon, $opt_email, $opt_epochtime, $opt_format, $opt_from, $opt_graph, $opt_help, $opt_height, $opt_hilo, $opt_i18n, $opt_list, $opt_nofork, $opt_nosmooth, $opt_nowarn, $opt_outfile, $opt_rainfall, $opt_raw, $opt_report, $opt_sesame, $opt_span, $opt_temperature, $opt_to, $opt_units, $opt_verbose, $opt_view, $opt_width, $opt_windspeed, %config, $is_cgi, $is_child, $date_from, $date_to, $email_regex, $ofd, $workbook, $worksheet, @kids, @pollers, @actions, %logfile); END { if (!$is_child && @kids) { msg("err", "END Infanticide from PID $$ - $0, killing kids: @kids"); kill POSIX::SIGTERM(), @kids; } } our %options = ( annotate => \$opt_annotate, "barometer=s"=>\$opt_barometer, "center=s" => \$opt_center, checkconfig => \$opt_checkconfig, "config=s" => \$opt_config, csv => \$opt_csv, current => \$opt_current, daemon => \$opt_daemon, epochtime => \$opt_epochtime, email => \$opt_email, "format=s" => \$opt_format, "from=s" => \$opt_from, graph => \$opt_graph, "height=i" => \$opt_height, hilo => \$opt_hilo, help => \$opt_help, "i18n:s" => \$opt_i18n, list => \$opt_list, nofork => \$opt_nofork, nosmooth => \$opt_nosmooth, nowarn => \$opt_nowarn, "outfile=s" => \$opt_outfile, "span=s" => \$opt_span, "rainfall=s"=>\$opt_rainfall, raw => \$opt_raw, report => \$opt_report, "temperature=s"=>\$opt_temperature, "to=s" => \$opt_to, "units=s" => \$opt_units, verbose => \$opt_verbose, "view=s" => \$opt_view, "width=i" => \$opt_width, "windspeed=s"=>\$opt_windspeed, ); # # This lists what switches are legal with which mode, used in check_opts # my @common = qw(config nowarn verbose); my @unitspec = qw(barometer rainfall temperature units windspeed); my @daterange = qw(center from span to); my @daemon = qw(force nofork verbose); my @report = qw(current raw epochtime format outfile view); my @graph = qw(height width hilo nosmooth outfile view); my @annotate = qw(current outfile view); my @checkconfig = qw(email list); # # The @color_wheel is what is used when we don't explicitly specify a # GraphColor attribute for a sensor. The %color_map correlates a color # name with an #RRGGBB value. There are more colors in the %color_map # than there are in the @color_wheel # my @color_wheel = qw(red lime blue purple orange teal fuschia olive aqua green pink yellow navy maroon black); my %color_map = ( red => "#FF0000", teal => "#008080", blue => "#0000FF", fuschia => "#FF00FF", olive => "#808000", aqua => "#00FFFF", green => "#008000", black => "#000000", orange => "#FFA500", purple => "#800080", silver => "#C0C0C0", white => "#FFFFFF", pink => "#FFC0CB", yellow => "#FFFF00", lime => "#00FF00", gray => "#808080", navy => "#000080", maroon => "#800000"); my %compass = # Used to lookup TEMP08 values and convert them to numbers ( N => 0, NNE => 22.5, NE => 45, ENE => 67.5, E => 90, ESE => 112.5, SE => 135, SSE => 157.5, S => 180, SSW => 202.5, SW => 225, WSW => 247.5, W => 270, WNW => 292.5, NW => 315, NNW => 337.5 ); my @compass = map { $lh->maketext($_) } qw(N NNW NW WNW W WSW SW SSW S SSE SE ESE E ENE NE NNE); # # For an explanation, see http://sheepdogsoftware.co.uk/sc3wmw.htm or # http://www.midondesign.com/Documents/Calculating%20Wind%20Speed%20and%20Direction.pdf # my %compass_lookup = ( "2220" => 0, "2200" => 22.5, "2202" => 45, "2002" => 67.5, "2022" => 90, "0022" => 112.5, "0222" => 135, "0221" => 157.5, "2221" => 180, "2211" => 202.5, "2212" => 225, "2112" => 247.5, "2122" => 270, "1122" => 292.5, "1222" => 315, "1220" => 337.5, ); my %linetype_map = (solid => 1, dashed => 2, dotted => 3, dotdashed => 4); my %units = (English => { barometer => "inHg", temperature => "F", rainfall => "Inches", windspeed => "MPH", }, Metric => { barometer => "mmHg", temperature => "C", rainfall => "mm", windspeed => "KPH", }, ); my %l_month = ($lh->maketext("jan") => 1, $lh->maketext("feb") => 2, $lh->maketext("mar") => 3, $lh->maketext("apr") => 4, $lh->maketext("may") => 5, $lh->maketext("jun") => 6, $lh->maketext("jul") => 7, $lh->maketext("aug") => 8, $lh->maketext("sep") => 9, $lh->maketext("oct") => 10, $lh->maketext("nov") => 11, $lh->maketext("dec") => 12); my %e_month = ("jan" => 1, "feb" => 2, "mar" => 3, "apr" => 4, "may" => 5, "jun" => 6, "jul" => 7, "aug" => 8, "sep" => 9, "oct" => 10, "nov" => 11, "dec" => 12); # # The list of legal keys for Weather Underground # my %wunder_types = map { ($_ => 1)} qw( humidity tempf winddir windspeedmph windgustmph dailyrainin baromin soiltempf soilmoisture indoortempf indoorhumidity ); use constant PROGRAM_START => time; my $numeric = qr/^[+-]?(\d+([.,]\d*)?|[.,]\d+)$/; my $optnumeric = qr/^$|$numeric/; my ($dbh, $sth); # Only used if we have LogFormat SQL sub usage { warn @_ if @_; die <<'==END=='; Usage - can run either as a logging daemon, reporting script, image annotator, graph generator, or CGI script. You must pick one :-) ALL FLAGS MAY BE ABBREVIATED! Daemon: thermd -daemon [-config file] [-nofork [-verbose]] -config file Use this as a config file (default=/etc/thermd.conf) -force Kill the existing daemon, if one is found -nofork Don't fork to background (usually only for debugging) -verbose Verbose output (definitely for debugging :-) Report: thermd -report [report args] [range-value args] -format type One of CSV (comma separated values), TSV (tab separated values), XML, CER (Eddy Common Event Record) or Excel. Default format is TSV -epochtime When printing time, print Unix time(2), instead of the default human-readable time -current Print current values only -raw Print all current values, in raw form Annotate: thermd -annotate [range-value args] Graph: thermd -graph [graph args] [range-value args] -width pixels Override the width of the graph. If not specified here, default value comes from the config file, and that default value is 750. -height pixels Override the height of the graph. If not specified here, default value comes from the config file, and that default value is 300. -hilo Graph 24-hour extremes instead of individual datapoints -nosmooth When graphs get dense (typ. > 1 month of data), graph data is automatically smoothed. This switch defeats that function. Common range-value args -config file Use this as a config file (default=/etc/thermd.conf) -outfile file Output graph/table to this file (instead of STDOUT) -view name Show a named view (defined in config file, default=all) -nowarn Do not print configuration warnings -units {English|Metric} Use English/Metric units (override config file) -temperature {C|F} Show temperature values as (override config and -units) -windspeed {mph|kph|mps|knots|knot} Show windspeed values as (override config and -units) -rainfall {inches|mm} Show rainfall values as (override config and -units) -barometer {inHg|mmHg|millibar|mBar} Show barometer values as (override config and -units) -from daytime From date/time * -to daytime To date/time * -center daytime Center chart on date/time * -span reltime Span for centered chart ** * Date/time values may be specified as: absolute (ex: "20030228" or "20030228T1535" - actually, any format allowed by HTTP::Date) relative (ex: 3d, -2.5h, 3w, +5m3d1h, etc., suffixes are y=>year, m=>month, w=>week, d=>day, h=>hour) Note: sign is highly significant, and changes what it is relative to... named (i.e., "now", "today", "yesterday"), considered absolute times as far as discussion below is considered If -from and -to are both missing, we assume: -from -1d -to now If -from is specified but -to is missing, we assume: -to now If -from is missing but -to is specified, we assume that -from is 1d before -from If -from is relative and -to is absolute, we assume that -from is relative to now and comes before -to (which means that sign is ignored!), so that if today is 20030327: -from -1m -to 20030228 means the same as: -from 20030227 -to 20030228 Since sign is ignored here, you could also say: -from 1m -to 20030228 or: -from 1m -to yesterday or: -from +1m -to 20030228 (counterituitive, but legal) If -from is absolute and -to is relative, we assume that -to is relative to -from and comes after -from, so that: -from 20030228 -to 1d means the same as: -from 20030228 -to +1d means the same as: -from 20030228 -to 20030301 However, there is one special case: if -to is negative, it is interpreted as relative to "now", so: -from 20030228 -to -1d (from 20030228 to yesterday) If both -from and -to are relative, then both are considered to be relative to "now" (with one exception), so that: -from -5d -to -4d means the same as: -from +5d -to 4d ignore sign on -from, same as: -from 5d -to 4d but: -from -4d -to -5d illegal reverse range! There is one special case, if -to is positive (i.e., +time), then it is relative to -from, so: -from -5d -to +1d means the same as: -from -5d -to -4d ** Span values may only be relative, see above If -center is specified, but -span is missing, then -span defaults to 1d (i.e., from 12h before to 12h after -center) Test: thermd -checkconfig [-config file] -checkconfig Check the validity of the config file, and exit -config file Use this as a config file (default=/etc/thermd.conf) -verbose Output a full config file, with all defaults expressed -email Also sends an email to all alarm addresses - useful for checking your email configuration -list Prints a list of logfiles used by thermd (overrides -verbose, and only prints the list) Debug: thermd -i18n -i18n [lang] Report on internationalization database CGI: put it in your CGI area, and the rest should happen automatically :-) ==END== } ############################################################################## # Initialization: If we are called as a CGI script, load CGI.pm and # either output a form or output a graph. If we are called from the # shell, the act on the command-line switches. NOTE: When we output # a graph from a CGI script, we output a MIME header and then fake # things up to look like we were called from the shell. ############################################################################## if ($ENV{REQUEST_METHOD}) { eval qq{ use CGI qw(-nosticky :standard :netscape ); use CGI::Carp qw(fatalsToBrowser warningsToBrowser); }; die $@ if $@; import_names(); $is_cgi = 1; $opt_config = $Q::config || "/etc/thermd.conf"; read_config(); $opt_units = $Q::units || $config{displayin}; $opt_barometer = $units{$opt_units}{barometer}; $opt_rainfall = $units{$opt_units}{rainfall}; $opt_temperature = $units{$opt_units}{temperature}; $opt_windspeed = $units{$opt_units}{windspeed}; $opt_from = $Q::from || "-1d"; $opt_to = $Q::to || "now"; $opt_view = $Q::view; $opt_hilo = $Q::hilo; check_opts("cgi", @common, @daterange, @unitspec, @annotate, @report, @graph); parse_and_assign_dates(); do_cgi(); } else { eval qq{ use Getopt::Long; }; die $@ if $@; $Getopt::Long::autoabbrev = 1; GetOptions(%options); die "Use -help for a full list of options\n" if $Getopt::Long::error; if ($opt_verbose || $opt_checkconfig) { print "$script V@{[(split(/\s+/, VERSION))[2,3]]}\n\n"; } usage() if $opt_help; die "You must choose exactly one of -daemon, -report, -annotate or -graph\nUse -help for a full list of options\n" unless $opt_daemon + $opt_report + $opt_annotate + $opt_graph + $opt_checkconfig + defined($opt_i18n) == 1; die "Please use '-format csv' instead of '-csv'" if $opt_csv; $| = $opt_verbose; $opt_config ||= "/etc/thermd.conf"; # # If we are going to be the daemon, reset the locale to "C", so that # all logging and interprocess communication is in "C", and not the # LC_NUMERIC format. Use of Thermd::I18N is unchanged, though. # setlocale(LC_ALL, "C") if $opt_daemon; read_config() unless defined $opt_i18n; if ($opt_daemon) { check_opts("daemon", @common, @daemon); # # After the config file is fully verified, fork the pollers # for my $poller (@pollers) { $poller->(); } # # Then do any queued actions (like opening and closing switches) # for my $action (@actions) { $action->(); } # # And finally run the daemon code # do_daemon(); } elsif ($opt_report) { check_opts("report", @common, @daterange, @unitspec, @report); $opt_format = lc($opt_format || "tsv"); die "Unrecognized -format $opt_format. Use tsv, csv, excel, xml, or cer" unless $opt_format =~ /^(tsv|csv|xml|excel|cer|timeplot)$/; if ($opt_format eq "excel") { eval qq{ use Spreadsheet::WriteExcel; }; die $@ if $@; } elsif ($opt_format eq "timeplot") { $opt_epochtime = 1; } elsif ($opt_format eq "xml") { eval qq{ use XML::Simple; }; die $@ if $@; } elsif ($opt_format eq "cer") { die "You must use '-current' when using '-format cer'\n" unless $opt_current; die "Format 'cer' is under development, and is not operational yet"; eval qq{ use XML::Simple; }; die $@ if $@; } if ($opt_raw) { my ($time, @lines) = read_current_values(); if (defined $time) { for my $line (@lines) { my ($val, $units, $name) = split /\t/, $line, 3; $val = sprintf "%.3f", $val; # Internationalize $line = join("\t", $val, $units, $name); my ($n, $k) = split '@', $name; $line .= "\t$config{collector}{$k}{sensor}{$n}{name}"; } print join("\n", strftime("%c",localtime($time)), @lines), "\n"; } else { print $lh->maketext("The logging daemon does not seem to be running\n"); } } elsif ($opt_current) { $date_from = $date_to = PROGRAM_START(); do_report(collect_data()); } else { parse_and_assign_dates(); do_report(collect_data()); } } elsif ($opt_annotate) { check_opts("annotate", @common, @unitspec, @annotate); parse_and_assign_dates(); if ($config{view}{$opt_view}{type} eq "graph") { die "View '$opt_view' is an graph: use -graph, not -annotate\n"; } do_annotate(); } elsif ($opt_graph) { check_opts("graph", @common, @daterange, @unitspec, @graph); parse_and_assign_dates(); if ($config{view}{$opt_view}{type} eq "image") { die "View '$opt_view' is an image: use -annotate, not -graph\n"; } do_graph(collect_data($config{view}{$opt_view}{cliplo}, $config{view}{$opt_view}{cliphi})); } elsif ($opt_checkconfig) { check_opts("checkconfig", @common, @checkconfig); if ($opt_list) { my @list; print "CONFIG\t$opt_config\n"; if ($config{logformat} eq "text") { print "LOGDIR\t$config{logwrite}\n"; } elsif ($config{logformat} eq "sql") { print "LOGSQL\t$config{_sql_type} $config{_database} $config{_db_auth}\n"; } else { die "Unknown LogFormat $config{logformat}"; } for my $k (keys %{ $config{collector} }) { for my $n (keys %{ $config{collector}{$k}{sensor} }) { push @list, "$config{collector}{$k}{sensor}{$n}{logfile}\n"; } } print "LOGFILE\t$_" for sort @list; } else { dump_config(); send_test_emails() if $opt_email; } } elsif (defined $opt_i18n) { check_i18n(); } else { die "Shouldn't get here!"; } } exit; ############################################################################## # Daemon ############################################################################## my (@my_select_buffer, $next_log_time); sub do_daemon { my ($rin, $rout, %rfd, $now, $fileno, $k, $ak, $n, $val, $fd, $collector, $sensor, $extra, $alter_ego); # # Fork and detach... We use POSIX::_exit so that we don't go through # Perl's exit handlers and shutdown routines. # unless ($opt_nofork) { print "Forking and backgrounding...\n" if $opt_verbose; my $pid = fork; die "Couldn't fork - $!\n" unless defined $pid; POSIX::_exit(0) if $pid; # Parent exits, child lives on print "Daemon child PID == $$\n" if $opt_verbose; POSIX::setsid() or die "Couldn't start new session\n"; msg("notice", "Backgrounded..."); } # # Store the current PID (child, or -nofork) into the PID file # unless ($config{pidfile} eq File::Spec->devnull()) { $fd = $config{_pidfile_fd}; truncate $fd, 0; print $fd "$$\n"; # ...and keep the file open to stay locked... } # # Start by building bit vectors of all the collectors, so we can read # from them as data becomes available. Also make an association between # the fileno and the collector name (so we know what we are reading when # we read it). # $rin = ''; for my $k (keys %{ $config{collector} }) { $collector = $config{collector}{$k}; # # Read-only collectors are (obviously) not polled. Individual # underground collectors are all handled by a single # wunderground_group collector # next if $collector->{readonly}; next if $collector->{type} eq "wunderground"; vec($rin, $collector->{_fd}->fileno, 1) = 1; $rfd{$collector->{_fd}->fileno} = $k; } # # Before looping, go to sleep for 5 seconds before collecting any data (to # give collectors time to read), then calculate the next time to log data. # print "Running...\n" if $opt_nofork; print "Waiting 5 seconds before polling...\n" if $opt_verbose; sleep 5; $next_log_time = find_next_log_time(); # # Main daemon loop. The use of "select" precludes the use of buffered # I/O, so we can't use getline - so beware the funky code below... The # call to my_select is non-blocking - it will return any FDs that have a # line of data. We shuffle through those, see if it is at or past time to # to log (logging if necessary), and then lather, rinse, repeat. # while (1) { my_select($rout=$rin, \%rfd); $now = time; while (($fileno, $k) = each %rfd) { $collector = $config{collector}{$k}; next unless vec($rout, $fileno, 1); printf " %s: %d line%s\n", $k, scalar @{$my_select_buffer[$fileno]}, @{$my_select_buffer[$fileno]} == 1 ? "" : "s" if $opt_verbose; LINE: while (@{$my_select_buffer[$fileno]}) { $_ = shift @{$my_select_buffer[$fileno]}; #nv# print "$now $k: $_\n" if $opt_verbose; # # All polled collectors are generic, because the poller can # reformat the data. All streaming collectors are parsed # here, since there is no poller to reformat their data # if ($collector->{_datatype} eq "generic") { # Lines look like "NN 19.625" (where NN is sensor number) ($n, $val) = split; } elsif ($collector->{_datatype} eq "wunderground_group") { # Lines look like "NN 19.625 KK" (KK is real collector name) # See below for more details on $alter_ego ($n, $val, $ak) = split /\s+/, $_, 3; $alter_ego = $collector; $collector = $config{collector}{$ak}; } elsif ($collector->{_datatype} eq "qk145") { next LINE unless /^\d/; # Skip non-temp lines # Lines look like "1 0081.95" ($n, $val) = split; # This seems redundant, but Heison has shown it's needed next unless $n =~ /^[1-4]$/ && $val =~ /\d+\.\d+/; } elsif ($collector->{_datatype} eq "vk011") { next LINE unless /^Sensor/; # Skip non-temp lines # Lines look like "Sensor 1 +81.95 DegC" (and more?) ($n, $val) = /Sensor\s+(\d)\s+([+-]?[\d.]+)/; } elsif ($collector->{_datatype} eq "temp08") { # Lines are complicated... ($n, $val, $extra) = (); if (/^Temp .*\[([\dA-F]{16})\]=(-?[\d.]+)C/) { ($n, $val) = ($1, $2); $n = hunt_for_sensor($collector, $n, "temperature"); next LINE unless defined($n); } elsif (/^Humidity .*\[([\dA-F]{16})\]=(\d+)%/) { ($n, $val) = ($1, $2); $n = hunt_for_sensor($collector, $n, "humidity"); next LINE unless defined($n); } elsif (/^Barometer .*\[([\dA-F]{16})\]=(\d+) inHg/) { ($n, $val) = ($1, $2); $n = hunt_for_sensor($collector, $n, "barometer"); next LINE unless defined($n); } elsif (/^Rain .*\[([\dA-F]{16})\]=([\d.]+) Inch/) { ($n, $val) = ($1, $2); $n = hunt_for_sensor($collector, $n, "rain"); next LINE unless defined($n); } elsif (/^Lightning .*\[([\dA-F]{16})\]=([\d.]+)/) { ($n, $val) = ($1, $2); $n = hunt_for_sensor($collector, $n, "lightning"); next LINE unless defined($n); } elsif (/^Wind Dirn\[([\dA-F]{16})\]=(\w+)/) { ($n, $val) = ($1, $compass{$2}); $n = hunt_for_sensor($collector, $n, "direction"); next LINE unless defined($n); } elsif (/^Wind Speed\[([\dA-F]{16})\]=(\d+).*=\s+(\d+)/) { ($n, $val, $extra) = ($1, $2, $3); $n = hunt_for_sensor($collector, $n, "speed"); next LINE unless defined($n); # # NOTE! Nothing in life (or programming) is simple. # Every sensor (except one!) gives one reading on one # line. For the wind speed and gust sensor, we extract # both values, and record the speed. We then construct # a fake gust line, push it into the input stream, and # reexecute the loop - where the data is picked up on # a later loop on the "fabricated data" line below. # if (defined $extra) { my $N = $n; $N =~ s/\.\w$//; # remove HUNTed subindex push @{$my_select_buffer[$fileno]}, "Wind Gust[$N]=$extra"; } } # # This is fabricated data - see above for details # elsif (/^Wind Gust\[([\dA-F]{16})\]=(\d+)/) { ($n, $val) = ($1, $2); $n = hunt_for_sensor($collector, $n, "gust"); next LINE unless defined($n); } } elsif ($collector->{_datatype} eq "snmp_trap") { # Data looks like "IP_NUM OID = val\tOID = val\t..." # # All SNMP traps come from a single snmp_trap collector, # but they reflect events on potentially multiple other # collectors. When we get a trap, split the payload # until we find a match in the snmp_trap collector's # trap_lookup hash, then switch to that collector and # sensor number (we'll switch back to our true identity # at the end of this loop). # my ($addr, $oid, $v); ($addr) = /([\d.]+)/; s/[\d.]+\s+//; PAYLOAD: for my $pair (split /\t/) { ($oid, $v) = split / = /, $pair; if (exists $collector->{_trap_lookup}{"$addr:$oid"}) { my $trap = $collector->{_trap_lookup}{"$addr:$oid"}; $alter_ego = $collector; $collector = $trap->{collector}; $n = $trap->{n}; $val = $v == $collector->{sensor}{$n}{snmponvalue} ? 1 : 0; last PAYLOAD; } } # # Sometimes we might get a spurious or misdirected trap # next LINE unless defined $alter_ego; } else { die "Unexpected collector $k datatype: $collector->{_datatype}" } unless (defined $val) { print "\t?? Unable to parse data\n" if $opt_verbose; next LINE; # There weren't two fields (?) } # # Throw out bogus values (and log them) and ignore ReadOnly # sensors. Then tweak the values if necessary using AdjustBy # or OnValue/OffValue # $sensor = $collector->{sensor}{$n}; next LINE if $sensor->{readonly}; if (($sensor->{_scale} eq "F" && $val >= 257) || ($sensor->{_scale} eq "C" && $val >= 125)) { msg("err", "OverTemp $sensor->{_nk} == $val"); next LINE; } elsif (($sensor->{_scale} eq "F" && $val <= -67) || ($sensor->{_scale} eq "C" && $val <= -55)) { msg("err", "UnderTemp $sensor->{_nk} == $val"); next LINE; } elsif (($sensor->{_scale} eq "MPH" || $sensor->{_scale} eq "%") && $val >= 100) { msg("err", "Overdriven $sensor->{_nk} == $val"); next LINE; } elsif (($sensor->{_scale} eq "MPH" || $sensor->{_scale} eq "%") && $val < 0) { msg("err", "Underdriven $sensor->{_nk} == $val"); next LINE; } elsif ($sensor->{_scale} eq "inHg" && $val >= 32) { msg("err", "Overdriven $sensor->{_nk} == $val"); next LINE; } elsif ($sensor->{_scale} eq "inHg" && $val <= 29) { msg("err", "Underdriven $sensor->{_nk} == $val"); next LINE; } # # Turn on/off values into logged values # if ($sensor->{type} eq "onoff") { if ($val) { # Non-zero == On $val = $sensor->{onvalue}; } else { $val = $sensor->{offvalue}; } } # # Adjust the sensor - unless it is a wind direction sensor. # The reason is that this will throw off the consensus # averaging algorithm - so do it after we average (and also # just below for the "current" value, a special case) # # NOTE: for some sensors, AdjustBy is disallowed in the # config, so we'll simply be adjusting by 0 here... # unless ($sensor->{type} eq "direction") { $val += $sensor->{adjustby}; } # # Handle wind gusts specially - we only care about the maximum # value, not the average. Values are reset to 0 when we log # every LogInterval minutes. Trick out _last5 to only have # whatever the maximum value is. # if ($sensor->{type} eq "gust") { if ($val >= $sensor->{_sum}) { $sensor->{_sum} = $val; # Maximum $sensor->{_last5} = [ $val ]; } $sensor->{_count} = 1; } # # Likewise, handle rainfall (and for the TEMP08, lightning) # specially. For rain, the thermd counter continuously # increases until it is reset after a period of inactivity. # For the TEMP08, the data value always increases until reset # (since it is summed in the sensor), so we care when it goes # up. For everything, the collector code reports on the # delta value, so we only care if the value is > 0. # Total values are potentially reset to 0 when we log every # LogInterval minutes. # elsif ($sensor->{type} eq "rain") { if ($collector->{type} eq "temp08") { if ($val > $sensor->{_last5}->[0]) { $sensor->{_sum} = $val; # Overwrite $sensor->{_lastchange} = $now; } } elsif ($val > 0) { $sensor->{_sum} += $val; # Increment $sensor->{_lastchange} = $now; } $sensor->{_count} = 1; $sensor->{_last5} = [ $sensor->{_sum} ]; } elsif ($sensor->{type} eq "lightning" && $collector->{type} eq "temp08") { if ($val > $sensor->{_last5}->[0]) { $sensor->{_sum} = $val; # Overwrite $sensor->{_lastchange} = $now; } $sensor->{_count} = 1; $sensor->{_last5} = [ $sensor->{_sum} ]; } # # WattHours (from the enersure, smartnet, etc) is a measure # of usage since the last reading - so we need to accumulate # the values in between log periods, instead of averaging # them. # elsif ($sensor->{type} eq "wh") { # Don't count the very first reading, which may be huge # after a long lapse in readings if (defined($sensor->{_lastchange})) { $sensor->{_sum} += $val; # Increment } else { $sensor->{_sum} = 0; } $sensor->{_count} = 1; $sensor->{_last5} = [ $sensor->{_sum} ]; $sensor->{_lastchange} = $now; } # # And counters are special too. If ResetAfter is undefined, # they increment for whatever LogInterval is, and then are # reset back to 0. If ResetAfter is defined, the counter is # only reset after that amount of inactivity. The sensor # simply reports the difference between now and the last # reading, so we sum but keep the count at 1 (so it is a sum, # not an average).. # # Since counters can have a multiplyby of negative (e.g., for # SNMP network counters), we multiply again here to keep # things sane. # elsif ($sensor->{type} eq "counter") { if ($val * $sensor->{multiplyby} > 0) { $sensor->{_lastchange} = $now; $sensor->{_sum} += $val; # "Increment" } $sensor->{_count} = 1; $sensor->{_last5} = [ $sensor->{_sum} ]; } # # Wind direction is also special. If you simply average the # direction values, then NNW (348.75 degrees) averaged with # NNE (11.5 degrees) will yield S (180 degrees). The solution # is to do a consensus average (described later) and to do # that we have to keep track of all direction data collected # for this measurement period in {_weight}. We still use the # single _last5 value for "current" readings. Note that we # adjust *after* we store the value in the weighted average # holder, so that "current" values print correctly, but we # still average on the raw data (and adjust the average after # we compute it). # elsif ($sensor->{type} eq "direction") { $sensor->{_weight}{$val}++; $val += $sensor->{adjustby}; $val -= 360 if $val >= 360; $val += 360 if $val < 0; $sensor->{_sum} = $val; $sensor->{_count} = 1; $sensor->{_last5} = [ $val ]; } # # For everything else, collect the current value as well as # pre-compute the long-term average. Keep the last 5 readings # for a short-term average. Ensure that the short-term average # _last5 only has 5 entries # else { # # Gauges can have a MultiplyBy to adjust their scale. # if ($sensor->{type} eq "gauge") { $val *= $sensor->{multiplyby}; } $sensor->{_sum} += $val; # Averaging $sensor->{_count}++; push @{ $sensor->{_last5} }, $val; if (@{ $sensor->{_last5} } > 5) { @{$sensor->{_last5}} = splice @{$sensor->{_last5}}, -5; } } # # The _lastdata field is used to detect sensor failures # $sensor->{_lastdata} = $now; } continue { # # If we were an snmp_trap handler, we changed the collector # identity above, so now we need to reset it. # $collector = $alter_ego if defined $alter_ego; undef $alter_ego; } } # # Update the current file every time through (determined by the # minimum PollInterval value). If $next_log_time has arrived, also # do the logging and RSS. FInally, figure out how long to sleep # before doing the next readings. We want to sleep for _minpoll # seconds, or until $next_log_time, whichever is less (if _minpoll # is 0, which happens if all the collectors are streaming, then # use 10 seconds as a "safe" value). # if ($config{logformat} eq "sql") { next unless connect_to_database(0); } update_current(); if (time >= $next_log_time) { # Compare REAL time, not saved time do_log_and_rss($next_log_time); $next_log_time = find_next_log_time(); } if ($config{logformat} eq "sql") { $sth->finish; $dbh->disconnect; } } continue { $now = time; sleep ((($next_log_time - $now > $config{_minpoll}) || ($next_log_time - $now <= 0)) ? $config{_minpoll} : ($next_log_time - $now)); } # # We should never get here # msg("alert", "Abnormal termination - restarting"); if ($config{logformat} eq "sql") { $sth->finish; $dbh->disconnect; } get_kicked("HUP"); } # # The extra parameters are used for multivalue sensors like the D2P # sub hunt_for_sensor ($$$;$$) { my ($collector, $n, $type, $extra, $match) = @_; my $n_re = qr/^$n/; for my $nx (grep { /^$n_re/ } keys %{ $collector->{sensor} }) { next unless exists $collector->{sensor}{$nx}; if ($collector->{sensor}{$nx}{type} eq $type) { if ($extra) { next unless $collector->{sensor}{$nx}{$extra} eq $match; return $nx; } else { return $nx; } } } return undef; # No match! } sub get_kicked { my $kicked = shift; msg("notice", "Received $kicked signal"); print "\nPID $$ Received $kicked signal\n" if $opt_verbose; # # We get here under two conditions - the first is we got a HUP, INT or # TERM signal (if we get a HUP, we restart). The second is because the # main daemon loop terminated for some unknown reason. Either way, # close down file handles and kill our kids, and optionally restart. # if ($config{logformat} eq "text") { for my $k (sort keys %{ $config{collector} }) { if ($config{collector}{$k}{type} =~ /qk145|vk011/) { for my $n (sort keys %{ $config{collector}{$k}{sensor} }) { close $config{collector}{$k}{sensor}{$n}{_fd}; } } } } elsif ($config{logformat} eq "sql") { $sth->finish if defined $sth; $dbh->disconnect if defined $dbh; } else { die "Unknown LogFormat"; } if (!$is_child && @kids) { msg("err", "Infanticide from PID $$ - $0, killing kids: @kids"); kill POSIX::SIGTERM(), @kids; } if ($kicked eq "HUP") { my $SELF = catfile $FindBin::Bin, $script; my @cmd = ("$SELF", "-daemon", "-config", $opt_config); push @cmd, "-verbose" if $opt_verbose; push @cmd, "-nofork" if $opt_nofork; msg("notice", "Kicked & restarting: @cmd"); exec @cmd; msg("err", "Cannot restart @cmd - $!"); } msg("notice", "Shutting down"); exit; } sub update_current { my ($sensor, $collector); my $now = time; my ($min, $hr, $day, $month) = (localtime($now))[1..4]; my $nowstr = sprintf "%02d%02d %02d%02d", $hr, $min, ++$month, $day; # # Update the "current" file. We don't care what kind of collector we # have - the data has already been collected in a device-dependent way # and sanitized. Also, check for any alarm conditions that may have been # tripped (or reset), and for failed sensors. # print "UPDATING 'current' $nowstr\n" if $opt_verbose; if ($config{logformat} eq "text") { print "Opening $config{logwrite}/current.tmp\n" if $opt_verbose; open CURRENT, ">", "$config{logwrite}/current.tmp" or warn "Can't open $config{logwrite}/current.tmp - $!\n"; CURRENT->autoflush(1); print CURRENT strftime("%c", localtime $now), "\t$now\n"; } elsif ($config{logformat} eq "sql") { $dbh->begin_work(); # Start of grouped transaction $sth = $dbh->prepare("DELETE FROM current"); $sth->execute(); } else { die "Unknown LogFormat"; } COLLECTOR: for my $k (keys %{ $config{collector} }) { $collector = $config{collector}{$k}; next COLLECTOR if $collector->{readonly}; SENSOR: for my $n (keys %{ $collector->{sensor} }) { my ($sum, $cnt, $avg); $sensor = $collector->{sensor}{$n}; next SENSOR if $sensor->{readonly}; # # If we haven't seen data for a bit over 5*PollInterval, the sensor # is flagged as dead (or alternatively, revived if we _do_ get data) # if ($now - $sensor->{_lastdata} > 5*$collector->{pollinterval}+10) { unless ($sensor->{_failed}++) { msg("crit", "\u$sensor->{type} sensor $sensor->{_nk} failed"); @{ $sensor->{_last5} } = (); } } else { if ($sensor->{_failed}) { msg("crit", "\u$sensor->{type} sensor $sensor->{_nk} returned"); } $sensor->{_failed} = 0; } # # Average the last 5 measurements (or as many as there are). # $sum = $cnt = 0; for my $t (@{ $sensor->{_last5} }) { $sum += $t; $cnt++; } if ($cnt) { $avg = $sum / $cnt; if ($config{logformat} eq "text") { printf CURRENT "%.3f\t%s\t%s@%s\n", $avg, $sensor->{_scale}, $n, $k; } elsif ($config{logformat} eq "sql") { $sth = $dbh->prepare( "INSERT INTO current " . "(logtime, value, units, log_id, log_name) VALUES " . "($now, $avg, '$sensor->{_scale}', $sensor->{_id}, '$n\@$k')"); $sth->execute(); } else { die "Unknown LogFormat"; } check_alarm($k, $n, $avg, $nowstr); } } } if ($config{logformat} eq "text") { print "Closing $config{logwrite}/current.tmp\n" if $opt_verbose; close CURRENT; print "Renaming current.tmp => current\n" if $opt_verbose; rename "$config{logwrite}/current.tmp", "$config{logwrite}/current" or msg("err", "Cannot rename current.tmp => current - $!"); } elsif ($config{logformat} eq "sql") { $dbh->commit(); # End of grouped transaction } else { die "Unknown LogFormat"; } } sub ztrim { my $in = shift; my $out = sprintf "%.3f", $in; $out =~ s/0+$//; # Trim trailing 0's $out =~ s/\.$//; # In case the number was N.000 return $out; } sub reset_temp08_counter { my ($collector, $sensor, $n) = @_; my ($hex, $id); # # Look inside the results of the DIS command to find the sensor number of # the gauge so we can send it an RST command. # ($hex = $n) =~ s/\.\w$//; # Shouldn't be there anyway ($id) = $collector->{_DIS_str} =~ /^(\d\d)\s+$hex/mi; msg("notice", "Resetting TEMP08 $sensor->{type} gauge $id $hex"); $collector->{_fd}->print("RST$id"); sleep 1; $collector->{_fd}->print("y"); } sub do_log_and_rss { my $now = shift; my ($sensor, $collector); our $every; # Persistent data, locally scoped # # Only write per-file log data once every LogInterval minutes. If # we are here, then it is time! Once we write, reset the averaging # counts (so we calculate LogInterval-minute averages and not # averages since boot-time!) # if ($opt_verbose) { printf "UPDATING LOGFILES @ %s\n", strftime("%c", localtime); printf " SCHEDULED FOR %s\n", strftime("%c", localtime($now)); } COLLECTOR: for my $k (sort keys %{ $config{collector} }) { $collector = $config{collector}{$k}; next COLLECTOR if $collector->{readonly}; SENSOR: for my $n (sort keys %{ $collector->{sensor} }) { $sensor = $collector->{sensor}{$n}; next SENSOR if $sensor->{readonly}; if ($sensor->{_count}) { my ($avg, $fd, $str); # # For wind direction, calculate the consensus average. # For every other sensor type, a simple average is good # enough. We adapt the consensus average algorithm found # at http://www.beals5.com/wx/faqs.htm # if ($sensor->{type} eq "direction") { my (%weight_sum, $max_sum, $max_idx); for (my $i = 0; $i < 90; $i += 22.5) { $sensor->{_weight}{$i+360} = $sensor->{_weight}{$i}; } for (my $i = 0; $i < 360; $i += 22.5) { $weight_sum{$i} = $sensor->{_weight}{$i} + $sensor->{_weight}{$i+22.5} + $sensor->{_weight}{$i+45} + $sensor->{_weight}{$i+67.5} + $sensor->{_weight}{$i+90}; if ($weight_sum{$i} > $max_sum) { $max_sum = $weight_sum{$i}; $max_idx = $i; } } if ($weight_sum{$max_idx}) { $avg = $max_idx + (($sensor->{_weight}{$max_idx+22.5} + (2 * $sensor->{_weight}{$max_idx+45}) + (3 * $sensor->{_weight}{$max_idx+67.5}) + (4 * $sensor->{_weight}{$max_idx+90})) * 22.5 / $weight_sum{$max_idx}); } else { # Only happens if there is no wind direction data $avg = 0; } # # After we have done the average on the raw values, we # apply the adjust_by value. We MUST average on the # raw values, else the constants built into the algorithm # above don't reference values correctly # $avg -= 360 if $avg > 360; $avg += $sensor->{adjustby}; $avg -= 360 if $avg >= 360; $avg += 360 if $avg < 0; $sensor->{_weight} = {}; } else { $avg = $sensor->{_sum} / $sensor->{_count}; } # # Write to logfile # if ($config{logformat} eq "text") { $str = sprintf "%010d\t%.3f", $now, $avg; $fd = $sensor->{_fd}; seek ($fd, 0, 2); # Append to file print $fd "$str\n"; } elsif ($config{logformat} eq "sql") { $str = sprintf "(%010d,%d,%.3f)", $now, $sensor->{_id}, $avg; $sth = $dbh->prepare( "INSERT INTO readings " . "(logtime, log_id, value) VALUES " . $str); $sth->execute(); } else { die "Unknown LogFormat"; } print "\t$str\t$sensor->{name}\n" if $opt_verbose; $sensor->{_last} = $avg; # # Reset the sum and count to 0 after logging. However, # counters with a defined ResetAfter (which includes the # rain gauges) never go down except irregularly, so do not # reset their values (except as below) # unless ($sensor->{resetafter}) { $sensor->{_sum} = 0; $sensor->{_count} = 0; } } else { print "\tNO DATA\t$sensor->{name}\n" if $opt_verbose; $sensor->{_last} = undef; $sensor->{_sum} = 0; $sensor->{_count} = 0; } # # Here is where we reset counters with a ResetAfter (this includes # all rain gauges) if there has been been no change in N hours. # For the TEMP08, we also have to reset the collector. For the # other collectors, we only reset the locally stored numbers. # if ($sensor->{resetafter} && $sensor->{_last5}->[0] > 0 && defined $sensor->{_lastchange} && $now - $sensor->{_lastchange} > $sensor->{resetafter}) { # # Reset the TEMP08 counter # if ($collector->{type} eq "temp08") { reset_temp08_counter($collector, $sensor, $n); } # # Always reset the internal counters # $sensor->{_last5} = [ 0 ]; $sensor->{_last} = 0; $sensor->{_sum} = 0; $sensor->{_count} = 0; } # # For TEMP08 lightning sensors, also reset the TEMP08 counter # if ($sensor->{type} eq "lightning" && $collector->{type} eq "temp08") { reset_temp08_counter($collector, $sensor, $n); } } } # # If there are any Wunderground views, send the data to wunderground # for my $view (keys %{ $config{_view} }) { if ($config{view}{$view}{type} eq "wunderground") { send_to_wunderground($view); } } # # And only generate RSS data every Every iterations of log writes # if ($config{rss} && ++$every == $config{rss}{every}) { generate_rss(); $every = 0; } # # For sanity's sake, restart once a month (*after* writing out data) # if ($now - $^T > 86400*30) { msg("notice", "Monthly restart of daemon"); get_kicked("HUP"); # NOTREACHED } } # # The next time we want to log is the next round value of LogInterval seconds # sub find_next_log_time { my $retval; my $now = time; $retval = int(($now + $config{loginterval}) / $config{loginterval}) * $config{loginterval}; print "Next log at $retval, in ", $retval-$now, " secs\n" if $opt_verbose; return $retval; } sub readval { my ($collector, $nx, $sub) = @_; my ($val, $str, $fn); if ($collector->{type} eq "owfs") { ($fn = "$collector->{mountpoint}/$nx/$sub") =~ s#//#/#g; open S, "<", $fn or msg("err", "Cannot open OWFS file $fn - $!"); chomp($val = ); close S; } elsif ($collector->{type} eq "owhttpd") { $fn = "$collector->{_baseurl}/$nx/$sub"; $str = $collector->{_ua}->get($fn)->content; ($val) = $str =~ m#$sub\s*((-\s*)?[\d.]+|yes|no)#i; } elsif ($collector->{type} eq "owshell") { $val = `owread -s $collector->{_baseurl} $nx/$sub`; } else { die "Unknown collector type $collector->{type}"; } if ($val =~ /yes/i) { return 1; } elsif ($val =~ /no/i) { return 0; } elsif ($val =~ /\d/) { # Any digit means we treat it like a number return $val; } else { next SENSOR; # Clever! Makes fork_owfs_poller skip sensor # WARNING: uses up-level addressing. } } sub compute_speed_gust { my ($sensor, $v, $now) = @_; my ($deltaT, $deltaC, $speed); $sensor->{_now} = $now; if ($sensor->{_then}) { $deltaT = $sensor->{_now} - $sensor->{_then}; if ($v >= $sensor->{_last}) { $deltaC = $v - $sensor->{_last}; } else { $deltaC = $v + (0xFFFFFFFF - $sensor->{_last}); } # Report MPH - other options converted in adjust_for_scale() $speed = 2.453 * $deltaC / $deltaT; } else { $speed = undef; } $sensor->{_then} = $sensor->{_now}; $sensor->{_last} = $v; return $speed; } sub compute_rain_lightning_counter { my ($sensor, $v) = @_; my $deltaC; if (defined $sensor->{_tare}) { if ($v >= $sensor->{_tare}) { $deltaC = $v - $sensor->{_tare}; } else { $deltaC = $v + (0xFFFFFFFF - $sensor->{_tare}); } } else { $deltaC = 0; } # # Sometimes the rain sensor goes runaway... # if ($sensor->{type} eq "rain" && $deltaC > 10) { msg("err", "Count of $deltaC too high on rain gauge $sensor->{name}"); $deltaC = 0; } # # All counters are scaled by MultiplyBy # $deltaC *= $sensor->{multiplyby}; # # Reset tare every time - let the daemon do the summing or maxima. # $sensor->{_tare} = $v; return $deltaC; } sub compute_windchill { # # See http://en.wikipedia.org/wiki/Wind_chill - requires degrees C, KPH # my ($T, $V) = @_; my $Ve = $V ** 0.16; return undef if $T < -50 || $T > 5 || $V < 3; return 13.12 + 0.6215*$T - 11.37 * $Ve + 0.3965 * $T * $Ve; } sub compute_dewpoint { # # See http://en.wikipedia.org/wiki/Dew_point - requires degrees C, %RH # my ($T, $RH) = @_; return undef if $T <= 0 || $T >= 60; my $a = 17.27; my $b = 237.7; my $gamma = (($a * $T) / ($b + $T)) + log($RH / 100); return ($b * $gamma) / ($a - $gamma); } sub compute_heatindex { # # See http://en.wikipedia.org/wiki/Heat_index - the subroutine requires # degrees C and %RH, but the formula requires degrees F, so we convert # back and forth. # my ($T, $RH) = @_; $T = $T * (9/5) + 32; return undef if $T < 80 || $RH < 40; my $c1 = -42.379; my $c2 = 2.04901523; my $c3 = 10.14333127; my $c4 = - 0.22475541; my $c5 = - 6.83783e-3; my $c6 = - 5.481717e-2; my $c7 = 1.22874e-3; my $c8 = 8.5282e-4; my $c9 = - 1.99e-6; return (($c1 + $c2*$T + $c3*$RH + $c4*$T*$RH + $c5*$T**2 + $c6*$RH**2 + $c7*$T**2*$RH + $c8*$T*$RH**2 + $c9*$T**2*$RH**2) - 32) * (5/9); } sub compute_humidex { # # See http://en.wikipedia.org/wiki/Heat_index - requires degrees C and %RH # my ($T, $RH) = @_; my $e = 6.112 * 10**((7.5*$T)/(237.7+$T)) * ($RH/100); return $T + (5/9)*($e - 10); } sub fork_owfs_poller { # Supports owfs, owhttpd, and owshell my $name = shift; my $collector = $config{collector}{$name}; my ($v, $fn, $n, $nx, $now, $start, $addr, $h, $t, %latch, %sense, %save); my $fd = new FileHandle; die "Unknown collector" unless $collector->{type} =~ /^(owfs|owhttpd|owshell)$/; print "Forking $collector->{type} poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for OWFS $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ @{[$collector->{ipaddress} || $collector->{mountpoint}]}"; # # Continually rotate through the collection of sensors, requesting them # in turn from owfs, owhttpd, or owshell # while (1) { $start = time; # # WARNING! The "SENSOR:" label is up-level addressed in readval() # SENSOR: for my $n (sort keys %{ $collector->{sensor} }) { my $sensor = $collector->{sensor}{$n}; ($nx = $n) =~ s/\.\w$//; # Remove subindex if ($nx =~ /^(10|22|26|28)/) { warn "Missing owfs filename for $n!" unless $sensor->{_owfs}; # # Handle temperature, humidity, etc first # $v = readval($collector, $nx, $sensor->{_owfs}); print "$n $v\n"; } elsif ($nx =~ /^12/) { # # Deal with the DS2406's. # if ($sensor->{type} eq "barometer") { # The sensor reads in millibar, we want inHg (and convert # to display units elsewhere) $v = readval($collector, $nx, $sensor->{_owfs}) / 33.863788; print "$n $v\n"; } elsif ($sensor->{type} eq "temperature") { # Reads in Celsius (which is what we expect) $v = readval($collector, $nx, $sensor->{_owfs}); print "$n $v\n"; } elsif ($sensor->{type} eq "onoff") { my $p = uc $sensor->{pio}; $latch{sensor}->{pio} = readval($collector, $nx, "latch.$p"); $sense{sensor}->{pio} = readval($collector, $nx, "PIO.$p"); # # Send the current value of the sensors. But since the sensor # knows what transitions were made, if the switch toggled # on-off-on (or off-on-off), send TWO measurements (and # always send the current state last). # if (defined $save{$addr}{$p} && $sense{$p} == $save{$addr}{$p} && $latch{$p}) { print "$n ", 1 - $sense{$p}, "\n"; } print "$n $sense{$p}\n"; # # Save the values for comparison next time around # $save{$addr}{a} = $sense{a}; $save{$addr}{b} = $sense{b}; # # Finally, reset the latches # msg("err", "I have no idea if the latches for $collector->{mountpoint}/$nx are reset this way..."); open S, ">", "$collector->{mountpoint}/$nx/latch.$p" or next SENSOR; print S "0\n"; close S; } else { die "Sanity error - please contact dan\@klein.com"; } } elsif ($nx =~ /^1D/) { die "Missing owfs filename!" unless $sensor->{_owfs}; # # Now deal with the DS2423's. For speed or gust only print # one value (since we are walking the real sensors) # $v = readval($collector, $nx, $sensor->{_owfs}); if ($sensor->{type} =~ /^(speed|gust)$/) { my $speed = compute_speed_gust($sensor, $v, time()); print "$n $speed\n" if defined $speed; } elsif ($sensor->{type} =~ /^(rain|lightning|counter)$/) { my $deltaC = compute_rain_lightning_counter($sensor, $v); print "$n $deltaC\n"; } else { msg("err", "Unknown type for 2423 in OWFS $name"); } } elsif ($nx =~ /^20/) { my ($A, $B, $C, $D, $dir); # # Now deal with the tricky case - the multi-value 2450 sensors. # We have to aquire a lock, and read a few values, and assemble # the direction data based on a lookup table. # # Extract the 4 values and scale them to high/medium/low (the # actual values are roughly 0, 2.5, and 5 volts). # $A = readval($collector, $nx, "volt.A"); $B = readval($collector, $nx, "volt.B"); $C = readval($collector, $nx, "volt.C"); $D = readval($collector, $nx, "volt.D"); for ($A, $B, $C, $D) { if ($_ > 4) { $_ = 2; } elsif ($_ > 1) { $_ = 1; } else { $_ = 0; } } if ($sensor->{inverted}) { $dir = $compass_lookup{"$D$C$B$A"}; } else { $dir = $compass_lookup{"$A$B$C$D"}; } next SENSOR unless defined $dir; print "$n $dir\n"; } else { die "Unknown sensor type for $n in owfs_poller"; } } } continue { # # After we cycle through the sensor list, figure out how long our # readings took, and pause before restarting. Since readings can # take a while, we want to sleep enough so that we can restart at the # start of the next PollInterval. But we have to be careful - if there # were enough sensors for our reading to take more than PollInterval # seconds, we don't want to sleep for a negative time (which is really # a *very* big positive time). Since we can't predict how long a # reading will take (we can only see how long it took to finish last # time), this will probably slowly skew. It doesn't matter - at worst, # we'll miss one set of readings in the main daemon loop. # $now = time; # Must read AFTER all the get()'s sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the OWFS poller exit?"); } sub fork_ha7net_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($url, $id, $lockid, $ua, $response, @response, $v, $count, $n, $n1, $now, $start, $addr, $h, $t, %latch, %sense, %save); my $fd = new FileHandle; eval qq{ use Digest::CRC 'crc16'; }; die $@ if $@; my @crc8 = ( 0,94,188,226,97,63,221,131,194,156,126,32,163,253,31,65, 157,195,33,127,252,162,64,30,95,1,227,189,62,96,130,220, 35,125,159,193,66,28,254,160,225,191,93,3,128,222,60,98, 190,224,2,92,223,129,99,61,124,34,192,158,29,67,161,255, 70,24,250,164,39,121,155,197,132,218,56,102,229,187,89,7, 219,133,103,57,186,228,6,88,25,71,165,251,120,38,196,154, 101,59,217,135,4,90,184,230,167,249,27,69,198,152,122,36, 248,166,68,26,153,199,37,123,58,100,134,216,91,5,231,185, 140,210,48,110,237,179,81,15,78,16,242,172,47,113,147,205, 17,79,173,243,112,46,204,146,211,141,111,49,178,236,14,80, 175,241,19,77,206,144,114,44,109,51,209,143,12,82,176,238, 50,108,142,208,83,13,239,177,240,174,76,18,145,207,45,115, 202,148,118,40,171,245,23,73,8,86,180,234,105,55,213,139, 87,9,235,181,54,104,138,212,149,203,41,119,244,170,72,22, 233,183,85,11,136,214,52,106,43,117,151,201,74,20,246,168, 116,42,200,150,21,75,169,247,182,232,10,84,215,137,107,53); sub crc8 { my $str = shift; my $crc = 0; my $byte; for (my $i = 0; $i < length($str); $i++) { $byte = ord(substr($str, $i, 1)); $crc = $crc8[$crc ^ $byte]; } return $crc; } print "Forking HA7Net poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for HA7Net $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ $collector->{ipaddress}"; # # Continually rotate through the collection of URLs, requesting them # in turn from the HA7Net # POLL: while (1) { $start = time; $count = 0; while ($count++ < @{$collector->{_urls}}) { $url = shift @{$collector->{_urls}}; push @{$collector->{_urls}}, $url; $response = $ua->get($url)->content; if ($response =~ /Read (DS18B20 Result|Temperature Reply)/) { # # Note - an empty temperature can match (and can happen on # device problems # @response = $response =~ /ID="Address.*?VALUE="([\da-fA-F]{16})" .*? ID="Temperature.*?VALUE="(-?[\d.]*)"/gx; while (($addr, $t) = splice(@response, 0, 2)) { next unless $t =~ /$numeric/; if (defined($n = hunt_for_sensor($collector, $addr, "temperature"))) { print "$n $t\n"; } } } elsif ($response =~ /Read Humidity Reply/) { # # Note - an empty humidity/temperature can match (and can # happen on device problems # @response = $response =~ /ID="Address.*?VALUE="([\da-fA-F]{16})" .*? ID="Humidity.*?VALUE="(-?[\d.]*)" .*? ID="Temperature.*?VALUE="(-?[\d.]*)"/gx; while (($addr, $h, $t) = splice(@response, 0, 3)) { next unless $h =~ /$numeric/ && $t =~ /$numeric/; if (defined($n1 = hunt_for_sensor($collector, $addr, "humidity"))) { print "$n1 $h\n"; } if (defined($n = hunt_for_sensor($collector, $addr, "temperature"))) { print "$n $t\n"; } else { # # Hunt to see if there was a combo'd temperature sensor # for my $n (keys %{ $collector->{sensor} }) { my $sensor = $collector->{sensor}{$n}; if ($sensor->{combo} eq $n1) { print "$n $t\n"; last; } } } } } elsif ($response =~ /Read Analog Probe Reply/) { # # Note - an empty probe/temperature can match (and can happen # on device problems # @response = $response =~ /ID="Probe_Address.*?VALUE="([\da-fA-F]{16})" .*? ID="Probe_Value.*?VALUE="(-?[\d.]*)" (?: .*? ID="Temperature_Address.*?VALUE="([\da-fA-F]{16})" .*? ID="Temperature.*?VALUE="(-?[\d.]*)" )?/gx; while (($addr, $h, $t) = splice(@response, 0, 3)) { next unless $h =~ /$numeric/ && $t =~ /$numeric/; if (defined($n1 = hunt_for_sensor($collector, $addr, "humidity"))) { print "$n1 $h\n"; } if (defined($n = hunt_for_sensor($collector, $addr, "temperature"))) { print "$n $t\n"; } else { # # Hunt to see if there was a combo'd temperature sensor # for my $n (keys %{ $collector->{sensor} }) { my $sensor = $collector->{sensor}{$n}; if ($sensor->{combo} eq $n1) { print "$n $t\n"; last; } } } } } else { msg("err", "Unknown response from HA7Net $name $response"); } } # # Next deal with the DS2406's. # DS2406: for my $addr (@{$collector->{_2406}}) { my ($val, $crc_in, $crc_out); $response = $ua->get("$collector->{_baseurl}/1Wire/WriteBlock.html?Data=F54DFFFFFFFFFF&Address=$addr")->content; if ($response =~ /Write Block Reply/) { ($val, $crc_in) = $response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]{10})([\da-fA-F]{4})"/; # # The DalSemi CRC16 is output as 1s complement, byte swapped # ($crc_out = sprintf "%04X", ~crc16(pack "H*", $val) & 0xffff) =~ s/(..)(..)/$2$1/; if ($crc_in ne $crc_out) { msg("warning", "CRC Error on onoff sensor $addr\@$name"); next DS2406; } $v = hex(substr($1, 6, 2)); $latch{b} = ($v & 0x20) >> 5 || 0; $latch{a} = ($v & 0x10) >> 4 || 0; $sense{b} = !($v & 0x08) || 0; # So closed/shorted ==> 1 $sense{a} = !($v & 0x04) || 0; # So closed/shorted ==> 1 # # Send the current value of the sensors. But since the sensor # knows what transitions were made, if the switch toggled # on-off-on (or off-on-off), send TWO measurements (and # always send the current state last). # for my $p ('a'..'b') { if (defined($n = hunt_for_sensor($collector, $addr, "onoff", "pio", $p))) { if (defined $save{$addr}{$p} && $sense{$p} == $save{$addr}{$p} && $latch{$p}) { print "$n ", 1 - $sense{$p}, "\n"; } print "$n $sense{$p}\n"; } } # # Save the values for comparison next time around # $save{$addr}{a} = $sense{a}; $save{$addr}{b} = $sense{b}; # # Finally, reset the latches # $ua->get("$collector->{_baseurl}/1Wire/WriteBlock.html?Data=F5CCFFFF&Address=$addr"); } else { msg("err", "Unknown answer for 2406 from HA7Net $name"); } } # # Now deal with the DS2423 counters. # DS2423: for my $addr (keys %{$collector->{_2423}}) { my $sensor = $collector->{_2423}{$addr}; my ($data, $crc_in, $crc_out); $response = $ua->get("$collector->{_baseurl}/1Wire/WriteBlock.html?Data=A5FF01FFFFFFFFFFFFFFFFFFFFFF&Address=$addr")->content; if ($response =~ /Write Block Reply/) { ($data, $crc_in) = $response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]{24})([\da-fA-F]{4})"/; # # The DalSemi CRC16 is output as 1s complement, byte swapped # ($crc_out = sprintf "%04X", ~crc16(pack "H*", $data) & 0xffff) =~ s/(..)(..)/$2$1/; if ($crc_in ne $crc_out) { msg("warning", "CRC Error on $sensor->{type} (counter) sensor $addr\@$name"); next DS2423; } $v = hex(substr($data, 14, 2) . substr($data, 12, 2) . substr($data, 10, 2) . substr($data, 8, 2)); if ($sensor->{type} =~ /^(speed|gust)$/) { my $speed = compute_speed_gust($collector, $v, time()); next DS2423 unless defined $speed; # # Elsewhere (in the logging daemon) we average the # speed and record the maximum gust - we just report # both here if requested. This is because we are walking # the ADDRESSES not the sensors themselves. # if (defined($n = hunt_for_sensor($collector, $addr, "speed"))) { print "$n $speed\n"; } if (defined($n = hunt_for_sensor($collector, $addr, "gust"))) { print "$n $speed\n"; } } elsif ($sensor->{type} =~ /^(rain|lightning|counter)$/) { my $deltaC = compute_rain_lightning_counter($sensor, $v); if (defined($n = hunt_for_sensor($collector, $addr, $sensor->{type}))) { print "$n $deltaC\n"; } } else { msg("err", "Unknown type for 2423 in HA7Net $name"); } } else { msg("err", "Unknown answer for 2423 from HA7Net $name $response"); } } #################################################################### # NOTE: All 1-wire transactions beyond this point are guarded by an # HA7Net transaction lock #################################################################### $response = $ua->get("$collector->{_baseurl}/1Wire/GetLock.html")->content; if ($response =~ /Get Lock Result/) { ($lockid) = $response =~ /NAME="LockID_0.*?VALUE="(\d+)"/; } else { msg("err", "Unknown lock reply for HA7Net $name"); next POLL; } # # Now deal with the tricky case - the multi-value 2450 sensors. We # have to read a few values, and assemble the direction data based # on a lookup table. # $count = 0; DS2450: while ($count++ < @{$collector->{_2450}}) { my ($n, $val, $crc_in, $crc_out, $ChanA, $ChanB, $ChanC, $ChanD, $A, $B, $C, $D); $id = shift @{$collector->{_2450}}; push @{$collector->{_2450}}, $id; $url = "$collector->{_baseurl}/1Wire/WriteBlock.html?Address=$id&LockID=$lockid"; # # Consult the DS2450 data sheet for the specific bit values used # below and for alternate settings. # # Setup each of the four channels for A to D conversion. We do # this a four separate url calls. This makes it a bit easier to # understand and avoids a length restriction on WriteBlock strings # # We select 8-bits of resolution and set IR to 1 for a 0-5.12 volt # range. Therefore, we want to write the two byte (08 and 01) to # locations 8 and 9 on memory page 1 (Control/Status) # # This is a tricky url to construct since each written byte has # it's own CRC and is ACKed byte by byte during the write cycle. # # Write Memory (55) starting at (0800) byte 08 byte 08 followed # by 16 read cycles (FFFF) for the CRC and 8 read cycles (FF) for # the echo of the written data. Now write 01 int byte 9. The # address auto increments so we only need to include reads for # CRC (FFFF) and echo'd data (FF). # ##$response = $ua->get("$url&Data=55080008FFFFFF01FFFFFF")->content; ##$response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]+)"/; # # And again for channel B, C and D of the AtoD. I have optimized # this below into two get's instead of four # ##$response = $ua->get("$url&Data=550A0008FFFFFF01FFFFFF")->content; ##$response = $ua->get("$url&Data=550C0008FFFFFF01FFFFFF")->content; ##$response = $ua->get("$url&Data=550E0008FFFFFF01FFFFFF")->content; # $ua->get("$url&Data=55080008FFFFFF01FFFFFF08FFFFFF01FFFFFF"); $ua->get("$url&Data=550C0008FFFFFF01FFFFFF08FFFFFF01FFFFFF"); # # Now we do an AtoD conversion (3c) of all 4 channels (0F00). # Don't forget the read time slots for the CRC (FFFF) # $response = $ua->get("$url&Data=3C0F00FFFF")->content; # # Read the results from memory page 0. Since we only asked for an # 8-bit conversion only use the most signficant byte of the result. # # Build the url with read command (AA) from Page 0 (0000), read # cycle for 8 bytes of return data (16 FFs) and a 2 byte CRC (FFFF) # $response = $ua->get("$url&Data=AA0000FFFFFFFFFFFFFFFFFFFF")->content; ($val, $crc_in) = $response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]{22})([\da-fA-F]{4})"/; # # The DalSemi CRC16 is output as 1s complement, byte swapped # ($crc_out = sprintf "%04X", ~crc16(pack "H*", $val) & 0xffff) =~ s/(..)(..)/$2$1/; if ($crc_in ne $crc_out) { msg("warning", "CRC Error on direction sensor $name/$id"); next DS2450; } # # Extract the 4 values and scale them to high/medium/low # $A = int(hex(substr($val, 8, 2)) / (256/3)); $B = int(hex(substr($val, 12, 2)) / (256/3)); $C = int(hex(substr($val, 16, 2)) / (256/3)); $D = int(hex(substr($val, 20, 2)) / (256/3)); if (defined($n = hunt_for_sensor($collector, $id, "direction"))) { my $sensor = $collector->{sensor}{$n}; if ($sensor->{inverted}) { $val = $compass_lookup{"$D$C$B$A"}; } else { $val = $compass_lookup{"$A$B$C$D"}; } next DS2450 unless defined $val; print "$n $val\n"; } } # # Now deal with the hard cases - the multi-value 2438 sensors. We # have to read a few values, and assemble the temperature and humidity # (or barometer or current) values based on a formula. Since the # sensor number has no suffix (but the logging is based on possibly # two Sensor blocks with different suffixed IDs), we have to hunt for # the blocks after we get the readings. The RH algorithm is from # http://www.sensorsmag.com/sensors/article/articleDetail.jsp?id=361379 # $count = 0; DS2438: while ($count++ < @{$collector->{_2438}}) { my ($n, $data, $bits, $vdd, $vad, $temp, $i, $crc_in, $crc_out); # Rotate sensors... $id = shift @{$collector->{_2438}}; push @{$collector->{_2438}}, $id; $url = "$collector->{_baseurl}/1Wire/WriteBlock.html?Address=$id&LockID=$lockid"; # Write scratchpad page 0 with 0x09 (set A/D to battery input (VDD) # and read current register) $ua->get("$url&Data=4e0009"); $ua->get("$url&Data=4800"); # Copy scratchpad 0 to memory page 0 $ua->get("$url&Data=44"); # Do a Convert T $ua->get("$url&Data=B4"); # Do a Convert V $ua->get("$url&Data=B800"); # Recall Memory page 0 to scratchpad 0 # Read Scratchpad 0 (8 bytes of page 0) $response = $ua->get("$url&Data=BE00FFFFFFFFFFFFFFFFFF")->content; # Assume it returned BE0008E00DA901000000E9: # BE 00 command and page # Breakdown of page 0 of DS2438 # 08 status byte # E0 0D temp LSB/MSB 0DE0 = 13.875 # A9 01 volt LSB/MSB 01A9 = 4.25 # 00 00 current LSB/MSB # E9 crc8 if ($response =~ /Write Block Reply/) { ($data, $crc_in) = $response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]{20})([\da-fA-F]{2})"/; # # The DalSemi CRC8 only counts the memory data # $crc_out = sprintf "%02X", crc8(pack "H*", substr($data, 4)); if ($crc_in ne $crc_out) { msg("warning", "CRC Error(1) on sensor $name/$id"); next DS2438; } $bits = hex(substr($data, 8, 2) . substr($data, 6, 2)); if ($bits & 0x8000) { $temp = - (((~$bits + 1) & 0x7FFF) >> 3) / 32; } else { $temp = ($bits >> 3) / 32; } $vdd = hex(substr($data, 12, 2) . substr($data, 10, 2)) / 100; $bits = hex(substr($data, 16, 2) . substr($data, 14, 2)); if ($bits & 0x8000) { $i = - (~$bits + 1) & 0x03FF; } else { $i = $bits & 0x3FF; } } else { msg("err", "Unknown response for 2438 from HA7Net $name"); next DS2438; } # # Temperature and sunlight can be reported on now # if (defined($n = hunt_for_sensor($collector, $id, "temperature"))) { print "$n $temp\n"; } if (defined($n = hunt_for_sensor($collector, $id, "sunlight"))) { print "$n $i\n"; } # # The barometer and humidity sensors need Vad, so if they are # being reported, read Vad (otherwise, just go to the next sensor # and save some time :-) # unless (defined(hunt_for_sensor($collector, $id, "humidity")) || defined(hunt_for_sensor($collector, $id, "barometer"))) { next DS2438; } # Write scratchpad page 0 with 0x00 (set A/D to gp input (VAD) # without reading current register $ua->get("$url&Data=4e0000"); $ua->get("$url&Data=4800"); # Copy scratchpad 0 to memory page 0 $ua->get("$url&Data=B4"); # Do a Convert V (don't bother with T) $ua->get("$url&Data=B800"); # Recall Memory page 0 to scratchpad 0 # Read Scratchpad 0 (8 bytes of page 0) $response = $ua->get("$url&Data=BE00FFFFFFFFFFFFFFFFFF")->content; if ($response =~ /Write Block Reply/) { ($data, $crc_in) = $response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]{20})([\da-fA-F]{2})"/; # # The DalSemi CRC8 only counts the memory data # $crc_out = sprintf "%02X", crc8(pack "H*", substr($data, 4)); if ($crc_in ne $crc_out) { msg("warning", "CRC Error(2) on sensor $name/$id"); next DS2438; } $vad = hex(substr($data, 12, 2) . substr($data, 10, 2)) / 100; } else { msg("err", "Unknown answer for 2438 from HA7Net $name"); next DS2438; } if (defined($n = hunt_for_sensor($collector, $id, "humidity"))) { my $sensorRH = (eval { ($vad / $vdd) } - 0.16) / 0.0062; my $trueRH = $sensorRH / (1.0546 - 0.00216 * $temp); print "$n $trueRH\n"; } if (defined($n = hunt_for_sensor($collector, $id, "barometer"))) { my $sensor = $collector->{sensor}{$n}; my $pressure = $vad * $sensor->{slope} + $sensor->{intercept}; print "$n $pressure\n"; } } } continue { #################################################################### # Release the HA7Net transaction lock #################################################################### if ($lockid) { # Release the lock $ua->get("$collector->{_baseurl}/1Wire/ReleaseLock.html?LockID=$lockid"); undef $lockid; } # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER all the get()'s sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the HA7Net poller exit?"); } sub fork_wunderground_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($ua, $now, $start, $response, $xml, $device, $devices, $n, $t, $delta_t, $next_poll_time); my $fd = new FileHandle; print "Forking Wunderground group poller\n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for Wunderground $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } eval qq{ use XML::Simple; }; die $@ if $@; $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, <@{[ scalar @{$collector->{_c}} ]} PWS> @ api.wunderground.com"; # # Continually read the data URL and split up the answer # LOOP: while (1) { $start = time; $next_poll_time = $start + 5*60; # Arbitrary +5 minutes from now SUB: for my $sub (@{ $collector->{_c} }) { if ($start >= $sub->{_next_poll_time}) { $sub->{_next_poll_time} = $start + $sub->{pollinterval}; $next_poll_time = min($sub->{_next_poll_time}, $next_poll_time); } else { $next_poll_time = min($sub->{_next_poll_time}, $next_poll_time); next SUB; } $response = $ua->get($sub->{_baseurl}); if ($response->is_error) { msg("err", "Cannot contact Wunderground at $sub->{_baseurl}, " . $response->status_line); next LOOP; } $xml = XMLin($response->content); # Convert (broken) RFC822 time to HTTP Time (which str2time can # parse). Use "now" just in case the parse fails $t = $xml->{observation_time_rfc822}; $t =~ s/^[^,]+,\s+//; # Eliminate day of week $t =~ s/(\s\w{3})\w*/$1/; # Reduce to 3-letter month $t =~ s/(\d+):(\d+):(\d+)/sprintf "%02d:%02d:%02d",$1,$2,$3/e; $delta_t = time - (str2time($t) || time); if ($delta_t > $sub->{staleafter}) { # Stale data msg("notice", "Data for Weather Station $sub->{stationid} is stale ($delta_t sec > StaleAfter $sub->{staleafter} sec)"); next SUB; } if (exists $sub->{sensor}{B}) { print "B $xml->{pressure_in} $sub->{_name}\n" unless $xml->{pressure_in} == -999; } if (exists $sub->{sensor}{D}) { # # Wind needs to be rounded to the nearest 22.5 degrees, so our # consensus algorithm works. # print "D @{[int(($xml->{wind_degrees}/22.5 + .5)) * 22.5]} $sub->{_name}\n" unless $xml->{wind_degrees} == -999; } if (exists $sub->{sensor}{G}) { print "G $xml->{wind_gust_mph} $sub->{_name}\n" unless $xml->{wind_gust_mph} == -999; } if (exists $sub->{sensor}{H}) { print "H $xml->{relative_humidity} $sub->{_name}\n" unless $xml->{relative_humidity} == -999; } if (exists $sub->{sensor}{S}) { print "S $xml->{wind_mph} $sub->{_name}\n" unless $xml->{wind_mph} == -999; } if (exists $sub->{sensor}{T}) { print "T $xml->{temp_f} $sub->{_name}\n" unless $xml->{temp_f} == -999; } } } continue { # # Handled slightly differently than the rest of the pollers. We # compute the next time to poll for each of the sub-collectors in # the body of the loop. Just sleep until that time is to come # (unless it has already passed, in which case don't sleep at all). # $now = time; # Must read AFTER all the get()'s sleep ($now > $next_poll_time ? 0 : $next_poll_time - $now); } msg("err", "How did the Wunderground poller exit?"); } sub fork_weathergoose_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($ua, $now, $start, $response, $xml, $device, $devices, $n); my $fd = new FileHandle; print "Forking WeatherGoose-style poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for WeatherGoose $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } eval qq{ use XML::Simple; }; die $@ if $@; $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ $collector->{ipaddress}"; # # Continually read the data URL and split up the answer # LOOP: while (1) { $start = time; $response = $ua->get("$collector->{_baseurl}/data.xml"); if ($response->is_error) { msg("err", "Cannot contact $name at $collector->{_baseurl}, " . $response->status_line); next LOOP; } $xml = XMLin($response->content); # # Distinguish between just a Goose and a Goose with external sensors. # The latter is a hash of sensors, so just build one if we only have # an unextended Goose. # if ($xml->{devices}->{device}->{id} =~ /^[0-9A-F]{16}$/) { $devices = { $xml->{devices}->{device}->{name} => $xml->{devices}->{device} }; } else { $devices = $xml->{devices}->{device}; } DEVICE: while (($name, $device) = each %$devices) { my $id = $device->{id}; unless ($device->{type} =~ m#^(WxGoos3?|PowerStrip|(Temp|AirFlow)Sensor$)#) { warn "Unknown sensor type $device->{type} $name in WeatherGoose $0\n"; next DEVICE; } next DEVICE unless $device->{available}; if (defined($n = hunt_for_sensor($collector, $id, "temperature"))) { print "$n $device->{field}->{TempC}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "humidity"))) { print "$n $device->{field}->{Humidity}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "airflow"))) { print "$n $device->{field}->{Airflow}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "sound"))) { print "$n $device->{field}->{Sound}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "light"))) { print "$n $device->{field}->{Light}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "io1"))) { print "$n $device->{field}->{IO1}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "io2"))) { print "$n $device->{field}->{IO2}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "io3"))) { print "$n $device->{field}->{IO3}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "volts"))) { print "$n $device->{field}->{Volts}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "volts-peak"))) { print "$n $device->{field}->{'Volt-Pk'}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "amps"))) { print "$n $device->{field}->{Amps}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "amps-peak"))) { print "$n $device->{field}->{'Amps-Pk'}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "real-power"))) { print "$n $device->{field}->{RealPower}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "apparent-power"))) { print "$n $device->{field}->{ApPower}->{value}\n"; } if (defined($n = hunt_for_sensor($collector, $id, "power-factor"))) { print "$n $device->{field}->{'Pwr-Factor%'}->{value}\n"; } } } continue { # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER all the get()'s sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the Weathergoose poller exit?"); } sub fork_smartnet_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($ua, $now, $start, $response); my $fd = new FileHandle; print "Forking SmartNet poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for Proliphix $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ $collector->{ipaddress}"; # # Continually read the data and split up the answer # LOOP: while (1) { $start = time; my (@hold, @query, $when, $err, $n1); if ($collector->{_smartwatt}) { @hold = (); while (@query = splice(@{ $collector->{_smartwatt} }, 0, 10)) { $response = $collector->{_ua}->simple_request('SmartWatt.Read', @query); $when = shift @{$response}; if ($err = shift @{$response}) { msg("err", "Error code $err on SmartNet $name"); } for my $r (@{$response}) { if (defined($n1 = hunt_for_sensor($collector, $r->{ROMID}, "watts"))) { my $sensor = $collector->{sensor}{$n1}; if ($sensor->{_prev_time}) { my $v = ($r->{WattHr} - $sensor->{_prev_Wh}) / ($when - $sensor->{_prev_time}); print "$n1\t$v\n"; } $sensor->{_prev_time} = $when; $sensor->{_prev_Wh} = $r->{WattHr}; } if (defined($n1 = hunt_for_sensor($collector, $r->{ROMID}, "wh"))) { print "$n1\t$r->{WattHr}\n"; } } push @hold, @query; } @{ $collector->{_smartwatt} } = @hold; } if ($collector->{_smartsense}) { @hold = (); while (@query = splice(@{ $collector->{_smartsense} }, 0, 10)) { $response = $collector->{_ua}->simple_request('SmartSenseTH.Read', @query); $when = shift @{$response}; if ($err = shift @{$response}) { msg("err", "Error code $err on SmartNet $name"); } for my $r (@{$response}) { if (defined($n1 = hunt_for_sensor($collector, $r->{ROMID}, "temperature"))) { print "$n1\t$r->{Temperature}\n"; } if (defined($n1 = hunt_for_sensor($collector, $r->{ROMID}, "humidity"))) { print "$n1\t$r->{TRH}\n"; } if (defined($n1 = hunt_for_sensor($collector, $r->{ROMID}, "dewpoint"))) { print "$n1\t$r->{DewPoint}\n"; } } push @hold, @query; } @{ $collector->{_smartsense} } = @hold; } } continue { # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER all the get()'s sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the smartnet poller exit?"); } sub fork_proliphix_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($ua, $now, $start, %request, %check, $response, $v); my $fd = new FileHandle; my %oid = ( TA => "OID4.1.13", T1 => "OID4.3.2.1", T2 => "OID4.3.2.2", T3 => "OID4.3.2.3", H1 => "OID4.1.14", S => "OID4.1.2", ); my %sensor = reverse %oid; # Unique reverse mapping print "Forking Proliphix poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for Proliphix $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ $collector->{ipaddress}"; # # Build the list of OIDs to poll # my %request = map { ($oid{uc($_)} => "")} keys %{ $collector->{sensor} }; # # Continually read the data URL and split up the answer # LOOP: while (1) { $start = time; $response = $ua->post("$collector->{_baseurl}/get", \%request); if ($response->is_error) { msg("err", "Cannot contact $name at $collector->{_baseurl}, " . $response->status_line); next LOOP; } %check = %request; for my $kv (split /&/, $response->content) { my ($k, $v) = split /=/, $kv; if (exists $sensor{$k}) { $v /= 10 if $sensor{$k} =~ /^T/; # Reads deci-degrees F print "$sensor{$k}\t$v\n"; delete $check{$k}; } else { msg("err", "Unexpected OID $k returned from Proliphix $name"); } } if (keys %check) { msg("err", "@{[keys %check]} not returned for Proliphix $name"); } } continue { # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER all the get()'s sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the Proliphix poller exit?"); } sub fork_em1_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($ua, $now, $start, $response, @values, $v); my $fd = new FileHandle; my @sensors = qw(T1 H1 W1 T2 H2 W2 T3 H3 W3 T4 H4 W4); print "Forking EM1 poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for EM1 $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ $collector->{ipaddress}"; # # Continually read the data URL and split up the answer # LOOP: while (1) { $start = time; $response = $ua->get("$collector->{_baseurl}/data"); if ($response->is_error) { msg("err", "Cannot contact $name at $collector->{_baseurl}, " . $response->status_line); next LOOP; } @values = split /\|/, $response->content; if (@values > 10) { shift @values; # Skip 0th field (temperature scale) } else { msg("err", "Unknown response from EM1 $name"); } # # Output the values we just read, skipping missing sensors # for my $k (@sensors) { $v = shift @values; next if $v == -999.9; print "$k $v\n"; } } continue { # # The EM1 constantly reads the sensors (so when we poll, we get an # instant answer), but we still need to honor PollInterval. # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER all the get()'s sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the EM1 poller exit?"); } sub fork_roomalert_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($ua, $now, $start, $response, @response, $v, $count, $out); my $fd = new FileHandle; my $old_firmware = 0; print "Forking Room Alert poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for Room Alert $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ $collector->{ipaddress}"; # # Continually read the data URL and split up the answer # LOOP: while (1) { $start = time; if ($old_firmware) { # # Basically, we convert the RoomAlert output (which is this almost # Perl-like data structure) into Perl, and eval it, after doing some # simple data protection and encoding/decoding # if ($response =~ /^{name:/) { # comment to balance curly's } $response =~ s/"([^"]*)"/'"' . encode_base64($1, "") . '"'/ge; $response =~ s/:/ => /g; $response =~ s/"([^"]*)"/'"' . decode_base64($1) . '"'/ge; eval "\$out = $response"; } else { msg("err", "Unknown response from Room Alert $name\n$response"); $out = {}; } $response = $ua->get("$collector->{_baseurl}/getData.cgi"); if ($response->is_error) { msg("err", "Cannot contact $name at $collector->{_baseurl}, " . $response->status_line); next LOOP; } $response = $response->content; } else { $response = $ua->get("$collector->{_baseurl}/getData.htm"); if ($response->code == 400) { $old_firmware = 1; redo LOOP; } elsif ($response->is_error) { msg("err", "Cannot contact $name at $collector->{_baseurl}, " . $response->status_line); next LOOP; } $response = $response->content; } # # Basically, we convert the RoomAlert output (which is this almost # Perl-like data structure) into Perl, and eval it, after doing some # simple data protection and encoding/decoding # if ($response =~ /^{name:/) { # comment to balance curly's } $response =~ s/"([^"]*)"/'"' . encode_base64($1, "") . '"'/ge; $response =~ s/:/ => /g; $response =~ s/"([^"]*)"/'"' . decode_base64($1) . '"'/ge; eval "\$out = $response"; } else { msg("err", "Unknown response from Room Alert $name\n$response"); $out = {}; } # # Output the values we just read, skipping missing sensors # $count = 0; for my $th (@{ $out->{internal_sen} }) { print "T0 $th->{tempc}\n" if exists $th->{tempc}; print "H0 $th->{humid}\n" if exists $th->{humid}; print "Power $th->{status}\n" if $th->{type} eq "power"; print "Flood $th->{flood_status}\n" if $th->{type} eq "flood"; } $count = 1; for my $th (@{ $out->{sensor} }) { print "T$count $th->{tempc}\n"; print "H$count $th->{humid}\n" if exists $th->{humid}; $count++; } $count = 1; for my $th (@{ $out->{switch_sen} }) { print "S$count $th->{status}\n"; $count++; } for my $th (@{ $out->{wireless_sen} }) { next if $th->{serial} eq "000000000000"; print "$th->{serial}T0 $th->{tempc}\n"; $count = 1; for my $swit (@{ $th->{swit_sen} }) { print "$th->{serial}S$count $swit->{status}\n"; $count++; } $count = 1; for my $digi (@{ $th->{digi_sen} }) { print "$th->{serial}T$count $digi->{tempc}\n" if exists $digi->{tempc}; print "$th->{serial}H$count $digi->{humid}\n" if exists $digi->{humid}; $count++; } } } continue { # # The unit constantly reads the sensors (so when we poll, we get an # instant answer), but we still need to honor PollInterval. # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER all the get()'s sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the Roomalert poller exit?"); } sub fork_enersure_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($now, $start, $result, $enersure, $sensor, @addrs); my ($v, $i, $p, $w, $k, $ks, $errcnt); my $fd = new FileHandle; print "Forking Enersure poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for Enersure $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $enersure = $collector->{_modbus_device}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name"; # # Build the list of sensors to poll. It is MUCH faster to read all the # registers in a bank (and thence all registers in multiple banks) if we # are reading more than one register per bank. So just take the simple # approach and say "if we read one, we read them all". # for my $n (@{ $collector->{_bank} }) { push @addrs, (30001+$n*10..30010+$n*10); } $ks = eval { $enersure->read_one(30010) } || 1; $SIG{ALRM} = sub { print STDERR "Timeout!\n"; die "Timeout!" }; LOOP: while (1) { $start = time; eval { $result = $enersure->read(@addrs); }; if ($@) { msg("err", $@); msg("err", "Modbus error count $errcnt"); # If the Enersure stops replying and we are not hardwired on a # serial line, the Ether-to-serial device may have crashed. Try # to re-establish a connection with it, and retry the read... if (++$errcnt > 3 && ! $collector->{device}) { msg("err", "reopening modbus device"); close $collector->{_fd}; sleep 1; $collector->{_fd} = unit_open($collector, $collector->{baudrate}); my $modbus = new Modbus::Client $collector->{_fd}; $enersure = $collector->{_modbus_device} = $modbus->device($collector->{modbusaddress}); $errcnt = 0; } next LOOP; } $errcnt = 0; for my $n (@{ $collector->{_bank} }) { $v = 30001 + 0 + ($n * 10); printf "V$n %.1f\n", $result->{$v}/10; $i = 30001 + 2 + ($n * 10); printf "I$n %.3f\n", $result->{$i}/100; $p = 30001 + 4 + ($n * 10); printf "P$n %.3f\n", $result->{$p}/1000; $w = 30001 + 5 + ($n * 10); printf "W$n %.3f\n", $result->{$w}; $k = 30001 + 7 + ($n * 10); printf "K$n %.3f\n", $result->{$k}/$ks; } } continue { # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER the read from modbus sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the Enersure poller exit?"); } sub fork_snmp_poller { my $name = shift; my $collector = $config{collector}{$name}; my ($ua, $now, $start, $result, $sensor, $oid, @oids, $v); my $fd = new FileHandle; print "Forking SNMP poller for \n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork collector for SNMP $name"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } $is_child++; close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $ua = $collector->{_ua}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name @ $collector->{ipaddress}"; # # Build the list of OIDs to poll # for my $n (sort keys %{ $collector->{sensor} }) { $sensor = $collector->{sensor}{$n}; push @oids, $sensor->{_oid}; } @oids = sort @oids; # # Continually read the OIDs # while (1) { $start = time; $result = $ua->get_request(-varbindlist => \@oids); SENSOR: for my $n (sort keys %{ $collector->{sensor} }) { $sensor = $collector->{sensor}{$n}; $oid = $sensor->{_oid}; next unless defined($v = $result->{$oid}); # # OnOff's are handled the same, regardless of collector # if ($sensor->{type} eq "onoff") { if ($v == $sensor->{snmponvalue}) { print "$n 1\n"; } elsif ($v == $sensor->{snmpoffvalue}) { print "$n 0\n"; } else { msg("err", "Unexpected SNMP value of $v for Sensor $sensor->{name}. Do you need to define SNMPOnValue or SNMPOffValue?"); print "$n $v\n"; } next SENSOR; } # # Some sensors are special, depending on collector # if ($collector->{type} eq "hwg") { if ($sensor->{type} =~ /^(temperature|humidity|volts|milliamps)$/) { printf "%d %.1f\n", $n, $v/10; } else { print "$n $v\n"; } } elsif ($collector->{type} eq "snmp") { if ($sensor->{type} eq "counter") { my $deltaC = compute_rain_lightning_counter($sensor, $v); print "$n $deltaC\n"; } else { print "$n $v\n"; } } else { msg("err", "Unknown collector type in fork_snmp_poller!"); print "$n $v\n"; } } } continue { # # See comments at end of fork_owfs_poller # $now = time; # Must read AFTER the get_request sleep ($now - $start > $collector->{pollinterval} ? 0 : $collector->{pollinterval} - ($now - $start)); } msg("err", "How did the SNMP poller exit?"); } sub fork_snmp_traphandler { my $fd = new FileHandle; print "Forking SNMP trap handler\n" if $opt_verbose; for (open $fd, "-|") { $_ == 0 && last; # Child - the real work is below $_ == -1 && die "Cannot fork SNMP trap handler"; print " Poller PID is $_\n" if $opt_verbose; push @kids, $_; # Save the child PID print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; return $fd; # Parent returns FD } close $fd; # We only use STDOUT in child $0 = "$script snmptrapd poller"; while (1) { exec (qw(snmptrapd -f -OnQ -C --disableAuthorization=true -Lo -F), '%a %v\n', "-f", "UDP:$config{snmptrapport}"); msg("err", "snmptrapd poller failed - retrying in 15 seconds"); sleep 15; } } sub unstick { alarm(0); # In case we weren't called by an alarm msg("info", "Unsticking stuck poller\n"); die "Unsticking - too much time\n"; } # # The subroutine my_select is needed because select should not be used with # buffered I/O, and because the QK145 uses \n\r as a line terminator. So # we read ONE character per FD for every successful select call, and when we # have read a line from any sensor, we return that full line, pre-trimmed # sub my_select { my ($rin, $rfd) = @_; my ($rout, $rret, $ri, $ro, $fileno, $k, $char, $start); our @my_select_tmp; # Persistent data across invocations # # For every FD that could posssibly have data, do a non-blocking select # (which means if there is no data waiting, we timeout immediately and # return no lines of data). But if there are any lines that have data, # then (again, non-blocking) suck as much data as you can from FD while # preserving "lines" of data. # print "In my_select\n" if $opt_verbose; if (select($rout=$rin, undef, undef, 0)) { FD: while (($fileno, $k) = each %{$rfd}) { next unless vec($rout, $fileno, 1); print " Draining $k" if $opt_verbose; # # Completely drain any data waiting on _this_ $fileno. Note that # on FreeBSD 5.3, there is a bug somewhere in the OS, Perl (or # possibly even my code :-), wherein the polling call to select # returns "true" even if there is nothing to read (and then the # sysread call blocks waiting for a character). This does not # happen reliably, but when it does, it appears to stay "stuck" # in this mode. My solution is this - since we want to drain # waiting characters (and not wait for new ones), if 2 seconds # elapses while reading from one file descriptor, assume that # we're stuck and go on to the next descriptor. Even on a # heavily loaded system, we can read thousands of characters in # 2 seconds, so this ought to do the trick. # # This clever code fails on Linux due to a different signal # handling behavior, so the solution is simply to not set the # alarm! Since Linux doesn't appear have the select bug, we're # probably cool with that. # # Correction - Some Linux DO have the bug :-( I previously used # an alarm timeout, I have now changed the code to do calls to # time() - but only once per line, to reduce overhead. And also # set an alarrm for 3 seconds (which is longer than the in-line # timeout) in case the select gets truly wedged. # vec($ri, $fileno, 1) = 1; eval { local $SIG{ALRM} = \&unstick; alarm(3); $start = time; while (select($ro = $ri, undef, undef, 0)) { sysread($config{collector}{$k}{_fd}, $char, 1); # # If we find a line terminator, trim leading and trailing # whitespace, and make it available it only if there is # something left (so, eliminate blank lines here) # if ($char eq "\r" || $char eq "\n") { $my_select_tmp[$fileno] =~ s/^\s+//; $my_select_tmp[$fileno] =~ s/\s+$//; next unless length($my_select_tmp[$fileno]); print "+" if $opt_verbose; push @{$my_select_buffer[$fileno]}, $my_select_tmp[$fileno]; $my_select_tmp[$fileno] = ""; vec($rret, $fileno, 1) = 1; unstick() if time - $start > 1; } else { # print "Got '$char' from $fileno\n" if $opt_verbose; $my_select_tmp[$fileno] .= $char; } } alarm(0); }; # end of eval with possible timeout print "Done\n" if $opt_verbose; } } # # "Return" the vector of FDs that have complete lines of data # $_[0] = $rret; # Return by REFERENCE! print "Done with my_select\n" if $opt_verbose; } ############################################################################ # Graphing # ############################################################################ sub wind_direction_str { for (shift) { $_ <= 11.25 && return $lh->maketext("N"); $_ <= 33.75 && return $lh->maketext("NNE"); $_ <= 56.25 && return $lh->maketext("NE"); $_ <= 78.75 && return $lh->maketext("ENE"); $_ <= 101.25 && return $lh->maketext("E"); $_ <= 123.75 && return $lh->maketext("ESE"); $_ <= 146.25 && return $lh->maketext("SE"); $_ <= 168.75 && return $lh->maketext("SSE"); $_ <= 191.25 && return $lh->maketext("S"); $_ <= 213.75 && return $lh->maketext("SSW"); $_ <= 236.25 && return $lh->maketext("SW"); $_ <= 258.75 && return $lh->maketext("WSW"); $_ <= 281.25 && return $lh->maketext("W"); $_ <= 303.75 && return $lh->maketext("WNW"); $_ <= 326.25 && return $lh->maketext("NW"); $_ <= 348.75 && return $lh->maketext("NNW"); return $lh->maketext("N"); } } sub wind_speed_clr { for (shift) { $_ == 0 && return "#ffffff"; $_ <= 5 && return "#e0ffe0"; $_ <= 10 && return "#c0ffc0"; $_ <= 15 && return "#90ff90"; $_ <= 20 && return "#60ff60"; $_ <= 25 && return "#60ff20"; $_ <= 30 && return "#90c060"; $_ <= 35 && return "#c09090"; $_ <= 40 && return "#e09090"; $_ <= 45 && return "#ff9090"; $_ <= 50 && return "#ff6060"; $_ <= 55 && return "#ff3030"; return "#ff0000"; } } sub do_graph { my ($num_datapoints, $axes, $times, $data) = @_; my ($graph, $title, $from_str, $to_str, $overall_max, $overall_min, @legend, @points, %axis, $plot_wind_only, $plot_wind_compass, $direction_data, $plot_weighted_direction, $values_fmt, $y_number_format); # # Quick question - is there any data to graph? # unless ($num_datapoints) { # # The No Data banner is generated in-line. Note that the # image is a fixed size, which is fine since it will be scaled # by the client browser (whereas the graph size is a configurable # option above). # require GD; my $im = new GD::Image(130,60); my $white = $im->colorAllocate(255,255,255); my $blue = $im->colorAllocate(0,0,255); $im->transparent($white); $im->string(GD::Font->Large, 0, 5, "No data exists", $blue); $im->string(GD::Font->Large, 0, 35, " in date range", $blue); print $ofd $im->png; return; } # # Change the graph axis from units to scale. # for my $axis (@$axes) { if ($axis =~ /^[CF]$/) { $axis = $lh->maketext("Temperature [_1]", "\N{U+00b0}$opt_temperature"); } elsif ($axis eq "Deg") { $axis = $lh->maketext("Direction"); # Not "wind" } else { $axis = (adjust_for_scale(0, $axis, 0))[1]; # scale only } } # # Set up the graph title # if ((localtime($date_from))[5] == (localtime($date_to))[5]) { $title = strftime $lh->maketext("%a %b %e"), localtime($date_from); } else { $title = strftime $lh->maketext("%a %b %e %Y"), localtime($date_from); } $title .= " - "; $title .= strftime $lh->maketext("%a %b %e %Y"), localtime($date_to); # # Figure out how many axis types there are - used much later # for (@$axes) { $axis{$_}++; } # # If we are asked to plot a Hi/Lo, suborn the minmax array for the low # and use the data array for the high # if ($opt_hilo) { my $delta = $times->[1] - $times->[0]; my ($lead_in, $npoints, $cnt, $ti, $hi, $lo, $min, $max); # # Start by figuring how many elements are in the first day of data, # and by shrinking @$times # for (@$times) { last if $_ % 86400 == 0; $lead_in++ } $cnt = 0; for (@$times) { if ($_ % 86400 == 0 || $cnt == $#$times) { push @$ti, $times->[$cnt]; } $cnt++; } $times = $ti; # # Then for each array in @$data, collect hi/lo values for the 24-hour # periods (the first one will only be $lead_in long, and the last one # may be short, too. # for my $sensor (@$data) { $hi = []; $lo = []; $min = INT_MAX; $max = INT_MIN; $cnt = 0; $npoints = $lead_in; for my $v (@{$sensor->{_data}}) { if (defined $v) { $min = min($v, $min); $max = max($v, $max); } if (--$npoints == 0 || $cnt == $#{$sensor->{_data}}) { push @$hi, ($max == INT_MIN) ? undef : $max; push @$lo, ($min == INT_MAX) ? undef : $min; $npoints = int(86400 / $delta); $min = INT_MAX; $max = INT_MIN; } $cnt++; } $sensor->{_data} = $hi; $sensor->{_minmax} = $lo; } } # # Otherwise, unless we are asked to make a messy plot, average the data # so that we don't try to plot more than 2x the number of points as there # are pixels on the graph. # elsif ($opt_nosmooth == 0) { my ($out, $runlen); if ($#$times > 2.5*$opt_width) { $runlen = int($#$times / (2.5*$opt_width)); # # Trim down the times array # $out = []; for (my $i = 0; $i <= $#$times; ) { my ($sum, $dcnt); for (my $cnt = 0; $cnt < $runlen; $cnt++, $i++) { $sum += $times->[$i]; $dcnt += defined($times->[$i]); } push @{$out}, $dcnt ? $sum/$dcnt : undef; } $times = $out; # # Handle the min/max/current arrays # for my $sensor (@$data) { $out = []; for (my $i = 0; $i <= $#{$sensor->{_minmax}}; ) { my (@hold); for (my $cnt = 0; $cnt < $runlen; $cnt++, $i++) { if (defined($sensor->{_minmax}[$i])) { push @hold, $sensor->{_minmax}[$i]; } } if (@hold == 0) { push @{$out}, undef; } elsif (@hold == 1) { push @{$out}, $hold[0]; } elsif (@hold > 1) { if (@{$out}) { pop @{$out}; push @{$out}, $hold[0]; } push @{$out}, $hold[1]; } } $sensor->{_minmax} = $out; } # # Now average the data arrays # for my $sensor (@$data) { $out = []; for (my $i = 0; $i <= $#{$sensor->{_data}}; ) { my ($sum, $dcnt); for (my $cnt = 0; $cnt < $runlen; $cnt++, $i++) { $sum += $sensor->{_data}[$i]; $dcnt += defined($sensor->{_data}[$i]); } push @{$out}, $dcnt ? $sum/$dcnt : undef; } $sensor->{_data} = $out; } } } # # Where do the ticks go? What do they look like? Depends on range... # The first element of @points are labels, everything else is data # if ($date_to - $date_from <= 28*3600) { # 06:35 @points = [ map { strftime "%H:%M", localtime($_) } @$times ]; } elsif ($date_to - $date_from <= 7*86400) { # Sun 6:35 @points = [ map { strftime "%a %H:%M", localtime($_) } @$times ]; } elsif ($date_to - $date_from <= 365*86400) {# Sun 8/27 my $fmt = $lh->maketext("%a %m/%d"); @points = [ map { strftime $fmt, localtime($_) } @$times ]; } else { # Aug 27 my $fmt = $lh->maketext("%b %d"); @points = [ map { strftime $fmt, localtime($_) } @$times ]; } # # A special cases - if we are only graphing wind speed and direction, # and the user asks for "radar" plot the average and maximum wind speeds # for the period around a compass rose. Also calculate (later) a weighted # average as a third plot... # if (keys %axis == 2 && $axis{$lh->maketext("Direction")} && ($axis{MPH} || $axis{KPH} || $axis{MPS} || $axis{KNOTS}) && $config{view}{$opt_view}{graphtype} eq "radar") { my ($max_speed, $max_cnt); $plot_wind_compass = 1; for (my $i = 0; $i <= $#$axes; $i++) { if ($axes->[$i] eq $lh->maketext("Direction")) { splice (@$axes, $i, 1); $direction_data = splice (@$data, $i, 1); last; } } # # Consolidate data points around the compass rose. We average the # speed and figure the maximum gust speed. # for (my $i = 0; $i <= $#{ $direction_data->{_data} }; $i++) { my $nsew = wind_direction_str($direction_data->{_data}[$i]); for my $sensor (@$data) { next unless defined $sensor->{_data}[$i]; if ($sensor->{type} eq "speed") { $sensor->{_compass}{$nsew}{sum} += $sensor->{_data}[$i]; $sensor->{_compass}{$nsew}{cnt}++; } elsif ($sensor->{type} eq "gust") { $sensor->{_compass}{$nsew}{sum} = $sensor->{_data}[$i] if $sensor->{_data}[$i] > $sensor->{_compass}{$nsew}{sum}; $max_speed = $sensor->{_data}[$i] if $sensor->{_data}[$i] > $max_speed; $sensor->{_compass}{$nsew}{cnt} = 1; } else { die "I shouldn't be seeing a $sensor->{type} sensor here!"; } } } # # Calculate the average/maximum speed (using the compass rose) # Overwrite @points, because the summary fields are only valid # for linear plots, not radial ones # @points = ( \@compass ); for my $nsew (@compass) { for my $sensor (@$data) { $sensor->{_compass}{$nsew}{avg} = $sensor->{_compass}{$nsew}{sum} == 0 ? 0 : int($sensor->{_compass}{$nsew}{sum} / $sensor->{_compass}{$nsew}{cnt}); push @{ $sensor->{_compass}{rose} }, $sensor->{_compass}{$nsew}{avg}; } } push @points, map { $_->{_compass}{rose} } @$data; # # If there is a speed sensor, we'll use that to create an extra plot # for my $sensor (@$data) { if ($sensor->{type} eq "speed") { $plot_weighted_direction = 1; push @points, []; for my $nsew (@compass) { $max_cnt = $sensor->{_compass}{$nsew}{cnt} if $sensor->{_compass}{$nsew}{cnt} > $max_cnt; } for my $nsew (@compass) { push @{$points[-1]}, $sensor->{_compass}{$nsew}{cnt}/$max_cnt * $max_speed; } } } } # # Another special case - if we are only graphing wind speed and direction, # and the user requests a "natural" graph, then map the direction to a # set of characters in wind_direction_str, and plot those glyphs as the # "value" of the speed. Which means that we have to delete the direction # list from the data being plotted. The "map" statement unclutters the # graph by not marking every point. # elsif (keys %axis == 2 && $axis{$lh->maketext("Direction")} && ($axis{MPH} || $axis{KPH} || $axis{MPS} || $axis{KNOTS}) && $config{view}{$opt_view}{graphtype} eq "natural") { my ($j, $skip); $plot_wind_only = 1; for (my $i = 0; $i <= $#$axes; $i++) { if ($axes->[$i] eq $lh->maketext("Direction")) { splice (@$axes, $i, 1); $direction_data = splice (@$data, $i, 1); last; } } $skip = int(@{ $direction_data->{_data} } / 12); map { undef $_ unless $j++ % $skip == 0 } @{ $direction_data->{_data} }; push @points, map { $_->{_data} } @$data; } # # The actual graph points (added after the X axis values from above) # We plot minmax first, so that the diamonds stay solid (because GD # blanks parts of the diamonds otherwise) # else { push @points, map { $_->{_minmax} } @$data; push @points, map { $_->{_data} } @$data; } # # Calculate the top and bottom of the graph # $overall_min = INT_MAX; $overall_max = INT_MIN; for my $sensor (@$data) { if (defined($sensor->{_min}) && $sensor->{_min} < $overall_min) { $overall_min = $sensor->{_min}; } if (defined($sensor->{_max}) && $sensor->{_max} > $overall_max) { $overall_max = $sensor->{_max}; } } # # Round the min/max values nicely. If no overall min or max, use 0-100 # Rain is special - scale 0..1 if we have close values, else by 1 Inch/mm # if (keys %axis == 1 && $axis{Inch}) { $overall_min = 0; $overall_max = 0 if $overall_max == INT_MIN; $overall_max = int($overall_max) + 1; $values_fmt = "%.2f"; } elsif (keys %axis == 1 && $axis{inHg}) { $overall_min = 30.25 if $overall_min == INT_MAX; $overall_max = 30.5 if $overall_max == INT_MIN; $overall_min = int($overall_min * 10) / 10; $overall_max = int($overall_max * 10 + .99) / 10; $values_fmt = "%.2f"; } else { my ($nearest, $limit); $overall_min = 0 if $overall_min == INT_MAX; $overall_max = 100 if $overall_max == INT_MIN; if ($overall_max - $overall_min > 5000) { $nearest = 10**int(log($overall_max - $overall_min) / log(10)); $values_fmt = "%d"; $y_number_format = "%.2e"; } elsif ($overall_max - $overall_min > 500) { $nearest = 100; $values_fmt = "%d"; } elsif ($overall_max - $overall_min > 5) { $nearest = 10; $values_fmt = "%.1f"; } elsif ($overall_max - $overall_min > 2) { $nearest = 5; $values_fmt = "%.1f"; } elsif ($overall_max - $overall_min > 1) { $nearest = 2; $values_fmt = "%.1f"; } else { $nearest = 1; $values_fmt = "%.2f"; } # Adjust limit down to the $nearest $limit = floor($overall_min); $overall_min = $limit - ($limit % $nearest ? $limit % $nearest : 0); # Adjust limit up to the $nearest $limit = ceil($overall_max); $overall_max = $limit + ($limit % $nearest ? $nearest - ($limit % $nearest) : 0); } # # Man is this weird (but handy :-) # if (defined $config{view}{$opt_view}{maxmin} && $overall_min > $config{view}{$opt_view}{maxmin}) { $overall_min = $config{view}{$opt_view}{maxmin}; } if (defined $config{view}{$opt_view}{minmax} && $overall_max < $config{view}{$opt_view}{minmax}) { $overall_max = $config{view}{$opt_view}{minmax}; } # # Line types and colors (the lines, and the min/max/current markers), # as well as general graph data # if ($plot_wind_compass) { #+ Comment/Uncomment when GD::Chart::Radial is not defined inline get_radial_code(); # eval qq{ use GD::Chart::Radial }; #- $graph = new GD::Chart::Radial($opt_width, $opt_height); $graph->set( dclrs => [ map { $_->{graphcolor} } @$data ], start_angle => 90, style => "circle", ); # # We put this back late to get the proper label/color on the # direction, without having the direction data involved in any # of the overall_min/overall_max calculations. # push @$data, $direction_data; } elsif ($plot_wind_only) { require GD::Graph::mixed; $graph = new GD::Graph::mixed($opt_width, $opt_height); $graph->set_values_font(GD::Font->Small); $graph->set( x_label_skip=> (@{$points[0]} / $opt_width) * length($points[0]->[0]) * 15, dclrs => [ (map { $_->{graphcolor} } @$data) x 2 ], types => [ ("lines") x @$data ], show_values => [ [ undef ], $direction_data->{_data} ], line_types => [ map { $_->{linetype} } @$data ], values_format=> \&wind_direction_str, valuesclr => "#b00000", ); } elsif ($opt_hilo) { require GD::Graph::mixed; $graph = new GD::Graph::mixed($opt_width, $opt_height); $graph->set( x_label_skip=> (@{$points[0]} / $opt_width) * length($points[0]->[0]) * 15, dclrs => [ (map { $_->{graphcolor} } @$data) x 2 ], types => [ ("lines") x @$data, ("lines") x @$data ], line_types => [ (map { $_->{linetype} } @$data) x 2 ], ); } else { require GD::Graph::mixed; $graph = new GD::Graph::mixed($opt_width, $opt_height); $graph->set( x_label_skip=> (@{$points[0]} / $opt_width) * length($points[0]->[0]) * 15, dclrs => [ (map { $_->{graphcolor} } @$data) x 2 ], types => [ ("points") x @$data, ("lines") x @$data ], show_values => [ [ undef ], map { $_->{_minmax} } @$data ], values_format=> $values_fmt, line_types => [ map { $_->{linetype} } @$data ], markers => [ 5 ], # Filled diamonds for hi/lo only marker_size => 3, ); } $graph->set( default_type => "lines", line_type_scale => 4, labelclr => "black", y_min_value => $overall_min, y_max_value => $overall_max, y_long_ticks => 1, y_tick_number => (($overall_max - $overall_min) <= 20 || ($overall_max - $overall_min) >= 200 ? 10 : ($overall_max - $overall_min) / 10), y_label => join(" / ", keys %axis), y_number_format => $y_number_format, title => ($config{location} && "$config{location} - " ) . $title, r_margin => 20, # Leaves room for last values text skip_undef => 1, ); $graph->set_legend(map { $_->{name} } @$data); print $ofd $graph->plot(\@points)->png; } ############################################################################ # Reporting # ############################################################################ sub do_report { my ($num_datapoints, $axes, $times, $data) = @_; my (@points, @head, @row, $date_format, $row); unless ($num_datapoints) { print $ofd $lh->maketext("No data available in selected date range\n"); return; } unshift @$axes, ""; # Because time is not an axis, this aligns axes & data if ($opt_epochtime) { @points = ( $times ); } else { @points = [ map { strftime "%c", localtime($_) } @$times ]; } push @points, map { $_->{_data} } @$data; # # Format specific initialization # if ($opt_format eq "excel") { # Nothing special binmode($ofd); $workbook = Spreadsheet::WriteExcel->new($ofd) or die "Can't create spreadsheet - $!"; $date_format = $workbook->add_format( num_format => 'mmm d yyyy hh:mm:ss'); $worksheet = $workbook->add_worksheet($opt_view); } # # Print the header # @head = ($lh->maketext("Time")); for (map { $_->{name} } @$data) { if ($opt_format eq "csv") { s/"/""/g; # Make titles safe for CSV... } elsif ($opt_format eq "tsv") { s/\t/ /g; # ...or TSV } elsif ($opt_format eq "xml" || $opt_format eq "cer") { s/&/&/g; # ...or XML s//>/g; } elsif ($opt_format eq "excel" || $opt_format eq "timeplot") { # Nothing special } else { die "Sanity check - impossible report format" } push @head, $_; } if ($opt_format eq "csv") { print $ofd qq("), join ('","', @head), qq("\n); } elsif ($opt_format eq "tsv") { print $ofd join ("\t", @head), "\n"; } elsif ($opt_format eq "excel") { if ($#{ $points[0] } >= 65535) { my $msg = "You requested a spreadsheet with @{[ scalar @{$points[0]} ]} rows, and Excel can only handle 65535 rows."; $worksheet->write_string(0, 0, $msg); die "$msg\n"; } $row = 0; for (my $col = 0; $col < @head; $col++) { $worksheet->write_string($row, $col, $head[$col]); } $worksheet->freeze_panes(1, 0); $worksheet->set_column(0, 0, 18); $row++; } elsif ($opt_format eq "timeplot") { # No header for timeplot } elsif ($opt_format eq "xml") { } else { die "Format: $opt_format not yet implemented"; } # # And now the data - walk the array of arrays (the first of them contains # the time, followed by the readings for the selected sensors), shifting # the first value off of each # while (@{$points[0]}) { @row = (); for my $ary (@points) { push @row, shift @$ary; } if ($opt_format eq "csv") { print $ofd qq("), join ('","', @row), qq("\n); } elsif ($opt_format eq "tsv") { print $ofd join ("\t", , @row), "\n"; } elsif ($opt_format eq "timeplot") { my @when = reverse( (gmtime($row[0]))[0..5]); $when[0] += 1900; $when[1]++; $row[0] = sprintf("%4d-%02d-%02dT%02d:%02d:%02dZ", @when); for (@row[1..$#row]) { $_ = sprintf "%.1f", $_ if defined $_; } print $ofd join ("\t", , @row), "\n"; } elsif ($opt_format eq "excel") { my @when = reverse( (localtime($row[0]))[0..5]); $when[0] += 1900; $when[1]++; $worksheet->write_date_time($row, 0, sprintf("%4d-%02d-%02dT%02d:%02d:%02d", @when), $date_format); for (my $col = 1; $col < @row; $col++) { $worksheet->write($row, $col, $row[$col]); } $row++; } elsif ($opt_format eq "xml") { my $row = { time => $row[0] }; for (my $col = 1; $col < @row; $col++) { push @{ $row->{sensor} }, { name => $head[$col], value => $row[$col], units => $axes->[$col] }; } push @{ $worksheet->{reading} }, $row; } } # # Format specific shutdown # if ($opt_format eq "excel") { $workbook->close(); } elsif ($opt_format eq "xml") { my $xs = XML::Simple->new; print $ofd $xs->XMLout($worksheet, RootName => "thermd"); } } sub do_annotate { my $scale_str; eval qq{ use Image::Magick 6.3.0; }; my $image = Image::Magick->new; my $view = $config{view}{$opt_view}; my $x = $image->Read($view->{image}); msg("err", $x) if $x; my ($time, @lines) = read_current_values(); if (! defined $time) { die $lh->maketext("The logging daemon does not seem to be running\n"); } # # Room for improvements: # 1) Should enable the user to specify date and time formats. # if ($view->{date}) { $image->Annotate( font => $view->{date}{font}, pointsize => $view->{date}{fontsize}, x => $view->{date}{x}, y => $view->{date}{y}, text => strftime($lh->maketext("%a %b %e %Y"), localtime), align => $view->{date}{textalign}, fill => $view->{date}{textcolor}, rotate => $view->{date}{textangle}, ); } if ($view->{time}) { $image->Annotate( font => $view->{time}{font}, pointsize => $view->{time}{fontsize}, x => $view->{time}{x}, y => $view->{time}{y}, text => strftime("%H:%M:%S %Z", localtime), align => $view->{time}{textalign}, fill => $view->{time}{textcolor}, rotate => $view->{time}{textangle}, ); } for my $line (@lines) { my ($val, $units, $id) = split /\t/, $line, 3; my $_view = $config{_view}{$opt_view}{$id}; next unless $_view; my $sensor = $_view->{_sensor}; if ($sensor->{_scale} eq 'Deg') { $val = $lh->maketext("[_1] wind", wind_direction_str($val)); } else { $val = adjust_for_scale($val, $sensor->{_scale}, $_view->{precision}); } $image->Annotate( font => $_view->{font}, pointsize => $_view->{fontsize}, x => $_view->{x}, y => $_view->{y}, text => $val, align => $_view->{textalign}, fill => $_view->{textcolor}, rotate => $_view->{textangle}, ); } $image->Write(file => $ofd) } sub determine_sensor_order { our @kn; return @kn if @kn; # Cheap memoizing :-) # # Scan the sensors and eliminate the ones we don't want # for my $k (keys %{ $config{collector} }) { SENSOR: for my $n (keys %{ $config{collector}{$k}{sensor} }) { my $nk = "$n\@$k"; # # If the specified sensor is not in the currently selected view, # skip it! In fact, delete it so we don't look at it again later. # Otherwise, record the axis value for later. We need to convert # all scales to different units-based strings EXCEPT direction. # next SENSOR unless $config{_view}{$opt_view}{$nk}; # # Put the collector/sensor k/n into this list so we can sort them # later alphabetically by sensor name, and use the same sort below # push @kn, { kn => $nk, k => $k, n => $n, sensor => $config{collector}{$k}{sensor}{$n}, }; } } # # Sort the sensors (independent of collector!) # if ($config{sensororder} eq "name") { @kn = sort { $a->{sensor}{name} cmp $b->{sensor}{name} } @kn; } elsif ($config{sensororder} eq "popup") { @kn = sort { $a->{sensor}{popup} cmp $b->{sensor}{popup} || $a->{sensor}{name} cmp $b->{sensor}{name} } @kn; } elsif ($config{sensororder} eq "id") { @kn = sort { ($a->{n} =~ /^\d+$/ && $b->{n} =~ /^\d+$/ ? $a->{n} <=> $b->{n} : $a->{n} cmp $b->{n}) || $a->{k} cmp $b->{k} } @kn; } elsif ($config{sensororder} eq "subid") { @kn = sort { $a->{k} cmp $b->{k} || ($a->{n} =~ /^\d+$/ && $b->{n} =~ /^\d+$/ ? $a->{n} <=> $b->{n} : $a->{n} cmp $b->{n}) } @kn; } elsif ($config{sensororder} eq "subname") { @kn = sort { $a->{k} cmp $b->{k} || $a->{sensor}{name} cmp $b->{sensor}{name} } @kn; } return @kn; } sub read_current_values { my (@lines, @kn, %kn, $idx, $last_time); # # Heavy-handedly force all data parsing and conversion to be international # Note that Thermd::I18N is still in effect # if ($config{logformat} eq "text") { open FD, "<", "$config{logread}/current" or msg("err", $lh->maketext("Cannot open [_1] - [_2]\n", "$config{logwrite}/current", $!)); chomp(@lines = ); close FD; $last_time = (split /\t/, shift @lines)[1]; # The epoch-time part } elsif ($config{logformat} eq "sql") { my ($log_name, $value, $units); $sth = $dbh->prepare(qq{ SELECT logtime, value, units, log_name FROM current }); $sth->execute(); while(my $row = $sth->fetchrow_hashref()) { $last_time ||= $row->{logtime}; push @lines, "$row->{value}\t$row->{units}\t$row->{log_name}"; } } else { die "Unknown LogFormat"; } # # If the current values are more than 10 minutes old, we think that the # daemon is stalled/hung/stopped. Report this as an undef time # if (time - $last_time > 60*10) { $last_time = undef; } $idx = 0; @kn = determine_sensor_order(); for my $kn (@kn) { $kn{$kn->{kn}} = $idx++; } @lines = sort { my $name_a = (split /\t/, $a, 3)[2]; my $name_b = (split /\t/, $b, 3)[2]; $kn{$name_a} <=> $kn{$name_b} } @lines; return ($last_time, @lines); } sub collect_data { my ($cliplo, $cliphi) = @_; my ($time, $val, $prev, $last_val, $min, $max, $min_idx, $max_idx, $line, $sensor, $scale, @data, @time, %time, $last_tick, @axes, $cur_time, @lines, @values, $interval, $num_datapoints, @kn); # # Heavy-handedly force all data parsing and conversion to be English # Note that Thermd::I18N is still in effect # setlocale(LC_ALL, "C"); # # Start by filling up a time array with the expected time values. We use # a hash table because we have large indices, and may need to fill in # more values later in between values (we assume that LogInterval now # is the same as it always was, but it might have been more frequent # at some time in the past). Start from the first date that is aligned # on LogInterval seconds, rounded down. # # Don't do this if we were called with -current (we only want one time) # unless ($opt_current) { $date_from = int(($date_from / $config{loginterval}) - 0.1) * $config{loginterval}; } for (my $t = $date_from; $t <= $date_to; $t += $config{loginterval}) { $time{$t}++; } $time{PROGRAM_START()}++ if $date_to == PROGRAM_START; $interval = $config{loginterval}; ($cur_time, @lines) = read_current_values(); @kn = determine_sensor_order(); # # Now scan the sensors in order and collect the data we want. # SENSOR: for my $kn (@kn) { $sensor = $kn->{sensor}; push @axes, ($scale = $sensor->{_scale}); # # Overwrite the sensor elements with the values from the hash, if # they exist. # my $_view = $config{_view}{$opt_view}{"$kn->{n}\@$kn->{k}"}; if (exists $_view->{name}) { $sensor->{name} = $_view->{name}; } if (exists $_view->{linetype}) { $sensor->{linetype} = $_view->{linetype}; } if (exists $_view->{graphcolor}) { $sensor->{graphcolor} = $_view->{graphcolor}; } if (exists $_view->{popup}) { $sensor->{popup} = $_view->{popup}; } # # Before we get any readings (because of the logic below), we # get the most recent one. Try to append the "current" value # if we are reporting/graphing up to "now" (and the "now" values # are recent enough). # if ($date_to == PROGRAM_START && defined($cur_time)) { LINE: for my $line (@lines) { my ($val, undef, $id) = split /\t/, $line, 3; next LINE unless $id eq "$kn->{n}\@$kn->{k}"; ($val, undef) = adjust_for_scale($val, $scale, 3); $sensor->{_data}->{PROGRAM_START()} = $val; last LINE; } } # # If we were called with -current, only use the current values # if ($opt_current) { next SENSOR; } if ($config{logformat} eq "text") { # # Dict::Search::look sets the file pointer to the first line # that is greater than or equal to the value we want. It will # fail under three conditions # 1) The file starts after the date we want (returns -1) # 2) The file ends before the date we want (we are at eof) # 3) The file i