perl/lib/Net/REPL/Server.pm

   1 package Net::REPL::Server;
   2 use strict;
   3 use warnings;
   4
   5 =pod
   6
   7 =head1 NAME
   8
   9 Net::REPL::Server - Eval + Socket = interactive development
  10
  11 =head1 DESCRIPTION
  12
  13 Perl processes running Server objects accept and run code
  14 interactively from remote clients. Perl code is received over a
  15 socket, eval'd, and the Dumper'd result(s) are sent back.
  16
  17 This class can be used as-is or superclassed to plug into an event
  18 loop or provide additional capabilities like Devel::REPL integration
  19 or serializing results so that usuable Perl data structures can be
  20 exchanged bidirectionally.
  21
  22 =head2 Methods
  23
  24 =cut
  25
  26 use base qw(Net::REPL::Base);
  27
  28 use Data::Dumper;
  29 use IO::Socket::INET;
  30
  31 =head3 new(argument => value...)
  32
  33 Arguments:
  34
  35 =over
  36
  37 =item C<socket_args>
  38
  39 Hashref of arguments for L<IO::Socket::INET>.
  40
  41 =item C<debug>
  42
  43 Debug level (refer to L<Net::REPL::Base>).
  44
  45 =back
  46
  47 =cut
  48
  49 sub new {
  50     my $proto = shift;
  51     my $class = ref($proto) || $proto;
  52     my $self = {
  53         'socket_args' => {},
  54         @_,
  55     };
  56     bless($self, $class);
  57
  58     $self->debug('Server starting:', Dumper($self->{'socket_args'}));
  59
  60     my $server = IO::Socket::INET->new(
  61         'Proto' => 'tcp',
  62         'Reuse' => 1,
  63         'Listen' => 1,
  64         %{$self->{'socket_args'}},
  65     );
  66     if (not $server) {
  67         die("Couldn't start server: $!\n");
  68     }
  69     $self->{'server'} = $server;
  70     $self->cb_listen();
  71
  72     $self->{'fh'} = undef;
  73
  74     return $self;
  75 }
  76
  77 sub DESTROY {
  78     my ($self) = @_;
  79
  80     if ($self->{'server'}) {
  81         $self->{'server'}->close();
  82         $self->{'server'} = undef;
  83     }
  84     $self->close_fh();
  85 }
  86
  87 sub close_fh {
  88     my ($self) = @_;
  89
  90     if ($self->{'fh'}) {
  91         $self->{'fh'}->close();
  92         $self->{'fh'} = undef;
  93         $self->cb_disconnect();
  94     }
  95 }
  96
  97 =head3 interact()
  98
  99 Run one iteration of the REPL. Returns true if the socket remains open
 100 for further iterations.
 101
 102 Blocks until a line of input can be read from the client socket and
 103 the result flushed out to it.
 104
 105 =cut
 106
 107 sub interact {
 108     my ($self) = @_;
 109
 110     if (not $self->{'fh'}) {
 111         $self->{'fh'} = $self->{'server'}->accept();
 112         if ($self->{'fh'}) {
 113             $self->cb_connect();
 114         }
 115         else {
 116             # Accept didn't.
 117             $self->{'fh'} = undef;
 118             return;
 119         }
 120     }
 121
 122     my $input = $self->lv_receive();
 123     if (not $input) {
 124         $self->close_fh();
 125         return 0;
 126     }
 127     my @output = $self->formatted_eval($input);
 128     my $output_s = "@output";
 129     $self->lv_send($output_s);
 130     return 1;
 131 }
 132
 133 =head2 Callback Methods
 134
 135 =over
 136
 137 =item C<cb_listen()>
 138
 139 Called when the Server begins to listen for client connections.
 140
 141 =item C<cb_connect()>
 142
 143 Called whenever a client connection is accepted.
 144
 145 =item C<cb_disconnect()>
 146
 147 Called whenever a client disconnects.
 148
 149 =back
 150
 151 =cut
 152
 153 sub cb_listen {
 154     my ($self) = @_;
 155     $self->debug("Server PID $$ listening.");
 156 }
 157
 158 sub cb_connect {
 159     my ($self) = @_;
 160
 161     if (not $self->{'fh'}) {
 162         return;
 163     }
 164     $self->debug("Server PID $$ connected with "
 165                    . $self->{'fh'}->peerhost()
 166                    . ':'
 167                    . $self->{'fh'}->peerport());
 168 }
 169
 170 sub cb_disconnect {
 171     my ($self) = @_;
 172 }
 173
 174 1;