Update, add url parsing to match other control scripts. Add getConfig and setConfig
This commit is contained in:
Isaac Connor
parent
cebe86feb2
commit
c864d0765b
|
|
@ -41,122 +41,135 @@ our @ISA = qw(ZoneMinder::Control);
|
|||
|
||||
use ZoneMinder::Logger qw(:all);
|
||||
use ZoneMinder::Config qw(:all);
|
||||
use ZoneMinder::General qw(:all);
|
||||
|
||||
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;
|
||||
|
||||
$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;
|
||||
$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 close
|
||||
{
|
||||
sub close {
|
||||
my $self = shift;
|
||||
$self->{state} = 'closed';
|
||||
}
|
||||
|
||||
sub printMsg
|
||||
{
|
||||
my $msg = shift;
|
||||
my $msg_len = length($msg);
|
||||
|
||||
Debug( $msg."[".$msg_len."]" );
|
||||
}
|
||||
|
||||
sub sendCmd
|
||||
{
|
||||
sub sendCmd {
|
||||
my ($self, $cmd, $speedcmd) = @_;
|
||||
|
||||
my $result = undef;
|
||||
$self->printMsg( $speedcmd, 'Tx' );
|
||||
$self->printMsg( $cmd, 'Tx' );
|
||||
|
||||
printMsg( $speedcmd, "Tx" );
|
||||
printMsg( $cmd, "Tx" );
|
||||
|
||||
my $req = HTTP::Request->new( GET => "http://" . $self->{Monitor}->{ControlAddress} . "/cgi-bin/camctrl/eCamCtrl.cgi?stream=0&$speedcmd&$cmd" );
|
||||
my $req = HTTP::Request->new( GET => $BASE_URL."/cgi-bin/camctrl/eCamCtrl.cgi?stream=0&$speedcmd&$cmd");
|
||||
my $res = $self->{ua}->request($req);
|
||||
|
||||
if ( $res->is_success )
|
||||
{
|
||||
$result = !undef;
|
||||
if (!$res->is_success) {
|
||||
Error('Request failed: '.$res->status_line().' (URI: '.$req->as_string().')');
|
||||
}
|
||||
else
|
||||
{
|
||||
Error( "Request failed: '" . $res->status_line() . "' (URI: '" . $req->as_string() . "')" );
|
||||
}
|
||||
|
||||
return( $result );
|
||||
return $res->is_success;
|
||||
}
|
||||
|
||||
sub moveConUp
|
||||
{
|
||||
sub moveConUp {
|
||||
my ($self, $params) = @_;
|
||||
my $speed = 'speedtilt=' . ($params->{tiltspeed} - 6);
|
||||
Debug( "Move Up" );
|
||||
$self->sendCmd( 'move=up', $speed );
|
||||
}
|
||||
|
||||
sub moveConDown
|
||||
{
|
||||
sub moveConDown {
|
||||
my ($self, $params) = @_;
|
||||
my $speed = 'speedtilt=' . ($params->{tiltspeed} - 6);
|
||||
Debug( "Move Down" );
|
||||
$self->sendCmd( 'move=down', $speed );
|
||||
}
|
||||
|
||||
sub moveConLeft
|
||||
{
|
||||
sub moveConLeft {
|
||||
my ($self, $params) = @_;
|
||||
my $speed = 'speedpan=-' . $params->{panspeed};
|
||||
Debug( "Move Left" );
|
||||
$self->sendCmd( 'move=left', $speed );
|
||||
}
|
||||
|
||||
sub moveConRight
|
||||
{
|
||||
sub moveConRight {
|
||||
my ($self, $params) = @_;
|
||||
my $speed = 'speedpan=' . ($params->{panspeed} - 6);
|
||||
Debug( "Move Right" );
|
||||
$self->sendCmd( 'move=right', $speed );
|
||||
}
|
||||
|
||||
sub moveStop
|
||||
{
|
||||
sub moveStop {
|
||||
my $self = shift;
|
||||
Debug( "Move Stop" );
|
||||
Debug( "Move Stop: not implemented" );
|
||||
# not implemented
|
||||
}
|
||||
|
||||
sub zoomConTele
|
||||
{
|
||||
sub zoomConTele {
|
||||
my ($self, $params) = @_;
|
||||
my $speed = 'speedzoom=' . ($params->{speed} - 6);
|
||||
Debug( "Zoom In" );
|
||||
$self->sendCmd( 'zoom=tele', $speed );
|
||||
}
|
||||
|
||||
sub zoomConWide
|
||||
{
|
||||
sub zoomConWide {
|
||||
my ($self, $params) = @_;
|
||||
my $speed = 'speedzoom=' . ($params->{speed} - 6);
|
||||
Debug( "Zoom Out" );
|
||||
$self->sendCmd( 'zoom=wide', $speed );
|
||||
}
|
||||
|
||||
sub reset
|
||||
{
|
||||
sub reset {
|
||||
my $self = shift;
|
||||
Debug( "Camera Reset" );
|
||||
$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;
|
||||
__END__
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue