#
# Copyright (c) 2004-2007 - Consultas, PKG.fr
#
# This file is part of A2P.
#
# A2P is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# A2P is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with A2P; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
# $Id: XML.pm 3 2007-10-18 16:20:19Z guillaume $
#
# Class to implement some XML support
#

package A2P::XML;

use strict;
use Fcntl ':flock';
use File::stat ;
use XML::LibXML ;
use Time::HiRes qw( time );
use MIME::Base64 ;
use A2P::Globals ;
use A2P::Syslog ;
use A2P::Tools qw( ShortID );

BEGIN {
    our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
}
our $VERSION ;

# Private variables
my %DTD = {} ;
my %IDs = {} ;

sub id {
    my $time = time ; # time is here the Time::HiRes 'time' version
    my @Date = localtime($time);
    my $DayTick = ($time - int($time - ( $Date[0] + $Date[1]*60 + $Date[2]*3600 ))) * 193 ;
    my $id ;
    while ( ! defined($id) or defined($IDs{$id}) ) {
        $id = sprintf( "XML-%c%03D-%06X-%s", $Date[5]-40 , $Date[7] , $DayTick, &ShortID ) ;
    }
    $IDs{$id} = 1 ;
    return $id ;
}

sub new {
    &Debug("new " . __PACKAGE__ . " v$VERSION");
    my $class = shift ;
    my $self  = {
        XMLREF =>  @_ ? shift : undef ,
        ID     =>  &id(),
        ERROR  =>  [],    NODES   =>  {},    LASTPARSEDFILE  =>  "",
        XML    =>  "",    NODEID  =>  "",
        DTD    =>  "",    DTDNAME =>  ""
        };

    &Debug("New XML object is identified with $self->{ID} tag");
    return bless $self , $class ;
}

################################################################################
#
#                           Common APIs
#
################################################################################
sub getParser {
    my $self = shift ;
    return $self->{PARSER} if (defined($self->{PARSER}));

    # Read Destination configuration file to set needed options
    &Debug("Creating new XML parser for $self->{ID}");
    my $parser = XML::LibXML->new();
    return $self->error(401,"Unable to get an XML parser: $!")
        unless (defined($parser));

    return $self->{PARSER} = $parser ;
}

sub clearParsedNodes {
    my $self   = shift ;
    undef $self->{TREE} ;
    $self->{NODES}  = {} ;
    $self->{NODEID} = "" ;
}

sub parse_file {
    my $self = shift ;
    my $file = shift ;
    my $parser ;

    # Check file is existing
    return $self->error(402, defined($file) ?
        "'$file' XML file doesn't exist" : "No file to parse provided")
        unless ( defined($file) and $file and -e $file );

    # Get file time creation to check if we need to reload
    my $stat = stat($file);
    my $mtime = $stat->mtime();

    # Check if we still have parsed this file and it has not changed
    if ( $self->{LASTPARSEDFILE} eq $file ) {
        # The mandatory point to parse again the file is to found a
        # different mtime on file, this should garanty to reload the
        # file at last in the second
        if ( $mtime == $self->{MTIMEPARSEDFILE} ) {
            &Debug("File to parse still known, keeping cached parsing");
            return $file ;

        } else {
            &Debug("XML file has been modified");
            # When we need to reload conf, we should free some structures
            $self->clearParsedNodes();
        }
    }

    # Check with can parse file
    return $self->error(403, "No parser available to read XML file")
        unless ( $parser = $self->getParser() );

    &Debug("Parsing '$file' XML file");
    $self->{XML} = $parser->parse_file( $file );
    if (defined($self->{XML})) {
        $self->{MTIMEPARSEDFILE} = $mtime ;

        if ($ADVANCED_DEBUGGING) {
            my $confdump = $self->{XML}->toString(2) ;
            &Debug( "XML conf: '" .
                ( length($confdump) > 160 ?
                    substr($confdump,0,160) . "..."
                    :
                    $confdump
                )."'" );
        }

    } else {
        $self->error(404,"Got XML Parsing error with '$file': $!");
        $file = "" ;
    }

    if ($ENABLE_DTD_VALIDATION and $file and $self->{DTD}) {
        my $valid = eval { $self->{XML}->is_valid($self->{DTD}) } ;
        if ( ! $valid ) {
            my $error = $parser->get_last_error() ;
            $error = defined($error) ? ", $error" : "" ;
            chomp $error ;
            $self->error(405,"'$file' XML document is not valid toward '$self->{DTDNAME}'$error");
            $file = "" ;

        } else {
            &Debug("'$file' is conform toward '$self->{DTDNAME}' DTD");
        }
    }

    return $self->{LASTPARSEDFILE} = $file ;
}

