The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;
use Net::Proxy;
use Getopt::Long;
use Benchmark qw( :hireswallclock timediff );
use Pod::Usage;

my %conf = (
    proxy       => 10000,
    server      => 10001,
    connections => 1,
);
GetOptions( \%conf, 'help', 'manual', 'verbose+', map {"$_=s"} keys %conf )
    or pod2usage(2);
pod2usage(1) if $conf{help};
pod2usage( -verbose => 2 ) if $conf{manual};

# mark the beginning of the benchmark/profiling
my $t0;

for my $item (qw( proxy server )) {
    $conf{$item} = ":$conf{$item}" if $conf{$item} !~ /:/;
    $conf{$item} = [ split /:/, $conf{$item} ];
}

# setup the proxy
my $proxy = Net::Proxy->new(
    {   in => {
            type    => 'tcp',
            host    => $conf{proxy}[0] || 'localhost',
            port    => $conf{proxy}[1],
            timeout => 1,
            hook    => sub {
                $t0 ||= Benchmark->new;
                Net::Proxy->set_callback( $_[1] );    # remove ourselves now
                }
        },
        out => {
            type => 'tcp',
            host => $conf{server}[0] || 'localhost',
            port => $conf{server}[1],
        },
    }
);
$proxy->register();

Net::Proxy->set_verbosity( $conf{verbose} || 0 );
Net::Proxy->mainloop( $conf{connections} );

# end of benchmark/profiling
my $t1 = timediff( Benchmark->new, $t0 );
print "\nforwarder.pl report: @$t1\n";

__END__

=head1 NAME

forwarder.pl - An example TCP port forwarder

=head1 SYNOPSIS

forwarder.pl [ options ]

=head1 OPTIONS

    --help                    Display this help
    --manual                  Longer manpage
    --verbose                 Increase verbosity (may be used several times)
    --proxy  [<host>:]<port>  Local port to be forwarded (default: 10000)
    --server [<host>:]<port>  Destination server         (default: 10001)
    --connections <n>         Maximum number of connection to accept
                              (0 means never stop, default is 1)

=head1 DESCRIPTION

This script is an example port forwarder written with C<Net::Proxy>.

If run for a limited number of connections, it prints a small
wallclock/CPU time report at the end.

It is used to profile C<Net::Proxy> itself, by using C<Devel::DProf>
and the B<bench.pl> script (also distributed in the F<eg/> directory
of the C<Net-Proxy> distribution.

=head1 AUTHOR

Philippe Bruhat (BooK), C<< <book@cpan.org> >>.

=head1

=head1 COPYRIGHT

Copyright 2008 Philippe Bruhat (BooK), All Rights Reserved.
 
=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut