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

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