Update, add url parsing to match other control scripts. Add getConfig and setConfig

This commit is contained in:
Isaac Connor 2021-10-26 18:10:39 -04:00
parent cebe86feb2
commit c864d0765b
1 changed files with 99 additions and 86 deletions

View File

@ -41,122 +41,135 @@ our @ISA = qw(ZoneMinder::Control);
use ZoneMinder::Logger qw(:all); use ZoneMinder::Logger qw(:all);
use ZoneMinder::Config qw(:all); use ZoneMinder::Config qw(:all);
use ZoneMinder::General qw(:all);
use Time::HiRes qw( usleep ); use Time::HiRes qw( usleep );
use URI::Encode qw(uri_encode);
sub open our $REALM = '';
{ our $PROTOCOL = 'http://';
our $USERNAME = 'admin';
our $PASSWORD = '';
our $ADDRESS = '';
our $BASE_URL = '';
sub open {
my $self = shift; my $self = shift;
$self->loadMonitor(); $self->loadMonitor();
Debug( "Camera open" );
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';
}
$BASE_URL = $PROTOCOL.($USERNAME?$USERNAME.':'.$PASSWORD.'@':'').$ADDRESS;
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 close sub close {
{
my $self = shift; my $self = shift;
$self->{state} = 'closed'; $self->{state} = 'closed';
} }
sub printMsg sub sendCmd {
{
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]" );
}
sub sendCmd
{
my ($self, $cmd, $speedcmd) = @_; my ($self, $cmd, $speedcmd) = @_;
my $result = undef; $self->printMsg( $speedcmd, 'Tx' );
$self->printMsg( $cmd, 'Tx' );
printMsg( $speedcmd, "Tx" ); my $req = HTTP::Request->new( GET => $BASE_URL."/cgi-bin/camctrl/eCamCtrl.cgi?stream=0&$speedcmd&$cmd");
printMsg( $cmd, "Tx" );
my $req = HTTP::Request->new( GET => "http://" . $self->{Monitor}->{ControlAddress} . "/cgi-bin/camctrl/eCamCtrl.cgi?stream=0&$speedcmd&$cmd" );
my $res = $self->{ua}->request($req); my $res = $self->{ua}->request($req);
if ( $res->is_success ) if (!$res->is_success) {
{ Error('Request failed: '.$res->status_line().' (URI: '.$req->as_string().')');
$result = !undef;
} }
else return $res->is_success;
{
Error( "Request failed: '" . $res->status_line() . "' (URI: '" . $req->as_string() . "')" );
} }
return( $result ); sub moveConUp {
}
sub moveConUp
{
my ($self, $params) = @_; my ($self, $params) = @_;
my $speed = 'speedtilt=' . ($params->{tiltspeed} - 6); my $speed = 'speedtilt=' . ($params->{tiltspeed} - 6);
Debug( "Move Up" );
$self->sendCmd( 'move=up', $speed ); $self->sendCmd( 'move=up', $speed );
} }
sub moveConDown sub moveConDown {
{
my ($self, $params) = @_; my ($self, $params) = @_;
my $speed = 'speedtilt=' . ($params->{tiltspeed} - 6); my $speed = 'speedtilt=' . ($params->{tiltspeed} - 6);
Debug( "Move Down" );
$self->sendCmd( 'move=down', $speed ); $self->sendCmd( 'move=down', $speed );
} }
sub moveConLeft sub moveConLeft {
{
my ($self, $params) = @_; my ($self, $params) = @_;
my $speed = 'speedpan=-' . $params->{panspeed}; my $speed = 'speedpan=-' . $params->{panspeed};
Debug( "Move Left" );
$self->sendCmd( 'move=left', $speed ); $self->sendCmd( 'move=left', $speed );
} }
sub moveConRight sub moveConRight {
{
my ($self, $params) = @_; my ($self, $params) = @_;
my $speed = 'speedpan=' . ($params->{panspeed} - 6); my $speed = 'speedpan=' . ($params->{panspeed} - 6);
Debug( "Move Right" );
$self->sendCmd( 'move=right', $speed ); $self->sendCmd( 'move=right', $speed );
} }
sub moveStop sub moveStop {
{
my $self = shift; my $self = shift;
Debug( "Move Stop" ); Debug( "Move Stop: not implemented" );
# not implemented # not implemented
} }
sub zoomConTele sub zoomConTele {
{
my ($self, $params) = @_; my ($self, $params) = @_;
my $speed = 'speedzoom=' . ($params->{speed} - 6); my $speed = 'speedzoom=' . ($params->{speed} - 6);
Debug( "Zoom In" );
$self->sendCmd( 'zoom=tele', $speed ); $self->sendCmd( 'zoom=tele', $speed );
} }
sub zoomConWide sub zoomConWide {
{
my ($self, $params) = @_; my ($self, $params) = @_;
my $speed = 'speedzoom=' . ($params->{speed} - 6); my $speed = 'speedzoom=' . ($params->{speed} - 6);
Debug( "Zoom Out" );
$self->sendCmd( 'zoom=wide', $speed ); $self->sendCmd( 'zoom=wide', $speed );
} }
sub reset sub reset {
{
my $self = shift; my $self = shift;
Debug( "Camera Reset" );
$self->sendCmd( 'move=home' ); $self->sendCmd( 'move=home' );
} }
sub get_config {
my $self = shift;
my $url = $BASE_URL.'/cgi-bin/admin/lsctrl.cgi?cmd=queryStatus&retType=javascript';
my $req = new HTTP::Request(GET => $url);
my $response = $self->{ua}->request($req);
if ( $response->is_success() ) {
my $resp = $response->decoded_content;
return ZoneMinder::General::parseNameEqualsValueToHash($resp);
}
Warn("Failed to get config from $url: " . $response->status_line());
return;
} # end sub get_config
sub set_config {
my $self = shift;
my $diff = shift;
my $url = $BASE_URL.'/cgi-bin/'.$USERNAME.'/setparam.cgi?'.
join('&', map { $_.'='.uri_encode($$diff{$_}) } keys %$diff);
my $response = $self->{ua}->get($url);
Debug($response->content);
return $response->is_success();
}
1; 1;
__END__ __END__