Text only | Text with Images

Dangerous Prototypes

Other projects => Past projects => #twatch network LCD backpack => Topic started by: noxin on November 12, 2009, 04:57:33 pm

Title: Perl Script for Hobbit/Xymon Monitoring system
Post by: noxin on November 12, 2009, 04:57:33 pm
I bought the #twatch to be a remote screen for my monitoring system.   Since I'm more familiar with perl than python, I hacked this together.   Horrible code, I know, it's functional and meets my goals.

Normally, it just pushes data to the screen, but if something goes critical, it'll turn on the backlight to draw attention.

Code: [Select]
#!/usr/bin/perl -w

use 5.005;
use strict;
use Getopt::Std;
use IO::Socket;
use Fcntl;

############################################################
# Configurable part. Set it according your setup.
############################################################

# Host which runs lcdproc daemon (LCDd)
my $SERVER = "192.168.11.116";

# Port on which LCDd listens to requests
my $PORT = "1337";
my $DEBUG = "0";

############################################################
# End of user configurable parts
############################################################

my $progname = $0;
   $progname =~ s#.*/(.*?)$#$1#;

# declare functions
sub error($@);
sub lineout($@);
sub debugmsg($@);

## main routine ##
my %opt = ();
my @BBOUT;
my $LCD = "";

debugmsg("Starting Process");
debugmsg("Opening Connection");
# Connect to the server...
my $remote = IO::Socket::INET->new(
		Proto     => 'tcp',
		PeerAddr  => $SERVER,
		PeerPort  => $PORT,
	)
	or  error(1, "cannot connect to LCDd daemon at $SERVER:$PORT");
debugmsg("Connection Complete");

# Make sure our messages get there right away
$remote->autoflush(1);

sleep (1);	# Give server plenty of time to notice us...

LCDOFF();
sleep(1);

while (1) {
	my $liner1 = "";
	debugmsg("Main loop...");

	my @liner = `/usr/lib/hobbit/server/bin/bb localhost "hobbitdboard fields=hostname,testname,color"`;
	my @BBYEL  = grep {/|yellow/} @liner;
	my @BBRED  = grep {/||red/} @liner;
	my @BBBLU  = grep {/|blue/} @liner;
	my @BBPUR  = grep {/|purple$/} @liner;
	debugmsg("Status: R: ",scalar(@BBRED)," Y: ",scalar(@BBYEL)," B: ",scalar(@BBBLU)," P: ",scalar(@BBPUR));
	if ( scalar(@BBRED) gt 0 ) {
		LCDON();
	} else { LCDOFF(); }
	lineout(1,5,"Hobbit Status ");
	$liner1="Red : ".scalar(@BBRED)." ";
	lineout(2, 2, $liner1);
	$liner1="Yel : ".scalar(@BBYEL)."  ";
	lineout(2, 12, $liner1);
	$liner1="Blu : ".scalar(@BBBLU)." ";
	lineout(3, 2, $liner1);
	$liner1="Pur : ".scalar(@BBPUR)." ";
	lineout(3, 12, $liner1);
	$liner1=`date +%D\ %H:%M`;
	chomp $liner1;
	lineout(4, 4, $liner1);
	# wait a bit
	debugmsg("Output Complete, sleeping");
	sleep(30);
}

close($remote)  or  error(1, "close() failed: $!");
exit;

sub lineout($@)
{
# Move to Pos 1,1
	my $lrow = $_[0];
	my $lcol = $_[1];
	my $lout = $_[2];
	##print "$lrow $lcol $loutn";
	debugmsg("Moving to ",$lrow,$lcol," printing : ",$lout);
	print $remote chr(0xFE),chr(0x47),chr(${lcol}),chr(${lrow});
	print $remote $lout;
}
## print out error message and eventually exit ##
# Synopsis:  error($status, $message)
sub error($@)
{
my $status = shift;
my @msg = @_;

  print STDERR $progname . ": " . join(" ", @msg) . "n";

  exit($status)  if ($status);
}

sub debugmsg($@) {
	if ( $DEBUG gt 0 ) {
	  my $BBDATE=`date`;
	  chomp $BBDATE;
	  print $BBDATE." ".join(" ", @_)."n";
	}
}

sub LCDON {
	if ( $LCD ne 0 ) {
	debugmsg("Turning LCD On");
	print $remote chr(0xFE),chr(0x42);
	print $remote chr(0xFE),chr(0x47),chr(0x01),chr(0x01);
	print $remote chr(0xFE),chr(0x58);
	$LCD = 0;
	sleep(1);
	}
}

sub LCDOFF {
	if ( $LCD ne 1 ) {
	debugmsg("Turning LCD Off");
	print $remote chr(0xFE),chr(0x46);
	print $remote chr(0xFE),chr(0x47),chr(0x01),chr(0x01);
	print $remote chr(0xFE),chr(0x58);
	$LCD = 1;
	sleep(1);
	}
}
Title: Re: Perl Script for Hobbit/Xymon Monitoring system
Post by: ian on November 12, 2009, 05:09:00 pm
Awesome! Thanks for sharing. May I please include it in the project SVN?
Title: Re: Perl Script for Hobbit/Xymon Monitoring system
Post by: noxin on November 12, 2009, 05:54:05 pm
Code: [Select]
#!/usr/bin/perl -w

