Complete installation/configuration instructions are in the perldoc at the end of the file. Install the following as Toshiba_IK_WB16A.pm
Code: Select all
# ==========================================================================
#
# ZoneMinder Toshiba IK-WB16A Control Protocol Module
# Copyright (C) 2017 Alan Ballard
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# 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 Toshiba IK-WB16A camera control
# protocol
#
package ZoneMinder::Control::Toshiba_IK_WB16A;
use 5.006;
use strict;
use warnings;
require ZoneMinder::Base;
require ZoneMinder::Control;
our @ISA = qw(ZoneMinder::Control);
# ==========================================================================
#
# Toshiba IK-WB16A 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 );
Debug( "Camera new" );
bless( $self, $class );
$self->{name} = "ToshibaWB16A"; # base hardwires PelcoD !
srand( time() );
return $self;
}
our $AUTOLOAD;
sub AUTOLOAD
{
my $self = shift;
my $class = ref($self) || croak( "$self not object" );
my $name = $AUTOLOAD;
Debug( "Camera AUTOLOAD" );
$name =~ s/.*://;
if ( exists($self->{$name}) )
{
return( $self->{$name} );
}
Fatal( "Can't access $name member of object of class $class" );
}
# Base Control.pl expects this to be defined (see Control.pl). Though doesn't seem to be used unless called from here.
sub printMsg
{
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]" );
}
sub open
{
my $self = shift;
$self->loadMonitor();
Debug( "Camera open" );
#Debug ( Data::Dumper::Dumper($self ) );
use LWP::UserAgent;
$self->{ua} = LWP::UserAgent->new;
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION );
$self->{state} = 'open';
# Init our global data. Make sure we set speed first time.
# See comments below re "speed" vs. "step"
$self->{toshibadata} = {speedPan => undef,
speedTilt => undef,
speedZoom => undef,
presets => []
};
}
sub close
{
my $self = shift;
$self->{state} = 'closed';
}
sub moveRelUp
{
my ($self, $params) = @_;
my $step = $params->{tiltstep};
Debug( "Move Up $step" );
$self->setTiltSpeed( $step);
$self->sendMoveCmd( 'move=up' );
}
sub moveRelDown
{
my ($self, $params) = @_;
my $step = $params->{tiltstep};
Debug( "Move Down $step" );
$self->setTiltSpeed( $step);
$self->sendMoveCmd( 'move=down' );
}
sub moveRelLeft
{
my ($self, $params) = @_;
my $step = $params->{panstep};
Debug( "Move Left $step " );
$self->setPanSpeed( $step);
$self->sendMoveCmd( 'move=left');
}
sub moveRelRight
{
my ($self, $params) = @_;
my $step = $params->{panstep};
Debug( "Move Right $step " );
$self->setPanSpeed( $step);
$self->sendMoveCmd( 'move=right' );
}
sub zoomRelTele
{
my ($self, $params) = @_;
my $step = $params->{step};
Debug( "Zoom In $step" );
$self->setZoomSpeed( $step);
$self->sendZoomCmd( 'zoom=tele');
}
sub zoomRelWide
{
my ($self, $params) = @_;
my $step = $params->{step};
Debug( "Zoom Out $step" );
$self->setZoomSpeed( $step);
$self->sendZoomCmd( 'zoom=wide');
}
sub presetHome
{
my $self = shift;
Debug( "Camera Home" );
$self->sendMoveCmd( 'move=home' );
}
sub presetGoto
{
my ($self, $params) = @_;
my $preset = $self->getParam( $params, 'preset' );
my $presetName = $self->getPresetName($preset);
if (defined ($presetName))
{
Debug( "Goto Preset $preset ($presetName)" );
$self->sendCmd("recall=$presetName", "camctrl/recall.cgi", "stream=0");
} else
{
Error("Preset $preset is not defined");
}
}
sub getPresetName
{
my ($self, $preset) = @_;
my $knownpresets = $self->{toshibadata}->{presets};
my $name = $knownpresets->[$preset];
if (defined($name) )
{
# if we've cached a null string we already know it is undefined
return ($name eq "") ? undef : $name;
}
my $key = "camctrl_c0_preset_i" . ($preset - 1) . "_name";
my $res = $self->sendCmd($key, "viewer/getparam.cgi", "channel=0");
if (defined ($res) )
{
Debug("lookup preset $key returns $res");
# should be key='value'
my $pattern = "$key='([^']+)'";
if ($res =~ /$pattern/)
{
$name = $1;
$knownpresets->[$preset] = $name;
return $name;
}
}
$knownpresets->[$preset] = ""; # cache that it doesn't exist
return undef;
}
sub setPanSpeed
{
my ($self, $step) = @_;
my $oldstep = $self->{toshibadata}->{speedPan};
Debug("pan speed $step was $oldstep ");
if (defined($step) && $step != $oldstep) {
if (defined ($self->sendMoveSpeedCmd("speedpan=" . $step) ) )
{
$self->{toshibadata}->{speedPan} = $step;
}
}
}
sub setTiltSpeed
{
my ($self, $step) = @_;
my $oldstep = $self->{toshibadata}->{speedTilt};
Debug("tilt speed $step was $oldstep ");
if (defined($step) && $step != $oldstep) {
if (defined($self->sendMoveSpeedCmd("speedtilt=" . $step) ) )
{
$self->{toshibadata}->{speedTilt} = $step;
}
}
}
sub setZoomSpeed
{
my ($self, $step) = @_;
# ZM seems to not allow a negative min in the definition of zoom step size.
# Range should be -5 to +5; using 0 to 10 instead.
if (defined($step)) {
$step -= 5;
my $oldstep = $self->{toshibadata}->{speedZoom};
Debug("zoom speed $step was $oldstep ");
if ($step != $oldstep) {
if (defined($self->sendZoomSpeedCmd("speedzoom=" . $step) ) )
{
$self->{toshibadata}->{speedZoom} = $step;
}
}
}
}
# move commands seem to use channel and stream, move speed commands specify channel but no
# stream. Zoom speed and zoom commands specify stream but no channel. But value of stream doesn't
# seem to matter; all commands affect all streams. Not sure if value of channel is used for anything.
# Using 0 for stream and channel seems to work fine.
#
# Commands except those setting the zoom "speed" use the program camctrl.cgi. Zoom speed uses
# eCamCtrl.cgi. This does seem to matter. Presumably this is a remnant from the camera's Vivotek heritage.
# (The Vivotek control program seems to use eCamCtrl.cgi for everything).
#
# The Toshiba api uses parameters ..speed to determine how much movement is done. This corresponds more closely
# to the "step" size in Zoneminder. I've defined the movements as relative using step for the Toshiba speed setting.
sub sendMoveCmd
{
return sendCmd(@_, "camctrl/camctrl.cgi", "channel=0&stream=0");
}
sub sendMoveSpeedCmd() {
return sendCmd(@_, "camctrl/camctrl.cgi", "channel=0");
}
sub sendZoomSpeedCmd
{
return sendCmd(@_, "camctrl/eCamCtrl.cgi", "stream=0");
}
sub sendZoomCmd
{
return sendCmd(@_, "camctrl/camctrl.cgi", "stream=0");
}
sub sendCmd
{
my ($self, $cmd, $program, $params) = @_;
my $result = undef;
my $req = HTTP::Request->new( GET => "http://" . $self->{Monitor}->{ControlAddress} .
"/cgi-bin/$program?$params&$cmd" );
Debug( "Request: " . $req->uri );
my $res = $self->{ua}->request($req);
if ( $res->is_success )
{
$result = $res->decoded_content;
}
else
{
Error( "Request failed: '" . $res->status_line() . "' (URI: '" . $req->as_string() . "')" );
}
return $result;
}
1;
__END__
=head1 NAME
ZoneMinder::Control::Toshiba_IK_WB16A - ZoneMinder Perl extension for Toshiba IK-WB16A
camera control protocol
=head1 SYNOPSIS
use ZoneMinder::Control::Toshiba_IK_WB16A;
=head1 DESCRIPTION
This module implements the control protocol used by the Toshiba IK-WB16A (and perhaps other Toshiba
cameras). This is similar to, but different from, the protocol of various Vivotek IP cameras.
It should support all known viewer control functionality of the camera. Setting presets operator
functionality is not currently supported.
To use this extension:
=over 4
=item -
Drop this file into F</usr/share/perl5/ZoneMinder/Control> (Ubuntu), or equivalent for your distro.
=item -
Add it to the control database (once only if you have multiple cameras) as follows:
=over 2
=item *
Edit your monitor definition and go to the control page.
=item *
Click C<edit> next to Control Type.
=item *
Click C<Add New Control>.
=item *
Fill in the new control definition as follows:
=over 10
=item Main page
NAME=Toshiba IK-WB16A
TYPE=Remote
PROTOCOL=Toshiba_IK_WB16A
=item Move page
CAN MOVE checked
CAN MOVE RELATIVE checked
=item Pan page
CAN PAN checked
MIN PAN STEP=-1
MAX PAN STEP=5
=item Tilt page
CAN TILT checked
MIN TILT STEP=-1
MAX TILT STEP=5
=item Zoom page
CAN ZOOM checked
CAN ZOOL RELATIVE checked
MIN ZOOM STEP 0
MAX ZOOM STEP 10
=item Focus, White, Iris pages
nothing required
=item Presets page
HAS PRESETS checked
NUM PRESETS 10 (more or less OK)
HAS HOME PRESET checked
=back
=back
=item -
For each camera using this protocol, edit the camera definition and go to the control page.
Fill it in as follows:
=over 2
Controllable checked
Control Type=Toshiba IK-WB16A
Control Address=I<URL for your camera>. If ID and password are required they can be specified as I<id:password@url>
=back
=back
=head2 EXPORT
None.
=head1 SEE ALSO
I would say, see ZoneMinder::Control documentation. But it is a stub.
=head1 AUTHOR
Alan Ballard<alan AT aballard.ca>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2017 by Alan Ballard
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