#-----------------------------------------------------------------
# MOSES::MOBY::Cache::Registries
# Author: Martin Senger <martin.senger@gmail.com>
# For copyright and disclaimer see below.
#
# $Id: Registries.pm,v 1.4 2008/04/29 19:29:54 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.4 $ =~ /: (\d+)\.(\d+)/;

#-----------------------------------------------------------------
# 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.
#
#-----------------------------------------------------------------

my %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://bioinfo.icapture.ubc.ca/cgi-bin/mobycentral/MOBY-Central.pl',
		    namespace => 'http://bioinfo.icapture.ubc.ca/MOBY/Central',
		    name      => 'Testing BioMoby registry',
		    contact   => 'Edward Kawas (edward.kawas@gmail.com)',
		    public    => 'yes',
		},
      );

$REGISTRIES{default} = $REGISTRIES{iCAPTURE};

#-----------------------------------------------------------------
# init
#-----------------------------------------------------------------
sub init {
    my $self = shift;
    my %cloned = %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 $cloned{$key};
					$cloned{$key} = $USER_REGISTRIES{$key}
				}
			}
	};
	unshift @INC, "/make/believe" if $@;
    $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__

=head1 NAME

MOSES::MOBY::Cache::Registries - List of known BioMoby registries

=head1 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;
  

=head1 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 C<add()> method).

=head1 SUBROUTINES

All subroutines can be called as object or class methods unless you plan 
on using the C<add()> method. In that case, make sure to use class methods.

=head2 list

   my @regs = MOSES::MOBY::Cache::Registries->list;

Return a list of synonyms (abbreviations) of all available
registries. At least a synonym C<default> is always present. The
synonyms can be used in the C<get> method.

=head2 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 C<get> method to retrieve the registry.

=head2 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

=head2 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 C<list> method.

Returned hash can contain the following keys:

=over

=item * endpoint

Value is an endpoint (a stringified URL) of this BioMoby registry.

=item * namespace

Value is a namespace (a URI) used by this registry.

=item * name

Value is a full-name of this registry. Often accompanied with the
geographical location.

=item * contact

Value is a contact person, perhaps with en email, who is in charge of
this registry.

=item * public

Indicate (by value 'yes') that this registry is publicly available.

=item * text

A human-readable description explaining reasons, sometimes policies,
of this registry.

=back

=head2 all

   my $regs = MOSES::MOBY::Cache::Registries->all;

Return a hash reference with details about all registries. It is the
same as calling C<get> for all individual entries.

=head1 AUTHORS

 Martin Senger (martin.senger [at] gmail [dot] com)
 Edward Kawas (edward.kawas [at] gmail [dot] com)

=cut

