Trendnet TV-IP651 PTZ Controls

[gengen]

Hi,

I created a control script for the Trendnet TV-IP651WI (I guess it also works for the other TV-IP651 models).
It is widely inspired by the work done by Art Scheel on the D-Link DCS-5020L script and Vincent Giovannone on the Trendnet TV-IP862 plus a bit of Wireshark to debug the Authentication and the day/night mode.

I tested it in Zoneminder 1.30.0 / Debian 9 Stretch.

Here it is :

Code: Select all

# =========================================================================
#
# ZoneMinder Trendnet TV-IP651 IP Control Protocol Module, $Date: $, $Revision: $
# Copyright (C) 2017 GenGen
#
# 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 Trendnet TV-IP651 IP camera
# control protocol.
#
# To add the TVIP651 profile, execute the following query :
# INSERT INTO Controls (Name, Type, Protocol, CanWake, CanSleep, CanReset, CanZoom, CanAutoZoom, CanZoomAbs, CanZoomRel, CanZoomCon, MinZoomRange, MaxZoomRange, MinZoomStep, MaxZoomStep, HasZoomSpeed, MinZoomSpeed, MaxZoomSpeed, CanFocus, CanAutoFocus, CanFocusAbs, CanFocusRel, CanFocusCon, MinFocusRange, MaxFocusRange, MinFocusStep, MaxFocusStep, HasFocusSpeed, MinFocusSpeed, MaxFocusSpeed, CanIris, CanAutoIris, CanIrisAbs, CanIrisRel, CanIrisCon, MinIrisRange, MaxIrisRange, MinIrisStep, MaxIrisStep, HasIrisSpeed, MinIrisSpeed, MaxIrisSpeed, CanGain, CanAutoGain, CanGainAbs, CanGainRel, CanGainCon, MinGainRange, MaxGainRange, MinGainStep, MaxGainStep, HasGainSpeed, MinGainSpeed, MaxGainSpeed, CanWhite, CanAutoWhite, CanWhiteAbs, CanWhiteRel, CanWhiteCon, MinWhiteRange, MaxWhiteRange, MinWhiteStep, MaxWhiteStep, HasWhiteSpeed, MinWhiteSpeed, MaxWhiteSpeed, HasPresets, NumPresets, HasHomePreset, CanSetPresets, CanMove, CanMoveDiag, CanMoveMap, CanMoveAbs, CanMoveRel, CanMoveCon, CanPan, MinPanRange, MaxPanRange, MinPanStep, MaxPanStep, HasPanSpeed, MinPanSpeed, MaxPanSpeed, HasTurboPan, TurboPanSpeed, CanTilt, MinTiltRange, MaxTiltRange, MinTiltStep, MaxTiltStep, HasTiltSpeed, MinTiltSpeed, MaxTiltSpeed, HasTurboTilt, TurboTiltSpeed, CanAutoScan, NumScanPaths) VALUES
# ('TVIP651', 'Remote', 'TVIP651', 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 24, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 30, 0, 0, 0, 0, 0, 1, 0, 0, 1, 30, 0, 0, 0, 0, 0, 0, 0);

#
package ZoneMinder::Control::TVIP651;

use 5.006;
use strict;
use warnings;

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

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

#
#  I have 2 "TV-IP651WI", each of them has its own realm : 
#  "TV-IP651WI_" followed by two numbers.
#  Realm will be autodetected if "TV-IP651WI" doesn't match.
#
#  Username and password are extracted from the control address. It must have
#  the following format : username:password@address[:port]
#  If no port is specified, ":80" will be automatically added.
#
our $REALM = 'TV-IP651WI';
our $USERNAME = 'admin';
our $PASSWORD = '';
our $ADDRESS = '';


# ==========================================================================
#
# Trendnet TV-IP651 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 );
    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();

    my ( $protocol, $username, $password, $address )
       = $self->{Monitor}->{ControlAddress} =~ /^(https?:\/\/)?([^:]+):([^\/@]+)@(.*)$/;
    if ( $username ) {
        $USERNAME = $username;
        $PASSWORD = $password;
        $ADDRESS = $address;
    } else {
        Error( "Failed to parse auth from address");
        $ADDRESS = $self->{Monitor}->{ControlAddress};
    }
    if ( $ADDRESS !~ /:/ ) {
        Error( "You generally need to also specify the port.  I will append :80" );
        $ADDRESS .= ':80';
    }

    use LWP::UserAgent;
    $self->{ua} = LWP::UserAgent->new;
    $self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION );
    $self->{state} = 'open';
