lib/Bio/Annotation/DBLink.pm

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