File Coverage

lib/XML/eXistDB.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             # Copyrights 2010-2014 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.01.
5 1     1   122728 use warnings;
  1         2  
  1         30  
6 1     1   6 use strict;
  1         1  
  1         43  
7              
8             package XML::eXistDB;
9             our $VERSION = '0.13';
10              
11 1     1   16 use base 'XML::Compile::Cache';
  1         2  
  1         694  
12              
13             use Log::Report 'xml-existdb', syntax => 'SHORT';
14              
15             use XML::eXistDB::Util;
16             use XML::Compile::Util qw/pack_type type_of_node/;
17             use XML::LibXML::Simple qw/XMLin/;
18              
19             my $coll_type = pack_type NS_COLLECTION_XCONF, 'collection';
20              
21              
22             sub init($)
23             { my ($self, $args) = @_;
24              
25             exists $args->{allow_undeclared}
26             or $args->{allow_undeclared} = 1;
27              
28             $args->{any_element} ||= 'SLOPPY'; # query results are sloppy
29              
30             unshift @{$args->{opts_readers}}
31             , sloppy_integers => 1, sloppy_floats => 1;
32              
33             $self->SUPER::init($args);
34              
35             (my $xsddir = __FILE__) =~ s,\.pm,/xsd-exist,;
36             my @xsds = glob "$xsddir/*.xsd";
37              
38             $self->addPrefixes(exist => NS_EXISTDB);
39             $self->importDefinitions(\@xsds);
40             $self;
41             }
42              
43              
44             sub createCollectionConfig($%)
45             { my ($self, $data, %args) = @_;
46              
47             my $format = (!exists $args{beautify} || $args{beautify}) ? 1 : 0;
48             my $string;
49              
50             # create XML via XML::Compile
51             my $writer = $self->{wr_coll_conf} ||=
52             $self->compile
53             ( WRITER => $coll_type
54             , include_namespaces => 1, sloppy_integers => 1
55             );
56              
57             my $doc = XML::LibXML::Document->new('1.0', 'UTF-8');
58             my $xml = $writer->($doc, $data);
59             $doc->setDocumentElement($xml);
60             $doc->toString($format);
61             }
62              
63             # perl -MXML::eXistDB -e 'print XML::eXistDB->new->_coll_conf_template'
64             sub _coll_conf_template { shift->template(PERL => $coll_type) }
65              
66              
67             sub decodeXML($)
68             { my $self = shift;
69             my $xml = $self->dataToXML(shift);
70             my $type = type_of_node $xml;
71             my $known = $self->namespaces->find(element => $type);
72             $known ? $self->reader($type)->($xml) : XMLin $xml;
73             }
74              
75             1;