]> gb7djk.dxcluster.net Git - spider.git/blob - perl/DXXml.pm
Improve the selection of parser for XML::Simple.
[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         eval { require XML::SAX } unless $@;
46         eval { require XML::SAX::Expat } unless $@;
47         if ($@) {
48                 LogDbg('err', "do_xml was set to 1 and the XML routines failed to load ($@)");
49                 $main::do_xml = 0;
50         } else {
51                 $XML::Simple::PREFERRED_PARSER = 'XML::SAX::Expat';
52                 import XML::Simple;
53                 $DXProt::handle_xml = 1;
54                 $xs = new XML::Simple(Cache=>[]);
55         }
56         undef $@;
57 }
58
59 #
60 # note that this a function not a method
61 #
62 sub normal
63 {
64         my $dxchan = shift;
65         my $line = shift;
66
67         unless ($main::do_xml) {
68                 dbg("xml not enabled, IGNORED") if isdbg('chanerr');
69                 return;
70         }
71         
72         my ($rootname) = $line =~ '<(\w+) ';
73         my $pkg = "DXXml::" . ucfirst lc "$rootname";
74
75         unless (defined *{"${pkg}::"} && $pkg->can('handle_input')) {
76                 dbg("xml sentence $rootname not recognised, IGNORED") if isdbg('chanerr');
77                 return;
78         }
79                 
80         my $xref;
81         unless ($xref = $pkg->decode_xml($dxchan, $line))  {
82                 dbg("invalid XML ($@), IGNORED") if isdbg('chanerr');
83                 undef $@;
84                 return;
85         }
86         
87         # mark the handle as accepting xml (but only if they 
88         # have at least one right)
89         $dxchan->handle_xml(1);
90
91         $xref = bless $xref, $pkg;
92         $xref->{'-xml'} = $line; 
93         $xref->handle_input($dxchan);
94 }
95
96 #
97 # note that this a function not a method
98 #
99
100 my $last10;
101 my $last_hour;
102
103 sub process
104 {
105         my $t = time;
106         my @dxchan = DXChannel::get_all();
107         my $dxchan;
108
109         foreach $dxchan (@dxchan) {
110                 next unless $dxchan->is_node;
111                 next unless $dxchan->handle_xml;
112                 next if $dxchan == $main::me;
113
114                 # send a ping out on this channel
115                 if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
116                         if ($dxchan->{nopings} <= 0) {
117                                 $dxchan->disconnect;
118                         } else {
119                                 DXXml::Ping::add($main::me, $dxchan->call);
120                                 $dxchan->{nopings} -= 1;
121                                 $dxchan->{lastping} = $t;
122                                 $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
123                         }
124                 }
125         }
126
127
128         # every ten seconds
129         if (!$last10 || $t - $last10 >= 10) {   
130                 $last10 = $t;
131         }
132
133         # every hour
134         if (!$last_hour || $main::systime - 3600 > $last_hour) {
135                 $last_hour = $main::systime;
136         }
137
138 }
139
140 sub decode_xml
141 {
142         my $pkg = shift;
143         my $dxchan = shift;
144         my $line = shift;
145
146         my $xref;
147         eval {$xref = $xs->XMLin($line)};
148         return $xref;
149 }
150
151 sub nextid
152 {
153         my $r = $id++;
154         $id = 0 if $id > 999;
155         return $r;
156 }
157
158 sub toxml
159 {
160         my $self = shift;
161
162         unless (exists $self->{'-xml'}) {
163                 $self->{o} ||= $main::mycall;
164                 $self->{t} ||= IsoTime::dayminsec();
165                 $self->{id} ||= nextid();
166                 
167                 my ($name) = (ref $self) =~ /::(\w+)$/;
168                 $self->{'-xml'} = $xs->XMLout($self, RootName =>lc $name, NumericEscape=>1);
169         }
170         return $self->{'-xml'};
171 }
172
173 sub route
174 {
175         my $self = shift;
176         my $fromdxchan = shift;
177         my $to = shift;
178         my $via = $to || $self->{'-via'} || $self->{to};
179
180         unless ($via) {
181                 dbg("XML: no route specified (" . $self->toxml . ")") if isdbg('chanerr');
182                 return;
183         }
184         if (ref $fromdxchan && $via && $fromdxchan->call eq $via) {
185                 dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
186                 return;
187         }
188
189         # always send it down the local interface if available
190         my $dxchan = DXChannel::get($via);
191         if ($dxchan) {
192                 dbg("route: $via -> $dxchan->{call} direct" ) if isdbg('route');
193         } else {
194                 my $cl = Route::get($via);
195                 $dxchan = $cl->dxchan if $cl;
196                 dbg("route: $via -> $dxchan->{call} using normal route" ) if isdbg('route');
197         }
198
199         # try the backstop method
200         unless ($dxchan) {
201                 my $rcall = RouteDB::get($via);
202                 if ($rcall) {
203                         $dxchan = DXChannel::get($rcall);
204                         dbg("route: $via -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
205                 }
206         }
207         
208         unless ($dxchan) {
209                 dbg("XML: no route available to $via") if isdbg('chanerr');
210                 return;
211         }
212
213         if ($fromdxchan->call eq $via) {
214                 dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
215                 return;
216         }
217
218         if ($dxchan == $main::me) {
219                 dbg("XML: Trying to route to me (" . $self->toxml . ")") if isdbg('chanerr');
220                 return;
221         }
222
223         if ($dxchan->handle_xml) {
224                 $dxchan->send($self->toxml);
225         } else {
226                 $self->{o} ||= $main::mycall;
227                 $self->{id} ||= nextid();
228                 $self->{'-timet'} ||= $main::systime;
229                 $dxchan->send($self->topcxx);
230         }
231 }
232
233 sub has_xml
234 {
235         return exists $_[0]->{'-xml'};
236 }
237
238 sub has_pcxx
239 {
240         return exists $_[0]->{'-pcxx'};
241 }
242
243 sub has_cmd
244 {
245         return exists $_[0]->{'-cmd'};
246 }
247
248 1;