]> dxcluster.net Git - spider.git/blob - perl/DXXml.pm
e3c5f270276db1f041d4164e811009fce0633bbf
[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 sub process
94 {
95
96 }
97
98 sub decode_xml
99 {
100         my $pkg = shift;
101         my $dxchan = shift;
102         my $line = shift;
103
104         my $xref;
105         eval {$xref = $xs->XMLin($line)};
106         return $xref;
107 }
108
109 sub nextid
110 {
111         my $r = $id++;
112         $id = 0 if $id > 999;
113         return $r;
114 }
115
116 sub toxml
117 {
118         my $self = shift;
119
120         $self->{o} ||= $main::mycall;
121         $self->{t} ||= IsoTime::dayms();
122         $self->{id} ||= nextid();
123
124         my ($name) = ref $self =~ /::(\w+)$/;
125         my $s = $xs->XMLout($self, RootName =>lc $name, NumericEscape=>1);
126         return $self->{'-xml'} = $s;
127 }
128
129 sub has_xml
130 {
131         return exists $_[0]->{'-xml'};
132 }
133
134 sub has_pcxx
135 {
136         return exists $_[0]->{'-pcxx'};
137 }
138
139 sub has_cmd
140 {
141         return exists $_[0]->{'-cmd'};
142 }
143
144 1;