diff --git a/src/lib-perl/lib/Daemonproxy/Protocol.pm b/src/lib-perl/lib/Daemonproxy/Protocol.pm index fed4b34..0d9f9ae 100644 --- a/src/lib-perl/lib/Daemonproxy/Protocol.pm +++ b/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; } diff --git a/src/lib-perl/t/100-use.t b/src/lib-perl/t/100-use.t new file mode 100644 index 0000000..e5b38b2 --- /dev/null +++ b/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; diff --git a/src/lib-perl/t/lib/Test/MockDaemonproxy.pm b/src/lib-perl/t/lib/Test/MockDaemonproxy.pm new file mode 100644 index 0000000..8cea8bf --- /dev/null +++ b/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; diff --git a/src/lib-perl/t/lib/TestDpProto.pm b/src/lib-perl/t/lib/TestDpProto.pm new file mode 100644 index 0000000..aee4ac9 --- /dev/null +++ b/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;