#   credentials:  ("ip:port" (no prefix!), realm (string), username (string), password (string)
    Debug ( "sendCmd credentials control address:'".$ADDRESS
            ."'  realm:'" . $REALM
            . "'  username:'" . $USERNAME
            . "'  password:'".$PASSWORD
            ."'"
    );
    $self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);

    # Detect REALM
    my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/pantiltcontrol.cgi" );
    my $res = $self->{ua}->request($req);

    if ( ! $res->is_success ) {
        Debug("Need newer REALM");
        if ( $res->status_line() eq '401 Authorization Required' ) {
            my $headers = $res->headers();
            foreach my $k ( keys %$headers ) {
                Debug("Initial Header $k => $$headers{$k}");
            }  # end foreach
            if ( $$headers{'www-authenticate'} ) {
                my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
                if ( $tokens =~ /\w+="([^"]+)"/i ) {
                    $REALM = $1;
                    Debug( "Changing REALM to $REALM" );
                    $self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
                } # end if
            } else {
                Debug("No headers line");
            } # end if headers
        } # end if $res->status_line() eq '401 Authorization Required'
    } # end if ! $res->is_success
}

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 $url = shift;
    my $cmd = shift;

    my $result = undef;

    my $req = HTTP::Request->new(POST => "http://".$self->{Monitor}->{ControlAddress}.$url );
    $req->content_type('application/x-www-form-urlencoded');
    $req->content($cmd);

    Debug ( "sendCmdPost credentials control address:'".$ADDRESS."'  realm:'" . $REALM . "'  username:'" . $USERNAME . "' password:'".$PASSWORD."'");

    my $res = $self->{ua}->request($req);

    if ( $res->is_success )
    {
        $result = !undef;
    }
    else
    {
        Error( "sendCmd Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
        Error( "sendCmd Error check failed: username: $USERNAME realm: $REALM password: " . $PASSWORD );
    }

    return( $result );
}

sub sendCmdPanTilt
{
    my $self = shift;
    my $cmd = shift;
    
    $self->sendCmd ("/pantiltcontrol.cgi", $cmd);
}

sub sendCmdDayNight
{
    my $self = shift;
    my $cmd = shift;
    
    $self->sendCmd ("/nightmodecontrol.cgi", $cmd);
}

