package Veo;

use strict;
use Carp;
use IO::Socket;
use IO::Select;

# -- VEO defaults for username/password/port
use constant VEO_OBSERVER_USER     => qq{admin};
use constant VEO_OBSERVER_PASSWORD => qq{password};
use constant VEO_OBSERVER_PORT     => 1600;

# -- begin of messages --
use constant VEO_MSG_LOGON           => 0x00;

use constant VEO_MSG_STREAM_START    => 0x01;
use constant VEO_MSG_STREAM_STOP     => 0x02;

use constant VEO_MSG_LOCATENET       => 0x03; # not implemented
use constant VEO_MSG_SETUPNET        => 0x04; # not implemented

use constant VEO_MSG_GETBRIGHT       => 0x05;
use constant VEO_MSG_SETBRIGHT       => 0x06;

use constant VEO_MSG_GETLIGHT        => 0x07;
use constant VEO_MSG_SETLIGHT        => 0x08;

use constant VEO_MSG_GETCAMINFO      => 0x09;
use constant VEO_MSG_SETCAMINFO      => 0x0a; # not implemented

use constant VEO_MSG_GETEMAILPROP    => 0x0b; # not implemented
use constant VEO_MSG_SETEMAILPROP    => 0x0c; # not implemented

use constant VEO_MSG_GETUSERACCOUNTS => 0x0d; # not implemented
use constant VEO_MSG_SETUSERACCOUNT  => 0x0e; # not implemented
use constant VEO_MSG_DELETEUSER      => 0x0f; # not implemented

use constant VEO_MSG_REPLACEFIRMLEN  => 0x10; # not implemented
use constant VEO_MSG_REPLACEFIRMDATA => 0x11; # not implemented

use constant VEO_MSG_GETMOTIONDETECT => 0x12; # not implemented
use constant VEO_MSG_SETMOTIONDETECT => 0x13; # not implemented

use constant VEO_MSG_SELECT_STREAM   => 0x14;

use constant VEO_MSG_MOVE            => 0x15;

use constant VEO_MSG_RESET           => 0x16;

use constant VEO_MSG_GETSTATUSLIGHT  => 0x17;
use constant VEO_MSG_SETSTATUSLIGHT  => 0x18;
# -- end of messages --

# -- general response codes --
use constant VEO_RESPONSE_OK       => 0x04;
use constant VEO_RESPONSE_ERROR    => 0x05;

# -- constants used for VEO_MSG_MOVE --
use constant VEO_MOVE_UP           => 0x00;
use constant VEO_MOVE_FULL_UP      => 0x01;
use constant VEO_MOVE_DOWN         => 0x02;
use constant VEO_MOVE_FULL_DOWN    => 0x03;
use constant VEO_MOVE_LEFT         => 0x04;
use constant VEO_MOVE_FULL_LEFT    => 0x05;
use constant VEO_MOVE_RIGHT        => 0x06;
use constant VEO_MOVE_FULL_RIGHT   => 0x07;

# -- constants used for VEO_MSG_SETLIGHT --
use constant VEO_LIGHT_NORMAL      => 0x00;
use constant VEO_LIGHT_BACKLIGHT   => 0x01;
use constant VEO_LIGHT_NIGHT       => 0x02;

# -- constants used for VEO_MSG_SETSTATUSLIGHT --
use constant VEO_STATUSLIGHT_OFF   => 0x00;
use constant VEO_STATUSLIGHT_ON    => 0x01;

# -- constants used for VEO_MSG_SETBRIGHT --
use constant VEO_BRIGHT_DARK       => 0x00;
use constant VEO_BRIGHT_NORMAL     => 0x12;
use constant VEO_BRIGHT_BRIGHT     => 0x23;

# -- constants used for VEO_MSG_SELECT_STREAM --
use constant VEO_STREAM_160X120    => 0;
use constant VEO_STREAM_320X240    => 1;
use constant VEO_STREAM_640X480    => 2;

# -- constants passed to the stream callback --
use constant VEO_IMAGE  => 0;
use constant VEO_AUDIO  => 1;

