[popfile-commit] engine/Test SimpleProxy.pm,NONE,1.1

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/Test
In directory sc8-pr-cvs1:/tmp/cvs-serv21270/Test

Added Files:
	SimpleProxy.pm 
Log Message:
Make test suite run from within the tests/ subdirectory to avoid interference with an installed POPFile.  You must now use the Makefile to execute tests.  A outline of class that will be used for proxy testing and improve WordMangle tests

--- NEW FILE: SimpleProxy.pm ---
package Test::SimpleProxy;

use Proxy::Proxy;
@ISA = ("Proxy::Proxy");

# ---------------------------------------------------------------------------------------------
#
# A simple test proxy server for testing Proxy::Proxy
#
# Copyright (c) 2001-2003 John Graham-Cumming
#
# ---------------------------------------------------------------------------------------------

use strict;
use warnings;
use locale;

use IO::Handle;
use IO::Socket;
use IO::Select;

# A handy variable containing the value of an EOL for networks
my $eol = "\015\012";

#----------------------------------------------------------------------------
# new
#
#   Class new() function
#----------------------------------------------------------------------------
sub new
{
    my $type = shift;
    my $self = Proxy::Proxy->new();

    # Must call bless before attempting to call any methods

    bless $self, $type;

    $self->name( 'simple' );

    return $self;
}

#----------------------------------------------------------------------------
# start_server
#
#   Starts a phony remote server for the proxy to connect to
#----------------------------------------------------------------------------
sub start_server
{
    my ( $self ) = @_;

    # This socket will act as the server that the proxy is connecting to,
    # SimpleProxy is used to connect to this server and proxy to and from
    # it.  The data sent to this socket is appended to {received__} and the
    # data to be made available is appended to {send__}

    $self->{remote_server__} = IO::Socket::INET->new( Proto     => 'tcp',
                                    LocalAddr => 'localhost',
                                    LocalPort => 10000,
                                    Listen    => SOMAXCONN,
                                    Reuse     => 1 );

    $self->{remote_selector__} = new IO::Select( $self->{remote_server__} );
}

#----------------------------------------------------------------------------
# service_server
#
#   Called regularly to service connections to the phony server
#----------------------------------------------------------------------------
sub service_server
{
    my ( $self ) = @_;

    # If we have already accepted a connection then service it, otherwise
    # check for connections

    if ( defined( $self->{remote_client__} ) ) {
        my $handle = $self->{remote_client__};

        # If there's data in the send pipe then write it out line by line

        while ( $self->{send__} =~ s/(.+)[\r\n]+// ) {
            print $handle "$1$eol";
	  }

        # If there's data available to read then read it into the received

        if ( defined( $self->{remote_client_selector__}->can_read(0) ) ) {
            $self->{received__} .= <$handle>;
            $self->{received__} .= $eol;
	}
    } else {
        if ( defined( $self->{remote_selector__}->can_read(0) ) ) {
            $self->{remote_client__} = $self->{remote_server__}->accept();
            $self->{remote_client_selector__} = new IO::Select( $self->{remote_client__} );
	}
    }
}

# Getter/setter

sub received
{
    my ( $self ) = @_;
    my $received = $self->{received__};

    $self->{received__} = '';

    return $received;
}

sub send
{
    my ( $self, $line ) = @_;

    $self->{send__} .= $line;
    $self->{send__} .= $eol;
}