edited to reflect the moving around of the demo files

[urisagit/Stem.git] / lib / Stem / UDPMsg.pm

#  File: Stem/UDPMsg.pm

#  This file is part of Stem.
#  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.

#  Stem 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.

#  Stem 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 Stem; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#  For a license to use the Stem under conditions other than those
#  described here, to purchase support for this software, or to purchase a
#  commercial warranty contract, please contact Stem Systems at:

#       Stem Systems, Inc.		781-643-7504
#  	79 Everett St.			info@stemsystems.com
#  	Arlington, MA 02474
#  	USA

package Stem::UDPMsg ;

use strict ;

use Data::Dumper ;
use IO::Socket ;

my $attr_spec = [

	{
		'name'		=> 'reg_name',
		'help'		=> <<HELP,
The registration name for this Cell
HELP
	},

	{
		'name'		=> 'bind_host',
		'help'		=> <<HELP,
The UDP socket is bound to this host for receiving or sending packets
HELP
	},

	{
		'name'		=> 'bind_port',
		'help'		=> <<HELP,
The UDP socket is bound to this port for receiving or sending packets
HELP
	},
	{
		'name'		=> 'send_host',
		'help'		=> <<HELP,
The UDP packet is sent to this host if the send message has no host
HELP
	},
	{
		'name'		=> 'send_port',
		'help'		=> <<HELP,
The UDP packet is sent to this port if the send message has no port
HELP
	},
	{
		'name'		=> 'bind_port',
		'help'		=> <<HELP,
The UDP socket is bound to this port for receiving or sending packets
HELP
	},
	{
		'name'		=> 'server',
		'type'		=> 'boolean',
		'help'		=> <<HELP,
Marks this socket as a server and it expect to receive UDP packets
HELP
	},
	{
		'name'		=> 'max_recv_size',
		'default'	=> 4096,
		'help'		=> <<HELP,
Maximum size of received UDP packets.

HELP
	},
	{
		'name'		=> 'data_addr',
		'help'		=> <<HELP,
Send received UDP packets as 'udp_data' type messages to this address
HELP
	},
	{
		'name'		=> 'error_addr',
		'help'		=> <<HELP,
Send received UDP errors as 'udp_error' type messages to this address
HELP
	},
	{
		'name'		=> 'timeout_addr',
		'help'		=> <<HELP,
Send UDP timeouts as 'udp_timeout' type messages to this address
HELP
	},
	{
		'name'		=> 'object',
		'help'		=> <<HELP,
This object will get the callbacks
HELP
	},
	{
		'name'		=> 'timeout',
		'help'		=> <<HELP,
This sets the timeout period to wait for UDP data. If no data has been
received since the timer started, a timeout message or callback will
be triggered.
HELP
	},
	{
		'name'		=> 'recv_method',
		'default'	=> 'udp_received',
		'help'		=> <<HELP,
This method will be called in the object when a UDP packet has been received 
HELP
	},
	{
		'name'		=> 'error_method',
		'default'	=> 'udp_error',
		'help'		=> <<HELP,
This method will be called in the object when a UDP had been detected
HELP
	},
	{
		'name'		=> 'timeout_method',
		'default'	=> 'udp_timeout',
		'help'		=> <<HELP,
This method will be called in the object when no UDP data has been received
after the timeout period.
HELP
	},
	{
		'name'		=> 'log_name',
		'help'		=> <<HELP,
Log to send store sent and received messages
HELP
	},
] ;


sub new {

	my( $class ) = shift ;

	my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
	return $self unless ref $self ;

	my $info_text = '' ;

	my $socket = IO::Socket::INET->new( 'Proto' => 'udp' ) ;
	$self->{'socket'} = $socket ;

	if ( my $bind_port = $self->{'bind_port'} ) {

		$info_text .= "Port:      $bind_port\n" ;

		my $bind_ip ;
		my $bind_host = $self->{'bind_host'} ;

		if ( length $bind_host ) {

			$bind_ip = inet_aton( $bind_host ) ;
			$info_text .= "Host:       $bind_host\n" ;
		}
		else {

			$bind_ip = INADDR_ANY ;
			$info_text .= "Host:      INADDR_ANY\n" ;
		}

		$socket->bind( $bind_port, $bind_ip ) ;
	}

	my @timeout_args = ( $self->{'timeout'} ) ?
				( 'timeout' => $self->{'timeout'} ) : () ;


	if ( $self->{'server'} ) {

		$self->{'read_event'} = Stem::Event::Read->new(
					'object'	=> $self,
					'fh'		=> $socket,
					@timeout_args,
		) ;
	}

	my $reg_name = $self->{'reg_name'} || 'NONE' ;
	my $sock_host = $socket->sockhost ;
	my $sock_port = $socket->sockport ;

	$self->{'info'} = <<INFO ;
---------------------
UDPMsg

Cell name: $reg_name
Port:      $sock_port
---
$info_text
---------------------

INFO

	return $self ;
}