sub parseNodesById {
    my $self = shift ;

    # Really parse only if it has not been done before
    unless ( keys(%{$self->{NODES}}) ) {
        &Debug("Parsing nodes tree by Id");
        foreach my $node ( @{$self->{TREE}} ) {
            my $nodeid = $node->getAttribute('Id');
            $self->{NODES}->{$nodeid} = $node ;
        }
    }
}

sub get {
    my $self = shift ;
    my $what = shift ;
    my $key  = '__' . $what ;

    return $self->error(406,"Nothing to seach provided")
        unless (defined($what) and $what );

    my $nodeid = $self->{NODEID} ;
    return $self->error(407,"Can't seach as no node as been selected")
        unless ($nodeid);

    return defined($self->{$key}->{$nodeid}) ?
        $self->{$key}->{$nodeid}
        :
        $self->{$key}->{$nodeid} = $self->{NODES}->{$nodeid}->findvalue($what)
        ;
}

sub getAttribute {
    my $self = shift ;
    my $what = shift ;
    my $key  = '__' . $what ;

    return $self->error(411,"Nothing to seach provided")
        unless (defined($what) and $what );

    my $nodeid = $self->{NODEID} ;
    return $self->error(412,"Can't seach as no node as been selected")
        unless ($nodeid);

    return defined($self->{$key}->{$nodeid}) ?
        $self->{$key}->{$nodeid}
        :
        $self->{$key}->{$nodeid} = $self->{NODES}->{$nodeid}->getAttribute($what)
        ;
}

sub concatenate {
    my $self = shift ;

    return &Error("[DEV] Can't concatenate without scalar ref as XMLREF")
        unless (ref($self->{XMLREF}) =~ /^SCALAR/);

    my $line = shift || "" ;

    return ${$self->{XMLREF}} .= $line ;
}

sub parse_string {
    my $self = shift ;
    my $parser ;

    # Check with can parse a string
    return $self->error(408, "No parser available to analyse string")
        unless ( $parser = $self->getParser() );

    return $self->error(409, "No string to analyse")
        unless ( ref($self->{XMLREF}) =~ /^SCALAR$/ );

    $self->{XML} = $parser->parse_string( ${$self->{XMLREF}} );
    unless (defined($self->{XML})) {
        $self->error(410,"Got XML Parsing error on '${$self->{XMLREF}}': $!");
        $self->{XML} = 0 ;
    }

    if ($ENABLE_DTD_VALIDATION and $self->{XML} and $self->{DTD} ) {
        my $valid = eval { $self->{XML}->is_valid($self->{DTD}) } ;
        if ( ! $valid ) {
            my $error = $parser->get_last_error() ;
            $error = defined($error) ? ", $error" : "" ;
            my $xml = ${$self->{XMLREF}} ;
            chomp $error ;
            chomp $xml ;
            $self->error(411,"'$xml' XML string is not valid toward '$self->{DTDNAME}'$error");
            $self->{XML} = 0 ;

        } else {
            &Debug("XML string is conform toward '$self->{DTDNAME}' DTD");
        }
    }

    return $self->{XML} ;
}

sub getid {
    return $_[0]->{ID} ;
}

