Lbdg: Fix: -->Bareword "VERSION" not allowed while "strict subs" in use at test.pm line 82

2015-08-25T12:38:31Z

Fix: -->Bareword "VERSION" not allowed while "strict subs" in use at test.pm line 82

← Older revision		Revision as of 08:38, 25 August 2015
Line 81:		Line 81:
	use LWP::UserAgent;		use LWP::UserAgent;
	$self->{ua} = LWP::UserAgent->new;		$self->{ua} = LWP::UserAgent->new;
	$self->{ua}->agent( "ZoneMinder Control Agent/".ZM_VERSION );		$self->{ua}->agent( "ZoneMinder Control Agent/" . ZoneMinder::Base::ZM_VERSION );

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

Thekorn: Add IR auto mode to script

2014-04-29T17:41:09Z

Add IR auto mode to script

← Older revision		Revision as of 13:41, 29 April 2014
Line 302:		Line 302:
	$self->sendCmd( $cmd );		$self->sendCmd( $cmd );
	}		}


			# IR Controls
			#
			# wake = IR on
			# sleep = IR off
			# reset = IR auto


	sub wake		sub wake
Line 310:		Line 318:
	$self->sendCmd2( $cmd );		$self->sendCmd2( $cmd );
	}		}

	sub sleep		sub sleep
	{		{
Line 315:		Line 324:
	Debug( "Sleep - IR off" );		Debug( "Sleep - IR off" );
	my $cmd = "setDaynightMode?ReplySuccessPage=night.htm&ReplyErrorPage=errrnight.htm&DayNightMode=2&ConfigDayNightMode=Save";		my $cmd = "setDaynightMode?ReplySuccessPage=night.htm&ReplyErrorPage=errrnight.htm&DayNightMode=2&ConfigDayNightMode=Save";
			$self->sendCmd2( $cmd );
			}

			sub reset
			{
			my $self = shift;
			Debug( "Reset - IR auto" );
			my $cmd = "setDaynightMode?ReplySuccessPage=night.htm&ReplyErrorPage=errrnight.htm&DayNightMode=0&ConfigDayNightMode=Save";
	$self->sendCmd2( $cmd );		$self->sendCmd2( $cmd );
	}		}

Utahjarhead at 01:46, 19 November 2013

2013-11-19T01:46:21Z

Show changes

Thekorn: Change control package name from Dlink-DCS5020L to DCS5020L.

2013-10-07T16:53:46Z

Change control package name from Dlink-DCS5020L to DCS5020L.

← Older revision		Revision as of 12:53, 7 October 2013
Line 23:		Line 23:
	# protocol.		# protocol.
	#		#
	package ZoneMinder::Control::~~DLink-~~DCS5020L;		package ZoneMinder::Control::DCS5020L;

	use 5.006;		use 5.006;

Utahjarhead at 03:36, 22 September 2013

2013-09-22T03:36:46Z

← Older revision		Revision as of 23:36, 21 September 2013
Line 309:		Line 309:
	=head1 AUTHOR		=head1 AUTHOR

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

	=head1 COPYRIGHT AND LICENSE		=head1 COPYRIGHT AND LICENSE

Utahjarhead at 03:36, 22 September 2013

2013-09-22T03:36:04Z

← Older revision		Revision as of 23:36, 21 September 2013
Line 1:		Line 1:
	~~[code]~~		<pre>
	# =========================================================================r		# =========================================================================r
	#		#
Line 316:		Line 316:

	=cut		=cut
	[/~~code]~~		</pre>

Utahjarhead at 03:35, 22 September 2013

2013-09-22T03:35:42Z

← Older revision		Revision as of 23:35, 21 September 2013
Line 1:		Line 1:
			[code]
	# =========================================================================r		# =========================================================================r
	#		#
Line 315:		Line 316:

	=cut		=cut
			[/code]

Utahjarhead: Created page with "# =========================================================================r # # ZoneMinder D-Link DCS-5020L IP Control Protocol Module, $Date: $, $Revision: $ # # This progra..."

2013-09-22T03:35:28Z

Created page with "# =========================================================================r # # ZoneMinder D-Link DCS-5020L IP Control Protocol Module, $Date: $, $Revision: $ # # This progra..."

New page

# =========================================================================r
#
# ZoneMinder D-Link DCS-5020L IP Control Protocol Module, $Date: $, $Revision: $
#
# 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# ==========================================================================
#
# This module contains the implementation of the D-Link DCS-5020L IP camera control
# 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;

# ==========================================================================
#
# D-Link DCS-5020L Control Protocol
#
# ==========================================================================

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 );
}

# moves the camera to center on the point that the user clicked on in the video image.
# 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 );
}

# this clear function works, but should probably be disabled because
# 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 );
}

# 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__
# 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

D-Link DCS-5020L Control Script - Revision history

Lbdg: Fix: -->Bareword "VERSION" not allowed while "strict subs" in use at test.pm line 82

Thekorn: Add IR auto mode to script

Utahjarhead at 01:46, 19 November 2013

Thekorn: Change control package name from Dlink-DCS5020L to DCS5020L.

Utahjarhead at 03:36, 22 September 2013

Utahjarhead at 03:36, 22 September 2013

Utahjarhead at 03:35, 22 September 2013

Utahjarhead: Created page with "# =========================================================================r # # ZoneMinder D-Link DCS-5020L IP Control Protocol Module, $Date: $, $Revision: $ # # This progra..."