MOSES::MOBY::Cache::Registries - List of known BioMoby registries
Index
Code Index:
NAME
MOSES::MOBY::Cache::Registries - List of known BioMoby registries
SYNOPSIS
use MOSES::MOBY::Cache::Registries;
# print synonyms of all available registries
print "Available registries: ",
join (", ", MOSES::MOBY::Cache::Registries->list);
# print all features of a selected registry
my $regs = new MOSES::MOBY::Cache::Registries;
my %reg = $regs->get ('IRRI');
foreach $key (sort keys $reg) {
print "$key: $reg{$key}\n";
}
# add a new user defined (localhost) registry
my $success = MOSES::MOBY::Cache::Registries->add(
endpoint => 'http://localhost/cgi-bin/MOBY/MOBY-Central.pl',
namespace => 'http://localhost/MOBY/Central',
name => 'My Localhost registry',
contact => 'Edward Kawas (edward.kawas@gmail.com)',
public => 'yes',
text => 'A curated private registry hosted right here on this cpu',
synonym => 'my_new_reg',);
print "Registry added!" if $success == 1;
print "Registry not added to persistent store! Unknown error. Please check the log file." if $success == 0;
print "Registry not added! Please check the parameters." if $success == -1;
print "Registry not added! It may be already defined or synonym is in use."
if $success == -2;
DESCRIPTION
A list of known BioMoby registries is hard coded here, and their
characteristics (such as their endpoints) can be retrieved by a
user-friendly synonym.
There is not that many registries, so there is (at the moment) no
intention to retrieve details from a database. Hard-coded entries seem
to be sufficient (if you create a new BioMoby registry, then make sure
to add the registry to this list by either editing the list (persistent)
or by programatically using the add() method).
SUBROUTINES
All subroutines can be called as object or class methods unless you plan
on using the add() method. In that case, make sure to use class methods.
list
my @regs = MOSES::MOBY::Cache::Registries->list;
Return a list of synonyms (abbreviations) of all available
registries. At least a synonym default is always present. The
synonyms can be used in the get method.
add
my $regs = new MOSES::MOBY::Cache::Registries;
print "Success!" if $reg->add(%details) == 1;
Add a registry to the list. This method consumes a hash
with the following keys:
synonym - a short name for the registry
name - a human readable textual name of the reg
endpoint - the endpoint to the registry
namespace - the registry URI
text - a human readable textual description for the reg
public - is this a public registry? [yes | no]
contact - contact information for the registry
force - if the registry synonym is in use, overwrite it
Returns:
1 on success (add to persistent store and in memory object)
0 failure to add persistent store, for other non life threatening reasons (like incomplete config file, etc)- check log file
-1 failure if there are bad parameters
-2 failure if the registry already exists or synonym in use
The synonym can be used in the get method to retrieve the registry.
remove
my $regs = new MOSES::MOBY::Cache::Registries;
print "Success!" if $reg->remove($name) == 1;
Removes a registry from the list. This method consumes a
the name of a registry to remove
Returns:
1 on success (remove from persistent store and in memory object)
0 failure to remove from persistent store, for other non life threatening reasons (like incomplete config file, etc)- check log file
get
my %reg = MOSES::MOBY::Cache::Registries->get ('IRRI');
my %reg = MOSES::MOBY::Cache::Registries->get;
Return a hash with details about a registry whose abbreviation was
given as an argument. No argument is the same as 'default'. The known
synonyms can be obtained by list method.
Returned hash can contain the following keys:
- * endpoint
-
Value is an endpoint (a stringified URL) of this BioMoby registry.
- * namespace
-
Value is a namespace (a URI) used by this registry.
- * name
-
Value is a full-name of this registry. Often accompanied with the
geographical location.
- * contact
-
Value is a contact person, perhaps with en email, who is in charge of
this registry.
- * public
-
Indicate (by value 'yes') that this registry is publicly available.
- * text
-
A human-readable description explaining reasons, sometimes policies,
of this registry.
all
my $regs = MOSES::MOBY::Cache::Registries->all;
Return a hash reference with details about all registries. It is the
same as calling get for all individual entries.
AUTHORS
Martin Senger (martin.senger [at] gmail [dot] com)
Edward Kawas (edward.kawas [at] gmail [dot] com)
#-----------------------------------------------------------------
# MOSES::MOBY::Cache::Registries
# Author: Martin Senger <martin.senger@gmail.com>
# For copyright and disclaimer see below.
#
# $Id: Registries.pm,v 1.6 2009/08/19 17:07:26 kawas Exp $
#-----------------------------------------------------------------
package MOSES::MOBY::Cache::Registries;
use MOSES::MOBY::Base;
use base qw ( MOSES::MOBY::Base);
use strict;
# add versioning to this module
use vars qw /$VERSION/;
$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /: (\d+)\.(\d+)/;
use vars qw/ %REGISTRIES /;
BEGIN {
our (%REGISTRIES);
my $already_init = 0;
sub is_init {
return $already_init++;
}
sub init_reg {
#-----------------------------------------------------------------
# A hard-coded list of the known registries.
#
# Please fill all details if you are adding new registry here.
#
# Do not create synonyms starting with 'http://' (they are in the
# roles of the hash keys) - this is how some methods distinguish
# between synonym and endpoint.
#
#-----------------------------------------------------------------
%REGISTRIES = (
iCAPTURE => {
endpoint => 'http://moby.ucalgary.ca/moby/MOBY-Central.pl',
namespace => 'http://moby.ucalgary.ca/MOBY/Central',
name => 'Sun Centre of Excellence, Calgary',
contact => 'Edward Kawas (edward.kawas@gmail.com)',
public => 'yes',
text => 'A curated public registry hosted at U of C, Calgary',
},
IRRI => {
endpoint => 'http://cropwiki.irri.org/cgi-bin/MOBY-Central.pl',
namespace => 'http://cropwiki.irri.org/MOBY/Central',
name => 'IRRI, Philippines',
contact => 'Mylah Rystie Anacleto (m.anacleto@cgiar.org)',
public => 'yes',
text => 'The MOBY registry at the International Rice Research Institute (IRRI) is intended mostly for Generation Challenge Program (GCP) developers. It allows the registration of experimental moby entities within GCP.',
},
testing => {
endpoint => 'http://mobytest.biordf.net/MOBY-Central.pl',
namespace => 'http://mobytest.biordf.net/MOBY/Central',
name => 'Testing BioMoby registry',
contact => 'Edward Kawas (edward.kawas+testregistry@gmail.com)',
public => 'yes',
},
);
# create a default registry
$REGISTRIES{default} = $REGISTRIES{iCAPTURE};
# read from config file user registries
# add user_registries
eval {
do {
# is this the best way?
use lib $MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_DIR
|| "/make/believe";
use vars qw( %USER_REGISTRIES );
require $MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_FILENAME
if defined $MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_FILENAME;
foreach my $key ( sort keys %USER_REGISTRIES ) {
# script if key exists
next if exists $REGISTRIES{$key};
$REGISTRIES{$key} = $USER_REGISTRIES{$key};
}
}
};
unshift @INC, "/make/believe" if $@;
}
}
#-----------------------------------------------------------------
# init
#-----------------------------------------------------------------
sub init {
my $self = shift;
init_reg() unless is_init();
my %cloned = %REGISTRIES;
$self->{registries} = \%cloned;
}
#-----------------------------------------------------------------
# list
#-----------------------------------------------------------------
sub list {
my $self = shift;
return sort keys %{ $self->{registries} } if ref $self;
# do this so that we can get user defined registries
return MOSES::MOBY::Cache::Registries->new()->list();
}
#-----------------------------------------------------------------
# get
#-----------------------------------------------------------------
sub get {
my ( $self, $abbrev ) = @_;
$abbrev ||= 'default';
return $self->{registries}->{$abbrev} if ref $self;
# do this so that we can get user defined registries
return MOSES::MOBY::Cache::Registries->new()->get($abbrev);
}
#-----------------------------------------------------------------
# all
#-----------------------------------------------------------------
sub all {
my $self = shift;
return $self->{registries} if ref $self;
# do this so that we can get user defined registries
return MOSES::MOBY::Cache::Registries->new()->all;
}
#-----------------------------------------------------------------
# add
#-----------------------------------------------------------------
sub add {
my ( $self, %reg ) = @_;
# add using object methods ...
return MOSES::MOBY::Cache::Registries->new()->add(%reg) unless ref $self;
# check for force
my $force = exists $reg{force};
# check %reg hash for conformance and existance
return -1
unless defined $reg{namespace}
and defined $reg{endpoint}
and defined $reg{synonym}
and defined $reg{text}
and defined $reg{name}
and defined $reg{contact}
and defined $reg{public};
$reg{public} = 'yes'
unless $reg{public} eq 'yes' || $reg{public} eq 'no';
return -1
if $reg{synonym} =~ m"^http://";
return -2
unless ( ( not defined $self->{registries}->{ $reg{synonym} } )
or $force );
# call update ...
do {
eval { $self->_update_user_registries(%reg); };
$LOG->warn("Error updating user registries: $@")
if ( $LOG->is_warn )
and $@;
# return 0 if $@; # removed because we should be able to
#update $self->{registries}
$self->{registries}->{ $reg{synonym} } = {
endpoint => $reg{endpoint},
namespace => $reg{namespace},
name => $reg{name},
contact => $reg{contact},
public => $reg{public},
text => $reg{text},
};
# return success
return 0 if $@;
return 1;
} if ref $self;
}
#-----------------------------------------------------------------
# remove
#-----------------------------------------------------------------
sub remove {
my ( $self, $name ) = @_;
# add using object methods ...
return MOSES::MOBY::Cache::Registries->new()->remove($name)
unless ref $self;
return 1 unless defined $self->{registries}->{$name};
# do the remove
do {
eval {
# remove from file
my %args = ( # some default values
user_reg_dir =>
( $MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_DIR || '' ),
user_reg_table => (
$MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_FILENAME
|| 'USER_REGISTRIES'
),
);
die
"Couldn't find the location to 'USER_REGISTRIES' in the configuration file!"
if $args{user_reg_dir} eq '';
# read the current user registry table
unshift( @INC, $args{user_reg_dir} )
; # place where USER_REGISTRIES could be
use vars qw ( %USER_REGISTRIES );
eval { require $args{user_reg_table} };
my $file_with_table;
if ($@) {
$LOG->warn( "Cannot find table of USER_REGISTRIES '"
. $args{user_reg_table}
. "': $@" );
$file_with_table = File::Spec->catfile( $args{user_reg_dir},
$args{user_reg_table} );
} else {
$file_with_table = $INC{ $args{user_reg_table} };
}
# remove from user regs table
delete $USER_REGISTRIES{$name};
# ...and write it back to a disk
require Data::Dumper;
open DISPATCH, ">$file_with_table"
or
$self->throw("Cannot open for writing '$file_with_table': $!\n");
print DISPATCH Data::Dumper->Dump( [ \%USER_REGISTRIES ],
['*USER_REGISTRIES'] )
or $self->throw("cannot write to '$file_with_table': $!\n");
close DISPATCH;
$LOG->info(
"\nUpdated user reg table '$file_with_table'. New contents:\n"
. $self->toString( \%USER_REGISTRIES ) );
};
$LOG->warn("Error removing user registries: $@")
if ( $LOG->is_warn )
and $@;
#update $self->{registries}
delete $self->{registries}->{$name};
# could remove from persistent store
return 0 if $@;
# return success
return 1;
} if ref $self;
}
#-----------------------------------------------------------------
# _update_user_registries
#-----------------------------------------------------------------
sub _update_user_registries {
my ( $self, @args ) = @_;
my %args = ( # some default values
user_reg_dir => ( $MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_DIR || '' ),
user_reg_table => (
$MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_FILENAME
|| 'USER_REGISTRIES'
),
# and the real parameters
@args
);
die
"Couldn't find the location to 'USER_REGISTRIES' in the configuration file!"
if $args{user_reg_dir} eq '';
# check %args for the right parameters, endpoint, namespace, name, synonym, contact, text, public
die "Arguments to update user registries are incomplete."
unless defined $args{namespace}
and defined $args{endpoint}
and defined $args{synonym}
and defined $args{text}
and defined $args{name}
and defined $args{contact}
and defined $args{public};
die "Registry synonyms should not start with http ..."
if $args{synonym} =~ m"^http://";
my $outdir = File::Spec->rel2abs( $args{user_reg_dir} );
$LOG->debug( "Arguments for generating user registries table: "
. $self->toString( \%args ) )
if ( $LOG->is_debug );
# read the current user registry table
unshift( @INC, $args{user_reg_dir} ); # place where USER_REGISTRIES could be
use vars qw ( %USER_REGISTRIES );
eval { require $args{user_reg_table} };
my $file_with_table;
if ($@) {
$LOG->warn( "Cannot find table of USER_REGISTRIES '"
. $args{user_reg_table}
. "': $@" );
$file_with_table =
File::Spec->catfile( $args{user_reg_dir}, $args{user_reg_table} );
} else {
$file_with_table = $INC{ $args{user_reg_table} };
}
# update user regs table
$USER_REGISTRIES{ $args{synonym} } = {
endpoint => $args{endpoint},
namespace => $args{namespace},
name => $args{name},
contact => $args{contact},
public => $args{public},
text => $args{text},
};
# ...and write it back to a disk
require Data::Dumper;
open DISPATCH, ">$file_with_table"
or $self->throw("Cannot open for writing '$file_with_table': $!\n");
print DISPATCH Data::Dumper->Dump( [ \%USER_REGISTRIES ],
['*USER_REGISTRIES'] )
or $self->throw("cannot write to '$file_with_table': $!\n");
close DISPATCH;
$LOG->info( "\nUpdated user reg table '$file_with_table'. New contents:\n"
. $self->toString( \%USER_REGISTRIES ) );
}
1;
__END__