]> www.dxcluster.org Git - spider.git/blob - perl/IntMsg.pm
try to fix unblessed refs in PC34s
[spider.git] / 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 #
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