package Net::Proxy;
use strict;
use warnings;
use Carp;
use Scalar::Util qw( refaddr reftype );
use IO::Select;
use POSIX 'strftime';
our $VERSION = '0.12';
# interal socket information table
my %SOCK_INFO;
my %LISTENER;
my %CLOSING;
my $READERS;
my $WRITERS;
my %PROXY;
my %STATS;
# Net::Proxy attributes
my %CONNECTOR = (
in => {},
out => {},
);
my $VERBOSITY = 0; # be silent by default
my $BUFFSIZE = 16384;
#
# some logging-related methods
#
sub set_verbosity { $VERBOSITY = $_[1]; }
{
my $i;
for my $meth (qw( error notice info debug )) {
no strict 'refs';
my $level = $i++;
*$meth = sub {
return if $VERBOSITY < $level;
print STDERR strftime "%Y-%m-%d %H:%M:%S $_[1]\n", localtime;
};
}
}
#
# constructor
#
sub new {
my ( $class, $args ) = @_;
my $self = bless \do { my $anon }, $class;
croak "Argument to new() must be a HASHREF" if ref $args ne 'HASH';
for my $conn (qw( in out )) {
# check arguments
croak "'$conn' connector required" if !exists $args->{$conn};
croak "'$conn' connector must be a HASHREF"
if ref $args->{$conn} ne 'HASH';
croak "'type' key required for '$conn' connector"
if !exists $args->{$conn}{type};
croak "'hook' key is not a CODE reference for '$conn' connector"
if $args->{$conn}{hook}
&& reftype( $args->{$conn}{hook} ) ne 'CODE';
# load the class
my $class = 'Net::Proxy::Connector::' . $args->{$conn}{type};
eval "require $class";
croak "Couldn't load $class for '$conn' connector: $@" if $@;
# create and store the Connector object
$args->{$conn}{_proxy_} = $self;
$CONNECTOR{$conn}{ refaddr $self} = $class->new( $args->{$conn} );
$CONNECTOR{$conn}{ refaddr $self}->set_proxy($self);
}
return $self;
}
sub register { $PROXY{ refaddr $_[0] } = $_[0]; }
sub unregister { delete $PROXY{ refaddr $_[0] }; }
#
# The Net::Proxy attributes
#
sub in_connector { return $CONNECTOR{in}{ refaddr $_[0] }; }
sub out_connector { return $CONNECTOR{out}{ refaddr $_[0] }; }
#
# create the socket setter/getter methods
# these are actually Net::Proxy clas methods
#
BEGIN {
my $n = 0;
my $buffer_id;
for my $attr (qw( peer connector state nick buffer callback )) {
no strict 'refs';
my $i = $n;
=1= |