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
  14 use Msg;
  15
  16 use vars qw(@ISA);
  17
  18 @ISA = qw(Msg);
  19
  20 sub login
  21 {
  22         goto &main::login;        # save some writing, this was the default
  23 }
  24
  25 sub enqueue
  26 {
  27         my ($conn, $msg) = @_;
  28         $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
  29     push (@{$conn->{outqueue}}, $msg . "\n");
  30 }
  31
  32 sub dequeue
  33 {
  34         my $conn = shift;
  35
  36         if ($conn && $conn->{msg} =~ /\cJ/) {
  37                 my @lines =  $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g;
  38                 if ($conn->{msg} =~ /\cJ$/) {
  39                         delete $conn->{msg};
  40                 } else {
  41                         $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
  42                 }
  43                 for (@lines) {
  44                         if (defined $_) {
  45                                 s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
  46                         } else {
  47                                 $_ = '';
  48                         }
  49                         &{$conn->{rproc}}($conn, $_) if exists $conn->{rproc};
  50                 }
  51         }
  52 }
  53