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