use 5.005;
use strict;
use Getopt::Std;
use IO::Socket;
use Fcntl;

############################################################
# Configurable part. Set it according your setup.
############################################################

# Host which runs lcdproc daemon (LCDd)
my $SERVER = "192.168.11.116";

# Port on which LCDd listens to requests
my $PORT = "1337";
my $DEBUG = "0";

############################################################
# End of user configurable parts
############################################################

my $progname = $0;
   $progname =~ s#.*/(.*?)$#$1#;

# declare functions
sub error($@);
sub lineout($@);
sub debugmsg($@);

## main routine ##
my %opt = ();
my @BBOUT;
my $LCD = "";

debugmsg("Starting Process");
debugmsg("Opening Connection");
# Connect to the server...
my $remote = IO::Socket::INET->new(
      Proto     => 'tcp',
      PeerAddr  => $SERVER,
      PeerPort  => $PORT,
   )
   or  error(1, "cannot connect to LCDd daemon at $SERVER:$PORT");
debugmsg("Connection Complete");

# Make sure our messages get there right away
$remote->autoflush(1);

sleep (1);   # Give server plenty of time to notice us...

LCDOFF();
sleep(1);

while (1) {
   my $liner1 = "";
   debugmsg("Main loop...");

   my @liner = `/usr/lib/hobbit/server/bin/bb localhost "hobbitdboard fields=hostname,testname,ackmsg,color"`;
   my @BBYEL  = grep {/|yellow/} @liner;
   my @BBRED  = grep {/||red/} @liner;
   my @BBBLU  = grep {/|blue/} @liner;
   my @BBPUR  = grep {/|purple$/} @liner;
   debugmsg("Status: R: ",scalar(@BBRED)," Y: ",scalar(@BBYEL)," B: ",scalar(@BBBLU)," P: ",scalar(@BBPUR));
   if ( scalar(@BBRED) gt 0 ) {
      LCDON();
   } else { LCDOFF(); }
   lineout(1,5,"Hobbit Status ");
   $liner1="Red : ".scalar(@BBRED)." ";
   lineout(2, 2, $liner1);
   $liner1="Yel : ".scalar(@BBYEL)."  ";
   lineout(2, 12, $liner1);
   $liner1="Blu : ".scalar(@BBBLU)." ";
   lineout(3, 2, $liner1);
   $liner1="Pur : ".scalar(@BBPUR)." ";
   lineout(3, 12, $liner1);
   $liner1=`date +%D\ %H:%M`;
   chomp $liner1;
   lineout(4, 4, $liner1);
   # wait a bit
   debugmsg("Output Complete, sleeping");
   sleep(30);
}

close($remote)  or  error(1, "close() failed: $!");
exit;

sub lineout($@)
{
# Move to Pos 1,1
   my $lrow = $_[0];
   my $lcol = $_[1];
   my $lout = $_[2];
   ##print "$lrow $lcol $loutn";
   debugmsg("Moving to ",$lrow,$lcol," printing : ",$lout);
   print $remote chr(0xFE),chr(0x47),chr(${lcol}),chr(${lrow});
   print $remote $lout;
}
## print out error message and eventually exit ##
# Synopsis:  error($status, $message)
sub error($@)
{
my $status = shift;
my @msg = @_;

  print STDERR $progname . ": " . join(" ", @msg) . "n";

  exit($status)  if ($status);
}

sub debugmsg($@) {
   if ( $DEBUG gt 0 ) {
     my $BBDATE=`date`;
     chomp $BBDATE;
     print $BBDATE." ".join(" ", @_)."n";
   }
}

sub LCDON {
   if ( $LCD ne 0 ) {
   debugmsg("Turning LCD On");
   print $remote chr(0xFE),chr(0x42);
   print $remote chr(0xFE),chr(0x47),chr(0x01),chr(0x01);
   print $remote chr(0xFE),chr(0x58);
   $LCD = 0;
   sleep(1);
   }
}

sub LCDOFF {
   if ( $LCD ne 1 ) {
   debugmsg("Turning LCD Off");
   print $remote chr(0xFE),chr(0x46);
   print $remote chr(0xFE),chr(0x47),chr(0x01),chr(0x01);
   print $remote chr(0xFE),chr(0x58);
   $LCD = 1;
   sleep(1);
   }
}

You can include this one, there was a typo in the first and I can't seem to figure out how to edit it :)

--Patrick
Text only | Text with Images

( ! ) Fatal error: Uncaught exception 'Elk_Exception' with message 'Please try again. If you come back to this error screen, report the error to an administrator.' in /var/www/dangerousprototypes/forum/sources/database/Db-mysql.class.php on line 696
( ! ) Elk_Exception: Please try again. If you come back to this error screen, report the error to an administrator. in /var/www/dangerousprototypes/forum/sources/database/Db-mysql.class.php on line 696
Call Stack
#TimeMemoryFunctionLocation
10.00932067440session_write_close ( )...(null):0
20.00962199032ElkArte\sources\subs\SessionHandler\DatabaseHandler->write( )...(null):0
30.00962199808Database_MySQL->query( ).../DatabaseHandler.php:119
40.05422338536Database_MySQL->error( ).../Db-mysql.class.php:273