Merge https://github.com/michaelbarkdoll/ZoneMinder into trendnet
This commit is contained in:
Isaac Connor
commit
70ba0ad342
|
|
@ -780,6 +780,7 @@ INSERT INTO `Controls` VALUES (NULL,'Reolink RLC-420','Ffmpeg','Reolink',0,0,1,0
|
|||
INSERT INTO `Controls` VALUES (NULL,'D-LINK DCS-3415','Remote','DCS3415',0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0);
|
||||
INSERT INTO `Controls` VALUES (NULL,'IOS Camera','Ffmpeg','IPCAMIOS',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0);
|
||||
INSERT INTO `Controls` VALUES (NULL,'Dericam P2','Ffmpeg','DericamP2',0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,10,0,1,1,1,0,0,0,1,1,0,0,0,0,1,1,45,0,0,1,0,0,0,0,1,1,45,0,0,0,0);
|
||||
INSERT INTO `Controls` VALUES (NULL,'Trendnet','Remote','Trendnet',1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0);
|
||||
--
|
||||
-- Add some monitor preset values
|
||||
--
|
||||
|
|
|
|||
|
|
@ -74,40 +74,37 @@ use ZoneMinder::Config qw(:all);
|
|||
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
sub open
|
||||
{
|
||||
sub open {
|
||||
my $self = shift;
|
||||
|
||||
$self->loadMonitor();
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{ua}->agent('ZoneMinder Control Agent/'.ZoneMinder::Base::ZM_VERSION);
|
||||
|
||||
$self->{state} = 'open';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
sub printMsg {
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
Debug($msg.'['.$msg_len.']');
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
sub sendCmd {
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
my $msg = shift;
|
||||
my $content_type = shift;
|
||||
my $result = undef;
|
||||
|
||||
printMsg( $cmd, "Tx" );
|
||||
printMsg($cmd, 'Tx');
|
||||
|
||||
my $server_endpoint = "http://".$self->{Monitor}->{ControlAddress}."/$cmd";
|
||||
my $req = HTTP::Request->new( POST => $server_endpoint );
|
||||
my $server_endpoint = 'http://'.$self->{Monitor}->{ControlAddress}.'/'.$cmd;
|
||||
my $req = HTTP::Request->new(POST => $server_endpoint);
|
||||
$req->header('content-type' => $content_type);
|
||||
$req->header('Host' => $self->{Monitor}->{ControlAddress});
|
||||
$req->header('content-length' => length($msg));
|
||||
|
|
@ -120,17 +117,16 @@ sub sendCmd
|
|||
if ( $res->is_success ) {
|
||||
$result = !undef;
|
||||
} else {
|
||||
Error( "After sending PTZ command, camera returned the following error:'".$res->status_line()."'" );
|
||||
Error("After sending PTZ command, camera returned the following error:'".$res->status_line()."'");
|
||||
}
|
||||
return( $result );
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub getCamParams
|
||||
{
|
||||
sub getCamParams {
|
||||
my $self = shift;
|
||||
my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><GetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken></GetImagingSettings></s:Body></s:Envelope>';
|
||||
my $server_endpoint = "http://".$self->{Monitor}->{ControlAddress}."/onvif/imaging";
|
||||
my $req = HTTP::Request->new( POST => $server_endpoint );
|
||||
my $server_endpoint = 'http://'.$self->{Monitor}->{ControlAddress}.'/onvif/imaging';
|
||||
my $req = HTTP::Request->new(POST => $server_endpoint);
|
||||
$req->header('content-type' => 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/GetImagingSettings"');
|
||||
$req->header('Host' => $self->{Monitor}->{ControlAddress});
|
||||
$req->header('content-length' => length($msg));
|
||||
|
|
@ -144,202 +140,185 @@ sub getCamParams
|
|||
# We should really use an xml or soap library to parse the xml tags
|
||||
my $content = $res->decoded_content;
|
||||
|
||||
if ($content =~ /.*<tt:(Brightness)>(.+)<\/tt:Brightness>.*/) {
|
||||
if ( $content =~ /.*<tt:(Brightness)>(.+)<\/tt:Brightness>.*/ ) {
|
||||
$CamParams{$1} = $2;
|
||||
}
|
||||
if ($content =~ /.*<tt:(Contrast)>(.+)<\/tt:Contrast>.*/) {
|
||||
if ( $content =~ /.*<tt:(Contrast)>(.+)<\/tt:Contrast>.*/ ) {
|
||||
$CamParams{$1} = $2;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Unable to retrieve camera image settings:'".$res->status_line()."'" );
|
||||
} else {
|
||||
Error("Unable to retrieve camera image settings:'".$res->status_line()."'");
|
||||
}
|
||||
}
|
||||
|
||||
#autoStop
|
||||
#This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab
|
||||
sub autoStop
|
||||
{
|
||||
sub autoStop {
|
||||
my $self = shift;
|
||||
my $autostop = shift;
|
||||
|
||||
if( $autostop ) {
|
||||
Debug( "Auto Stop" );
|
||||
if ( $autostop ) {
|
||||
Debug('Auto Stop');
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><Stop xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PanTilt>true</PanTilt><Zoom>false</Zoom></Stop></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
usleep( $autostop );
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
usleep($autostop);
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
}
|
||||
}
|
||||
|
||||
# Reset the Camera
|
||||
sub reset
|
||||
{
|
||||
Debug( "Camera Reset" );
|
||||
sub reset {
|
||||
Debug('Camera Reset');
|
||||
my $self = shift;
|
||||
my $cmd = "";
|
||||
my $cmd = '';
|
||||
my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SystemReboot xmlns="http://www.onvif.org/ver10/device/wsdl"/></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver10/device/wsdl/SystemReboot"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
}
|
||||
|
||||
#Up Arrow
|
||||
sub moveConUp
|
||||
{
|
||||
Debug( "Move Up" );
|
||||
sub moveConUp {
|
||||
Debug('Move Up');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Down Arrow
|
||||
sub moveConDown
|
||||
{
|
||||
Debug( "Move Down" );
|
||||
sub moveConDown {
|
||||
Debug('Move Down');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Left Arrow
|
||||
sub moveConLeft
|
||||
{
|
||||
Debug( "Move Left" );
|
||||
sub moveConLeft {
|
||||
Debug('Move Left');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.49" y="0" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Right Arrow
|
||||
sub moveConRight
|
||||
{
|
||||
Debug( "Move Right" );
|
||||
sub moveConRight {
|
||||
Debug('Move Right');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.49" y="0" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Zoom In
|
||||
sub zoomConTele
|
||||
{
|
||||
Debug( "Zoom Tele" );
|
||||
sub zoomConTele {
|
||||
Debug('Zoom Tele');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><Zoom x="0.49" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Zoom Out
|
||||
sub zoomConWide
|
||||
{
|
||||
Debug( "Zoom Wide" );
|
||||
sub zoomConWide {
|
||||
Debug('Zoom Wide');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><Zoom x="-0.49" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Diagonally Up Right Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConUpRight
|
||||
{
|
||||
Debug( "Move Diagonally Up Right" );
|
||||
sub moveConUpRight {
|
||||
Debug('Move Diagonally Up Right');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.5" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Diagonally Down Right Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConDownRight
|
||||
{
|
||||
Debug( "Move Diagonally Down Right" );
|
||||
sub moveConDownRight {
|
||||
Debug('Move Diagonally Down Right');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.5" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Diagonally Up Left Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConUpLeft
|
||||
{
|
||||
Debug( "Move Diagonally Up Left" );
|
||||
sub moveConUpLeft {
|
||||
Debug('Move Diagonally Up Left');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.5" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Diagonally Down Left Arrow
|
||||
#This camera does not have builtin diagonal commands so we emulate them
|
||||
sub moveConDownLeft
|
||||
{
|
||||
Debug( "Move Diagonally Down Left" );
|
||||
sub moveConDownLeft {
|
||||
Debug('Move Diagonally Down Left');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.5" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
$self->autoStop($self->{Monitor}->{AutoStopTimeout});
|
||||
}
|
||||
|
||||
#Stop
|
||||
sub moveStop
|
||||
{
|
||||
Debug( "Move Stop" );
|
||||
sub moveStop {
|
||||
Debug('Move Stop');
|
||||
my $self = shift;
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><Stop xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PanTilt>true</PanTilt><Zoom>false</Zoom></Stop></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
}
|
||||
|
||||
#Set Camera Preset
|
||||
sub presetSet
|
||||
{
|
||||
sub presetSet {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Set Preset $preset" );
|
||||
my $preset = $self->getParam($params, 'preset');
|
||||
Debug("Set Preset $preset");
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetPreset xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PresetToken>'.$preset.'</PresetToken></SetPreset></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/SetPreset"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
$self->sendCmd($cmd, $msg, $content_type);
|
||||
}
|
||||
|
||||
#Recall Camera Preset
|
||||
sub presetGoto
|
||||
{
|
||||
sub presetGoto {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $preset = $self->getParam($params, 'preset');
|
||||
Debug("Goto Preset $preset");
|
||||
my $cmd = 'onvif/PTZ';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><GotoPreset xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PresetToken>'.$preset.'</PresetToken></GotoPreset></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/GotoPreset"';
|
||||
|
|
@ -348,45 +327,42 @@ sub presetGoto
|
|||
|
||||
#Horizontal Patrol
|
||||
#To be determined if this camera supports this feature
|
||||
sub horizontalPatrol
|
||||
{
|
||||
Debug( "Horizontal Patrol" );
|
||||
sub horizontalPatrol {
|
||||
Debug('Horizontal Patrol');
|
||||
my $self = shift;
|
||||
my $cmd = '';
|
||||
my $msg ='';
|
||||
my $content_type = '';
|
||||
# $self->sendCmd( $cmd, $msg, $content_type );
|
||||
Error( "PTZ Command not implemented in control script." );
|
||||
# $self->sendCmd( $cmd, $msg, $content_type );
|
||||
Error('PTZ Command not implemented in control script.');
|
||||
}
|
||||
|
||||
#Horizontal Patrol Stop
|
||||
#To be determined if this camera supports this feature
|
||||
sub horizontalPatrolStop
|
||||
{
|
||||
Debug( "Horizontal Patrol Stop" );
|
||||
sub horizontalPatrolStop {
|
||||
Debug('Horizontal Patrol Stop');
|
||||
my $self = shift;
|
||||
my $cmd = '';
|
||||
my $msg ='';
|
||||
my $content_type = '';
|
||||
# $self->sendCmd( $cmd, $msg, $content_type );
|
||||
Error( "PTZ Command not implemented in control script." );
|
||||
# $self->sendCmd( $cmd, $msg, $content_type );
|
||||
Error('PTZ Command not implemented in control script.');
|
||||
}
|
||||
|
||||
# Increase Brightness
|
||||
sub irisAbsOpen
|
||||
{
|
||||
Debug( "Iris $CamParams{'Brightness'}" );
|
||||
sub irisAbsOpen {
|
||||
Debug("Iris $CamParams{Brightness}");
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'Brightness'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
$self->getCamParams() unless($CamParams{Brightness});
|
||||
my $step = $self->getParam($params, 'step');
|
||||
my $max = 100;
|
||||
|
||||
$CamParams{'Brightness'} += $step;
|
||||
$CamParams{'Brightness'} = $max if ($CamParams{'Brightness'} > $max);
|
||||
$CamParams{Brightness} += $step;
|
||||
$CamParams{Brightness} = $max if ($CamParams{Brightness} > $max);
|
||||
|
||||
my $cmd = 'onvif/imaging';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Brightness'}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Brightness}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
}
|
||||
|
|
@ -394,57 +370,55 @@ sub irisAbsOpen
|
|||
# Decrease Brightness
|
||||
sub irisAbsClose
|
||||
{
|
||||
Debug( "Iris $CamParams{'Brightness'}" );
|
||||
Debug( "Iris $CamParams{Brightness}" );
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'brightness'});
|
||||
$self->getCamParams() unless($CamParams{brightness});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
my $min = 0;
|
||||
|
||||
$CamParams{'Brightness'} -= $step;
|
||||
$CamParams{'Brightness'} = $min if ($CamParams{'Brightness'} < $min);
|
||||
$CamParams{Brightness} -= $step;
|
||||
$CamParams{Brightness} = $min if ($CamParams{Brightness} < $min);
|
||||
|
||||
my $cmd = 'onvif/imaging';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Brightness'}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Brightness}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
|
||||
$self->sendCmd( $cmd, $msg, $content_type );
|
||||
}
|
||||
|
||||
# Increase Contrast
|
||||
sub whiteAbsIn
|
||||
{
|
||||
Debug( "Iris $CamParams{'Contrast'}" );
|
||||
sub whiteAbsIn {
|
||||
Debug("Iris $CamParams{Contrast}");
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'Contrast'});
|
||||
$self->getCamParams() unless($CamParams{Contrast});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
my $max = 100;
|
||||
|
||||
$CamParams{'Contrast'} += $step;
|
||||
$CamParams{'Contrast'} = $max if ($CamParams{'Contrast'} > $max);
|
||||
$CamParams{Contrast} += $step;
|
||||
$CamParams{Contrast} = $max if ($CamParams{Contrast} > $max);
|
||||
|
||||
my $cmd = 'onvif/imaging';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Contrast'}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Contrast}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
|
||||
}
|
||||
|
||||
# Decrease Contrast
|
||||
sub whiteAbsOut
|
||||
{
|
||||
Debug( "Iris $CamParams{'Contrast'}" );
|
||||
sub whiteAbsOut {
|
||||
Debug("Iris $CamParams{Contrast}");
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
$self->getCamParams() unless($CamParams{'Contrast'});
|
||||
my $step = $self->getParam( $params, 'step' );
|
||||
$self->getCamParams() unless($CamParams{Contrast});
|
||||
my $step = $self->getParam($params, 'step');
|
||||
my $min = 0;
|
||||
|
||||
$CamParams{'Contrast'} -= $step;
|
||||
$CamParams{'Contrast'} = $min if ($CamParams{'Contrast'} < $min);
|
||||
$CamParams{Contrast} -= $step;
|
||||
$CamParams{Contrast} = $min if ($CamParams{Contrast} < $min);
|
||||
|
||||
my $cmd = 'onvif/imaging';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Contrast'}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Contrast}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
|
||||
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
|
|
|||
|
|
@ -0,0 +1,590 @@
|
|||
# =========================================================================
|
||||
#
|
||||
# ZoneMinder Trendnet TV-IP672WI IP Control Protocol Module, $Date: $, $Revision: $
|
||||
# Copyright (C) 2014 Vincent Giovannone
|
||||
# Updated 2017 Michael Barkdoll
|
||||
#
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Trendnet TV-IP672WI IP camera control
|
||||
# protocol.
|
||||
#
|
||||
# Tested on Zoneminder 1.30.4
|
||||
#
|
||||
# Under control capability:
|
||||
#
|
||||
# * Main: name it (suggest TVIP672WI), type is FFMPEG (or remote if you're using MJPEG), protocol is TVIP672WI
|
||||
# * Main (more): Can wake, can sleep, can reset
|
||||
# * Move: Can move, can move diagonally, can move mapped, can move relative
|
||||
# * Pan: Can pan
|
||||
# * Tilt: Can tilt
|
||||
#
|
||||
# * Presets: Has presets, num presets 20, has home preset (don't set presets via camera's web server, only set via ZM.)
|
||||
# (I didn't test/use presets -MB)
|
||||
#
|
||||
# Under control tab in the monitor itself:
|
||||
#
|
||||
# * Controllable
|
||||
# * Control type is the name you gave it in control capability above
|
||||
# * Control device is the username and password you use to authenticate to the camera
|
||||
# E.g., admin:password
|
||||
#
|
||||
# * Control address is the camera's ip address AND web port
|
||||
# E.g., 192.168.1.100:80
|
||||
# Optionally, it can parse all username and password with the following format:
|
||||
# http://admin:password@192.168.1.100:80
|
||||
#
|
||||
#
|
||||
# If using with anything but a TV-IP672WI (ex: TV-IP672PI), YOU MUST MATCH THE REALM TO MATCH YOUR CAMERA FURTHER DOWN!
|
||||
#
|
||||
#
|
||||
# Due to how the TVIP672 represents presets internally, you MUST define the presets in order... i.e. 1,2,3,4... not 1,10,3,4.
|
||||
# (see much further down for why, if you care...)
|
||||
#
|
||||
# Install this file with the following commands:
|
||||
#
|
||||
# sudo cp TVIP672WI.pm /usr/share/perl5/ZoneMinder/Control/
|
||||
# sudo chmod 755 /usr/share/perl5/ZoneMinder/Control/TVIP672WI.pm
|
||||
|
||||
|
||||
package ZoneMinder::Control::TVIP672WI;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require ZoneMinder::Base;
|
||||
require ZoneMinder::Control;
|
||||
|
||||
our @ISA = qw(ZoneMinder::Control);
|
||||
|
||||
#
|
||||
# ******** YOU MUST CHANGE THE FOLLOWING LINES TO MATCH YOUR CAMERA! **********
|
||||
#
|
||||
# I assume that "TV-IP672WI" would work for the TV-IP672PI, but can't test since I don't own one.
|
||||
#
|
||||
# TV-IP672WI works for the WI version, of course.
|
||||
#
|
||||
# Finally, the username is the username you'd like to authenticate as.
|
||||
#
|
||||
#our $REALM = 'TV-IP862IC';
|
||||
#our $REALM = 'TV-IP672PI';
|
||||
|
||||
our $REALM = 'TV-IP672WI';
|
||||
#our $REALM = 'TVIP672WI';
|
||||
|
||||
# $USERNAME and $PASSWORD are parsed from ControlDevice field in GUI
|
||||
# E.g., username:password
|
||||
# Note: values defined below are overriden by GUI values
|
||||
our $USERNAME = '';
|
||||
our $PASSWORD = '';
|
||||
|
||||
# $ADDRESS is parsed from field, 'Control Address'
|
||||
our $ADDRESS = '';
|
||||
|
||||
# ==========================================================================
|
||||
#
|
||||
# Trendnet TV-IP672PI Control Protocol
|
||||
#
|
||||
# ==========================================================================
|
||||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $self = ZoneMinder::Control->new( $id );
|
||||
bless( $self, $class );
|
||||
srand( time() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
our $AUTOLOAD;
|
||||
|
||||
sub AUTOLOAD
|
||||
{
|
||||
my $self = shift;
|
||||
my $class = ref($self) || croak( "$self not object" );
|
||||
my $name = $AUTOLOAD;
|
||||
$name =~ s/.*://;
|
||||
if ( exists($self->{$name}) )
|
||||
{
|
||||
return( $self->{$name} );
|
||||
}
|
||||
Fatal( "Can't access $name member of object of class $class" );
|
||||
}
|
||||
|
||||
sub open
|
||||
{
|
||||
my $self = shift;
|
||||
$self->loadMonitor();
|
||||
|
||||
my $controldevice = $self->{Monitor}->{ControlDevice};
|
||||
if ( $controldevice && $controldevice =~ m/\:/ ) {
|
||||
my ( $adminname, $lastpass )
|
||||
= split(/\:/, $controldevice, 2);
|
||||
if ( $adminname ) {
|
||||
$USERNAME = $adminname;
|
||||
#Error( "Username updated to: " . $USERNAME );
|
||||
}
|
||||
if ( $lastpass ) {
|
||||
$PASSWORD = $lastpass;
|
||||
#Error( "Password updated to: " . $PASSWORD );
|
||||
}
|
||||
} else {
|
||||
if ( $controldevice ) {
|
||||
$PASSWORD = $controldevice;
|
||||
#Error( "Password updated to: " . $PASSWORD );
|
||||
} else {
|
||||
Error ( "Unable to parse Control Device field: " . $controldevice );
|
||||
}
|
||||
}
|
||||
|
||||
my ( $protocol, $username, $password, $address )
|
||||
= $self->{Monitor}->{ControlAddress} =~ /^(http?:\/\/)?([^:]+):([^\/@]+)@(.*)$/;
|
||||
if ( ( $username ) && ( $password ) && ( $address ) ) {
|
||||
$USERNAME = $username;
|
||||
$PASSWORD = $password;
|
||||
$ADDRESS = $address;
|
||||
#Error( "Set USERNAME: " . $USERNAME . "PASSWORD: " . $PASSWORD . "ADDRESS: " . $ADDRESS );
|
||||
} else {
|
||||
if ( ! ( $controldevice ) ) {
|
||||
Error( "Failed to parse auth from address");
|
||||
Error( "Unable to pull username and password for authentication from fields ControlAddress or ControlDevice" );
|
||||
Error( "Control script attempts to pull these values from field ControlDevice as username:password" );
|
||||
Error( "Optionally, these values can also be set at /usr/share/perl5/ZoneMinder/Control/TVIP672WI.pm" );
|
||||
}
|
||||
$ADDRESS = $self->{Monitor}->{ControlAddress};
|
||||
}
|
||||
if ( ! ( $ADDRESS =~ m/\:/ ) ) {
|
||||
$ADDRESS .= ':80';
|
||||
Debug( "You generally need to also specify the port. I will append :80" );
|
||||
}
|
||||
|
||||
Debug ( "Address is now: " . $ADDRESS );
|
||||
|
||||
use LWP::UserAgent;
|
||||
use HTTP::Request::Common;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{state} = 'open';
|
||||
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
|
||||
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
|
||||
|
||||
# Detect REALM
|
||||
my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/cgi/ptdc.cgi" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( ! $res->is_success ) {
|
||||
Debug("Need newer REALM");
|
||||
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
my $headers = $res->headers();
|
||||
foreach my $k ( keys %$headers ) {
|
||||
Error("Initial Header $k => $$headers{$k}");
|
||||
} # end foreach
|
||||
if ( $$headers{'www-authenticate'} ) {
|
||||
my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
|
||||
if ( $tokens =~ /\w+="([^"]+)"/i ) {
|
||||
$REALM = $1;
|
||||
Debug( "Changing REALM to $REALM" );
|
||||
$self->{ua}->credentials($ADDRESS, $REALM, $USERNAME, $PASSWORD);
|
||||
my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/cgi/ptdc.cgi" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
if ( ! $res->is_success ) {
|
||||
Error ( "Unable to authenticate!!!" );
|
||||
}
|
||||
} # end if
|
||||
} else {
|
||||
Error("No headers line");
|
||||
} # end if headers
|
||||
} # end if $res->status_line() eq '401 Unauthorized'
|
||||
} # end if ! $res->is_success
|
||||
}
|
||||
|
||||
sub close
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
|
||||
# This routine is used for all moving, which are all GET commands...
|
||||
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
# Assuming you've placed your camera on a secure vlan network for ip cameras...
|
||||
my $url = "http://".$USERNAME.":".$PASSWORD."@".$ADDRESS."/cgi/ptdc.cgi?command=".$cmd;
|
||||
# The following didn't work with the TV-IP672WI; required authentication despite previous auth
|
||||
#my $url = "http://".$ADDRESS."/cgi/ptdc.cgi?command=".$cmd;
|
||||
my $req = HTTP::Request->new( GET=>$url );
|
||||
|
||||
Debug ("sendCmd command: " . $url );
|
||||
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success ) {
|
||||
$result = !undef;
|
||||
} else {
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
Debug( "Error check failed, trying again: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
Debug("Content was " . $res->content() );
|
||||
my $res = $self->{ua}->request($req);
|
||||
if ( $res->is_success ) {
|
||||
$result = !undef;
|
||||
} else {
|
||||
Debug("Content was " . $res->content() );
|
||||
}
|
||||
}
|
||||
if ( ! $result ) {
|
||||
Debug( "Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
|
||||
}
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub sendCmdPost
|
||||
{
|
||||
|
||||
#
|
||||
# This routine is used for setting/clearing presets and IR commands, which are POST commands...
|
||||
#
|
||||
|
||||
my $self = shift;
|
||||
my $url = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
if ($url eq undef)
|
||||
{
|
||||
Error ("url passed to sendCmdPost is undefined.");
|
||||
return(-1);
|
||||
}
|
||||
|
||||
Debug ("sendCmdPost url: " . $url . " cmd: " . $cmd);
|
||||
|
||||
my $req = HTTP::Request->new(POST => "http://".$ADDRESS.$url);
|
||||
$req->content_type('application/x-www-form-urlencoded');
|
||||
$req->content($cmd);
|
||||
|
||||
Debug ( "sendCmdPost credentials control address:'".$ADDRESS."' realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
|
||||
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "sendCmdPost Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
} else {
|
||||
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
} # endif
|
||||
}
|
||||
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub move
|
||||
{
|
||||
my $self = shift;
|
||||
my $panSteps = shift;
|
||||
my $tiltSteps = shift;
|
||||
|
||||
my $cmd = "set_relative_pos&posX=$panSteps&posY=$tiltSteps";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub moveRelUpLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up Left" );
|
||||
$self->move(-3, 3);
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
$self->move(0, 3);
|
||||
}
|
||||
|
||||
sub moveRelUpRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Up Right" );
|
||||
$self->move(3, 3);
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
$self->move(-3, 0);
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
$self->move(3, 0);
|
||||
}
|
||||
|
||||
sub moveRelDownLeft
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down Left" );
|
||||
$self->move(-3, -3);
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
$self->move(0, -3);
|
||||
}
|
||||
|
||||
sub moveRelDownRight
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Move Down Right" );
|
||||
$self->move(3, -3);
|
||||
}
|
||||
|
||||
|
||||
# moves the camera to center on the point that the user clicked on in the video image.
|
||||
# This isn't mega accurate but good enough for most purposes
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
|
||||
# If the camera moves too much, increase hscale and vscale. (...if it doesn't move enough, try decreasing!)
|
||||
# They scale the movement and are here to compensate for manufacturing variation.
|
||||
# It's never going to be perfect, so just get somewhere in the ballpark and call it a day.
|
||||
# (Don't forget to kill the zmcontrol process while tweaking!)
|
||||
|
||||
# 1280x800
|
||||
my $hscale = 31;
|
||||
my $vscale = 25;
|
||||
|
||||
# 1280x800 with fisheye
|
||||
#my $hscale = 15;
|
||||
#my $vscale = 15;
|
||||
|
||||
# 640x400
|
||||
#my $hscale = 14;
|
||||
#my $vscale = 12;
|
||||
|
||||
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $xcoord = $self->getParam( $params, 'xcoord' );
|
||||
my $ycoord = $self->getParam( $params, 'ycoord' );
|
||||
|
||||
my $hor = ($xcoord - ($self->{Monitor}->{Width} / 2))/$hscale;
|
||||
my $ver = ($ycoord - ($self->{Monitor}->{Height} / 2))/$vscale;
|
||||
|
||||
$hor = int($hor);
|
||||
$ver = -1 * int($ver);
|
||||
|
||||
Debug( "Move Map to $xcoord,$ycoord, hor=$hor, ver=$ver" );
|
||||
$self->move( $hor, $ver );
|
||||
}
|
||||
|
||||
|
||||
# **** PRESETS ****
|
||||
#
|
||||
# OK, presets work a little funky but they DO work, provided you define them in order and don't skip any.
|
||||
#
|
||||
# The problem is that when you load the web page for this camera, it gives a list of preset names tied to index numbers.
|
||||
# So let's say you have four presets... A, B, C, and D, and defined them in that order.
|
||||
# So A is index 0, B is index 1, C is index 2, D is index 3. When you tell the camera to go to a preset, you actually tell it by number, not by name.
|
||||
# (So "Go to D" is really "go to index 3".)
|
||||
#
|
||||
# Now let's say somebody deletes C via the camera's web GUI. The camera re-numbers the existing presets A=0, B=1, D=2.
|
||||
# There's really no easy way for ZM to discover this re-numbering, so zoneminder would still send "go to preset 3" thinking
|
||||
# it's telling the camera to go to point D. In actuality it's telling the camera to go to a preset that no longer exists.
|
||||
#
|
||||
# As long as you define your presets in order (i.e. define preset 1, then preset 2, then preset 3, etc.) everything will work just
|
||||
# fine in ZoneMinder.
|
||||
#
|
||||
# (Home preset needs to be set via the camera's web gui, and is unaffected by any of this.)
|
||||
#
|
||||
# So that's the limitation: DEFINE YOUR PRESETS IN ORDER THROUGH (and only through!) ZM AND DON'T SKIP ANY.
|
||||
#
|
||||
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $cmd = "presetName=$preset&command=del";
|
||||
my $url = "/eng/admin/cam_control.cgi";
|
||||
Debug ("presetClear: " . $preset . " cmd: " . $cmd);
|
||||
$self->sendCmdPost($url,$cmd);
|
||||
}
|
||||
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $cmd = "presetName=$preset&command=add";
|
||||
my $url = "/eng/admin/cam_control.cgi";
|
||||
Debug ("presetSet " . $preset . " cmd: " . $cmd);
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
$preset = $preset - 1;
|
||||
Debug( "Goto Preset $preset" );
|
||||
my $cmd = "goto_preset_position&index=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "go_home";
|
||||
$self->sendCmd( $cmd );
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# **** IR CONTROLS ****
|
||||
#
|
||||
#
|
||||
# Wake: Force IR on, always. (always night mode)
|
||||
#
|
||||
# Sleep: Force IR off, always. (always day mode)
|
||||
#
|
||||
# Reset: Automatic IR mode. (day/night mode determined by camera)
|
||||
#
|
||||
|
||||
|
||||
sub wake
|
||||
{
|
||||
# force IR on ("always night mode")
|
||||
|
||||
my $self = shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=3";
|
||||
|
||||
Debug("Wake -- IR on");
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
sub sleep
|
||||
{
|
||||
# force IR off ("always day mode")
|
||||
|
||||
my $self=shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=2";
|
||||
|
||||
Debug("Sleep -- IR off");
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
# IR auto
|
||||
|
||||
my $self=shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=0";
|
||||
|
||||
Debug("Reset -- IR auto");
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ZoneMinder::Database - Perl extension for Trendnet TVIP672
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
stuff this in /usr/share/perl5/ZoneMinder/Control , then eat a sandwich
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Stub documentation for Trendnet TVIP672, created by Vince, updated by Michael.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Read the comments at the beginning of this file to see the usage for zoneminder 1.25.0
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Vincent Giovannone, I'd rather you not email me; sure no problem...
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2014 by Vincent Giovannone
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
# =========================================================================
|
||||
#===========================================================================
|
||||
#
|
||||
# ZoneMinder Trendnet TV-IP862IC IP Control Protocol Module, $Date: $, $Revision: $
|
||||
# Copyright (C) 2014 Vincent Giovannone
|
||||
|
|
@ -17,10 +17,8 @@
|
|||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the Trendnet TV-IP672PI IP camera control
|
||||
# protocol. Also works or TV-IP862IC
|
||||
#
|
||||
# For Zoneminder 1.26+
|
||||
# This module contains the implementation of the Trendnet # IP camera control
|
||||
# protocol. Has been testing with TV-IP862IC and TV-IP672PI
|
||||
#
|
||||
# Under control capability:
|
||||
#
|
||||
|
|
@ -33,20 +31,17 @@
|
|||
#
|
||||
# Under control tab in the monitor itself:
|
||||
#
|
||||
# * Controllable
|
||||
# * Control type is the name you gave it in control capability above
|
||||
# * Control device is the password you use to authenticate to the camera (see further below if you need to change the username from "admin")
|
||||
# * Control address is the camera's ip address AND web port. example: 192.168.1.1:80
|
||||
#
|
||||
#
|
||||
# If using with anything but a TV-IP672PI (ex: TV-IP672WI), YOU MUST MATCH THE REALM TO MATCH YOUR CAMERA FURTHER DOWN!
|
||||
# Controllable
|
||||
# Control type is the name you gave it in control capability above
|
||||
# Control address is the camera's ip address AND web port. example: 192.168.1.1:80
|
||||
# You can also put the authentication information here and change the
|
||||
# protocol to https using something like https://admin:password@192.168.1.1:80
|
||||
#
|
||||
#
|
||||
# Due to how the TVIP672 represents presets internally, you MUST define the presets in order... i.e. 1,2,3,4... not 1,10,3,4.
|
||||
# (see much further down for why, if you care...)
|
||||
#
|
||||
|
||||
|
||||
package ZoneMinder::Control::TVIP862;
|
||||
|
||||
use 5.006;
|
||||
|
|
@ -61,13 +56,14 @@ our @ISA = qw(ZoneMinder::Control);
|
|||
#
|
||||
# ******** YOU MUST CHANGE THE FOLLOWING LINES TO MATCH YOUR CAMERA! **********
|
||||
#
|
||||
# I assume that "TV-IP672WI" would work for the TV-IP672WI, but can't test since I don't own one.
|
||||
# You do not need to change the REALM, but you can get slightly faster response
|
||||
# by setting so that the first auth request succeeds.
|
||||
#
|
||||
# TV-IP672PI works for the PI version, of course.
|
||||
#
|
||||
# Finally, the username is the username you'd like to authenticate as.
|
||||
# The username and password should be passed in the ControlDevice field but you
|
||||
# can set them here if you want.
|
||||
#
|
||||
our $REALM = 'TV-IP862IC';
|
||||
our $PROTOCOL = 'http://';
|
||||
our $USERNAME = 'admin';
|
||||
our $PASSWORD = '';
|
||||
our $ADDRESS = '';
|
||||
|
|
@ -81,31 +77,29 @@ our $ADDRESS = '';
|
|||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
|
||||
sub open
|
||||
{
|
||||
sub open {
|
||||
my $self = shift;
|
||||
$self->loadMonitor();
|
||||
|
||||
my ( $protocol, $username, $password, $address )
|
||||
= $self->{Monitor}->{ControlAddress} =~ /^(https?:\/\/)?([^:]+):([^\/@]+)@(.*)$/;
|
||||
if ( $username ) {
|
||||
$USERNAME = $username;
|
||||
$PASSWORD = $password;
|
||||
$ADDRESS = $address;
|
||||
if ( ( $self->{Monitor}->{ControlAddress} =~ /^(?<PROTOCOL>https?:\/\/)?(?<USERNAME>[^:@]+)?:?(?<PASSWORD>[^\/@]+)?@?(?<ADDRESS>.*)$/ ) ) {
|
||||
$PROTOCOL = $+{PROTOCOL} if $+{PROTOCOL};
|
||||
$USERNAME = $+{USERNAME} if $+{USERNAME};
|
||||
$PASSWORD = $+{PASSWORD} if $+{PASSWORD};
|
||||
$ADDRESS = $+{ADDRESS} if $+{ADDRESS};
|
||||
} else {
|
||||
Error( "Failed to parse auth from address");
|
||||
Error('Failed to parse auth from address ' . $self->{Monitor}->{ControlAddress});
|
||||
$ADDRESS = $self->{Monitor}->{ControlAddress};
|
||||
}
|
||||
if ( ! $ADDRESS =~ /:/ ) {
|
||||
Error( "You generally need to also specify the port. I will append :80" );
|
||||
if ( !($ADDRESS =~ /:/) ) {
|
||||
Error('You generally need to also specify the port. I will append :80');
|
||||
$ADDRESS .= ':80';
|
||||
}
|
||||
|
||||
use LWP::UserAgent;
|
||||
$self->{ua} = LWP::UserAgent->new;
|
||||
$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION );
|
||||
$self->{state} = 'open';
|
||||
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
|
||||
$self->{ua}->agent('ZoneMinder Control Agent/'.$ZoneMinder::Base::ZM_VERSION);
|
||||
$self->{state} = 'closed';
|
||||
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
|
||||
Debug ( "sendCmd credentials control address:'".$ADDRESS
|
||||
."' realm:'" . $REALM
|
||||
. "' username:'" . $USERNAME
|
||||
|
|
@ -115,199 +109,172 @@ sub open
|
|||
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
|
||||
|
||||
# Detect REALM
|
||||
my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/cgi/ptdc.cgi" );
|
||||
my $res = $self->{ua}->request($req);
|
||||
my $res = $self->{ua}->get($PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi');
|
||||
|
||||
if ( $res->is_success ) {
|
||||
$self->{state} = 'open';
|
||||
return;
|
||||
}
|
||||
|
||||
if ( ! $res->is_success ) {
|
||||
Debug("Need newer REALM");
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
|
||||
my $headers = $res->headers();
|
||||
foreach my $k ( keys %$headers ) {
|
||||
Debug("Initial Header $k => $$headers{$k}");
|
||||
} # end foreach
|
||||
}
|
||||
|
||||
if ( $$headers{'www-authenticate'} ) {
|
||||
my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
|
||||
if ( $tokens =~ /\w+="([^"]+)"/i ) {
|
||||
if ( $REALM ne $1 ) {
|
||||
$REALM = $1;
|
||||
Debug( "Changing REALM to $REALM" );
|
||||
Debug("Changing REALM to $REALM");
|
||||
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
|
||||
$res = $self->{ua}->get($PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi');
|
||||
if ( $res->is_success() ) {
|
||||
$self->{state} = 'open';
|
||||
return;
|
||||
}
|
||||
Error('Authentication still failed after updating REALM' . $res->status_line);
|
||||
$headers = $res->headers();
|
||||
foreach my $k ( keys %$headers ) {
|
||||
Debug("Initial Header $k => $$headers{$k}");
|
||||
} # end foreach
|
||||
} else {
|
||||
Error('Authentication failed, not a REALM problem');
|
||||
}
|
||||
} else {
|
||||
Error('Failed to match realm in tokens');
|
||||
} # end if
|
||||
} else {
|
||||
Debug("No headers line");
|
||||
Debug('No headers line');
|
||||
} # end if headers
|
||||
} # end if $res->status_line() eq '401 Unauthorized'
|
||||
} # end if ! $res->is_success
|
||||
}
|
||||
} # end sub open
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
sub printMsg {
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
Debug($msg.'['.$msg_len.']');
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
sub sendCmd {
|
||||
|
||||
# This routine is used for all moving, which are all GET commands...
|
||||
# This routine is used for all moving, which are all GET commands...
|
||||
|
||||
my $self = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
my $url = "http://".$ADDRESS."/cgi/ptdc.cgi?command=".$cmd;
|
||||
my $req = HTTP::Request->new( GET=>$url );
|
||||
|
||||
Debug ("sendCmd command: " . $url );
|
||||
|
||||
my $res = $self->{ua}->request($req);
|
||||
my $url = $PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi?command='.$cmd;
|
||||
my $res = $self->{ua}->get($url);
|
||||
|
||||
Debug('sendCmd command: ' . $url);
|
||||
if ( $res->is_success ) {
|
||||
$result = !undef;
|
||||
} else {
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
Error( "Error check failed, trying again: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
Error("Content was " . $res->content() );
|
||||
my $res = $self->{ua}->request($req);
|
||||
if ( $res->is_success ) {
|
||||
$result = !undef;
|
||||
} else {
|
||||
Error("Content was " . $res->content() );
|
||||
return !undef;
|
||||
}
|
||||
}
|
||||
if ( ! $result ) {
|
||||
Error( "Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
|
||||
}
|
||||
}
|
||||
|
||||
return( $result );
|
||||
Error("Error check failed: '".$res->status_line()."' cmd:'".$cmd."'");
|
||||
return;
|
||||
}
|
||||
|
||||
sub sendCmdPost {
|
||||
|
||||
|
||||
sub sendCmdPost
|
||||
{
|
||||
|
||||
#
|
||||
# This routine is used for setting/clearing presets and IR commands, which are POST commands...
|
||||
#
|
||||
#
|
||||
# This routine is used for setting/clearing presets and IR commands, which are POST commands...
|
||||
#
|
||||
|
||||
my $self = shift;
|
||||
my $url = shift;
|
||||
my $cmd = shift;
|
||||
my $form = shift;
|
||||
|
||||
my $result = undef;
|
||||
|
||||
if ($url eq undef)
|
||||
{
|
||||
Error ("url passed to sendCmdPost is undefined.");
|
||||
return(-1);
|
||||
if ( $url eq undef ) {
|
||||
Error('url passed to sendCmdPost is undefined.');
|
||||
return -1;
|
||||
}
|
||||
|
||||
Debug ("sendCmdPost url: " . $url . " cmd: " . $cmd);
|
||||
#Debug('sendCmdPost url: ' . $url . ' cmd: ' . $cmd);
|
||||
|
||||
my $req = HTTP::Request->new(POST => "http://".$ADDRESS.$url);
|
||||
$req->content_type('application/x-www-form-urlencoded');
|
||||
$req->content($cmd);
|
||||
my $res;
|
||||
$res = $self->{ua}->post(
|
||||
$PROTOCOL.$ADDRESS.$url,
|
||||
Referer=>$PROTOCOL.$ADDRESS.$url,
|
||||
Content=>$form
|
||||
);
|
||||
|
||||
Debug ( "sendCmdPost credentials control address:'".$ADDRESS."' realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
|
||||
Debug("sendCmdPost credentials control to: $PROTOCOL$ADDRESS$url realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
|
||||
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "sendCmdPost Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
|
||||
if ( $res->status_line() eq '401 Unauthorized' ) {
|
||||
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
} else {
|
||||
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
|
||||
} # endif
|
||||
if ( $res->is_success ) {
|
||||
return !undef;
|
||||
}
|
||||
Error("sendCmdPost Error check failed: '".$res->status_line()."' cmd:");
|
||||
|
||||
return( $result );
|
||||
}
|
||||
return $result;
|
||||
} # end sub sendCmdPost
|
||||
|
||||
|
||||
|
||||
sub move
|
||||
{
|
||||
sub move {
|
||||
my $self = shift;
|
||||
my $panSteps = shift;
|
||||
my $tiltSteps = shift;
|
||||
|
||||
my $cmd = "set_relative_pos&posX=$panSteps&posY=$tiltSteps";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->sendCmd($cmd);
|
||||
}
|
||||
|
||||
sub moveRelUpLeft
|
||||
{
|
||||
sub moveRelUpLeft {
|
||||
my $self = shift;
|
||||
Debug( "Move Up Left" );
|
||||
Debug('Move Up Left');
|
||||
$self->move(-3, 3);
|
||||
}
|
||||
|
||||
sub moveRelUp
|
||||
{
|
||||
sub moveRelUp {
|
||||
my $self = shift;
|
||||
Debug( "Move Up" );
|
||||
Debug('Move Up');
|
||||
$self->move(0, 3);
|
||||
}
|
||||
|
||||
sub moveRelUpRight
|
||||
{
|
||||
sub moveRelUpRight {
|
||||
my $self = shift;
|
||||
Debug( "Move Up Right" );
|
||||
Debug('Move Up Right');
|
||||
$self->move(3, 3);
|
||||
}
|
||||
|
||||
sub moveRelLeft
|
||||
{
|
||||
sub moveRelLeft {
|
||||
my $self = shift;
|
||||
Debug( "Move Left" );
|
||||
Debug('Move Left');
|
||||
$self->move(-3, 0);
|
||||
}
|
||||
|
||||
sub moveRelRight
|
||||
{
|
||||
sub moveRelRight {
|
||||
my $self = shift;
|
||||
Debug( "Move Right" );
|
||||
Debug('Move Right');
|
||||
$self->move(3, 0);
|
||||
}
|
||||
|
||||
sub moveRelDownLeft
|
||||
{
|
||||
sub moveRelDownLeft {
|
||||
my $self = shift;
|
||||
Debug( "Move Down Left" );
|
||||
Debug('Move Down Left');
|
||||
$self->move(-3, -3);
|
||||
}
|
||||
|
||||
sub moveRelDown
|
||||
{
|
||||
sub moveRelDown {
|
||||
my $self = shift;
|
||||
Debug( "Move Down" );
|
||||
Debug('Move Down');
|
||||
$self->move(0, -3);
|
||||
}
|
||||
|
||||
sub moveRelDownRight
|
||||
{
|
||||
sub moveRelDownRight {
|
||||
my $self = shift;
|
||||
Debug( "Move Down Right" );
|
||||
Debug('Move Down Right');
|
||||
$self->move(3, -3);
|
||||
}
|
||||
|
||||
|
||||
# moves the camera to center on the point that the user clicked on in the video image.
|
||||
# This isn't mega accurate but good enough for most purposes
|
||||
|
||||
sub moveMap
|
||||
{
|
||||
sub moveMap {
|
||||
|
||||
# If the camera moves too much, increase hscale and vscale. (...if it doesn't move enough, try decreasing!)
|
||||
# They scale the movement and are here to compensate for manufacturing variation.
|
||||
|
|
@ -338,76 +305,79 @@ sub moveMap
|
|||
$hor = int($hor);
|
||||
$ver = -1 * int($ver);
|
||||
|
||||
Debug( "Move Map to $xcoord,$ycoord, hor=$hor, ver=$ver" );
|
||||
$self->move( $hor, $ver );
|
||||
Debug("Move Map to $xcoord,$ycoord, hor=$hor, ver=$ver");
|
||||
$self->move($hor, $ver);
|
||||
}
|
||||
|
||||
|
||||
# **** PRESETS ****
|
||||
#
|
||||
# OK, presets work a little funky but they DO work, provided you define them in order and don't skip any.
|
||||
# OK, presets work a little funky but they DO work, provided you define them
|
||||
# in order and don't skip any.
|
||||
#
|
||||
# The problem is that when you load the web page for this camera, it gives a list of preset names tied to index numbers.
|
||||
# So let's say you have four presets... A, B, C, and D, and defined them in that order.
|
||||
# So A is index 0, B is index 1, C is index 2, D is index 3. When you tell the camera to go to a preset, you actually tell it by number, not by name.
|
||||
# The problem is that when you load the web page for this camera, it gives a
|
||||
# list of preset names tied to index numbers.
|
||||
# So let's say you have four presets... A, B, C, and D, and defined them in
|
||||
# that order.
|
||||
# So A is index 0, B is index 1, C is index 2, D is index 3. When you tell
|
||||
# the camera to go to a preset, you actually tell it by number, not by name.
|
||||
# (So "Go to D" is really "go to index 3".)
|
||||
#
|
||||
# Now let's say somebody deletes C via the camera's web GUI. The camera re-numbers the existing presets A=0, B=1, D=2.
|
||||
# There's really no easy way for ZM to discover this re-numbering, so zoneminder would still send "go to preset 3" thinking
|
||||
# it's telling the camera to go to point D. In actuality it's telling the camera to go to a preset that no longer exists.
|
||||
# Now let's say somebody deletes C via the camera's web GUI. The camera
|
||||
# re-numbers the existing presets A=0, B=1, D=2.
|
||||
# There's really no easy way for ZM to discover this re-numbering, so
|
||||
# zoneminder would still send "go to preset 3" thinking
|
||||
# it's telling the camera to go to point D. In actuality it's telling the
|
||||
# camera to go to a preset that no longer exists.
|
||||
#
|
||||
# As long as you define your presets in order (i.e. define preset 1, then preset 2, then preset 3, etc.) everything will work just
|
||||
# As long as you define your presets in order (i.e. define preset 1, then
|
||||
# preset 2, then preset 3, etc.) everything will work just
|
||||
# fine in ZoneMinder.
|
||||
#
|
||||
# (Home preset needs to be set via the camera's web gui, and is unaffected by any of this.)
|
||||
# (Home preset needs to be set via the camera's web gui, and is unaffected by
|
||||
# any of this.)
|
||||
#
|
||||
# So that's the limitation: DEFINE YOUR PRESETS IN ORDER THROUGH (and only through!) ZM AND DON'T SKIP ANY.
|
||||
# So that's the limitation: DEFINE YOUR PRESETS IN ORDER THROUGH (and only
|
||||
# through!) ZM AND DON'T SKIP ANY.
|
||||
#
|
||||
|
||||
|
||||
sub presetClear
|
||||
{
|
||||
sub presetClear {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $preset = $self->getParam($params, 'preset');
|
||||
my $cmd = "presetName=$preset&command=del";
|
||||
my $url = "/eng/admin/cam_control.cgi";
|
||||
Debug ("presetClear: " . $preset . " cmd: " . $cmd);
|
||||
$self->sendCmdPost($url,$cmd);
|
||||
my $url = '/eng/admin/cam_control.cgi';
|
||||
Debug('presetClear: ' . $preset . ' cmd: ' . $cmd);
|
||||
$self->sendCmdPost($url,{presetName=>$preset, command=>'del'});
|
||||
}
|
||||
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
sub presetSet {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $preset = $self->getParam($params, 'preset');
|
||||
my $cmd = "presetName=$preset&command=add";
|
||||
my $url = "/eng/admin/cam_control.cgi";
|
||||
Debug ("presetSet " . $preset . " cmd: " . $cmd);
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
my $url = '/eng/admin/cam_control.cgi';
|
||||
Debug('presetSet ' . $preset . ' cmd: ' . $cmd);
|
||||
$self->sendCmdPost($url,{presetName=>$preset, command=>'add', Submit=>'Add'});
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
sub presetGoto {
|
||||
my $self = shift;
|
||||
my $params = shift;
|
||||
my $preset = $self->getParam( $params, 'preset' );
|
||||
my $preset = $self->getParam($params, 'preset');
|
||||
$preset = $preset - 1;
|
||||
Debug( "Goto Preset $preset" );
|
||||
Debug("Goto Preset $preset");
|
||||
my $cmd = "goto_preset_position&index=$preset";
|
||||
$self->sendCmd( $cmd );
|
||||
$self->sendCmd($cmd);
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
sub presetHome {
|
||||
my $self = shift;
|
||||
Debug( "Home Preset" );
|
||||
my $cmd = "go_home";
|
||||
$self->sendCmd( $cmd );
|
||||
Debug('Home Preset');
|
||||
my $cmd = 'go_home';
|
||||
$self->sendCmd($cmd);
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# **** IR CONTROLS ****
|
||||
#
|
||||
|
|
@ -419,47 +389,42 @@ sub presetHome
|
|||
# Reset: Automatic IR mode. (day/night mode determined by camera)
|
||||
#
|
||||
|
||||
|
||||
sub wake
|
||||
{
|
||||
sub wake {
|
||||
# force IR on ("always night mode")
|
||||
|
||||
my $self = shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=3";
|
||||
my $url = '/eng/admin/adv_audiovideo.cgi';
|
||||
my $cmd = 'irMode=3';
|
||||
|
||||
Debug("Wake -- IR on");
|
||||
Debug('Wake -- IR on');
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
$self->sendCmdPost($url,$cmd);
|
||||
}
|
||||
|
||||
sub sleep
|
||||
{
|
||||
sub sleep {
|
||||
# force IR off ("always day mode")
|
||||
|
||||
my $self=shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=2";
|
||||
my $self = shift;
|
||||
my $url = '/eng/admin/adv_audiovideo.cgi';
|
||||
my $cmd = 'irMode=2';
|
||||
|
||||
Debug("Sleep -- IR off");
|
||||
Debug('Sleep -- IR off');
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
$self->sendCmdPost($url,$cmd);
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
sub reset {
|
||||
# IR auto
|
||||
|
||||
my $self=shift;
|
||||
my $url = "/eng/admin/adv_audiovideo.cgi";
|
||||
my $cmd = "irMode=0";
|
||||
my $url = '/eng/admin/adv_audiovideo.cgi';
|
||||
my $cmd = 'irMode=0';
|
||||
|
||||
Debug("Reset -- IR auto");
|
||||
Debug('Reset -- IR auto');
|
||||
|
||||
$self->sendCmdPost ($url,$cmd);
|
||||
$self->sendCmdPost($url,$cmd);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
# Below is stub documentation for your module. You'd better edit it!
|
||||
|
|
@ -471,7 +436,7 @@ ZoneMinder::Database - Perl extension for Trendnet TVIP672
|
|||
=head1 SYNOPSIS
|
||||
|
||||
use ZoneMinder::Database;
|
||||
stuff this in /usr/share/perl5/ZoneMinder/Control , then eat a sandwich
|
||||
place this in /usr/share/perl5/ZoneMinder/Control
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
|
|
@ -490,11 +455,10 @@ Read the comments at the beginning of this file to see the usage for zoneminder
|
|||
|
||||
=head1 AUTHOR
|
||||
|
||||
Vincent Giovannone, I'd rather you not email me.
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2014 by Vincent Giovannone
|
||||
Copyright (C) 2018 by ZoneMinder LLC
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.3 or,
|
||||
|
|
|
|||
|
|
@ -184,16 +184,19 @@ sub zmDbGetMonitor {
|
|||
|
||||
my $id = shift;
|
||||
|
||||
return( undef ) if ( !defined($id) );
|
||||
if ( !defined($id) ) {
|
||||
croak("Undefined id in zmDbgetMonitor");
|
||||
return undef ;
|
||||
}
|
||||
|
||||
my $sql = "select * from Monitors where Id = ?";
|
||||
my $sth = $dbh->prepare_cached( $sql )
|
||||
or croak( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute( $id )
|
||||
or croak( "Can't execute '$sql': ".$sth->errstr() );
|
||||
my $sql = 'SELECT * FROM Monitors WHERE Id = ?';
|
||||
my $sth = $dbh->prepare_cached($sql)
|
||||
or croak("Can't prepare '$sql': ".$dbh->errstr());
|
||||
my $res = $sth->execute($id)
|
||||
or croak("Can't execute '$sql': ".$sth->errstr());
|
||||
my $monitor = $sth->fetchrow_hashref();
|
||||
|
||||
return( $monitor );
|
||||
return $monitor;
|
||||
}
|
||||
|
||||
sub zmDbGetMonitorAndControl {
|
||||
|
|
|
|||
|
|
@ -527,6 +527,7 @@ sub logPrint {
|
|||
my $this = shift;
|
||||
my $level = shift;
|
||||
my $string = shift;
|
||||
my ($caller, undef, $line) = @_ ? @_ : caller;
|
||||
|
||||
if ( $level <= $this->{effectiveLevel} ) {
|
||||
$string =~ s/[\r\n]+$//g;
|
||||
|
|
@ -537,12 +538,14 @@ sub logPrint {
|
|||
my ($seconds, $microseconds) = gettimeofday();
|
||||
if ( $level <= $this->{fileLevel} or $level <= $this->{termLevel} ) {
|
||||
my $message = sprintf(
|
||||
'%s.%06d %s[%d].%s [%s]'
|
||||
'%s.%06d %s[%d].%s [%s:%d] [%s]'
|
||||
, strftime('%x %H:%M:%S', localtime($seconds))
|
||||
, $microseconds
|
||||
, $this->{id}
|
||||
, $$
|
||||
, $codes{$level}
|
||||
, $caller
|
||||
, $line
|
||||
, $string
|
||||
);
|
||||
if ( $this->{trace} ) {
|
||||
|
|
@ -660,39 +663,39 @@ sub Dump {
|
|||
|
||||
sub debug {
|
||||
my $log = shift;
|
||||
$log->logPrint(DEBUG, @_);
|
||||
}
|
||||
$log->logPrint(DEBUG, @_, caller);
|
||||
}
|
||||
|
||||
sub Debug( @ ) {
|
||||
fetch()->logPrint(DEBUG, @_);
|
||||
fetch()->logPrint(DEBUG, @_, caller);
|
||||
}
|
||||
|
||||
sub Info( @ ) {
|
||||
fetch()->logPrint(INFO, @_);
|
||||
fetch()->logPrint(INFO, @_, caller);
|
||||
}
|
||||
sub info {
|
||||
my $log = shift;
|
||||
$log->logPrint(INFO, @_);
|
||||
$log->logPrint(INFO, @_, caller);
|
||||
}
|
||||
|
||||
sub Warning( @ ) {
|
||||
fetch()->logPrint(WARNING, @_);
|
||||
fetch()->logPrint(WARNING, @_, caller);
|
||||
}
|
||||
sub warn {
|
||||
my $log = shift;
|
||||
$log->logPrint(WARNING, @_);
|
||||
$log->logPrint(WARNING, @_, caller);
|
||||
}
|
||||
|
||||
sub Error( @ ) {
|
||||
fetch()->logPrint(ERROR, @_);
|
||||
fetch()->logPrint(ERROR, @_, caller);
|
||||
}
|
||||
sub error {
|
||||
my $log = shift;
|
||||
$log->logPrint(ERROR, @_);
|
||||
$log->logPrint(ERROR, @_, caller);
|
||||
}
|
||||
|
||||
sub Fatal( @ ) {
|
||||
fetch()->logPrint(FATAL, @_);
|
||||
fetch()->logPrint(FATAL, @_, caller);
|
||||
if ( $SIG{TERM} and ( $SIG{TERM} ne 'DEFAULT' ) ) {
|
||||
$SIG{TERM}();
|
||||
}
|
||||
|
|
@ -700,7 +703,7 @@ sub Fatal( @ ) {
|
|||
}
|
||||
|
||||
sub Panic( @ ) {
|
||||
fetch()->logPrint(PANIC, @_);
|
||||
fetch()->logPrint(PANIC, @_, caller);
|
||||
confess($_[0]);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -21,32 +21,6 @@
|
|||
#
|
||||
# ==========================================================================
|
||||
|
||||
=head1 NAME
|
||||
|
||||
zmcontrol.pl - ZoneMinder control script
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
zmcontrol.pl --id {monitor_id} --command={command} [various options]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
FIXME FIXME
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
--autostop -
|
||||
--xcoord [ arg ] - X-coord
|
||||
--ycoord [ arg ] - Y-coord
|
||||
--speed [ arg ] - Speed
|
||||
--step [ arg ] -
|
||||
--panspeed [ arg ] -
|
||||
--panstep [ arg ] -
|
||||
--tiltspeed [ arg ] -
|
||||
--tiltstep [ arg ] -
|
||||
--preset [ arg ] -
|
||||
|
||||
=cut
|
||||
use strict;
|
||||
|
||||
@EXTRA_PERL_LIB@
|
||||
|
|
@ -58,7 +32,7 @@ use Socket;
|
|||
#use Data::Dumper;
|
||||
use Module::Load::Conditional qw{can_load};;
|
||||
|
||||
use constant MAX_CONNECT_DELAY => 10;
|
||||
use constant MAX_CONNECT_DELAY => 15;
|
||||
use constant MAX_COMMAND_WAIT => 1800;
|
||||
|
||||
$| = 1;
|
||||
|
|
@ -89,122 +63,109 @@ GetOptions(
|
|||
'autostop' =>\$options{autostop},
|
||||
) or pod2usage(-exitstatus => -1);
|
||||
|
||||
if ( !$id || !$options{command} )
|
||||
{
|
||||
if ( !$id || !$options{command} ) {
|
||||
print( STDERR "Please give a valid monitor id and command\n" );
|
||||
pod2usage(-exitstatus => -1);
|
||||
}
|
||||
|
||||
( $id ) = $id =~ /^(\w+)$/;
|
||||
|
||||
Debug( $arg_string );
|
||||
Debug("zmcontrol: arg string: $arg_string");
|
||||
|
||||
my $sock_file = $Config{ZM_PATH_SOCKS}.'/zmcontrol-'.$id.'.sock';
|
||||
|
||||
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 )
|
||||
or Fatal( "Can't open socket: $!" );
|
||||
socket(CLIENT, PF_UNIX, SOCK_STREAM, 0)
|
||||
or Fatal("Can't open socket: $!");
|
||||
|
||||
my $saddr = sockaddr_un( $sock_file );
|
||||
my $server_up = connect( CLIENT, $saddr );
|
||||
if ( !$server_up )
|
||||
{
|
||||
my $saddr = sockaddr_un($sock_file);
|
||||
my $server_up = connect(CLIENT, $saddr);
|
||||
if ( !$server_up ) {
|
||||
# The server isn't there
|
||||
my $monitor = zmDbGetMonitorAndControl( $id );
|
||||
if ( !$monitor )
|
||||
{
|
||||
Fatal( "Unable to load control data for monitor $id" );
|
||||
my $monitor = zmDbGetMonitorAndControl($id);
|
||||
if ( !$monitor ) {
|
||||
Fatal("Unable to load control data for monitor $id");
|
||||
}
|
||||
my $protocol = $monitor->{Protocol};
|
||||
|
||||
if ( -x $protocol )
|
||||
{
|
||||
if ( -x $protocol ) {
|
||||
# Protocol is actually a script!
|
||||
# Holdover from previous versions
|
||||
my $command .= $protocol.' '.$arg_string;
|
||||
Debug( $command."\n" );
|
||||
Debug($command);
|
||||
|
||||
my $output = qx($command);
|
||||
my $status = $? >> 8;
|
||||
if ( $status || logDebugging() )
|
||||
{
|
||||
chomp( $output );
|
||||
Debug( "Output: $output\n" );
|
||||
if ( $status || logDebugging() ) {
|
||||
chomp($output);
|
||||
Debug("Output: $output");
|
||||
}
|
||||
if ( $status )
|
||||
{
|
||||
Error( "Command '$command' exited with status: $status\n" );
|
||||
exit( $status );
|
||||
if ( $status ) {
|
||||
Error("Command '$command' exited with status: $status");
|
||||
exit($status);
|
||||
}
|
||||
exit( 0 );
|
||||
exit(0);
|
||||
}
|
||||
|
||||
Info( "Starting control server $id/$protocol" );
|
||||
close( CLIENT );
|
||||
Info("Starting control server $id/$protocol");
|
||||
close(CLIENT);
|
||||
|
||||
if ( ! can_load( modules => { "ZoneMinder::Control::$protocol" => undef } ) ) {
|
||||
Fatal("Can't load ZoneMinder::Control::$protocol");
|
||||
Fatal("Can't load ZoneMinder::Control::$protocol\n$Module::Load::Conditional::ERROR");
|
||||
}
|
||||
|
||||
if ( my $cpid = fork() )
|
||||
{
|
||||
if ( my $cpid = fork() ) {
|
||||
logReinit();
|
||||
|
||||
# Parent process just sleep and fall through
|
||||
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 )
|
||||
or die( "Can't open socket: $!" );
|
||||
socket(CLIENT, PF_UNIX, SOCK_STREAM, 0)
|
||||
or die("Can't open socket: $!");
|
||||
my $attempts = 0;
|
||||
while (!connect( CLIENT, $saddr ))
|
||||
{
|
||||
while ( !connect(CLIENT, $saddr) ) {
|
||||
$attempts++;
|
||||
Fatal( "Can't connect: $! after $attempts attempts to $sock_file" ) if ($attempts > MAX_CONNECT_DELAY);
|
||||
Fatal("Can't connect: $! after $attempts attempts to $sock_file") if $attempts > MAX_CONNECT_DELAY;
|
||||
sleep(1);
|
||||
}
|
||||
}
|
||||
elsif ( defined($cpid) )
|
||||
{
|
||||
close( STDOUT );
|
||||
close( STDERR );
|
||||
} elsif ( defined($cpid) ) {
|
||||
close(STDOUT);
|
||||
close(STDERR);
|
||||
|
||||
setpgrp();
|
||||
|
||||
logReinit();
|
||||
|
||||
Info( "Control server $id/$protocol starting at "
|
||||
.strftime( '%y/%m/%d %H:%M:%S', localtime() )
|
||||
Info("Control server $id/$protocol starting at "
|
||||
.strftime('%y/%m/%d %H:%M:%S', localtime())
|
||||
);
|
||||
|
||||
$0 = $0." --id $id";
|
||||
|
||||
my $control = "ZoneMinder::Control::$protocol"->new( $id );
|
||||
my $control = "ZoneMinder::Control::$protocol"->new($id);
|
||||
my $control_key = $control->getKey();
|
||||
$control->loadMonitor();
|
||||
|
||||
$control->open();
|
||||
|
||||
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 )
|
||||
or Fatal( "Can't open socket: $!" );
|
||||
unlink( $sock_file );
|
||||
bind( SERVER, $saddr ) or Fatal( "Can't bind: $!" );
|
||||
listen( SERVER, SOMAXCONN ) or Fatal( "Can't listen: $!" );
|
||||
socket(SERVER, PF_UNIX, SOCK_STREAM, 0)
|
||||
or Fatal("Can't open socket: $!");
|
||||
unlink($sock_file);
|
||||
bind(SERVER, $saddr) or Fatal("Can't bind: $!");
|
||||
listen(SERVER, SOMAXCONN) or Fatal("Can't listen: $!");
|
||||
|
||||
my $rin = '';
|
||||
vec( $rin, fileno(SERVER), 1 ) = 1;
|
||||
my $win = $rin;
|
||||
my $ein = $win;
|
||||
my $timeout = MAX_COMMAND_WAIT;
|
||||
while( 1 )
|
||||
{
|
||||
my $nfound = select( my $rout = $rin, undef, undef, $timeout );
|
||||
if ( $nfound > 0 )
|
||||
{
|
||||
if ( vec( $rout, fileno(SERVER), 1 ) )
|
||||
{
|
||||
my $paddr = accept( CLIENT, SERVER );
|
||||
while( 1 ) {
|
||||
my $nfound = select(my $rout = $rin, undef, undef, $timeout);
|
||||
if ( $nfound > 0 ) {
|
||||
if ( vec( $rout, fileno(SERVER), 1 ) ) {
|
||||
my $paddr = accept(CLIENT, SERVER);
|
||||
my $message = <CLIENT>;
|
||||
|
||||
next if ( !$message );
|
||||
next if !$message;
|
||||
|
||||
my $params = jsonDecode( $message );
|
||||
my $params = jsonDecode($message);
|
||||
#Debug( Dumper( $params ) );
|
||||
|
||||
my $command = $params->{command};
|
||||
|
|
@ -212,49 +173,66 @@ if ( !$server_up )
|
|||
if ( $command eq 'quit' ) {
|
||||
last;
|
||||
}
|
||||
$control->$command( $params );
|
||||
$control->$command($params);
|
||||
} else {
|
||||
Fatal('Bogus descriptor');
|
||||
}
|
||||
else
|
||||
{
|
||||
Fatal( "Bogus descriptor" );
|
||||
} elsif ( $nfound < 0 ) {
|
||||
if ( $! == EPIPE ) {
|
||||
Error("Can't select: $!");
|
||||
} else {
|
||||
Fatal("Can't select: $!");
|
||||
}
|
||||
}
|
||||
elsif ( $nfound < 0 )
|
||||
{
|
||||
if ( $! == EPIPE )
|
||||
{
|
||||
Error( "Can't select: $!" );
|
||||
}
|
||||
else
|
||||
{
|
||||
Fatal( "Can't select: $!" );
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
} else {
|
||||
#print( "Select timed out\n" );
|
||||
last;
|
||||
}
|
||||
}
|
||||
Info( "Control server $id/$protocol exiting at "
|
||||
.strftime( '%y/%m/%d %H:%M:%S', localtime() )
|
||||
);
|
||||
unlink( $sock_file );
|
||||
} # end while forever
|
||||
Info("Control server $id/$protocol exiting");
|
||||
unlink($sock_file);
|
||||
$control->close();
|
||||
exit( 0 );
|
||||
exit(0);
|
||||
} else {
|
||||
Fatal("Can't fork: $!");
|
||||
}
|
||||
else
|
||||
{
|
||||
Fatal( "Can't fork: $!" );
|
||||
}
|
||||
}
|
||||
} # end if !server up
|
||||
|
||||
# The server is there, connect to it
|
||||
#print( "Writing commands\n" );
|
||||
CLIENT->autoflush();
|
||||
|
||||
my $message = jsonEncode( \%options );
|
||||
print( CLIENT $message );
|
||||
shutdown( CLIENT, 1 );
|
||||
my $message = jsonEncode(\%options);
|
||||
print(CLIENT $message);
|
||||
shutdown(CLIENT, 1);
|
||||
|
||||
exit( 0 );
|
||||
exit(0);
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
zmcontrol.pl - ZoneMinder control script
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
zmcontrol.pl --id {monitor_id} --command={command} [various options]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
FIXME FIXME
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
--autostop -
|
||||
--xcoord [ arg ] - X-coord
|
||||
--ycoord [ arg ] - Y-coord
|
||||
--speed [ arg ] - Speed
|
||||
--step [ arg ] -
|
||||
--panspeed [ arg ] -
|
||||
--panstep [ arg ] -
|
||||
--tiltspeed [ arg ] -
|
||||
--tiltstep [ arg ] -
|
||||
--preset [ arg ] -
|
||||
|
||||
=cut
|
||||
|
|
|
|||
Loading…
Reference in New Issue