sub toString {
    my $self = shift ;
    my $format = shift || 0;

    my $doc = $self->{XML} ;

    unless (defined($doc) and ref($doc) =~ /^XML/) {
        $self->error(412,"No XML to return");
        return "" ;
    }

    # Return the XML as original format string by default
    my $string = $doc->toString($format) ;
    &Debug( "Returning XML string: '" .
        ( length($string) > 160 ?
            substr($string,0,160) . "..."
            :
            $string
        ) . "'" )
        if ($ADVANCED_DEBUGGING);

    return $string;
}

sub setDTD {
    my $self = shift ;
    my $name = shift || "" ;
    return &Error("No DTD name provided") unless $name ;
    return &Error("No such '$name' DTD available")
        unless (defined($DTD{$name}));
    &Debug("Selecting '$name' DTD");
    $self->{DTD} = $DTD{$self->{DTDNAME} = $name} ;
}

################################################################################
#
#                         ControlRecord dedicated API
#
################################################################################
# Provides the selection of the right NODE in the XML
# Then we can use 'get' API to retreive destid values
sub selectDestId {
    my $self   = shift ;
    my $destid = shift ;

    return $self->error(450,"No destid provided")
        unless (defined($destid) and $destid );

    &Debug("Getting Destinations node in XML");
    my $TREE = $self->getDestinations();
    return $self->error(451,"No destination tree found".($!?" $!":""))
        unless @{$TREE} ;

    $self->parseNodesById();

    unless (defined($self->{NODES}->{$destid})) {
        $self->error(452,"No configuration found for DestID '$destid'");
        return "" ;
    }

    return $self->{NODEID} = $destid ;
}

sub selectDocument {
    my $self = shift ;
    my $doc  = shift ;

    return $self->error(453,"No document name provided")
        unless (defined($doc) and $doc );

    &Debug("Getting Documents node in XML");
    my $TREE = $self->getDocuments();
    return $self->error(454,"No Document tree found".($!?" $!":""))
        unless @{$TREE} ;

    $self->parseNodesById();

    unless (defined($self->{NODES}->{$doc})) {
        &Debug("No configuration found for Document '$doc'");
        return "" ;
    }

    return $self->{NODEID} = $doc ;
}

sub getDestinations {
    my $self = shift ;

    # Return cached TREE
    return $self->{TREE} if (defined($self->{TREE}));

    &Debug("Searching Destination nodes in XML");
    my @TREE = $self->{XML}->getElementsByTagName("Destination");
    return $self->{TREE} = \@TREE ;
}

sub getDocuments {
    my $self = shift ;

    # Return cached TREE
    return $self->{TREE} if (defined($self->{TREE}));

    &Debug("Searching Document nodes in XML");
    my @TREE = $self->{XML}->getElementsByTagName("Document");
    return $self->{TREE} = \@TREE ;
}

