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