File Coverage

blib/lib/Net/RRP/Lite.pm

Criterion	Covered	Total	%
statement	25	69	36.2
branch	0	16	0.0
condition			n/a
subroutine	8	17	47.0
pod	4	5	80.0
total	37	107	34.5

package Net::RRP::Lite;

use strict;
use vars qw($VERSION $DEBUG);
$VERSION = '0.02';
$DEBUG = 0;
use Net::RRP::Lite::Response;

use constant CRLF => "\r\n";
use constant END_MARK => qr/\r\n\.\r\n/;
use constant READ_LEN => 64;

__PACKAGE__->_mk_commands(qw(add check del describe mod quit renew session status transfer));

sub new {
    my($class, $sock) = @_;
    my $self = bless {_sock => $sock}, $class;
    $self->_read_until(END_MARK); # READ HELLO.
    return $self;
}

sub connect {
    my($class, %args) = @_;
    require IO::Socket::SSL;
    my $sock = IO::Socket::SSL->new(%args)
	or _croak("could not make socket:$!");
    return $class->new($sock);
}

sub login {
    my($self, $registrer, $password) = @_;
    $self->request('SESSION', undef, {
	-Id => $registrer,
	-Password => $password,
    });
}

sub disconnect {
    my $self = shift;
    my $res = $self->request('QUIT');
    $self->{_sock}->close;
    return $res;
}

sub request {
    my($self, $command, $entity, $args) = @_;
    $self->_write_sock(sprintf("%s". CRLF, lc($command)));
    $self->_write_sock(sprintf("EntityName:%s". CRLF, $entity)) if $entity;
    if (ref($args) eq 'HASH') {
	while (my($key, $val) = each %$args) {
	    if (ref($val) eq 'ARRAY') {
		for my $v(@$val) {
		    $self->_write_sock(sprintf("%s:%s". CRLF, $key, $v));
		}
	    }
	    else {
		$self->_write_sock(sprintf("%s:%s". CRLF, $key, $val));
	    }
	}
    }
    $self->_write_sock(".". CRLF);
    my $result_data = $self->_read_until(END_MARK);
    return Net::RRP::Lite::Response->new($result_data);
}

sub _read_until {
    my($self, $stop) = @_;
    my $line = "";
    my $buf = "";
    my $len = 0;
    while (my $len = $self->{_sock}->sysread($line, READ_LEN)) {
	$buf .= $line;
	if ($buf =~ m/$stop/s) {
	    if ($DEBUG) {
		warn "S:$_\r\n" for(split(/\r\n/, $`));
	    }
	    return $`;
	}
    }
    _croak("could not read data") unless $len;
}

sub _write_sock {
    my($self, $data) = @_;
    warn "C:$data" if $DEBUG;
    $self->{_sock}->print($data);
}

sub _mk_commands {
    my($class, @commands) = @_;
    no strict 'refs';
    for my $command(@commands) {
	*{"$class\:\:$command"} = sub {
	    my($self, $entity, $args) = @_;
	    $self->request($command, $entity, $args);
	}
    }
}

sub _croak {
    require Carp;
    Carp::croak(@_);
}

1;
__END__