################################################################################
#
#                       E-Service dedicated API
#
################################################################################
sub getbin {
    my $self = shift ;
    my $name = shift ;
    my $exec ;

    $self->error(0);
    $! = 0 ;

    return $self->error(480,"No service name provided")
        unless (defined($name) and $name );

    &Debug("Getting E-Services node in XML");
    my $TREE = $self->getEServices();
    return $self->error(481,"No E-Service tree found".($!?" ($!)":""))
        unless @{$TREE} ;

    # Really parse only if it has not been done before
    unless ( keys(%{$self->{NODES}}) ) {
        &Debug("Parsing nodes tree by name");
        foreach my $node ( @{$self->{TREE}} ) {
            my $service = $node->getAttribute('name');
            unless (defined($name) and $name) {
                &Warn("Skipping bad service node without name attribut '" .
                    $node->toString() . "'");
                next ;
            }

            $exec = $node->getAttribute('exec');
            unless (defined($exec) and $exec) {
                &Warn("Skipping bad service node without exec attribut '" .
                    $node->toString() . "'");
                next ;
            }

            &Warn("'$service' E-Service definition seems to use and non existing '" .
                $exec . "' program")
                    unless (-e $exec);

            &Warn("'$service' E-Service definition seems to use and non executable '" .
                $exec . "' program")
                    unless (-x $exec);

            my $mode = $node->getAttribute('mode');
            unless (defined($exec) and $exec) {
                &Debug("No service node mode attribut found in '" .
                    $node->toString() . "', taking default");
                $mode = 0 ;
            }

            &Debug("Registring node '$service' with exec '$exec' and mode '$mode'")
                 if ($ADVANCED_DEBUGGING);
            $self->{NODES}->{$service} = [ $exec , $mode ] ;
        }
    }

    unless (defined($self->{NODES}->{$name})) {
        $self->error(482,"No configuration found for E-Service '$name'");
        return "" ;
    }

    $exec = $self->{NODES}->{$name}->[0] || "" ;

    return $self->error(483,"Requested E-Service '$name' uses not existing '$exec' program")
        unless ( -e $exec );

    # Check if its a link if not executable
    my $maxlink = 10 ; # Even if link loop should not pass the 483 error, its better
    # to keep as reasonnable loop exit condition
    my $link = $exec ;
    while ( ! -x _ and $maxlink -- ) {
        if ( -l $link ) {
            $link = readlink $link ;
            return $self->error(483,"Requested E-Service '$name' uses a '$exec' link to a not existing '$link' program")
                unless ( -e $link );

        } else {
            last ;
        }
    }

    return $self->error(484,"Too much link found behind '$exec'")
        if ( $maxlink < 0 );

    return $self->error(485,"Requested E-Service '$name' uses not executable '$link' program" .
            ($link ne $exec?" as '$exec' link":""))
        unless ( -x _ );

    return @{$self->{NODES}->{$name}} ;
}

sub getEServices {
    my $self = shift ;

    # Return cached TREE
    return $self->{TREE} if (defined($self->{TREE}));

    &Debug("Searching any service node in XML") if ($ADVANCED_DEBUGGING);
    my @TREE = $self->{XML}->getElementsByTagName("service");

    &Debug("Tree nodes: @TREE") if ($ADVANCED_DEBUGGING);
    return $self->{TREE} = \@TREE ;
}


################################################################################
#
#                       External requests dedicated API
#
################################################################################
# Provides access to the NODE <a2p /> xml validation
sub isA2P_valid {
    my $self   = shift ;
    my $strict = shift || 0 ;

    # 1. Parse buffer as string
    my $doc = $self->parse_string ;
    return $strict ? $self->error(460,"Not an XML document") : 0
        unless ( ref($doc) =~ /^XML::LibXML::Document$/ );

    # 2. Check doc is valid
    # TODO We need to validate toward a DTD
    #my $dtd = $self->getDTD('a2p');
    #return $strict ? $self->error(461,"Not a valid XML A2P object") : 0
    #    unless ($doc->is_valid($dtd));

    return $doc ;
}

