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 {
  12         my $class = shift;
  13         my %args = @_;
  14         $class = ref($class) || $class;
  15         return bless(\%args,$class);
  16 }
  17
  18 sub xml {
  19         my $self = shift;
  20         my $xml = shift;
  21         if ($xml) {
  22                 $self->{xml} = $xml;
  23         }
  24         return $self->{xml};
  25 }
  26
  27 sub xmlfile {
  28         my $self = shift;
  29         my $xml = shift;
  30         if ($xml) {
  31                 $self->{xmlfile} = $xml;
  32         }
  33         return $self->{xmlfile};
  34 }
  35
  36 sub xml_to_doc {
  37         my($self, $xml) = @_;
  38         my $doc = $self->{doc};
  39         unless ($doc) {
  40                 $xml ||= $self->{xml};
  41                 $doc = $self->{doc} = $parser->parse_string( $xml );
  42         }
  43         return $doc;
  44 }
  45
  46 sub xml_to_nodeset {
  47         my($self, $xml) = @_;
  48         $xml ||= $self->xml;
  49         $self->xml_to_doc( $xml );
  50         my $nodeset = $self->_xml_to_nodeset;
  51         return $self;
  52 }
  53
  54 sub nodeset {
  55         my $self = shift;
  56         return $self->{nodelist};
  57 }
  58
  59 sub xmlfile_to_nodeset {
  60         my($self, $xmlfile) = @_;
  61         $self->xmlfile( $xmlfile );
  62         $self->xmlfile_to_doc;
  63         return $self->xml_to_nodeset;
  64 }
  65
  66 sub doc {
  67         my $self = shift;
  68         return $self->{doc};
  69 }
  70
  71 sub xmlfile_to_doc {
  72         my($self, $xmlfile) = @_;
  73         $xmlfile ||= $self->xmlfile;
  74         my $doc = $self->{doc};
  75         unless ($doc) {
  76                 $doc = $self->{doc} = $parser->parse_file( $xmlfile );
  77         }
  78         return $doc;
  79 }
  80
  81 sub nodeset_to_xml {
  82         my $self = shift;
  83         my $nodeset = shift;
  84         $nodeset ||= $self->nodeset;
  85
  86         my $doc = XML::LibXML::Document->new;
  87
  88         my %seen_ns;
  89
  90         my @_xmllist;
  91         for my $node ( @$nodeset ) {
  92                 my $xml;
  93
  94                 if ( $node->{node_type} == XML_ELEMENT_NODE ) {
  95
  96                         $xml = $doc->createElement( $node->{name} );
  97
  98                         $xml->setNodeName($seen_ns{$node->{namespace_uri}} . ':' . $xml->nodeName) if ($node->{namespace_uri} and $seen_ns{$node->{namespace_uri}});
  99
 100                 } elsif ( $node->{node_type} == XML_TEXT_NODE ) {
 101                         $xml = $doc->createTextNode( $node->{value} );
 102
 103                 } elsif ( $node->{node_type} == XML_COMMENT_NODE ) {
 104                         $xml = $doc->createComment( $node->{value} );
 105
 106                 } elsif ( $node->{node_type} == XML_NAMESPACE_DECL ) {
 107                         if ($self->nodeset->[$node->{parent_node}]->{namespace_uri} eq $node->{value}) {
 108                                 $_xmllist[$node->{parent_node}]->setNamespace($node->{value}, $node->{name}, 1);
 109                         } else {
 110                                 $_xmllist[$node->{parent_node}]->setNamespace($node->{value}, $node->{name}, 0);
 111                         }
 112                         $seen_ns{$node->{value}} = $node->{name};
 113                         next;
 114
 115                 } elsif ( $node->{node_type} == XML_ATTRIBUTE_NODE ) {
 116
 117                         if ($node->{namespace_uri}) {
 118                                 $_xmllist[$node->{parent_node}]->setAttributeNS($node->{namespace_uri}, $node->{name}, $node->{value});
 119                         } else {
 120                                 $_xmllist[$node->{parent_node}]->setAttribute($node->{name}, $node->{value});
 121                         }
 122
 123                         next;
 124                 } else {
 125                         next;
 126                 }
 127
 128                 $_xmllist[$node->{intra_doc_id}] = $xml;
 129
 130                 if (defined $node->{parent_node}) {
 131                         $_xmllist[$node->{parent_node}]->addChild($xml);
 132                 }
 133         }
 134
 135         $doc->setDocumentElement($_xmllist[0]);
 136
 137         return $doc;
 138 }
 139
 140 # --------------------------------------------------------------
 141 # -- Builds a list of nodes from a given xml doc
 142 sub _xml_to_nodeset {
 143
 144         my($self, $doc) = @_;
 145
 146         $doc ||= $self->doc;
 147         return undef unless($doc);
 148
 149         my $node = $doc->documentElement;
 150         return undef unless($node);
 151
 152
 153         $self->{next_id} = 0;
 154
 155         push @{$self->{nodelist}}, {
 156                 intra_doc_id    => 0,
 157                 parent_node     => undef,
 158                 name            => $node->localname,
 159                 value           => undef,
 160                 node_type       => $node->nodeType,
 161                 namespace_uri   => $node->namespaceURI
 162         };
 163
 164         $self->_nodeset_recurse( $node, 0);
 165
 166         return  $self;
 167 }
 168
 169 sub _nodeset_recurse {
 170
 171         my( $self, $node, $parent) = @_;
 172         return undef unless($node && $node->nodeType == 1);
 173
 174
 175         for my $kid ( ($node->getNamespaces, $node->attributes, $node->childNodes) ) {
 176
 177                 my $type = $kid->nodeType;
 178
 179                 push @{$self->{nodelist}}, {
 180                         intra_doc_id    => ++$self->{next_id},
 181                         parent_node     => $parent,
 182                         name            => $kid->localname,
 183                         value           => _grab_content( $kid, $type ),
 184                         node_type       => $type,
 185                         namespace_uri   => ($type != 18 ? $kid->namespaceURI : undef )
 186                 };
 187
 188                 return if ($type == 3);
 189                 $self->_nodeset_recurse( $kid, $self->{next_id});
 190         }
 191 }
 192
 193 sub _grab_content {
 194         my $node = shift;
 195         my $type = 1 << shift();
 196
 197         return undef if ($type & 1 << XML_ELEMENT_NODE);
 198         return $node->textContent if ($type & $_tC_mask);
 199         return $node->value if ($type & $_val_mask);
 200         return $node->getData if ($type & 1 << XML_PI_NODE);
 201 }
 202
 203 1;