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 =>$name, NumericEscape=>1);
 126         return $self->{'-xml'} = $s;
 127 }
 128 1;