sub move
{
    my $self = shift;
    my $dir = shift;
    my $panSteps = shift;
    my $tiltSteps = shift;

    my $cmd = "PanSingleMoveDegree=$panSteps&TiltSingleMoveDegree=$tiltSteps&PanTiltSingleMove=$dir";
    $self->sendCmdPanTilt( $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->sendCmdPanTilt( $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->sendCmdPanTilt( $cmd );
}

sub presetGoto
{
    my $self = shift;
    my $params = shift;
    my $preset = $self->getParam( $params, 'preset' );
    Debug( "Goto Preset $preset" );
    my $cmd = "PanTiltPresetPositionMove=$preset";
    $self->sendCmdPanTilt( $cmd );
}

sub presetHome
{
    my $self = shift;
    Debug( "Home Preset" );
    my $cmd = "PanTiltSingleMove=4";
    $self->sendCmdPanTilt( $cmd );
}


# wake and sleep functions require the day/night mode to be set to "Manual"

sub wake
{
    my $self = shift;
    Debug( "Wake - IR on" );
    my $cmd = "IRLed=1";
    $self->sendCmdDayNight( $cmd );
}

sub sleep
{
    my $self = shift;
    Debug( "Sleep - IR off" );
    my $cmd = "IRLed=0";
    $self->sendCmdDayNight( $cmd );
}

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

=head1 NAME

ZoneMinder::Database - Perl extension for TV-IP651

=head1 SYNOPSIS

use ZoneMinder::Database;
Trendnet TV-IP651

=head1 DESCRIPTION

ZoneMinder driver for the Trendnet consumer camera TV-IP651.

=head2 EXPORT

None by default.



=head1 SEE ALSO

See if there are better instructions for the TV-IP651 at
https://wiki.zoneminder.com/Trendnet#TV-IP651W.28I.29

=head1 AUTHOR

GenGen, based on the work of :
- Art Scheel for D-Link DCS-5020L
- Vincent Giovannone for Trendnet TV-IP862

=head1 COPYRIGHT AND LICENSE

LGPLv3

=cut

[gengen]

In the wiki, it's written (https://wiki.zoneminder.com/Trendnet#TV-IP651W.28I.29) :

The home position of the Trendnet TV-IP651W(I) camera is not settable, and as a result will always return to its default home position upon any reason for a reboot (power failure, crash, etc.). As a result, this camera should be considered unusable for any security use above a simple baby monitor. he wiki

It's true, but you can set a preset for your favorite position (through Trendnet administration webpage, my script can't do this for the moment), and then, call zmcontrol from the command line to set this position :

Code: Select all

zmcontrol.pl --id 1 --command=presetGoto --preset=1

You will have to suit "id" and "preset" to your configuration.
This command can be automated trough a cron job, or added to the zoneminder start script.

It may not be fully satisfactory but if it can help...

In the next days, I will try to work on the setPreset and zoom functions...

[SteveGilvarry]

is widely inspired by the work done by Art Scheel on the D-Link DCS-5020L script and Vincent Giovannone on the Trendnet TV-IP862

If their work was a starting point for you file leave any copyright statements in place like Copyright (C) 2014 Vincent Giovannone and add your own to it. Once you are ready let us know and we can help you push it to GitHub so it can become part of zm install.

[gengen]

Ok,thank you for the information.
Sorry, I'm not familiar with these considerations.

[andronks]

Hi. I add setPreset
Sorry my debug.
# =========================================================================
#
# ZoneMinder Trendnet TV-IP651 IP Control Protocol Module, $Date: $, $Revision: $
# Copyright (C) 2017 GenGen
#
# 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 Trendnet TV-IP651 IP camera
# control protocol.
#
# To add the TVIP651 profile, execute the following query :
# INSERT INTO Controls (Name, Type, Protocol, CanWake, CanSleep, CanReset, CanZoom, CanAutoZoom, CanZoomAbs, CanZoomRel, CanZoomCon, MinZoomRange, MaxZoomRange, MinZoomStep, MaxZoomStep, HasZoomSpeed, MinZoomSpeed, MaxZoomSpeed, CanFocus, CanAutoFocus, CanFocusAbs, CanFocusRel, CanFocusCon, MinFocusRange, MaxFocusRange, MinFocusStep, MaxFocusStep, HasFocusSpeed, MinFocusSpeed, MaxFocusSpeed, CanIris, CanAutoIris, CanIrisAbs, CanIrisRel, CanIrisCon, MinIrisRange, MaxIrisRange, MinIrisStep, MaxIrisStep, HasIrisSpeed, MinIrisSpeed, MaxIrisSpeed, CanGain, CanAutoGain, CanGainAbs, CanGainRel, CanGainCon, MinGainRange, MaxGainRange, MinGainStep, MaxGainStep, HasGainSpeed, MinGainSpeed, MaxGainSpeed, CanWhite, CanAutoWhite, CanWhiteAbs, CanWhiteRel, CanWhiteCon, MinWhiteRange, MaxWhiteRange, MinWhiteStep, MaxWhiteStep, HasWhiteSpeed, MinWhiteSpeed, MaxWhiteSpeed, HasPresets, NumPresets, HasHomePreset, CanSetPresets, CanMove, CanMoveDiag, CanMoveMap, CanMoveAbs, CanMoveRel, CanMoveCon, CanPan, MinPanRange, MaxPanRange, MinPanStep, MaxPanStep, HasPanSpeed, MinPanSpeed, MaxPanSpeed, HasTurboPan, TurboPanSpeed, CanTilt, MinTiltRange, MaxTiltRange, MinTiltStep, MaxTiltStep, HasTiltSpeed, MinTiltSpeed, MaxTiltSpeed, HasTurboTilt, TurboTiltSpeed, CanAutoScan, NumScanPaths) VALUES
# ('TVIP651', 'Remote', 'TVIP651', 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 24, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 30, 0, 0, 0, 0, 0, 1, 0, 0, 1, 30, 0, 0, 0, 0, 0, 0, 0);

#

package MyAgent;

use base 'LWP::UserAgent';
use IO::Socket;
use MIME::Base64;

package ZoneMinder::Control::TVIP651;

use 5.006;
use strict;
use warnings;


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

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

#
# I have 2 "TV-IP651WI", each of them has its own realm :
# "TV-IP651WI_" followed by two numbers.
# Realm will be autodetected if "TV-IP651WI" doesn't match.
#
# Username and password are extracted from the control address. It must have
# the following format : username:password@address[:port]
# If no port is specified, ":80" will be automatically added.
#
my $REALM = 'TV-IP651WI';
my $USERNAME = 'admin';
my $PASSWORD = 'admin';
my $ADDRESS = '192.168.0.20';


# ==========================================================================
#
# Trendnet TV-IP651 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();

my ( $protocol, $username, $password, $address )
= $self->{Monitor}->{ControlAddress} =~ /^(http?:\/\/)?([^:]+):([^\/@]+)@(.*)$/;
if ( $username ) {
$USERNAME = $username;
$PASSWORD = $password;
$ADDRESS = $address;
} else {
Error( "Failed to parse auth from address");
$ADDRESS = $self->{Monitor}->{ControlAddress};
}
if ( $ADDRESS !~ /:/ ) {
#Error( "You generally need to also specify the port. I will append :80" );
$ADDRESS .= ':80';
}

use LWP::UserAgent;
$self->{ua} = LWP::UserAgent->new;
$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION );
$self->{state} = 'open';
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
Debug ( "sendCmd credentials control address:'".$ADDRESS
."' realm:'" . $REALM
. "' username:'" . $USERNAME
. "' password:'".$PASSWORD
."'"
);
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);

