Bio/Annotation/DBLink.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Annotation::DBLink
   4 #
   5 # Cared for by Ewan Birney <birney@ebi.ac.uk>
   6 #
   7 # Copyright Ewan Birney
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::Annotation::DBLink - untyped links between databases
  16
  17 =head1 SYNOPSIS
  18
  19    $link1 = Bio::Annotation::DBLink->new(-database => 'TSC',
  20                                         -primary_id => 'TSC0000030'
  21                                         );
  22
  23    #or
  24
  25    $link2 = Bio::Annotation::DBLink->new();
  26    $link2->database('dbSNP');
  27    $link2->primary_id('2367');
  28
  29    # DBLink is-a Bio::AnnotationI object, can be added to annotation
  30    # collections, e.g. the one on features or seqs
  31    $feat->annotation->add_Annotation('dblink', $link2);
  32
  33
  34 =head1 DESCRIPTION
  35
  36 Provides an object which represents a link from one object to something
  37 in another database without prescribing what is in the other database.
  38
  39 Aside from L<Bio::AnnotationI>, this class also implements
  40 L<Bio::IdentifiableI>.
  41
  42 =head1 AUTHOR - Ewan Birney
  43
  44 Ewan Birney - birney@ebi.ac.uk
  45
  46 =head1 APPENDIX
  47
  48 The rest of the documentation details each of the object
  49 methods. Internal methods are usually preceded with a _
  50
  51 =cut
  52
  53
  54 # Let the code begin...
  55
  56 package Bio::Annotation::DBLink;
  57 use strict;
  58
  59 use base qw(Bio::Root::Root Bio::AnnotationI Bio::IdentifiableI);
  60
  61
  62 =head2 new
  63
  64  Title   : new
  65  Usage   : $dblink = Bio::Annotation::DBLink->new(-database =>"GenBank",
  66                                                   -primary_id => "M123456");
  67  Function: Creates a new instance of this class.
  68  Example :
  69  Returns : A new instance of Bio::Annotation::DBLink.
  70  Args    : Named parameters. At present, the following parameters are
  71            recognized.
  72
  73              -database    the name of the database referenced by the xref
  74              -primary_id  the primary (main) id of the referenced entry
  75                           (usually this will be an accession number)
  76              -optional_id a secondary ID under which the referenced entry
  77                           is known in the same database
  78              -comment     comment text for the dbxref
  79              -tagname     the name of the tag under which to add this
  80                           instance to an annotation bundle (usually 'dblink')
  81              -namespace   synonymous with -database (also overrides)
  82              -version     version of the referenced entry
  83              -authority   attribute of the Bio::IdentifiableI interface
  84              -url         attribute of the Bio::IdentifiableI interface
  85
  86 =cut
  87
  88 sub new {
  89   my($class,@args) = @_;
  90
  91   my $self = $class->SUPER::new(@args);
  92
  93   my ($database,$primary_id,$optional_id,$comment,$tag,$ns,$auth,$v,$url) =
  94       $self->_rearrange([qw(DATABASE
  95                             PRIMARY_ID
  96                             OPTIONAL_ID
  97                             COMMENT
  98                             TAGNAME
  99                             NAMESPACE
 100                             AUTHORITY
 101                             VERSION
 102                             URL
 103                             )], @args);
 104
 105   $database    && $self->database($database);
 106   $primary_id  && $self->primary_id($primary_id);
 107   $optional_id && $self->optional_id($optional_id);
 108   $comment     && $self->comment($comment);
 109   $tag         && $self->tagname($tag);
 110   # Bio::IdentifiableI parameters:
 111   $ns          && $self->namespace($ns); # this will override $database
 112   $auth        && $self->authority($auth);
 113   defined($v)  && $self->version($v);
 114   defined($url)  && $self->url($url);
 115
 116   return $self;
 117 }
 118
 119 =head1 AnnotationI implementing functions
 120
 121 =cut
 122
 123
 124 =head2 as_text
 125
 126  Title   : as_text
 127  Usage   :
 128  Function:
 129  Example :
 130  Returns :
 131  Args    :
 132
 133
 134 =cut
 135
 136 sub as_text{
 137    my ($self) = @_;
 138
 139    return "Direct database link to ".$self->primary_id
 140        .($self->version ? ".".$self->version : "")
 141        .($self->optional_id ? " (".$self->optional_id.")" : "")
 142        ." in database ".$self->database;
 143 }
 144
 145 =head2 display_text
 146
 147  Title   : display_text
 148  Usage   : my $str = $ann->display_text();
 149  Function: returns a string. Unlike as_text(), this method returns a string
 150            formatted as would be expected for te specific implementation.
 151
 152            One can pass a callback as an argument which allows custom text
 153            generation; the callback is passed the current instance and any text
 154            returned
 155  Example :
 156  Returns : a string
 157  Args    : [optional] callback
 158
 159 =cut
 160
 161 {
 162   my $DEFAULT_CB = sub { (($_[0]->database ? $_[0]->database . ':' : '' ) .
 163                           ($_[0]->primary_id ? $_[0]->primary_id : '') .
 164                           ($_[0]->version ? '.' . $_[0]->version : '')) || '' };
 165
 166   sub display_text {
 167     my ($self, $cb) = @_;
 168     $cb ||= $DEFAULT_CB;
 169     $self->throw("") if ref $cb ne 'CODE';
 170     return $cb->($self);
 171   }
 172
 173 }
 174
 175 =head2 hash_tree
 176
 177  Title   : hash_tree
 178  Usage   :
 179  Function:
 180  Example :
 181  Returns :
 182  Args    :
 183
 184
 185 =cut
 186
 187 sub hash_tree{
 188    my ($self) = @_;
 189
 190    my $h = {};
 191    $h->{'database'}   = $self->database;
 192    $h->{'primary_id'} = $self->primary_id;
 193    if( defined $self->optional_id ) {
 194        $h->{'optional_id'} = $self->optional_id;
 195    }
 196    if( defined $self->comment ) {
 197        # we know that comments have hash_tree methods
 198        $h->{'comment'} = $self->comment;
 199    }
 200
 201    return $h;
 202 }
 203
 204 =head2 tagname
 205
 206  Title   : tagname
 207  Usage   : $obj->tagname($newval)
 208  Function: Get/set the tagname for this annotation value.
 209
 210            Setting this is optional. If set, it obviates the need to
 211            provide a tag to Bio::AnnotationCollectionI when adding
 212            this object. When obtaining an AnnotationI object from the
 213            collection, the collection will set the value to the tag
 214            under which it was stored unless the object has a tag
 215            stored already.
 216
 217  Example :
 218  Returns : value of tagname (a scalar)
 219  Args    : new value (a scalar, optional)
 220
 221
 222 =cut
 223
 224 sub tagname{
 225     my $self = shift;
 226
 227     return $self->{'tagname'} = shift if @_;
 228     return $self->{'tagname'};
 229 }
 230
 231 =head1 Specific accessors for DBLinks
 232
 233 =cut
 234
 235 =head2 database
 236
 237  Title   : database
 238  Usage   : $self->database($newval)
 239  Function: set/get on the database string. Databases are just
 240            a string here which can then be interpreted elsewhere
 241  Example :
 242  Returns : value of database
 243  Args    : newvalue (optional)
 244
 245 =cut
 246
 247 sub database{
 248     my $self = shift;
 249
 250     return $self->{'database'} = shift if @_;
 251     return $self->{'database'};
 252 }
 253
 254 =head2 primary_id
 255
 256  Title   : primary_id
 257  Usage   : $self->primary_id($newval)
 258  Function: set/get on the primary id (a string)
 259            The primary id is the main identifier used for this object in
 260            the database. Good examples would be accession numbers. The id
 261            is meant to be the main, stable identifier for this object
 262  Example :
 263  Returns : value of primary_id
 264  Args    : newvalue (optional)
 265
 266 =cut
 267
 268 sub primary_id{
 269     my $self = shift;
 270
 271     return $self->{'primary_id'} = shift if @_;
 272     return $self->{'primary_id'};
 273 }
 274
 275 =head2 optional_id
 276
 277  Title   : optional_id
 278  Usage   : $self->optional_id($newval)
 279  Function: get/set for the optional_id (a string)
 280
 281            optional id is a slot for people to use as they wish. The
 282            main issue is that some databases do not have a clean
 283            single string identifier scheme. It is hoped that the
 284            primary_id can behave like a reasonably sane "single string
 285            identifier" of objects, and people can use/abuse optional
 286            ids to their heart's content to provide precise mappings.
 287
 288  Example :
 289  Returns : value of optional_id
 290  Args    : newvalue (optional)
 291
 292 =cut
 293
 294 #'
 295
 296 sub optional_id{
 297     my $self = shift;
 298
 299     return $self->{'optional_id'} = shift if @_;
 300     return $self->{'optional_id'};
 301 }
 302
 303 =head2 comment
 304
 305  Title   : comment
 306  Usage   : $self->comment($newval)
 307  Function: get/set of comments (comment object)
 308            Sets or gets comments of this dblink, which is sometimes relevant
 309  Example :
 310  Returns : value of comment (Bio::Annotation::Comment)
 311  Args    : newvalue (optional)
 312
 313 =cut
 314
 315 sub comment{
 316     my $self = shift;
 317
 318     return $self->{'comment'} = shift if @_;
 319     return $self->{'comment'};
 320 }
 321
 322 =head1 Methods for Bio::IdentifiableI compliance
 323
 324 =head2 object_id
 325
 326  Title   : object_id
 327  Usage   : $string    = $obj->object_id()
 328  Function: a string which represents the stable primary identifier
 329            in this namespace of this object. For DNA sequences this
 330            is its accession_number, similarly for protein sequences
 331
 332            This is aliased to primary_id().
 333  Returns : A scalar
 334
 335
 336 =cut
 337
 338 sub object_id {
 339     return shift->primary_id(@_);
 340 }
 341
 342 =head2 version
 343
 344  Title   : version
 345  Usage   : $version    = $obj->version()
 346  Function: a number which differentiates between versions of
 347            the same object. Higher numbers are considered to be
 348            later and more relevant, but a single object described
 349            the same identifier should represent the same concept
 350
 351  Returns : A number
 352
 353 =cut
 354
 355 sub version{
 356     my $self = shift;
 357
 358     return $self->{'version'} = shift if @_;
 359     return $self->{'version'};
 360 }
 361
 362
 363 =head2 url
 364
 365  Title   : url
 366  Usage   : $url    = $obj->url()
 367  Function: URL which is associated with this DB link
 368  Returns : string, full URL descriptor
 369
 370 =cut
 371
 372 sub url {
 373     my $self = shift;
 374     return $self->{'url'} = shift if @_;
 375     return $self->{'url'};
 376 }
 377
 378
 379 =head2 authority
 380
 381  Title   : authority
 382  Usage   : $authority    = $obj->authority()
 383  Function: a string which represents the organisation which
 384            granted the namespace, written as the DNS name for
 385            organisation (eg, wormbase.org)
 386
 387  Returns : A scalar
 388
 389 =cut
 390
 391 sub authority{
 392     my $self = shift;
 393
 394     return $self->{'authority'} = shift if @_;
 395     return $self->{'authority'};
 396 }
 397
 398 =head2 namespace
 399
 400  Title   : namespace
 401  Usage   : $string    = $obj->namespace()
 402  Function: A string representing the name space this identifier
 403            is valid in, often the database name or the name
 404            describing the collection
 405
 406            For DBLink this is the same as database().
 407  Returns : A scalar
 408
 409
 410 =cut
 411
 412 sub namespace{
 413     return shift->database(@_);
 414 }
 415
 416 1;