# $Id: Echo.pm,v 1.3 2005/01/27 08:37:22 chris Exp $
#
# POE::Component::Server::Echo, by Chris 'BinGOs' Williams <chris@bingosnet.co.uk>
#
# This module may be used, modified, and distributed under the same
# terms as Perl itself. Please see the license that came with your Perl
# distribution for details.
#

package POE::Component::Server::Echo;

use strict;
use warnings;
use POE qw( Wheel::SocketFactory Wheel::ReadWrite Driver::SysRW
            Filter::Line );
use Carp;
use Socket;
use IO::Socket::INET;
use vars qw($VERSION);

use constant DATAGRAM_MAXLEN => 1024;
use constant DEFAULT_PORT => 7;

$VERSION = '1.62';

sub spawn {
  my $package = shift;
  croak "$package requires an even number of parameters" if @_ & 1;

  my %parms = @_;

  $parms{'Alias'} = 'Echo-Server' unless defined $parms{'Alias'} and $parms{'Alias'};
  $parms{'tcp'} = 1 unless defined $parms{'tcp'} and $parms{'tcp'} == 0;
  $parms{'udp'} = 1 unless defined $parms{'udp'} and $parms{'udp'} == 0;

  my $self = bless( { }, $package );

  $self->{CONFIG} = \%parms;

  POE::Session->create(
	object_states => [ 
		$self => { _start => '_server_start',
			   _stop  => '_server_stop',
			   shutdown => '_server_close' },
		$self => [ qw(_accept_new_client _accept_failed _client_input _client_error _get_datagram) ],
			  ],
	( ref $parms{'options'} eq 'HASH' ? ( options => $parms{'options'} ) : () ),
  );
  
  return $self;
}

sub _server_start {
  my ($kernel,$self) = @_[KERNEL,OBJECT];

  $kernel->alias_set( $self->{CONFIG}->{Alias} );
  
  if ( $self->{CONFIG}->{tcp} ) {
    $self->{Listener} = POE::Wheel::SocketFactory->new(
      ( defined ( $self->{CONFIG}->{BindAddress} ) ? ( BindAddress => $self->{CONFIG}->{BindAddress} ) : () ),
      ( defined ( $self->{CONFIG}->{BindPort} ) ? ( BindPort => $self->{CONFIG}->{BindPort} ) : ( BindPort => DEFAULT_PORT ) ),
      SuccessEvent   => '_accept_new_client',
      FailureEvent   => '_accept_failed',
      SocketDomain   => AF_INET,             # Sets the socket() domain
      SocketType     => SOCK_STREAM,         # Sets the socket() type
      SocketProtocol => 'tcp',               # Sets the socket() protocol
      Reuse          => 'on',                # Lets the port be reused
    );
  }
  if ( $self->{CONFIG}->{udp} ) {
    my $proto = getprotobyname('udp');
    my $port = defined ( $self->{CONFIG}->{BindPort} ) ? $self->{CONFIG}->{BindPort} : DEFAULT_PORT;
    my $paddr = sockaddr_in($port, INADDR_ANY);
    socket( my $socket, PF_INET, SOCK_DGRAM, $proto)   || die "socket: $!";
    bind( $socket, $paddr)                          || die "bind: $!";
    $self->{udp_socket} = $socket;
    $kernel->select_read( $self->{udp_socket}, "_get_datagram" );
  }
  undef;
}

sub _server_stop {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  undef;
}

sub _server_close {
  my ($kernel,$self) = @_[KERNEL,OBJECT];

  delete $self->{Listener};
  delete $self->{Clients};
  $kernel->select( $self->{udp_socket} );
  delete $self->{udp_socket};
  $kernel->alias_remove( $self->{CONFIG}->{Alias} );
  undef;
}