sub status_cmd {

	my ( $self ) = @_ ;

	return 	$self->{'info'} ;
}


sub readable {

	my( $self ) = @_ ;

#print "UDP readable\n" ;

	my $udp_data ;

	my $udp_addr = $self->{'socket'}->recv( $udp_data,
						 $self->{'max_recv_size'} ) ;

#print "UDP READ [$udp_data]\n" ;

# handle errors

	unless( defined( $udp_addr ) ) {

		if ( my $error_addr = $self->{'error_addr'} ) {

			my $msg = Stem::Msg->new(
				'to'		=> $error_addr,
				'from'		=> $self->{'from_addr'},
				'type'		=> 'udp_error',
				'data'		=> \"$!",
			) ;

#print $msg->dump( 'UDP error' ) ;
			$msg->dispatch() ;
			return ;
		}

# send the data via a callback

		if ( my $obj = $self->{'object'} ) {

			my $method = $self->{'error_method'} ;
			$obj->$method( \"$!" ) ;
		}

		return ;
	}

	my( $from_port, $from_host ) = unpack_sockaddr_in( $udp_addr ) ;

	$from_host = inet_ntoa( $from_host ) ;

# send out the data as a stem message

#print "ADDR [$self->{'data_addr'}]\n" ;

	if ( my $data_addr = $self->{'data_addr'} ) {

		my $msg = Stem::Msg->new(
			'to'		=> $data_addr,
			'from'		=> $self->{'reg_name'},
			'type'		=> 'udp_data',
			'data'		=> {
				'data'		=> \$udp_data,
				'from_port'	=> $from_port,
				'from_host'	=> $from_host,
			},
		) ;

#print $msg->dump( 'UDP recv' ) ;
		$msg->dispatch() ;
		return ;
	}

# send the data via a callback

	if ( my $obj = $self->{'object'} ) {

		my $method = $self->{'recv_method'} ;
		$obj->$method( \$udp_data, $from_port, $from_host ) ;
	}

	return ;
}

sub read_timeout {

	my( $self ) = @_ ;

#print "UDP timeout\n" ;

# send out the timeout as a stem message

	if ( my $timeout_addr = $self->{'timeout_addr'} ) {

		my $msg = Stem::Msg->new(
			'to'		=> $timeout_addr,
			'from'		=> $self->{'reg_name'},
			'type'		=> 'udp_timeout',
		) ;

#print $msg->dump( 'UDP timeout' ) ;
		$msg->dispatch() ;
		return ;
	}

# send the timeout via a callback

	if ( my $obj = $self->{'object'} ) {

		my $method = $self->{'timeout_method'} ;
		$obj->$method() ;
	}

	return ;
}


sub send_cmd {

	my ( $self, $msg ) = @_ ;

#print $msg->dump( 'UDP send' ) ;
	my $msg_data = $msg->data() ;

	my $send_port = $msg_data->{'send_port'} || $self->{'send_port'} ;
	my $send_host = $msg_data->{'send_host'} || $self->{'send_host'} ;

	my $udp_data = $msg_data->{'data'} ;

	return $self->_send( $udp_data, $send_port, $send_host ) ;
}

sub send {

	my ( $self, $data, %args ) = @_ ;

	my $send_port = $args{'send_port'} || $self->{'send_port'} ;
	my $send_host = $args{'send_host'} || $self->{'send_host'} ;

	return $self->_send( $data, $send_port, $send_host ) ;
}

sub _send {

	my( $self, $data, $port, $host ) = @_ ;

	$host or return "Missing send_host for UDP send" ;
	$port or return "Missing send_port for UDP send" ;

#print "P $port H $host\n" ;

	my $host_ip = inet_aton( $host ) ;
	$host_ip or return "Bad host '$host'" ;

	my $send_addr = pack_sockaddr_in( $port, $host_ip ) ;

	$data = $$data if ref $data ;

	my $byte_cnt = $self->{'socket'}->send( $data, 0, $send_addr ) ;

#print "BYTES [$byte_cnt]\n" ;

	return "send error: $!" unless defined $byte_cnt ;
	return ;
}


sub shut_down_cmd {

	my ( $self, $msg ) = @_ ;

#print $msg->dump( 'SHUT' ) ;

	$self->shut_down() ;

	return ;
}

sub shut_down {

	my ( $self ) = @_ ;

	if ( my $read_event = delete $self->{'read_event'} ) {

		$read_event->cancel() ;
	}

	delete $self->{'object'} ;

	my $socket = delete $self->{'socket'} ;

	close $socket ;
}

1 ;