# -- responses from VEO_MSG_MOVE --
use constant OK         => 1;
use constant ERROR      => 0;
use constant MOVE_LIMIT => 2;

# -- constants to select debugging output --
use constant DEBUG_VERBOSE      => 1;
use constant DEBUG_SEND         => 2;
use constant DEBUG_RECEIVE      => 4;

# -- generic JPG-header for streamed frames, frame size
# needs to be patched at location 0xA0 (two bytes height, two bytes width)
use constant VEO_JPG_HDR => 
  qq{\xFF\xD8\xFF\xE0\x00\x11\x00\x4A\x46\x49\x46\x00\x01\x02\x00\x00}.
  qq{\x48\x00\x48\x00\x00\xFF\xDB\x00\x84\x00\x08\x05\x06\x07\x06\x05}.
  qq{\x08\x07\x06\x07\x09\x08\x08\x09\x0D\x15\x0E\x0D\x0C\x0C\x0D\x1A}.
  qq{\x11\x12\x0E\x15\x20\x1A\x20\x20\x1C\x1A\x1C\x1C\x20\x25\x2F\x27}.
  qq{\x20\x22\x2F\x22\x1C\x1C\x2B\x39\x2B\x2F\x33\x33\x33\x39\x33\x20}.
  qq{\x27\x39\x40\x39\x33\x40\x2F\x33\x33\x33\x01\x08\x09\x09\x0D\x0B}.
  qq{\x0D\x17\x0E\x0E\x1C\x33\x22\x1C\x22\x33\x33\x33\x33\x33\x33\x33}.
  qq{\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33}.
  qq{\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33}.
  qq{\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\xFF\xC0\x00\x11\x08}.
  qq{\x00\xF0\x01\x40\x03\x01\x21\x00\x02\x11\x01\x03\x11\x01\xFF\xC4}.
  qq{\x00\xD2\x00\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00}.
  qq{\x00\x00\x00\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x10}.
  qq{\x00\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D}.
  qq{\x01\x02\x03\x00\x04\x11\x05\x12\x21\x31\x41\x06\x13\x51\x61\x07}.
  qq{\x22\x71\x14\x32\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52\xD1\xF0}.
  qq{\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A\x25\x26\x27\x28}.
  qq{\x29\x2A\x34\x35\x36\x37\x38\x39\x3A\x43\x44\x45\x46\x47\x48\x49}.
  qq{\x4A\x53\x54\x55\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68\x69}.
  qq{\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83\x84\x85\x86\x87\x88\x89}.
  qq{\x8A\x92\x93\x94\x95\x96\x97\x98\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7}.
  qq{\xA8\xA9\xAA\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5}.
  qq{\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xE1\xE2}.
  qq{\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8}.
  qq{\xF9\xFA\xFF\xDA\x00\x0C\x03\x01\x00\x02\x00\x03\x00\x00\x3F\x00};

sub new {
    my $self=shift;
    my $type=ref($self) || $self;
    my %args=@_;
    croak(qq{Usage: $type->new(host => hostname/ip [,port => portnumber])})
      unless(defined($args{host}));
    $self = {
	     _host       => $args{host},
	     _port       => $args{port}||VEO_OBSERVER_PORT,
	     _timeout    => 0.5,
	     _peektimeout=> 0.05,
	     _blocksize  => 512,
	     _seq        => 0,
	     _streamID   => 0,
	     _debug      => $args{debug}||0,
	    };
    bless $self,$type;
    $self->{_socket}=$self->_connect($self->{_host},$self->{_port},$self->{_timeout});
    $self->{_select}=IO::Select->new();
    $self->{_select}->add($self->{_socket});
    return $self;
}

sub DESTROY {
    my $self=shift;
    $self->_disconnect();
}

sub _dprint {
    my($self)=shift;
    my($mask)=shift;
    return unless ($mask & $self->{_debug});
    my $ts=scalar(localtime(time));
    print STDERR "[$ts] $_\n" foreach (split(/\n/,join("",@_)));
}

