#!/usr/bin/perl -w # # Copyright (c) 2014 Sulev-Madis Silber # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # use strict; use warnings FATAL => 'all'; use Data::Dumper; use OWNet; $| = 1; my ($ownet_dest) = @ARGV; $ownet_dest = 'localhost:4304' unless $ownet_dest; my $owserver; sub safe_string ($) { my ($string) = @_; $string =~ s/[[:cntrl:]]/./g; return $string; } sub ownet_connect () { $owserver = OWNet->new(sprintf "%s -C -mbar -fic -trim -v", $ownet_dest); die 'connect error' unless $owserver; } sub ownet_disconnect () { } sub clean_exit () { ownet_disconnect; exit; } sub ownet_read ($) { my ($path) = @_; my $result = $owserver->read($path); unless (defined $result) { printf "readerror %s '%s'\n", $path, $!; return; } printf "read %s %s\n", $path, safe_string $result; } sub ownet_dir ($) { my ($path) = @_; my $result = $owserver->dir($path); unless (defined $result) { printf "direrror %s '%s'\n", $path, $!; return; } printf "dir %s %s\n", $path, safe_string $result; } sub ownet_tree { my ($path) = @_; my $value = $owserver->read($path); if (defined $value) { printf "tree %s\t%s\n", $path, safe_string $value; return; } else { printf "tree %s\t", $path; } my $dirstring = $owserver->dir($path); if (defined $dirstring) { print "\n"; ownet_tree($_) foreach split ',', $owserver->dir($path); return; } print "\n"; } sub ownet_read_temps { my ($path) = @_; my $dirstring = $owserver->dir($path); unless (defined $dirstring) { printf "readtempsdirerror %s '%s'\n", $path, $!; return; } foreach my $dir (grep { /^\/10\.?[[:xdigit:]]+$/i } split ',', $dirstring) { my $temp_path = sprintf "%s/temperature", $dir; my $value = $owserver->read($temp_path); next unless defined $value; printf "readtemps %s %s\n", $temp_path, safe_string $value; } } $SIG{$_} = \&clean_exit foreach qw(INT TERM); ownet_connect; $0 = 'ownet'; print STDERR "READY\n"; while () { if (/^\s*read\s+(.+)\s*$/i) { ownet_read safe_string $_ foreach split /\s+/, $1; } elsif (/^\s*dir\s+(.+)\s*$/i) { ownet_dir safe_string $_ foreach split /\s+/, $1; } elsif (/^\s*tree(?:\s+(.+))?\s*$/i) { ownet_tree safe_string $_ foreach split /\s+/, defined $1 ? $1 : '/'; } elsif (/^\s*(?:read\s*)?temps?(?:\s+(.+))?\s*$/i) { ownet_read_temps safe_string $_ foreach split /\s+/, defined $1 ? $1 : '/'; } } clean_exit;