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
parent
d8e0ce1f74
commit
88bd01167a
|
|
@ -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
|
||||
{
|
||||
my $string = shift;
|
||||
|
|
|
|||
|
|
@ -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( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
Info( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
|
|
@ -110,8 +110,7 @@ sub printMsg
|
|||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
print( $msg );
|
||||
print( "[".$msg_len."]\n" );
|
||||
Info( $msg."[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
|
|
@ -136,7 +135,7 @@ sub sendCmd
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Error check failed: '".$res->status_line()."'\n" );
|
||||
Error( "Error check failed: '".$res->status_line()."'\n" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
|
|
@ -144,63 +143,63 @@ sub sendCmd
|
|||
|
||||
sub cameraReset
|
||||
{
|
||||
print( "Camera Reset\n" );
|
||||
Info( "Camera Reset\n" );
|
||||
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
Info( "Move Up\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=up";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
Info( "Move Down\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=down";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
Info( "Move Left\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=left";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
Info( "Move Right\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=right";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
Info( "Move Up/Right\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upright";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
Info( "Move Up/Left\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=upleft";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "Move Down/Right\n" );
|
||||
Info( "Move Down/Right\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downright";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
Info( "Move Down/Left\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=downleft";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -208,7 +207,7 @@ sub moveDownLeft
|
|||
sub moveMap
|
||||
{
|
||||
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";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -216,7 +215,7 @@ sub moveMap
|
|||
sub stepUp
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Up $step\n" );
|
||||
Info( "Step Up $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -224,7 +223,7 @@ sub stepUp
|
|||
sub stepDown
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Down $step\n" );
|
||||
Info( "Step Down $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -232,7 +231,7 @@ sub stepDown
|
|||
sub stepLeft
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Left $step\n" );
|
||||
Info( "Step Left $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -240,7 +239,7 @@ sub stepLeft
|
|||
sub stepRight
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Step Right $step\n" );
|
||||
Info( "Step Right $step\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -249,7 +248,7 @@ sub stepUpRight
|
|||
{
|
||||
my $panstep = 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";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -258,7 +257,7 @@ sub stepUpLeft
|
|||
{
|
||||
my $panstep = 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";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -267,7 +266,7 @@ sub stepDownRight
|
|||
{
|
||||
my $panstep = 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";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -276,7 +275,7 @@ sub stepDownLeft
|
|||
{
|
||||
my $panstep = 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";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -284,7 +283,7 @@ sub stepDownLeft
|
|||
sub zoomTele
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Zoom Tele\n" );
|
||||
Info( "Zoom Tele\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -292,7 +291,7 @@ sub zoomTele
|
|||
sub zoomWide
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Zoom Wide\n" );
|
||||
Info( "Zoom Wide\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -300,7 +299,7 @@ sub zoomWide
|
|||
sub focusNear
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Focus Near\n" );
|
||||
Info( "Focus Near\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -308,21 +307,21 @@ sub focusNear
|
|||
sub focusFar
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Focus Far\n" );
|
||||
Info( "Focus Far\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
Info( "Focus Auto\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=on";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Manual\n" );
|
||||
Info( "Focus Manual\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -330,7 +329,7 @@ sub focusMan
|
|||
sub irisOpen
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Iris Open\n" );
|
||||
Info( "Iris Open\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -338,21 +337,21 @@ sub irisOpen
|
|||
sub irisClose
|
||||
{
|
||||
my $step = shift;
|
||||
print( "Iris Close\n" );
|
||||
Info( "Iris Close\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?riris=-$step";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisAuto
|
||||
{
|
||||
print( "Iris Auto\n" );
|
||||
Info( "Iris Auto\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=on";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
print( "Iris Manual\n" );
|
||||
Info( "Iris Manual\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=off";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -360,7 +359,7 @@ sub irisMan
|
|||
sub presetClear
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
Info( "Clear Preset $preset\n" );
|
||||
my $cmd = "nphPresetNameCheck?Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -368,7 +367,7 @@ sub presetClear
|
|||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
Info( "Set Preset $preset\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -376,14 +375,14 @@ sub presetSet
|
|||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
Info( "Goto Preset $preset\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?gotoserverpresetno=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
Info( "Home Preset\n" );
|
||||
my $cmd = "/axis-cgi/com/ptz.cgi?move=home";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -510,5 +509,5 @@ elsif ( $command eq "preset_goto" )
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
Error( "Can't handle command $command\n" );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
Info( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
|
|
@ -110,8 +110,7 @@ sub printMsg
|
|||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
print( $msg );
|
||||
print( "[".$msg_len."]\n" );
|
||||
Info( $msg."[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
|
|
@ -136,7 +135,7 @@ sub sendCmd
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Error check failed: '".$res->status_line()."'\n" );
|
||||
Error( "Error check failed: '".$res->status_line()."'\n" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
|
|
@ -144,35 +143,35 @@ sub sendCmd
|
|||
|
||||
sub cameraReset
|
||||
{
|
||||
print( "Camera Reset\n" );
|
||||
Info( "Camera Reset\n" );
|
||||
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
Info( "Move Up\n" );
|
||||
my $cmd = "nphControlCamera?Direction=TiltUp";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
Info( "Move Down\n" );
|
||||
my $cmd = "nphControlCamera?Direction=TiltDown";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
Info( "Move Left\n" );
|
||||
my $cmd = "nphControlCamera?Direction=PanLeft";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
Info( "Move Right\n" );
|
||||
my $cmd = "nphControlCamera?Direction=PanRight";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -180,42 +179,42 @@ sub moveRight
|
|||
sub moveMap
|
||||
{
|
||||
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";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
Info( "Zoom Tele\n" );
|
||||
my $cmd = "nphControlCamera?Direction=ZoomTele";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
Info( "Zoom Wide\n" );
|
||||
my $cmd = "nphControlCamera?Direction=ZoomWide";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
Info( "Focus Near\n" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusNear";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
Info( "Focus Far\n" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusFar";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
Info( "Focus Auto\n" );
|
||||
my $cmd = "nphControlCamera?Direction=FocusAuto";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -223,7 +222,7 @@ sub focusAuto
|
|||
sub presetClear
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
Info( "Clear Preset $preset\n" );
|
||||
my $cmd = "nphPresetNameCheck?Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -231,7 +230,7 @@ sub presetClear
|
|||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
Info( "Set Preset $preset\n" );
|
||||
my $cmd = "nphPresetNameCheck?PresetName=$preset&Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -239,14 +238,14 @@ sub presetSet
|
|||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
Info( "Goto Preset $preset\n" );
|
||||
my $cmd = "nphControlCamera?Direction=Preset&PresetOperation=Move&Data=$preset";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
Info( "Home Preset\n" );
|
||||
my $cmd = "nphControlCamera?Direction=HomePosition";
|
||||
sendCmd( $cmd );
|
||||
}
|
||||
|
|
@ -309,5 +308,5 @@ elsif ( $command eq "preset_goto" )
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
Error( "Can't handle command $command\n" );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
Info( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
|
|
@ -127,16 +127,17 @@ sub printMsg
|
|||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
print( $prefix );
|
||||
my $msg_str = $prefix;
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
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
|
||||
|
|
@ -163,16 +164,16 @@ sub sendCmd
|
|||
my $n_bytes = $serial_port->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
print( "Error, write failed: $!" );
|
||||
Error( "Write failed: $!" );
|
||||
}
|
||||
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 )
|
||||
{
|
||||
print( "Waiting for ack\n" );
|
||||
Info( "Waiting for ack\n" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
|
|
@ -190,23 +191,23 @@ sub sendCmd
|
|||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
print( "Got ack for socket $socket\n" );
|
||||
Info( "Got ack for socket $socket\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got bogus response\n" );
|
||||
Error( "Got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
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 )
|
||||
{
|
||||
print( "Warning, response timeout\n" );
|
||||
Warning( "Response timeout\n" );
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
|
@ -217,49 +218,49 @@ my $sync = 0xff;
|
|||
|
||||
sub remoteReset
|
||||
{
|
||||
print( "Remote Reset\n" );
|
||||
Info( "Remote Reset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x0f, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
print( "Camera Off\n" );
|
||||
Info( "Camera Off\n" );
|
||||
my @msg = ( $sync, $address, 0x08, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
print( "Camera On\n" );
|
||||
Info( "Camera On\n" );
|
||||
my @msg = ( $sync, $address, 0x88, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub autoScan
|
||||
{
|
||||
print( "Auto Scan\n" );
|
||||
Info( "Auto Scan\n" );
|
||||
my @msg = ( $sync, $address, 0x90, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub manScan
|
||||
{
|
||||
print( "Manual Scan\n" );
|
||||
Info( "Manual Scan\n" );
|
||||
my @msg = ( $sync, $address, 0x10, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
print( "Stop\n" );
|
||||
Info( "Stop\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
Info( "Move Up\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x08, 0x00, $speed );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -272,7 +273,7 @@ sub moveUp
|
|||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
Info( "Move Down\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x10, 0x00, $speed );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -285,7 +286,7 @@ sub moveDown
|
|||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
Info( "Move Left\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x04, $speed, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -298,7 +299,7 @@ sub moveLeft
|
|||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
Info( "Move Right\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x02, $speed, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -311,7 +312,7 @@ sub moveRight
|
|||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
Info( "Move Up/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x0c, $panspeed, $tiltspeed );
|
||||
|
|
@ -325,7 +326,7 @@ sub moveUpLeft
|
|||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
Info( "Move Up/Right\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x0a, $panspeed, $tiltspeed );
|
||||
|
|
@ -339,7 +340,7 @@ sub moveUpRight
|
|||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
Info( "Move Down/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x14, $panspeed, $tiltspeed );
|
||||
|
|
@ -353,7 +354,7 @@ sub moveDownLeft
|
|||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "Move Down/Right\n" );
|
||||
Info( "Move Down/Right\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $sync, $address, 0x00, 0x12, $panspeed, $tiltspeed );
|
||||
|
|
@ -367,14 +368,14 @@ sub moveDownRight
|
|||
|
||||
sub flip180
|
||||
{
|
||||
print( "Flip 180\n" );
|
||||
Info( "Flip 180\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x21 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zeroPan
|
||||
{
|
||||
print( "Zero Pan\n" );
|
||||
Info( "Zero Pan\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -388,7 +389,7 @@ sub setZoomSpeed
|
|||
|
||||
sub zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
Info( "Zoom Tele\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
|
|
@ -403,7 +404,7 @@ sub zoomTele
|
|||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
Info( "Zoom Wide\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
|
|
@ -425,7 +426,7 @@ sub setFocusSpeed
|
|||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
Info( "Focus Near\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
|
|
@ -440,7 +441,7 @@ sub focusNear
|
|||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
Info( "Focus Far\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
usleep( 250000 );
|
||||
|
|
@ -455,21 +456,21 @@ sub focusFar
|
|||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
Info( "Focus Auto\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Man\n" );
|
||||
Info( "Focus Man\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x02 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisClose
|
||||
{
|
||||
print( "Iris Close\n" );
|
||||
Info( "Iris Close\n" );
|
||||
my @msg = ( $sync, $address, 0x04, 0x00, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
|
|
@ -481,7 +482,7 @@ sub irisClose
|
|||
|
||||
sub irisOpen
|
||||
{
|
||||
print( "Iris Open\n" );
|
||||
Info( "Iris Open\n" );
|
||||
my @msg = ( $sync, $address, 0x02, 0x80, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
|
|
@ -493,14 +494,14 @@ sub irisOpen
|
|||
|
||||
sub irisAuto
|
||||
{
|
||||
print( "Iris Auto\n" );
|
||||
Info( "Iris Auto\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub irisMan
|
||||
{
|
||||
print( "Iris Man\n" );
|
||||
Info( "Iris Man\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x02 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -508,12 +509,12 @@ sub irisMan
|
|||
sub writeScreen
|
||||
{
|
||||
my $string = shift;
|
||||
print( "Writing '$string' to screen\n" );
|
||||
Info( "Writing '$string' to screen\n" );
|
||||
|
||||
my @chars = unpack( "C*", $string );
|
||||
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] );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -521,7 +522,7 @@ sub writeScreen
|
|||
|
||||
sub clearScreen
|
||||
{
|
||||
print( "Clear Screen\n" );
|
||||
Info( "Clear Screen\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x17, 0x00, 0x00 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -529,7 +530,7 @@ sub clearScreen
|
|||
sub clearPreset
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
Info( "Clear Preset $preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x05, 0x00, $preset );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -537,7 +538,7 @@ sub clearPreset
|
|||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
Info( "Set Preset $preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x03, 0x00, $preset );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -545,14 +546,14 @@ sub presetSet
|
|||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
Info( "Goto Preset $preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, $preset );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
Info( "Home Preset\n" );
|
||||
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -672,7 +673,7 @@ elsif ( $command eq "preset_goto" )
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
Error( "Can't handle command $command\n" );
|
||||
}
|
||||
|
||||
$serial_port->close();
|
||||
|
|
|
|||
|
|
@ -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( LOG ); $| = 1;
|
||||
|
||||
print( $arg_string."\n" );
|
||||
Info( $arg_string."\n" );
|
||||
|
||||
srand( time() );
|
||||
|
||||
|
|
@ -119,16 +119,16 @@ sub printMsg
|
|||
my $line_length = 16;
|
||||
my $msg_len = int(@$msg);
|
||||
|
||||
print( $prefix );
|
||||
my $msg_str = $prefix;
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
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
|
||||
|
|
@ -148,16 +148,16 @@ sub sendCmd
|
|||
my $n_bytes = $serial_port->write( $tx_msg );
|
||||
if ( !$n_bytes )
|
||||
{
|
||||
print( "Error, write failed: $!" );
|
||||
Error( "Write failed: $!" );
|
||||
}
|
||||
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 )
|
||||
{
|
||||
print( "Waiting for ack\n" );
|
||||
Info( "Waiting for ack\n" );
|
||||
my $max_wait = 3;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
|
|
@ -175,18 +175,18 @@ sub sendCmd
|
|||
if ( ($resp[1] & 0xf0) == 0x40 )
|
||||
{
|
||||
my $socket = $resp[1] & 0x0f;
|
||||
print( "Got ack for socket $socket\n" );
|
||||
Info( "Got ack for socket $socket\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
printf( "Error, got bogus response\n" );
|
||||
Error( "Got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
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 )
|
||||
|
|
@ -198,7 +198,7 @@ sub sendCmd
|
|||
|
||||
if ( $cmp )
|
||||
{
|
||||
print( "Waiting for command complete\n" );
|
||||
Info( "Waiting for command complete\n" );
|
||||
my $max_wait = 10;
|
||||
my $now = time();
|
||||
while( 1 )
|
||||
|
|
@ -216,18 +216,18 @@ sub sendCmd
|
|||
{
|
||||
if ( ($resp[1] & 0xf0) == 0x50 )
|
||||
{
|
||||
printf( "Got command complete\n" );
|
||||
Info( "Got command complete\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
printf( "Error, got bogus response\n" );
|
||||
Error( "Got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
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 )
|
||||
|
|
@ -243,28 +243,28 @@ my $sync = 0xff;
|
|||
|
||||
sub cameraOff
|
||||
{
|
||||
print( "Camera Off\n" );
|
||||
Info( "Camera Off\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
print( "Camera On\n" );
|
||||
Info( "Camera On\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
print( "Stop\n" );
|
||||
Info( "Stop\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, 0x00, 0x03, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
Info( "Move Up\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x01, $sync );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -272,7 +272,7 @@ sub moveUp
|
|||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
Info( "Move Down\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -280,7 +280,7 @@ sub moveDown
|
|||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
Info( "Move Left\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x01, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -288,7 +288,7 @@ sub moveLeft
|
|||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
Info( "Move Right\n" );
|
||||
my $speed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x02, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -296,7 +296,7 @@ sub moveRight
|
|||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
Info( "Move Up/Left\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x01, $sync );
|
||||
|
|
@ -305,7 +305,7 @@ sub moveUpLeft
|
|||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
Info( "Move Up/Right\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x01, $sync );
|
||||
|
|
@ -314,7 +314,7 @@ sub moveUpRight
|
|||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
Info( "Move Down/Left\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x02, $sync );
|
||||
|
|
@ -323,7 +323,7 @@ sub moveDownLeft
|
|||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "Move Down/Right\n" );
|
||||
Info( "Move Down/Right\n" );
|
||||
my $panspeed = shift || 0x40;
|
||||
my $tiltspeed = shift || 0x40;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x02, $sync );
|
||||
|
|
@ -332,7 +332,7 @@ sub moveDownRight
|
|||
|
||||
sub stepUp
|
||||
{
|
||||
print( "Step Up\n" );
|
||||
Info( "Step Up\n" );
|
||||
my $step = shift;
|
||||
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 );
|
||||
|
|
@ -342,7 +342,7 @@ sub stepUp
|
|||
|
||||
sub stepDown
|
||||
{
|
||||
print( "Step Down\n" );
|
||||
Info( "Step Down\n" );
|
||||
my $step = shift;
|
||||
$step = -$step;
|
||||
my $speed = shift || 0x40;
|
||||
|
|
@ -352,7 +352,7 @@ sub stepDown
|
|||
|
||||
sub stepLeft
|
||||
{
|
||||
print( "Step Left\n" );
|
||||
Info( "Step Left\n" );
|
||||
my $step = shift;
|
||||
$step = -$step;
|
||||
my $speed = shift || 0x40;
|
||||
|
|
@ -362,7 +362,7 @@ sub stepLeft
|
|||
|
||||
sub stepRight
|
||||
{
|
||||
print( "Step Right\n" );
|
||||
Info( "Step Right\n" );
|
||||
my $step = shift;
|
||||
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 );
|
||||
|
|
@ -371,7 +371,7 @@ sub stepRight
|
|||
|
||||
sub stepUpLeft
|
||||
{
|
||||
print( "Step Up/Left\n" );
|
||||
Info( "Step Up/Left\n" );
|
||||
my $panstep = shift;
|
||||
$panstep = -$panstep;
|
||||
my $tiltstep = shift;
|
||||
|
|
@ -383,7 +383,7 @@ sub stepUpLeft
|
|||
|
||||
sub stepUpRight
|
||||
{
|
||||
print( "Step Up/Right\n" );
|
||||
Info( "Step Up/Right\n" );
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
my $panspeed = shift || 0x40;
|
||||
|
|
@ -394,7 +394,7 @@ sub stepUpRight
|
|||
|
||||
sub stepDownLeft
|
||||
{
|
||||
print( "Step Down/Left\n" );
|
||||
Info( "Step Down/Left\n" );
|
||||
my $panstep = shift;
|
||||
$panstep = -$panstep;
|
||||
my $tiltstep = shift;
|
||||
|
|
@ -407,7 +407,7 @@ sub stepDownLeft
|
|||
|
||||
sub stepDownRight
|
||||
{
|
||||
print( "Step Down/Right\n" );
|
||||
Info( "Step Down/Right\n" );
|
||||
my $panstep = shift;
|
||||
my $tiltstep = shift;
|
||||
$tiltstep = -$tiltstep;
|
||||
|
|
@ -419,7 +419,7 @@ sub stepDownRight
|
|||
|
||||
sub zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
Info( "Zoom Tele\n" );
|
||||
my $speed = shift || 0x06;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x20|$speed, $sync );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -427,7 +427,7 @@ sub zoomTele
|
|||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
Info( "Zoom Wide\n" );
|
||||
my $speed = shift || 0x06;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x30|$speed, $sync );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -435,7 +435,7 @@ sub zoomWide
|
|||
|
||||
sub zoomStop
|
||||
{
|
||||
print( "Zoom Stop\n" );
|
||||
Info( "Zoom Stop\n" );
|
||||
my $speed = shift || 0x06;
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x00, $sync );
|
||||
sendCmd( \@msg );
|
||||
|
|
@ -443,35 +443,35 @@ sub zoomStop
|
|||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
Info( "Focus Near\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
Info( "Focus Far\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusStop
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
Info( "Focus Far\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x00, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
Info( "Focus Auto\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x02, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Man\n" );
|
||||
Info( "Focus Man\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x03, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -479,7 +479,7 @@ sub focusMan
|
|||
sub presetClear
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
Info( "Clear Preset $preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x00, $preset, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -487,7 +487,7 @@ sub presetClear
|
|||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
Info( "Set Preset $preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x01, $preset, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -495,14 +495,14 @@ sub presetSet
|
|||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
Info( "Goto Preset $preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x02, $preset, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
Info( "Home Preset\n" );
|
||||
my @msg = ( 0x80|$address, 0x01, 0x06, 0x04, $sync );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
|
@ -621,7 +621,7 @@ elsif ( $command eq "preset_goto" )
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
Error( "Can't handle command $command\n" );
|
||||
}
|
||||
|
||||
$serial_port->close();
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ use bytes;
|
|||
# ==========================================================================
|
||||
|
||||
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 @_;
|
||||
Info @_;
|
||||
}
|
||||
sub start
|
||||
{
|
||||
|
|
@ -336,11 +336,11 @@ if ( !connect( CLIENT, $saddr ) )
|
|||
|
||||
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
|
||||
{
|
||||
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( ", signal $exit_signal" ) if ( $exit_signal );
|
||||
|
|
|
|||
|
|
@ -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
|
||||
#
|
||||
|
|
@ -239,7 +198,7 @@ select( LOG ); $| = 1;
|
|||
|
||||
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" );
|
||||
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ use DBI;
|
|||
use POSIX;
|
||||
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
|
||||
$ENV{PATH} = '/bin:/usr/bin';
|
||||
|
|
@ -332,45 +332,3 @@ sub runCommand
|
|||
}
|
||||
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 );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ use bytes;
|
|||
# ==========================================================================
|
||||
|
||||
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" );
|
||||
|
||||
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 $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
|
||||
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
||||
|
|
@ -205,7 +205,7 @@ while( 1 )
|
|||
my ( $alarm_x, $alarm_y ) = unpack( "ll", $alarm_pos );
|
||||
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 );
|
||||
Track( $monitor, $alarm_x, $alarm_y );
|
||||
Resume( $monitor );
|
||||
|
|
@ -215,14 +215,14 @@ while( 1 )
|
|||
}
|
||||
else
|
||||
{
|
||||
if ( VERBOSE && $alarmed )
|
||||
if ( DBG_LEVEL > 0 && $alarmed )
|
||||
{
|
||||
print( "Left alarm state\n" );
|
||||
$alarmed = undef;
|
||||
}
|
||||
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 );
|
||||
Return( $monitor );
|
||||
Resume( $monitor );
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ use bytes;
|
|||
# ==========================================================================
|
||||
|
||||
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
|
||||
# Ignore parser field for now.
|
||||
|
|
@ -79,9 +79,9 @@ open(STDERR, ">&LOG") || die( "Can't dup stderr: $!" );
|
|||
select( STDERR ); $| = 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 $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
|
|
@ -91,7 +91,7 @@ $SIG{HUP} = \&status;
|
|||
my $base_rin = '';
|
||||
foreach my $source ( @sources )
|
||||
{
|
||||
print( "Opening source '$source->{name}'\n" );
|
||||
Info( "Opening source '$source->{name}'\n" );
|
||||
if ( $source->{type} eq "inet" )
|
||||
{
|
||||
local *sfh;
|
||||
|
|
@ -151,18 +151,18 @@ while( 1 )
|
|||
my $nfound = select( my $rout = $rin, undef, my $eout = $ein, $timeout );
|
||||
if ( $nfound > 0 )
|
||||
{
|
||||
print( "Got input from $nfound sources\n" ) if ( VERBOSE );
|
||||
Debug( "Got input from $nfound sources\n" );
|
||||
foreach my $source ( @sources )
|
||||
{
|
||||
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" )
|
||||
{
|
||||
local *cfh;
|
||||
my $paddr = accept( *cfh, $source->{handle} );
|
||||
$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
|
||||
{
|
||||
|
|
@ -174,7 +174,7 @@ while( 1 )
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE );
|
||||
Debug( "Got '$buffer' ($nbytes bytes)\n" );
|
||||
handleMessage( $buffer );
|
||||
}
|
||||
}
|
||||
|
|
@ -182,7 +182,7 @@ while( 1 )
|
|||
}
|
||||
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) )
|
||||
{
|
||||
my $buffer;
|
||||
|
|
@ -190,12 +190,12 @@ while( 1 )
|
|||
if ( !$nbytes )
|
||||
{
|
||||
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} );
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE );
|
||||
Debug( "Got '$buffer' ($nbytes bytes)\n" );
|
||||
handleMessage( $buffer );
|
||||
}
|
||||
}
|
||||
|
|
@ -206,7 +206,7 @@ while( 1 )
|
|||
if ( $! == EINTR )
|
||||
{
|
||||
# Dead child, will be reaped
|
||||
#print( "Probable dead child\n" );
|
||||
#Info( "Probable dead child\n" );
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -215,32 +215,32 @@ while( 1 )
|
|||
}
|
||||
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();
|
||||
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}} )
|
||||
{
|
||||
print( "Found action '$action'\n" );
|
||||
Info( "Found action '$action'\n" );
|
||||
handleMessage( $action );
|
||||
}
|
||||
delete( $actions{$action_time} );
|
||||
}
|
||||
}
|
||||
}
|
||||
print( "Trigger daemon exiting\n" );
|
||||
Info( "Trigger daemon exiting\n" );
|
||||
|
||||
sub handleMessage
|
||||
{
|
||||
my $buffer = shift;
|
||||
#chomp( $buffer );
|
||||
|
||||
print( "Processing buffer '$buffer'\n" ) if ( VERBOSE );
|
||||
Debug( "Processing buffer '$buffer'\n" );
|
||||
foreach my $message ( split( /\r?\n/, $buffer ) )
|
||||
{
|
||||
next if ( !$message );
|
||||
print( "Processing message '$message'\n" ) if ( VERBOSE );
|
||||
Debug( "Processing message '$message'\n" );
|
||||
my ( $id, $action, $score, $cause, $text, $showtext ) = split( /\|/, $message );
|
||||
$score = 0 if ( !defined($score) );
|
||||
$cause = 0 if ( !defined($cause) );
|
||||
|
|
@ -251,29 +251,29 @@ sub handleMessage
|
|||
|
||||
if ( !$monitor )
|
||||
{
|
||||
print( "Can't find monitor '$id' for message '$message'\n" );
|
||||
Warning( "Can't find monitor '$id' for message '$message'\n" );
|
||||
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
|
||||
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
|
||||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
||||
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;
|
||||
}
|
||||
|
||||
my $shm_data_size;
|
||||
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 );
|
||||
}
|
||||
$shm_data_size = unpack( "l", $shm_data_size );
|
||||
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+))?$/ )
|
||||
{
|
||||
my $trigger = $1;
|
||||
|
|
@ -289,9 +289,9 @@ sub handleMessage
|
|||
}
|
||||
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 )
|
||||
{
|
||||
my $action_time = time()+$delay;
|
||||
|
|
@ -302,7 +302,7 @@ sub handleMessage
|
|||
$action_array = $actions{$action_time} = [];
|
||||
}
|
||||
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" )
|
||||
|
|
@ -318,22 +318,22 @@ sub handleMessage
|
|||
}
|
||||
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" )
|
||||
{
|
||||
my $trigger_data = pack( "Z32", $showtext );
|
||||
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
|
||||
{
|
||||
print( "Unrecognised action '$action' in message '$message'\n" );
|
||||
Error( "Unrecognised action '$action' in message '$message'\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ use bytes;
|
|||
# ==========================================================================
|
||||
|
||||
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();
|
||||
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;
|
||||
my $ua = LWP::UserAgent->new;
|
||||
|
|
@ -146,7 +146,7 @@ if ( $check && ZM_CHECK_FOR_UPDATES )
|
|||
chomp($last_version);
|
||||
$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 );
|
||||
|
||||
|
|
@ -162,7 +162,7 @@ if ( $check && ZM_CHECK_FOR_UPDATES )
|
|||
}
|
||||
else
|
||||
{
|
||||
print( "Error check failed: '".$res->status_line()."'\n" );
|
||||
Error( "Error check failed: '".$res->status_line()."'\n" );
|
||||
}
|
||||
}
|
||||
sleep( 3600 );
|
||||
|
|
@ -267,10 +267,10 @@ if ( $version )
|
|||
my $backup = ZM_DB_NAME."-".$version.".dump";
|
||||
$command .= " --add-drop-table --databases ".ZM_DB_NAME." > ".$backup;
|
||||
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 $status = $? >> 8;
|
||||
if ( $status || VERBOSE )
|
||||
if ( $status || DBG_LEVEL > 0 )
|
||||
{
|
||||
chomp( $output );
|
||||
print( "Output: $output\n" );
|
||||
|
|
@ -306,10 +306,10 @@ if ( $version )
|
|||
}
|
||||
$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 $status = $? >> 8;
|
||||
if ( $status || VERBOSE )
|
||||
if ( $status || DBG_LEVEL > 0 )
|
||||
{
|
||||
chomp( $output );
|
||||
print( "Output: $output\n" );
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
|
|
|
|||
|
|
@ -35,7 +35,8 @@ use bytes;
|
|||
# ==========================================================================
|
||||
|
||||
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: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
print( "Watchdog starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
print( "Watchdog pausing for ".START_DELAY." seconds\n" );
|
||||
Info( "Watchdog starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
||||
Info( "Watchdog pausing for ".START_DELAY." seconds\n" );
|
||||
sleep( START_DELAY );
|
||||
|
||||
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 );
|
||||
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;
|
||||
}
|
||||
my $image_time;
|
||||
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;
|
||||
}
|
||||
$image_time = unpack( "l", $image_time );
|
||||
|
||||
#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 );
|
||||
#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 $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 )
|
||||
{
|
||||
# Yes, so continue
|
||||
|
|
@ -134,11 +135,11 @@ while( 1 )
|
|||
{
|
||||
$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" );
|
||||
print( qx( $command ) );
|
||||
Info( "Restarting capture daemon ('$command'), time since last capture $image_delay seconds ($now-$image_time)\n" );
|
||||
Info( qx( $command ) );
|
||||
}
|
||||
}
|
||||
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();
|
||||
|
|
|
|||
|
|
@ -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( 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: $!" );
|
||||
unlink( main::X10_SOCK_FILE );
|
||||
|
|
@ -171,7 +171,7 @@ sub runServer
|
|||
bind( SERVER, $saddr ) or die( "Can't bind: $!" );
|
||||
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 );
|
||||
|
||||
|
|
@ -296,7 +296,7 @@ sub runServer
|
|||
my $state;
|
||||
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;
|
||||
next;
|
||||
}
|
||||
|
|
@ -306,12 +306,12 @@ sub runServer
|
|||
my $task_list;
|
||||
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"};
|
||||
}
|
||||
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"};
|
||||
}
|
||||
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( SERVER );
|
||||
exit();
|
||||
|
|
@ -359,7 +359,7 @@ sub addToDeviceList
|
|||
my $function = 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};
|
||||
if ( !$device )
|
||||
{
|
||||
|
|
@ -388,7 +388,7 @@ sub addToMonitorList
|
|||
my $function = 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};
|
||||
if ( !$device )
|
||||
{
|
||||
|
|
@ -413,7 +413,7 @@ sub loadTasks
|
|||
{
|
||||
%monitor_hash = ();
|
||||
|
||||
print( "Loading tasks\n" ) if ( main::VERBOSE );
|
||||
Debug( "Loading tasks\n" );
|
||||
# Clear out all old device task lists
|
||||
foreach my $unit_code ( sort( keys(%device_hash) ) )
|
||||
{
|
||||
|
|
@ -432,7 +432,7 @@ sub loadTasks
|
|||
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
||||
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;
|
||||
}
|
||||
|
||||
|
|
@ -440,10 +440,10 @@ sub loadTasks
|
|||
|
||||
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} ) )
|
||||
{
|
||||
#print( "Code string: $code_string\n" );
|
||||
#Debug( "Code string: $code_string\n" );
|
||||
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
|
||||
$limit = 0 if ( !$limit );
|
||||
if ( $unit_code )
|
||||
|
|
@ -461,10 +461,10 @@ sub loadTasks
|
|||
}
|
||||
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} ) )
|
||||
{
|
||||
#print( "Code string: $code_string\n" );
|
||||
#Debug( "Code string: $code_string\n" );
|
||||
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
|
||||
$limit = 0 if ( !$limit );
|
||||
if ( $unit_code )
|
||||
|
|
@ -482,10 +482,10 @@ sub loadTasks
|
|||
}
|
||||
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} ) )
|
||||
{
|
||||
#print( "Code string: $code_string\n" );
|
||||
#Debug( "Code string: $code_string\n" );
|
||||
my ( $invert, $unit_code, $modifier, $limit ) = ( $code_string =~ /^([!~])?(\d+)(?:([+-])(\d+)?)?$/ );
|
||||
$limit = 0 if ( !$limit );
|
||||
if ( $unit_code )
|
||||
|
|
@ -605,7 +605,7 @@ sub processTask
|
|||
my $force_data = pack( "llZ*", 1, 0, "X10" );
|
||||
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} )
|
||||
{
|
||||
|
|
@ -618,13 +618,13 @@ sub processTask
|
|||
my $force_data = pack( "llZ*", 0, 0, "" );
|
||||
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 )
|
||||
{
|
||||
print( "Executing command '$command'\n" );
|
||||
Info( "Executing command '$command'\n" );
|
||||
qx( $command );
|
||||
}
|
||||
}
|
||||
|
|
@ -651,7 +651,7 @@ sub dprint
|
|||
{
|
||||
print CLIENT @_
|
||||
}
|
||||
print @_;
|
||||
Info( @_ );
|
||||
}
|
||||
|
||||
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" );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue