D-Link DCS-5020L Control Script

[code]

1. =========================================================================r
3. ZoneMinder D-Link DCS-5020L IP Control Protocol Module, $Date: $, $Revision: $
5. This program is free software; you can redistribute it and/or
6. modify it under the terms of the GNU General Public License
7. as published by the Free Software Foundation; either version 2
8. of the License, or (at your option) any later version.
10. This program is distributed in the hope that it will be useful,
11. but WITHOUT ANY WARRANTY; without even the implied warranty of
12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13. GNU General Public License for more details.
15. You should have received a copy of the GNU General Public License
16. along with this program; if not, write to the Free Software
17. Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19. ==========================================================================
21. This module contains the implementation of the D-Link DCS-5020L IP camera control
22. protocol.

package ZoneMinder::Control::DLink-DCS5020L;

use 5.006; use strict; use warnings;

require ZoneMinder::Base; require ZoneMinder::Control;

our @ISA = qw(ZoneMinder::Control);

our $VERSION = $ZoneMinder::Base::VERSION;

1. ==========================================================================
3. D-Link DCS-5020L Control Protocol
5. ==========================================================================

use ZoneMinder::Logger qw(:all); use ZoneMinder::Config qw(:all);

use Time::HiRes qw( usleep );

sub new {

   my $class = shift;
   my $id = shift;
   my $self = ZoneMinder::Control->new( $id );
   bless( $self, $class );
   srand( time() );
   return $self;

}

our $AUTOLOAD;

sub AUTOLOAD {

   my $self = shift;
   my $class = ref($self) || croak( "$self not object" );
   my $name = $AUTOLOAD;
   $name =~ s/.*://;
   if ( exists($self->{$name}) )
   {
       return( $self->{$name} );
   }
   Fatal( "Can't access $name member of object of class $class" );

}

sub open {

   my $self = shift;

   $self->loadMonitor();

   use LWP::UserAgent;
   $self->{ua} = LWP::UserAgent->new;
   $self->{ua}->agent( "ZoneMinder Control Agent/".ZM_VERSION );

   $self->{state} = 'open';

}

sub close {

   my $self = shift;
   $self->{state} = 'closed';

}

sub printMsg {

   my $self = shift;
   my $msg = shift;
   my $msg_len = length($msg);

   Debug( $msg."[".$msg_len."]" );

}

sub sendCmd {

   my $self = shift;
   my $cmd = shift;

   my $result = undef;

   printMsg( $cmd, "Tx" );

   my $req = HTTP::Request->new( POST=>"http://".$self->{Monitor}->{ControlAddress}."/PANTILTCONTROL.CGI" );
   $req->content($cmd);
   my $res = $self->{ua}->request($req);

   if ( $res->is_success )
   {
       $result = !undef;
   }
   else
   {
       Error( "Error check failed: '".$res->status_line()."'" );
   }

   return( $result );

}

sub move {

   my $self = shift;
   my $dir = shift;
   my $panSteps = shift;
   my $tiltSteps = shift;

   my $cmd = "PanSingleMoveDegree=$panSteps&TiltSingleMoveDegree=$tiltSteps&PanTiltSingleMove=$dir";
   $self->sendCmd( $cmd );

}

sub moveRelUpLeft {

   my $self = shift;
   Debug( "Move Up Left" );
   $self->move( 0, 1, 1 );

}

sub moveRelUp {

   my $self = shift;
   Debug( "Move Up" );
   $self->move( 1, 1, 1 );

}

sub moveRelUpRight {

   my $self = shift;
   Debug( "Move Up" );
   $self->move( 2, 1, 1 );

}

sub moveRelLeft {

   my $self = shift;
   Debug( "Move Left" );
   $self->move( 3, 1, 1 );

}

sub moveRelRight {

   my $self = shift;
   Debug( "Move Right" );
   $self->move( 5, 1, 1 );

}

sub moveRelDownLeft {

   my $self = shift;
   Debug( "Move Down" );
   $self->move( 6, 1, 1 );

}

sub moveRelDown {

   my $self = shift;
   Debug( "Move Down" );
   $self->move( 7, 1, 1 );

}

sub moveRelDownRight {

   my $self = shift;
   Debug( "Move Down" );
   $self->move( 8, 1, 1 );

}

1. moves the camera to center on the point that the user clicked on in the video image.
2. This isn't extremely accurate but good enough for most purposes

sub moveMap {

   # if the camera moves too much or too little, try increasing or decreasing this value
   my $f = 11;

   my $self = shift;
   my $params = shift;
   my $xcoord = $self->getParam( $params, 'xcoord' );
   my $ycoord = $self->getParam( $params, 'ycoord' );

   my $hor = $xcoord * 100 / $self->{Monitor}->{Width};
   my $ver = $ycoord * 100 / $self->{Monitor}->{Height};
  
   my $direction;
   my $horSteps;
   my $verSteps;
   if ($hor < 50 && $ver < 50) {
       # up left
       $horSteps = (50 - $hor) / $f;
       $verSteps = (50 - $ver) / $f;
       $direction = 0;
   } elsif ($hor >= 50 && $ver < 50) {
       # up right
       $horSteps = ($hor - 50) / $f;
       $verSteps = (50 - $ver) / $f;
       $direction = 2;
   } elsif ($hor < 50 && $ver >= 50) {
       # down left
       $horSteps = (50 - $hor) / $f;
       $verSteps = ($ver - 50) / $f;
       $direction = 6;
   } elsif ($hor >= 50 && $ver >= 50) {
       # down right
       $horSteps = ($hor - 50) / $f;
       $verSteps = ($ver - 50) / $f;
       $direction = 8;
   }
   my $v = int($verSteps + .5);
   my $h = int($horSteps + .5);
   Debug( "Move Map to $xcoord,$ycoord, hor=$h, ver=$v with direction $direction" );
   $self->move( $direction, $h, $v );

}

1. this clear function works, but should probably be disabled because
2. it isn't possible to set presets yet.

sub presetClear {

   my $self = shift;
   my $params = shift;
   my $preset = $self->getParam( $params, 'preset' );
   Debug( "Clear Preset $preset" );
   my $cmd = "ClearPosition=$preset";
   $self->sendCmd( $cmd );

}

1. not working yet

sub presetSet {

   my $self = shift;
   my $params = shift;
   my $preset = $self->getParam( $params, 'preset' );
   Debug( "Set Preset $preset" );
   # TODO need to first get current position $horPos and $verPos
   #my $cmd = "PanTiltHorizontal=$horPos&PanTiltVertical=$verPos&SetName=$preset&SetPosition=$preset";
   #$self->sendCmd( $cmd );

}

sub presetGoto {

   my $self = shift;
   my $params = shift;
   my $preset = $self->getParam( $params, 'preset' );
   Debug( "Goto Preset $preset" );
   my $cmd = "PanTiltPresetPositionMove=$preset";
   $self->sendCmd( $cmd );

}

sub presetHome {

   my $self = shift;
   Debug( "Home Preset" );
   my $cmd = "PanTiltSingleMove=4";
   $self->sendCmd( $cmd );

}

1; __END__

1. Below is stub documentation for your module. You'd better edit it!

=head1 NAME

ZoneMinder::Database - Perl extension for DCS-5020L

=head1 SYNOPSIS

 use ZoneMinder::Database;
 DLINK DCS-5020L

=head1 DESCRIPTION

ZoneMinder driver for the D-Link consumer camera DCS-5020L.

=head2 EXPORT

None by default.

=head1 SEE ALSO

See if there are better instructions for the DCS-5020L at http://www.zoneminder.com/wiki/index.php/Dlink

=head1 AUTHOR

Art Scheel <lt>ascheel (at) gmail<gt>

=head1 COPYRIGHT AND LICENSE

LGPLv3

=cut [/code]