# Provides access to the NODE <a2p /> to handle conversion request
sub isA2P {
    my $self = shift ;

    # 1. Parse and validate buffer
    $self->setDTD('a2p-listener.dtd');
    my $doc = $self->isA2P_valid('strict') ;
    return 0 unless ( $doc and ref($doc) =~ /^XML::LibXML::Document$/ );

    # 2. Check document format: we must have an a2p node as root
    return $self->error(462,"Document has no 'a2p' node")
        unless ( $doc->hasChildNodes and $doc->getChildNodes->size == 1 and
            $doc->lastChild->nodeName eq 'a2p');

    my $a2p = $doc->lastChild ;
    my @nodes = map { $_->nodeName } $a2p->getChildNodes ;
    &Debug("Available nodes: @nodes");

    # 3. We need at least a path or a content node
    return 0 unless grep { /^(path|content)$/i } @nodes ;

    # 4. Still select A2P comportement
    my $key = 'CONTENT' ;
    $key = 'PATH' if (grep { /^path$/i } @nodes);

    # Initializes few things
    $self->{MESSAGE} = [ "A2P-XML-Object = ".$self->{ID} ] ;
    $self->{PDFS} = [] ;
    $self->{STATE} = 0 ;

    foreach my $node ( $a2p->getChildNodes ) {
        next unless ( $node->nodeName =~ /^$key$/i );

        # Check eventually type attribut
        my $type = $node->getAttribute("type");
        return $self->error(464,"Type '$type' conversion not supported")
            if (defined($type) and $type =~ /^afp$/i );

        $self->{$key} = $node->textContent() ;
        $self->{$key} = "" unless (defined($self->{$key}));
    }

    return defined($self->{PATH}) and $self->{PATH} ? 1 : 0
        if ( $key eq 'PATH' );

    # key = CONTENT as AFP EBCDIDC base64 encoded flux
    &Debug("Got base64 content to convert");
    $self->{CONTENT} = &decode_base64( $self->{CONTENT} ) ;
    $self->{PATH} = $SHMDIR . '/AFP.' . $self->{ID} ;

    open AFP, ">" .$self->{PATH}
        or return $self->error(463,"Can't open temporary file to save AFP content: $!");

    # Lock the file just in case
    my $locked = flock(AFP, LOCK_EX | LOCK_NB);
    return $self->error(465,"Can't lock file for AFP content: $!")
        unless $locked ;

    my $print = print AFP $self->{CONTENT}
        or $self->error(466,"Can't write file with AFP content: $!");

    flock(AFP, LOCK_UN);
    close(AFP);

    return $print ;
}

# Provides access to the NODE <a2p /> as E-Service request
sub isA2P_eService {
    my $self = shift ;

    # 1. Parse and validate buffer or return without error
    $self->setDTD('a2p-eservice.dtd');
    my $doc = $self->isA2P_valid('') ;
    return 0 unless ( $doc and ref($doc) =~ /^XML::LibXML::Document$/ );

    # 2. Check document format: we must have an a2p node as root
    return $self->error(472,"Document has no 'a2p' node")
        unless ( $doc->hasChildNodes and $doc->getChildNodes->size == 1 and
            $doc->lastChild->nodeName eq 'a2p');

    my $a2p = $self->{A2P} = $doc->lastChild ;
    my @nodes = () ;

    # 3. Keep ref to service node and check it exists
    foreach my $node ( $a2p->getChildNodes ) {
        my $nodename = $node->nodeName ;
        push @nodes , $nodename ;
        next unless ( $nodename =~ /^service$/i );
        $self->{SERVICE} = $node ;
    }

    unless (grep { /^service$/i } @nodes and defined($self->{SERVICE})) {
        $self->error(473,"XML request must content a 'service' node");
        &Info("Available nodes: @nodes");
        return 0 ;
    }

    &Debug("Available nodes: @nodes");

    # 4. Check name attribut is defined
    my $name = $self->{SERVICE}->getAttribute("name");
    return $self->error(474,"No service name found to handle request")
        unless (defined($name) and $name );

    return $self->error(475,"'$name' found service name is prohibited")
        if ( $name eq '200' );

    &Debug("Claimed E-Service is '$name'");
    $self->{'E-SERVICE'} = $name ;

    # 5. Check pdf and file attribut for just overriding warns
    my $pdf = $self->{SERVICE}->getAttribute("pdf");
    &Warn("service node 'pdf' attribut with value '$pdf' will be lost")
        if (defined($pdf) and $pdf );

    my $file = $self->{SERVICE}->getAttribute("file");
    &Warn("service node 'file' attribut with value '$file' will be lost")
        if (defined($file) and $file );

    # 6. Returns E-Service name as true value
    return $name ;
}

sub set_a2p_attribut {
    my $self = shift ;
    my $name  = shift || "" ;
    my $value = shift || "" ;
    return 0 unless (defined($self->{A2P}) and $name and $value);

    $self->{A2P}->setAttribute( $name , $value );

    return $self->{A2P}->hasAttribute( $name );
}

