AnyEvent-Finger

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

     my %users = (
       grimlock => 'ME GRIMLOCK HAVE ACCOUNT ON THIS MACHINE',
       optimus  => 'Freedom is the right of all sentient beings.',
     );
     
     finger_server sub {
       my $tx = shift; # isa AnyEvent::Finger::Transaction
       if($tx->req->listing_request)
       {
         # respond if remote requests list of users
         $tx->res->say('users: ', keys %users);
       }
       else
       {
         # respond if user exists
         if(defined $users{$tx->req->username})
         {
           $tx->res->say($users{$request});
         }
         # respond if user does not exist
         else
         {
           $tx->res->say('no such user');
         }
       }
       # required! done generating the reply,
       # close the connection with the client.
       $tx->res->done;
     };

DESCRIPTION

    This distribution provides an asynchronous finger server and client

example/server.pl  view on Meta::CPAN

print "listening to port $port\n";

my $server = AnyEvent::Finger::Server->new( port => $port );

$server->start(
  sub {
    my $tx = shift;
    if($tx->req->listing_request)
    {
      $tx->res->say('list of sers:', '', '- grimlock');
    }
    else
    {
      if($tx->req->username eq 'grimlock')
      {
        $tx->res->('ME GRIMLOCK HAVE AN ACCOUNT ON THIS MACHINE');
      }
      else
      {
        $tx->res->('no such user');

lib/AnyEvent/Finger.pm  view on Meta::CPAN

 my %users = (
   grimlock => 'ME GRIMLOCK HAVE ACCOUNT ON THIS MACHINE',
   optimus  => 'Freedom is the right of all sentient beings.',
 );
 
 finger_server sub {
   my $tx = shift; # isa AnyEvent::Finger::Transaction
   if($tx->req->listing_request)
   {
     # respond if remote requests list of users
     $tx->res->say('users: ', keys %users);
   }
   else
   {
     # respond if user exists
     if(defined $users{$tx->req->username})
     {
       $tx->res->say($users{$request});
     }
     # respond if user does not exist
     else
     {
       $tx->res->say('no such user');
     }
   }
   # required! done generating the reply,
   # close the connection with the client.
   $tx->res->done;
 };

=head1 DESCRIPTION

This distribution provides an asynchronous finger server and

lib/AnyEvent/Finger/Response.pm  view on Meta::CPAN

=head1 DESCRIPTION

This class provides an interface for constructing a response
from a finger server for L<AnyEvent::Finger::Server>.  See
the documentation on that class for more details.

=head1 METHODS

=head2 say

 $response->say( @lines )

Send the lines to the client.  Do not include new line characters (\r,
\n or \r\n), these will be added by L<AnyEvent::Finger::Server>.

=head2 done

 $response->done

Close the connection with the client.  This signals that the response is
complete.  Do not forget to call this!

lib/AnyEvent/Finger/Server.pm  view on Meta::CPAN

 my %users = (
   grimlock => "ME GRIMLOCK HAVE PLAN",
   optimus  => "Freedom is the right of all sentient beings.",
 );
 
 $server->start(sub {
   my($tx) = @_;
   if($tx->req->listing_request)
   {
     # respond if remote requests list of users
     $tx->res->say('users:', keys %users);
   }
   else
   {
     # respond if user exists
     if(defined $users{$tx->req->username})
     {
       $tx->res->say($users{$tx->req->username});
     }
     # respond if user does not exist
     else
     {
       $tx->res->say('no such user');
     }
   }
   # required! done generating the reply,
   # close the connection with the client.
   $tx->res->done;
 });

=head1 DESCRIPTION

Provide a simple asynchronous finger server.

lib/AnyEvent/Finger/Server.pm  view on Meta::CPAN

The first argument passed to the callback is the transaction object,
which is an instance of L<AnyEvent::Finger::Transaction>.  The most
important members of these objects that you will want to interact
with are C<$tx-E<gt>req> for the request (an instance of
L<AnyEvent::Finger::Request>) and C<$tx-E<gt>res> for the response
interface (an instance of L<AnyEvent::Finger::Response>).

With the response object you can return a whole response at one time:

 $tx->res->say(
   "this is the first line",
   "this is the second line",
   "there will be no forth line",
 );
 $tx->res->done;

or you can send line one at a time as they become available (possibly
asynchronously).

 # $dbh is a DBI database handle
 my $sth = $dbh->prepare("select user_name from user_list");
 while(my $h = $sth->fetchrow_hashref)
 {
   $tx->res->say($h->{user_name});
 }
 $tx->res->done;

The server will unbind from its port and stop if the server
object falls out of scope, or if the C<stop> method (see below)
is called.

=head2 bindport

 $server->bindport

t/forward.t  view on Meta::CPAN

my $server1 = AnyEvent::Finger::Server->new(
  port         => 0,
  hostname     => '127.0.0.1',
  forward_deny => 1,
  on_bind      => sub { $bind->send },
);

$server1->start(sub {
  my $tx = shift;
  $tx->res->say('server1');
  $tx->res->say('username = ' . $tx->req->username);
  $tx->res->say('verbose  = ' . $tx->req->verbose);
  $tx->res->done;
});

$bind->recv;
like $server1->bindport, qr{^[1-9]\d*$}, "server1->bindport = " . $server1->bindport;

my $client1 = AnyEvent::Finger::Client->new(
  port     => $server1->bindport,
  on_error => sub { say STDERR shift; exit 2 },
);

$bind = AnyEvent->condvar;
my $server2 = AnyEvent::Finger::Server->new(
  port     => 0,
  hostname => '127.0.0.1',
  forward  => $client1,
  on_bind  => sub { $bind->send },
);
$server2->start(sub {
  my $tx = shift;
  $tx->res->say('server2');
  $tx->res->done;
});

like $server2->bindport, qr{^[1-9]\d*$}, "server2->bindport = " . $server2->bindport;

my $client2 = AnyEvent::Finger::Client->new(
  port     => $server2->bindport,
  on_error => sub { say STDERR shift; exit 2 },
);

subtest 'finger', sub {
  my $done = AnyEvent->condvar;

  my $lines;
  $client2->finger('', sub {
    ($lines) = shift;
    $done->send;
  });

t/forward_deny.t  view on Meta::CPAN

    forward_deny => 1,
    on_bind      => sub { $bind->send },
  );
};
diag $@ if $@;
isa_ok $server, 'AnyEvent::Finger::Server';

eval { $server->start(
  sub {
    my $tx = shift;
    $tx->res->say("okay");
    $tx->res->done;
  }
) };
diag $@ if $@;

$bind->recv;
my $port = $server->bindport;
like $port, qr{^[123456789]\d*$}, "bindport = $port";

my $client = AnyEvent::Finger::Client->new( port => $port, on_error => sub { say STDERR shift; exit 2 } );

subtest "finger" => sub {
  my $done = AnyEvent->condvar;

  my $lines;
  $client->finger('', sub {
    ($lines) = shift;
    $done->send;
  });

t/server.t  view on Meta::CPAN

diag $@ if $@;
isa_ok $server, 'AnyEvent::Finger::Server';

eval {
  $bind = AnyEvent->condvar;
  $server->start(
    sub {
      my $tx = shift;
      my $req = $tx->req;
      eval {
        $tx->res->say("request = '$req'");
        $tx->res->say($tx->remote_port);
        $tx->res->say($tx->local_port);
        $tx->res->say($tx->remote_address);
      };
      diag $@ if $@;
      $tx->res->done;
    }
  );
  $bind->recv;
};
diag $@ if $@;

my $port = $server->bindport;
like $port, qr{^[123456789]\d*$}, "bindport = $port";

my $client = AnyEvent::Finger::Client->new( port => $port, on_error => sub { say STDERR shift; exit 2 } );

subtest t1 => sub {
  my $done = AnyEvent->condvar;

  my $lines;
  $client->finger('', sub {
    ($lines) = shift;
    $done->send;
  });

t/server.t  view on Meta::CPAN

  $done->recv;

  is $lines->[0], "request = 'grimlock'", 'response is correct';
};

eval {
  $server->stop;
  $bind = AnyEvent->condvar;
  $server->start(sub {
    my $tx = shift;
    $tx->res->say(
      "request_isa: " . ref($tx->req),
      "verbose:     " . $tx->req->verbose,
      "username:    " . $tx->req->username,
      "hostnames:   " . join("@", @{ $tx->req->hostnames }),
    );
    $tx->res->done;
  });
  $bind->recv;
};
diag $@ if $@;

$port = $server->bindport;
like $port, qr{^[123456789]\d*$}, "bindport = $port";
$client = AnyEvent::Finger::Client->new( port => $port, on_error => sub { say STDERR shift; exit 2 } );

subtest t3 => sub {
  my $done = AnyEvent->condvar;

  my $lines;
  $client->finger('/W grimlock@localhost@foo@bar@baz', sub {
    $lines = shift;
    $done->send;
  });