sub _connect {
    my($self)=shift;
    my($host,$port,$timeout)=@_;
    # try to connect to camera
    my $socket=IO::Socket::INET->new(PeerAddr => $host,
				     PeerPort => $port,
				     Proto    => qq{tcp},
				     Type     => SOCK_STREAM,
				     Timeout  => $timeout);
    unless($socket) {
	croak(qq{Unable to connect to $host:$port - $@});
    }
    # $socket->timeout($timeout);
    return $socket;
}

sub _disconnect {
    my($self)=shift;
    if($self->{_socket} && $self->{_socket}->connected()) {
	close($self->{_socket});
    }
    delete $self->{_loggedin};
}

sub _sendmsg {
    my($self)=shift;
    my($message, $data)=@_;
    my $packet=chr($message).chr($self->{_seq}++).(defined($data)?$data:qq{});
    $self->{_seq}=0 if($self->{_seq}>255);
    $packet=pack(qq{n},length($packet)+2).$packet;
    $self->_dprint(DEBUG_SEND,qq{_sendmsg:sending }.length($packet).qq{ bytes to camera});
    unless($self->{_socket}->send($packet) == length($packet)) {
	croak(qq{Error sending packet to camera - $@});
    }
}

sub _recvmsg {
    my($self)=@_;
    my($buf,$packet);
    $self->_dprint(DEBUG_RECEIVE,qq{_recvmsg:trying to receive a packet});
    my @read=$self->{_select}->can_read($self->{_timeout});
    if(scalar(@read)) {
	$read[0]->recv($buf,$self->{_blocksize});
	$self->_dprint(DEBUG_RECEIVE,qq{_recvmsg:read }.length($buf).qq{ bytes of data});
    }
    $self->{_buf}.=$buf if(defined($buf));
    if(defined($self->{_buf}) && length($self->{_buf}) > 1) {
	my $len=unpack(qq{n}, substr($self->{_buf},0,2));
	# enough data in buffer?
	if(length($self->{_buf})>=$len) {
	    # extract packet 
	    $packet=substr($self->{_buf},0,$len);
	    # trim buffer
	    $self->{_buf}=substr($self->{_buf},$len);
	    $self->_dprint(DEBUG_RECEIVE,qq{_recvmsg:returning }.length($packet).qq{ bytes of data});
        }
    }
    return $packet;
}

sub _peekmsg {
    my($self)=@_;
    my @read=$self->{_select}->can_read($self->{_peektimeout});
    return scalar(@read);
}

sub _bufmsglen {
    my($self)=@_;
    $self->_dprint(DEBUG_RECEIVE,qq{_bufmsglen: }.length($self->{_buf}));
    return length($self->{_buf});
}

sub _decode {
    my($self)=shift;
    my($packet)=shift;
    unless(defined($packet)) {
	return (0,0,0,qq{});
    }
    my($length,$code,$seq)=unpack(qq{nCC},$packet);
    my($data)=length($packet)>4?substr($packet,4):qq{};
    return ($length,$code,$seq,$data);
}

sub login {
    my($self)=shift;
    my %args=@_;
    $args{user}=VEO_OBSERVER_USER unless(defined($args{user}));
    $args{password}=VEO_OBSERVER_PASSWORD unless(defined($args{password}));
    my $seq=$self->{_seq};
    $self->_sendmsg(VEO_MSG_LOGON,pack(qq{a64a64},$args{user},$args{password}));
    my $packet=$self->_recvmsg;
    croak(qq{No response from camera}) unless(defined($packet));
    my($l,$c,$s,$d)=$self->_decode($packet);
    if($c == VEO_RESPONSE_OK) {
	my($pMajor,$pMinor,$accessLevel,$sid,$format,$tpf,$maxBright,$cnt)=
	  unpack(qq{CCcNcNNc},$d);
	$self->{_protocolVersion}=qq{$pMajor.$pMinor};
	$self->{_accessLevel}=$accessLevel;
	$self->{_streamID}=$sid;
	$self->{_format}=$format;
	$self->{_timePerFrame}=$tpf;
	$self->{_maxBrightness}=$maxBright;
	$d=substr($d,17);
	for(my $i=0; $i<$cnt; $i++) {
	    my($w,$h,$maxTime,$minTime)=unpack(qq{nnNN},$d);
	    $d=substr($d,12);
	    $self->{_streams}->[$i]={width=>$w, height=>$h, maxTime=>$maxTime, minTime=>$minTime};
	}
	$self->{_loggedin}=$args{user};
    } elsif ($c == VEO_RESPONSE_ERROR) {
	croak(qq{Unable to login to camera - $d});
    } else {
	croak(qq{Invalid response from camera - $c});
    }
}