sub A2Panswer {
    my $self = shift ;
    return join("\n",( @{$self->{MESSAGE}}, $self->error ))
        unless ( ref($self->{XML}) =~ /^XML::LibXML::Document$/ );
    # We need to update XML and return its text version
    my $a2p = $self->{XML}->lastChild ;
    my $lastnode = 0 ;

    my $key = 'PATH' ;
    $self->{PATH} = (defined($self->{PDFS}) and @{$self->{PDFS}})?
        shift @{$self->{PDFS}} : "" ;

    # Update path or content

    if (defined($self->{CONTENT})) {
        $key = 'CONTENT' ;
        open PDF, $self->{PATH}
            or return $self->error(467,"Can't open pdf file for reading: $!");

        $self->{CONTENT} = &encode_base64(join('',<PDF>));
        close(PDF);

        # Delete PDF as it is requested
        unlink $self->{PATH} ;
    }

    if (defined($self->{PATH}) and $self->{PATH}) {
        foreach my $node ( $a2p->getChildNodes ) {
            next unless ( $node->nodeName =~ /^$key$/i );

            $lastnode = $node->cloneNode ;
            $lastnode->appendText( $self->{$key} );
            $lastnode->setAttribute("type","pdf");
            $node->replaceNode( $lastnode );

            # We must have only one node to update
            last ;
        }

    } else {
        $self->A2Pabterm ;
        $self->error(470,"No pdf generated: '$_'");
        $self->A2Pmessage("A2P-Error-XML-no-pdf-available");
    }

    # Check we don't received another PDF or we didn't update the node
    if ( defined($self->{PDFS}) and @{$self->{PDFS}} ) {
        map {
            $self->error(468,"Too much pdf generated: '$_'");
            $self->A2Pmessage("A2P-Error-Other-PDF = $_");
            $self->A2Pabterm ;
            } @{$self->{PDFS}} ;

    } elsif ( defined($self->{PDFS}) and ! $lastnode ) {
        $self->A2Pabterm ;
        $self->error(469,"Too much pdf generated: '$_'");
        $self->A2Pmessage("A2P-Error-XML-not-updated");
    }

    # Set return code
    my $RC = sprintf("%02d",$self->{STATE}) ;
    my ( $returnCode ) = grep { $_->nodeName =~ /^ReturnCode$/i } $a2p->getChildNodes ;
    if (defined($returnCode)) {
        $lastnode = $returnCode->cloneNode ;
        $lastnode->appendText( $RC );
        $returnCode->replaceNode( $lastnode );

    } else {
        $a2p->appendTextChild( "returnCode", $RC );
    }

    # Set messages on bad status
    $a2p->appendTextChild( "message", join("\n",@{$self->{MESSAGE}}) )
        if ($self->{STATE});

    my $answer = $self->{XML}->toString ;
    &Debug("XML answer is '$answer'");
    return $answer ;
}

sub A2Pmessage {
    my $self = shift ;
    &Debug("Got XML message as '@_'");
    push @{$self->{MESSAGE}}, @_ ;
}

sub A2Ppdf {
    my $self = shift ;
    push @{$self->{PDFS}}, @_ ;
}

sub getPATH {
    my $self = shift ;
    return defined($self->{PATH}) ? $self->{PATH} : "" ;
}

sub A2Pabterm {
    $_[0]->{STATE} ++ ;
}

sub setstate {
    my $self = shift ;

    my $state = shift ;
    my $path = $DONESPOOL ;

    # Check state
    unless ($state =~ /^OK$/i) {
        $path = $ERRORSPOOL ;
        $self->{STATE} ++ ;
    }

    # Update PDFs path
    @{$self->{PDFS}} = map { $path . '/' . $_ } @{$self->{PDFS}} ;
}

