File Coverage

lib/XML/eXistDB.pm

Criterion	Covered	Total	%
statement	24	53	45.2
branch	0	4	0.0
condition	0	8	0.0
subroutine	8	15	53.3
pod	5	6	83.3
total	37	86	43.0

# Copyrights 2010-2021 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution XML-ExistsDB.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package XML::eXistDB;
use vars '$VERSION';
$VERSION = '0.99_1';


use warnings;
use strict;

use Log::Report 'xml-existdb';

use XML::eXistDB::Util;
use XML::Compile::Util  qw/pack_type type_of_node/;
use XML::Compile::Cache ();
use XML::LibXML::Simple qw/XMLin/;

my $coll_type = pack_type NS_COLLECTION_XCONF, 'collection';


sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }

sub init($)
{   my ($self, $args) = @_;

    my $schemas = $self->{XE_schemas} ||= XML::Compile::Cache->new;

    $schemas->allowUndeclared(1);
    $schemas->anyElement('SLOPPY');   # query results are sloppy
    $schemas->addCompileOptions('RW', sloppy_integers => 1, sloppy_floats => 1);
    $schemas->addPrefixes(exist => NS_EXISTDB);

    my $sv      = $args->{server_version} || $ENV{XML_SERVER_VERSION} || '3.0';
    $self->{XE_version} = $sv;

    (my $xsddir = __FILE__) =~ s,\.pm,/xsd-exist,;
    my @xsds    = glob "$xsddir/*.xsd";
    $schemas->importDefinitions(\@xsds);

    $self;
}

#-----------------

sub schemas()       {shift->{XE_schemas}}
sub serverVersion() {shift->{XE_version}}

#-----------------

sub createCollectionConfig($%)
{   my ($self, $data, %args) = @_;
    my $format = (!exists $args{beautify} || $args{beautify}) ? 1 : 0;

    # create XML via XML::Compile
    my $doc    = XML::LibXML::Document->new('1.0', 'UTF-8');
    my $xml    = $self->schemas->writer($coll_type)->($doc, $data);
    $doc->setDocumentElement($xml);
    $doc->toString($format);
}

# perl -MXML::eXistDB -e 'print XML::eXistDB->new->_coll_conf_template'
sub _coll_conf_template { shift->schemas->template(PERL => $coll_type) }


sub decodeXML($)
{   my $self    = shift;
    my $schemas = $self->schemas;
    my $xml     = $schemas->dataToXML(shift);

    my $type    = type_of_node $xml;
    my $known   = $schemas->namespaces->find(element => $type);
    $known ? $schemas->reader($type)->($xml) : XMLin $xml;
}

1;