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

Merge branch 'master' into storageareas

This commit is contained in:
Isaac Connor 2018-08-13 11:17:04 -04:00
parent 3b86d9255b e6d1a9447e
commit 3ab542199c
11 changed files with 925 additions and 1016 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
conf.d/01-system-paths.conf.in
View File

@ -50,4 +50,4 @@ ZM_PATH_SWAP=@ZM_TMPDIR@
# Full path to optional arp binary # Full path to optional arp binary
# ZoneMinder will find the arp binary automatically on most systems # ZoneMinder will find the arp binary automatically on most systems
ZM_PATH_ARP=@ZM_PATH_ARP@ ZM_PATH_ARP="@ZM_PATH_ARP@"

1
db/zm_create.sql.in
View File

@ -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,'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,'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,'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 -- Add some monitor preset values
-- --

2
scripts/ZoneMinder/lib/ZoneMinder/Config.pm.in
View File

@ -149,7 +149,7 @@ BEGIN {
foreach my $str ( <$CONFIG> ) { foreach my $str ( <$CONFIG> ) {
next if ( $str =~ /^\s*$/ ); next if ( $str =~ /^\s*$/ );
next if ( $str =~ /^\s*#/ ); next if ( $str =~ /^\s*#/ );
my ( $name, $value ) = $str =~ /^\s*([^=\s]+)\s*=\s*(.*?)\s*$/; my ( $name, $value ) = $str =~ /^\s*([^=\s]+)\s*=\s*[\'"]*(.*?)[\'"]*\s*$/;
if ( ! $name ) { if ( ! $name ) {
print( STDERR "Warning, bad line in $config_file: $str\n" ); print( STDERR "Warning, bad line in $config_file: $str\n" );
next; next;

526
scripts/ZoneMinder/lib/ZoneMinder/Control/Netcat.pm
View File

@ -74,377 +74,351 @@ use ZoneMinder::Config qw(:all);
use Time::HiRes qw( usleep ); use Time::HiRes qw( usleep );
sub open sub open {
{ my $self = shift;
my $self = shift;
$self->loadMonitor(); $self->loadMonitor();
use LWP::UserAgent; use LWP::UserAgent;
$self->{ua} = LWP::UserAgent->new; $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'; $self->{state} = 'open';
} }
sub printMsg sub printMsg {
{ my $self = shift;
my $self = shift; my $msg = shift;
my $msg = shift; my $msg_len = length($msg);
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]" ); Debug($msg.'['.$msg_len.']');
} }
sub sendCmd sub sendCmd {
{ my $self = shift;
my $self = shift; my $cmd = shift;
my $cmd = shift; my $msg = shift;
my $msg = shift; my $content_type = shift;
my $content_type = shift; my $result = undef;
my $result = undef;
printMsg( $cmd, "Tx" ); printMsg($cmd, 'Tx');
my $server_endpoint = "http://".$self->{Monitor}->{ControlAddress}."/$cmd"; my $server_endpoint = 'http://'.$self->{Monitor}->{ControlAddress}.'/'.$cmd;
my $req = HTTP::Request->new( POST => $server_endpoint ); my $req = HTTP::Request->new(POST => $server_endpoint);
$req->header('content-type' => $content_type); $req->header('content-type' => $content_type);
$req->header('Host' => $self->{Monitor}->{ControlAddress}); $req->header('Host' => $self->{Monitor}->{ControlAddress});
$req->header('content-length' => length($msg)); $req->header('content-length' => length($msg));
$req->header('accept-encoding' => 'gzip, deflate'); $req->header('accept-encoding' => 'gzip, deflate');
$req->header('connection' => 'Close'); $req->header('connection' => 'Close');
$req->content($msg); $req->content($msg);
my $res = $self->{ua}->request($req); my $res = $self->{ua}->request($req);
if ( $res->is_success ) { if ( $res->is_success ) {
$result = !undef; $result = !undef;
} else { } 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;
}
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);
$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));
$req->header('accept-encoding' => 'gzip, deflate');
$req->header('connection' => 'Close');
$req->content($msg);
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
# 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>.*/ ) {
$CamParams{$1} = $2;
} }
return( $result ); if ( $content =~ /.*<tt:(Contrast)>(.+)<\/tt:Contrast>.*/ ) {
} $CamParams{$1} = $2;
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 );
$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));
$req->header('accept-encoding' => 'gzip, deflate');
$req->header('connection' => 'Close');
$req->content($msg);
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
# 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>.*/) {
$CamParams{$1} = $2;
}
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 #autoStop
#This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab #This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab
sub autoStop sub autoStop {
{ my $self = shift;
my $self = shift; my $autostop = shift;
my $autostop = shift;
if( $autostop ) { if ( $autostop ) {
Debug( "Auto Stop" ); Debug('Auto Stop');
my $cmd = 'onvif/PTZ'; 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 $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"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
usleep( $autostop ); usleep($autostop);
$self->sendCmd( $cmd, $msg, $content_type ); $self->sendCmd($cmd, $msg, $content_type);
} }
} }
# Reset the Camera # Reset the Camera
sub reset sub reset {
{ Debug('Camera Reset');
Debug( "Camera Reset" ); my $self = shift;
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 $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"';
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 #Up Arrow
sub moveConUp sub moveConUp {
{ Debug('Move Up');
Debug( "Move Up" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Down Arrow #Down Arrow
sub moveConDown sub moveConDown {
{ Debug('Move Down');
Debug( "Move Down" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Left Arrow #Left Arrow
sub moveConLeft sub moveConLeft {
{ Debug('Move Left');
Debug( "Move Left" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Right Arrow #Right Arrow
sub moveConRight sub moveConRight {
{ Debug('Move Right');
Debug( "Move Right" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Zoom In #Zoom In
sub zoomConTele sub zoomConTele {
{ Debug('Zoom Tele');
Debug( "Zoom Tele" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Zoom Out #Zoom Out
sub zoomConWide sub zoomConWide {
{ Debug('Zoom Wide');
Debug( "Zoom Wide" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Up Right Arrow #Diagonally Up Right Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConUpRight sub moveConUpRight {
{ Debug('Move Diagonally Up Right');
Debug( "Move Diagonally Up Right" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Down Right Arrow #Diagonally Down Right Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConDownRight sub moveConDownRight {
{ Debug('Move Diagonally Down Right');
Debug( "Move Diagonally Down Right" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Up Left Arrow #Diagonally Up Left Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConUpLeft sub moveConUpLeft {
{ Debug('Move Diagonally Up Left');
Debug( "Move Diagonally Up Left" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Down Left Arrow #Diagonally Down Left Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConDownLeft sub moveConDownLeft {
{ Debug('Move Diagonally Down Left');
Debug( "Move Diagonally Down Left" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Stop #Stop
sub moveStop sub moveStop {
{ Debug('Move Stop');
Debug( "Move Stop" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
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 $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"';
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 #Set Camera Preset
sub presetSet sub presetSet {
{ my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; my $preset = $self->getParam($params, 'preset');
my $preset = $self->getParam( $params, 'preset' ); Debug("Set Preset $preset");
Debug( "Set Preset $preset" ); my $cmd = 'onvif/PTZ';
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 $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"';
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 #Recall Camera Preset
sub presetGoto sub presetGoto {
{ my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; my $preset = $self->getParam($params, 'preset');
my $preset = $self->getParam( $params, 'preset' ); Debug("Goto Preset $preset");
Debug( "Goto Preset $preset" ); my $cmd = 'onvif/PTZ';
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 $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"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/GotoPreset"'; $self->sendCmd( $cmd, $msg, $content_type );
$self->sendCmd( $cmd, $msg, $content_type );
} }
#Horizontal Patrol #Horizontal Patrol
#To be determined if this camera supports this feature #To be determined if this camera supports this feature
sub horizontalPatrol sub horizontalPatrol {
{ Debug('Horizontal Patrol');
Debug( "Horizontal Patrol" ); my $self = shift;
my $self = shift; my $cmd = '';
my $cmd = ''; my $msg ='';
my $msg =''; my $content_type = '';
my $content_type = ''; # $self->sendCmd( $cmd, $msg, $content_type );
# $self->sendCmd( $cmd, $msg, $content_type ); Error('PTZ Command not implemented in control script.');
Error( "PTZ Command not implemented in control script." );
} }
#Horizontal Patrol Stop #Horizontal Patrol Stop
#To be determined if this camera supports this feature #To be determined if this camera supports this feature
sub horizontalPatrolStop sub horizontalPatrolStop {
{ Debug('Horizontal Patrol Stop');
Debug( "Horizontal Patrol Stop" ); my $self = shift;
my $self = shift; my $cmd = '';
my $cmd = ''; my $msg ='';
my $msg =''; my $content_type = '';
my $content_type = ''; # $self->sendCmd( $cmd, $msg, $content_type );
# $self->sendCmd( $cmd, $msg, $content_type ); Error('PTZ Command not implemented in control script.');
Error( "PTZ Command not implemented in control script." );
} }
# Increase Brightness # Increase Brightness
sub irisAbsOpen sub irisAbsOpen {
{ Debug("Iris $CamParams{Brightness}");
Debug( "Iris $CamParams{'Brightness'}" ); my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; $self->getCamParams() unless($CamParams{Brightness});
$self->getCamParams() unless($CamParams{'Brightness'}); my $step = $self->getParam($params, 'step');
my $step = $self->getParam( $params, 'step' ); my $max = 100;
my $max = 100;
$CamParams{'Brightness'} += $step; $CamParams{Brightness} += $step;
$CamParams{'Brightness'} = $max if ($CamParams{'Brightness'} > $max); $CamParams{Brightness} = $max if ($CamParams{Brightness} > $max);
my $cmd = 'onvif/imaging'; 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"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
$self->sendCmd( $cmd, $msg, $content_type ); $self->sendCmd( $cmd, $msg, $content_type );
} }
# Decrease Brightness # Decrease Brightness
sub irisAbsClose sub irisAbsClose
{ {
Debug( "Iris $CamParams{'Brightness'}" ); Debug( "Iris $CamParams{Brightness}" );
my $self = shift; my $self = shift;
my $params = shift; my $params = shift;
$self->getCamParams() unless($CamParams{'brightness'}); $self->getCamParams() unless($CamParams{brightness});
my $step = $self->getParam( $params, 'step' ); my $step = $self->getParam( $params, 'step' );
my $min = 0; my $min = 0;
$CamParams{'Brightness'} -= $step; $CamParams{Brightness} -= $step;
$CamParams{'Brightness'} = $min if ($CamParams{'Brightness'} < $min); $CamParams{Brightness} = $min if ($CamParams{Brightness} < $min);
my $cmd = 'onvif/imaging'; 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"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
$self->sendCmd( $cmd, $msg, $content_type ); $self->sendCmd( $cmd, $msg, $content_type );
} }
# Increase Contrast # Increase Contrast
sub whiteAbsIn sub whiteAbsIn {
{ Debug("Iris $CamParams{Contrast}");
Debug( "Iris $CamParams{'Contrast'}" ); my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; $self->getCamParams() unless($CamParams{Contrast});
$self->getCamParams() unless($CamParams{'Contrast'}); my $step = $self->getParam( $params, 'step' );
my $step = $self->getParam( $params, 'step' ); my $max = 100;
my $max = 100;
$CamParams{'Contrast'} += $step; $CamParams{Contrast} += $step;
$CamParams{'Contrast'} = $max if ($CamParams{'Contrast'} > $max); $CamParams{Contrast} = $max if ($CamParams{Contrast} > $max);
my $cmd = 'onvif/imaging'; 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"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
} }
# Decrease Contrast # Decrease Contrast
sub whiteAbsOut sub whiteAbsOut {
{ Debug("Iris $CamParams{Contrast}");
Debug( "Iris $CamParams{'Contrast'}" ); my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; $self->getCamParams() unless($CamParams{Contrast});
$self->getCamParams() unless($CamParams{'Contrast'}); my $step = $self->getParam($params, 'step');
my $step = $self->getParam( $params, 'step' ); my $min = 0;
my $min = 0;
$CamParams{'Contrast'} -= $step; $CamParams{Contrast} -= $step;
$CamParams{'Contrast'} = $min if ($CamParams{'Contrast'} < $min); $CamParams{Contrast} = $min if ($CamParams{Contrast} < $min);
my $cmd = 'onvif/imaging'; 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"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
} }
1; 1;
__END__

504
scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP862.pm
View File

@ -1,504 +0,0 @@
# =========================================================================
#
# ZoneMinder Trendnet TV-IP862IC IP Control Protocol Module, $Date: $, $Revision: $
# Copyright (C) 2014 Vincent Giovannone
#
#
# ==========================================================================
#
# 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-IP672PI IP camera control
# protocol. Also works or TV-IP862IC
#
# For Zoneminder 1.26+
#
# Under control capability:
#
# * Main: name it (suggest TVIP672PI), type is FFMPEG (or remote if you're using MJPEG), protocol is TVIP672PI
# * 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.)
#
# 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!
#
#
# 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;
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-IP672WI, but can't test since I don't own one.
#
# TV-IP672PI works for the PI version, of course.
#
# Finally, the username is the username you'd like to authenticate as.
#
our $REALM = 'TV-IP862IC';
our $USERNAME = 'admin';
our $PASSWORD = '';
our $ADDRESS = '';
# ==========================================================================
#
# Trendnet TV-IP672PI Control Protocol
#
# ==========================================================================
use ZoneMinder::Logger qw(:all);
use ZoneMinder::Config qw(:all);
sub open
{
my $self = shift;
$self->loadMonitor();
my ( $protocol, $username, $password, $address )
= $self->{Monitor}->{ControlAddress} =~ /^(https?:\/\/)?([^:]+):([^\/@]+)@(.*)$/;
if ( $username ) {
$USERNAME = $username;
$PASSWORD = $password;
$ADDRESS = $address;
} else {
Error( "Failed to parse auth from address");
$ADDRESS = $self->{Monitor}->{ControlAddress};
}
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)
Debug ( "sendCmd credentials control address:'".$ADDRESS
."' realm:'" . $REALM
. "' username:'" . $USERNAME
. "' password:'".$PASSWORD
."'"
);
$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 ) {
Debug("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);
} # end if
} else {
Debug("No headers line");
} # end if headers
} # end if $res->status_line() eq '401 Unauthorized'
} # end if ! $res->is_success
}
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;
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' ) {
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() );
}
}
if ( ! $result ) {
Error( "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.
=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.
=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

453
scripts/ZoneMinder/lib/ZoneMinder/Control/Trendnet.pm Normal file
View File

@ -0,0 +1,453 @@
#===========================================================================
#
# ZoneMinder Trendnet IP Control Protocol Module, $Date: $, $Revision: $
# Copyright (C) 2018 ZoneMinder LLC8 ZoneMinder LLC8 ZoneMinder LLC8 ZoneMinder LLC8 ZoneMinder LLC8 ZoneMinder LLC8 ZoneMinder LLC8 ZoneMinder LLC
#
#
# ==========================================================================
#
# 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 # IP camera control
# protocol. Has been tested with TV-IP862IC
#
# Under control capability:
#
# * Main: 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.)
#
# Under control tab in the monitor itself:
#
# 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
#
package ZoneMinder::Control::Trendnet;
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! **********
#
# You do not need to change the REALM, but you can get slightly faster response
# by setting so that the first auth request succeeds.
#
# The username and password should be passed in the ControlDevice field but you
# can set them here if you want.
#
our $REALM = '';
our $PROTOCOL = 'http://';
our $USERNAME = 'admin';
our $PASSWORD = '';
our $ADDRESS = '';
# ==========================================================================
#
# Trendnet TV-IP672PI Control Protocol
#
# ==========================================================================
use ZoneMinder::Logger qw(:all);
use ZoneMinder::Config qw(:all);
sub open {
my $self = shift;
$self->loadMonitor();
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 ' . $self->{Monitor}->{ControlAddress});
$ADDRESS = $self->{Monitor}->{ControlAddress};
}
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} = 'closed';
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
Debug ( "sendCmd credentials control address:'".$ADDRESS
."' realm:'" . $REALM
. "' username:'" . $USERNAME
. "' password:'".$PASSWORD
."'"
);
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
# Detect REALM
my $res = $self->{ua}->get($PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi');
if ( $res->is_success ) {
$self->{state} = 'open';
return;
}
if ( $res->status_line() eq '401 Unauthorized' ) {
my $headers = $res->headers();
foreach my $k ( keys %$headers ) {
Debug("Initial Header $k => $$headers{$k}");
}
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");
$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');
} # end if headers
} # end if $res->status_line() eq '401 Unauthorized'
} # end sub open
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 $url = $PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi?command='.$cmd;
my $res = $self->{ua}->get($url);
Debug('sendCmd command: ' . $url);
if ( $res->is_success ) {
return !undef;
}
Error("Error check failed: '".$res->status_line()."' cmd:'".$cmd."'");
return;
}
sub sendCmdPost {
#
# This routine is used for setting/clearing presets and IR commands, which are POST commands...
#
my $self = shift;
my $url = shift;
my $form = shift;
my $result = undef;
if ( $url eq undef ) {
Error('url passed to sendCmdPost is undefined.');
return -1;
}
#Debug('sendCmdPost url: ' . $url . ' cmd: ' . $cmd);
my $res;
$res = $self->{ua}->post(
$PROTOCOL.$ADDRESS.$url,
Referer=>$PROTOCOL.$ADDRESS.$url,
Content=>$form
);
Debug("sendCmdPost credentials control to: $PROTOCOL$ADDRESS$url realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
if ( $res->is_success ) {
return !undef;
}
Error("sendCmdPost Error check failed: '".$res->status_line()."' cmd:");
return $result;
} # end sub sendCmdPost
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,{presetName=>$preset, command=>'del'});
}
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,{presetName=>$preset, command=>'add', Submit=>'Add'});
}
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::Control::Trendnet - Perl module for Trendnet cameras
=head1 SYNOPSIS
use ZoneMinder::Database;
place this in /usr/share/perl5/ZoneMinder/Control
=head1 DESCRIPTION
Stub documentation for Trendnet PTZ Sctrol
=head2 EXPORT
None by default.
=head1 COPYRIGHT AND LICENSE
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,
at your option, any later version of Perl 5 you may have available.
=cut

17
scripts/ZoneMinder/lib/ZoneMinder/Database.pm
View File

@ -184,16 +184,19 @@ sub zmDbGetMonitor {
my $id = shift; 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 $sql = 'SELECT * FROM Monitors WHERE Id = ?';
my $sth = $dbh->prepare_cached( $sql ) my $sth = $dbh->prepare_cached($sql)
or croak( "Can't prepare '$sql': ".$dbh->errstr() ); or croak("Can't prepare '$sql': ".$dbh->errstr());
my $res = $sth->execute( $id ) my $res = $sth->execute($id)
or croak( "Can't execute '$sql': ".$sth->errstr() ); or croak("Can't execute '$sql': ".$sth->errstr());
my $monitor = $sth->fetchrow_hashref(); my $monitor = $sth->fetchrow_hashref();
return( $monitor ); return $monitor;
} }
sub zmDbGetMonitorAndControl { sub zmDbGetMonitorAndControl {

27
scripts/ZoneMinder/lib/ZoneMinder/Logger.pm
View File

@ -527,6 +527,7 @@ sub logPrint {
my $this = shift; my $this = shift;
my $level = shift; my $level = shift;
my $string = shift; my $string = shift;
my ($caller, undef, $line) = @_ ? @_ : caller;
if ( $level <= $this->{effectiveLevel} ) { if ( $level <= $this->{effectiveLevel} ) {
$string =~ s/[\r\n]+$//g; $string =~ s/[\r\n]+$//g;
@ -537,12 +538,14 @@ sub logPrint {
my ($seconds, $microseconds) = gettimeofday(); my ($seconds, $microseconds) = gettimeofday();
if ( $level <= $this->{fileLevel} or $level <= $this->{termLevel} ) { if ( $level <= $this->{fileLevel} or $level <= $this->{termLevel} ) {
my $message = sprintf( my $message = sprintf(
'%s.%06d %s[%d].%s [%s]' '%s.%06d %s[%d].%s [%s:%d] [%s]'
, strftime('%x %H:%M:%S', localtime($seconds)) , strftime('%x %H:%M:%S', localtime($seconds))
, $microseconds , $microseconds
, $this->{id} , $this->{id}
, $$ , $$
, $codes{$level} , $codes{$level}
, $caller
, $line
, $string , $string
); );
if ( $this->{trace} ) { if ( $this->{trace} ) {
@ -660,39 +663,39 @@ sub Dump {
sub debug { sub debug {
my $log = shift; my $log = shift;
$log->logPrint(DEBUG, @_); $log->logPrint(DEBUG, @_, caller);
} }
sub Debug( @ ) { sub Debug( @ ) {
fetch()->logPrint(DEBUG, @_); fetch()->logPrint(DEBUG, @_, caller);
} }
sub Info( @ ) { sub Info( @ ) {
fetch()->logPrint(INFO, @_); fetch()->logPrint(INFO, @_, caller);
} }
sub info { sub info {
my $log = shift; my $log = shift;
$log->logPrint(INFO, @_); $log->logPrint(INFO, @_, caller);
} }
sub Warning( @ ) { sub Warning( @ ) {
fetch()->logPrint(WARNING, @_); fetch()->logPrint(WARNING, @_, caller);
} }
sub warn { sub warn {
my $log = shift; my $log = shift;
$log->logPrint(WARNING, @_); $log->logPrint(WARNING, @_, caller);
} }
sub Error( @ ) { sub Error( @ ) {
fetch()->logPrint(ERROR, @_); fetch()->logPrint(ERROR, @_, caller);
} }
sub error { sub error {
my $log = shift; my $log = shift;
$log->logPrint(ERROR, @_); $log->logPrint(ERROR, @_, caller);
} }
sub Fatal( @ ) { sub Fatal( @ ) {
fetch()->logPrint(FATAL, @_); fetch()->logPrint(FATAL, @_, caller);
if ( $SIG{TERM} and ( $SIG{TERM} ne 'DEFAULT' ) ) { if ( $SIG{TERM} and ( $SIG{TERM} ne 'DEFAULT' ) ) {
$SIG{TERM}(); $SIG{TERM}();
} }
@ -700,7 +703,7 @@ sub Fatal( @ ) {
} }
sub Panic( @ ) { sub Panic( @ ) {
fetch()->logPrint(PANIC, @_); fetch()->logPrint(PANIC, @_, caller);
confess($_[0]); confess($_[0]);
} }

400
scripts/zmcontrol.pl.in
View File

@ -21,6 +21,195 @@
# #
# ========================================================================== # ==========================================================================
use strict;
@EXTRA_PERL_LIB@
use ZoneMinder;
use Getopt::Long;
use autouse 'Pod::Usage'=>qw(pod2usage);
use POSIX qw/strftime EPIPE/;
use Socket;
#use Data::Dumper;
use Module::Load::Conditional qw{can_load};;
use constant MAX_CONNECT_DELAY => 15;
use constant MAX_COMMAND_WAIT => 1800;
$| = 1;
$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
logInit();
my $arg_string = join( " ", @ARGV );
my $id;
my %options;
GetOptions(
'id=i' =>\$id,
'command=s' =>\$options{command},
'xcoord=i' =>\$options{xcoord},
'ycoord=i' =>\$options{ycoord},
'speed=i' =>\$options{speed},
'step=i' =>\$options{step},
'panspeed=i' =>\$options{panspeed},
'tiltspeed=i' =>\$options{tiltspeed},
'panstep=i' =>\$options{panstep},
'tiltstep=i' =>\$options{tiltstep},
'preset=i' =>\$options{preset},
'autostop' =>\$options{autostop},
) or pod2usage(-exitstatus => -1);
if ( !$id || !$options{command} ) {
print( STDERR "Please give a valid monitor id and command\n" );
pod2usage(-exitstatus => -1);
}
( $id ) = $id =~ /^(\w+)$/;
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: $!");
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 $protocol = $monitor->{Protocol};
if ( -x $protocol ) {
# Protocol is actually a script!
# Holdover from previous versions
my $command .= $protocol.' '.$arg_string;
Debug($command);
my $output = qx($command);
my $status = $? >> 8;
if ( $status || logDebugging() ) {
chomp($output);
Debug("Output: $output");
}
if ( $status ) {
Error("Command '$command' exited with status: $status");
exit($status);
}
exit(0);
}
Info("Starting control server $id/$protocol");
close(CLIENT);
if ( ! can_load( modules => { "ZoneMinder::Control::$protocol" => undef } ) ) {
Fatal("Can't load ZoneMinder::Control::$protocol\n$Module::Load::Conditional::ERROR");
}
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: $!");
my $attempts = 0;
while ( !connect(CLIENT, $saddr) ) {
$attempts++;
Fatal("Can't connect: $! after $attempts attempts to $sock_file") if $attempts > MAX_CONNECT_DELAY;
sleep(1);
}
} elsif ( defined($cpid) ) {
close(STDOUT);
close(STDERR);
setpgrp();
logReinit();
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_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: $!");
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);
my $message = <CLIENT>;
next if !$message;
my $params = jsonDecode($message);
#Debug( Dumper( $params ) );
my $command = $params->{command};
close( CLIENT );
if ( $command eq 'quit' ) {
last;
}
$control->$command($params);
} else {
Fatal('Bogus descriptor');
}
} elsif ( $nfound < 0 ) {
if ( $! == EPIPE ) {
Error("Can't select: $!");
} else {
Fatal("Can't select: $!");
}
} else {
#print( "Select timed out\n" );
last;
}
} # end while forever
Info("Control server $id/$protocol exiting");
unlink($sock_file);
$control->close();
exit(0);
} 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);
exit(0);
1;
__END__
=head1 NAME =head1 NAME
zmcontrol.pl - ZoneMinder control script zmcontrol.pl - ZoneMinder control script
@ -47,214 +236,3 @@ FIXME FIXME
--preset [ arg ] - --preset [ arg ] -
=cut =cut
use strict;
@EXTRA_PERL_LIB@
use ZoneMinder;
use Getopt::Long;
use autouse 'Pod::Usage'=>qw(pod2usage);
use POSIX qw/strftime EPIPE/;
use Socket;
#use Data::Dumper;
use Module::Load::Conditional qw{can_load};;
use constant MAX_CONNECT_DELAY => 10;
use constant MAX_COMMAND_WAIT => 1800;
$| = 1;
$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
logInit();
my $arg_string = join( " ", @ARGV );
my $id;
my %options;
GetOptions(
'id=i' =>\$id,
'command=s' =>\$options{command},
'xcoord=i' =>\$options{xcoord},
'ycoord=i' =>\$options{ycoord},
'speed=i' =>\$options{speed},
'step=i' =>\$options{step},
'panspeed=i' =>\$options{panspeed},
'tiltspeed=i' =>\$options{tiltspeed},
'panstep=i' =>\$options{panstep},
'tiltstep=i' =>\$options{tiltstep},
'preset=i' =>\$options{preset},
'autostop' =>\$options{autostop},
) or pod2usage(-exitstatus => -1);
if ( !$id || !$options{command} )
{
print( STDERR "Please give a valid monitor id and command\n" );
pod2usage(-exitstatus => -1);
}
( $id ) = $id =~ /^(\w+)$/;
Debug( $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: $!" );
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 $protocol = $monitor->{Protocol};
if ( -x $protocol )
{
# Protocol is actually a script!
# Holdover from previous versions
my $command .= $protocol.' '.$arg_string;
Debug( $command."\n" );
my $output = qx($command);
my $status = $? >> 8;
if ( $status || logDebugging() )
{
chomp( $output );
Debug( "Output: $output\n" );
}
if ( $status )
{
Error( "Command '$command' exited with status: $status\n" );
exit( $status );
}
exit( 0 );
}
Info( "Starting control server $id/$protocol" );
close( CLIENT );
if ( ! can_load( modules => { "ZoneMinder::Control::$protocol" => undef } ) ) {
Fatal("Can't load ZoneMinder::Control::$protocol");
}
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: $!" );
my $attempts = 0;
while (!connect( CLIENT, $saddr ))
{
$attempts++;
Fatal( "Can't connect: $! after $attempts attempts to $sock_file" ) if ($attempts > MAX_CONNECT_DELAY);
sleep(1);
}
}
elsif ( defined($cpid) )
{
close( STDOUT );
close( STDERR );
setpgrp();
logReinit();
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_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: $!" );
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 );
my $message = <CLIENT>;
next if ( !$message );
my $params = jsonDecode( $message );
#Debug( Dumper( $params ) );
my $command = $params->{command};
close( CLIENT );
if ( $command eq 'quit' ) {
last;
}
$control->$command( $params );
}
else
{
Fatal( "Bogus descriptor" );
}
}
elsif ( $nfound < 0 )
{
if ( $! == EPIPE )
{
Error( "Can't select: $!" );
}
else
{
Fatal( "Can't select: $!" );
}
}
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 );
$control->close();
exit( 0 );
}
else
{
Fatal( "Can't fork: $!" );
}
}
# The server is there, connect to it
#print( "Writing commands\n" );
CLIENT->autoflush();
my $message = jsonEncode( \%options );
print( CLIENT $message );
shutdown( CLIENT, 1 );
exit( 0 );

7
src/zm_config.cpp
View File

@ -123,9 +123,9 @@ void process_configfile( char* configFile) {
if ( *line_ptr == '\0' || *line_ptr == '#' ) if ( *line_ptr == '\0' || *line_ptr == '#' )
continue; continue;
// Remove trailing white space // Remove trailing white space and trailing quotes
char *temp_ptr = line_ptr+strlen(line_ptr)-1; char *temp_ptr = line_ptr+strlen(line_ptr)-1;
while ( *temp_ptr == ' ' || *temp_ptr == '\t' ) { while ( *temp_ptr == ' ' || *temp_ptr == '\t' || *temp_ptr == '\'' || *temp_ptr == '\"') {
*temp_ptr-- = '\0'; *temp_ptr-- = '\0';
temp_ptr--; temp_ptr--;
} }
@ -147,8 +147,9 @@ void process_configfile( char* configFile) {
temp_ptr--; temp_ptr--;
} while ( *temp_ptr == ' ' || *temp_ptr == '\t' ); } while ( *temp_ptr == ' ' || *temp_ptr == '\t' );
// Remove leading white space from the value part // Remove leading white space and leading quotes from the value part
white_len = strspn( val_ptr, " \t" ); white_len = strspn( val_ptr, " \t" );
white_len += strspn( val_ptr, "\'\"" );
val_ptr += white_len; val_ptr += white_len;
if ( strcasecmp( name_ptr, "ZM_DB_HOST" ) == 0 ) if ( strcasecmp( name_ptr, "ZM_DB_HOST" ) == 0 )

2
web/includes/config.php.in
View File

@ -212,7 +212,7 @@ function process_configfile($configFile) {
continue; continue;
elseif ( preg_match( '/^\s*#/', $str )) elseif ( preg_match( '/^\s*#/', $str ))
continue; continue;
elseif ( preg_match( '/^\s*([^=\s]+)\s*=\s*(.*?)\s*$/', $str, $matches )) elseif ( preg_match( '/^\s*([^=\s]+)\s*=\s*[\'"]*(.*?)[\'"]*\s*$/', $str, $matches ))
$configvals[$matches[1]] = $matches[2]; $configvals[$matches[1]] = $matches[2];
} }
fclose( $cfg ); fclose( $cfg );