sub logout {
    my($self)=shift;
    $self->_disconnect();
}

sub stream {
    my($self)=shift;
    my($cb)=shift;
    my($audio)=shift || 0;
    croak(qq{Need a callback for method stream}) unless(defined($cb) && ref($cb) eq q{CODE});
    $self->_sendmsg(VEO_MSG_STREAM_START,pack(qq{Nnc},$self->{_streamID},0,$audio));
    my $packet=$self->_recvmsg;
    my($l,$c,$s,$d)=$self->_decode($packet);
    if($c == VEO_RESPONSE_OK) {
	# camera responded that streaming was accepted.
	# we should now get a continuous stream of bytes
	my $imgdata;
	my ($streaming,$ending,$endingack,$seq)=(1,0,0,0);
	while($streaming) {
	    my $packet=$self->_recvmsg;
	    unless(defined($packet) && length($packet)) {
		last if($endingack && !$self->_bufmsglen());
		next;
	    }
	    # if we received the ack for the stop stream message, we drain packets
	    next if($endingack);
	    if($ending) {
		my($l,$c,$s,$d)=$self->_decode($packet);
		if($c == VEO_RESPONSE_OK && $s == $seq) {
		    # got the response to our stop message
		    $endingack=1;
		}
		next;
	    }
	    my($l,$type)=unpack(qq{nC},$packet);
	    $self->_dprint(DEBUG_VERBOSE,qq{stream: received packet type $type with size $l});
	    $packet=substr($packet,3);
	    if($type == 0) {
		my($frameNo,$seqNo,$rate,$timestamp,$dummy,$height,$width)=
		  unpack(qq{nnCa8a6a2a2},$packet);
		$packet=substr($packet,23);
		# combine static JPEG header and packet data
		$imgdata=VEO_JPG_HDR.$packet;
		# patch width/height
		substr($imgdata,0xA0,4)=$height.$width;
	    }elsif($type == 1) {
		my($frameNo,$seqNo,$rate)=unpack(qq{nnC},$packet);
		$packet=substr($packet,5);
		$imgdata.=$packet;
	    }elsif($type == 2) {
		my($frameNo,$seqNo,$rate)=unpack(qq{nnC},$packet);
		$packet=substr($packet,5);
		$imgdata.=$packet;
		# send to callback
		my $status=&$cb(VEO_IMAGE,$frameNo,$imgdata);
		if(!$status) {
		    # callback does not want us to continue - stop stream
		    $ending=1;
		    $seq=$self->{_seq};
		    $self->_sendmsg(VEO_MSG_STREAM_STOP);
		}
		$imgdata=qq{};
	    }elsif($type == 3) {
		# audio?
		my($timestamp,$dummy)=unpack(qq{a8C},$packet);
		$packet=substr($packet,9);
		my $status=&$cb(VEO_AUDIO,0,$packet);
		if(!$status) {
		    # callback does not want us to continue - stop stream
		    $ending=1;
		    $seq=$self->{_seq};
		    $self->_sendmsg(VEO_MSG_STREAM_STOP);
		}
	    }else{
		croak(qq{Unexpected packet code $type});
	    }
	}
    } else {
	return ERROR;
    }
}

