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