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