sub selectStream {
    my($self)=shift;
    my($streamIndex,$framesPerSec)=@_;
    # (0x0f4240) =  1 frame/sec
    # (0x07a120) =  2 frame/sec
    # (0x051615) =  3 frame/sec
    # (0x03d090) =  4 frame/sec
    # (0x030d40) =  5 frame/sec
    # (0x028b0a) =  6 frame/sec
    # (0x022e09) =  7 frame/sec
    # (0x01e848) =  8 frame/sec
    # (0x01b207) =  9 frame/sec
    # (0x0186a0) = 10 frame/sec
    my(@delays)=(0x0f4240,0x07a120,0x051615,0x03d090,0x030d40,0x028b0a,0x022e09,0x01e848,0x01b207,0x0186a0);
    if(!defined($self->{_streams}->[$streamIndex])) {
	croak(qq{cannot handle stream index $streamIndex});
    }
    $framesPerSec=1 if($framesPerSec<0);
    $framesPerSec=10 if($framesPerSec>10);
    my $delay=$delays[$framesPerSec-1];
    if($delay < $self->{_streams}->[$streamIndex]->{minTime}) {
	$delay=$self->{_streams}->[$streamIndex]->{minTime};
	$self->_dprint(DEBUG_VERBOSE,qq{selectStream: frameRate adjusted to delay $delay});
    }elsif($delay > $self->{_streams}->[$streamIndex]->{maxTime}) {
	$delay=$self->{_streams}->[$streamIndex]->{maxTime};
	$self->_dprint(DEBUG_VERBOSE,qq{selectStream: frameRate adjusted to delay $delay});
    }
    $self->_sendmsg(VEO_MSG_SELECT_STREAM,pack(qq{CN},$streamIndex,$delay));
    my $packet=$self->_recvmsg;
    my($l,$c,$s,$d)=$self->_decode($packet);

    if($c == VEO_RESPONSE_OK) {
	my($streamID,$format,$tpf)=unpack(qq{NcN},$d);
	$self->{_streamID}=$streamID;
	$self->{_format}=$format;
	$self->{_timePerFrame}=$tpf;
	return OK;
    }else{
	return ERROR;
    }
}

sub info {
    my($self)=shift;
    my($name,$location);
    $self->_sendmsg(VEO_MSG_GETCAMINFO);
    my $packet=$self->_recvmsg;
    croak(qq{No response from camera}) unless(defined($packet));
    my($l,$c,$s,$d)=$self->_decode($packet);
    if($c == VEO_RESPONSE_OK) {
	($name,$location)=unpack(qq{a64a64},$d);
	$name=(split(/\0/,$name))[0];
	$location=(split(/\0/,$location))[0];
    } elsif ($c == VEO_RESPONSE_ERROR) {
	croak(qq{Unable to get information from camera - $d});
    } else {
	croak(qq{Invalid response from camera - $c});
    }
    return ($name, $location);
}

sub brightness {
    my($self)=shift;
    my($bright)=shift;
    if(defined($bright)) {
	# set brightness
	$bright=VEO_BRIGHT_BRIGHT if($bright > VEO_BRIGHT_BRIGHT);
	$self->_sendmsg(VEO_MSG_SETBRIGHT,chr(0).chr(0).chr(0).chr($bright));
	my $packet=$self->_recvmsg;
	croak(qq{No response from camera}) unless(defined($packet));
	my($l,$c,$s,$d)=$self->_decode($packet);
	if($c == VEO_RESPONSE_OK) {
	    return OK;
	} else {
	    return ERROR;
	}
    } else {
	# get brightness
	$self->_sendmsg(VEO_MSG_GETBRIGHT);
	my $packet=$self->_recvmsg;
	croak(qq{No response from camera}) unless(defined($packet));
	my($l,$c,$s,$d)=$self->_decode($packet);
	if($c == VEO_RESPONSE_OK) {
	    return ord(substr($d,3,1));
	} else {
	    return undef;
	}
    }
}