# Detect REALM
my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/pantiltcontrol.cgi" );
my $res = $self->{ua}->request($req);

if ( ! $res->is_success ) {
Debug("Need newer REALM");
if ( $res->status_line() eq '401 Authorization Required' ) {
my $headers = $res->headers();
foreach my $k ( keys %$headers ) {
Debug("Initial Header $k => $$headers{$k}");
} # end foreach
if ( $$headers{'www-authenticate'} ) {
my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
if ( $tokens =~ /\w+="([^"]+)"/i ) {
$REALM = $1;
Debug( "Changing REALM to $REALM" );
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
} # end if
} else {
Debug("No headers line");
} # end if headers
} # end if $res->status_line() eq '401 Authorization Required'
} # end if ! $res->is_success
}

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 $url = shift;
my $cmd = shift;

my $result = undef;

my $req = HTTP::Request->new(POST => "http://".$self->{Monitor}->{ControlAddress}.$url );
$req->content_type('application/x-www-form-urlencoded');
$req->content($cmd);

Debug ( "sendCmdPost credentials control address:'".$ADDRESS."' realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");

my $res = $self->{ua}->request($req);

if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "sendCmd Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
Error( "sendCmd Error check failed: username: $USERNAME realm: $REALM password: " . $PASSWORD );
}

return( $result );
}

sub sendCmdPanTilt
{
my $self = shift;
my $cmd = shift;

$self->sendCmd ("/pantiltcontrol.cgi", $cmd);
}

sub sendCmdDayNight
{
my $self = shift;
my $cmd = shift;

$self->sendCmd ("/nightmodecontrol.cgi", $cmd);
}

