ZaneYork
/
zoneminder
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bug 233 - Converted to use common debug format 

git-svn-id: http://svn.zoneminder.com/svn/zm/trunk@1684 e3e1d417-86f3-4887-817a-d78f3d33393f
This commit is contained in:
stan 2005-12-16 12:17:10 +00:00
parent d8e0ce1f74
commit 88bd01167a
14 changed files with 238 additions and 362 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
scripts/zmaudit.pl
View File

@ -108,47 +108,6 @@ sub dbgInit
} }
} }
sub dbgPrint
{
my $code = shift;
my $string = shift;
my $line = shift;
$string =~ s/[\r\n]+$//g;
my ($seconds, $microseconds) = gettimeofday();
if ( $line )
{
my $file = __FILE__;
$file =~ s|^.*/||g;
printf( "%s.%06d %s[%d].%s-%s/%d [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $file, $line, $code, $string );
}
else
{
printf( "%s.%06d %s[%d].%s [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $code, $string );
}
}
sub Debug
{
dbgPrint( "DBG", $_[0] ) if ( DBG_LEVEL >= 1 );
}
sub Info
{
dbgPrint( "INF", $_[0] ) if ( DBG_LEVEL >= 0 );
}
sub Warning
{
dbgPrint( "WAR", $_[0] ) if ( DBG_LEVEL >= -1 );
}
sub Error
{
dbgPrint( "ERR", $_[0] ) if ( DBG_LEVEL >= -2 );
}
sub aud_print sub aud_print
{ {
my $string = shift; my $string = shift;

75
scripts/zmcontrol-axis-v2.pl
View File

@ -33,7 +33,7 @@ use strict;
# #
# ========================================================================== # ==========================================================================
# None use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
@ -101,7 +101,7 @@ open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
select( STDERR ); $| = 1; select( STDERR ); $| = 1;
select( LOG ); $| = 1; select( LOG ); $| = 1;
print( $arg_string."\n" ); Info( $arg_string."\n" );
srand( time() ); srand( time() );
@ -110,8 +110,7 @@ sub printMsg
my $msg = shift; my $msg = shift;
my $msg_len = length($msg); my $msg_len = length($msg);
print( $msg ); Info( $msg."[".$msg_len."]\n" );
print( "[".$msg_len."]\n" );
} }
sub sendCmd sub sendCmd
@ -136,7 +135,7 @@ sub sendCmd
} }
else else
{ {
print( "Error check failed: '".$res->status_line()."'\n" ); Error( "Error check failed: '".$res->status_line()."'\n" );
} }
return( $result ); return( $result );
@ -144,63 +143,63 @@ sub sendCmd
sub cameraReset sub cameraReset
{ {
print( "Camera Reset\n" ); Info( "Camera Reset\n" );
my $cmd = "nphRestart?PAGE=Restart&Restart=OK"; my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveUp sub moveUp
{ {
print( "Move Up\n" ); Info( "Move Up\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=up"; my $cmd = "/axis-cgi/com/ptz.cgi?move=up";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveDown sub moveDown
{ {
print( "Move Down\n" ); Info( "Move Down\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=down"; my $cmd = "/axis-cgi/com/ptz.cgi?move=down";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveLeft sub moveLeft
{ {
print( "Move Left\n" ); Info( "Move Left\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=left"; my $cmd = "/axis-cgi/com/ptz.cgi?move=left";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveRight sub moveRight
{ {
print( "Move Right\n" ); Info( "Move Right\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=right"; my $cmd = "/axis-cgi/com/ptz.cgi?move=right";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveUpRight sub moveUpRight
{ {
print( "Move Up/Right\n" ); Info( "Move Up/Right\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=upright"; my $cmd = "/axis-cgi/com/ptz.cgi?move=upright";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveUpLeft sub moveUpLeft
{ {
print( "Move Up/Left\n" ); Info( "Move Up/Left\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=upleft"; my $cmd = "/axis-cgi/com/ptz.cgi?move=upleft";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveDownRight sub moveDownRight
{ {
print( "Move Down/Right\n" ); Info( "Move Down/Right\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=downright"; my $cmd = "/axis-cgi/com/ptz.cgi?move=downright";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveDownLeft sub moveDownLeft
{ {
print( "Move Down/Left\n" ); Info( "Move Down/Left\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=downleft"; my $cmd = "/axis-cgi/com/ptz.cgi?move=downleft";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -208,7 +207,7 @@ sub moveDownLeft
sub moveMap sub moveMap
{ {
my ( $xcoord, $ycoord, $width, $height ) = @_; my ( $xcoord, $ycoord, $width, $height ) = @_;
print( "Move Map to $xcoord,$ycoord\n" ); Info( "Move Map to $xcoord,$ycoord\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?center=$xcoord,$ycoord&imagewidth=$width&imageheight=$height"; my $cmd = "/axis-cgi/com/ptz.cgi?center=$xcoord,$ycoord&imagewidth=$width&imageheight=$height";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -216,7 +215,7 @@ sub moveMap
sub stepUp sub stepUp
{ {
my $step = shift; my $step = shift;
print( "Step Up $step\n" ); Info( "Step Up $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -224,7 +223,7 @@ sub stepUp
sub stepDown sub stepDown
{ {
my $step = shift; my $step = shift;
print( "Step Down $step\n" ); Info( "Step Down $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=-$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=-$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -232,7 +231,7 @@ sub stepDown
sub stepLeft sub stepLeft
{ {
my $step = shift; my $step = shift;
print( "Step Left $step\n" ); Info( "Step Left $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -240,7 +239,7 @@ sub stepLeft
sub stepRight sub stepRight
{ {
my $step = shift; my $step = shift;
print( "Step Right $step\n" ); Info( "Step Right $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -249,7 +248,7 @@ sub stepUpRight
{ {
my $panstep = shift; my $panstep = shift;
my $tiltstep = shift; my $tiltstep = shift;
print( "Step Up/Right $tiltstep/$panstep\n" ); Info( "Step Up/Right $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=$tiltstep"; my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=$tiltstep";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -258,7 +257,7 @@ sub stepUpLeft
{ {
my $panstep = shift; my $panstep = shift;
my $tiltstep = shift; my $tiltstep = shift;
print( "Step Up/Left $tiltstep/$panstep\n" ); Info( "Step Up/Left $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=$tiltstep"; my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=$tiltstep";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -267,7 +266,7 @@ sub stepDownRight
{ {
my $panstep = shift; my $panstep = shift;
my $tiltstep = shift; my $tiltstep = shift;
print( "Step Down/Right $tiltstep/$panstep\n" ); Info( "Step Down/Right $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=-$tiltstep"; my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=-$tiltstep";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -276,7 +275,7 @@ sub stepDownLeft
{ {
my $panstep = shift; my $panstep = shift;
my $tiltstep = shift; my $tiltstep = shift;
print( "Step Down/Left $tiltstep/$panstep\n" ); Info( "Step Down/Left $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=-$tiltstep"; my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=-$tiltstep";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -284,7 +283,7 @@ sub stepDownLeft
sub zoomTele sub zoomTele
{ {
my $step = shift; my $step = shift;
print( "Zoom Tele\n" ); Info( "Zoom Tele\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -292,7 +291,7 @@ sub zoomTele
sub zoomWide sub zoomWide
{ {
my $step = shift; my $step = shift;
print( "Zoom Wide\n" ); Info( "Zoom Wide\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=-$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=-$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -300,7 +299,7 @@ sub zoomWide
sub focusNear sub focusNear
{ {
my $step = shift; my $step = shift;
print( "Focus Near\n" ); Info( "Focus Near\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=-$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=-$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -308,21 +307,21 @@ sub focusNear
sub focusFar sub focusFar
{ {
my $step = shift; my $step = shift;
print( "Focus Far\n" ); Info( "Focus Far\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=$step"; my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub focusAuto sub focusAuto
{ {
print( "Focus Auto\n" ); Info( "Focus Auto\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=on"; my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=on";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub focusMan sub focusMan
{ {
print( "Focus Manual\n" ); Info( "Focus Manual\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off"; my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -330,7 +329,7 @@ sub focusMan
sub irisOpen sub irisOpen
{ {
my $step = shift; my $step = shift;
print( "Iris Open\n" ); Info( "Iris Open\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?riris=$step"; my $cmd = "/axis-cgi/com/ptz.cgi?riris=$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -338,21 +337,21 @@ sub irisOpen
sub irisClose sub irisClose
{ {
my $step = shift; my $step = shift;
print( "Iris Close\n" ); Info( "Iris Close\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?riris=-$step"; my $cmd = "/axis-cgi/com/ptz.cgi?riris=-$step";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub irisAuto sub irisAuto
{ {
print( "Iris Auto\n" ); Info( "Iris Auto\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=on"; my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=on";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub irisMan sub irisMan
{ {
print( "Iris Manual\n" ); Info( "Iris Manual\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=off"; my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=off";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -360,7 +359,7 @@ sub irisMan
sub presetClear sub presetClear
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Clear Preset $preset\n" ); Info( "Clear Preset $preset\n" );
my $cmd = "nphPresetNameCheck?Data=$preset"; my $cmd = "nphPresetNameCheck?Data=$preset";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -368,7 +367,7 @@ sub presetClear
sub presetSet sub presetSet
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Set Preset $preset\n" ); Info( "Set Preset $preset\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset"; my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -376,14 +375,14 @@ sub presetSet
sub presetGoto sub presetGoto
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Goto Preset $preset\n" ); Info( "Goto Preset $preset\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?gotoserverpresetno=$preset"; my $cmd = "/axis-cgi/com/ptz.cgi?gotoserverpresetno=$preset";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub presetHome sub presetHome
{ {
print( "Home Preset\n" ); Info( "Home Preset\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=home"; my $cmd = "/axis-cgi/com/ptz.cgi?move=home";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -510,5 +509,5 @@ elsif ( $command eq "preset_goto" )
} }
else else
{ {
print( "Error, can't handle command $command\n" ); Error( "Can't handle command $command\n" );
} }

41
scripts/zmcontrol-kx-hcm10.pl
View File

@ -33,7 +33,7 @@ use strict;
# #
# ========================================================================== # ==========================================================================
# None use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
@ -101,7 +101,7 @@ open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
select( STDERR ); $| = 1; select( STDERR ); $| = 1;
select( LOG ); $| = 1; select( LOG ); $| = 1;
print( $arg_string."\n" ); Info( $arg_string."\n" );
srand( time() ); srand( time() );
@ -110,8 +110,7 @@ sub printMsg
my $msg = shift; my $msg = shift;
my $msg_len = length($msg); my $msg_len = length($msg);
print( $msg ); Info( $msg."[".$msg_len."]\n" );
print( "[".$msg_len."]\n" );
} }
sub sendCmd sub sendCmd
@ -136,7 +135,7 @@ sub sendCmd
} }
else else
{ {
print( "Error check failed: '".$res->status_line()."'\n" ); Error( "Error check failed: '".$res->status_line()."'\n" );
} }
return( $result ); return( $result );
@ -144,35 +143,35 @@ sub sendCmd
sub cameraReset sub cameraReset
{ {
print( "Camera Reset\n" ); Info( "Camera Reset\n" );
my $cmd = "nphRestart?PAGE=Restart&Restart=OK"; my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveUp sub moveUp
{ {
print( "Move Up\n" ); Info( "Move Up\n" );
my $cmd = "nphControlCamera?Direction=TiltUp"; my $cmd = "nphControlCamera?Direction=TiltUp";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveDown sub moveDown
{ {
print( "Move Down\n" ); Info( "Move Down\n" );
my $cmd = "nphControlCamera?Direction=TiltDown"; my $cmd = "nphControlCamera?Direction=TiltDown";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveLeft sub moveLeft
{ {
print( "Move Left\n" ); Info( "Move Left\n" );
my $cmd = "nphControlCamera?Direction=PanLeft"; my $cmd = "nphControlCamera?Direction=PanLeft";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub moveRight sub moveRight
{ {
print( "Move Right\n" ); Info( "Move Right\n" );
my $cmd = "nphControlCamera?Direction=PanRight"; my $cmd = "nphControlCamera?Direction=PanRight";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -180,42 +179,42 @@ sub moveRight
sub moveMap sub moveMap
{ {
my ( $xcoord, $ycoord, $width, $height ) = @_; my ( $xcoord, $ycoord, $width, $height ) = @_;
print( "Move Map to $xcoord,$ycoord\n" ); Info( "Move Map to $xcoord,$ycoord\n" );
my $cmd = "nphControlCamera?Direction=Direct&NewPosition.x=$xcoord&NewPosition.y=$ycoord&Width=$width&Height=$height"; my $cmd = "nphControlCamera?Direction=Direct&NewPosition.x=$xcoord&NewPosition.y=$ycoord&Width=$width&Height=$height";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub zoomTele sub zoomTele
{ {
print( "Zoom Tele\n" ); Info( "Zoom Tele\n" );
my $cmd = "nphControlCamera?Direction=ZoomTele"; my $cmd = "nphControlCamera?Direction=ZoomTele";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub zoomWide sub zoomWide
{ {
print( "Zoom Wide\n" ); Info( "Zoom Wide\n" );
my $cmd = "nphControlCamera?Direction=ZoomWide"; my $cmd = "nphControlCamera?Direction=ZoomWide";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub focusNear sub focusNear
{ {
print( "Focus Near\n" ); Info( "Focus Near\n" );
my $cmd = "nphControlCamera?Direction=FocusNear"; my $cmd = "nphControlCamera?Direction=FocusNear";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub focusFar sub focusFar
{ {
print( "Focus Far\n" ); Info( "Focus Far\n" );
my $cmd = "nphControlCamera?Direction=FocusFar"; my $cmd = "nphControlCamera?Direction=FocusFar";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub focusAuto sub focusAuto
{ {
print( "Focus Auto\n" ); Info( "Focus Auto\n" );
my $cmd = "nphControlCamera?Direction=FocusAuto"; my $cmd = "nphControlCamera?Direction=FocusAuto";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -223,7 +222,7 @@ sub focusAuto
sub presetClear sub presetClear
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Clear Preset $preset\n" ); Info( "Clear Preset $preset\n" );
my $cmd = "nphPresetNameCheck?Data=$preset"; my $cmd = "nphPresetNameCheck?Data=$preset";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -231,7 +230,7 @@ sub presetClear
sub presetSet sub presetSet
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Set Preset $preset\n" ); Info( "Set Preset $preset\n" );
my $cmd = "nphPresetNameCheck?PresetName=$preset&Data=$preset"; my $cmd = "nphPresetNameCheck?PresetName=$preset&Data=$preset";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -239,14 +238,14 @@ sub presetSet
sub presetGoto sub presetGoto
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Goto Preset $preset\n" ); Info( "Goto Preset $preset\n" );
my $cmd = "nphControlCamera?Direction=Preset&PresetOperation=Move&Data=$preset"; my $cmd = "nphControlCamera?Direction=Preset&PresetOperation=Move&Data=$preset";
sendCmd( $cmd ); sendCmd( $cmd );
} }
sub presetHome sub presetHome
{ {
print( "Home Preset\n" ); Info( "Home Preset\n" );
my $cmd = "nphControlCamera?Direction=HomePosition"; my $cmd = "nphControlCamera?Direction=HomePosition";
sendCmd( $cmd ); sendCmd( $cmd );
} }
@ -309,5 +308,5 @@ elsif ( $command eq "preset_goto" )
} }
else else
{ {
print( "Error, can't handle command $command\n" ); Error( "Can't handle command $command\n" );
} }

95
scripts/zmcontrol-pelco-d.pl
View File

@ -33,7 +33,7 @@ use strict;
# #
# ========================================================================== # ==========================================================================
# None use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
@ -104,7 +104,7 @@ open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
select( STDERR ); $| = 1; select( STDERR ); $| = 1;
select( LOG ); $| = 1; select( LOG ); $| = 1;
print( $arg_string."\n" ); Info( $arg_string."\n" );
srand( time() ); srand( time() );
@ -127,16 +127,17 @@ sub printMsg
my $line_length = 16; my $line_length = 16;
my $msg_len = int(@$msg); my $msg_len = int(@$msg);
print( $prefix ); my $msg_str = $prefix;
for ( my $i = 0; $i < $msg_len; $i++ ) for ( my $i = 0; $i < $msg_len; $i++ )
{ {
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) ) if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
{ {
printf( "\n%*s", length($prefix), "" ); $msg_str .= sprintf( "\n%*s", length($prefix), "" );
} }
printf( "%02x ", $msg->[$i] ); $msg_str .= sprintf( "%02x ", $msg->[$i] );
} }
print( "[".$msg_len."]\n" ); $msg_str .= "[".$msg_len."]\n";
Info( $msg_str );
} }
sub sendCmd sub sendCmd
@ -163,16 +164,16 @@ sub sendCmd
my $n_bytes = $serial_port->write( $tx_msg ); my $n_bytes = $serial_port->write( $tx_msg );
if ( !$n_bytes ) if ( !$n_bytes )
{ {
print( "Error, write failed: $!" ); Error( "Write failed: $!" );
} }
if ( $n_bytes != length($tx_msg) ) if ( $n_bytes != length($tx_msg) )
{ {
print( "Error, incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" ); Error( "Incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
} }
if ( $ack ) if ( $ack )
{ {
print( "Waiting for ack\n" ); Info( "Waiting for ack\n" );
my $max_wait = 3; my $max_wait = 3;
my $now = time(); my $now = time();
while( 1 ) while( 1 )
@ -190,23 +191,23 @@ sub sendCmd
if ( ($resp[1] & 0xf0) == 0x40 ) if ( ($resp[1] & 0xf0) == 0x40 )
{ {
my $socket = $resp[1] & 0x0f; my $socket = $resp[1] & 0x0f;
print( "Got ack for socket $socket\n" ); Info( "Got ack for socket $socket\n" );
$result = !undef; $result = !undef;
} }
else else
{ {
print( "Error, got bogus response\n" ); Error( "Got bogus response\n" );
} }
last; last;
} }
else else
{ {
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" ); Error( "Got message for camera ".(($resp[0]-0x80)>>4)."\n" );
} }
} }
if ( (time() - $now) > $max_wait ) if ( (time() - $now) > $max_wait )
{ {
print( "Warning, response timeout\n" ); Warning( "Response timeout\n" );
last; last;
} }
} }
@ -217,49 +218,49 @@ my $sync = 0xff;
sub remoteReset sub remoteReset
{ {
print( "Remote Reset\n" ); Info( "Remote Reset\n" );
my @msg = ( $sync, $address, 0x00, 0x0f, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x00, 0x0f, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub cameraOff sub cameraOff
{ {
print( "Camera Off\n" ); Info( "Camera Off\n" );
my @msg = ( $sync, $address, 0x08, 0x00, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x08, 0x00, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub cameraOn sub cameraOn
{ {
print( "Camera On\n" ); Info( "Camera On\n" );
my @msg = ( $sync, $address, 0x88, 0x00, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x88, 0x00, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub autoScan sub autoScan
{ {
print( "Auto Scan\n" ); Info( "Auto Scan\n" );
my @msg = ( $sync, $address, 0x90, 0x00, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x90, 0x00, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub manScan sub manScan
{ {
print( "Manual Scan\n" ); Info( "Manual Scan\n" );
my @msg = ( $sync, $address, 0x10, 0x00, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x10, 0x00, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub stop sub stop
{ {
print( "Stop\n" ); Info( "Stop\n" );
my @msg = ( $sync, $address, 0x00, 0x00, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x00, 0x00, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub moveUp sub moveUp
{ {
print( "Move Up\n" ); Info( "Move Up\n" );
my $speed = shift || 0x3f; my $speed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x08, 0x00, $speed ); my @msg = ( $sync, $address, 0x00, 0x08, 0x00, $speed );
sendCmd( \@msg ); sendCmd( \@msg );
@ -272,7 +273,7 @@ sub moveUp
sub moveDown sub moveDown
{ {
print( "Move Down\n" ); Info( "Move Down\n" );
my $speed = shift || 0x3f; my $speed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x10, 0x00, $speed ); my @msg = ( $sync, $address, 0x00, 0x10, 0x00, $speed );
sendCmd( \@msg ); sendCmd( \@msg );
@ -285,7 +286,7 @@ sub moveDown
sub moveLeft sub moveLeft
{ {
print( "Move Left\n" ); Info( "Move Left\n" );
my $speed = shift || 0x3f; my $speed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x04, $speed, 0x00 ); my @msg = ( $sync, $address, 0x00, 0x04, $speed, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
@ -298,7 +299,7 @@ sub moveLeft
sub moveRight sub moveRight
{ {
print( "Move Right\n" ); Info( "Move Right\n" );
my $speed = shift || 0x3f; my $speed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x02, $speed, 0x00 ); my @msg = ( $sync, $address, 0x00, 0x02, $speed, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
@ -311,7 +312,7 @@ sub moveRight
sub moveUpLeft sub moveUpLeft
{ {
print( "Move Up/Left\n" ); Info( "Move Up/Left\n" );
my $panspeed = shift || 0x3f; my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f; my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x0c, $panspeed, $tiltspeed ); my @msg = ( $sync, $address, 0x00, 0x0c, $panspeed, $tiltspeed );
@ -325,7 +326,7 @@ sub moveUpLeft
sub moveUpRight sub moveUpRight
{ {
print( "Move Up/Right\n" ); Info( "Move Up/Right\n" );
my $panspeed = shift || 0x3f; my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f; my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x0a, $panspeed, $tiltspeed ); my @msg = ( $sync, $address, 0x00, 0x0a, $panspeed, $tiltspeed );
@ -339,7 +340,7 @@ sub moveUpRight
sub moveDownLeft sub moveDownLeft
{ {
print( "Move Down/Left\n" ); Info( "Move Down/Left\n" );
my $panspeed = shift || 0x3f; my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f; my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x14, $panspeed, $tiltspeed ); my @msg = ( $sync, $address, 0x00, 0x14, $panspeed, $tiltspeed );
@ -353,7 +354,7 @@ sub moveDownLeft
sub moveDownRight sub moveDownRight
{ {
print( "Move Down/Right\n" ); Info( "Move Down/Right\n" );
my $panspeed = shift || 0x3f; my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f; my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x12, $panspeed, $tiltspeed ); my @msg = ( $sync, $address, 0x00, 0x12, $panspeed, $tiltspeed );
@ -367,14 +368,14 @@ sub moveDownRight
sub flip180 sub flip180
{ {
print( "Flip 180\n" ); Info( "Flip 180\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x21 ); my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x21 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub zeroPan sub zeroPan
{ {
print( "Zero Pan\n" ); Info( "Zero Pan\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 ); my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -388,7 +389,7 @@ sub setZoomSpeed
sub zoomTele sub zoomTele
{ {
print( "Zoom Tele\n" ); Info( "Zoom Tele\n" );
my $speed = shift || 0x01; my $speed = shift || 0x01;
setZoomSpeed( $speed ); setZoomSpeed( $speed );
usleep( 250000 ); usleep( 250000 );
@ -403,7 +404,7 @@ sub zoomTele
sub zoomWide sub zoomWide
{ {
print( "Zoom Wide\n" ); Info( "Zoom Wide\n" );
my $speed = shift || 0x01; my $speed = shift || 0x01;
setZoomSpeed( $speed ); setZoomSpeed( $speed );
usleep( 250000 ); usleep( 250000 );
@ -425,7 +426,7 @@ sub setFocusSpeed
sub focusNear sub focusNear
{ {
print( "Focus Near\n" ); Info( "Focus Near\n" );
my $speed = shift || 0x03; my $speed = shift || 0x03;
setFocusSpeed( $speed ); setFocusSpeed( $speed );
usleep( 250000 ); usleep( 250000 );
@ -440,7 +441,7 @@ sub focusNear
sub focusFar sub focusFar
{ {
print( "Focus Far\n" ); Info( "Focus Far\n" );
my $speed = shift || 0x03; my $speed = shift || 0x03;
setFocusSpeed( $speed ); setFocusSpeed( $speed );
usleep( 250000 ); usleep( 250000 );
@ -455,21 +456,21 @@ sub focusFar
sub focusAuto sub focusAuto
{ {
print( "Focus Auto\n" ); Info( "Focus Auto\n" );
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub focusMan sub focusMan
{ {
print( "Focus Man\n" ); Info( "Focus Man\n" );
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x02 ); my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x02 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub irisClose sub irisClose
{ {
print( "Iris Close\n" ); Info( "Iris Close\n" );
my @msg = ( $sync, $address, 0x04, 0x00, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x04, 0x00, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
if ( $autostop ) if ( $autostop )
@ -481,7 +482,7 @@ sub irisClose
sub irisOpen sub irisOpen
{ {
print( "Iris Open\n" ); Info( "Iris Open\n" );
my @msg = ( $sync, $address, 0x02, 0x80, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x02, 0x80, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
if ( $autostop ) if ( $autostop )
@ -493,14 +494,14 @@ sub irisOpen
sub irisAuto sub irisAuto
{ {
print( "Iris Auto\n" ); Info( "Iris Auto\n" );
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub irisMan sub irisMan
{ {
print( "Iris Man\n" ); Info( "Iris Man\n" );
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x02 ); my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x02 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -508,12 +509,12 @@ sub irisMan
sub writeScreen sub writeScreen
{ {
my $string = shift; my $string = shift;
print( "Writing '$string' to screen\n" ); Info( "Writing '$string' to screen\n" );
my @chars = unpack( "C*", $string ); my @chars = unpack( "C*", $string );
for ( my $i = 0; $i < length($string); $i++ ) for ( my $i = 0; $i < length($string); $i++ )
{ {
printf( "0x%02x\n", $chars[$i] ); #printf( "0x%02x\n", $chars[$i] );
my @msg = ( $sync, $address, 0x00, 0x15, $i, $chars[$i] ); my @msg = ( $sync, $address, 0x00, 0x15, $i, $chars[$i] );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -521,7 +522,7 @@ sub writeScreen
sub clearScreen sub clearScreen
{ {
print( "Clear Screen\n" ); Info( "Clear Screen\n" );
my @msg = ( $sync, $address, 0x00, 0x17, 0x00, 0x00 ); my @msg = ( $sync, $address, 0x00, 0x17, 0x00, 0x00 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -529,7 +530,7 @@ sub clearScreen
sub clearPreset sub clearPreset
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Clear Preset $preset\n" ); Info( "Clear Preset $preset\n" );
my @msg = ( $sync, $address, 0x00, 0x05, 0x00, $preset ); my @msg = ( $sync, $address, 0x00, 0x05, 0x00, $preset );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -537,7 +538,7 @@ sub clearPreset
sub presetSet sub presetSet
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Set Preset $preset\n" ); Info( "Set Preset $preset\n" );
my @msg = ( $sync, $address, 0x00, 0x03, 0x00, $preset ); my @msg = ( $sync, $address, 0x00, 0x03, 0x00, $preset );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -545,14 +546,14 @@ sub presetSet
sub presetGoto sub presetGoto
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Goto Preset $preset\n" ); Info( "Goto Preset $preset\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, $preset ); my @msg = ( $sync, $address, 0x00, 0x07, 0x00, $preset );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub presetHome sub presetHome
{ {
print( "Home Preset\n" ); Info( "Home Preset\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 ); my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -672,7 +673,7 @@ elsif ( $command eq "preset_goto" )
} }
else else
{ {
print( "Error, can't handle command $command\n" ); Error( "Can't handle command $command\n" );
} }
$serial_port->close(); $serial_port->close();

96
scripts/zmcontrol-visca.pl
View File

@ -33,7 +33,7 @@ use strict;
# #
# ========================================================================== # ==========================================================================
# None use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
@ -95,7 +95,7 @@ open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
select( STDERR ); $| = 1; select( STDERR ); $| = 1;
select( LOG ); $| = 1; select( LOG ); $| = 1;
print( $arg_string."\n" ); Info( $arg_string."\n" );
srand( time() ); srand( time() );
@ -119,16 +119,16 @@ sub printMsg
my $line_length = 16; my $line_length = 16;
my $msg_len = int(@$msg); my $msg_len = int(@$msg);
print( $prefix ); my $msg_str = $prefix;
for ( my $i = 0; $i < $msg_len; $i++ ) for ( my $i = 0; $i < $msg_len; $i++ )
{ {
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) ) if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
{ {
printf( "\n%*s", length($prefix), "" ); $msg_str .= sprintf( "\n%*s", length($prefix), "" );
} }
printf( "%02x ", $msg->[$i] ); $msg_str .= sprintf( "%02x ", $msg->[$i] );
} }
print( "[".$msg_len."]\n" ); $msg_str .= "[".$msg_len."]\n";
} }
sub sendCmd sub sendCmd
@ -148,16 +148,16 @@ sub sendCmd
my $n_bytes = $serial_port->write( $tx_msg ); my $n_bytes = $serial_port->write( $tx_msg );
if ( !$n_bytes ) if ( !$n_bytes )
{ {
print( "Error, write failed: $!" ); Error( "Write failed: $!" );
} }
if ( $n_bytes != length($tx_msg) ) if ( $n_bytes != length($tx_msg) )
{ {
print( "Error, incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" ); Error( "Incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
} }
if ( $ack ) if ( $ack )
{ {
print( "Waiting for ack\n" ); Info( "Waiting for ack\n" );
my $max_wait = 3; my $max_wait = 3;
my $now = time(); my $now = time();
while( 1 ) while( 1 )
@ -175,18 +175,18 @@ sub sendCmd
if ( ($resp[1] & 0xf0) == 0x40 ) if ( ($resp[1] & 0xf0) == 0x40 )
{ {
my $socket = $resp[1] & 0x0f; my $socket = $resp[1] & 0x0f;
print( "Got ack for socket $socket\n" ); Info( "Got ack for socket $socket\n" );
$result = !undef; $result = !undef;
} }
else else
{ {
printf( "Error, got bogus response\n" ); Error( "Got bogus response\n" );
} }
last; last;
} }
else else
{ {
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" ); Error( "Got message for camera ".(($resp[0]-0x80)>>4)."\n" );
} }
} }
if ( (time() - $now) > $max_wait ) if ( (time() - $now) > $max_wait )
@ -198,7 +198,7 @@ sub sendCmd
if ( $cmp ) if ( $cmp )
{ {
print( "Waiting for command complete\n" ); Info( "Waiting for command complete\n" );
my $max_wait = 10; my $max_wait = 10;
my $now = time(); my $now = time();
while( 1 ) while( 1 )
@ -216,18 +216,18 @@ sub sendCmd
{ {
if ( ($resp[1] & 0xf0) == 0x50 ) if ( ($resp[1] & 0xf0) == 0x50 )
{ {
printf( "Got command complete\n" ); Info( "Got command complete\n" );
$result = !undef; $result = !undef;
} }
else else
{ {
printf( "Error, got bogus response\n" ); Error( "Got bogus response\n" );
} }
last; last;
} }
else else
{ {
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" ); Error( "Got message for camera ".(($resp[0]-0x80)>>4)."\n" );
} }
} }
if ( (time() - $now) > $max_wait ) if ( (time() - $now) > $max_wait )
@ -243,28 +243,28 @@ my $sync = 0xff;
sub cameraOff sub cameraOff
{ {
print( "Camera Off\n" ); Info( "Camera Off\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x03, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x03, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub cameraOn sub cameraOn
{ {
print( "Camera On\n" ); Info( "Camera On\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x02, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x02, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub stop sub stop
{ {
print( "Stop\n" ); Info( "Stop\n" );
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, 0x00, 0x03, 0x03, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, 0x00, 0x03, 0x03, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub moveUp sub moveUp
{ {
print( "Move Up\n" ); Info( "Move Up\n" );
my $speed = shift || 0x40; my $speed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x01, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x01, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
@ -272,7 +272,7 @@ sub moveUp
sub moveDown sub moveDown
{ {
print( "Move Down\n" ); Info( "Move Down\n" );
my $speed = shift || 0x40; my $speed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x02, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x02, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
@ -280,7 +280,7 @@ sub moveDown
sub moveLeft sub moveLeft
{ {
print( "Move Left\n" ); Info( "Move Left\n" );
my $speed = shift || 0x40; my $speed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x01, 0x03, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x01, 0x03, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
@ -288,7 +288,7 @@ sub moveLeft
sub moveRight sub moveRight
{ {
print( "Move Right\n" ); Info( "Move Right\n" );
my $speed = shift || 0x40; my $speed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x02, 0x03, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x02, 0x03, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
@ -296,7 +296,7 @@ sub moveRight
sub moveUpLeft sub moveUpLeft
{ {
print( "Move Up/Left\n" ); Info( "Move Up/Left\n" );
my $panspeed = shift || 0x40; my $panspeed = shift || 0x40;
my $tiltspeed = shift || 0x40; my $tiltspeed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x01, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x01, $sync );
@ -305,7 +305,7 @@ sub moveUpLeft
sub moveUpRight sub moveUpRight
{ {
print( "Move Up/Right\n" ); Info( "Move Up/Right\n" );
my $panspeed = shift || 0x40; my $panspeed = shift || 0x40;
my $tiltspeed = shift || 0x40; my $tiltspeed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x01, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x01, $sync );
@ -314,7 +314,7 @@ sub moveUpRight
sub moveDownLeft sub moveDownLeft
{ {
print( "Move Down/Left\n" ); Info( "Move Down/Left\n" );
my $panspeed = shift || 0x40; my $panspeed = shift || 0x40;
my $tiltspeed = shift || 0x40; my $tiltspeed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x02, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x02, $sync );
@ -323,7 +323,7 @@ sub moveDownLeft
sub moveDownRight sub moveDownRight
{ {
print( "Move Down/Right\n" ); Info( "Move Down/Right\n" );
my $panspeed = shift || 0x40; my $panspeed = shift || 0x40;
my $tiltspeed = shift || 0x40; my $tiltspeed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x02, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x02, $sync );
@ -332,7 +332,7 @@ sub moveDownRight
sub stepUp sub stepUp
{ {
print( "Step Up\n" ); Info( "Step Up\n" );
my $step = shift; my $step = shift;
my $speed = shift || 0x40; my $speed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, $sync );
@ -342,7 +342,7 @@ sub stepUp
sub stepDown sub stepDown
{ {
print( "Step Down\n" ); Info( "Step Down\n" );
my $step = shift; my $step = shift;
$step = -$step; $step = -$step;
my $speed = shift || 0x40; my $speed = shift || 0x40;
@ -352,7 +352,7 @@ sub stepDown
sub stepLeft sub stepLeft
{ {
print( "Step Left\n" ); Info( "Step Left\n" );
my $step = shift; my $step = shift;
$step = -$step; $step = -$step;
my $speed = shift || 0x40; my $speed = shift || 0x40;
@ -362,7 +362,7 @@ sub stepLeft
sub stepRight sub stepRight
{ {
print( "Step Right\n" ); Info( "Step Right\n" );
my $step = shift; my $step = shift;
my $speed = shift || 0x40; my $speed = shift || 0x40;
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, $sync );
@ -371,7 +371,7 @@ sub stepRight
sub stepUpLeft sub stepUpLeft
{ {
print( "Step Up/Left\n" ); Info( "Step Up/Left\n" );
my $panstep = shift; my $panstep = shift;
$panstep = -$panstep; $panstep = -$panstep;
my $tiltstep = shift; my $tiltstep = shift;
@ -383,7 +383,7 @@ sub stepUpLeft
sub stepUpRight sub stepUpRight
{ {
print( "Step Up/Right\n" ); Info( "Step Up/Right\n" );
my $panstep = shift; my $panstep = shift;
my $tiltstep = shift; my $tiltstep = shift;
my $panspeed = shift || 0x40; my $panspeed = shift || 0x40;
@ -394,7 +394,7 @@ sub stepUpRight
sub stepDownLeft sub stepDownLeft
{ {
print( "Step Down/Left\n" ); Info( "Step Down/Left\n" );
my $panstep = shift; my $panstep = shift;
$panstep = -$panstep; $panstep = -$panstep;
my $tiltstep = shift; my $tiltstep = shift;
@ -407,7 +407,7 @@ sub stepDownLeft
sub stepDownRight sub stepDownRight
{ {
print( "Step Down/Right\n" ); Info( "Step Down/Right\n" );
my $panstep = shift; my $panstep = shift;
my $tiltstep = shift; my $tiltstep = shift;
$tiltstep = -$tiltstep; $tiltstep = -$tiltstep;
@ -419,7 +419,7 @@ sub stepDownRight
sub zoomTele sub zoomTele
{ {
print( "Zoom Tele\n" ); Info( "Zoom Tele\n" );
my $speed = shift || 0x06; my $speed = shift || 0x06;
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x20|$speed, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x20|$speed, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
@ -427,7 +427,7 @@ sub zoomTele
sub zoomWide sub zoomWide
{ {
print( "Zoom Wide\n" ); Info( "Zoom Wide\n" );
my $speed = shift || 0x06; my $speed = shift || 0x06;
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x30|$speed, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x30|$speed, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
@ -435,7 +435,7 @@ sub zoomWide
sub zoomStop sub zoomStop
{ {
print( "Zoom Stop\n" ); Info( "Zoom Stop\n" );
my $speed = shift || 0x06; my $speed = shift || 0x06;
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x00, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x00, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
@ -443,35 +443,35 @@ sub zoomStop
sub focusNear sub focusNear
{ {
print( "Focus Near\n" ); Info( "Focus Near\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x03, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x03, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub focusFar sub focusFar
{ {
print( "Focus Far\n" ); Info( "Focus Far\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x02, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x02, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub focusStop sub focusStop
{ {
print( "Focus Far\n" ); Info( "Focus Far\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x00, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x00, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub focusAuto sub focusAuto
{ {
print( "Focus Auto\n" ); Info( "Focus Auto\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x02, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x02, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub focusMan sub focusMan
{ {
print( "Focus Man\n" ); Info( "Focus Man\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x03, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x03, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -479,7 +479,7 @@ sub focusMan
sub presetClear sub presetClear
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Clear Preset $preset\n" ); Info( "Clear Preset $preset\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x00, $preset, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x00, $preset, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -487,7 +487,7 @@ sub presetClear
sub presetSet sub presetSet
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Set Preset $preset\n" ); Info( "Set Preset $preset\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x01, $preset, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x01, $preset, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -495,14 +495,14 @@ sub presetSet
sub presetGoto sub presetGoto
{ {
my $preset = shift || 1; my $preset = shift || 1;
print( "Goto Preset $preset\n" ); Info( "Goto Preset $preset\n" );
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x02, $preset, $sync ); my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x02, $preset, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
sub presetHome sub presetHome
{ {
print( "Home Preset\n" ); Info( "Home Preset\n" );
my @msg = ( 0x80|$address, 0x01, 0x06, 0x04, $sync ); my @msg = ( 0x80|$address, 0x01, 0x06, 0x04, $sync );
sendCmd( \@msg ); sendCmd( \@msg );
} }
@ -621,7 +621,7 @@ elsif ( $command eq "preset_goto" )
} }
else else
{ {
print( "Error, can't handle command $command\n" ); Error( "Can't handle command $command\n" );
} }
$serial_port->close(); $serial_port->close();

8
scripts/zmdc.pl
View File

@ -37,7 +37,7 @@ use bytes;
# ========================================================================== # ==========================================================================
use constant MAX_CONNECT_DELAY => 10; use constant MAX_CONNECT_DELAY => 10;
use constant VERBOSE => 0; # Whether to output more verbose debug use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
# #
@ -165,7 +165,7 @@ if ( !connect( CLIENT, $saddr ) )
{ {
print CLIENT @_ print CLIENT @_
} }
print @_; Info @_;
} }
sub start sub start
{ {
@ -336,11 +336,11 @@ if ( !connect( CLIENT, $saddr ) )
if ( $exit_status == 0 ) if ( $exit_status == 0 )
{ {
print( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' died at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) ); Info( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' died at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) );
} }
else else
{ {
print( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' crashed at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) ); Error( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' crashed at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) );
} }
print( ", exit status $exit_status" ) if ( $exit_status ); print( ", exit status $exit_status" ) if ( $exit_status );
print( ", signal $exit_signal" ) if ( $exit_signal ); print( ", signal $exit_signal" ) if ( $exit_signal );

43
scripts/zmfilter.pl
View File

@ -149,47 +149,6 @@ sub dbgInit
} }
} }
sub dbgPrint
{
my $code = shift;
my $string = shift;
my $line = shift;
$string =~ s/[\r\n]+$//g;
my ($seconds, $microseconds) = gettimeofday();
if ( $line )
{
my $file = __FILE__;
$file =~ s|^.*/||g;
printf( "%s.%06d %s[%d].%s-%s/%d [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $file, $line, $code, $string );
}
else
{
printf( "%s.%06d %s[%d].%s [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $code, $string );
}
}
sub Debug
{
dbgPrint( "DBG", $_[0] ) if ( DBG_LEVEL >= 1 );
}
sub Info
{
dbgPrint( "INF", $_[0] ) if ( DBG_LEVEL >= 0 );
}
sub Warning
{
dbgPrint( "WAR", $_[0] ) if ( DBG_LEVEL >= -1 );
}
sub Error
{
dbgPrint( "ERR", $_[0] ) if ( DBG_LEVEL >= -2 );
}
# #
# More or less replicates the equivalent PHP function # More or less replicates the equivalent PHP function
# #
@ -239,7 +198,7 @@ select( LOG ); $| = 1;
chdir( EVENT_PATH ); chdir( EVENT_PATH );
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS ); my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_HOST, ZM_DB_USER, ZM_DB_PASS );
Info( "Scanning for events\n" ); Info( "Scanning for events\n" );

44
scripts/zmpkg.pl
View File

@ -46,7 +46,7 @@ use DBI;
use POSIX; use POSIX;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
use constant LOG_FILE => ZM_PATH_LOGS.'/zmpkg.log'; use constant LOG_FILE => ZoneMinder::ZM_PATH_LOGS.'/zmpkg.log';
# Detaint our environment # Detaint our environment
$ENV{PATH} = '/bin:/usr/bin'; $ENV{PATH} = '/bin:/usr/bin';
@ -332,45 +332,3 @@ sub runCommand
} }
return( $output ); return( $output );
} }
sub dbgPrint
{
my $code = shift;
my $string = shift;
my $line = shift;
$string =~ s/[\r\n]+$//g;
my ($seconds, $microseconds) = gettimeofday();
if ( $line )
{
my $file = __FILE__;
$file =~ s|^.*/||g;
printf( STDERR "%s.%06d %s[%d].%s-%s/%d [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $file, $line, $code, $string );
}
else
{
printf( STDERR "%s.%06d %s[%d].%s [%s]\n", strftime( "%x %H:%M:%S", localtime( $seconds ) ), $microseconds, $dbg_id, $$, $code, $string );
}
}
sub Debug
{
dbgPrint( "DBG", $_[0] ) if ( DBG_LEVEL >= 1 );
}
sub Info
{
dbgPrint( "INF", $_[0] ) if ( DBG_LEVEL >= 0 );
}
sub Warning
{
dbgPrint( "WAR", $_[0] ) if ( DBG_LEVEL >= -1 );
}
sub Error
{
dbgPrint( "ERR", $_[0] ) if ( DBG_LEVEL >= -2 );
}

12
scripts/zmtrack.pl
View File

@ -34,7 +34,7 @@ use bytes;
# ========================================================================== # ==========================================================================
use constant SLEEP_TIME => 10000; # In microseconds use constant SLEEP_TIME => 10000; # In microseconds
use constant VERBOSE => 1; # Whether to output more verbose debug use constant DBG_LEVEL => 1; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
# #
@ -87,7 +87,7 @@ select( LOG ); $| = 1;
print( "Tracker daemon $mid (experimental) starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" ); print( "Tracker daemon $mid (experimental) starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS ); my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_HOST, ZM_DB_USER, ZM_DB_PASS );
my $sql = "select C.*,M.* from Monitors as M left join Controls as C on M.ControlId = C.Id where M.Id = ?"; my $sql = "select C.*,M.* from Monitors as M left join Controls as C on M.ControlId = C.Id where M.Id = ?";
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() ); my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
@ -125,7 +125,7 @@ if ( !$monitor->{CanMoveMap} )
} }
} }
print( "Found monitor for id '$monitor'\n" ) if ( VERBOSE ); Debug( "Found monitor for id '$monitor'\n" );
my $size = 512; # We only need the first 512 bytes really for the alarm state and forced alarm my $size = 512; # We only need the first 512 bytes really for the alarm state and forced alarm
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id}; $monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 ); $monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
@ -205,7 +205,7 @@ while( 1 )
my ( $alarm_x, $alarm_y ) = unpack( "ll", $alarm_pos ); my ( $alarm_x, $alarm_y ) = unpack( "ll", $alarm_pos );
if ( $alarm_x > 0 && $alarm_y > 0 ) if ( $alarm_x > 0 && $alarm_y > 0 )
{ {
print( "Got alarm at $alarm_x, $alarm_y\n" ) if ( VERBOSE ); Debug( "Got alarm at $alarm_x, $alarm_y\n" );
Suspend( $monitor ); Suspend( $monitor );
Track( $monitor, $alarm_x, $alarm_y ); Track( $monitor, $alarm_x, $alarm_y );
Resume( $monitor ); Resume( $monitor );
@ -215,14 +215,14 @@ while( 1 )
} }
else else
{ {
if ( VERBOSE && $alarmed ) if ( DBG_LEVEL > 0 && $alarmed )
{ {
print( "Left alarm state\n" ); print( "Left alarm state\n" );
$alarmed = undef; $alarmed = undef;
} }
if ( ($monitor->{ReturnLocation} >= 0) && ($last_alarm > 0) && ((time()-$last_alarm) > $monitor->{ReturnDelay}) ) if ( ($monitor->{ReturnLocation} >= 0) && ($last_alarm > 0) && ((time()-$last_alarm) > $monitor->{ReturnDelay}) )
{ {
print( "Returning to location ".$monitor->{ReturnLocation}."\n" ) if ( VERBOSE ); Debug( "Returning to location ".$monitor->{ReturnLocation}."\n" );
Suspend( $monitor ); Suspend( $monitor );
Return( $monitor ); Return( $monitor );
Resume( $monitor ); Resume( $monitor );

62
scripts/zmtrigger.pl
View File

@ -34,7 +34,7 @@ use bytes;
# ========================================================================== # ==========================================================================
use constant MAX_CONNECT_DELAY => 10; use constant MAX_CONNECT_DELAY => 10;
use constant VERBOSE => 0; # Whether to output more verbose debug use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# Now define the trigger sources, can be inet socket, unix socket or file based # Now define the trigger sources, can be inet socket, unix socket or file based
# Ignore parser field for now. # Ignore parser field for now.
@ -79,9 +79,9 @@ open(STDERR, ">&LOG") || die( "Can't dup stderr: $!" );
select( STDERR ); $| = 1; select( STDERR ); $| = 1;
select( LOG ); $| = 1; select( LOG ); $| = 1;
print( "Trigger daemon starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" ); Info( "Trigger daemon starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USER, ZM_DB_PASS ); my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_HOST, ZM_DB_USER, ZM_DB_PASS );
my $sql = "select * from Monitors where Id = ? or Name = ?"; my $sql = "select * from Monitors where Id = ? or Name = ?";
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() ); my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
@ -91,7 +91,7 @@ $SIG{HUP} = \&status;
my $base_rin = ''; my $base_rin = '';
foreach my $source ( @sources ) foreach my $source ( @sources )
{ {
print( "Opening source '$source->{name}'\n" ); Info( "Opening source '$source->{name}'\n" );
if ( $source->{type} eq "inet" ) if ( $source->{type} eq "inet" )
{ {
local *sfh; local *sfh;
@ -151,18 +151,18 @@ while( 1 )
my $nfound = select( my $rout = $rin, undef, my $eout = $ein, $timeout ); my $nfound = select( my $rout = $rin, undef, my $eout = $ein, $timeout );
if ( $nfound > 0 ) if ( $nfound > 0 )
{ {
print( "Got input from $nfound sources\n" ) if ( VERBOSE ); Debug( "Got input from $nfound sources\n" );
foreach my $source ( @sources ) foreach my $source ( @sources )
{ {
if ( vec( $rout, fileno($source->{handle}),1) ) if ( vec( $rout, fileno($source->{handle}),1) )
{ {
print( "Got input from source $source->{name} (".fileno($source->{handle}).")\n" ) if ( VERBOSE ); Debug( "Got input from source $source->{name} (".fileno($source->{handle}).")\n" );
if ( $source->{type} eq "inet" || $source->{type} eq "unix" ) if ( $source->{type} eq "inet" || $source->{type} eq "unix" )
{ {
local *cfh; local *cfh;
my $paddr = accept( *cfh, $source->{handle} ); my $paddr = accept( *cfh, $source->{handle} );
$connections{fileno(*cfh)} = { source=>$source, handle=>*cfh }; $connections{fileno(*cfh)} = { source=>$source, handle=>*cfh };
print( "Added new connection (".fileno(*cfh)."), ".int(keys(%connections))." connections\n" ) if ( VERBOSE ); Debug( "Added new connection (".fileno(*cfh)."), ".int(keys(%connections))." connections\n" );
} }
else else
{ {
@ -174,7 +174,7 @@ while( 1 )
} }
else else
{ {
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE ); Debug( "Got '$buffer' ($nbytes bytes)\n" );
handleMessage( $buffer ); handleMessage( $buffer );
} }
} }
@ -182,7 +182,7 @@ while( 1 )
} }
foreach my $connection ( values(%connections) ) foreach my $connection ( values(%connections) )
{ {
print( "Got input from connection on ".$connection->{source}->{name}." (".fileno($connection->{handle}).")\n" ) if ( VERBOSE ); Debug( "Got input from connection on ".$connection->{source}->{name}." (".fileno($connection->{handle}).")\n" );
if ( vec( $rout, fileno($connection->{handle}),1) ) if ( vec( $rout, fileno($connection->{handle}),1) )
{ {
my $buffer; my $buffer;
@ -190,12 +190,12 @@ while( 1 )
if ( !$nbytes ) if ( !$nbytes )
{ {
delete( $connections{fileno($connection->{handle})} ); delete( $connections{fileno($connection->{handle})} );
print( "Removed connection (".fileno($connection->{handle})."), ".int(keys(%connections))." connections\n" ) if ( VERBOSE ); Debug( "Removed connection (".fileno($connection->{handle})."), ".int(keys(%connections))." connections\n" );
close( $connection->{handle} ); close( $connection->{handle} );
} }
else else
{ {
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE ); Debug( "Got '$buffer' ($nbytes bytes)\n" );
handleMessage( $buffer ); handleMessage( $buffer );
} }
} }
@ -206,7 +206,7 @@ while( 1 )
if ( $! == EINTR ) if ( $! == EINTR )
{ {
# Dead child, will be reaped # Dead child, will be reaped
#print( "Probable dead child\n" ); #Info( "Probable dead child\n" );
} }
else else
{ {
@ -215,32 +215,32 @@ while( 1 )
} }
else else
{ {
print( "Checking for timed actions at ".time()."\n" ) if ( VERBOSE && int(keys(%actions)) ); Debug( "Checking for timed actions at ".time()."\n" ) if ( int(keys(%actions)) );
my $now = time(); my $now = time();
foreach my $action_time ( sort( grep { $_ < $now } keys( %actions ) ) ) foreach my $action_time ( sort( grep { $_ < $now } keys( %actions ) ) )
{ {
print( "Found actions expiring at $action_time\n" ); Info( "Found actions expiring at $action_time\n" );
foreach my $action ( @{$actions{$action_time}} ) foreach my $action ( @{$actions{$action_time}} )
{ {
print( "Found action '$action'\n" ); Info( "Found action '$action'\n" );
handleMessage( $action ); handleMessage( $action );
} }
delete( $actions{$action_time} ); delete( $actions{$action_time} );
} }
} }
} }
print( "Trigger daemon exiting\n" ); Info( "Trigger daemon exiting\n" );
sub handleMessage sub handleMessage
{ {
my $buffer = shift; my $buffer = shift;
#chomp( $buffer ); #chomp( $buffer );
print( "Processing buffer '$buffer'\n" ) if ( VERBOSE ); Debug( "Processing buffer '$buffer'\n" );
foreach my $message ( split( /\r?\n/, $buffer ) ) foreach my $message ( split( /\r?\n/, $buffer ) )
{ {
next if ( !$message ); next if ( !$message );
print( "Processing message '$message'\n" ) if ( VERBOSE ); Debug( "Processing message '$message'\n" );
my ( $id, $action, $score, $cause, $text, $showtext ) = split( /\|/, $message ); my ( $id, $action, $score, $cause, $text, $showtext ) = split( /\|/, $message );
$score = 0 if ( !defined($score) ); $score = 0 if ( !defined($score) );
$cause = 0 if ( !defined($cause) ); $cause = 0 if ( !defined($cause) );
@ -251,29 +251,29 @@ sub handleMessage
if ( !$monitor ) if ( !$monitor )
{ {
print( "Can't find monitor '$id' for message '$message'\n" ); Warning( "Can't find monitor '$id' for message '$message'\n" );
next; next;
} }
print( "Found monitor for id '$id'\n" ) if ( VERBOSE ); Debug( "Found monitor for id '$id'\n" );
my $size = 512; # We only need the first 512 bytes really for the shared data and trigger section my $size = 512; # We only need the first 512 bytes really for the shared data and trigger section
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id}; $monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 ); $monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
if ( !defined($monitor->{ShmId}) ) if ( !defined($monitor->{ShmId}) )
{ {
printf( "Can't get shared memory id '%x': $!\n", $monitor->{ShmKey}, $! ); Error( "Can't get shared memory id '%x': $!\n", $monitor->{ShmKey}, $! );
next; next;
} }
my $shm_data_size; my $shm_data_size;
if ( !shmread( $monitor->{ShmId}, $shm_data_size, 0, 4 ) ) if ( !shmread( $monitor->{ShmId}, $shm_data_size, 0, 4 ) )
{ {
print( "Can't read from shared memory: $!\n" ); Error( "Can't read from shared memory: $!\n" );
exit( -1 ); exit( -1 );
} }
$shm_data_size = unpack( "l", $shm_data_size ); $shm_data_size = unpack( "l", $shm_data_size );
my $trigger_data_offset = $shm_data_size+4; # Allow for 'size' member of trigger data my $trigger_data_offset = $shm_data_size+4; # Allow for 'size' member of trigger data
print( "Handling action '$action'\n" ) if ( VERBOSE ); Debug( "Handling action '$action'\n" );
if ( $action =~ /^(on|off)(?:\+(\d+))?$/ ) if ( $action =~ /^(on|off)(?:\+(\d+))?$/ )
{ {
my $trigger = $1; my $trigger = $1;
@ -289,9 +289,9 @@ sub handleMessage
} }
if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) ) if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) )
{ {
print( "Can't write to shared memory: $!\n" ); Error( "Can't write to shared memory: $!\n" );
} }
print( "Triggered event $trigger '$cause'\n" ); Info( "Triggered event $trigger '$cause'\n" );
if ( $delay ) if ( $delay )
{ {
my $action_time = time()+$delay; my $action_time = time()+$delay;
@ -302,7 +302,7 @@ sub handleMessage
$action_array = $actions{$action_time} = []; $action_array = $actions{$action_time} = [];
} }
push( @$action_array, $action_text ); push( @$action_array, $action_text );
print( "Added timed event '$action_text', expires at $action_time (+$delay secs)\n" ) if ( VERBOSE ); Debug( "Added timed event '$action_text', expires at $action_time (+$delay secs)\n" );
} }
} }
elsif( $action eq "cancel" ) elsif( $action eq "cancel" )
@ -318,22 +318,22 @@ sub handleMessage
} }
if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) ) if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) )
{ {
print( "Can't write to shared memory: $!\n" ); Error( "Can't write to shared memory: $!\n" );
} }
print( "Cancelled event '$cause'\n" ); Info( "Cancelled event '$cause'\n" );
} }
elsif( $action eq "show" ) elsif( $action eq "show" )
{ {
my $trigger_data = pack( "Z32", $showtext ); my $trigger_data = pack( "Z32", $showtext );
if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) ) if ( !shmwrite( $monitor->{ShmId}, $trigger_data, $trigger_data_offset, length($trigger_data) ) )
{ {
print( "Can't write to shared memory: $!\n" ); Error( "Can't write to shared memory: $!\n" );
} }
print( "Updated show text to '$showtext'\n" ); Info( "Updated show text to '$showtext'\n" );
} }
else else
{ {
print( "Unrecognised action '$action' in message '$message'\n" ); Error( "Unrecognised action '$action' in message '$message'\n" );
} }
} }
} }

16
scripts/zmupdate.pl
View File

@ -35,7 +35,7 @@ use bytes;
# ========================================================================== # ==========================================================================
use constant CHECK_INTERVAL => (1*24*60*60); # Interval between version checks use constant CHECK_INTERVAL => (1*24*60*60); # Interval between version checks
use constant VERBOSE => 0; # Whether to output more verbose debug use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
# #
@ -131,7 +131,7 @@ if ( $check && ZM_CHECK_FOR_UPDATES )
my $now = time(); my $now = time();
if ( !$last_version || !$last_check || (($now-$last_check) > CHECK_INTERVAL) ) if ( !$last_version || !$last_check || (($now-$last_check) > CHECK_INTERVAL) )
{ {
print( "Checking for updates at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" ); Info( "Checking for updates at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
use LWP::UserAgent; use LWP::UserAgent;
my $ua = LWP::UserAgent->new; my $ua = LWP::UserAgent->new;
@ -146,7 +146,7 @@ if ( $check && ZM_CHECK_FOR_UPDATES )
chomp($last_version); chomp($last_version);
$last_check = $now; $last_check = $now;
print( "Got version: '".$last_version."'\n" ); Info( "Got version: '".$last_version."'\n" );
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_HOST, ZM_DB_USER, ZM_DB_PASS ); my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_HOST, ZM_DB_USER, ZM_DB_PASS );
@ -162,7 +162,7 @@ if ( $check && ZM_CHECK_FOR_UPDATES )
} }
else else
{ {
print( "Error check failed: '".$res->status_line()."'\n" ); Error( "Error check failed: '".$res->status_line()."'\n" );
} }
} }
sleep( 3600 ); sleep( 3600 );
@ -267,10 +267,10 @@ if ( $version )
my $backup = ZM_DB_NAME."-".$version.".dump"; my $backup = ZM_DB_NAME."-".$version.".dump";
$command .= " --add-drop-table --databases ".ZM_DB_NAME." > ".$backup; $command .= " --add-drop-table --databases ".ZM_DB_NAME." > ".$backup;
print( "Creating backup to $backup. This may take several minutes.\n" ); print( "Creating backup to $backup. This may take several minutes.\n" );
print( "Executing '$command'\n" ) if ( VERBOSE ); print( "Executing '$command'\n" ) if ( DBG_LEVEL > 0 );
my $output = qx($command); my $output = qx($command);
my $status = $? >> 8; my $status = $? >> 8;
if ( $status || VERBOSE ) if ( $status || DBG_LEVEL > 0 )
{ {
chomp( $output ); chomp( $output );
print( "Output: $output\n" ); print( "Output: $output\n" );
@ -306,10 +306,10 @@ if ( $version )
} }
$command .= " ".ZM_DB_NAME." < ".ZM_PATH_BUILD."/db/zmalter-".$version.".sql"; $command .= " ".ZM_DB_NAME." < ".ZM_PATH_BUILD."/db/zmalter-".$version.".sql";
print( "Executing '$command'\n" ) if ( VERBOSE ); print( "Executing '$command'\n" ) if ( DBG_LEVEL > 0 );
my $output = qx($command); my $output = qx($command);
my $status = $? >> 8; my $status = $? >> 8;
if ( $status || VERBOSE ) if ( $status || DBG_LEVEL > 0 )
{ {
chomp( $output ); chomp( $output );
print( "Output: $output\n" ); print( "Output: $output\n" );

2
scripts/zmvideo.pl
View File

@ -33,7 +33,7 @@ use bytes;
# #
# ========================================================================== # ==========================================================================
use constant VERBOSE => 0; # Whether to output more verbose debug use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
# #

21
scripts/zmwatch.pl
View File

@ -35,7 +35,8 @@ use bytes;
# ========================================================================== # ==========================================================================
use constant START_DELAY => 30; # To give everything else time to start use constant START_DELAY => 30; # To give everything else time to start
use constant VERBOSE => 0; # Whether to output more verbose debug use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
# #
@ -70,8 +71,8 @@ select( STDOUT ); $| = 1;
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" ); open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
select( STDERR ); $| = 1; select( STDERR ); $| = 1;
select( LOG ); $| = 1; select( LOG ); $| = 1;
print( "Watchdog starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" ); Info( "Watchdog starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
print( "Watchdog pausing for ".START_DELAY." seconds\n" ); Info( "Watchdog pausing for ".START_DELAY." seconds\n" );
sleep( START_DELAY ); sleep( START_DELAY );
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_HOST, ZM_DB_USER, ZM_DB_PASS ); my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_HOST, ZM_DB_USER, ZM_DB_PASS );
@ -93,19 +94,19 @@ while( 1 )
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $shm_size, 0 ); $monitor->{ShmId} = shmget( $monitor->{ShmKey}, $shm_size, 0 );
if ( !defined($monitor->{ShmId}) ) if ( !defined($monitor->{ShmId}) )
{ {
print( "Can't get shared memory id '$monitor->{ShmKey}': $!\n" ); Error( "Can't get shared memory id '$monitor->{ShmKey}': $!\n" );
next; next;
} }
my $image_time; my $image_time;
if ( !shmread( $monitor->{ShmId}, $image_time, 20, 4 ) ) if ( !shmread( $monitor->{ShmId}, $image_time, 20, 4 ) )
{ {
print( "Can't read from shared memory '$monitor->{ShmKey}/$monitor->{ShmId}': $!\n" ); Error( "Can't read from shared memory '$monitor->{ShmKey}/$monitor->{ShmId}': $!\n" );
next; next;
} }
$image_time = unpack( "l", $image_time ); $image_time = unpack( "l", $image_time );
#my $command = ZM_PATH_BIN."/zmu -m ".$monitor->{Id}." -t"; #my $command = ZM_PATH_BIN."/zmu -m ".$monitor->{Id}." -t";
#print( "Getting last image time for monitor $monitor->{Id} ('$command')\n" ) if ( VERBOSE ); #Debug( "Getting last image time for monitor $monitor->{Id} ('$command')\n" );
#my $image_time = qx( $command ); #my $image_time = qx( $command );
#chomp($image_time); #chomp($image_time);
@ -117,7 +118,7 @@ while( 1 )
my $max_image_delay = (($monitor->{MaxFPS}>0)&&($monitor->{MaxFPS}<1))?(3/$monitor->{MaxFPS}):ZM_WATCH_MAX_DELAY; my $max_image_delay = (($monitor->{MaxFPS}>0)&&($monitor->{MaxFPS}<1))?(3/$monitor->{MaxFPS}):ZM_WATCH_MAX_DELAY;
my $image_delay = $now-$image_time; my $image_delay = $now-$image_time;
print( "Monitor $monitor->{Id} last captured $image_delay seconds ago, max is $max_image_delay\n" ) if ( VERBOSE ); Debug( "Monitor $monitor->{Id} last captured $image_delay seconds ago, max is $max_image_delay\n" );
if ( $image_delay <= $max_image_delay ) if ( $image_delay <= $max_image_delay )
{ {
# Yes, so continue # Yes, so continue
@ -134,11 +135,11 @@ while( 1 )
{ {
$command = ZM_PATH_BIN."/zmdc.pl restart zmc -m $monitor->{Id}"; $command = ZM_PATH_BIN."/zmdc.pl restart zmc -m $monitor->{Id}";
} }
print( "Restarting capture daemon ('$command'), time since last capture $image_delay seconds ($now-$image_time)\n" ); Info( "Restarting capture daemon ('$command'), time since last capture $image_delay seconds ($now-$image_time)\n" );
print( qx( $command ) ); Info( qx( $command ) );
} }
} }
sleep( ZM_WATCH_CHECK_INTERVAL ); sleep( ZM_WATCH_CHECK_INTERVAL );
} }
print( "Watchdog exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" ); Info( "Watchdog exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
exit(); exit();

44
scripts/zmx10.pl
View File

@ -33,7 +33,7 @@ use bytes;
# #
# ========================================================================== # ==========================================================================
use constant VERBOSE => 0; # Whether to output more verbose debug use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
# ========================================================================== # ==========================================================================
# #
@ -163,7 +163,7 @@ sub runServer
select( STDERR ); $| = 1; select( STDERR ); $| = 1;
select( LOG ); $| = 1; select( LOG ); $| = 1;
print( "X10 server starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" ); Info( "X10 server starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" ); socket( SERVER, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
unlink( main::X10_SOCK_FILE ); unlink( main::X10_SOCK_FILE );
@ -171,7 +171,7 @@ sub runServer
bind( SERVER, $saddr ) or die( "Can't bind: $!" ); bind( SERVER, $saddr ) or die( "Can't bind: $!" );
listen( SERVER, SOMAXCONN ) or die( "Can't listen: $!" ); listen( SERVER, SOMAXCONN ) or die( "Can't listen: $!" );
$dbh = DBI->connect( "DBI:mysql:database=".main::ZM_DB_NAME.";host=".main::ZM_DB_SERVER, main::ZM_DB_USER, main::ZM_DB_PASS ); $dbh = DBI->connect( "DBI:mysql:database=".main::ZM_DB_NAME.";host=".main::ZM_DB_HOST, main::ZM_DB_USER, main::ZM_DB_PASS );
$x10 = new X10::ActiveHome( port=>main::ZM_X10_DEVICE, house_code=>main::ZM_X10_HOUSE_CODE, debug=>1 ); $x10 = new X10::ActiveHome( port=>main::ZM_X10_DEVICE, house_code=>main::ZM_X10_HOUSE_CODE, debug=>1 );
@ -296,7 +296,7 @@ sub runServer
my $state; my $state;
if ( !shmread( $monitor->{ShmId}, $state, 8, 4 ) ) if ( !shmread( $monitor->{ShmId}, $state, 8, 4 ) )
{ {
print( "Can't read from shared memory: $!\n" ); Error( "Can't read from shared memory: $!\n" );
$reload = !undef; $reload = !undef;
next; next;
} }
@ -306,12 +306,12 @@ sub runServer
my $task_list; my $task_list;
if ( $state == 2 && $monitor->{LastState} == 0 ) # Gone into alarm state if ( $state == 2 && $monitor->{LastState} == 0 ) # Gone into alarm state
{ {
print( "Applying ON_list for $monitor_id\n" ) if ( main::VERBOSE ); Debug( "Applying ON_list for $monitor_id\n" );
$task_list = $monitor->{"ON_list"}; $task_list = $monitor->{"ON_list"};
} }
elsif ( $state == 0 && $monitor->{LastState} > 0 ) # Come out of alarm state elsif ( $state == 0 && $monitor->{LastState} > 0 ) # Come out of alarm state
{ {
print( "Applying OFF_list for $monitor_id\n" ) if ( main::VERBOSE ); Debug( "Applying OFF_list for $monitor_id\n" );
$task_list = $monitor->{"OFF_list"}; $task_list = $monitor->{"OFF_list"};
} }
if ( $task_list ) if ( $task_list )
@ -345,7 +345,7 @@ sub runServer
} }
} }
} }
print( "X10 server exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" ); Info( "X10 server exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
close( LOG ); close( LOG );
close( SERVER ); close( SERVER );
exit(); exit();
@ -359,7 +359,7 @@ sub addToDeviceList
my $function = shift; my $function = shift;
my $limit = shift; my $limit = shift;
print( "Adding to device list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" ) if ( main::VERBOSE ); Debug( "Adding to device list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" );
my $device = $device_hash{$unit_code}; my $device = $device_hash{$unit_code};
if ( !$device ) if ( !$device )
{ {
@ -388,7 +388,7 @@ sub addToMonitorList
my $function = shift; my $function = shift;
my $limit = shift; my $limit = shift;
print( "Adding to monitor list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" ) if ( main::VERBOSE ); Debug( "Adding to monitor list, uc:$unit_code, ev:$event, mo:$monitor, fu:$function, li:$limit\n" );
my $device = $device_hash{$unit_code}; my $device = $device_hash{$unit_code};
if ( !$device ) if ( !$device )
{ {
@ -413,7 +413,7 @@ sub loadTasks
{ {
%monitor_hash = (); %monitor_hash = ();
print( "Loading tasks\n" ) if ( main::VERBOSE ); Debug( "Loading tasks\n" );
# Clear out all old device task lists # Clear out all old device task lists
foreach my $unit_code ( sort( keys(%device_hash) ) ) foreach my $unit_code ( sort( keys(%device_hash) ) )
{ {
@ -432,7 +432,7 @@ sub loadTasks
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 ); $monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
if ( !defined($monitor->{ShmId}) ) if ( !defined($monitor->{ShmId}) )
{ {
print( "Can't get shared memory id '$monitor->{ShmKey}': $!\n" ); Error( "Can't get shared memory id '$monitor->{ShmKey}': $!\n" );
next; next;
} }
@ -440,10 +440,10 @@ sub loadTasks
if ( $monitor->{Activation} ) if ( $monitor->{Activation} )
{ {
print( "$monitor->{Name} has active string '$monitor->{Activation}'\n" ) if ( main::VERBOSE ); Debug( "$monitor->{Name} has active string '$monitor->{Activation}'\n" );
foreach my $code_string ( split( ',', $monitor->{Activation} ) ) foreach my $code_string ( split( ',', $monitor->{Activation} ) )
{ {
#print( "Code string: $code_string\n" ); #Debug( "Code string: $code_string\n" );
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ ); my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
$limit = 0 if ( !$limit ); $limit = 0 if ( !$limit );
if ( $unit_code ) if ( $unit_code )
@ -461,10 +461,10 @@ sub loadTasks
} }
if ( $monitor->{AlarmInput} ) if ( $monitor->{AlarmInput} )
{ {
print( "$monitor->{Name} has alarm input string '$monitor->{AlarmInput}'\n" ) if ( main::VERBOSE ); Debug( "$monitor->{Name} has alarm input string '$monitor->{AlarmInput}'\n" );
foreach my $code_string ( split( ',', $monitor->{AlarmInput} ) ) foreach my $code_string ( split( ',', $monitor->{AlarmInput} ) )
{ {
#print( "Code string: $code_string\n" ); #Debug( "Code string: $code_string\n" );
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ ); my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
$limit = 0 if ( !$limit ); $limit = 0 if ( !$limit );
if ( $unit_code ) if ( $unit_code )
@ -482,10 +482,10 @@ sub loadTasks
} }
if ( $monitor->{AlarmOutput} ) if ( $monitor->{AlarmOutput} )
{ {
print( "$monitor->{Name} has alarm output string '$monitor->{AlarmOutput}'\n" ) if ( main::VERBOSE ); Debug( "$monitor->{Name} has alarm output string '$monitor->{AlarmOutput}'\n" );
foreach my $code_string ( split( ',', $monitor->{AlarmOutput} ) ) foreach my $code_string ( split( ',', $monitor->{AlarmOutput} ) )
{ {
#print( "Code string: $code_string\n" ); #Debug( "Code string: $code_string\n" );
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ ); my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
$limit = 0 if ( !$limit ); $limit = 0 if ( !$limit );
if ( $unit_code ) if ( $unit_code )
@ -605,7 +605,7 @@ sub processTask
my $force_data = pack( "llZ*", 1, 0, "X10" ); my $force_data = pack( "llZ*", 1, 0, "X10" );
if ( !shmwrite( $task->{monitor}->{ShmId}, $force_data, 52, 12 ) ) if ( !shmwrite( $task->{monitor}->{ShmId}, $force_data, 52, 12 ) )
{ {
print( "Can't write to shared memory: $!\n" ); Error( "Can't write to shared memory: $!\n" );
} }
if ( $task->{limit} ) if ( $task->{limit} )
{ {
@ -618,13 +618,13 @@ sub processTask
my $force_data = pack( "llZ*", 0, 0, "" ); my $force_data = pack( "llZ*", 0, 0, "" );
if ( !shmwrite( $task->{monitor}->{ShmId}, $force_data, 52, 12 ) ) if ( !shmwrite( $task->{monitor}->{ShmId}, $force_data, 52, 12 ) )
{ {
print( "Can't write to shared memory: $!\n" ); Error( "Can't write to shared memory: $!\n" );
} }
} }
} }
foreach my $command ( @commands ) foreach my $command ( @commands )
{ {
print( "Executing command '$command'\n" ); Info( "Executing command '$command'\n" );
qx( $command ); qx( $command );
} }
} }
@ -651,7 +651,7 @@ sub dprint
{ {
print CLIENT @_ print CLIENT @_
} }
print @_; Info( @_ );
} }
sub x10listen sub x10listen
@ -678,7 +678,7 @@ sub x10listen
} }
} }
} }
print( strftime( "%y/%m/%d %H:%M:%S", localtime() )." - ".$event->as_string()."\n" ); Info( strftime( "%y/%m/%d %H:%M:%S", localtime() )." - ".$event->as_string()."\n" );
} }
} }