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