]> scm.dxcluster.org Git - spider.git/blob - perl/IntMsg.pm
more pc41 hardening
[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 # $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