]> gb7djk.dxcluster.net Git - spider.git/blob - perl/DXXml.pm
a351510c511f02ca0f8ce450bb3d3906c39f61c1
[spider.git] / perl / DXXml.pm
1 #
2 # XML handler
3 #
4 # $Id$
5 #
6 # Copyright (c) Dirk Koopman, G1TLH
7 #
8
9 use strict;
10
11 package DXXml;
12 use IsoTime;
13
14 use DXProt;
15 use DXDebug;
16 use DXLog;
17 use DXXml::Ping;
18 use DXXml::Dx;
19
20 use vars qw($VERSION $BRANCH $xs $id);
21 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
22 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
23 $main::build += $VERSION;
24 $main::branch += $BRANCH;
25
26 $xs = undef;                                    # the XML::Simple parser instance
27 $id = 0;                                                # the next ID to be used
28
29 # generate a new XML sentence structure 
30 sub new
31 {
32         my $pkg = shift;
33         my $class = ref $pkg || $pkg;
34         return bless{@_}, $class;
35 }
36
37 #
38 # note that this a function not a method
39 #
40 sub init
41 {
42         return unless $main::do_xml;
43         
44         eval { require XML::Simple; };
45         unless ($@) {
46                 import XML::Simple;
47                 $DXProt::handle_xml = 1;
48                 $xs = new XML::Simple();
49         }
50         undef $@;
51 }
52
53 #
54 # note that this a function not a method
55 #
56 sub normal
57 {
58         my $dxchan = shift;
59         my $line = shift;
60
61         unless ($main::do_xml) {
62                 dbg("xml not enabled, IGNORED") if isdbg('chanerr');
63                 return;
64         }
65         
66         my ($rootname) = $line =~ '<(\w+) ';
67         my $pkg = "DXXml::" . ucfirst lc "$rootname";
68
69         unless (defined *{"${pkg}::"} && $pkg->can('handle_input')) {
70                 dbg("xml sentence $rootname not recognised, IGNORED") if isdbg('chanerr');
71                 return;
72         }
73                 
74         my $xref;
75         unless ($xref = $pkg->decode_xml($dxchan, $line))  {
76                 dbg("invalid XML ($@), IGNORED") if isdbg('chanerr');
77                 undef $@;
78                 return;
79         }
80         
81         # mark the handle as accepting xml (but only if they 
82         # have at least one right)
83         $dxchan->handle_xml(1);
84
85         $xref = bless $xref, $pkg;
86         $xref->{'-xml'} = $line; 
87         $xref->handle_input($dxchan);
88 }
89
90 #
91 # note that this a function not a method
92 #
93
94 my $last10;
95 my $last_hour;
96
97 sub process
98 {
99         my $t = time;
100         my @dxchan = DXChannel::get_all();
101         my $dxchan;
102
103         foreach $dxchan (@dxchan) {
104                 next unless $dxchan->is_node;
105                 next unless $dxchan->handle_xml;
106                 next if $dxchan == $main::me;
107
108                 # send a ping out on this channel
109                 if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
110                         if ($dxchan->{nopings} <= 0) {
111                                 $dxchan->disconnect;
112                         } else {
113                                 DXXml::Ping::add($main::me, $dxchan->call);
114                                 $dxchan->{nopings} -= 1;
115                                 $dxchan->{lastping} = $t;
116                                 $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
117                         }
118                 }
119         }
120
121
122         # every ten seconds
123         if (!$last10 || $t - $last10 >= 10) {   
124                 $last10 = $t;
125         }
126
127         # every hour
128         if (!$last_hour || $main::systime - 3600 > $last_hour) {
129                 $last_hour = $main::systime;
130         }
131
132 }
133
134 sub decode_xml
135 {
136         my $pkg = shift;
137         my $dxchan = shift;
138         my $line = shift;
139
140         my $xref;
141         eval {$xref = $xs->XMLin($line)};
142         return $xref;
143 }
144
145 sub nextid
146 {
147         my $r = $id++;
148         $id = 0 if $id > 999;
149         return $r;
150 }
151
152 sub toxml
153 {
154         my $self = shift;
155
156         unless (exists $self->{'-xml'}) {
157                 $self->{o} ||= $main::mycall;
158                 $self->{t} ||= IsoTime::dayminsec();
159                 $self->{id} ||= nextid();
160                 
161                 my ($name) = (ref $self) =~ /::(\w+)$/;
162                 $self->{'-xml'} = $xs->XMLout($self, RootName =>lc $name, NumericEscape=>1);
163         }
164         return $self->{'-xml'};
165 }
166
167 sub route
168 {
169         my $self = shift;
170         my $fromdxchan = shift;
171         my $to = shift;
172         my $via = $to || $self->{'-via'} || $self->{to};
173
174         unless ($via) {
175                 dbg("XML: no route specified (" . $self->toxml . ")") if isdbg('chanerr');
176                 return;
177         }
178         if (ref $fromdxchan && $via && $fromdxchan->call eq $via) {
179                 dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
180                 return;
181         }
182
183         # always send it down the local interface if available
184         my $dxchan = DXChannel::get($via);
185         if ($dxchan) {
186                 dbg("route: $via -> $dxchan->{call} direct" ) if isdbg('route');
187         } else {
188                 my $cl = Route::get($via);
189                 $dxchan = $cl->dxchan if $cl;
190                 dbg("route: $via -> $dxchan->{call} using normal route" ) if isdbg('route');
191         }
192
193         # try the backstop method
194         unless ($dxchan) {
195                 my $rcall = RouteDB::get($via);
196                 if ($rcall) {
197                         $dxchan = DXChannel::get($rcall);
198                         dbg("route: $via -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
199                 }
200         }
201         
202         unless ($dxchan) {
203                 dbg("XML: no route available to $via") if isdbg('chanerr');
204                 return;
205         }
206
207         if ($fromdxchan->call eq $via) {
208                 dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
209                 return;
210         }
211
212         if ($dxchan == $main::me) {
213                 dbg("XML: Trying to route to me (" . $self->toxml . ")") if isdbg('chanerr');
214                 return;
215         }
216
217         if ($dxchan->handle_xml) {
218                 $dxchan->send($self->toxml);
219         } else {
220                 $self->{o} ||= $main::mycall;
221                 $self->{id} ||= nextid();
222                 $self->{'-timet'} ||= $main::systime;
223                 $dxchan->send($self->topcxx);
224         }
225 }
226
227 sub has_xml
228 {
229         return exists $_[0]->{'-xml'};
230 }
231
232 sub has_pcxx
233 {
234         return exists $_[0]->{'-pcxx'};
235 }
236
237 sub has_cmd
238 {
239         return exists $_[0]->{'-cmd'};
240 }
241
242 1;