GeniXML.pm.in 5.94 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/perl -w
#
# GENIPUBLIC-COPYRIGHT
# Copyright (c) 2010 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniXML;

use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA = "Exporter";
14
@EXPORT = qw(Parse ParseFile FindNodes FindFirst FindElement FindAttr IsLanNode IsLocalNode GetNodeId GetVirtualId GetManagerId SetText GetText CreateDocument AddElement);
15
16
17

use English;
use XML::LibXML;
18
19
use XML::LibXML::XPathContext;
use XML::LibXML::NodeList;
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
use GeniHRN;
use Carp qw(cluck carp);

# Configure variables
# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";

# Returns the document element by parsing a given string. If the
# string fails to parse, returns undefined.
sub Parse($)
{
    my ($xml) = @_;
    my $parser = XML::LibXML->new;
    my $doc;
    eval {
        $doc = $parser->parse_string($xml);
    };
    if ($@) {
	carp("Failed to parse xml string: $@\n");
	return undef;
    } else {
	return $doc->documentElement();
    }
}

sub ParseFile($)
{
    my ($file) = @_;
    my $parser = XML::LibXML->new;
    my $doc;
    eval {
        $doc = $parser->parse_file($file);
    };
    if ($@) {
	carp("Failed to parse xml string: $@\n");
	return undef;
    } else {
	return $doc->documentElement();
    }
}

# Returns a NodeList for a given XPath using a given node as
# context. 'n' is defined to be the prefix for the namespace of the
# node.
sub FindNodes($$)
{
    my ($path, $node) = @_;
    my $result = undef;
    my $ns = undef;
    eval {
	my $xc = XML::LibXML::XPathContext->new();
	$ns = $node->namespaceURI();
	if (defined($ns)) {
	    $xc->registerNs('n', $node->namespaceURI());
	} else {
	    $path =~ s/\bn://g;
	}
	$result = $xc->findnodes($path, $node);
    };
    if ($@) {
	if (! defined($ns)) {
	    $ns = "undefined";
	}
        cluck "Failed to find nodes using XPath path='$path', ns='$ns': $@\n";
	return XML::LibXML::NodeList->new();
    } else {
	return $result;
    }
}

# Returns the first Node which matches a given XPath against a given
# node. If that node is not of the specified type, returns
# undefined. Works like FindNodes.
sub FindNodeType($$$)
{
    my ($path, $node, $type) = @_;
    my $result = FindNodes($path, $node)->pop();
    if (defined($result) && $result->nodeType() != $type) {
	$result = undef;
    }
    return $result;
}

# Returns the first Node which matches a given XPath.
sub FindFirst($$)
{
    my ($path, $node) = @_;
    return FindNodes($path, $node)->pop();
}

# Returns the first Element which matches a given XPath.
sub FindElement($$)
{
    my ($path, $node) = @_;
    return FindNodeType($path, $node, XML_ELEMENT_NODE);
}

# Returns the first Attribute which matches a given XPath.
sub FindAttr($$)
{
    my ($path, $node) = @_;
    return FindNodeType($path, $node, XML_ATTRIBUTE_NODE);
}

# Returns true if a given XML Node is an RSpec node and is of type lan
sub IsLanNode($)
{
    my ($node) = @_;
    my $result = 0;
    if (defined($node) && $node->localname() eq "node") {
131
132
133
	foreach my $lan (FindNodes("n:node_type", $node)->get_nodelist()) {
	    my $typeName = GetText("type_name", $lan);
	    if (defined($typeName) && $typeName eq "lan") {
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
		$result = 1;
		last;
	    }
	}
    }
    return $result;
}

# Returns true if a given XML Node is an RSpec node and either has
# the current CM as a 'component_manager_urn' or
# 'component_manager_uuid or no component_manager defined.
sub IsLocalNode($)
{
    my ($node) = @_;
    my $result = 0;
    if (defined($node) && $node->localname() eq "node") {
150
	my $manager_uuid  = GetManagerId($node);
151
152
153
154
155
156
157
158
159
160
161
162
163
164
	if (! defined($manager_uuid) ||
	    GeniHRN::Equal($manager_uuid, $ENV{'MYURN'}) ||
	    $manager_uuid eq $ENV{'MYUUID'}) {

	    $result = 1;
	}
    }
    return $result;
}

# Returns the uuid or urn of an RSpec node or undef if it is not a node.
sub GetNodeId($)
{
    my ($node) = @_;
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    return GetText("component_uuid", $node) ||
	GetText("component_urn", $node) ||
	GetText("uuid", $node);
}

sub GetVirtualId($)
{
    my ($node) = @_;
    return GetText("virtual_id", $node) ||
	GetText("nickname", $node);
}

sub GetManagerId($)
{
    my ($node) = @_;
    return GetText("component_manager_uuid", $node) ||
	GetText("component_manager_urn", $node);
182
183
184
185
186
187
188
189
190
191
192
}

# Takes an attribute/element name, *NOT AN XPATH* and a node and sets
# the text of that node to a particular value. If the node is an
# attribute, the value is set. If it is an element with just a text
# node child, that node is replaced.
# Returns 1 on success and 0 on failure.
sub SetText($$$)
{
    my ($name, $node, $text) = @_;
    my $result = 0;
193
194
195
196
    my $child = FindFirst('@n:'.$name, $node);
    if (! defined($child)) {
	$child = FindFirst('@'.$name, $node);
    }
197
198
199
200
    if (defined($child)) {
	if ($child->nodeType() == XML_ATTRIBUTE_NODE) {
	    $child->setValue($text);
	    $result = 1;
201
202
	}
    } else {
203
	$child = FindFirst('n:'.$name, $node);
204
	if (defined($child)) {
205
206
207
208
209
210
211
212
	    my @grand = $child->childNodes();
	    if (scalar(@grand) == 1
		&& $grand[0]->nodeType() == XML_TEXT_NODE) {
		$grand[0]->setData($text);
		$result = 1;
	    } elsif (scalar(@grand) == 0
		     && $child->nodeType() == XML_ELEMENT_NODE) {
		$child->appendText($text);
213
		$result = 1;
214
	    }
215
216
	} elsif ($node->nodeType() == XML_ELEMENT_NODE) {
	    $node->setAttribute($name, $text);
217
	    $result = 1;
218
219
220
221
222
	}
    }
    return $result;
}

223
224
# Get the text contents of a child of a node with a particular
# name. This can be either an attribute or an element.
225
226
sub GetText($$)
{
227
    my ($name, $node) = @_;
228
    my $result = undef;
229
230
231
232
    my $child = FindFirst('@n:'.$name, $node);
    if (! defined($child)) {
	$child = FindFirst('@'.$name, $node);
    }
233
234
235
    if (! defined($child)) {
	$child = FindFirst('n:'.$name, $node);
    }
236
237
238
239
240
241
    if (defined($child)) {
	$result = $child->textContent();
    }
    return $result;
}

242
243
244
245
246
247
248
249
250
251
252
sub CreateDocument($$)
{
    my ($ns, $name) = @_;
    my $doc = XML::LibXML::Document->createDocument("1.0", "UTF-8");
}

sub AddElement($$)
{
    my ($name, $node) = @_;
}

253
254
# _Always_ make sure that this 1 is at the end of the file...
1;