view release on metacpan or  search on metacpan

lib/MOSES/MOBY/Cache/Central.pm  view on Meta::CPAN

				}
			  );

	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;
    
    $LOG->debug("Saving the '". LIST_FILE . "' 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
		$LOG->debug("Processing the datatype, '$name'.");
		$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!");
	}
   if (!(-e File::Spec->catfile (
   					$self->cachedir,
				    $self->_clean ($self->_endpoint),
				    DATATYPES_CACHE,
				    LIST_FILE))) {
		$self->throw("Datatypes LIST_FILE doesn't exist, so I can't update the cache. Please create a datatype cache first!");
	}
    # steps:
    # read in the LIST file and extract lsids for all datatypes
    $LOG->debug("Reading the cached '" . LIST_FILE ."'.");
    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;
    }
    $LOG->debug("Retrieving an up to date '". LIST_FILE ."'.");
    # 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;
   		$LOG->debug("The datatype, '$dt', seems to have been modified.");

lib/MOSES/MOBY/Cache/Central.pm  view on Meta::CPAN

					$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!");
	}
	
	if (!(-e File::Spec->catfile (
   					$self->cachedir,
				    $self->_clean ($self->_endpoint),
				    SERVICES_CACHE,
				    LIST_FILE))) {
		$self->throw("Services LIST_FILE doesn't exist, so I can't update the cache. 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};