sub _accept_new_client {
  my ($kernel,$self,$socket,$peeraddr,$peerport) = @_[KERNEL,OBJECT,ARG0 .. ARG2];
  $peeraddr = inet_ntoa($peeraddr);

  my $wheel = POE::Wheel::ReadWrite->new (
        Handle => $socket,
        Filter => POE::Filter::Line->new(),
        InputEvent => '_client_input',
        ErrorEvent => '_client_error',
  );

  my $wheel_id = $wheel->ID();
  $self->{Clients}->{ $wheel_id }->{Wheel} = $wheel;
  $self->{Clients}->{ $wheel_id }->{peeraddr} = $peeraddr;
  $self->{Clients}->{ $wheel_id }->{peerport} = $peerport;
  undef;
}

sub _accept_failed {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  $kernel->yield( 'shutdown' );
  undef;
}

sub _client_input {
  my ($kernel,$self,$input,$wheel_id) = @_[KERNEL,OBJECT,ARG0,ARG1];

  if ( defined ( $self->{Clients}->{ $wheel_id } ) and defined ( $self->{Clients}->{ $wheel_id }->{Wheel} ) ) {
	$self->{Clients}->{ $wheel_id }->{Wheel}->put($input);
  }
  undef;
}

sub _client_error {
  my ($self,$wheel_id) = @_[OBJECT,ARG3];
  delete $self->{Clients}->{ $wheel_id };
  undef;
}

sub _get_datagram {
  my ( $kernel, $socket ) = @_[ KERNEL, ARG0 ];

  my $remote_address = recv( $socket, my $message = "", DATAGRAM_MAXLEN, 0 );
    return unless defined $remote_address;

  send( $socket, $message, 0, $remote_address ) == length($message)
      or warn "Trouble sending response: $!";
  undef;
}

sub sockname_tcp {
  my $self = shift;
  my $name;
  $name =  $self->{Listener}->getsockname() if $self->{CONFIG}->{tcp};
  return unless $name;
  return sockaddr_in($name);
}

sub sockname_udp {
  my $self = shift;
  return unless $self->{CONFIG}->{udp} and $self->{udp_socket};
  return sockaddr_in( getsockname $self->{udp_socket} );
}

1;
__END__

=head1 NAME

POE::Component::Server::Echo - A POE component that implements an RFC 862 Echo server.

=head1 SYNOPSIS

  use POE::Component::Server::Echo;

  my $self = POE::Component::Server::Echo->spawn( 
	Alias => 'Echo-Server',
	BindAddress => '127.0.0.1',
	BindPort => 7777,
	options => { trace => 1 },
  );

=head1 DESCRIPTION

POE::Component::Server::Echo implements a RFC 862 L<http://www.faqs.org/rfcs/rfc862.html> TCP/UDP echo server, using 
L<POE|POE>. The component encapsulates a class which may be used to implement further RFC protocols.

=head1 CONSTRUCTOR

=over

=item spawn

Takes a number of optional values: 

  "Alias", the kernel alias that this component is to be blessed with; 
  "BindAddress", the address on the local host to bind to, 
	defaults to L<POE::Wheel::SocketFactory|POE::Wheel::SocketFactory> default; 
  "BindPort", the local port that we wish to listen on for requests, 
        defaults to 7 as per RFC, this will require "root" privs on UN*X; 
  "options", should be a hashref, containing the options for the component's session, 
        see POE::Session for more details on what this should contain.

=back

=head1 METHODS

=over

=item sockname_tcp

Takes no arguments. Returns a list consisting of the socket port and address of the TCP listening socket as returned by Socket's sockaddr_in function.

=item sockname_udp

Takes no arguments. Returns a list consisting of the socket port and address of the UDP listening socket as returned by Socket's sockaddr_in function.

=back

=head1 INPUT EVENTS

=over

=item shutdown

Takes no arguments. Shuts down the component gracefully, terminating all listeners and disconnecting all connected clients.

=back

=head1 BUGS

Report any bugs through L<http://rt.cpan.org/>.

=head1 AUTHOR

Chris 'BinGOs' Williams, <chris@bingosnet.co.uk>

=head1 LICENSE

Copyright (C) Chris Williams

This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details.

=head1 SEE ALSO

L<POE|POE>
L<POE::Session|POE::Session>
L<POE::Wheel::SocketFactory|POE::Wheel::SocketFactory>
L<http://www.faqs.org/rfcs/rfc862.html>

=cut