Open-ILS/src/perlmods/OpenILS/Utils/FlatXML.pm

   1 use strict; use warnings;
   2 package OpenILS::Utils::FlatXML;
   3 use XML::LibXML;
   4
   5 my $_tC_mask = 1 << XML_TEXT_NODE | 1 << XML_COMMENT_NODE | 1 << XML_CDATA_SECTION_NODE | 1 << XML_DTD_NODE;
   6 my $_val_mask = 1 << XML_ATTRIBUTE_NODE | 1 << XML_NAMESPACE_DECL;
   7
   8
   9 my $parser = XML::LibXML->new();
  10 $parser->keep_blanks(0);
  11 sub new { return bless({},shift()); }
  12
  13 sub xml_to_doc {
  14         my($self, $xml) = @_;
  15         return $parser->parse_string( $xml );
  16 }
  17
  18 sub xml_to_nodeset {
  19         my($self, $xml) = @_;
  20         return $self->_xml_to_nodeset(  $self->xml_to_doc( $xml ) );
  21 }
  22
  23 sub xmlfile_to_nodeset {
  24         my($self, $xmlfile) = @_;
  25         return $self->_xml_to_nodeset(  $self->xmlfile_to_doc( $xmlfile ) );
  26 }
  27
  28 sub xmlfile_to_doc {
  29         my($self, $xmlfile) = @_;
  30         return $parser->parse_file( $xmlfile );
  31 }
  32
  33 sub nodeset_to_xml {
  34         my $self = shift;
  35         my $nodeset = shift;
  36
  37         my $doc = XML::LibXML::Document->new;
  38
  39         my %seen_ns;
  40
  41         my @_xmllist;
  42         for my $node ( @{ $$nodeset{doclist} } ) {
  43                 my $xml;
  44
  45                 if ( $node->{type} == XML_ELEMENT_NODE ) {
  46
  47                         $xml = $doc->createElement( $node->{name} );
  48
  49                         if ($node->{ns}) {
  50                                 my ($ns) = grep { $node->{ns} eq $_->{uri} } @{ $$nodeset{nslist} };
  51                                 $xml->setNamespace($ns->{uri}, $ns->{prefix}, 1) if ($ns->{prefix} || !$seen_ns{$ns->{uri}});
  52                                 $seen_ns{$ns->{uri}}++;
  53                         }
  54
  55                 } elsif ( $node->{type} == XML_TEXT_NODE ) {
  56                         $xml = $doc->createTextNode( $node->{value} );
  57
  58                 } elsif ( $node->{type} == XML_COMMENT_NODE ) {
  59                         $xml = $doc->createComment( $node->{value} );
  60
  61                 } elsif ( $node->{type} == XML_ATTRIBUTE_NODE ) {
  62
  63                         if ($node->{ns}) {
  64                                 my ($ns) = grep { $node->{ns} eq $_->{uri} } @{ $$nodeset{nslist} };
  65                                 $_xmllist[$node->{parent}]->setAttributeNS($ns->{uri}, $node->{name}, $node->{value});
  66                         } else {
  67                                 $_xmllist[$node->{parent}]->setAttribute($node->{name}, $node->{value});
  68                         }
  69
  70                         next;
  71                 }
  72
  73                 $_xmllist[$node->{id}] = $xml;
  74
  75                 if (defined $node->{parent}) {
  76                         $_xmllist[$node->{parent}]->addChild($xml);
  77                 }
  78         }
  79
  80         $doc->setDocumentElement($_xmllist[0]);
  81
  82         return $doc;
  83 }
  84
  85 # --------------------------------------------------------------
  86 # -- Builds a list of nodes from a given xml doc
  87 my @nodeset = ();
  88 my @nslist = ();
  89 my $next_id = 0;
  90 sub _xml_to_nodeset {
  91
  92         my($self, $doc) = @_;
  93
  94         return undef unless($doc);
  95         my $node = $doc->documentElement;
  96         return undef unless($node);
  97
  98         _grab_namespaces($node);
  99
 100         push @nodeset, {
 101                 id                      => 0,
 102                 parent  => undef,
 103                 name            => $node->localname,
 104                 value           => undef,
 105                 type            => $node->nodeType,
 106                 ns                      => $node->namespaceURI
 107         };
 108
 109         $self->_nodeset_recurse( $node, 0);
 110
 111         # clear out the global variables
 112         my @tmp = @nodeset;
 113         my @tmpnslist = @nslist;
 114         @nodeset = ();
 115         @nslist = ();
 116         $next_id = 0;
 117
 118         return  { doclist => [@tmp], nslist => [@tmpnslist] };
 119 }
 120
 121 sub _grab_namespaces {
 122         my $node = shift;
 123         # add to the ns list if not alread there
 124         for my $ns ($node->getNamespaces) {
 125                 if (my ($existing_ns) = grep { $_->{uri} eq $ns->value } @nslist) {
 126                         $existing_ns->{prefix} = $ns->localname;
 127                         next;
 128                 }
 129                 push @nslist, { prefix => $ns->localname, uri => $ns->value };
 130         }
 131 }
 132
 133 sub _nodeset_recurse {
 134
 135         my( $self, $node, $parent) = @_;
 136         return undef unless($node && $node->nodeType == 1);
 137
 138         _grab_namespaces($node);
 139
 140         for my $kid ( ($node->attributes, $node->childNodes) ) {
 141                 next if ($kid->nodeType == 18);
 142
 143                 my $type = $kid->nodeType;
 144
 145                 push @nodeset, {
 146                         id                      => ++$next_id,
 147                         parent  => $parent,
 148                         name            => $kid->localname,
 149                         value           => _grab_content( $kid, $type ),
 150                         type            => $type,
 151                         ns                      => $kid->namespaceURI
 152                 };
 153
 154                 return if ($type == 3);
 155                 $self->_nodeset_recurse( $kid, $next_id);
 156         }
 157 }
 158
 159 sub _grab_content {
 160         my $node = shift;
 161         my $type = 1 << shift();
 162
 163         return undef if ($type & 1 << XML_ELEMENT_NODE);
 164         return $node->textContent if ($type & $_tC_mask);
 165         return $node->value if ($type & $_val_mask);
 166         return $node->getData if ($type & 1 << XML_PI_NODE);
 167 }
 168
 169 1;