lib/MOBY/Client/OntologyServer.pm

   1 #$Id: OntologyServer.pm,v 1.15 2005/11/22 21:33:23 mwilkinson Exp $
   2
   3 =head1 NAME
   4
   5 MOBY::Client::OntologyServer - A client interface to the Ontology
   6 Server at MOBY Central
   7
   8 =cut
   9
  10 =head1 SYNOPSIS
  11
  12  use MOBY::Client::OntologyServer;
  13  my $OS = MOBY::Client::OntologyServer->new();
  14
  15  my ($success, $message, $existingURI) = $OS->objectExists(term => "Object");
  16  my ($success, $message, $existingURI) = $OS->serviceExists(term => "Retrieval");
  17  my ($success, $message, $existingURI) = $OS->namespaceExists(term => "NCBI_gi");
  18  my ($success, $message, $existingURI) = $OS->relationshipExists(term => "ISA");
  19
  20  if ($success){
  21      print "object exists and it has the LSID $existingURI\n";
  22  } else {
  23     print "object does not exist; additional message from server: $message\n";
  24  }
  25
  26
  27 =cut
  28
  29 =head1 DESCRIPTION
  30
  31 This module is used primarily as a way of dealing with the
  32 flexibility MOBY allows in the use of "common" names
  33 versus LSID's.  Calling the ontology server using this
  34 module will return the LSID of whatever it is you send it,
  35 even if you send the LSID itself.  As such, you can now simply
  36 filter your terms through the ontologyserver and know that
  37 what is returned will be an LSID, and skip the checking step
  38 yourself.
  39
  40
  41 =head1 PROXY SERVERS
  42
  43 If your site uses a proxy server, simply set the environment variable
  44 MOBY_PROXY=http://your.proxy.server/address
  45
  46 =cut
  47
  48 =head1 AUTHORS
  49
  50
  51 Mark Wilkinson (markw at illuminae.com)
  52 Nina Opushneva (opushneva at yahoo.ca)
  53
  54 BioMOBY Project:  http://www.biomoby.org
  55
  56
  57 =cut
  58
  59 =head1 METHODS
  60
  61
  62 =head2 new
  63
  64  Title     :    new
  65  Usage     :    my $OS = MOBY::OntologyServer->new(%args)
  66  Function  :
  67  Returns   :    MOBY::OntologyServer object
  68  Args      :    host =>  URL to ontolgy_server script (default http://mobycentral.cbr.nrc.ca/cgi-bin/OntologyServer.cgi)
  69                 proxy => URL to an HTTP proxy server if necessarray (optional)
  70
  71 =cut
  72
  73 package MOBY::Client::OntologyServer;
  74 use strict;
  75 use Carp;
  76 use vars qw($AUTOLOAD);
  77 use LWP::UserAgent;
  78 my $debug = 0;
  79 {
  80
  81         #Encapsulated class data
  82         #___________________________________________________________
  83         #ATTRIBUTES
  84         my %_attr_data =    #                                   DEFAULT         ACCESSIBILITY
  85           (
  86                 host => [
  87                                   "http://mobycentral.icapture.ubc.ca/cgi-bin/OntologyServer.cgi",
  88                                   'read/write'
  89                 ],
  90                 proxy => [ undef, 'read/write' ],
  91           );
  92
  93         #_____________________________________________________________
  94         # METHODS, to operate on encapsulated class data
  95         # Is a specified object attribute accessible in a given mode
  96         sub _accessible {
  97                 my ( $self, $attr, $mode ) = @_;
  98                 $_attr_data{$attr}[1] =~ /$mode/;
  99         }
 100
 101         # Classwide default value for a specified object attribute
 102         sub _default_for {
 103                 my ( $self, $attr ) = @_;
 104                 $_attr_data{$attr}[0];
 105         }
 106
 107         # List of names of all specified object attributes
 108         sub _standard_keys {
 109                 keys %_attr_data;
 110         }
 111 }
 112
 113 sub new {
 114         my ( $caller, %args ) = @_;
 115         my $caller_is_obj = ref( $caller );
 116         my $class         = $caller_is_obj || $caller;
 117         my $self          = bless {}, $class;
 118         foreach my $attrname ( $self->_standard_keys ) {
 119                 if ( exists $args{$attrname} && defined $args{$attrname} ) {
 120                         $self->{$attrname} = $args{$attrname};
 121                 } elsif ( $caller_is_obj ) {
 122                         $self->{$attrname} = $caller->{$attrname};
 123                 } else {
 124                         $self->{$attrname} = $self->_default_for( $attrname );
 125                 }
 126         }
 127         $self->host($ENV{MOBY_ONTOLOGYSERVER}) if ($ENV{MOBY_ONTOLOGYSERVER});
 128         return undef unless $self->host;
 129         return $self;
 130 }
 131
 132 =head2 objectExists
 133
 134 =cut
 135
 136 sub objectExists {
 137         my ( $self, %args ) = @_;
 138         my $term = $args{'term'};
 139         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 140         my $ua = $self->getUserAgent;
 141         my $req = HTTP::Request->new( POST => $self->host );
 142         $req->content( "objectExists=$term" );
 143         my $res = $ua->request( $req );
 144         if ( $res->is_success ) {
 145                 return split "\n", $res->content;
 146         } else {
 147                 return ( 0, "Request Failed for unknown reasons", "" );
 148         }
 149 }
 150
 151 =head2 serviceExists
 152
 153 =cut
 154
 155 sub serviceExists {
 156         my ( $self, %args ) = @_;
 157         my $term = $args{'term'};
 158         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 159         my $ua = $self->getUserAgent;
 160         my $req = HTTP::Request->new( POST => $self->host );
 161         $req->content( "serviceExists=$term" );
 162         my $res = $ua->request( $req );
 163         if ( $res->is_success ) {
 164                 return split "\n", $res->content;
 165         } else {
 166                 return ( 0, "Request Failed for unknown reasons", "" );
 167         }
 168 }
 169
 170 =head2 namespaceExists
 171
 172 =cut
 173
 174 sub namespaceExists {
 175         my ( $self, %args ) = @_;
 176         my $term = $args{'term'};
 177         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 178         my $ua = $self->getUserAgent;
 179         my $req = HTTP::Request->new( POST => $self->host );
 180         $req->content( "namespaceExists=$term" );
 181         my $res = $ua->request( $req );
 182         if ( $res->is_success ) {
 183                 return split "\n", $res->content;
 184         } else {
 185                 return ( 0, "Request Failed for unknown reasons", "" );
 186         }
 187 }
 188
 189 =head2 relationshipExists
 190
 191 =cut
 192
 193 sub relationshipExists {
 194         my ( $self, %args ) = @_;
 195         my $term = $args{'term'};
 196         my $ontology = $args{'ontology'};
 197         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 198         my $ua = $self->getUserAgent;
 199         my $req = HTTP::Request->new( POST => $self->host );
 200         $req->content( "relationshipExists=$term&ontology=$ontology" );
 201         my $res = $ua->request( $req );
 202         if ( $res->is_success ) {
 203                 return split "\n", $res->content;
 204         } else {
 205                 return ( 0, "Request Failed for unknown reasons", "" );
 206         }
 207 }
 208
 209 sub getUserAgent {
 210         my ( $self, @args ) = @_;
 211         my $ua    = LWP::UserAgent->new;
 212         my $proxy = $ENV{MOBY_PROXY}
 213           if $ENV{MOBY_PROXY};    # first check the environment
 214         $proxy = $self->proxy
 215           if $self->proxy
 216           ; # but if the object was initialized with a proxy argument then use that instead
 217         if ( $proxy ) {
 218                 $ua->proxy( 'http', $proxy );
 219         }
 220         return $ua;
 221 }
 222 sub DESTROY { }
 223
 224 sub AUTOLOAD {
 225         no strict "refs";
 226         my ( $self, $newval ) = @_;
 227         $AUTOLOAD =~ /.*::(\w+)/;
 228         my $attr = $1;
 229         if ( $self->_accessible( $attr, 'write' ) ) {
 230                 *{$AUTOLOAD} = sub {
 231                         if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
 232                         return $_[0]->{$attr};
 233                 };    ### end of created subroutine
 234 ###  this is called first time only
 235                 if ( defined $newval ) {
 236                         $self->{$attr} = $newval;
 237                 }
 238                 return $self->{$attr};
 239         } elsif ( $self->_accessible( $attr, 'read' ) ) {
 240                 *{$AUTOLOAD} = sub {
 241                         return $_[0]->{$attr};
 242                 };    ### end of created subroutine
 243                 return $self->{$attr};
 244         }
 245
 246         # Must have been a mistake then...
 247         croak "No such method: $AUTOLOAD";
 248 }
 249 1;