################################################################################
#
#                           General common APIs
#
################################################################################
sub error {
    my $self = shift ;
    if ( @_ ) {
        my ( $errno , $msg ) = @_ ;

        # Reset ERROR when requested
        return @{$self->{ERROR}} = ( 0 )
            unless (defined($errno) and $errno );

        return 0 unless (defined($msg));

        push @{$self->{ERROR}} , $msg ;
        &Error( "Error $errno: $msg on " . $self->{ID} );
        return 0 ;

    } else {
        return wantarray ? grep { ! /^\d+$/ } @{$self->{ERROR}} : $self->{ERROR}->[0] ;
    }
}

sub DESTROY {
    my $self = shift;
    my @err  = @{$self->{ERROR}} ;

    if (@err) {
        &UPSTAT('GET-XML-ERROR');
        &UPSTAT('GET-XML-ERROR-' . $err[0] );
        &Debug($self->{ID} . " XML object destroyed with error #" . $err[0]);

    } else {
        &UPSTAT('GOT-GOOD-XML');
        &Debug($self->{ID} . " XML object destroyed");
    }

    delete $IDs{$self->{ID}} ;
}

################################################################################
### Load default inline DTDs ###################################################
################################################################################
sub SaveDTD ( $ \$ ) {
    my $name   = shift || "" ;
    my $buffer = shift ;

    return &Error("No name provided to keep DTD in memory")
        unless $name ;

    unless ($$buffer) {
        &Debug("Nothing to save for '$name' DTD");
        return 1 ;
    }

    my $string = $$buffer ;

    # Empty the buffer
    $$buffer = "" ;

    &Debug("Saving '$name' DTD in memory...");
    $DTD{$name} = XML::LibXML::Dtd->parse_string($string);
}

{
    my ( $name , $buffer , $count ) = ( "" , "" , 0 );
    $! = 0 ;

    &Debug("Loading default DTD definitions...");
    while (<DATA>)
    {
        next if /^\s*$/ ; # Skip empty lines
        next if /^####/    ; # Skip big comment lines
        chomp ;

        # Start a new DTD
        if (/^### DTD\s+'([^']*)'/) {
            die "Can't initialize '$name' DTD: $!\n"
                unless (!$name or
                ($name and $buffer and &SaveDTD($name,\$buffer) and ++ $count));

            $name = $1 ;
            &Debug("Reading '$name' DTD...");
            next ;
        }

        $buffer .= $_ . "\n" ;
    }

    # Save last DTD
    die "Can't initialize '$name' DTD: $!\n"
        unless ($name and $buffer and &SaveDTD($name,\$buffer));

    close(DATA);

    &Debug("$count DTD loaded");
}

&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");

1;
################################################################################
### Each DTD is defined by an id and a name from the following format line   ###
### After the __DATA__ inline tag                                            ###
### DTD 'id' 'name'  any string as comment for example                       ###
################################################################################

__DATA__
################################################################################
### DTD 'a2p-listener.dtd' A2P Listener DTD                                  ###
################################################################################
<!ELEMENT a2p ( (path|content) , (returnCode)* , (message)* )+ >
<!ELEMENT path          ANY >
<!ELEMENT content       ANY >
<!ELEMENT returnCode    ANY >
<!ELEMENT message       ANY >

################################################################################
### DTD 'a2p-eservice.dtd' A2P E-Service DTD                                 ###
################################################################################
<!ELEMENT a2p ( service )+ >
<!ELEMENT service ANY >
<!ATTLIST a2p
                    pdf          CDATA   #IMPLIED
                    file         CDATA   #IMPLIED
>
<!ATTLIST service
                    name         CDATA   #REQUIRED
>

################################################################################
### DTD 'e-service.conf.dtd' Configuration E-Service DTD                     ###
################################################################################
<!ELEMENT conf ( service )* >
<!ELEMENT service EMPTY >
<!ATTLIST service
                    name         CDATA   #REQUIRED
                    exec         CDATA   #REQUIRED
                    mode         (0|1)   #REQUIRED
>