[MOBY-guts] biomoby commit
Eddie Kawas
kawas at dev.open-bio.org
Tue Jul 24 17:26:00 UTC 2007
kawas
Tue Jul 24 13:25:59 EDT 2007
Update of /home/repository/moby/moby-live/Java/src/Perl/MOSES/MOBY/Cache
In directory dev.open-bio.org:/tmp/cvs-serv19734/Java/src/Perl/MOSES/MOBY/Cache
Modified Files:
Central.pm
Log Message:
added 5 subroutines ...
create_datatype_cache
update_datatype_cache
create_service_cache
update_service_cache
create_cache_dirs
These subs help remove the dependency on the java cache.
moby-live/Java/src/Perl/MOSES/MOBY/Cache Central.pm,1.1,1.2
===================================================================
RCS file: /home/repository/moby/moby-live/Java/src/Perl/MOSES/MOBY/Cache/Central.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /home/repository/moby/moby-live/Java/src/Perl/MOSES/MOBY/Cache/Central.pm 2006/10/13 21:51:16 1.1
+++ /home/repository/moby/moby-live/Java/src/Perl/MOSES/MOBY/Cache/Central.pm 2007/07/24 17:25:59 1.2
@@ -17,6 +17,7 @@
use MOSES::MOBY::Def::Data;
use MOSES::MOBY::Def::Namespace;
use MOSES::MOBY::Def::Relationship;
+use SOAP::Lite;
use XML::LibXML;
use File::Spec;
use strict;
@@ -53,6 +54,18 @@
print $cache->cachedir;
print $cache->registry();
+ # create a cache for datatypes and fill it up
+ $cache->create_datatype_cache;
+
+ #update the datatype cache
+ $cache->update_datatype_cache;
+
+ # create a cache for services and fill it up
+ $cache->create_service_cache;
+
+ #update the services cache
+ $cache->update_service_cache;
+
# get a data type called DNASequence
my $dna = $cache->get_datatype ('DNASequence');
@@ -182,6 +195,21 @@
}
#-----------------------------------------------------------------
+# _namespace
+# Return a namespace of the $self->registry, or of a given
+# registry.
+#-----------------------------------------------------------------
+sub _namespace {
+ my ($self, $registry) = @_;
+ $registry ||= $self->registry;
+ return $registry if $registry =~ m"^http://";
+ my $reg = MOSES::MOBY::Cache::Registries->get ($registry);
+ return $reg->{namespace} if $reg;
+ return MOSES::MOBY::Cache::Registries->get ('default')->{namespace};
+}
+
+
+#-----------------------------------------------------------------
# init
#-----------------------------------------------------------------
sub init {
@@ -253,6 +281,351 @@
}
#-----------------------------------------------------------------
+# create_datatype_cache
+#-----------------------------------------------------------------
+
+=head2 create_datatype_cache
+
+Create the datatype cache. This will over write any pre-existing
+cache that it finds.
+
+Throw an exception if any of the following occur:
+ * There is a SOAP error calling the registry
+ * There were write errors on the cache directory or its contents
+=cut
+
+sub create_datatype_cache {
+ my ($self) = @_;
+
+ # 2 steps:
+ # -> create a LIST file
+ my $soap =
+ SOAP::Lite->uri($self->_namespace)
+ ->proxy( $self->_endpoint )->on_fault(
+ sub {
+ my $soap = shift;
+ my $res = shift;
+ $self->throw ("There was a problem calling the registry: " . $self->_endpoint . "\@ " . $self->_namespace . ".\n" + $res);
+ }
+ );
+
+ my $xml =
+ $soap->retrieveObjectNames( )->result;
+ # create cache dirs as needed
+ $self->create_cache_dirs;
+
+ my $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ DATATYPES_CACHE,
+ LIST_FILE);
+ open (FILE, ">$file")
+ or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+
+ # 2-> foreach datatype store 'retrieveObjectDefinition'
+ my $parser = XML::LibXML->new();
+ my $doc = $parser->parse_string($xml);
+
+ my $nodes = $doc->documentElement()->getChildrenByTagName('Object');
+ for (1 .. $nodes->size()) {
+ my $name = $nodes->get_node($_ )->getAttribute('name');
+ my $input =<<END;
+<retrieveObjectDefinition>
+ <objectType>$name</objectType>
+</retrieveObjectDefinition>
+END
+ $xml =
+ $soap->retrieveObjectDefinition ( SOAP::Data->type('string' => "$input") )->result;
+ $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ DATATYPES_CACHE,
+ $name);
+ open (FILE, ">$file") or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+ }
+
+}
+
+#-----------------------------------------------------------------
+# update_datatype_cache
+#-----------------------------------------------------------------
+
+=head2 update_datatype_cache
+
+Update the datatype cache. This will update any items that are 'old',
+by relying on the LSID for the datatype.
+
+Throw an exception if any of the following occur:
+ * A cache to update doesn't exist
+ * There is a SOAP error calling the registry
+ * There were read/write errors on the cache directory or its contents
+
+=cut
+
+sub update_datatype_cache {
+ my ($self) = @_;
+
+ my %old_datatypes = ();
+ my %new_datatypes = ();
+ my @changed_datatypes = ();
+
+ if (!(-e File::Spec->catfile (
+ $self->cachedir,
+ $self->_clean ($self->_endpoint),
+ DATATYPES_CACHE))) {
+ $self->throw("Datatype cache doesn't exist, so I can't update it. Please create a datatype cache first!");
+ }
+
+ # steps:
+ # read in the LIST file and extract lsids for all datatypes
+ my $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ DATATYPES_CACHE,
+ LIST_FILE);
+ my $parser = XML::LibXML->new();
+ my $doc = $parser->parse_file($file);
+ my $nodes = $doc->documentElement()->getChildrenByTagName('Object');
+ for (1 .. $nodes->size()) {
+ my $name = $nodes->get_node($_ )->getAttribute('name');
+ my $lsid = $nodes->get_node($_ )->getAttribute('lsid');
+ $old_datatypes{$name} = $lsid;
+ }
+ # get the new LIST file and extract lsids for all datatypes
+ my $soap =
+ SOAP::Lite->uri($self->_namespace)
+ ->proxy( $self->_endpoint )->on_fault(
+ sub {
+ my $soap = shift;
+ my $res = shift;
+ $self->throw ("There was a problem calling the registry: " . $self->_endpoint . "\@ " . $self->_namespace . ".\n" + $res);
+ }
+ );
+
+ my $xml = $soap->retrieveObjectNames( )->result;
+ $parser = XML::LibXML->new();
+ $doc = $parser->parse_string($xml);
+ $nodes = $doc->documentElement()->getChildrenByTagName('Object');
+ for (1 .. $nodes->size()) {
+ my $name = $nodes->get_node($_ )->getAttribute('name');
+ my $lsid = $nodes->get_node($_ )->getAttribute('lsid');
+ $new_datatypes{$name} = $lsid;
+ }
+ # go through the keys of the new one and if the keys doesnt exist or has been modified, add to 'download' queue
+ foreach my $dt (keys %new_datatypes) {
+ next unless !$old_datatypes{$dt} or $old_datatypes{$dt} ne $new_datatypes{$dt};
+ push @changed_datatypes, $dt;
+ }
+
+ # if their where changes, save new LIST file over the old one and get changes
+ if (scalar @changed_datatypes) {
+ # save new LIST file
+ open (FILE, ">$file")
+ or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+ # clear used values
+ $xml = undef;
+ $file = undef;
+ $parser = undef;
+ $doc = undef;
+ $nodes = undef;
+ foreach my $name (@changed_datatypes) {
+ print "Found modified datatype, '$name', updating ...\n";
+ my $input =<<END;
+<retrieveObjectDefinition>
+ <objectType>$name</objectType>
+</retrieveObjectDefinition>
+END
+ $xml =
+ $soap->retrieveObjectDefinition ( SOAP::Data->type('string' => "$input") )->result;
+ $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ DATATYPES_CACHE,
+ $name);
+ open (FILE, ">$file") or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+ }
+ }
+}
+
+#-----------------------------------------------------------------
+# create_datatype_cache
+#-----------------------------------------------------------------
+
+=head2 create_datatype_cache
+
+Create the datatype cache. This will over write any pre-existing
+cache that it finds.
+
+Throw an exception if something bad happens ... TODO explain this better
+
+=cut
+
+sub create_service_cache {
+ my ($self) = @_;
+
+ # 2 steps:
+ # -> create a LIST file
+ my $soap =
+ SOAP::Lite->uri($self->_namespace)
+ ->proxy( $self->_endpoint )->on_fault(
+ sub {
+ my $soap = shift;
+ my $res = shift;
+ $self->throw ("There was a problem calling the registry: " . $self->_endpoint . "\@ " . $self->_namespace . ".\n" + $res);
+ }
+ );
+
+ my $xml =
+ $soap->retrieveServiceNames( )->result;
+ # create cache dirs as needed
+ $self->create_cache_dirs;
+ my $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ SERVICES_CACHE,
+ LIST_FILE);
+ open (FILE, ">$file")
+ or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+
+ # 2-> foreach datatype store 'findService' on the authority
+ my $parser = XML::LibXML->new();
+ my $doc = $parser->parse_string($xml);
+ my %authorities_completed = ();
+ my $nodes = $doc->documentElement()->getChildrenByTagName('serviceName');
+ for (1 .. $nodes->size()) {
+ my $name = $nodes->get_node($_ )->getAttribute('authURI');
+ next if $authorities_completed{$name};
+ $authorities_completed{$name} = 1;
+ my $input =<<END;
+<findService>
+ <authURI>$name</authURI>
+</findService>
+END
+ $xml =
+ $soap->findService ( SOAP::Data->type('string' => "$input") )->result;
+ $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ SERVICES_CACHE,
+ $name);
+ open (FILE, ">$file") or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+ }
+
+}
+
+#-----------------------------------------------------------------
+# update_service_cache
+#-----------------------------------------------------------------
+
+=head2 update_service_cache
+
+Update the services cache. This will update any items that are 'old',
+by relying on the LSID for the datatype.
+
+Throw an exception if any of the following occur:
+ * A cache to update doesn't exist
+ * There is a SOAP error calling the registry
+ * There were read/write errors on the cache directory or its contents
+
+=cut
+
+sub update_service_cache {
+ my ($self) = @_;
+
+ my %old_services = ();
+ my %new_services = ();
+ my %changed_services = ();
+
+ if (!(-e File::Spec->catfile (
+ $self->cachedir,
+ $self->_clean ($self->_endpoint),
+ SERVICES_CACHE))) {
+ $self->throw("Services cache doesn't exist, so I can't update it. Please create a services cache first!");
+ }
+
+ # steps:
+ # read in the LIST file and extract lsids for all datatypes
+ my $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ SERVICES_CACHE,
+ LIST_FILE);
+ my $parser = XML::LibXML->new();
+ my $doc = $parser->parse_file($file);
+ my $nodes = $doc->documentElement()->getChildrenByTagName('serviceName');
+ for (1 .. $nodes->size()) {
+ my $name = $nodes->get_node($_ )->getAttribute('authURI');
+ my $lsid = $nodes->get_node($_ )->getAttribute('lsid');
+ $old_services{$name}{$lsid} = 1;
+ }
+ # get the new LIST file and extract lsids for all datatypes
+ my $soap =
+ SOAP::Lite->uri($self->_namespace)
+ ->proxy( $self->_endpoint )->on_fault(
+ sub {
+ my $soap = shift;
+ my $res = shift;
+ $self->throw ("There was a problem calling the registry: " . $self->_endpoint . "\@ " . $self->_namespace . ".\n" + $res);
+ }
+ );
+
+ my $xml = $soap->retrieveServiceNames( )->result;
+ $parser = XML::LibXML->new();
+ $doc = $parser->parse_string($xml);
+ $nodes = $doc->documentElement()->getChildrenByTagName('serviceName');
+ for (1 .. $nodes->size()) {
+ my $name = $nodes->get_node($_ )->getAttribute('authURI');
+ my $lsid = $nodes->get_node($_ )->getAttribute('lsid');
+ $new_services{$name}{$lsid} = 1;
+ }
+ # go through the keys of the new one and if the keys doesnt exist or has been modified, add to 'download' queue
+ foreach my $auth (keys %new_services) {
+ next if $changed_services{$auth};
+ foreach my $lsid (keys %{$new_services{$auth}}) {
+ next unless !$old_services{$auth}{$lsid};
+ $changed_services{$auth} = 1;
+ }
+
+ }
+
+ # if their where changes, save new LIST file over the old one and get changes
+ if (keys %changed_services) {
+ # save new LIST file
+ open (FILE, ">$file")
+ or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+ # clear used values
+ $xml = undef;
+ $file = undef;
+ $parser = undef;
+ $doc = undef;
+ $nodes = undef;
+ foreach my $authURI (keys %changed_services) {
+ my $input =<<END;
+<findService>
+ <authURI>$authURI</authURI>
+</findService>
+END
+ $xml =
+ $soap->findService ( SOAP::Data->type('string' => "$input") )->result;
+ $file = File::Spec->catfile ($self->cachedir,
+ $self->_clean ($self->_endpoint),
+ SERVICES_CACHE,
+ $authURI);
+ open (FILE, ">$file") or $self->throw ("Can't open file '$file' for writing: $!");
+ print FILE $xml;
+ close FILE;
+ }
+ }
+}
+
+#-----------------------------------------------------------------
# _createDataTypeFromXML
# given xmlString, build a MOSES::MOBY::Def::DataType
#-----------------------------------------------------------------
@@ -807,5 +1180,38 @@
}
+#-----------------------------------------------------------------
+# cache_exists
+#-----------------------------------------------------------------
+
+=head2 create_cache_dirs
+
+Creates the cache directories needed for generating datatypes and services.
+
+Throws an exception if there are problems creating the directories.
+
+=cut
+
+sub create_cache_dirs {
+ my ($self)= @_;
+ my @dirs = (
+ File::Spec->catfile ($self->cachedir,$self->_clean ($self->_endpoint),DATATYPES_CACHE),
+ File::Spec->catdir ($self->cachedir,$self->_clean ($self->_endpoint),SERVICES_CACHE),
+ File::Spec->catdir ($self->cachedir,$self->_clean ($self->_endpoint),NAMESPACES_CACHE),
+ File::Spec->catdir ($self->cachedir,$self->_clean ($self->_endpoint),SERVICETYPES_CACHE),
+ );
+
+ foreach my $file (@dirs) {
+ my ($v, $d, $f) = File::Spec->splitpath( $file );
+ my $dir = File::Spec->catdir($v);
+ foreach my $part ( File::Spec->splitdir( ($d.$f ) ) ) {
+ $dir = File::Spec->catdir($dir, $part);
+ next if -d $dir or -e $dir;
+ mkdir( $dir ) || $self->throw("Error creating caching directory '".$dir."':\n$!");
+ }
+ }
+}
+
+
1;
__END__
More information about the MOBY-guts
mailing list