perl/lib/Net/REPL/Base.pm

   1 package Net::REPL::Base;
   2 use strict;
   3 use warnings;
   4
   5 =pod
   6
   7 =head1 NAME
   8
   9 Net::REPL::Base - Utilities for REPL clients and servers.
  10
  11 =head1 DESCRIPTION
  12
  13 This contains the protocol implementation and various other simple
  14 utilities.
  15
  16 The REPL protocol uses length/value strings. A value is encoded to one
  17 of these strings by concatenating its 32-bit unsigned big-endian
  18 length with the value as a bytestring.
  19
  20 =head2 Methods
  21
  22 =cut
  23
  24 use Data::Dumper;
  25
  26 =head3 lv_receive()
  27
  28 Read and return one length/value encoded string from the file handle.
  29
  30 Dies if an error (like the socket closing unexpectedly) occurs during
  31 the read call. Returns a partial string or undef if the read is merely
  32 incomplete.
  33
  34 =cut
  35
  36 sub lv_receive {
  37     my ($self) = @_;
  38
  39     my $total_length = unpack('N', $self->_read_fh(4));
  40     if (not defined($total_length)) {
  41         return;
  42     }
  43     # $self->debug('Incoming message:', $total_length);
  44     my $message = $self->_read_fh($total_length);
  45     return unpack('a*', $message);
  46 }
  47
  48 sub _read_fh {
  49     my ($self, $length) = @_;
  50
  51     my $data;
  52     my $result = sysread($self->{'fh'}, $data, $length);
  53     if (not defined($result)) {
  54         $self->debug("REPL PID $$ reading: $!")
  55     }
  56     return $data;
  57
  58 }
  59
  60 =head3 lv_send($message)
  61
  62 Encode $message as a length/value string and write it to the file handle.
  63
  64 =cut
  65
  66 sub lv_send {
  67     my ($self, $message) = @_;
  68
  69     my $length = length($message);
  70     my $initial = pack('N', $length);
  71     $self->{'fh'}->send($initial . $message);
  72     $self->{'fh'}->flush();
  73 }
  74
  75 =head3 debug(@words)
  76
  77 Write words to the debug log according to the current debug level.
  78
  79 The default implementation writes to STDERR and uses the debug level
  80 as a boolean (i.e., 0 or other false values disable it).
  81
  82 =cut
  83
  84 sub debug {
  85     my ($self, @words) = @_;
  86
  87     if ($self->{'debug'}) {
  88         print STDERR join(' ', 'REPL:', @words) . "\n";
  89     }
  90 }
  91
  92 =head3 formatted_eval($code)
  93
  94 Eval the Perl $code and return the Dumper'd or serialized result.
  95
  96 =cut
  97
  98 # TODO: integrate with Devel::REPL
  99 sub formatted_eval {
 100     my ($self, $input) = @_;
 101
 102     my @output;
 103     do {
 104         local $SIG{'__DIE__'} = 'DEFAULT';
 105         @output = eval('sub { ' . $input . '}->();');
 106     };
 107     # TODO: should this also pass through warnings?
 108     if ($@) {
 109         return $@;
 110     }
 111     else {
 112         my $dumper = Data::Dumper->new(\@output);
 113         $dumper->Deparse(1);
 114         return $dumper->Dump();
 115     }
 116 }
 117
 118 1;