perl/IntMsg.pm

   1 #
   2 # This class is the internal subclass that deals with the internal port 27754
   3 # communications for Msg.pm
   4 #
   5 # $Id$
   6 #
   7 # Copyright (c) 2001 - Dirk Koopman G1TLH
   8 #
   9
  10 package IntMsg;
  11
  12 use strict;
  13 use Msg;
  14
  15 use vars qw(@ISA);
  16
  17 @ISA = qw(Msg);
  18
  19 sub enqueue
  20 {
  21         my ($conn, $msg) = @_;
  22         $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
  23     push (@{$conn->{outqueue}}, $msg . "\n");
  24 }
  25
  26 sub dequeue
  27 {
  28         my $conn = shift;
  29
  30         if ($conn && $conn->{msg} =~ /\n/) {
  31                 my @lines = split /\r?\n/, $conn->{msg};
  32                 if ($conn->{msg} =~ /\n$/) {
  33                         delete $conn->{msg};
  34                 } else {
  35                         $conn->{msg} = pop @lines;
  36                 }
  37                 for (@lines) {
  38                         if (defined $_) {
  39                                 s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
  40                                 s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
  41                         } else {
  42                                 $_ = '';
  43                         }
  44                         &{$conn->{rproc}}($conn, $_) if exists $conn->{rproc};
  45                 }
  46         }
  47 }
  48