File Coverage

blib/lib/AnyEvent/Ident/Client.pm

Criterion	Covered	Total	%
statement	55	80	68.7
branch	11	20	55.0
condition	4	6	66.6
subroutine	10	12	83.3
pod	2	3	66.6
total	82	121	67.7

package AnyEvent::Ident::Client;

use strict;
use warnings;
use AnyEvent::Socket qw( tcp_connect );
use AnyEvent::Handle;
use Carp qw( carp );

# ABSTRACT: Simple asynchronous ident client
our $VERSION = '0.07'; # VERSION


sub new
{
  my $class = shift;
  my $args     = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});
  my $port = $args->{port};
  $port = 113 unless defined $port;
  bless {
    hostname       => $args->{hostname}       || '127.0.0.1',
    port           => $port,
    on_error       => $args->{on_error}       || sub { carp $_[0] },
    response_class => $args->{response_class} || 'AnyEvent::Ident::Response',
  }, $class;
}


sub ident
{
  my($self, $server_port, $client_port, $cb) = @_;

  unless(eval { $self->{response_class}->can('new') })
  {
    eval 'use ' . $self->{response_class};
    die $@ if $@;
  }

  my $key = join ':', $server_port, $client_port;
  push @{ $self->{$key} }, $cb;
  return if @{ $self->{$key} } > 1;

  # if handle is defined then the connection is open and we can push
  # the request right away.
  if(defined $self->{handle})
  {
    $self->{handle}->push_write("$server_port,$client_port\015\012");
    return;
  }

  # if handle is not defined, but wait is, then we are waiting for
  # the connection, and we queue up the request
  if(defined $self->{wait})
  {
    push @{ $self->{wait} }, "$server_port,$client_port\015\012";
    return;
  }

  $self->{wait} = [];

  tcp_connect $self->{hostname}, $self->{port}, sub {
    my($fh) = @_;
    return $self->_cleanup->{on_error}->("unable to connect: $!") unless $fh;

    $self->{handle} = AnyEvent::Handle->new(
      fh       => $fh,
      on_error => sub {
        my ($hdl, $fatal, $msg) = @_;
        $self->{on_error}->($msg);
        $self->_cleanup;
        $_[0]->destroy;
        delete $self->{handle};
      },
      on_eof   => sub {
        $self->_cleanup;
        $self->{handle}->destroy;
       delete $self->{handle};
      },
    );

    $self->{handle}->push_write("$server_port,$client_port\015\012");
    $self->{handle}->push_write($_) for @{ $self->{wait} };
    delete $self->{wait};

    $self->{handle}->on_read(sub {
      $self->{handle}->push_read( line => sub {
        my($handle, $line) = @_;
        $line =~ s/\015?\012//g;
        my $res = $self->{response_class}->new($line);
        my $key = $res->_key;
        if(defined $self->{$key})
        {
          $_->($res) for @{ $self->{$key} };
          delete $self->{$key};
        }
      });
    });
  };

  return $self;
}


sub _cleanup
{
  my $self = shift;
  foreach my $key (grep /^(\d+):(\d+)$/, keys %$self)
  {
    $_->($self->{response_class}->new("$1,$2:ERROR:UNKNOWN-ERROR"))
      for @{ $self->{$key} };
    delete $self->{$key};
  }
  $self;
}

sub close
{
  my $self = shift;
  if(defined $self->{handle})
  {
    $self->_cleanup;
    $self->{handle}->destroy;
    delete $self->{handle};
    delete $self->{wait};
  }
}

sub DESTROY
{
  shift->close;
}

1;

__END__