sub move
{
my $self = shift;
my $dir = shift;
my $panSteps = shift;
my $tiltSteps = shift;

my $cmd = "PanSingleMoveDegree=$panSteps&TiltSingleMoveDegree=$tiltSteps&PanTiltSingleMove=$dir";
$self->sendCmdPanTilt( $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 DownRight" );
$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 $f = 5;

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->sendCmdPanTilt( $cmd );
}

sub presetSet
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
#Error( "Set Preset ($preset)." );
use LWP::UserAgent;
$self->{ua} = LWP::UserAgent->new;
#$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION );
$self->{ua}->agent( "user" );
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
my $addr = $self->{Monitor}->{ControlAddress};
$addr = substr($addr, index($addr, "@") + 1);
#Error("Address: $addr");
#my $req = HTTP::Request->new( HEAD=>"http://".$self->{Monitor}->{ControlAddress}."/mjpeg.cgi" );
#$req->content_type('application/x-www-form-urlencoded');
#$req->content("text=text&login=admin&passwd=176ce977");
#$req->content("");
#my $reqt = $self->{ua}->request($req)->as_string;
#Error("Set request $reqt");
#my $res = $self->{ua}->request($req);
#die "Hey, I was expecting HTML, not ", $res->content_type
#unless $res->content_type eq 'text/html';
#my $res = $self->{ua}->get("http://10.9.10.6/IOCONTROL.CGI");
#Error("Get http $res");
#if ( ! $res->is_success ) {
# Debug("Need newer REALM");
# if ( $res->status_line() eq '401 Authorization Required' ) {
# my $headers = $res->headers();
# foreach my $k ( keys %$headers ) {
# Error("Initial Header $k => $$headers{$k}");
# } # end foreach
# if ( $$headers{'www-authenticate'} ) {
# my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
# if ( $tokens =~ /\w+="([^"]+)"/i ) {
# $REALM = $1;
# Debug( "Changing REALM to $REALM" );
# $self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
# } # end if
# } else {
# Debug("No headers line");
# } # end if headers
# } # end if $res->status_line() eq '401 Authorization Required'
#} # end if ! $res->is_success
#Error( "Get success! $res");
#my $headers = $res->headers();
#my $head = $res->headers()->as_string;
#my $r = $res->as_string;
# foreach my $k ( keys %$headers ) {
# Error("Initial Header $k => $$headers{$k}");
# } # end foreach
#Error("All Headers: $head");
#Error("All Response: $r");
my $sock = IO::Socket::INET->new(PeerAddr=>$addr,Proto=>'tcp',PeerPort=>80,);
#Error("Starting Sock");
return unless defined $sock;
$sock->autoflush(1);
#Error("Start Sock");
print $sock "GET /mjpeg.cgi HTTP/1.0\r\nUser-Agent: user\r\nAuthorization: Basic\r\n\r\n";
my $status = <$sock>;
#Error("Sock status: $status");
#die unless ($status =~ m|HTTP/\S+\s+401|);
my ($grab,$jpeg,$data,$image,$thisbuf,$lastimage);
while (my $nread = sysread($sock, $thisbuf, 4096)) {
$grab .= $thisbuf;
}
#Error("Sock buff: $grab");
$sock->close();

#my $srch = 'nonce="';
my ($snonce, $srealm);
#my $result = index($grab, $srch);
#if ($result != -1) {
# $snonce = substr($grab, $result + 7 , 42);
#}
if (my $r = index($grab, "WWW-Authenticate") != -1) {
$snonce = substr($grab, index($grab, 'nonce="') + 7, 42);
$srealm = substr($grab, index($grab, 'realm="') + 7, 13);
}
#my $auth_param = $h->{auth_param};
my @auth_param;
$auth_param['username'] = $USERNAME;
$auth_param['realm'] = $REALM;
$auth_param['uri'] = "/mjpeg.cgi";
$auth_param['algorithm'] = "MD5";
$auth_param['nonce'] = $snonce;
$auth_param['cnonce'] = "";
$auth_param['qop'] = "auth";
$auth_param['nc'] = "1";
$auth_param['response'] = "";
my $cnonce = sprintf "%8x", time;
#my $nc = sprintf "%08X", ++$ua->{authen_md5_nonce_count}{$auth_param->{nonce}};
my $nc = sprintf "%08X", 1;
my $md5 = Digest::MD5->new;
my(@digest);
$md5->add(join(":", $USERNAME, $REALM, $PASSWORD));
my $HA1 = $md5->hexdigest;
push(@digest, $md5->hexdigest);
$md5->reset;
push(@digest, $snonce);
push(@digest, $nc, $cnonce, 'auth');
$md5->add(join(":", "GET", "/mjpeg.cgi"));
my $HA2 = $md5->hexdigest;
push(@digest, $md5->hexdigest);
$md5->reset;
$md5->add(join(":", @digest));
my($digest) = $md5->hexdigest;
$md5->reset;
$md5->add(join(":", $HA1, $snonce, $nc, $cnonce, "auth", $HA2));
my $digestgen = $md5->hexdigest;
$md5->reset;
#my %resp = map { $auth_param->{$_} } qw(realm nonce opaque);
my %resp;
@resp{qw(realm nonce)} = ($REALM, $snonce);
@resp{qw(username uri response algorithm)} = ($USERNAME, "/mjpeg.cgi", $digestgen, "MD5");
@resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc);
my(@order) = qw(username realm uri algorithm nonce cnonce qop nc response);
$resp{"message-digest"} = $md5->hexdigest;
my @pairs;
for (@order) {
next unless defined $resp{$_};

# RFC2617 says that qop-value and nc-value should be unquoted.
if ( $_ eq 'qop' || $_ eq 'nc' ) {
push(@pairs, "$_=" . $resp{$_});
}
else {
push(@pairs, "$_=" . qq("$resp{$_}"));
}
}
my $auth_value = "Digest " . join(", ", @pairs);


#my $uspasswd = MIME::Base64::encode('admin:176ce977');
#my $ser = MIME::Base64::encode('YWRtaW46MTc2Y2U5Nzc=');
#my $mdigest = 'Digest username="admin", realm="TV-IP651WI_10", uri="/mjpeg.cgi", algorithm=MD5, nonce="4c8fdb0effd7d60cae43856a85314ab410.9.10.72", cnonce="$cnonce", qop=auth, nc=2, response="YWRtaW46MTc2Y2U5Nzc="';
#print $sock "GET /mjpeg.cgi HTTP/1.0\r\nUser-Agent: user\r\nAuthorization: Basic YWRtaW46MTc2Y2U5Nzc=\r\n\r\n";
#Error("Digest: $auth_value");
#my $status = <$sock>;


my $sockauth = IO::Socket::INET->new(PeerAddr=>$addr,Proto=>'tcp',PeerPort=>80,);
#Error("Starting Sock1");
return unless defined $sockauth;
$sockauth->autoflush(1);
#Error("Start Sock1 $auth_value");
#$sock->open();
print $sockauth "GET /mjpeg.cgi HTTP/1.0\r\nUser-Agent: user\r\nAuthorization: $auth_value\r\n\r\n";
$grab = "";
my $cnt = 0;
while (my $nread = sysread($sockauth, $thisbuf, 4096) && $cnt < 7) {
$grab .= $thisbuf;
$cnt++;
}
#my $nread1 = sysread($sockauth, $thisbuf, 4096);
#Error("Sock1 buff: $grab");
#$nread1 = sysread($sockauth, $thisbuf, 4096);
#Error("Sock1 buff: $thisbuf");
$sockauth->close();

my ($verPos, $horPos);
my $PO = index($grab, 'PT_');
$horPos = substr($grab, $PO + 3, 3);
$verPos = substr($grab, $PO + 7, 3);
#Error("Address: $addr Pos: $verPos $horPos");

# TODO need to first get current position $horPos and $verPos
my $cmd = "PanTiltHorizontal=$horPos&PanTiltVertical=$verPos&SetName=$preset&SetPosition=$preset";
#my $cmd = "PanTiltHorizontal&PanTiltVertical&SetName=$preset&SetPosition=$preset";
$self->sendCmdPanTilt( $cmd );
}

sub presetGoto
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
Debug( "Goto Preset $preset" );
my $cmd = "PanTiltPresetPositionMove=$preset";
$self->sendCmdPanTilt( $cmd );
}

sub presetHome
{
my $self = shift;
Debug( "Home Preset" );
my $cmd = "PanTiltSingleMove=4";
$self->sendCmdPanTilt( $cmd );
}


# wake and sleep functions require the day/night mode to be set to "Manual"

sub wake
{
my $self = shift;
Debug( "Wake - IR on" );
my $cmd = "IRLed=1";
$self->sendCmdDayNight( $cmd );
}

sub sleep
{
my $self = shift;
Debug( "Sleep - IR off" );
my $cmd = "IRLed=0";
$self->sendCmdDayNight( $cmd );
}

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

=head1 NAME

ZoneMinder::Database - Perl extension for TV-IP651

=head1 SYNOPSIS

use ZoneMinder::Database;
Trendnet TV-IP651

=head1 DESCRIPTION

ZoneMinder driver for the Trendnet consumer camera TV-IP651.

=head2 EXPORT

None by default.



=head1 SEE ALSO

See if there are better instructions for the TV-IP651 at
https://wiki.zoneminder.com/Trendnet#TV-IP651W.28I.29

=head1 AUTHOR

GenGen, based on the work of :
- Art Scheel for D-Link DCS-5020L
- Vincent Giovannone for Trendnet TV-IP862

=head1 COPYRIGHT AND LICENSE

LGPLv3

=cut