Added utils and first testcase for Daemonproxy::Protocol

Also fixed syntax errors in Daemonproxy::Protocol revealed by test

refs #47

src/lib-perl/lib/Daemonproxy/Protocol.pm

@@ -4,7 +4,8 @@ use Log::Any '$log';
 use Time::HiRes 'time';
 use Carp;
 
-has 'handle',           is => 'ro', required => 1;
+has 'rd_handle',        is => 'ro', required => 1;
+has 'wr_handle',        is => 'ro', required => 1;
 has 'state',            is => 'rw';
 has 'pending_commands', is => 'rw';
 has 'signals',          is => 'rw';
@@ -24,7 +25,7 @@ sub file_descriptor {
 
 sub pump_events {
 	my $self= shift;
-	while (defined my $line= $self->handle->getline) {
+	while (defined (my $line= $self->rd_handle->getline)) {
 		$self->process_event($line);
 	}
 }
@@ -33,7 +34,7 @@ sub process_event {
 	my ($self, $text)= @_;
 	chomp $text;
 	my ($event_id, @args)= split /\t/, $text;
-	$event_id =~ tr/./_/g;
+	$event_id =~ tr/./_/;
 	if (my $mth= $self->can('process_event_'.$event_id)) {
 		$self->$mth(@args);
 	} else {
@@ -42,7 +43,7 @@ sub process_event {
 }
 
 sub process_event_service_state {
-	my $self= shit;
+	my $self= shift;
 	my $service_name= shift;
 	@{$self->{state}{services}{$service_name}}{qw( state timestamp pid exit_reason exit_value uptime downtime )}=
 		map { defined $_ && $_ eq '-'? undef : $_ } @_;
@@ -59,7 +60,7 @@ sub process_event_service_auto_up {
 
 sub process_event_service_tags {
 	my ($self, $service_name, @tags)= @_;
-	$self->{state}{services}{$service_name}{'tags','tags_hash'}= (\@tags, undef);
+	@{$self->{state}{services}{$service_name}}{'tags','tags_hash'}= (\@tags, undef);
 }
 
 sub process_event_service_fds {
@@ -69,7 +70,7 @@ sub process_event_service_fds {
 
 sub process_event_fd_state {
 	my ($self, $fd_name, $type, $flags, $descrip)= @_;
-	@{$self->{state}{handles}{$fd_name}{state}}{'type','flags','descrip'}= ($type, $flags, $descrip);
+	@{$self->{state}{fds}{$fd_name}{state}}{'type','flags','descrip'}= ($type, $flags, $descrip);
 }
 
 sub process_event_echo {
@@ -84,7 +85,7 @@ sub process_event_echo {
 sub send {
 	my $self= shift;
 	my $msg= join("\t", @_);
-	$self->handle->print($msg."\n");
+	$self->wr_handle->print($msg."\n");
 }
 
 sub begin_cmd {
@@ -102,6 +103,7 @@ sub _get_cmd_watcher {
 }
 
 sub reset {
+	my $self= shift;
 	$self->{state}= {};
 	return $self->begin_cmd("statedump");
 }
@@ -164,7 +166,7 @@ sub tag_values {
 	my $tag_hash= shift->_tag_hash;
 	return @_ > 1? @{$tag_hash}{@_}
 		: ref $_[0] eq 'ARRAY'? [ @{$tag_hash}{@{$_[0]}} ]
-		: $tags_hash->{$_[0]};
+		: $tag_hash->{$_[0]};
 }
 
 sub start {
@@ -227,6 +229,7 @@ package Daemonproxy::Protocol::FileDescriptor;
 use strict;
 use warnings;
 no warnings 'uninitialized';
+use Carp;
 
 sub conn { $_[0][0] }
 sub name { $_[0][1] }
@@ -287,6 +290,7 @@ has 'args',     is => 'ro', required => 1;
 has 'complete', is => 'rw';
 
 sub wait {
+	my $self= shift;
 	$self->conn->pump_events until $self->complete;
 }
 

src/lib-perl/t/100-use.t

@@ -0,0 +1,14 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More;
+use FindBin;
+use Try::Tiny;
+use lib "$FindBin::Bin/lib";
+
+use_ok( 'TestDpProto' ) or BAIL_OUT;
+use_ok( 'Daemonproxy::Protocol' ) or BAIL_OUT;
+ok( try { mock_dp()->client }, 'create mock_dp and client' ) or BAIL_OUT;
+
+done_testing;

src/lib-perl/t/lib/Test/MockDaemonproxy.pm

@@ -0,0 +1,40 @@
+package Test::MockDaemonproxy;
+use strict;
+use warnings;
+use IO::Handle;
+use Log::Any '$log';
+use Daemonproxy::Protocol;
+
+sub new {
+	my $class= shift;
+	my %args= @_ == 1 && ref $_[0] eq 'HASH'? %{ $_[0] } : @_;
+	pipe($args{event_rd}, $args{event_wr});
+	pipe($args{cmd_rd}, $args{cmd_wr});
+	bless \%args, $class;
+}
+
+sub client {
+	my $self= shift;
+	return $self->{client} ||= Daemonproxy::Protocol->new(
+		rd_handle => $self->{event_rd},
+		wr_handle => $self->{event_wr}
+	);
+}
+
+sub next_cmd {
+	my $self= shift;
+	$self->{cmd_rd}->blocking(0);
+	my $line= $self->{cmd_rd}->getline;
+	return unless defined $line;
+	chomp $line;
+	return [ split /\t/, $line ];
+}
+
+sub send_event {
+	my ($self, @args)= @_;
+	my $msg= join("\t", @args);
+	$log->tracef("mock event: %s", $msg) if $log->is_trace;
+	$self->{event_wr}->print($msg."\n");
+}
+
+1;

src/lib-perl/t/lib/TestDpProto.pm

@@ -0,0 +1,70 @@
+package TestDpProto;
+use strict;
+use warnings;
+use Carp;
+use FindBin;
+use lib "$FindBin::Bin/../../../../t/lib";
+use Exporter 'import';
+our @EXPORT= qw( dp client client2 mock_dp );
+
+our $mock_dp;
+sub mock_dp {
+	$mock_dp ||= do {
+		require Test::MockDaemonproxy;
+		Test::MockDaemonproxy->new;
+	};
+}
+
+our $dp;
+sub dp {
+	$dp ||= do {
+		require Test::Daemonproxy;
+		Test::Daemonproxy->new();
+	};
+}
+
+our $client1;
+sub dp_client1 {
+	$client1 ||= do {
+		require Daemonproxy::Protocol;
+		Daemonproxy::Protocol->new(
+			rd_handle => dp->dp_stdout,
+			wr_handle => dp->dp_stdin
+		);
+	};
+}
+*dp_client= *dp_client1;
+
+our $client2;
+sub dp_client2 {
+	$client2 ||= do {
+		require Socket;
+
+		# The only way to connect an additional client to daemonproxy is
+		# to either spawn a new client process, or connect via socket.
+		# We opt for the socket route here.  The alternative is to define
+		# and start a new service which relays its handles to pipes that
+		# we created when spawning daemonproxy.
+		-d "$FindBin::Bin/tmp" or mkdir("$FindBin::Bin/tmp") or croak "can't create ./tmp dir";
+		my $sockpath= "$FindBin::Bin/tmp/daemonproxy-client2.sock";
+		unlink $sockpath;
+
+		# Create a socket, connect to it, and then remove it
+
+		client->send("socket.create", "-", $sockpath);
+		for (1..100) { last if -S $sockpath; sleep 0.1; }
+		socket(my $sock, Socket::AF_UNIX(), Socket::SOCK_STREAM(), 0)
+			or die "Can't create socket: $!";
+		connect($sock, Socket::sockaddr_un($sockpath))
+			or croak "Can't connect to $sockpath";
+		client->send("socket.delete");
+
+		# Return protocol client on this new socket
+		DaemonProxy::Protocol->new(
+			rd_handle => $sock,
+			wr_handle => $sock
+		);
+	}
+}
+
+1;