source: A2P/a2p/A2P/XML.pm @ 3

Last change on this file since 3 was 3, checked in by guillaume, 17 years ago
  • AUTHORS: Ajout des différents contributeurs
  • COPYING: Ajout de la licence GPL v3
  • a2p: Préparation des sources pour leur publication sous GPL
  • Property svn:keywords set to Id
File size: 26.7 KB
Line 
1#
2# Copyright (c) 2004-2007 - Consultas, PKG.fr
3#
4# This file is part of A2P.
5#
6# A2P is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version.
10#
11# A2P is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with A2P; if not, write to the Free Software
18# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19#
20# $Id: XML.pm 3 2007-10-18 16:20:19Z guillaume $
21#
22# Class to implement some XML support
23#
24
25package A2P::XML;
26
27use strict;
28use Fcntl ':flock';
29use File::stat ;
30use XML::LibXML ;
31use Time::HiRes qw( time );
32use MIME::Base64 ;
33use A2P::Globals ;
34use A2P::Syslog ;
35use A2P::Tools qw( ShortID );
36
37BEGIN {
38    our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
39}
40our $VERSION ;
41
42# Private variables
43my %DTD = {} ;
44my %IDs = {} ;
45
46sub id {
47    my $time = time ; # time is here the Time::HiRes 'time' version
48    my @Date = localtime($time);
49    my $DayTick = ($time - int($time - ( $Date[0] + $Date[1]*60 + $Date[2]*3600 ))) * 193 ;
50    my $id ;
51    while ( ! defined($id) or defined($IDs{$id}) ) {
52        $id = sprintf( "XML-%c%03D-%06X-%s", $Date[5]-40 , $Date[7] , $DayTick, &ShortID ) ;
53    }
54    $IDs{$id} = 1 ;
55    return $id ;
56}
57
58sub new {
59    &Debug("new " . __PACKAGE__ . " v$VERSION");
60    my $class = shift ;
61    my $self  = {
62        XMLREF =>  @_ ? shift : undef ,
63        ID     =>  &id(),
64        ERROR  =>  [],    NODES   =>  {},    LASTPARSEDFILE  =>  "",
65        XML    =>  "",    NODEID  =>  "",
66        DTD    =>  "",    DTDNAME =>  ""
67        };
68
69    &Debug("New XML object is identified with $self->{ID} tag");
70    return bless $self , $class ;
71}
72
73################################################################################
74#
75#                           Common APIs
76#
77################################################################################
78sub getParser {
79    my $self = shift ;
80    return $self->{PARSER} if (defined($self->{PARSER}));
81
82    # Read Destination configuration file to set needed options
83    &Debug("Creating new XML parser for $self->{ID}");
84    my $parser = XML::LibXML->new();
85    return $self->error(401,"Unable to get an XML parser: $!")
86        unless (defined($parser));
87
88    return $self->{PARSER} = $parser ;
89}
90
91sub clearParsedNodes {
92    my $self   = shift ;
93    undef $self->{TREE} ;
94    $self->{NODES}  = {} ;
95    $self->{NODEID} = "" ;
96}
97
98sub parse_file {
99    my $self = shift ;
100    my $file = shift ;
101    my $parser ;
102
103    # Check file is existing
104    return $self->error(402, defined($file) ?
105        "'$file' XML file doesn't exist" : "No file to parse provided")
106        unless ( defined($file) and $file and -e $file );
107
108    # Get file time creation to check if we need to reload
109    my $stat = stat($file);
110    my $mtime = $stat->mtime();
111
112    # Check if we still have parsed this file and it has not changed
113    if ( $self->{LASTPARSEDFILE} eq $file ) {
114        # The mandatory point to parse again the file is to found a
115        # different mtime on file, this should garanty to reload the
116        # file at last in the second
117        if ( $mtime == $self->{MTIMEPARSEDFILE} ) {
118            &Debug("File to parse still known, keeping cached parsing");
119            return $file ;
120
121        } else {
122            &Debug("XML file has been modified");
123            # When we need to reload conf, we should free some structures
124            $self->clearParsedNodes();
125        }
126    }
127
128    # Check with can parse file
129    return $self->error(403, "No parser available to read XML file")
130        unless ( $parser = $self->getParser() );
131
132    &Debug("Parsing '$file' XML file");
133    $self->{XML} = $parser->parse_file( $file );
134    if (defined($self->{XML})) {
135        $self->{MTIMEPARSEDFILE} = $mtime ;
136
137        if ($ADVANCED_DEBUGGING) {
138            my $confdump = $self->{XML}->toString(2) ;
139            &Debug( "XML conf: '" .
140                ( length($confdump) > 160 ?
141                    substr($confdump,0,160) . "..."
142                    :
143                    $confdump
144                )."'" );
145        }
146
147    } else {
148        $self->error(404,"Got XML Parsing error with '$file': $!");
149        $file = "" ;
150    }
151
152    if ($ENABLE_DTD_VALIDATION and $file and $self->{DTD}) {
153        my $valid = eval { $self->{XML}->is_valid($self->{DTD}) } ;
154        if ( ! $valid ) {
155            my $error = $parser->get_last_error() ;
156            $error = defined($error) ? ", $error" : "" ;
157            chomp $error ;
158            $self->error(405,"'$file' XML document is not valid toward '$self->{DTDNAME}'$error");
159            $file = "" ;
160
161        } else {
162            &Debug("'$file' is conform toward '$self->{DTDNAME}' DTD");
163        }
164    }
165
166    return $self->{LASTPARSEDFILE} = $file ;
167}
168
169sub parseNodesById {
170    my $self = shift ;
171
172    # Really parse only if it has not been done before
173    unless ( keys(%{$self->{NODES}}) ) {
174        &Debug("Parsing nodes tree by Id");
175        foreach my $node ( @{$self->{TREE}} ) {
176            my $nodeid = $node->getAttribute('Id');
177            $self->{NODES}->{$nodeid} = $node ;
178        }
179    }
180}
181
182sub get {
183    my $self = shift ;
184    my $what = shift ;
185    my $key  = '__' . $what ;
186
187    return $self->error(406,"Nothing to seach provided")
188        unless (defined($what) and $what );
189
190    my $nodeid = $self->{NODEID} ;
191    return $self->error(407,"Can't seach as no node as been selected")
192        unless ($nodeid);
193
194    return defined($self->{$key}->{$nodeid}) ?
195        $self->{$key}->{$nodeid}
196        :
197        $self->{$key}->{$nodeid} = $self->{NODES}->{$nodeid}->findvalue($what)
198        ;
199}
200
201sub getAttribute {
202    my $self = shift ;
203    my $what = shift ;
204    my $key  = '__' . $what ;
205
206    return $self->error(411,"Nothing to seach provided")
207        unless (defined($what) and $what );
208
209    my $nodeid = $self->{NODEID} ;
210    return $self->error(412,"Can't seach as no node as been selected")
211        unless ($nodeid);
212
213    return defined($self->{$key}->{$nodeid}) ?
214        $self->{$key}->{$nodeid}
215        :
216        $self->{$key}->{$nodeid} = $self->{NODES}->{$nodeid}->getAttribute($what)
217        ;
218}
219
220sub concatenate {
221    my $self = shift ;
222
223    return &Error("[DEV] Can't concatenate without scalar ref as XMLREF")
224        unless (ref($self->{XMLREF}) =~ /^SCALAR/);
225
226    my $line = shift || "" ;
227
228    return ${$self->{XMLREF}} .= $line ;
229}
230
231sub parse_string {
232    my $self = shift ;
233    my $parser ;
234
235    # Check with can parse a string
236    return $self->error(408, "No parser available to analyse string")
237        unless ( $parser = $self->getParser() );
238
239    return $self->error(409, "No string to analyse")
240        unless ( ref($self->{XMLREF}) =~ /^SCALAR$/ );
241
242    $self->{XML} = $parser->parse_string( ${$self->{XMLREF}} );
243    unless (defined($self->{XML})) {
244        $self->error(410,"Got XML Parsing error on '${$self->{XMLREF}}': $!");
245        $self->{XML} = 0 ;
246    }
247
248    if ($ENABLE_DTD_VALIDATION and $self->{XML} and $self->{DTD} ) {
249        my $valid = eval { $self->{XML}->is_valid($self->{DTD}) } ;
250        if ( ! $valid ) {
251            my $error = $parser->get_last_error() ;
252            $error = defined($error) ? ", $error" : "" ;
253            my $xml = ${$self->{XMLREF}} ;
254            chomp $error ;
255            chomp $xml ;
256            $self->error(411,"'$xml' XML string is not valid toward '$self->{DTDNAME}'$error");
257            $self->{XML} = 0 ;
258
259        } else {
260            &Debug("XML string is conform toward '$self->{DTDNAME}' DTD");
261        }
262    }
263
264    return $self->{XML} ;
265}
266
267sub getid {
268    return $_[0]->{ID} ;
269}
270
271sub toString {
272    my $self = shift ;
273    my $format = shift || 0;
274
275    my $doc = $self->{XML} ;
276
277    unless (defined($doc) and ref($doc) =~ /^XML/) {
278        $self->error(412,"No XML to return");
279        return "" ;
280    }
281
282    # Return the XML as original format string by default
283    my $string = $doc->toString($format) ;
284    &Debug( "Returning XML string: '" .
285        ( length($string) > 160 ?
286            substr($string,0,160) . "..."
287            :
288            $string
289        ) . "'" )
290        if ($ADVANCED_DEBUGGING);
291
292    return $string;
293}
294
295sub setDTD {
296    my $self = shift ;
297    my $name = shift || "" ;
298    return &Error("No DTD name provided") unless $name ;
299    return &Error("No such '$name' DTD available")
300        unless (defined($DTD{$name}));
301    &Debug("Selecting '$name' DTD");
302    $self->{DTD} = $DTD{$self->{DTDNAME} = $name} ;
303}
304
305################################################################################
306#
307#                         ControlRecord dedicated API
308#
309################################################################################
310# Provides the selection of the right NODE in the XML
311# Then we can use 'get' API to retreive destid values
312sub selectDestId {
313    my $self   = shift ;
314    my $destid = shift ;
315
316    return $self->error(450,"No destid provided")
317        unless (defined($destid) and $destid );
318
319    &Debug("Getting Destinations node in XML");
320    my $TREE = $self->getDestinations();
321    return $self->error(451,"No destination tree found".($!?" $!":""))
322        unless @{$TREE} ;
323
324    $self->parseNodesById();
325
326    unless (defined($self->{NODES}->{$destid})) {
327        $self->error(452,"No configuration found for DestID '$destid'");
328        return "" ;
329    }
330
331    return $self->{NODEID} = $destid ;
332}
333
334sub selectDocument {
335    my $self = shift ;
336    my $doc  = shift ;
337
338    return $self->error(453,"No document name provided")
339        unless (defined($doc) and $doc );
340
341    &Debug("Getting Documents node in XML");
342    my $TREE = $self->getDocuments();
343    return $self->error(454,"No Document tree found".($!?" $!":""))
344        unless @{$TREE} ;
345
346    $self->parseNodesById();
347
348    unless (defined($self->{NODES}->{$doc})) {
349        &Debug("No configuration found for Document '$doc'");
350        return "" ;
351    }
352
353    return $self->{NODEID} = $doc ;
354}
355
356sub getDestinations {
357    my $self = shift ;
358
359    # Return cached TREE
360    return $self->{TREE} if (defined($self->{TREE}));
361
362    &Debug("Searching Destination nodes in XML");
363    my @TREE = $self->{XML}->getElementsByTagName("Destination");
364    return $self->{TREE} = \@TREE ;
365}
366
367sub getDocuments {
368    my $self = shift ;
369
370    # Return cached TREE
371    return $self->{TREE} if (defined($self->{TREE}));
372
373    &Debug("Searching Document nodes in XML");
374    my @TREE = $self->{XML}->getElementsByTagName("Document");
375    return $self->{TREE} = \@TREE ;
376}
377
378################################################################################
379#
380#                       E-Service dedicated API
381#
382################################################################################
383sub getbin {
384    my $self = shift ;
385    my $name = shift ;
386    my $exec ;
387
388    $self->error(0);
389    $! = 0 ;
390
391    return $self->error(480,"No service name provided")
392        unless (defined($name) and $name );
393
394    &Debug("Getting E-Services node in XML");
395    my $TREE = $self->getEServices();
396    return $self->error(481,"No E-Service tree found".($!?" ($!)":""))
397        unless @{$TREE} ;
398
399    # Really parse only if it has not been done before
400    unless ( keys(%{$self->{NODES}}) ) {
401        &Debug("Parsing nodes tree by name");
402        foreach my $node ( @{$self->{TREE}} ) {
403            my $service = $node->getAttribute('name');
404            unless (defined($name) and $name) {
405                &Warn("Skipping bad service node without name attribut '" .
406                    $node->toString() . "'");
407                next ;
408            }
409
410            $exec = $node->getAttribute('exec');
411            unless (defined($exec) and $exec) {
412                &Warn("Skipping bad service node without exec attribut '" .
413                    $node->toString() . "'");
414                next ;
415            }
416
417            &Warn("'$service' E-Service definition seems to use and non existing '" .
418                $exec . "' program")
419                    unless (-e $exec);
420
421            &Warn("'$service' E-Service definition seems to use and non executable '" .
422                $exec . "' program")
423                    unless (-x $exec);
424
425            my $mode = $node->getAttribute('mode');
426            unless (defined($exec) and $exec) {
427                &Debug("No service node mode attribut found in '" .
428                    $node->toString() . "', taking default");
429                $mode = 0 ;
430            }
431
432            &Debug("Registring node '$service' with exec '$exec' and mode '$mode'")
433                 if ($ADVANCED_DEBUGGING);
434            $self->{NODES}->{$service} = [ $exec , $mode ] ;
435        }
436    }
437
438    unless (defined($self->{NODES}->{$name})) {
439        $self->error(482,"No configuration found for E-Service '$name'");
440        return "" ;
441    }
442
443    $exec = $self->{NODES}->{$name}->[0] || "" ;
444
445    return $self->error(483,"Requested E-Service '$name' uses not existing '$exec' program")
446        unless ( -e $exec );
447
448    # Check if its a link if not executable
449    my $maxlink = 10 ; # Even if link loop should not pass the 483 error, its better
450    # to keep as reasonnable loop exit condition
451    my $link = $exec ;
452    while ( ! -x _ and $maxlink -- ) {
453        if ( -l $link ) {
454            $link = readlink $link ;
455            return $self->error(483,"Requested E-Service '$name' uses a '$exec' link to a not existing '$link' program")
456                unless ( -e $link );
457
458        } else {
459            last ;
460        }
461    }
462
463    return $self->error(484,"Too much link found behind '$exec'")
464        if ( $maxlink < 0 );
465
466    return $self->error(485,"Requested E-Service '$name' uses not executable '$link' program" .
467            ($link ne $exec?" as '$exec' link":""))
468        unless ( -x _ );
469
470    return @{$self->{NODES}->{$name}} ;
471}
472
473sub getEServices {
474    my $self = shift ;
475
476    # Return cached TREE
477    return $self->{TREE} if (defined($self->{TREE}));
478
479    &Debug("Searching any service node in XML") if ($ADVANCED_DEBUGGING);
480    my @TREE = $self->{XML}->getElementsByTagName("service");
481
482    &Debug("Tree nodes: @TREE") if ($ADVANCED_DEBUGGING);
483    return $self->{TREE} = \@TREE ;
484}
485
486
487################################################################################
488#
489#                       External requests dedicated API
490#
491################################################################################
492# Provides access to the NODE <a2p /> xml validation
493sub isA2P_valid {
494    my $self   = shift ;
495    my $strict = shift || 0 ;
496
497    # 1. Parse buffer as string
498    my $doc = $self->parse_string ;
499    return $strict ? $self->error(460,"Not an XML document") : 0
500        unless ( ref($doc) =~ /^XML::LibXML::Document$/ );
501
502    # 2. Check doc is valid
503    # TODO We need to validate toward a DTD
504    #my $dtd = $self->getDTD('a2p');
505    #return $strict ? $self->error(461,"Not a valid XML A2P object") : 0
506    #    unless ($doc->is_valid($dtd));
507
508    return $doc ;
509}
510
511# Provides access to the NODE <a2p /> to handle conversion request
512sub isA2P {
513    my $self = shift ;
514
515    # 1. Parse and validate buffer
516    $self->setDTD('a2p-listener.dtd');
517    my $doc = $self->isA2P_valid('strict') ;
518    return 0 unless ( $doc and ref($doc) =~ /^XML::LibXML::Document$/ );
519
520    # 2. Check document format: we must have an a2p node as root
521    return $self->error(462,"Document has no 'a2p' node")
522        unless ( $doc->hasChildNodes and $doc->getChildNodes->size == 1 and
523            $doc->lastChild->nodeName eq 'a2p');
524
525    my $a2p = $doc->lastChild ;
526    my @nodes = map { $_->nodeName } $a2p->getChildNodes ;
527    &Debug("Available nodes: @nodes");
528
529    # 3. We need at least a path or a content node
530    return 0 unless grep { /^(path|content)$/i } @nodes ;
531
532    # 4. Still select A2P comportement
533    my $key = 'CONTENT' ;
534    $key = 'PATH' if (grep { /^path$/i } @nodes);
535
536    # Initializes few things
537    $self->{MESSAGE} = [ "A2P-XML-Object = ".$self->{ID} ] ;
538    $self->{PDFS} = [] ;
539    $self->{STATE} = 0 ;
540
541    foreach my $node ( $a2p->getChildNodes ) {
542        next unless ( $node->nodeName =~ /^$key$/i );
543
544        # Check eventually type attribut
545        my $type = $node->getAttribute("type");
546        return $self->error(464,"Type '$type' conversion not supported")
547            if (defined($type) and $type =~ /^afp$/i );
548
549        $self->{$key} = $node->textContent() ;
550        $self->{$key} = "" unless (defined($self->{$key}));
551    }
552
553    return defined($self->{PATH}) and $self->{PATH} ? 1 : 0
554        if ( $key eq 'PATH' );
555
556    # key = CONTENT as AFP EBCDIDC base64 encoded flux
557    &Debug("Got base64 content to convert");
558    $self->{CONTENT} = &decode_base64( $self->{CONTENT} ) ;
559    $self->{PATH} = $SHMDIR . '/AFP.' . $self->{ID} ;
560
561    open AFP, ">" .$self->{PATH}
562        or return $self->error(463,"Can't open temporary file to save AFP content: $!");
563
564    # Lock the file just in case
565    my $locked = flock(AFP, LOCK_EX | LOCK_NB);
566    return $self->error(465,"Can't lock file for AFP content: $!")
567        unless $locked ;
568
569    my $print = print AFP $self->{CONTENT}
570        or $self->error(466,"Can't write file with AFP content: $!");
571
572    flock(AFP, LOCK_UN);
573    close(AFP);
574
575    return $print ;
576}
577
578# Provides access to the NODE <a2p /> as E-Service request
579sub isA2P_eService {
580    my $self = shift ;
581
582    # 1. Parse and validate buffer or return without error
583    $self->setDTD('a2p-eservice.dtd');
584    my $doc = $self->isA2P_valid('') ;
585    return 0 unless ( $doc and ref($doc) =~ /^XML::LibXML::Document$/ );
586
587    # 2. Check document format: we must have an a2p node as root
588    return $self->error(472,"Document has no 'a2p' node")
589        unless ( $doc->hasChildNodes and $doc->getChildNodes->size == 1 and
590            $doc->lastChild->nodeName eq 'a2p');
591
592    my $a2p = $self->{A2P} = $doc->lastChild ;
593    my @nodes = () ;
594
595    # 3. Keep ref to service node and check it exists
596    foreach my $node ( $a2p->getChildNodes ) {
597        my $nodename = $node->nodeName ;
598        push @nodes , $nodename ;
599        next unless ( $nodename =~ /^service$/i );
600        $self->{SERVICE} = $node ;
601    }
602
603    unless (grep { /^service$/i } @nodes and defined($self->{SERVICE})) {
604        $self->error(473,"XML request must content a 'service' node");
605        &Info("Available nodes: @nodes");
606        return 0 ;
607    }
608
609    &Debug("Available nodes: @nodes");
610
611    # 4. Check name attribut is defined
612    my $name = $self->{SERVICE}->getAttribute("name");
613    return $self->error(474,"No service name found to handle request")
614        unless (defined($name) and $name );
615
616    return $self->error(475,"'$name' found service name is prohibited")
617        if ( $name eq '200' );
618
619    &Debug("Claimed E-Service is '$name'");
620    $self->{'E-SERVICE'} = $name ;
621
622    # 5. Check pdf and file attribut for just overriding warns
623    my $pdf = $self->{SERVICE}->getAttribute("pdf");
624    &Warn("service node 'pdf' attribut with value '$pdf' will be lost")
625        if (defined($pdf) and $pdf );
626
627    my $file = $self->{SERVICE}->getAttribute("file");
628    &Warn("service node 'file' attribut with value '$file' will be lost")
629        if (defined($file) and $file );
630
631    # 6. Returns E-Service name as true value
632    return $name ;
633}
634
635sub set_a2p_attribut {
636    my $self = shift ;
637    my $name  = shift || "" ;
638    my $value = shift || "" ;
639    return 0 unless (defined($self->{A2P}) and $name and $value);
640
641    $self->{A2P}->setAttribute( $name , $value );
642
643    return $self->{A2P}->hasAttribute( $name );
644}
645
646sub A2Panswer {
647    my $self = shift ;
648    return join("\n",( @{$self->{MESSAGE}}, $self->error ))
649        unless ( ref($self->{XML}) =~ /^XML::LibXML::Document$/ );
650    # We need to update XML and return its text version
651    my $a2p = $self->{XML}->lastChild ;
652    my $lastnode = 0 ;
653
654    my $key = 'PATH' ;
655    $self->{PATH} = (defined($self->{PDFS}) and @{$self->{PDFS}})?
656        shift @{$self->{PDFS}} : "" ;
657
658    # Update path or content
659
660    if (defined($self->{CONTENT})) {
661        $key = 'CONTENT' ;
662        open PDF, $self->{PATH}
663            or return $self->error(467,"Can't open pdf file for reading: $!");
664
665        $self->{CONTENT} = &encode_base64(join('',<PDF>));
666        close(PDF);
667
668        # Delete PDF as it is requested
669        unlink $self->{PATH} ;
670    }
671
672    if (defined($self->{PATH}) and $self->{PATH}) {
673        foreach my $node ( $a2p->getChildNodes ) {
674            next unless ( $node->nodeName =~ /^$key$/i );
675
676            $lastnode = $node->cloneNode ;
677            $lastnode->appendText( $self->{$key} );
678            $lastnode->setAttribute("type","pdf");
679            $node->replaceNode( $lastnode );
680
681            # We must have only one node to update
682            last ;
683        }
684
685    } else {
686        $self->A2Pabterm ;
687        $self->error(470,"No pdf generated: '$_'");
688        $self->A2Pmessage("A2P-Error-XML-no-pdf-available");
689    }
690
691    # Check we don't received another PDF or we didn't update the node
692    if ( defined($self->{PDFS}) and @{$self->{PDFS}} ) {
693        map {
694            $self->error(468,"Too much pdf generated: '$_'");
695            $self->A2Pmessage("A2P-Error-Other-PDF = $_");
696            $self->A2Pabterm ;
697            } @{$self->{PDFS}} ;
698
699    } elsif ( defined($self->{PDFS}) and ! $lastnode ) {
700        $self->A2Pabterm ;
701        $self->error(469,"Too much pdf generated: '$_'");
702        $self->A2Pmessage("A2P-Error-XML-not-updated");
703    }
704
705    # Set return code
706    my $RC = sprintf("%02d",$self->{STATE}) ;
707    my ( $returnCode ) = grep { $_->nodeName =~ /^ReturnCode$/i } $a2p->getChildNodes ;
708    if (defined($returnCode)) {
709        $lastnode = $returnCode->cloneNode ;
710        $lastnode->appendText( $RC );
711        $returnCode->replaceNode( $lastnode );
712
713    } else {
714        $a2p->appendTextChild( "returnCode", $RC );
715    }
716
717    # Set messages on bad status
718    $a2p->appendTextChild( "message", join("\n",@{$self->{MESSAGE}}) )
719        if ($self->{STATE});
720
721    my $answer = $self->{XML}->toString ;
722    &Debug("XML answer is '$answer'");
723    return $answer ;
724}
725
726sub A2Pmessage {
727    my $self = shift ;
728    &Debug("Got XML message as '@_'");
729    push @{$self->{MESSAGE}}, @_ ;
730}
731
732sub A2Ppdf {
733    my $self = shift ;
734    push @{$self->{PDFS}}, @_ ;
735}
736
737sub getPATH {
738    my $self = shift ;
739    return defined($self->{PATH}) ? $self->{PATH} : "" ;
740}
741
742sub A2Pabterm {
743    $_[0]->{STATE} ++ ;
744}
745
746sub setstate {
747    my $self = shift ;
748
749    my $state = shift ;
750    my $path = $DONESPOOL ;
751
752    # Check state
753    unless ($state =~ /^OK$/i) {
754        $path = $ERRORSPOOL ;
755        $self->{STATE} ++ ;
756    }
757
758    # Update PDFs path
759    @{$self->{PDFS}} = map { $path . '/' . $_ } @{$self->{PDFS}} ;
760}
761
762################################################################################
763#
764#                           General common APIs
765#
766################################################################################
767sub error {
768    my $self = shift ;
769    if ( @_ ) {
770        my ( $errno , $msg ) = @_ ;
771
772        # Reset ERROR when requested
773        return @{$self->{ERROR}} = ( 0 )
774            unless (defined($errno) and $errno );
775
776        return 0 unless (defined($msg));
777
778        push @{$self->{ERROR}} , $msg ;
779        &Error( "Error $errno: $msg on " . $self->{ID} );
780        return 0 ;
781
782    } else {
783        return wantarray ? grep { ! /^\d+$/ } @{$self->{ERROR}} : $self->{ERROR}->[0] ;
784    }
785}
786
787sub DESTROY {
788    my $self = shift;
789    my @err  = @{$self->{ERROR}} ;
790
791    if (@err) {
792        &UPSTAT('GET-XML-ERROR');
793        &UPSTAT('GET-XML-ERROR-' . $err[0] );
794        &Debug($self->{ID} . " XML object destroyed with error #" . $err[0]);
795
796    } else {
797        &UPSTAT('GOT-GOOD-XML');
798        &Debug($self->{ID} . " XML object destroyed");
799    }
800
801    delete $IDs{$self->{ID}} ;
802}
803
804################################################################################
805### Load default inline DTDs ###################################################
806################################################################################
807sub SaveDTD ( $ \$ ) {
808    my $name   = shift || "" ;
809    my $buffer = shift ;
810
811    return &Error("No name provided to keep DTD in memory")
812        unless $name ;
813
814    unless ($$buffer) {
815        &Debug("Nothing to save for '$name' DTD");
816        return 1 ;
817    }
818
819    my $string = $$buffer ;
820
821    # Empty the buffer
822    $$buffer = "" ;
823
824    &Debug("Saving '$name' DTD in memory...");
825    $DTD{$name} = XML::LibXML::Dtd->parse_string($string);
826}
827
828{
829    my ( $name , $buffer , $count ) = ( "" , "" , 0 );
830    $! = 0 ;
831
832    &Debug("Loading default DTD definitions...");
833    while (<DATA>)
834    {
835        next if /^\s*$/ ; # Skip empty lines
836        next if /^####/    ; # Skip big comment lines
837        chomp ;
838
839        # Start a new DTD
840        if (/^### DTD\s+'([^']*)'/) {
841            die "Can't initialize '$name' DTD: $!\n"
842                unless (!$name or
843                ($name and $buffer and &SaveDTD($name,\$buffer) and ++ $count));
844
845            $name = $1 ;
846            &Debug("Reading '$name' DTD...");
847            next ;
848        }
849
850        $buffer .= $_ . "\n" ;
851    }
852
853    # Save last DTD
854    die "Can't initialize '$name' DTD: $!\n"
855        unless ($name and $buffer and &SaveDTD($name,\$buffer));
856
857    close(DATA);
858
859    &Debug("$count DTD loaded");
860}
861
862&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
863
8641;
865################################################################################
866### Each DTD is defined by an id and a name from the following format line   ###
867### After the __DATA__ inline tag                                            ###
868### DTD 'id' 'name'  any string as comment for example                       ###
869################################################################################
870
871__DATA__
872################################################################################
873### DTD 'a2p-listener.dtd' A2P Listener DTD                                  ###
874################################################################################
875<!ELEMENT a2p ( (path|content) , (returnCode)* , (message)* )+ >
876<!ELEMENT path          ANY >
877<!ELEMENT content       ANY >
878<!ELEMENT returnCode    ANY >
879<!ELEMENT message       ANY >
880
881################################################################################
882### DTD 'a2p-eservice.dtd' A2P E-Service DTD                                 ###
883################################################################################
884<!ELEMENT a2p ( service )+ >
885<!ELEMENT service ANY >
886<!ATTLIST a2p
887                    pdf          CDATA   #IMPLIED
888                    file         CDATA   #IMPLIED
889>
890<!ATTLIST service
891                    name         CDATA   #REQUIRED
892>
893
894################################################################################
895### DTD 'e-service.conf.dtd' Configuration E-Service DTD                     ###
896################################################################################
897<!ELEMENT conf ( service )* >
898<!ELEMENT service EMPTY >
899<!ATTLIST service
900                    name         CDATA   #REQUIRED
901                    exec         CDATA   #REQUIRED
902                    mode         (0|1)   #REQUIRED
903>
Note: See TracBrowser for help on using the repository browser.