#!/usr/bin/perl # # Copyright 2001-2009 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.85 2014/08/24 15:21:31 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 :sys_wait_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_all_sensors, $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, @pollers, @actions, %kids, %logfile); END { if (!$is_child && keys %kids) { msg("err", "END Infanticide from PID $$ - $0 killing: @{[keys %kids]}"); $SIG{CHLD} = "IGNORE"; kill POSIX::SIGTERM(), keys %kids; } } our %options = ( all_sensors => \$opt_all_sensors, 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 => { # inHg is hardwired for English barometer => "inHg", temperature => "F", rainfall => "Inches", windspeed => "MPH", }, Metric => { # ...but look up scale for Metric barometer => $lh->baroscale, 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 ); # # Thermocouple ranges, from http://srdata.nist.gov/its90/main/ # my %min_max = ( B => [ 0, 1820 ], E => [ -200, 1000 ], J => [ -210, 1200 ], K => [ -270, 1372 ], N => [ -270, 1300 ], R => [ -50, 1768 ], S => [ -50, 1768 ], T => [ -270, 400 ], ); # # Constants for the Veris H8030 and H8031 (via private communication from # h8030_h8031_i0c2_Z205220-0C.pdf, document not found on the web), and for # the H8035 and H8036, http://www.veris.com/modbus/8035-6MB_implementation.pdf # my %veris = ( 40001 => { type => "KWH", _scale => "KWh", _label => "KiloWatt Hours", multiplier => { "H8030/H8031" => { 100 => 0.01562, 300 => 0.0625, }, "H8035/H8036" => { 100 => 7.8125e-3, 300 => 0.03125, 400 => 0.03125, 800 => 0.0625, 1600 => .125, 2400 => 0.25, }, }, description => "Energy Consumption, LSW", }, 40002 => { type => "KWH", _scale => "KWh", _label => "KiloWatt Hours", multiplier => { "H8030/H8031" => { 100 => 1024, 300 => 4096, }, "H8035/H8036" => { 100 => 512, 300 => 2048, 400 => 2048, 800 => 4096, 1600 => 8192, 2400 => 16384, }, }, description => "Energy Consumption, MSW", }, 40003 => { type => "KWatts", _scale => "KW", _label => "KiloWatts", multiplier => { "H8030/H8031" => { 100 => 0.008, 300 => 0.032, }, "H8035/H8036" => { 100 => 0.004, 300 => 0.016, 400 => 0.016, 800 => 0.032, 1600 => 0.064, 2400 => 0.128, }, }, description => "Demand (power)", }, 40004 => { type => "VAR", _scale => "VAR", _label => "Volt Amps R", multiplier => { "H8030/H8031" => { 100 => 0.008, 300 => 0.032, }, "H8035/H8036" => { 100 => 0.004, 300 => 0.016, 400 => 0.016, 800 => 0.032, 1600 => 0.064, 2400 => 0.128, }, }, description => "Reactive Power", }, 40005 => { type => "VA", _scale => "VA", _label => "Volt Amps", multiplier => { "H8030/H8031" => { 100 => 0.008, 300 => 0.032, }, "H8035/H8036" => { 100 => 0.004, 300 => 0.016, 400 => 0.016, 800 => 0.032, 1600 => 0.064, 2400 => 0.128, }, }, description => "Apparent Power", }, 40006 => { type => "Power-Factor", _scale => "PF", _label => "Power Factor", multiplier => { "H8030/H8031" => { 100 => 3.0518e-5, 300 => 3.0518e-5, }, "H8035/H8036" => { 100 => 3.0518e-5, 300 => 3.0518e-5, 400 => 3.0518e-5, 800 => 3.0518e-5, 1600 => 3.0518e-5, 2400 => 3.0518e-5, }, }, description => "Power Factor", }, 40007 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.03125, 300 => 0.03125, }, "H8035/H8036" => { 100 => 0.03125, 300 => 0.03125, 400 => 0.03125, 800 => 0.03125, 1600 => 0.03125, 2400 => 0.03125, }, }, description => "Voltage, line to line", }, 40008 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.015625, 300 => 0.015625, }, "H8035/H8036" => { 100 => 0.015625, 300 => 0.015625, 400 => 0.015625, 800 => 0.015625, 1600 => 0.015625, 2400 => 0.015625, }, }, description => "Voltage, line to neutral", }, 40009 => { type => "Amps", _scale => "A", _label => "Amps", multiplier => { "H8030/H8031" => { 100 => 3.9063e-3, 300 => 0.015625, }, "H8035/H8036" => { 100 => 3.9063e-3, 300 => 0.015625, 400 => 0.015625, 800 => 0.03125, 1600 => 0.0625, 2400 => 0.125, }, }, description => "Current", }, 40010 => { type => "KWatts", _scale => "KW", _label => "KiloWatts", multiplier => { "H8030/H8031" => { 100 => 0.001, 300 => 0.004, }, "H8035/H8036" => { 100 => 0.001, 300 => 0.004, 400 => 0.004, 800 => 0.008, 1600 => 0.016, 2400 => 0.032, }, }, description => "Demand (power), phase A", }, 40011 => { type => "KWatts", _scale => "KW", _label => "KiloWatts", multiplier => { "H8030/H8031" => { 100 => 0.001, 300 => 0.004, }, "H8035/H8036" => { 100 => 0.001, 300 => 0.004, 400 => 0.004, 800 => 0.008, 1600 => 0.016, 2400 => 0.032, }, }, description => "Demand (power), phase B", }, 40012 => { type => "KWatts", _scale => "KW", _label => "KiloWatts", multiplier => { "H8030/H8031" => { 100 => 0.001, 300 => 0.004, }, "H8035/H8036" => { 100 => 0.001, 300 => 0.004, 400 => 0.004, 800 => 0.008, 1600 => 0.016, 2400 => 0.032, }, }, description => "Demand (power), phase C", }, 40013 => { type => "Power-Factor", _scale => "PF", _label => "Power Factor", multiplier => { "H8030/H8031" => { 100 => 3.0518e-5, 300 => 3.0518e-5, }, "H8035/H8036" => { 100 => 3.0518e-5, 300 => 3.0518e-5, 400 => 3.0518e-5, 800 => 3.0518e-5, 1600 => 3.0518e-5, 2400 => 3.0518e-5, }, }, description => "Power Factor, phase A", }, 40014 => { type => "Power-Factor", _scale => "PF", _label => "Power Factor", multiplier => { "H8030/H8031" => { 100 => 3.0518e-5, 300 => 3.0518e-5, }, "H8035/H8036" => { 100 => 3.0518e-5, 300 => 3.0518e-5, 400 => 3.0518e-5, 800 => 3.0518e-5, 1600 => 3.0518e-5, 2400 => 3.0518e-5, }, }, description => "Power Factor, phase B", }, 40015 => { type => "Power-Factor", _scale => "PF", _label => "Power Factor", multiplier => { "H8030/H8031" => { 100 => 3.0518e-5, 300 => 3.0518e-5, }, "H8035/H8036" => { 100 => 3.0518e-5, 300 => 3.0518e-5, 400 => 3.0518e-5, 800 => 3.0518e-5, 1600 => 3.0518e-5, 2400 => 3.0518e-5, }, }, description => "Power Factor, phase C", }, 40016 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.03125, 300 => 0.03125, }, "H8035/H8036" => { 100 => 0.03125, 300 => 0.03125, 400 => 0.03125, 800 => 0.03125, 1600 => 0.03125, 2400 => 0.03125, }, }, description => "Voltage, phase A-B", }, 40017 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.03125, 300 => 0.03125, }, "H8035/H8036" => { 100 => 0.03125, 300 => 0.03125, 400 => 0.03125, 800 => 0.03125, 1600 => 0.03125, 2400 => 0.03125, }, }, description => "Voltage, phase B-C", }, 40018 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.03125, 300 => 0.03125, }, "H8035/H8036" => { 100 => 0.03125, 300 => 0.03125, 400 => 0.03125, 800 => 0.03125, 1600 => 0.03125, 2400 => 0.03125, }, }, description => "Voltage, phase A-C", }, 40019 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.015625, 300 => 0.015625, }, "H8035/H8036" => { 100 => 0.015625, 300 => 0.015625, 400 => 0.015625, 800 => 0.015625, 1600 => 0.015625, 2400 => 0.015625, }, }, description => "Voltage, phase A-N", }, 40020 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.015625, 300 => 0.015625, }, "H8035/H8036" => { 100 => 0.015625, 300 => 0.015625, 400 => 0.015625, 800 => 0.015625, 1600 => 0.015625, 2400 => 0.015625, }, }, description => "Voltage, phase B-N", }, 40021 => { type => "Volts", _scale => "V", _label => "Volts", multiplier => { "H8030/H8031" => { 100 => 0.015625, 300 => 0.015625, }, "H8035/H8036" => { 100 => 0.015625, 300 => 0.015625, 400 => 0.015625, 800 => 0.015625, 1600 => 0.015625, 2400 => 0.015625, }, }, description => "Voltage, phase C-N", }, 40022 => { type => "Amps", _scale => "A", _label => "Amps", multiplier => { "H8030/H8031" => { 100 => 3.9063e-3, 300 => 0.015625, }, "H8035/H8036" => { 100 => 3.9063e-3, 300 => 0.015625, 400 => 0.015625, 800 => 0.03125, 1600 => 0.0625, 2400 => 0.125, }, }, description => "Current, phase A", }, 40023 => { type => "Amps", _scale => "A", _label => "Amps", multiplier => { "H8030/H8031" => { 100 => 3.9063e-3, 300 => 0.015625, }, "H8035/H8036" => { 100 => 3.9063e-3, 300 => 0.015625, 400 => 0.015625, 800 => 0.03125, 1600 => 0.0625, 2400 => 0.125, }, }, description => "Current, phase B", }, 40024 => { type => "Amps", _scale => "A", _label => "Amps", multiplier => { "H8030/H8031" => { 100 => 3.9063e-3, 300 => 0.015625, }, "H8035/H8036" => { 100 => 3.9063e-3, 300 => 0.015625, 400 => 0.015625, 800 => 0.03125, 1600 => 0.0625, 2400 => 0.125, }, }, description => "Current, phase C", }, 40025 => { type => "KWatts", _scale => "KW", _label => "KiloWatts", multiplier => { "H8030/H8031" => { 100 => 0.008, 300 => 0.032, }, "H8035/H8036" => { 100 => 0.004, 300 => 0.016, 400 => 0.016, 800 => 0.032, 1600 => 0.064, 2400 => 0.128, }, }, description => "Average Demand", }, 40026 => { type => "KWatts", _scale => "KW", _label => "KiloWatts", multiplier => { "H8030/H8031" => { 100 => 0.008, 300 => 0.032, }, "H8035/H8036" => { 100 => 0.004, 300 => 0.016, 400 => 0.016, 800 => 0.032, 1600 => 0.064, 2400 => 0.128, }, }, description => "Minimum Demand", }, 40027 => { type => "KWatts", _scale => "KW", _label => "KiloWatts", multiplier => { "H8030/H8031" => { 100 => 0.008, 300 => 0.032, }, "H8035/H8036" => { 100 => 0.004, 300 => 0.016, 400 => 0.016, 800 => 0.032, 1600 => 0.064, 2400 => 0.128, }, }, description => "Maximum Demand", }, ); # Types and commands for the Newport/Omega iServer family my %newport = ( ibthx => { regex => qr/^SR(TC|Hi|H2|DC2)$/, errmsg => "SRTC, SRHi, SRH2, or SRDC2", type => { SRTC => "temperature", SRHi => "barometer", SRH2 => "humidity", SRDC2 => "dewpoint", }, }, ibtx => { regex => qr/^SR(TC|Hi|H2|DC2)$/, errmsg => "SRTC, SRHi, SRH2, or SRDC2", type => { SRTC => "temperature", SRHi => "barometer", SRH2 => "humidity", SRDC2 => "dewpoint", }, }, "ibtx-m" => { regex => qr/^SR(TC|Hi)$/, errmsg => "SRTC or SRHi", type => { SRTC => "temperature", SRHi => "barometer", }, }, "iptx-d" => { regex => qr/^SR(TC|Hb)$/, errmsg => "SRTC or SRHb", type => { SRTC => "temperature", SRHb => "pressure", }, }, "iptx-w" => { regex => qr/^SR(TC|Hb)$/, errmsg => "SRTC or SRHb", type => { SRTC => "temperature", SRHb => "pressure", }, }, itcx => { regex => qr/^SR[THD]C$/, errmsg => "SRTC, SRHC, or SRDC", type => { SRTC => "temperature", SRHC => "temperature", SRDC => "temperature", }, }, "ithx-m" => { regex => qr/^SR[THD]$/, errmsg => "SRT, SRH, or SRD", type => { SRT => "temperature", SRH => "humidity", SRD => "dewpoint", }, }, "ithx-2" => { regex => qr/^SR(TC|H|DC)2?$/, errmsg => "SRTC, SRTC2, SRH, SRH2, SRDC, or SRDC2", type => { SRTC => "temperature", SRTC2 => "temperature", SRH => "humidity", SRH2 => "humidity", SRDC => "dewpoint", SRDC2 => "dewpoint", }, }, "ithx-w" => { regex => qr/^SR(TC|H|DC)2?$/, errmsg => "SRTC, SRTC2, SRH, SRH2, SRDC, or SRDC2", type => { SRTC => "temperature", SRTC2 => "temperature", SRH => "humidity", SRH2 => "humidity", SRDC => "dewpoint", SRDC2 => "dewpoint", }, }, ); use constant PROGRAM_START => time; my $number = qr/[+-]?(?:\d+(?:[.,]\d*)?|[.,]\d+)/; my $numeric = qr/^$number$/; 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) -all_sensors Ignore/override any -view, and show *all* sensors -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) (also affects MaxBotix "range" values) -barometer {inHg|mmHg|hPa|kPa|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 $@; $is_cgi = 1; $opt_config = param('config') || "/etc/thermd.conf"; read_config(); $opt_units = param('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 = param('from') || "-1d"; $opt_to = param('to') || "now"; $opt_view = param('view'); $opt_hilo = param('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, do the main daemon job # 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; if (exists $config{collector}{$k}{sensor}) { $line .= "\t$config{collector}{$k}{sensor}{$n}{name}"; } else { $line .= "\t$config{collector}{$k}{actuator}{$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"; } for my $n (keys %{ $config{collector}{$k}{actuator} }) { push @list, "$config{collector}{$k}{actuator}{$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 0; ############################################################################## # Daemon ############################################################################## my (@my_select_buffer, $next_log_time, $rescan_file_descriptors); sub do_daemon { my ($rin, $rout, %rfd, @rfd, $now, $fileno, $k, $ak, $n, $val, $fd, $count, $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; if (!defined $pid) { die "Couldn't fork - $!\n"; } elsif ($pid) { close STDIN; close STDOUT; close STDERR; POSIX::_exit(0); # Parent exits, child lives on } else { 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... } # # Fork off all the sub-processes and handle their possible demise # $SIG{CHLD} = \&child_died; for my $poller (@pollers) { $poller->(); } # # Then do any queued actions (like opening and closing switches) # for my $action (@actions) { $action->(); } # # And finally get ready for the main loop # # 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. # $rescan_file_descriptors = 1; FOREVER: while (1) { # # 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). We need to do this every time, in case a child dies and # winds up with a new file descriptor. # if ($rescan_file_descriptors) { $rin = ''; %rfd = (); for my $k (keys %{ $config{collector} }) { $collector = $config{collector}{$k}; # # Read-only collectors are (obviously) not polled. Individual # underground collectors handled by a single wunderground_group # collector. Derived sensors are also not polled. # next if $collector->{readonly}; next if $collector->{type} eq "wunderground"; next if $collector->{type} eq "derived"; vec($rin, $collector->{_fd}->fileno, 1) = 1; $rfd{$collector->{_fd}->fileno} = $k; } @rfd = keys %rfd; $rescan_file_descriptors = 0; my_select($rout=$rin, \%rfd, 1); } else { my_select($rout=$rin, \%rfd, 0); } $now = time; $count = 0; COLLECTOR: while ($fileno = shift @rfd) { # # Rotate though collectors, in case of timeout, but make sure that # when we finish the list, we break and start at the right place # if (++$count > scalar keys %rfd) { unshift @rfd, $fileno; last COLLECTOR; } else { push @rfd, $fileno; } $k = $rfd{$fileno}; $collector = $config{collector}{$k}; next COLLECTOR 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 "maxbotix") { # Lines look like "R086" next unless /R(\d\d\d)/; $n = "Range"; $val = $1; } 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 >= $sensor->{_max_f}) { msg("err", "OverTemp $sensor->{_nk}: $val > $sensor->{_max_f}"); next LINE; } elsif ($sensor->{_scale} eq "C" && $val >= $sensor->{_max_c}) { msg("err", "OverTemp $sensor->{_nk}: $val > $sensor->{_max_c}"); next LINE; } elsif ($sensor->{_scale} eq "F" && $val <= $sensor->{_min_f}) { msg("err", "UnderTemp $sensor->{_nk}: $val < $sensor->{_min_f}"); next LINE; } elsif ($sensor->{_scale} eq "C" && $val <= $sensor->{_min_c}) { msg("err", "UnderTemp $sensor->{_nk}: $val < $sensor->{_min_c}"); next LINE; } elsif (($sensor->{_scale} eq "MPH" || $sensor->{_scale} eq "%") && $val >= 100) { msg("err", "Overdriven $sensor->{_nk}: $val >= 100 MPH"); next LINE; } elsif (($sensor->{_scale} eq "MPH" || $sensor->{_scale} eq "%") && $val < 0) { msg("err", "Underdriven $sensor->{_nk}: $val < 0 MPH"); next LINE; } elsif ($sensor->{_scale} eq "inHg" && $val >= 32) { msg("err", "Overdriven $sensor->{_nk}: $val >= 32 inHg"); next LINE; } elsif ($sensor->{_scale} eq "inHg" && $val <= 29) { msg("err", "Underdriven $sensor->{_nk}: $val <= 29 inHg"); 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... Likewise # if multiplyby is missing, we multiply by 1. Only one of # the two will actually be in effect. # unless ($sensor->{type} eq "direction") { $val += $sensor->{adjustby}; $val *= $sensor->{multiplyby} || 1; } # # Handle wind gusts and MaxRat especially - 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" || $sensor->{type} eq "counter" && $sensor->{subtype} eq "maxrate") { if ($val >= $sensor->{_sum}) { $sensor->{_sum} = $val; # Maximum $sensor->{_last5} = [ $val ]; } $sensor->{_count} = 1; } # # MinRate (not sure who'd need this, but why not?) is the # opposite of MaxRate (except undef is merely the initial # value, not a minimum) # elsif ($sensor->{type} eq "counter" && $sensor->{subtype} eq "minrate") { if ($val <= $sensor->{_sum} || !defined($sensor->{_sum})) { $sensor->{_sum} = $val; # Minimum $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 (via InactivityReset and _lastchange). # elsif ($sensor->{type} eq "rain" || $sensor->{type} eq "counter" && $sensor->{subtype} eq "total") { # # Temp08 rain sensor already reports total, not delta # if ($collector->{type} eq "temp08") { if ($val > $sensor->{_last5}[0]) { $sensor->{_sum} = $val; # Overwrite $sensor->{_lastchange} = $now; } } # # All others compute delta in the poller. Since counters # can have a multiplyby of negative (e.g., for SNMP in/out # counters), we check absolute value # elsif (abs($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" || $sensor->{type} eq "counter" && $sensor->{subtype} =~ /^(count|raw)$/) { 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; } # # 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 { append_to_average($sensor, $val); } # # The _lastdata field is used to detect sensor failures and # for derived collectors # $sensor->{_lastdata} = $now; # # It is conceivable that due to system load, we would be # so slow in the main program that we would not finish # reading from all the collectors and could miss writing to # current or miss a loginterval. So check using REAL time... # last COLLECTOR if time >= $next_log_time; } 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/2 # seconds, or until $next_log_time-1, 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 FOREVER unless connect_to_database(0); } percolate_actuator_values(); compute_derived_sensors(); 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)) ? int($config{_minpoll}/2) : (($next_log_time - $now) - 1)); } # # We should never get here # msg("alert", "Abnormal termination - restarting"); if ($config{logformat} eq "sql") { $sth->finish; $dbh->disconnect; } get_kicked("HUP"); } sub child_died { my ($kidpid, $collector); # If a second child dies while in the signal handler caused by the # first death, we won't get another signal. So must loop here else # we will leave the unreaped child as a zombie. And the next time # two children die we get another zombie. And so on. while (($kidpid = waitpid(-1,WNOHANG)) > 0) { $collector = $kids{$kidpid}; next unless $collector; # I.e., don't restart the RSS logging processes msg("err", "Child PID $kidpid ($collector->{_name}) died - restarting"); delete $kids{$kidpid}; close $collector->{_fd}; create_child_process($collector); msg("err", "New PID is $collector->{_kidpid}"); } $SIG{CHLD} = \&child_died; # SysV sucks, because it unsets handlers... $rescan_file_descriptors = 1; } sub create_child_process { my $collector = shift; if ($collector->{_subr}) { $collector->{_kidpid} = $collector->{_subr}($collector); $kids{ $collector->{_kidpid} } = $collector; } else { die "Poller for $collector->{_name} has no poller subroutine!" } } # # The extra parameters are used for multivalue sensors like the D2P and counters # If the type is undef (as, for HA7Net counters), we'll match any type. # sub hunt_for_sensor ($$$;$$) { my ($collector, $n, $type, $extra, $match) = @_; my $n_re = qr/^$n/; my @n; for my $nx (grep { /^$n_re/ } keys %{ $collector->{sensor} }) { next unless exists $collector->{sensor}{$nx}; if ($collector->{sensor}{$nx}{type} eq $type || !defined $type) { if ($extra) { next unless $collector->{sensor}{$nx}{$extra} eq $match; push @n, $nx; } else { push @n, $nx; } } } if (wantarray) { return @n; } else { return shift @n; } } 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|temp08|maxbotix/) { 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 && keys %kids) { msg("err", "Infanticide from PID $$ - $0 killing: @{[keys %kids]}"); $SIG{CHLD} = "IGNORE"; kill POSIX::SIGTERM(), keys %kids; } if ($kicked eq "HUP") { my $SELF = File::Spec->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 0; } sub append_to_average { my ($sensor_actuator, $val) = @_; $sensor_actuator->{_sum} += $val; # Long-term averaging $sensor_actuator->{_count}++; unshift @{ $sensor_actuator->{_last5} }, $val; if (@{ $sensor_actuator->{_last5} } > 5) { splice @{$sensor_actuator->{_last5}}, 5; # Removes tail } } sub compute_average { my $sensor = shift; my ($sum, $cnt); # # Average the as many elements as there are available (may be 0) # for my $t (@{ $sensor->{_last5} }) { $sum += $t; $cnt++; } return $cnt ? $sum / $cnt : undef; } sub update_current { my ($sensor, $collector, $actuator); 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 $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; } $avg = compute_average($sensor); if (defined $avg) { 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"; } printf "%.3f\t%s\t%s@%s\n", $avg, $sensor->{_scale}, $n, $k if $opt_verbose; check_alarm($k, $n, $avg, $nowstr); } } ACTUATOR: for my $n (keys %{ $collector->{actuator} }) { my $avg; $actuator = $collector->{actuator}{$n}; next ACTUATOR if $actuator->{readonly}; $avg = compute_average($actuator); if (defined $avg) { if ($config{logformat} eq "text") { printf CURRENT "%.3f\t%s\t%s@%s\n", $avg, $actuator->{_scale}, $n, $k; } elsif ($config{logformat} eq "sql") { $sth = $dbh->prepare( "INSERT INTO current " . "(logtime, value, units, log_id, log_name) VALUES " . "($now, $avg, '$actuator->{_scale}', $actuator->{_id}, '$n\@$k')"); $sth->execute(); } else { die "Unknown LogFormat"; } printf "%.3f\t%s\t%s@%s\n", $avg, $actuator->{_scale}, $n, $k if $opt_verbose; } } } 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"); syswrite($collector->{_fd}, "RST$id"); sleep 1; syswrite($collector->{_fd}, "y"); } sub do_log_and_rss { my $now = shift; 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} }) { my $collector = $config{collector}{$k}; next COLLECTOR if $collector->{readonly}; SENSOR: for my $n (sort keys %{ $collector->{sensor} }) { my $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 InactivityReset (which includes the # rain gauges) never go down except irregularly, so do not # reset their values (except as below) # unless ($sensor->{inactivityreset}) { $sensor->{_sum} = undef; # Not 0, because of MinRate $sensor->{_count} = 0; } } else { print "\tNO DATA\t$sensor->{name}\n" if $opt_verbose; $sensor->{_last} = undef; $sensor->{_sum} = undef; # Not 0, because of MinRate $sensor->{_count} = 0; } # # Here is where we reset counters with a InactivityReset (this # includes all rain gauges) if there has been been no change in # N hours/minutes. For the TEMP08, we also have to reset the # collector. For the other collectors, we only reset the locally # stored numbers. # if ($sensor->{inactivityreset} && $sensor->{_last5}[0] > 0 && defined $sensor->{_lastchange} && $now - $sensor->{_lastchange} > $sensor->{inactivityreset}) { # # 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); } } ACTUATOR: for my $n (sort keys %{ $collector->{actuator} }) { my $actuator = $collector->{actuator}{$n}; next ACTUATOR if $actuator->{readonly}; if ($actuator->{_count}) { my ($fd, $str); my $avg = $actuator->{_sum} / $actuator->{_count}; # # Write to logfile # if ($config{logformat} eq "text") { $str = sprintf "%010d\t%.3f", $now, $avg; $fd = $actuator->{_fd}; seek ($fd, 0, 2); # Append to file print $fd "$str\n"; } elsif ($config{logformat} eq "sql") { $str = sprintf "(%010d,%d,%.3f)", $now, $actuator->{_id}, $avg; $sth = $dbh->prepare( "INSERT INTO readings " . "(logtime, log_id, value) VALUES " . $str); $sth->execute(); } else { die "Unknown LogFormat"; } print "\t$str\t$actuator->{name}\n" if $opt_verbose; # # Because actuators are probably rarely changed, preserve the # last seen value as the assumed current value. # $actuator->{_last} = $avg; $actuator->{_sum} = $actuator->{_last5}[0]; $actuator->{_count} = 1; } } } # # 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 twice a year (*after* writing out data) # if ($now - $^T > 86400*180) { msg("notice", "Periodic 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 owfs_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. } } # # This returns C/min for AvgRate, MinRate and MaxRate (the min/maximizing is # done in the logging daemon); delta-C for Count and Total (again, all work # done in logging daemon); and C for Raw # sub evaluate_counter { my ($sensor, $count, $now) = @_; my ($deltaT, $deltaC, $retval); $now ||= time(); # For collectors which don't support internal time if (!defined $sensor->{_tare}) { $deltaC = 0; } elsif ($count >= $sensor->{_tare}) { $deltaC = $count - $sensor->{_tare}; } else { $deltaC = $count + (0xFFFFFFFF - $sensor->{_tare}); } # # Reset tare every time - let the daemon do the summing or maxima. # $sensor->{_tare} = $count; # # Compute and return the appropriate value from the counter value # if ($sensor->{type} =~ /^(speed|gust)$/ || $sensor->{subtype} =~ /^(avgrate|maxrate|minrate)$/) { if ($sensor->{_then}) { $deltaT = $now - $sensor->{_then}; # Report count/second - all min/max/rate is done in the daemon $retval = $deltaC / $deltaT; } else { $retval = undef; } $sensor->{_then} = $now; } elsif ($sensor->{type} =~ /^(rain|lightning)$/ || $sensor->{subtype} =~ /^(count|total)$/) { $retval = $deltaC; } elsif ($sensor->{subtype} eq "raw") { $retval = $count; } else { msg("err", "Impossible sensor subtype '$sensor->{subtype}' on $sensor->{name}"); die "Impossible sensor subtype '$sensor->{subtype}' on $sensor->{name}"; } return $retval; } sub fork_owfs_poller { # Supports owfs, owhttpd, and owshell my $collector = shift; my $name = $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 my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for OWFS $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $_\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 owfs_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|30)/) { warn "Missing owfs filename for $n!" unless $sensor->{_owfs}; # # Handle temperature, humidity, etc first # $v = owfs_readval($collector, $nx, $sensor->{_owfs}); if ($sensor->{type} eq "barometer") { my $pressure = $v * $sensor->{slope} + $sensor->{intercept}; print "$n $pressure\n"; } else { print "$n $v\n"; } } elsif ($nx =~ /^12/) { # # Deal with the DS2406's. # if ($sensor->{type} eq "barometer") { die "Missing owfs filename!" unless $sensor->{_owfs}; # The sensor reads in millibar, we want inHg (and convert # to display units elsewhere) $v = owfs_readval($collector, $nx, $sensor->{_owfs}) / 33.863788; print "$n $v\n"; } elsif ($sensor->{type} eq "temperature") { die "Missing owfs filename!" unless $sensor->{_owfs}; # Reads in Celsius (which is what we expect) $v = owfs_readval($collector, $nx, $sensor->{_owfs}); print "$n $v\n"; } elsif ($sensor->{type} eq "onoff") { my $p = uc $sensor->{pio}; $latch{sensor}->{pio} = owfs_readval($collector, $nx, "latch.$p"); $sense{sensor}->{pio} = owfs_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 = owfs_readval($collector, $nx, $sensor->{_owfs}); $v = evaluate_counter($sensor, $v, time()); print "$n $v\n" if defined $v; } 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 = owfs_readval($collector, $nx, "volt.A"); $B = owfs_readval($collector, $nx, "volt.B"); $C = owfs_readval($collector, $nx, "volt.C"); $D = owfs_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_newport_poller { my $collector = shift; my $name = $collector->{_name}; my ($ua, $now, $start, $ok, $val, $n, $t); my $fd = new FileHandle; print "Forking Newport/Omega poller\n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for Wunderground $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 sensors. Unlike most # collectors, we open/close the connection each time we collect from # all the sensors (the collectors eventually time out otherwise). # while (1) { $ok = $ua->open ( host => $collector->{ipaddress}, port => $collector->{port} || 2000, ); unless ($ok) { msg("warn", "Could not create Telnet connection for Newport/Omega $collector->{_subtype}"); return; } $start = time; while (my ($n, $sensor) = each %{ $collector->{sensor} }) { $ok = $ua->print("*$n"); next unless $ok; (undef,$val) = $ua->waitfor('/-?\d+\.\d+/'); print "$n $val\n"; } } continue { $ua->close; # # 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 Newport/Omega poller exit?"); } sub fork_ha7net_poller { my $collector = shift; my $name = $collector->{_name}; my ($url, $id, $lockid, $ua, $response, @response, $v, $count, $now, $start, $addr, $h, $t, %latch, %sense, %save); my $fd = new FileHandle; eval qq{ use Digest::CRC 'crc16'; }; die $@ if $@; our @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; } # # Thermocouple polynomial coefficients taken # from http://srdata.nist.gov/its90/main/ # our %thermocouple = ( B => [ { min => 0.291, max => 2.431, coeff => [ 9.8423321E+01, 6.9971500E+02, -8.4765304E+02, 1.0052644E+03, -8.3345952E+02, 4.5508542E+02, -1.5523037E+02, 2.9886750E+01, -2.4742860E+00 ] }, { min => 2.431, max => 13.820, coeff => [ 2.1315071E+02, 2.8510504E+02, -5.2742887E+01, 9.9160804E+00, -1.2965303E+00, 1.1195870E-01, -6.0625199E-03, 1.8661696E-04, -2.4878585E-06 ] }, ], E => [ { min => -8.825, max => 0.000, coeff => [ 0.0000000E+00, 1.6977288E+01, -4.3514970E-01, -1.5859697E-01, -9.2502871E-02, -2.6084314E-02, -4.1360199E-03, -3.4034030E-04, -1.1564890E-05 ] }, { min => 0.000, max => 76.373, coeff => [ 0.0000000E+00, 1.7057035E+01, -2.3301759E-01, 6.5435585E-03, -7.3562749E-05, -1.7896001E-06, 8.4036165E-08, -1.3735879E-09, 1.0629823E-11, -3.2447087E-14 ] }, ], J => [ { min=> -8.095, max => 0.000, coeff => [ 0.0000000E+00, 1.9528268E+01, -1.2286185E+00, -1.0752178E+00, -5.9086933E-01, -1.7256713E-01, -2.8131513E-02, -2.3963370E-03, -8.3823321E-05 ] }, { min => 0.000, max => 42.919, coeff => [ 0.000000E+00, 1.978425E+01, -2.001204E-01, 1.036969E-02, -2.549687E-04, 3.585153E-06, -5.344285E-08, 5.099890E-10 ] }, { min => 42.919, max => 69.553, coeff => [ -3.11358187E+03, 3.00543684E+02, -9.94773230E+00, 1.70276630E-01, -1.43033468E-03, 4.73886084E-06 ] }, ], K => [ { min => -5.891, max => 0.000, coeff => [ 0.0000000E+00, 2.5173462E+01, -1.1662878E+00, -1.0833638E+00, -8.9773540E-01, -3.7342377E-01, -8.6632643E-02, -1.0450598E-02, -5.1920577E-04 ] }, { min => 0.000, max => 20.644, coeff => [ 0.000000E+00, 2.508355E+01, 7.860106E-02, -2.503131E-01, 8.315270E-02, -1.228034E-02, 9.804036E-04, -4.413030E-05, 1.057734E-06, -1.052755E-08 ] }, { min => 20.644, max => 54.886, coeff => [ -1.318058E+02, 4.830222E+01, -1.646031E+00, 5.464731E-02, -9.650715E-04, 8.802193E-06, -3.110810E-08 ] }, ], N => [ { min => -3.990, max => 0.000, coeff => [ 0.0000000E+00, 3.8436847E+01, 1.1010485E+00, 5.2229312E+00, 7.2060525E+00, 5.8488586E+00, 2.7754916E+00, 7.7075166E-01, 1.1582665E-01, 7.3138868E-03 ] }, { min => 0.000, max => 20.613, coeff => [ 0.00000E+00, 3.86896E+01, -1.08267E+00, 4.70205E-02, -2.12169E-06, -1.17272E-04, 5.39280E-06, -7.98156E-08 ] }, { min => 20.613, max => 47.513, coeff => [ 1.972485E+01, 3.300943E+01, -3.915159E-01, 9.855391E-03, -1.274371E-04, 7.767022E-07 ] }, ], R => [ { min => -0.226, max => 1.923, coeff => [ 0.0000000E+00, 1.8891380E+02, -9.3835290E+01, 1.3068619E+02, -2.2703580E+02, 3.5145659E+02, -3.8953900E+02, 2.8239471E+02, -1.2607281E+02, 3.1353611E+01, -3.3187769E+00 ] }, { min => 1.923, max => 13.228, coeff => [ 1.334584505E+01, 1.472644573E+02, -1.844024844E+01, 4.031129726E+00, -6.249428360E-01, 6.468412046E-02, -4.458750426E-03, 1.994710149E-04, -5.313401790E-06, 6.481976217E-08 ] }, { min => 11.361, max => 19.739, coeff => [ -8.199599416E+01, 1.553962042E+02, -8.342197663E+00, 4.279433549E-01, -1.191577910E-02, 1.492290091E-04 ] }, { min => 19.739, max => 21.103, coeff => [ 3.406177836E+04, -7.023729171E+03, 5.582903813E+02, -1.952394635E+01, 2.560740231E-01 ] }, ], S => [ { min => -0.235, max => 1.874, coeff => [ 0.00000000E+00, 1.84949460E+02, -8.00504062E+01, 1.02237430E+02, -1.52248592E+02, 1.88821343E+02, -1.59085941E+02, 8.23027880E+01, -2.34181944E+01, 2.79786260E+00 ] }, { min => 1.874, max => 11.950, coeff => [ 1.291507177E+01, 1.466298863E+02, -1.534713402E+01, 3.145945973E+00, -4.163257839E-01, 3.187963771E-02, -1.291637500E-03, 2.183475087E-05, -1.447379511E-07, 8.211272125E-09 ] }, { min => 10.332, max => 17.536, coeff => [ -8.087801117E+01, 1.621573104E+02, -8.536869453E+00, 4.719686976E-01, -1.441693666E-02, 2.081618890E-04 ] }, { min => 17.536, max => 18.693, coeff => [ 5.333875126E+04, -1.235892298E+04, 1.092657613E+03, -4.265693686E+01, 6.247205420E-01 ] }, ], T => [ { min => -5.603, max => 0.000, coeff => [ 0.0000000E+00, 2.5949192E+01, -2.1316967E-01, 7.9018692E-01, 4.2527777E-01, 1.3304473E-01, 2.0241446E-02, 1.2668171E-03, ] }, { min => 0.000, max => 20.872, coeff => [ 0.000000E+00, 2.592800E+01, -7.602961E-01, 4.637791E-02, -2.165394E-03, 6.048144E-05, -7.293422E-07 ] }, ], ); sub calculate_polynomial { my ($uv, $type) = @_; my $mv = $uv / 1000; my $coeff; # # Find the set of coefficients that match. If it is less than the # max, use it (which means that for type B, for example, which says # it ranges from 0-1820C, but for whom the reverse polynomial tables # are only listed from 250-1820C, we possibly use an imperfect table) # Similar issues exist for other types, too. # for my $h (@{ $thermocouple{$type} }) { if ($mv < $h->{max}) { $coeff = $h->{coeff}; last; } } # # If the mV range is beyond that of the tables, use the last element, # again possibly giving erroneous readings... # $coeff ||= $thermocouple{$type}[-1]{coeff}; my $retval = 0; for my $i (0..$#$coeff) { $retval += ($mv ** $i) * $coeff->[$i]; } return $retval; } print "Forking HA7Net poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for HA7Net $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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/; for my $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/; for my $n (hunt_for_sensor($collector, $addr, "humidity")) { print "$n $h\n"; } for my $n (hunt_for_sensor($collector, $addr, "temperature")) { print "$n $t\n"; } } } 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, $v) = splice(@response, 0, 2)) { next unless $v =~ /$numeric/; for my $n (hunt_for_sensor($collector, $addr, "humidity")) { print "$n $v\n"; } for my $n (hunt_for_sensor($collector, $addr, "temperature")) { print "$n $v\n"; } } } 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') { for my $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. # my ($addr, $channels); DS2423: while (($addr, $channels) = each %{ $collector->{_2423} }) { for my $channel (keys %$channels) { my ($data, $crc_in, $crc_out, $now); my $request = $channel eq 'A' ? 'A5DF01FFFFFFFFFFFFFFFFFFFFFF' : 'A5FF01FFFFFFFFFFFFFFFFFFFFFF'; $response = $ua->get("$collector->{_baseurl}/1Wire/WriteBlock.html?Data=$request&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 counter sensor $addr\@$name"); next DS2423; } $v = hex(substr($data, 14, 2) . substr($data, 12, 2) . substr($data, 10, 2) . substr($data, 8, 2)); ($now) = $response =~ /NAME="Completed_0" VALUE="(\d+)"/; # # Elsewhere (in the logging daemon) we compute averages, min # and max values, etc. We just report raw values here, and # search for undef because we don't care about the sensor type # However, the return values from hunt_for_sensor are the real # thermd addresses, and we need to use THAT to find the sensor # for my $n (hunt_for_sensor($collector, $addr, undef, "channel", $channel)) { my $vc = evaluate_counter($collector->{sensor}{$n}, $v, $now); next unless defined $vc; print "$n $vc\n"; #warn "$collector->{sensor}{$n}{name} $n $vc\n"; } } 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 because they require multiple HTTP requests #################################################################### $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 $id\@$name"); 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)); for my $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 thermocouples on the HA7Net # $count = 0; DS2760: while ($count++ < @{$collector->{_2760}}) { my ($data, $bits, $cold_junction, $uv, $temp, $type, $pair); $pair = shift @{$collector->{_2760}}; push @{$collector->{_2760}}, $pair; ($id, $type) = @$pair; $url = "$collector->{_baseurl}/1Wire/WriteBlock.html?Address=$id&LockID=$lockid"; # # Read the cold junction temperature # $response = $ua->get("$url&Data=6918FFFF")->content; if ($response =~ /Write Block Reply/) { # # Unlike the 2438 (which is LSB/MSB), the 2760 is MSB/LSB, # but units are 0.125 degreesC # ($data) = $response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]{8})"/; $bits = hex(substr($data, 4, 4)); if ($bits & 0x8000) { $cold_junction = - (((~$bits + 1) & 0x7FFF) >> 5) * 0.125; } else { $cold_junction = ($bits >> 5) * 0.125; } } else { msg("err", "Unknown temp answer for 2760 from HA7Net $name"); next DS2760; } # # Read the thermocouple microvolts # $response = $ua->get("$url&Data=690EFFFF")->content; if ($response =~ /Write Block Reply/) { # # Microvolts bits as also MSB/LSB, in 15.625uv units # ($data) = $response =~ /NAME="ResultData_0.*?VALUE="([\da-fA-F]{8})"/; $bits = hex(substr($data, 4, 4)); if ($bits & 0x8000) { $uv = - (((~$bits + 1) & 0x7FFF) >> 3) * 15.625; } else { $uv = ($bits >> 3) * 15.625; } } else { msg("err", "Unknown uv answer for 2760 from HA7Net $name"); next DS2760; } $temp = $cold_junction + calculate_polynomial($uv, $type); for my $n (hunt_for_sensor($collector, $id, "temperature")) { print "$n $temp\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 $id\@$name"); 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 # for my $n (hunt_for_sensor($collector, $id, "temperature")) { print "$n $temp\n"; } for my $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 $id\@$name"); 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; } for my $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"; } for my $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 $collector = shift; my $name = $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 my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for Wunderground $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } eval qq{ use XML::Simple; }; die $@ if $@; $is_child++; close_logfiles(); 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, SuppressEmpty => 1); # 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} && defined $xml->{pressure_in}) { print "B $xml->{pressure_in} $sub->{_name}\n" unless $xml->{pressure_in} == -999; } if (exists $sub->{sensor}{D} && defined $xml->{wind_degrees}) { # # 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} && defined $xml->{wind_gust_mph}) { print "G $xml->{wind_gust_mph} $sub->{_name}\n" unless $xml->{wind_gust_mph} == -999; } if (exists $sub->{sensor}{H} && defined $xml->{relative_humidity}) { print "H $xml->{relative_humidity} $sub->{_name}\n" unless $xml->{relative_humidity} == -999; } if (exists $sub->{sensor}{S} && defined $xml->{wind_mph}) { print "S $xml->{wind_mph} $sub->{_name}\n" unless $xml->{wind_mph} == -999; } if (exists $sub->{sensor}{T} && defined $xml->{temp_f}) { print "T $xml->{temp_f} $sub->{_name}\n" unless $xml->{temp_f} == -999; } if (exists $sub->{sensor}{P} && defined $xml->{dewpoint_f}) { print "P $xml->{dewpoint_f} $sub->{_name}\n" unless $xml->{dewpoint_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 $collector = shift; my $name = $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 my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for WeatherGoose $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } eval qq{ use XML::Simple; }; die $@ if $@; $is_child++; close_logfiles(); 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}; for my $n (hunt_for_sensor($collector, $id, "temperature")) { print "$n $device->{field}->{TempC}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "humidity")) { print "$n $device->{field}->{Humidity}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "airflow")) { print "$n $device->{field}->{Airflow}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "sound")) { print "$n $device->{field}->{Sound}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "light")) { print "$n $device->{field}->{Light}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "io1")) { print "$n $device->{field}->{IO1}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "io2")) { print "$n $device->{field}->{IO2}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "io3")) { print "$n $device->{field}->{IO3}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "volts")) { print "$n $device->{field}->{Volts}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "volts-min")) { print "$n $device->{field}->{'Volt-Min'}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "volts-max")) { print "$n $device->{field}->{'Volt-Max'}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "volts-peak")) { print "$n $device->{field}->{'Volt-Pk'}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "amps")) { print "$n $device->{field}->{Amps}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "amps-peak")) { print "$n $device->{field}->{'Amps-Pk'}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "kwh")) { print "$n $device->{field}->{'KWatt-hrs'}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "real-power")) { print "$n $device->{field}->{RealPower}->{value}\n"; } for my $n (hunt_for_sensor($collector, $id, "apparent-power")) { print "$n $device->{field}->{ApPower}->{value}\n"; } for my $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 $collector = shift; my $name = $collector->{_name}; my ($ua, $now, $start, $response); my $fd = new FileHandle; print "Forking SmartNet poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for Proliphix $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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); 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}) { for my $n (hunt_for_sensor($collector, $r->{ROMID}, "watts")) { my $sensor = $collector->{sensor}{$n}; if ($sensor->{_prev_time}) { my $v = ($r->{WattHr} - $sensor->{_prev_Wh}) / ($when - $sensor->{_prev_time}); print "$n\t$v\n"; } $sensor->{_prev_time} = $when; $sensor->{_prev_Wh} = $r->{WattHr}; } for my $n (hunt_for_sensor($collector, $r->{ROMID}, "wh")) { print "$n\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}) { for my $n (hunt_for_sensor($collector, $r->{ROMID}, "temperature")) { print "$n\t$r->{Temperature}\n"; } for my $n (hunt_for_sensor($collector, $r->{ROMID}, "humidity")) { print "$n\t$r->{TRH}\n"; } for my $n (hunt_for_sensor($collector, $r->{ROMID}, "dewpoint")) { print "$n\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 $collector = shift; my $name = $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 my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for Proliphix $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 # %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_hwg_poller { my $collector = shift; my $name = $collector->{_name}; my ($ua, $now, $start, $response, $values, $v); my $fd = new FileHandle; print "Forking HWg poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for HWg $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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}"; eval qq{ use XML::Simple; }; die $@ if $@; # # Continually read the data URL and split up the answer # LOOP: while (1) { $start = time; $response = $ua->get("$collector->{_baseurl}/values.xml"); if ($response->is_error) { msg("err", "Cannot contact $name at $collector->{_baseurl}, " . $response->status_line); next LOOP; } $values = XMLin($response->content); # # Output the values we just read # for my $h (@{ $values->{BinaryInSet}{Entry} }) { printf "B%d %d\n", $h->{ID}, $h->{Value}; } for my $h (@{ $values->{BinaryOutSet}{Entry} }) { printf "A%d %d\n", $h->{ID} - 150, $h->{Value}; } for my $h (@{ $values->{SenSet}{Entry} }) { printf "%d %.3f\n", $h->{ID}, $h->{Value}; } } continue { # # The HWg 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 HWg poller exit?"); } sub fork_em1_poller { my $collector = shift; my $name = $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 my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for EM1 $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 $collector = shift; my $name = $collector->{_name}; my ($ua, $now, $start, $response, $content, $v, $count, $out); my $fd = new FileHandle; use constant UNK_FIRMWARE => 0; use constant OLD_FIRMWARE => 1; use constant NEW_FIRMWARE => 2; my $firmware = UNK_FIRMWARE; print "Forking Room Alert poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for Room Alert $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 ($firmware == UNK_FIRMWARE) { $response = $ua->get("$collector->{_baseurl}/getData.htm"); if ($response->code == 400) { $firmware = OLD_FIRMWARE; redo LOOP; } else { $firmware = NEW_FIRMWARE; redo LOOP; } } elsif ($firmware == OLD_FIRMWARE) { $response = $ua->get("$collector->{_baseurl}/getData.cgi"); if ($response->code == 400) { $firmware = UNK_FIRMWARE; redo LOOP; } } elsif ($firmware == NEW_FIRMWARE) { $response = $ua->get("$collector->{_baseurl}/getData.htm"); if ($response->code == 400) { $firmware = OLD_FIRMWARE; redo LOOP; } } else { die "Roomalert firmware inconsistency error"; } if ($response->is_error) { msg("err", "Cannot contact $name at $collector->{_baseurl}, " . $response->status_line); next LOOP; } $content = $response->content; # # Basically, we convert the RoomAlert JSON output (an almost # Perl-like data structure) into Perl, and eval it, after doing some # simple data protection and encoding/decoding # if ($content =~ /^{name:/) { # comment: to balance curly's } $content =~ s/"([^"]*)"/'"' . encode_base64($1, "") . '"'/ge; $content =~ s/:/ => /g; $content =~ s/"([^"]*)"/'"' . decode_base64($1) . '"'/ge; eval "\$out = $content"; } else { msg("err", "Unknown response from Room Alert $name\n$content"); $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_commandline_poller { my $collector = shift; my $name = $collector->{_name}; my ($now, $start); my $fd = new FileHandle; print "Forking CommandLine poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for CommandLine $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 commandline poller, $name"; # # Continually rotate through the collection of sensors # while (1) { $start = time; while (my ($n, $sensor) = each %{ $collector->{sensor} }) { my $val = `$sensor->{command}`; $val =~ s/^\s*//; $val =~ s/\n.*$//s; $val =~ s/\s*$//; print "$n $val\n"; } # # 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 CommandLine poller exit?"); } sub fork_veris_poller { my $collector = shift; my $name = $collector->{_name}; my ($now, $start, $result, $veris, $sensor, @addrs); my ($A, $M); my $errcnt = 0; my $fd = new FileHandle; print "Forking Veris poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for Veris $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); close $fd; # We only use STDOUT in child $| = 1; # And it gets flushed at every write! $SIG{HUP} = $SIG{INT} = $SIG{TERM} = "DEFAULT"; $veris = $collector->{_modbus_device}; $A = $collector->{amperage}; $M = $collector->{_multiplier_key}; undef %config; # Cleans up a lot of extraneous crap... $0 = "$script poller, $name"; $SIG{ALRM} = sub { print STDERR "Timeout!\n"; die "Timeout!" }; LOOP: while (1) { $start = time; eval { $result = $veris->read(40001..$collector->{_last_modbus}); }; if ($@) { msg("err", $@); msg("err", "Modbus error count $errcnt"); # If the Veris 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}; $veris = $collector->{_modbus_device} = $modbus->device($collector->{modbusaddress}); $errcnt = 0; } next LOOP; } $errcnt = 0; printf "40001\t%.3f\n", $result->{40001} * $veris{40001}{multiplier}{$M}{$A} + $result->{40002} * $veris{40002}{multiplier}{$M}{$A}; for my $n (40003..$collector->{_last_modbus}) { printf "%d\t%.3f\n", $n, $result->{$n} * $veris{$n}{multiplier}{$M}{$A}; } } 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 Veris poller exit?"); } sub fork_enersure_poller { my $collector = shift; my $name = $collector->{_name}; my ($now, $start, $result, $enersure, $sensor, @addrs); my ($v, $i, $p, $w, $k, $ks); my $errcnt = 0; my $fd = new FileHandle; print "Forking Enersure poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for Enersure $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 # exiting, which will signal that the child has died, and we'll # try to re-establish a connection with it, and retry the read... if (++$errcnt > 3 && ! $collector->{device}) { msg("err", "modbus device may have failed - exiting to retry"); exit 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 $collector = shift; my $name = $collector->{_name}; my ($ua, $now, $start, $result, $sensor, $oid, @oids, %oids, $v); my $fd = new FileHandle; print "Forking SNMP poller for \n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork collector for SNMP $name"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } $is_child++; close_logfiles(); 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 (we only need to poll any OID once, # even if there are duplicates in the list) # for my $n (sort keys %{ $collector->{sensor} }) { $sensor = $collector->{sensor}{$n}; $oids{ $sensor->{_oid} }++; } @oids = sort keys %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") { $v = evaluate_counter($sensor, $v); print "$n $v\n"; } elsif ($sensor->{type} eq "gauge") { print "$n $v\n"; } else { die "Unpossible SNMP sensor type $sensor->{type}"; } } 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 $collector = shift; my $fd = new FileHandle; print "Forking SNMP trap handler\n" if $opt_verbose; for my $pid (open $fd, "-|") { $pid == 0 && last; # Child - the real work is below $pid == -1 && die "Cannot fork SNMP trap handler"; print " Filenumber ", $fd->fileno(), "\n" if $opt_verbose; $collector->{_fd} = $fd; print " Poller PID is $pid\n" if $opt_verbose; return $pid; # Parent returns PID } close_logfiles(); 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, and # the MaxBotix sonar devices use \r. 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, $rescan) = @_; my ($rout, $rret, $ri, $ro, $fileno, $k, $char, $start, $count); my @my_select_tmp; # No persistent data across invocations, that # is, throw out half-formed lines (which should # only occur if we hit our timeouts) our @rfd; # Persistent descriptor list, though @rfd = keys %$rfd if $rescan; # Initialize (mostly) once # # 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)) { $count = 0; FD: while ($fileno = shift @rfd) { # # Rotate though collectors, in case of timeout, but make sure that # when we finish the list, we break and start at the right place # if (++$count > scalar keys %$rfd) { unshift @rfd, $fileno; last FD; } else { push @rfd, $fileno; } next FD unless vec($rout, $fileno, 1); $k = $rfd->{$fileno}; 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; } else { # print "Got '$char' from $fileno\n" if $opt_verbose; $my_select_tmp[$fileno] .= $char; } } continue { unstick() if time - $start > 1; } alarm(0); }; # end of eval with possible timeout msg("err","Unstick seems to have been called while in $k") if $&; 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 $a (@$axes) { if ($a->{_scale} =~ /^[CF]$/) { $a->{_scale} = $lh->maketext("Temperature [_1]", "\N{U+00b0}$opt_temperature"); } elsif ($a->{_scale} eq "Deg") { $a->{_scale} = $lh->maketext("Direction"); # Not "wind" } else { $a->{_scale} = (adjust_for_scale(0, $a->{_scale}, 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 my $a (@$axes) { $axis{ $a->{_scale} }++; } # # 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]{_scale} 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]{_scale} 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 (minmax, maxmin) 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") { # No header for 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} }, { id => $axes->[$col]{_nk}, name => $head[$col], value => $row[$col], units => $axes->[$col]{_scale}, }; } 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} || $opt_all_sensors; # # 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}, }; } ACTUATOR: for my $n (keys %{ $config{collector}{$k}{actuator} }) { my $nk = "$n\@$k"; next ACTUATOR unless $config{_view}{$opt_view}{$nk} || $opt_all_sensors; push @kn, { kn => $nk, k => $k, n => $n, sensor => $config{collector}{$k}{actuator}{$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) { push @axes, ($sensor = $kn->{sensor}); # # 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, $sensor->{_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 is empty (it could happen! :-) (returns -1) # We need to assess the success and two failure modes below # if (look($sensor->{_fd}, $date_from, {comp => sub { $_[0] <=> $_[1] }}) == -1) { next SENSOR; } chomp($line = $sensor->{_fd}->getline); # # If we can't read anything, then we're at the end of the file # (conditions 2 or 3, above). Skip this file - we have no time # references to use. We'll fill it in at the very end. # ($time, $val) = split /\t/, $line; } elsif ($config{logformat} eq "sql") { $sth = $dbh->prepare(qq{ SELECT logtime, value FROM readings WHERE log_id = $sensor->{_id} AND logtime >= ? AND logtime <= ? ORDER BY logtime}); $sth->execute($date_from, $date_to); ($time, $val) = $sth->fetchrow_array(); } else { die "Unknown LogFormat"; } next SENSOR unless $time; keys %{ $sensor->{_data} } = keys %time; # Preallocate hash # # Now suck in as many entries as we need until $date_to or EOF # If file is empty or the dataset returned NULL, skip this part... # while ($time <= $date_to) { ($val, undef) = adjust_for_scale($val, $sensor->{_scale}, 5); $sensor->{_data}->{$time} = $val; $prev = $time; if ($config{logformat} eq "text") { chomp($line = $sensor->{_fd}->getline); ($time, $val) = split /\t/, $line; } elsif ($config{logformat} eq "sql") { ($time, $val) = $sth->fetchrow_array(); } else { die "Unknown LogFormat"; } last unless $time; next unless $val; $interval = min($time - $prev, $interval) if $time - $prev > 0; } } # # If back in the measured time we had a different value for LogInterval, # we have to adjust the values in %time to compensate; # if (!$opt_current && $interval < $config{loginterval}) { for (my $t = $date_from; $t <= $date_to; $t += $interval) { $time{$t}++; } } # # Okay, we really want a collection of arrays, not hashes, so convert # the hashes to arrays. Use a time array, too. While we copy from hash # to array, calculate the min/max values and the indices of them in the # arrays. Same for the last value measured (which may not be the last # value in the array, since we intentionally copy undefs!) # @time = sort keys %time; for my $kn (@kn) { my @values; # Reallocated each time through the loop ($max_idx, $min_idx, $last_tick, @values) = (undef); $min = INT_MAX; $max = INT_MIN; $sensor = $kn->{sensor}; for my $t (@time) { $val = $sensor->{_data}->{$t}; $val = $cliplo if defined($cliplo) && $val < $cliplo; $val = $cliphi if defined($cliphi) && $val > $cliphi; push @values, $val; next unless defined $val; $num_datapoints++; if ($val < $min) { $min = $val; $min_idx = $#values; } if ($val > $max) { $max = $val; $max_idx = $#values; } $last_val = $val; $last_tick = $#values; } $sensor->{_data} = \@values; # # Now find the min and max values for the markers, and mark them # If the min_idx or max_idx are undefined, then we found no data # at all for that sensor in that time range. # if (defined($min_idx) && defined($max_idx)) { $sensor->{_min} = $min; $sensor->{_minmax}[$min_idx] = $min; $sensor->{_max} = $max; $sensor->{_minmax}[$max_idx] = $max; $sensor->{_minmax}[$last_tick] = $last_val; push @data, $sensor; } # # No min/max, so kludge in empty arrays # else { push @data, {_minmax => [], _data => []}; } } setlocale(LC_ALL, $lh->locale()); # Set the locale back return $num_datapoints, \@axes, \@time, \@data; } ############################################################################ # CGI Script # ############################################################################ sub do_cgi { my $is_timeplot = (param('type') eq "timeplot" && $config{view}{$opt_view}{graphtype} ne "radar" && $config{view}{$opt_view}{type} ne "image"); # # We need to do this first: if we are asked to show a view of type "radar" # then set the width of the graph equal to the height so we get a circular # (and not an elliptical) graph # if ($config{view}{$opt_view}{graphtype} eq "radar") { $opt_width = $opt_height; } if (param('graph')) { # # If we are called with param('graph'), we are creating a plot/picture # of the data. The catch is, if we use timeplot, the plot is just # textual data that is picked up by the javascript. So, do the right # thing for the type requested # if ($is_timeplot) { print header(-content_type => "text/plain", -expires => "-10d"); $opt_epochtime = 1; $opt_format = "timeplot"; do_report(collect_data($config{view}{$opt_view}{cliplo}, $config{view}{$opt_view}{cliphi})); } elsif ($config{view}{$opt_view}{type} eq "graph") { print header(-content_type => "image/png", -expires => "-10d"); do_graph(collect_data($config{view}{$opt_view}{cliplo}, $config{view}{$opt_view}{cliphi})); } elsif ($config{view}{$opt_view}{type} eq "image") { print header(-content_type => "image/png", -expires => "-10d"); do_annotate(); } } elsif (param('type') =~ /[ct]sv[ru]|excel|xml/) { if (param('type') =~ /([ct]sv)([ru])/) { $opt_format = $1; if ($opt_format eq "csv") { print header(-content_type => "text/csv; charset=@{[$lh->charset]}", -expires => "-10d", -content_disposition => "attachment;filename=thermd.csv"); } elsif ($opt_format eq "tsv") { print header(-content_type => "text/plain; charset=@{[$lh->charset]}", -expires => "-10d"); } $opt_epochtime = $2 eq 'u'; do_report(collect_data()); } elsif (param('type') eq "excel") { eval qq{ use Spreadsheet::WriteExcel; }; die $@ if $@; $opt_format = "excel"; print header(-content_type => "application/vnd.ms-excel; charset=@{[$lh->charset]}", -expires => "-10d", -content_disposition => "attachment;filename=thermd.xls"); $opt_epochtime = 1; do_report(collect_data()); } elsif (param('type') eq "xml") { eval qq{ use XML::Simple; }; die $@ if $@; $opt_format = "xml"; print header(-content_type => "text/xml; charset=@{[$lh->charset]}", -expires => "-10d"); $opt_epochtime = 1; $opt_current = 1; $opt_all_sensors = 1; do_report(collect_data()); } } elsif (param('pleasewait')) { # # The Please Wait 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). # print header(-content_type => "image/png", -expires => "now"); 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,"Generating Graph",$blue); $im->string(GD::Font->Large,0,35,"Please Wait...",$blue); print $im->png; } elsif (param('docs')) { print header(), `pod2html $ENV{SCRIPT_FILENAME}`; } else { # The HTML text wrapper around everything else local $, = " "; my (@current, @current_rows, $time, @lines); my $me = self_url(); my %type_labels = ( # a hash for radio_group() graph => $lh->maketext("Graphical"), timeplot => $lh->maketext("TimePlot"), csvr => $lh->maketext("CSV Human Time"), csvu => $lh->maketext("CSV UNIX Epoch Time"), tsvr => $lh->maketext("TSV Human"), tsvu => $lh->maketext("TSV Epoch"), excel => $lh->maketext("Excel"), xml => $lh->maketext("XML"), ); $me .= '?' unless $me =~ /\?/; # # Create a list of views, make sure "all" (or the DefaultView) is first # Don't show the wunderground views - they are "push" only # my %view_labels = %{ $config{_view} }; delete $view_labels{all}; delete $view_labels{ $config{defaultview} }; my @view_labels = ($config{defaultview}, sort { $config{view}{$a}{buttonorder} <=> $config{view}{$b}{buttonorder} || $a cmp $b } grep { $config{view}{$_}{type} ne "wunderground"} keys %view_labels); # # Build the current data view (with colors) # ($time, @lines) = read_current_values(); if (defined $time) { @current = ( $lh->maketext("Latest Readings: [_1]", decode_utf8(strftime("%c", localtime($time)))) ); LINE: for my $line (@lines) { chomp $line; my ($v, $sensor_units, $id) = split /\t/, $line, 3; my ($color, $popup, $adj, $old); my $_view = $config{_view}{$opt_view}{$id}; # # If the specified sensor is not in the currently selected # view, skip it! Otherwise, get its color by name match. # The element in the _view hash will be a pointer to a hash. # Overwrite the sensor GraphColor with the value from the # hash (either TextColor or GraphColor), if it exists. # next LINE unless $_view; my $sensor = $_view->{_sensor}; if (exists $_view->{name}) { $sensor->{name} = $_view->{name}; } $color = $_view->{textcolor} || $_view->{graphcolor} || $sensor->{graphcolor}; $color = "black" if lc($color) eq "white"; if ($popup = $_view->{popup} || $sensor->{popup}) { $popup = escapeHTML($popup); $popup =~ s#\n#
#g; } if ($sensor_units eq 'Deg') { $line = $lh->maketext("[_1] wind", wind_direction_str($v)); } elsif ($sensor_units eq 'Count') { $line = sprintf "%s %s", ztrim($v), $sensor->{name}; } else { ($adj, undef) = adjust_for_scale($v, $sensor_units, 2); $line = sprintf "%s %s", $adj, $sensor->{name}; } $old = autoEscape(0); push @current, font({color => $color, $popup ? (onmouseover => "return escape('$popup')") : (), }, " $line "); autoEscape($old); } } else { @current = ($lh->maketext("The logging daemon does not seem to be running\n")); } while (my @c = splice @current, 1, 5) { push @current_rows, td([ @c ]); } # # Here's an annoying one - from and to can be relative values, and # we allow things like "+1d". But in HTTP requests, '+' is the same # as ' ', so we need to turn the '+' in to '%2b' in dates. # $opt_from =~ s/\+/%2b/g; $opt_to =~ s/\+/%2b/g; $, = "\n"; print header(-content_type => "text/html; charset=@{[$lh->charset]}"), start_html(-bgcolor => "white", -title => $config{location} ? $lh->maketext("Temperature and Environment in [_1]", $config{location}) : $lh->maketext("Temperature and Environment"), -head => meta({ -http_equiv => 'Refresh', -content => "$config{refreshrate}; url=$me"}), -script => [ { -language => "javascript", -code => javascript_timer(), }, # # If we're asking for a timeplot, we need to call upon the # main body of MIT code, as well as the second call to # thermd which creates the data to be plotted # $is_timeplot ? ( { -type => "text/javascript", -src => "http://static.simile.mit.edu/timeplot/api/1.0/timeplot-api.js", }, { -language => "javascript", -code => javascript_timeplot(), }, ) : (), ], # # Also, the timeplot code requires attributes in the tag # $is_timeplot ? ( -onLoad => "onLoad();", -onResize => "onResize();", ) : (), ), table({width => "85%"}, TR( td({valign=>"top"}, h1($config{location} ? $lh->maketext("The environment in and around [_1]", $config{location}) : ""), ($config{gpscoordinates} ? h2(a({href => $config{mapurl}}, $config{gpscoordinates})) : "")), td({valign=>"top", align=>"right", nowrap=>1}, small(b(decode_utf8(strftime("%c", localtime)))), br(), small({-id=>'refresh_counter'}, "")))), ($config{blurb} ? p($config{blurb}) : ""), table({width => "85%"}, # Sigh - If the charset is UTF-8, then $current[0] may have # UTF-8 in it, and @current_rows may have Unicode (which will # give garbage when concatenated). Decode one of them if # necessary, so we can print them both in one string. # Honestly, the code makes no sense - make sure that DA, RU, # and EN work, and that'll do her. TR(th({colspan=>3}, ($lh->charset eq "UTF-8" && ! utf8::is_utf8($current[0])) ? decode_utf8($current[0]) : $current[0])), TR([@current_rows])), '', p(), start_form({-method => "GET"}); # # The timeplot code is simply a div that the javascript targets # while the self-generated images are an image that results from # another invocation of thermd # if ($is_timeplot) { my @hdr; for my $kn (determine_sensor_order()) { push @hdr, span( {-style => "color: $kn->{sensor}{graphcolor};"}, $kn->{sensor}{name}); } print div({-style => "font-size: 10px; font-family: 'verdana', 'helvetica', sans serif;"}, join(' | ', @hdr)), div({-id => "thermd-tp", -style => "height: ${opt_height}px;"}, " "); } else { print img({ $config{view}{$opt_view}{type} eq "image" ? () : (-height => $opt_height, -width => $opt_width), -lowsrc => "$me;pleasewait=1", -src => "$me;graph=1"}); } print hidden("config"), br(), table($opt_width == $opt_height ? {} : {width => $opt_width}, TR( td({align => "right"}, b($lh->maketext("Scale:"))), td(radio_group(-name => "units", -onClick => "submit()", -values => [qw(Metric English)], -labels => { Metric => $lh->maketext("Metric"), English => $lh->maketext("English"), }, -default => $opt_units)), td({align => "middle"}, b($lh->maketext("Hi/Lo graph:")), checkbox(-name => "hilo", -onClick => "submit()", -label => "")), td({align => "middle"}, b($lh->maketext("From:")), textfield(-name => "from", -default => "-1d", -size => 6), b($lh->maketext("To:")), textfield(-name => "to", -default => "now", -size => 6), submit(-label => $lh->maketext("Redraw")))), @view_labels > 1 ? TR(td({align => "right"}, b($lh->maketext("View:"))), td({colspan => @view_labels > 7 ? 4 : 3, align => "middle"}, radio_group(-name => "view", -onClick => "submit()", -values => [ @view_labels ], @view_labels > 7 ? (-columns => 7) : (), -default => $config{defaultview} || "all"))) : "", TR( td({align => "right"}, b($lh->maketext("Type:"))), td({colspan => 3, align => "middle"}, table( TR(td([ radio_group(-name => "type", -onClick => "submit()", -values => [ qw(graph) ], -labels => \%type_labels, -default => "graph"), radio_group(-name => "type", -onClick => "submit()", -values => [ qw(csvr) ], -labels => \%type_labels, -default => "graph"), radio_group(-name => "type", -onClick => "submit()", -values => [ qw(tsvr) ], -labels => \%type_labels, -default => "graph"), radio_group(-name => "type", -onClick => "submit()", -values => [ qw(excel) ], -labels => \%type_labels, -default => "graph"), ])), TR(td([ radio_group(-name => "type", -onClick => "submit()", -values => [ qw(timeplot) ], -labels => \%type_labels, -default => "graph"), radio_group(-name => "type", -onClick => "submit()", -values => [ qw(csvu) ], -labels => \%type_labels, -default => "graph"), radio_group(-name => "type", -onClick => "submit()", -values => [ qw(tsvu) ], -labels => \%type_labels, -default => "graph"), radio_group(-name => "type", -onClick => "submit()", -values => [ qw(xml) ], -labels => \%type_labels, -default => "graph"), ])) )) )), hidden("endtime"), end_form(), javascript_popup(), ($config{blurb2} ? p($config{blurb2}) : ""); #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ # NOTE: If you delete these next few lines, you will be in violation # of my copyright, and that will make me mad (and litigious)... #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ print font({color => "black", size => 2}, address("Thermometer Daemon", a({href => 'http://www.klein.com/thermd', target => "_blank"}, "source code"), "and", a({href => "$me;docs=1", target => "_blank"}, "documentation."), "(V@{[(split(/\s+/, VERSION))[2,3]]}) Copyright © 2001-2009", a({href => 'mailto:dan@klein.com'}, "Daniel V. Klein"))); #-------------------------------------------------------------------- # End of serious copyright law stuff #-------------------------------------------------------------------- if ($config{rss}) { print address( a({href => "$config{rss}{url}/index.xml"}, "RSS-2.0 Feed")); } print end_html(); } } sub javascript_timeplot { my $idx = 1; my $me = url(-absolute => 1, -query => 1); # Without http://ip.com:port my $js = <<"==FIRST-PLOT-JS=="; var timeplot; var eventSource = new Timeplot.DefaultEventSource(); var timeGeometry = new Timeplot.DefaultTimeGeometry({ gridColor: new Timeplot.Color("#000000"), axisLabelsPlacement: "top", }); var valueGeometry = new Timeplot.DefaultValueGeometry({ gridColor: "#000000", // min: 0, // max: 100, axisLabelsPlacement: "left", }); function onLoad() { var plotInfo = [ ==FIRST-PLOT-JS== for my $kn (determine_sensor_order()) { $js .= <<"==MIDDLE-PLOT-JS=="; Timeplot.createPlotInfo({ id: "plot$idx", dataSource: new Timeplot.ColumnSource(eventSource, $idx), timeGeometry: timeGeometry, valueGeometry: valueGeometry, lineColor: "$kn->{sensor}{graphcolor}", showValues: true, roundValues: false, }), ==MIDDLE-PLOT-JS== $idx++; } $js .= <<"==LAST-PLOT-JS=="; ]; timeplot = Timeplot.create(document.getElementById("thermd-tp"), plotInfo); timeplot.loadText("$me;graph=1", "\\t", eventSource); } var resizeTimerID = null; function onResize() { if (resizeTimerID == null) { resizeTimerID = window.setTimeout(function() { resizeTimerID = null; timeplot.repaint(); }, 100); } } ==LAST-PLOT-JS== return $js; } sub javascript_timer { my $refreshing = $lh->maketext("Refreshing..."); my $refreshing_in = $lh->maketext("Refreshing in"); my $refresh_failed = $lh->maketext("Refresh failed, hit Reload"); return <<"==TIMER-JS=="; /* * This timer script was adapted from a script in the source code to drraw, * http://web.taranis.org/drraw, which is released under a BSD-style licence */ var ViewerStart; var ViewerRefresh; function ViewerCountdown(target) { if (!ViewerStart || !ViewerRefresh) return; var targetElement; targetElement = document.getElementById(target); if (!targetElement) return; now = new Date(); elapsed = ( now - ViewerStart ) / 1000; if (elapsed > ViewerRefresh + 30) { if ((elapsed - ViewerRefresh) % 2 < 1) { targetElement.innerHTML = "$refresh_failed"; } else { targetElement.innerHTML = "$refresh_failed"; } setTimeout("ViewerCountdown(thetarget)", 1000); } else if (elapsed > ViewerRefresh-1) { targetElement.innerHTML = "$refreshing"; setTimeout("ViewerCountdown(thetarget)", 10000); } else { with (Math) { min = floor((ViewerRefresh - elapsed) / 60); sec = floor((ViewerRefresh - elapsed) % 60); if (min < 1) { if (sec < 30 && sec % 2 == 0) targetElement.innerHTML = "$refreshing_in "+ sec +"s"; else targetElement.innerHTML = "$refreshing_in "+ sec +"s"; } else targetElement.innerHTML = "$refreshing_in "+ min +"m "+ sec +"s"; } thetarget=target; setTimeout("ViewerCountdown(thetarget)", 1000); } } ==TIMER-JS== } sub javascript_popup { return $config{_has_popups} ? <<'==POPUP-JS==' : ""; ==POPUP-JS== } ############################################################################## # Argument and config file processing ############################################################################## my $warned = 0; my $erred = 0; my $errstr; format STDERR = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~ $errstr ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ $errstr . sub cfg_warn { return if $opt_nowarn; unless($warned++) { warn "\n" if $erred; warn "- Configuration warning(s) in $opt_config:\n\n"; } $errstr = "- @{[join ' ', @_]}\n"; write STDERR; } sub cfg_die { my $str = join " ", @_; my $hdr = "Configuration error in $opt_config"; $errstr = "* $str\n"; write STDERR; if ($ENV{REQUEST_METHOD}) { unless ($erred) { print header(-content_type => "text/html; charset=@{[$lh->charset]}"), start_html("$hdr"), h1("Configuration error"); } $str =~ s/&/&/g; $str =~ s//>/g; print p(), pre($str); } unless ($opt_checkconfig) { print end_html() if $ENV{REQUEST_METHOD}; exit 1; } $erred++; } sub walk_cfg { my $cfg = shift; my ($k, $v); while (($k, $v) = each %$cfg) { if (ref $v eq "HASH") { walk_cfg($v); } elsif (!defined $v) { cfg_die "Missing value for attribute $k"; } } } sub read_config { # # NOTE: we declare %cfg, $k, %used, $email_regex, $collector, and $clctr # as local so that the collector subroutines may up-level address them! # use vars qw(%cfg $k %used $email_regex $collector $clctr); die $lh->maketext("Shell redirection characters not allowed in filename '[_1]'", $opt_config) if $opt_config =~ /[`|<>]/; local %cfg = ParseConfig(-ConfigFile => $opt_config, -AutoTrue => 1, -LowerCaseNames => 1, -MergeDuplicateBlocks => 1); local $email_regex = email_regex(); my %facility = map {$_, 1} qw(console daemon user), ('local0'..'local7'); my %trap_lookup; my @extra; walk_cfg(\%cfg); $config{logformat} = delete $cfg{logformat} || 'text'; ($config{logformat}, @extra) = split /\s+/, $config{logformat}; $config{logformat} = lc $config{logformat}; if ($config{logformat} eq "sql") { eval qq{ use DBI; }; die $@ if $@; cfg_die "LogFormat SQL requires an SQL type, database name and authenication credentials" unless @extra == 3; ($config{_sql_type}, $config{_database}, $config{_db_auth}) = @extra; for my $driver (DBI->available_drivers) { if (lc($driver) eq lc($config{_sql_type})) { $config{_sql_type} = $driver; last; } } connect_to_database(1); verify_database_format(); cfg_warn "Ignoring LogRead - you don't need it when LogFormat is SQL" if delete $cfg{logread}; cfg_warn "Ignoring LogWrite - you don't need it when LogFormat is SQL" if delete $cfg{logwrite}; } elsif ($config{logformat} eq "text") { cfg_warn "Ignored extra fields after 'text' in LogFormat" if @extra; if ($cfg{logread} && $cfg{logwrite}) { $config{logread} = delete $cfg{logread}; $config{logwrite} = delete $cfg{logwrite}; } elsif ($cfg{logread}) { $config{logread} = $config{logwrite} = delete $cfg{logread}; } elsif ($cfg{logwrite}) { $config{logwrite} = $config{logread} = delete $cfg{logwrite}; } else { $config{logwrite} = $config{logread} = "/var/log/thermd"; } if (! $opt_daemon && ! (-d $config{logread} && -r _)) { cfg_die "Cannot read LogRead directory $config{logread}"; } if ($opt_daemon && ! (-d $config{logwrite} && -w _)) { cfg_die "Cannot write LogWrite directory $config{logwrite}"; } } else { cfg_die "Unknown LogFormat (try 'text' or 'sql')"; } $config{pidfile} = delete $cfg{pidfile} || '/var/run/thermd.pid'; if ($opt_daemon && $config{pidfile} ne File::Spec->devnull()) { print "Initial Daemon PID == $$\n" if $opt_verbose; print "Opening PID file\n" if $opt_verbose; my $fd = new FileHandle; sysopen($fd, $config{pidfile}, (O_RDWR | O_CREAT), 0644) or die "Can't open $config{pidfile} - $!"; $fd->autoflush(1); unless (flock($fd, LOCK_EX|LOCK_NB)) { my $pid = <$fd>; warn "I think there is a thermd daemon already running as PID $pid"; die "Please stop any running daemon before starting a new one.\n"; } $config{_pidfile_fd} = $fd; } $config{loginterval} = $cfg{logfrequency} || delete $cfg{loginterval}; if (delete $cfg{logfrequency}) { cfg_warn "LogFrequency is now deprecated - please use LogInterval"; } $config{loginterval} = parse_reltime("LogInterval", $config{loginterval}, "10m"); if ($config{loginterval} < 15 || $config{loginterval} > 30*60) { cfg_warn "LogInterval should probably be between 15s and 30m"; } $config{_minpoll} = $config{loginterval}; # Reduced below... if ($^O eq "MSWin32") { if (defined delete $cfg{syslogfacility}) { cfg_warn "Syslog is not available on Windows - ignoring SysLogFacility"; } } else { $config{syslogfacility} = delete $cfg{syslogfacility} || 'user'; unless ($facility{$config{syslogfacility}}) { cfg_die "Syslog Facility '$config{syslogfacility}' unknown. Use one of", join(", ", sort keys %facility); } print "Opening syslog\n" if $opt_verbose; openlog("$script", "pid", $config{syslogfacility}); if ($opt_daemon) { msg("notice", "Starting daemon V@{[(split(/\s+/, VERSION))[2,3]]}"); } } $config{mailfrom} = delete $cfg{mailfrom} || ('root@' . hostname()); unless ($config{mailfrom} =~ /^$email_regex$/) { cfg_die "Address in MailFrom is not a valid email address"; } if ($config{smtphost} = delete $cfg{smtphost}) { if (my $s = delete $cfg{sendmail}) { cfg_warn "Ignoring Sendmail $s when SMTPHost is used. Pick one."; } $config{smtpusername} = delete $cfg{smtpusername}; $config{smtppassword} = delete $cfg{smtppassword}; if (defined($config{smtpusername}) != defined($config{smtppassword})) { cfg_warn "You must use both SMTPUsername and SMTPPassword for authentication (or neither for no authentication)"; } } else { $config{sendmail} = delete $cfg{sendmail} || '/usr/sbin/sendmail'; if (-e $config{sendmail}) { unless (-x $config{sendmail}) { cfg_warn "Sendmail ($config{sendmail}) doesn't look executable"; $config{sendmail} = File::Spec->devnull(); } } else { cfg_warn "I can't find Sendmail ($config{sendmail})"; $config{sendmail} = File::Spec->devnull(); } if (delete $cfg{smtpusername}) { cfg_warn "Ignoring SMTPUsername when Sendmail is used"; } if (delete $cfg{smtppassword}) { cfg_warn "Ignoring SMTPPassword when Sendmail is used"; } } $config{location} = delete $cfg{location}; $config{timezone} = uc(delete $cfg{timezone} || 'GMT'); $config{gpscoordinates} = delete $cfg{gpscoordinates}; $config{mapurl} = delete $cfg{mapurl}; if (defined $cfg{displayin}) { cfg_warn "DisplayIn is now deprecated - thermd will make a reasonable choice based on your locale"; } $config{displayin} = ucfirst(lc(delete $cfg{displayin} || $lh->scale)); $config{temperature}= uc(delete $cfg{temperature} || $units{ $config{displayin} }{temperature}); $config{windspeed} = uc(delete $cfg{windspeed} || $units{ $config{displayin} }{windspeed}); $config{barometer} = uc(delete $cfg{barometer} || $units{ $config{displayin} }{barometer}); $config{rainfall} = uc(delete $cfg{rainfall} || $units{ $config{displayin} }{rainfall}); $config{graphwidth} = delete $cfg{graphwidth} || 750; $config{graphheight}= delete $cfg{graphheight} || 300; $config{refreshrate}= parse_reltime("RefreshRate", delete $cfg{refreshrate}, "30m"); unless ($config{refreshrate} >= 1) { cfg_die "RefreshRate must be at least 1m (and expressed as minutes)"; } $config{blurb} = delete $cfg{blurb}; $config{blurb2} = delete $cfg{blurb2}; $config{sensororder}= lc(delete $cfg{sensororder}) || "name"; unless ($config{sensororder} =~ /^(((sub)?(name|id))|popup|nosort)$/) { cfg_warn "Unknown SensorOrder '$config{sensororder}' - using 'name'"; $config{sensororder}= "name"; } if ($config{displayin} =~ /^([FC]|English|Metric)$/) { # # This F/C -> English/Metric is for backwards compatability # $config{displayin} = "English" if $config{displayin} eq "F"; $config{displayin} = "Metric" if $config{displayin} eq "C"; } else { cfg_die "DisplayIn must be English or Metric"; } # # Allow specific overrides on units # $config{temperature} ||= $units{ $config{displayin} }{temperature}; $config{temperature} = uc($config{temperature}); unless ($config{temperature} =~ /^[CF]$/) { cfg_die "Temperature can only be displayed in C or F"; } $config{barometer} ||= $units{ $config{displayin} }{barometer}; $config{barometer} = uc($config{barometer}); unless ($config{barometer} =~ /^((IN|MM)HG|HPA|KPA|MILLIBAR|MBAR)$/) { cfg_die "Barometric pressure can only be displayed in inHg, mmHg, hPa, kPa, mBar or millibar"; } $config{rainfall} ||= $units{ $config{displayin} }{rainfall}; $config{rainfall} = uc($config{rainfall}); unless ($config{rainfall} =~ /^(INCH(ES)?|MM)$/) { cfg_die "Rainfall can only be displayed in inches or mm"; } $config{windspeed} ||= $units{ $config{displayin} }{windspeed}; $config{windspeed} = uc($config{windspeed}); unless ($config{windspeed} =~ /^(MPH|KPH|MPS|KNOTS?)$/) { cfg_die "WindSpeed can only be displayed in MPH, KPH, MPS, or Knots"; } $config{snmptrapport} = delete $cfg{snmptrapport} || 162; unless ($config{snmptrapport} =~ /$numeric/) { cfg_warn "Non-numeric SNMPTrapPort - using 162"; $config{snmptrapport} = 162; } # # I can't comment (no really, I can't comment). But I'll give you a hint: # If you reverse engineer this or bypass it, you're accepting the risk # if ($config{decode_base64("YWNrbm93bGVkZ2U=")} = lc(delete $cfg{decode_base64("YWNrbm93bGVkZ2U=")})) { if ($config{decode_base64("YWNrbm93bGVkZ2U=")} eq decode_base64("bm93YXJyYW50eQ==")) { $opt_sesame++; } else { cfg_die "I don't recognize", ucfirst(decode_base64("YWNrbm93bGVkZ2U=")), ucfirst($config{decode_base64("YWNrbm93bGVkZ2U=")}); } } if ($cfg{rss}) { if (ref $cfg{rss} eq "HASH") { if (keys %{$cfg{rss}} == 1) { my ($k, $v) = %{$cfg{rss}}; my $showit; unless (-d $k) { cfg_warn "RSS directory $k does not exist - creating it"; mkdir $k or cfg_die "Cannot create RSS subdirectory $k"; } cfg_die "RSS directory $k is not writable" if $opt_daemon && ! -w $k; $config{rss}{_dir} = $k; $config{rss}{url} = delete $v->{url} || cfg_die "Missing URL in RSS directive"; $config{rss}{webmaster} = delete $v->{webmaster} || cfg_die "Missing Webmaster in RSS directive"; unless ($config{rss}{webmaster} =~ /^$email_regex$/) { cfg_die "Address in RSS Webmaster is not a valid email address"; } $config{rss}{every} = delete $v->{every} || 1; cfg_die "Illegal value for Every in RSS block" unless $config{rss}{every} =~ /^\d+$/; $config{rss}{nice} = delete $v->{nice}; if (keys %$v == 0) { delete $cfg{rss}; } else { cfg_warn "Unknown components in RSS directive ignored: ", join(", ", keys %$v); } } else { cfg_die "Only one RSS directive may be specified"; } } else { cfg_die "RSS directive must be enclosed by and "; } } if ($cfg{collector}) { if (ref $cfg{collector} eq "HASH") { # # NOTE: $k is declared local so the various device subroutines # can up-level address it. The weird sort just forces derived # collectors last (because we have to have all the other collectors # defined before we can use their sensors).. # for $k (sort { lc($cfg{collector}{$a}{type}) eq "derived" ? 1 : -1 }keys %{$cfg{collector}}) { $collector = \%{$config{collector}{$k}}; # Autovivify $clctr = $cfg{collector}{$k}; $collector->{_name} = $k; if (ref $clctr->{type}) { die "You have two collectors named $k - each collector must have unique name\n"; } defined ($collector->{type} = lc(delete $clctr->{type})) || cfg_die "Missing Type directive in "; $collector->{_datatype} = $collector->{type}; # The default $collector->{readonly} = defined(delete $clctr->{readonly}); if ($collector->{type} eq "qk145") { parse_qk145_vk011(); if ($opt_daemon && ! $collector->{readonly}) { $collector->{baudrate} ||= B2400; $collector->{_fd} = unit_open($collector, $collector->{baudrate}); } } elsif ($collector->{type} eq "vk011") { parse_qk145_vk011(); if ($opt_daemon && ! $collector->{readonly}) { $collector->{baudrate} ||= B9600; $collector->{_fd} = unit_open($collector, $collector->{baudrate}); } } elsif ($collector->{type} eq "maxbotix") { parse_maxbotix(); if ($opt_daemon && ! $collector->{readonly}) { $collector->{baudrate} ||= B9600; $collector->{_fd} = unit_open($collector, $collector->{baudrate}); } } elsif ($collector->{type} =~ /^ow(fs|httpd|shell)$/) { parse_owfs($collector->{type}); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_owfs_poller; create_child_process($collector); }; } } elsif ($collector->{type} =~ /^newport\s+(ibtx(-m)?|ibthx|iptx-[dw]|itcx|ithx-[mw2])/) { $collector->{type} = "newport"; $collector->{_subtype} = $1; parse_newport(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_newport_poller; create_child_process($collector); }; } } elsif ($collector->{type} eq "ha7net") { parse_ha7net(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_ha7net_poller; create_child_process($collector); }; } } elsif ($collector->{type} =~ /^(poseidon\s*\d+|damocles\s*(\d+e?|mini))$/) { # # We parse this device specially, but we poll it via SNMP # parse_hwg(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure if ($collector->{subtype} eq 'snmp') { push @pollers, sub { $collector->{_subr} = \&fork_snmp_poller; create_child_process($collector); }; } elsif ($collector->{subtype} eq 'http') { push @pollers, sub { $collector->{_subr} = \&fork_hwg_poller; create_child_process($collector); }; } else { die "Unpossible SubType $collector->{subtype}"; } } } elsif ($collector->{type} eq "snmp") { parse_snmp(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_snmp_poller; create_child_process($collector); }; } } elsif ($collector->{type} =~ /^veris\s+(H803[0156])$/i) { $collector->{type} = "veris"; $collector->{_subtype} = $1; parse_veris(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure eval qq{ use Modbus::Client; }; die $@ if $@; $collector->{baudrate} ||= B9600; $collector->{_fd} = unit_open($collector, $collector->{baudrate}); my $modbus = new Modbus::Client $collector->{_fd}; $collector->{_modbus_device} = $modbus->device($collector->{modbusaddress}); push @pollers, sub { $collector->{_subr} = \&fork_veris_poller; create_child_process($collector); }; } } elsif ($collector->{type} eq "enersure") { parse_enersure(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure eval qq{ use Modbus::Client; }; die $@ if $@; $collector->{baudrate} ||= B9600; $collector->{_fd} = unit_open($collector, $collector->{baudrate}); my $modbus = new Modbus::Client $collector->{_fd}; $collector->{_modbus_device} = $modbus->device($collector->{modbusaddress}); push @pollers, sub { $collector->{_subr} = \&fork_enersure_poller; create_child_process($collector); }; } } elsif ($collector->{type} eq "wunderground") { parse_wunderground(); if (exists $config{collector}{"WUNDERGROUND/"}) { my $sub = $collector; my $collector = # Autovivify \%{ $config{collector}{"WUNDERGROUND/"} }; push @{ $collector->{_c} }, $sub; } else { # # Create a group collector - note that the name of # the pseudo-collector is illegal in the config # file, so we'll never have a real one named thus # my $sub = $collector; my $collector = # Autovivify \%{ $config{collector}{"WUNDERGROUND/"} }; $collector->{type} = "wunderground_group"; $collector->{_name} = "WUNDERGROUND/"; $collector->{_datatype} = "wunderground_group"; $collector->{_c} = [ $sub ]; # List of collectors $collector->{_ua} = $sub->{_ua}; undef $sub->{_ua}; $collector->{pollinterval} = 60; # Fake if ($opt_daemon && ! $collector->{readonly}) { push @pollers, sub { $collector->{_subr} = \&fork_wunderground_poller; create_child_process($collector); }; } } } # # We allow you to specifiy minigoose, weathergoose, supergoose, # racsense or powergoose, but we treat them all the same :-) # elsif ($collector->{type} =~ /^((mini|weather|super|power)goose|racsense)$/) { parse_weathergoose(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_weathergoose_poller; create_child_process($collector); }; } } elsif ($collector->{type} =~ /^proliphix\s*(.*)$/) { parse_proliphix($1); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_proliphix_poller; create_child_process($collector); }; } } elsif ($collector->{type} eq 'smartnet') { parse_smartnet(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_smartnet_poller; create_child_process($collector); }; } } elsif ($collector->{type} eq "em1") { parse_em1(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_em1_poller; create_child_process($collector); }; } } elsif ($collector->{type} eq "tempager") { parse_roomalert(4); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_roomalert_poller; create_child_process($collector); }; } } elsif ($collector->{type} =~ /^room\s*alert\s*(7|11|24|26)[ew]?$/) { parse_roomalert($1); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_roomalert_poller; create_child_process($collector); }; } } elsif ($collector->{type} =~ "commandline") { parse_commandline(); if ($opt_daemon && ! $collector->{readonly}) { my $collector = $collector; # For closure push @pollers, sub { $collector->{_subr} = \&fork_commandline_poller; create_child_process($collector); }; } } elsif ($collector->{type} eq "temp08") { my $count; parse_temp08(); if ($opt_daemon && ! $collector->{readonly}) { my ($char, $d, $h, $m, $s, $sck_str); $collector->{baudrate} ||= B9600; $collector->{_fd} = unit_open($collector, $collector->{baudrate}); $collector->{_fd}->autoflush(1); print "Initializing TEMP08\n" if $opt_verbose; # You do NOT want to internationalize this ($s, $m, $h, $d) = (localtime)[0..2, 6]; $sck_str = sprintf "%02d,%02d,%02d,%02d",$d+1,$h,$m,$s; print " Sending newline\n" if $opt_verbose; syswrite($collector->{_fd}, "\n"); # Synchronize eval { local $SIG{ALRM} = \&unstick; alarm 1; while (sysread($collector->{_fd}, $char, 1)) { print $char if $opt_verbose; last if $char eq ">"; } alarm 0; }; print " Sending 'SPT00'\n" if $opt_verbose; syswrite($collector->{_fd}, "SPT00"); # Shaddup! while (sysread($collector->{_fd}, $char, 1)) { # print $char if $opt_verbose; last if $char eq ">"; } until ($collector->{_DIS_str} =~ /Qty/) { undef $collector->{_DIS_str}; print " Sending 'DIS'\n" if $opt_verbose; syswrite($collector->{_fd}, "DIS"); # What's there? while (sysread($collector->{_fd}, $char, 1)) { print $char if $opt_verbose; $collector->{_DIS_str} .= $char;# For sensor ID last if $char eq ">"; } sleep 1; if ($count++ > 25) { msg("err", "Cannot communicate with Temp08\n"); last; } } print "$collector->{_DIS_str}\n" if $opt_verbose; print " Sending 'SCK$sck_str'\n" if $opt_verbose; syswrite($collector->{_fd}, "SCK$sck_str\n");# Set TOD while (sysread($collector->{_fd}, $char, 1)) { # print $char if $opt_verbose; last if $char eq ">"; } print " Sending 'DTIon'\n" if $opt_verbose; syswrite($collector->{_fd}, "DTIon"); # No TOD log while (sysread($collector->{_fd}, $char, 1)) { # print $char if $opt_verbose; last if $char eq ">"; } print " Sending 'SIDon'\n" if $opt_verbose; syswrite($collector->{_fd}, "SIDon"); # Seral #s while (sysread($collector->{_fd}, $char, 1)) { # print $char if $opt_verbose; last if $char eq ">"; } print " Sending 'STDC'\n" if $opt_verbose; syswrite($collector->{_fd}, "STDC"); # Centigrade while (sysread($collector->{_fd}, $char, 1)) { # print $char if $opt_verbose; last if $char eq ">"; } print " Sending 'SPT01'\n" if $opt_verbose; syswrite($collector->{_fd}, "SPT01"); # Every minute while (sysread($collector->{_fd}, $char, 1)) { # print $char if $opt_verbose; last if $char eq ">"; } print " Sending 'TMP'\n" if $opt_verbose; syswrite($collector->{_fd}, "TMP"); # Read now! while (sysread($collector->{_fd}, $char, 1)) { # print $char if $opt_verbose; last if $char eq ">"; } # # Note: The ">" is printed before the data readings, # so this needs to be the last command (and let the # data readings sit in the input buffer) # } } elsif ($collector->{type} eq "derived") { parse_derived(); } else { cfg_die "Unknown collector type '$collector->{type}'. Try QK145, VK011, HA7Net, EM1, Temp08, TemPageR, RoomAlert 7E (11E, 24E, or 26W), owfs, owhttpd, owshell, Proliphix, Poseidon 1250 (3262, 3265, 3266, 3268, or 2251), Damocles 2405 (0808e, 0816, or MINI), Newport (or Omega) iBTX (iBTX-M, iBTHX, iPTX-D, iPTX-W, iTCX, iTHX-M, iTHX-W, or iTHX-2), Veris H8030 (H8031, H8035, H8036), EnerSure, or MaxBotix"; } if (keys %{$cfg{collector}{$k}}) { cfg_warn "Unknown components in ignored: ", join(", ", keys %{$cfg{collector}{$k}}); } delete $cfg{collector}{$k}; } delete $cfg{collector}; } else { cfg_die "Collectors must be enclosed by and "; } } else { cfg_die "You must specify at least one directive"; } if ($cfg{view}) { if (ref $cfg{view} eq "HASH") { for my $Vn (keys %{$cfg{view}}) { my $view = \%{$config{view}{lc($Vn)}}; # Autovivify my $vw = $cfg{view}{$Vn}; if ($Vn =~ /^all$/i) { cfg_die " is reserved and automatically defined. Maybe you want to make another View the DefaultView?"; } $view->{_name} = $Vn; if (ref $vw eq "HASH") { $view->{type} = lc(delete $vw->{type} || "graph"); cfg_warn "Unknown View Type '$view->{type}' in " unless $view->{type} =~ /^(graph|image|wunderground)$/; # # (Mostly) Common View components # if ($view->{type} =~ /^(graph|image)$/) { $view->{rssname} = delete $vw->{rssname}; $view->{rssorder} = delete $vw->{rssorder} || 999; cfg_warn "Non-numeric RSSOrder in " unless $view->{rssorder} =~ /$numeric/; $view->{buttonorder} = delete $vw->{buttonorder} || 999; cfg_warn "Non-numeric ButtonOrder in " unless $view->{buttonorder} =~ /$numeric/; } # # Type specific View components # if ($view->{type} eq "graph") { $view->{graphtype} = lc(delete $vw->{graphtype} || "natural"); cfg_warn "Unknown GraphType '$view->{graphtype}' in - use Radar, Natural or Lines" unless $view->{graphtype} =~ /^(radar|natural|lines)$/; $view->{maxmin} = delete $vw->{maxmin}; cfg_warn "Non-numeric MaxMin in " unless $view->{maxmin} =~ /$optnumeric/; $view->{minmax} = delete $vw->{minmax}; cfg_warn "Non-numeric MinMax in " unless $view->{minmax} =~ /$optnumeric/; $view->{cliplo} = delete $vw->{cliplo}; cfg_warn "Non-numeric ClipLo in " unless $view->{cliplo} =~ /$optnumeric/; $view->{cliphi} = delete $vw->{cliphi}; cfg_warn "Non-numeric ClipHi in " unless $view->{cliphi} =~ /$optnumeric/; if ($vw->{show}) { if (ref $vw->{show} eq "ARRAY") { for (@{$vw->{show}}) { check_and_set_view_item($Vn, $_); } } elsif (ref $vw->{show} eq "") { check_and_set_view_item($Vn, $vw->{show}); } else { cfg_die "Unexpected Show in " } delete $vw->{show}; } if ($vw->{"show+"}) { if (ref $vw->{"show+"} eq "HASH") { for (keys %{$vw->{"show+"}}) { check_and_set_graph_hash($Vn, $_); } } elsif (ref $vw->{"show+"} eq "") { check_and_set_view_item($Vn, $vw->{"show+"}); } else { cfg_die "Unexpected in " } delete $vw->{"show+"}; } } elsif ($view->{type} eq "image") { cfg_die "Missing Image " unless $view->{image} = delete $vw->{image}; unless (substr($view->{image}, 0, 1) eq "/") { if ($config{rss}{_dir}) { $view->{image} = "$config{rss}{_dir}/$view->{image}" } else { cfg_die "Image must start with a '/' if there is not RSS block" } } cfg_warn "Can't find Image $view->{image}" unless -e $view->{image}; $view->{font} = delete $vw->{font} || "Helvetica"; $view->{fontsize} = delete $vw->{fontsize} || 14; cfg_warn "Non-numeric FontSize in " unless $view->{fontsize} =~ /$numeric/; if (my $color = lc(delete $vw->{textcolor})) { if ($color_map{$color} || $color =~ /^#[0-9a-f]{6}$/) { $view->{textcolor} = $color; } else { cfg_warn "Unknown TextColor '$color' - use one of ", join(", ", sort keys %color_map); $view->{textcolor} = 'black'; } } else { $view->{textcolor} = 'black'; } $view->{textalign} = lc(delete $vw->{textalign} || "left"); unless ($view->{textalign} =~ /^(left|center|right)$/) { cfg_warn "Unknown TextAlign '$view->{textalign}' - use one of left, center, right"; $view->{textalign} = 'left'; } # It is legal to have a 0 textangle $view->{textangle} = delete $vw->{textangle} || 0; cfg_warn "Non-numeric TextAngle in " unless $view->{textangle} =~ /$numeric/; # It is legal to have a 0 precision $view->{precision} = delete $vw->{precision}; $view->{precision} = 1 unless defined $view->{precision}; cfg_warn "Non-numeric Precision in " unless $view->{precision} =~ /$numeric/; if ($vw->{"show+"}) { if (ref $vw->{"show+"} eq "HASH") { for (keys %{$vw->{"show+"}}) { check_and_set_image_hash($Vn, $_); } } else { cfg_die "Unexpected in " } delete $vw->{"show+"}; } if ($vw->{date}) { if (ref $vw->{date} eq "HASH") { check_and_set_datetime($Vn, "Date"); } else { cfg_die "Unexpected in " } delete $vw->{date}; } if ($vw->{time}) { if (ref $vw->{time} eq "HASH") { check_and_set_datetime($Vn, "Time"); } else { cfg_die "Unexpected