package perfSONAR_PS::Client::Topology::XMLDB; use strict; use warnings; use Log::Log4perl qw(get_logger); use Data::Dumper; use perfSONAR_PS::DB::XMLDB; use perfSONAR_PS::Common; use perfSONAR_PS::Topology::Common; use perfSONAR_PS::Topology::ID; use fields 'READ_ONLY', 'DB_OPEN', 'DB_NAMESPACES', 'DB_FILE', 'DB_CONTAINER', 'DATADB'; our $VERSION = 0.08; sub new { my ($package, $db_container, $db_file, $ns, $read_only) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); my $self = fields::new($package); if ($read_only) { $self->{"READ_ONLY"} = 1; } else { $self->{"READ_ONLY"} = 0; } if (defined $db_container and $db_container ne "") { $self->{"DB_CONTAINER"} = $db_container; } if (defined $db_file and $db_file ne "") { $self->{"DB_FILE"} = $db_file; } if (defined $ns and $ns ne "") { $self->{"DB_NAMESPACES"} = $ns; } else { my %ns = getTopologyNamespaces(); $self->{"DB_NAMESPACES"} = \%ns; } $self->{"DB_OPEN"} = 0; $self->{"DATADB"} = ""; return $self; } sub open { my ($self) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); return (0, "") if ($self->{DB_OPEN} != 0); $self->{DATADB} = new perfSONAR_PS::DB::XMLDB({ env => $self->{DB_CONTAINER}, cont => $self->{DB_FILE}, ns => $self->{DB_NAMESPACES} }); if (not defined $self->{DATADB}) { my $msg = "Couldn't open specified database"; $logger->error($msg); return (-1, $msg); } # my $status = $self->{DATADB}->prep; # if ($status == -1) { # my $msg = "Couldn't open specified database"; # $logger->error($msg); # return (-1, $msg); # } my $error; my $status = $self->{DATADB}->openDB({ txn => undef, error => \$error }); if ($status == -1) { my $msg = "Couldn't open specified database: $error"; $logger->error($msg); return (-1, $msg); } $self->{DB_OPEN} = 1; return (0, ""); } sub close { my ($self) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); return 0 if ($self->{DB_OPEN} == 0); $self->{DB_OPEN} = 0; return $self->{DATADB}->closeDB; } sub dbIsOpen { my ($self) = @_; return $self->{DB_OPEN}; } sub setDBContainer { my ($self, $container) = @_; $self->{DB_CONTAINER} = $container; $self->close; return; } sub setDBFile { my ($self, $file) = @_; $self->{DB_FILE} = $file; $self->close; return; } sub setDBNamespaces { my ($self, $namespaces) = @_; $self->{DB_NAMESPACES} = $namespaces; if ($self->{DB_OPEN}) { $self->{DATADB}->setNamespaces({ ns => $namespaces }); } return; } sub xQuery { my($self, $xquery) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); my $localContent = ""; my $error; return (-1, "Database is not open") if ($self->{DB_OPEN} == 0); $xquery =~ s/\s{1}\// collection('CHANGEME')\//g; my @queryResults = $self->{DATADB}->query({ query => $xquery, txn => undef, error => \$error }); if ($error ne "") { $logger->error("Couldn't query database"); return (-1, "Couldn't query database: $error"); } $localContent .= "\n"; $localContent .= join("", @queryResults); $localContent .= "\n"; return (0, $localContent); } sub getAll { my($self) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); my @results; my $error; return (-1, "Database not open") if ($self->{DB_OPEN} == 0); my $content = ""; $content .= "{DB_NAMESPACES} }) { $content .= " xmlns:$ns=\"".$self->{DB_NAMESPACES}->{$ns}."\""; } $content .= ">"; @results = $self->{DATADB}->query({ query => "/*:domain", txn => undef, error => \$error }); if ($error ne "") { my $msg = "Couldn't get list of domains from database: $error"; $logger->error($msg); return (-1, $msg); } $content .= join("", @results); @results = $self->{DATADB}->query({ query => "/*:node", txn => undef, error => \$error }); if ($error ne "") { my $msg = "Couldn't get list of nodes from database: $error"; $logger->error($msg); return (-1, $msg); } $content .= join("", @results); @results = $self->{DATADB}->query({ query => "/*:port", txn => undef, error => \$error }); if ($error ne "") { my $msg = "Couldn't get list of ports from database: $error"; $logger->error($msg); return (-1, $msg); } $content .= join("", @results); @results = $self->{DATADB}->query({ query => "/*:link", txn => undef, error => \$error }); if ($error ne "") { my $msg = "Couldn't get list of links from database: $error"; $logger->error($msg); return (-1, $msg); } $content .= join("", @results); @results = $self->{DATADB}->query({ query => "/*:network", txn => undef, error => \$error }); if ($error ne "") { my $msg = "Couldn't get list of networks from database: $error"; $logger->error($msg); return (-1, $msg); } $content .= join("", @results); @results = $self->{DATADB}->query({ query => "/*:path", txn => undef, error => \$error }); if ($error ne "") { my $msg = "Couldn't get list of paths from database: $error"; $logger->error($msg); return (-1, $msg); } $content .= join("", @results); $content .= ""; my $topology; eval { my $parser = XML::LibXML->new(); my $pdoc = $parser->parse_string($content); $topology = $pdoc->getDocumentElement; }; if ($@) { my $msg = "Couldn't parse resulting database dump: ".$@; $logger->error($msg); return (-1, $msg); } return (0, $topology); } sub getUniqueIDs { my ($self) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); my $error; my (@domain_ids, @network_ids, @path_ids); return (-1, "Database not open") if ($self->{DB_OPEN} == 0); my ($status, $results) = $self->getAll(); if ($status != 0) { return ($status, $results); } my @ids = (); my $find_res; $find_res = find($results, "./*[local-name()='domain']", 0); if ($find_res) { foreach my $node ($find_res->get_nodelist) { my $id = $node->getAttribute("id"); my $uri = $node->namespaceURI(); my $prefix = $node->prefix; my %info = ( type => 'domain', id => $id, prefix => $prefix, uri => $uri, ); push @ids, \%info; } } $find_res = find($results, "./*[local-name()='network']", 0); if ($find_res) { foreach my $node ($find_res->get_nodelist) { my $id = $node->getAttribute("id"); my $uri = $node->namespaceURI(); my $prefix = $node->prefix; my %info = ( type => 'network', id => $id, prefix => $prefix, uri => $uri, ); push @ids, \%info; } } $find_res = find($results, "./*[local-name()='path']", 0); if ($find_res) { foreach my $node ($find_res->get_nodelist) { my $id = $node->getAttribute("id"); my $uri = $node->namespaceURI(); my $prefix = $node->prefix; my %info = ( type => 'path', id => $id, prefix => $prefix, uri => $uri, ); push @ids, \%info; } } return (0, \@ids); } sub changeTopology { my ($self, $type, $topology) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); my ($status, $res); $logger->debug("Topology: ".$topology->toString); return (-1, "Database not open") if ($self->{DB_OPEN} == 0); return (-1, "Database is Read-Only") if ($self->{READ_ONLY} == 1); my %comparison_attrs = ( link => ( id => '' ), node => ( id => '' ), port => ( id => '' ), domain => ( id => '' ), path => ( id => '' ), network => ( id => '' ), ); if ($type ne "update" and $type ne "replace" and $type ne "add") { my $msg = "Invalid topology change specified: $type"; $logger->error($msg); return (-1, $msg); } my @namespaces = $topology->getNamespaces(); my %elements = (); my %domain_ids = (); my $find_res; $find_res = find($topology, "./*[local-name()='domain']", 0); if ($find_res) { foreach my $domain ($find_res->get_nodelist) { my $id = $domain->getAttribute("id"); $logger->debug("Got a request for domain: $id"); if (not defined $id or $id eq "") { my $msg = "Domain with no id found"; $logger->error($msg); return (-1, $msg); } if (idIsFQ($id, "domain") == 0) { my $msg = "Domain with non-fully qualified id, $id, is specified"; $logger->error($msg); return (-1, $msg); } my ($status, $res) = validateDomain($domain, \%domain_ids); if ($status != 0) { my $msg = "Invalid domain, $id, specified: $res"; $logger->error($msg); return (-1, $msg); } my $new_domain; my $old_domain; ($status, $res) = $self->lookupElement($id, \%elements); $old_domain = $res if ($status == 0); if ($type eq "update") { if (not defined $old_domain) { my $msg = "Domain $id to update, but not found"; $logger->error($msg); return (-1, $msg); } $new_domain = mergeNodes_general($old_domain, $domain, \%comparison_attrs); } elsif ($type eq "replace") { $new_domain = $domain->cloneNode(1); } elsif ($type eq "add") { if (defined $old_domain) { my $msg = "Domain $id already exists"; $logger->error($msg); return (-1, $msg); } $new_domain = $domain->cloneNode(1); } $elements{$id} = $new_domain; } } my %node_ids = (); $find_res = find($topology, "./*[local-name()='node']", 0); if ($find_res) { foreach my $node ($find_res->get_nodelist) { my $id = $node->getAttribute("id"); if (not defined $id or $id eq "") { my $msg = "Node with no id found"; $logger->error($msg); return (-1, $msg); } if (idIsFQ($id, "node") == 0) { my $msg = "Node with non-fully qualified id, $id, is specified at top-level"; $logger->error($msg); return (-1, $msg); } my ($status, $res) = validateNode($node, \%node_ids, ""); if ($status != 0) { my $msg = "Invalid node , $id, specified: $res"; $logger->error($msg); return (-1, $msg); } my $domain; my $new_node; my $old_node; ($status, $res) = $self->lookupElement(idRemoveLevel($id, ""), \%elements); $domain = $res if ($status == 0); ($status, $res) = $self->lookupElement($id, \%elements); $old_node = $res if ($status == 0); if ($type eq "update") { if (not defined $old_node) { my $msg = "Node $id to update, but not found"; $logger->error($msg); return (-1, $msg); } $new_node = mergeNodes_general($old_node, $node, \%comparison_attrs); } elsif ($type eq "replace") { $new_node = $node->cloneNode(1); } elsif ($type eq "add") { if (defined $old_node) { my $msg = "Node $id already exists"; $logger->error($msg); return (-1, $msg); } $new_node = $node->cloneNode(1); } if (defined $domain) { if (defined $old_node) { $old_node->replaceNode($new_node); } else { replaceChild($domain, "domain", $new_node, $id); } } $elements{$id} = $new_node; } } my %port_ids = (); $find_res = find($topology, "./*[local-name()='port']", 0); if ($find_res) { foreach my $port ($find_res->get_nodelist) { my $id = $port->getAttribute("id"); if (not defined $id or $id eq "") { my $msg = "Port with no id found"; $logger->error($msg); return (-1, $msg); } if (idIsFQ($id, "port") == 0) { my $msg = "Port with non-fully qualified id, $id, is specified at top-level"; $logger->error($msg); return (-1, $msg); } my ($status, $res) = validatePort($port, \%port_ids, ""); if ($status != 0) { my $msg = "Invalid port , $id, specified: $res"; $logger->error($msg); return (-1, $msg); } my $node; my $old_port; my $new_port; ($status, $res) = $self->lookupElement(idRemoveLevel($id, ""), \%elements); $node = $res if ($status == 0); ($status, $res) = $self->lookupElement($id, \%elements); $old_port = $res if ($status == 0); if ($type eq "update") { if (not defined $old_port) { my $msg = "Port $id to update, but not found"; $logger->error($msg); return (-1, $msg); } $new_port = mergeNodes_general($old_port, $port, \%comparison_attrs); } elsif ($type eq "replace") { $new_port = $port->cloneNode(1); } elsif ($type eq "add") { if (defined $old_port) { my $msg = "Port $id already exists"; $logger->error($msg); return (-1, $msg); } $new_port = $port->cloneNode(1); } if (defined $node) { if (defined $old_port) { $old_port->replaceNode($new_port); } else { replaceChild($node, "node", $new_port, $id); } } $elements{$id} = $new_port; } } my %link_ids = (); $find_res = find($topology, "./*[local-name()='link']", 0); if ($find_res) { foreach my $link ($find_res->get_nodelist) { my $id = $link->getAttribute("id"); if (not defined $id or $id eq "") { my $msg = "Link with no id found"; $logger->error($msg); return (-1, $msg); } if (idIsFQ($id, "link") == 0) { my $msg = "Link with non-fully qualified id, $id, is specified at top-level"; $logger->error($msg); return (-1, $msg); } my ($status, $res) = validateLink($link, \%link_ids, ""); if ($status != 0) { my $msg = "Invalid link , $id, specified: $res"; $logger->error($msg); return (-1, $msg); } my $port; my $old_link; my $new_link; ($status, $res) = $self->lookupElement(idRemoveLevel($id, ""), \%elements); $port = $res if ($status == 0); ($status, $res) = $self->lookupElement($id, \%elements); $old_link = $res if ($status == 0); if ($type eq "update") { if (not defined $old_link) { my $msg = "Link $id to update, but not found"; $logger->error($msg); return (-1, $msg); } $new_link = mergeNodes_general($old_link, $link, \%comparison_attrs); } elsif ($type eq "replace") { $new_link = $link->cloneNode(1); } elsif ($type eq "add") { if (defined $old_link) { my $msg = "Link $id already exists"; $logger->error($msg); return (-1, $msg); } $new_link = $link->cloneNode(1); } if (defined $port) { if (defined $old_link) { $old_link->replaceNode($new_link); } else { replaceChild($port, "port", $new_link, $id); } } $elements{$id} = $new_link; } } $logger->debug("Elements: ".Dumper(\%elements)); # update everything that is sitting at the top-level foreach my $id (keys %elements) { next if (defined $elements{$id}->parentNode->parentNode); $logger->debug("Inserting $id"); # This is a hack to force the namespace declaration into the # node we're going to insert. A better solution would be to # have each node declare its namespace, but I'm not sure how to # finagle libxml into doing that. $elements{$id}->unbindNode; $elements{$id}->setNamespace($elements{$id}->namespaceURI(), $elements{$id}->prefix, 1); $self->{DATADB}->remove({ name => $id }); if ($self->{DATADB}->insertIntoContainer({ content => $elements{$id}->toString, name => $id }) != 0) { my $msg = "Error updating $id"; $logger->error($msg); return (-1, $msg); } } return (0, ""); } sub lookupElement { my ($self, $id, $elements) = @_; my $logger = get_logger("perfSONAR_PS::Client::Topology::XMLDB"); $logger->debug("Looking up element \"$id\""); my @res = idSplit($id, 1, 0); if ($res[0] != 0) { my $msg = "Invalid id: $id"; $logger->error($msg); return (-1, $msg); } my $base_type = $res[1]; my $base_id = $res[3]; my $parent_id = $res[5]; if (defined $elements->{$base_id}) { return (0, $elements->{$base_id}); } my $parent; if (defined $parent_id) { my ($status, $res) = $self->lookupElement($parent_id, $elements); if ($status == 0) { $parent = $res; } } if (not defined $parent_id or not defined $parent) { my $error; if (not defined $parent_id) { $logger->debug("Parent not found"); } else { $logger->debug("Parent '$parent_id' Not Found"); } my $doc = $self->{DATADB}->getDocumentByName({ name => $base_id, txn => undef, error => \$error }); if ($error ne "" or $doc eq "") { my $msg = "Element ".$base_id." not found"; $logger->error($msg); return (-1, $msg); } my $parser = XML::LibXML->new(); my $pdoc = $parser->parse_string($doc); my $elm = $pdoc->getDocumentElement; $elements->{$base_id} = $elm; return (0, $elm); } else { $logger->debug("Parent: $parent_id Found"); my $find_res = find($parent, "./*[local-name()='$base_type']", 0); if ($find_res) { foreach my $curr_elm ($find_res->get_nodelist) { if ($curr_elm->getAttribute("id") eq $base_id) { $elements->{$base_id} = $curr_elm; return (0, $curr_elm); } } } my $msg = "Element ".$base_id." not found"; $logger->error($msg); return (-1, $msg); } return (-1, "It should never get here"); } 1; __END__ =head1 NAME perfSONAR_PS::Client::Topology::XMLDB - A module that provides methods for interacting with a Topology MA database directly. =head1 DESCRIPTION This module allows one to interact with the Topology MA XMLDB Backend directly using a standard set of methods. interface. The API provided is identical to the API for interacting with the MAs via its Web Serviecs interface. Thus, a client written to read from or update a Topology MA can be easily modified to interact directly with its underlying database allowing more efficient interactions if required. The module is to be treated as an object, where each instance of the object represents a connection to a single database. Each method may then be invoked on the object for the specific database. =head1 SYNOPSIS =head1 DETAILS =head1 API The API for perfSONAR_PS::Client::Topology::MA is rather simple and greatly resembles the messages types received by the server. It is also identical to the perfSONAR_PS::Client::Topology::SQL API allowing easy construction of programs that can interface via the MA server or directly with the database. =head2 new($package, $uri_string) The new function takes a URI connection string as its first argument. This specifies which MA to interact with. =head2 open($self) The open function could be used to open a persistent connection to the MA. However, currently, it is simply a stub function. =head2 close($self) The close function could close a persistent connection to the MA. However, currently, it is simply a stub function. =head2 setURIString($self, $uri_string) The setURIString function changes the MA that the instance uses. =head2 dbIsOpen($self) This function is a stub function that always returns 1. =head2 getURIString($) The getURIString function returns the current URI string =head2 getAll($self) The getAll function gets the full contents of the database. It returns the results as a ref to a LibXML element pointing to the structure containing the contents of the database. =head2 xQuery($self, $xquery) The xQuery function performs an xquery on the specified database. It returns the results as a string. =head1 SEE ALSO L, L To join the 'perfSONAR-PS' mailing list, please visit: https://mail.internet2.edu/wws/info/i2-perfsonar The perfSONAR-PS subversion repository is located at: https://svn.internet2.edu/svn/perfSONAR-PS Questions and comments can be directed to the author, or the mailing list. =head1 VERSION $Id$ =head1 AUTHOR Aaron Brown, aaron@internet2.edu =head1 LICENSE You should have received a copy of the Internet2 Intellectual Property Framework along with this software. If not, see =head1 COPYRIGHT Copyright (c) 2004-2007, Internet2 and the University of Delaware All rights reserved. =cut # vim: expandtab shiftwidth=4 tabstop=4