sub light {
    my($self)=shift;
    my($light)=shift;
    if(defined($light)) {
	# set light
	$self->_sendmsg(VEO_MSG_SETLIGHT,chr($light));
	my $packet=$self->_recvmsg;
	croak(qq{No response from camera}) unless(defined($packet));
	my($l,$c,$s,$d)=$self->_decode($packet);
	if($c == VEO_RESPONSE_OK) {
	    return OK;
	} else {
	    return ERROR;
	}
    } else {
	# get light
	$self->_sendmsg(VEO_MSG_GETLIGHT);
	my $packet=$self->_recvmsg;
	croak(qq{No response from camera}) unless(defined($packet));
	my($l,$c,$s,$d)=$self->_decode($packet);
	if($c == VEO_RESPONSE_OK) {
	    return ord($d);
	} else {
	    return undef;
	}
    }
}

sub statusLight {
    my($self)=shift;
    my($status)=shift;
    if(defined($status)) {
        # set status light
        $self->_sendmsg(VEO_MSG_SETSTATUSLIGHT,chr($status));
        my $packet=$self->_recvmsg;
        croak(qq{No response from camera}) unless(defined($packet));
        my($l,$c,$s,$d)=$self->_decode($packet);
        if($c == VEO_RESPONSE_OK) {
            return OK;
        } else {
            return ERROR;
        }
    } else {
        # get status light
        $self->_sendmsg(VEO_MSG_GETSTATUSLIGHT);
        my $packet=$self->_recvmsg;
        croak(qq{No response from camera}) unless(defined($packet));
        my($l,$c,$s,$d)=$self->_decode($packet);
        if($c == VEO_RESPONSE_OK) {
            return ord($d);
        } else {
            return undef;
        }
    }
}

sub move {
    my($self)=shift;
    my($direction)=shift;
    croak(qq{Need a direction code for method }.__PACKAGE__.qq{move}) unless(defined($direction));
    $self->_sendmsg(VEO_MSG_MOVE,chr($direction));
    my $packet=$self->_recvmsg;
    my($l,$c,$s,$d)=$self->_decode($packet);
    if($c == VEO_RESPONSE_OK) {
	return OK;
    }elsif(substr($d,0,1) eq chr(0x0c)) {
	return MOVE_LIMIT;
    }else{
	return ERROR;
    }
}

sub reset {
    my($self)=shift;
    $self->_sendmsg(VEO_MSG_RESET);
    my $packet=$self->_recvmsg;
    my($l,$c,$s,$d)=$self->_decode($packet);
    if($c == VEO_RESPONSE_OK) {
	delete($self->{_loggedin});
	return OK;
    }else{
	return ERROR;
    }
}

1;

__END__

=head1 NAME

Veo - Veo Observer Client

=head1 SYNOPSIS

    use Veo;
    $veo=Veo->new(host => '192.168.1.1', port => 1600);
    $veo->login(user => 'admin', password => 'password');
    $veo->selectStream(Veo::VEO_STREAM_320X240, 1);
    $veo->stream(\&callback);

    sub callback {
      my($type,$frame,$data)=@_;
      open(OUT,">image.jpg") || die;
      binmode(OUT);
      print OUT $data;
      close(OUT);
      return 0;
    }

=head1 DESCRIPTION

C<Veo> is a class implementing a simple client to the Veo Observer
Cameras.

=head1 OVERVIEW

Veo did not bother to provide access to the Veo Observer Networking
Cameras from any other platform but Windows. The only way to download
images from the camera is provided via an Active-X control under Windows.
While the camera itself is nice (and cheap), not being able to use it
from Unix is a severe limitation.

This module addresses this limitation and allows access to the Veo Observer
Networking camera from any platform that supports perl and the perl modules
C<IO::Select> and C<IO::Socket>.

The C<Veo> module is not complete yet and the author intends to implement
the missing calls in the near future. This will also include the documentation
to this module.

=head1 CREDITS

Brian Gottlieb <brianosaurus.org> - for THE missing link

=head1 COPYRIGHT

Copyright (c) 2004 Tobias Hoellrich, http://www.kahunaburger.com/. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
1;