# $Id: Dbxref.pm 2011-03-29 erick.antezana $ # # Module : Dbxref.pm # Purpose : Reference structure. # License : Copyright (c) 2006-2011 by Erick Antezana. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # Contact : Erick Antezana # package OBO::Core::Dbxref; use Carp; use strict; use warnings; sub new { my $class = shift; my $self = {}; $self->{DB} = ''; # required, scalar (1) $self->{ACC} = ''; # required, scalar (1) $self->{DESCRIPTION} = ''; # scalar (0..1) $self->{MODIFIER} = ''; # scalar (0..1) bless ($self, $class); return $self; } =head2 name Usage - print $dbxref->name() or $dbxref->name($name) Returns - the dbxref name (string) Args - the dbxref name (string) that follows this convention DB:ACC (ACC may be an empty string like some dbxrefs from the ChEBI ontology) Function - gets/sets the dbxref name =cut sub name { if ($_[1]) { if ($_[1] =~ /([\*\.\w-]*):([ '\#~\w:\\\+\?\{\}\$\/\(\)\[\]\.=&!%_-]*)/ || # See $r_db_acc in Term.pm $_[1] =~ /(http):\/\/(.*)/) { $_[0]->{DB} = $1; $_[0]->{ACC} = $2; } } elsif (!defined($_[0]->{DB}) || !defined($_[0]->{ACC})) { croak 'The name of this dbxref is not defined.'; } else { # get-mode return $_[0]->{DB}.':'.$_[0]->{ACC}; } } # Alias *id = \&name; =head2 db Usage - print $dbxref->db() or $dbxref->db($db) Returns - the dbxref db (string) Args - the dbxref db (string) Function - gets/sets the dbxref db =cut sub db { if ($_[1]) { $_[0]->{DB} = $_[1]; } elsif (!defined($_[0]->{DB})) { croak "The database (db) of this 'dbxref' is not defined."; } else { # get-mode return $_[0]->{DB}; } } =head2 acc Usage - print $dbxref->acc() or $dbxref->acc($acc) Returns - the dbxref acc (string) Args - the dbxref acc (string) Function - gets/sets the dbxref acc =cut sub acc { if ($_[1]) { $_[0]->{ACC} = $_[1]; } elsif (!defined($_[0]->{ACC})) { croak 'The accession number (acc) of this dbxref is not defined.'; } else { # get-mode return $_[0]->{ACC}; } } =head2 description Usage - print $dbxref->description() or $dbxref->description($description) Returns - the dbxref description (string) Args - the dbxref description (string) Function - gets/sets the dbxref description =cut sub description { if ($_[1]) { $_[0]->{DESCRIPTION} = $_[1]; } elsif (!defined($_[0]->{DB}) || !defined($_[0]->{ACC})) { croak 'The name of this dbxref is not defined.'; } else { # get-mode return $_[0]->{DESCRIPTION}; } } =head2 modifier Usage - print $dbxref->modifier() or $dbxref->modifier($modifier) Returns - the optional trailing modifier (string) Args - the optional trailing modifier (string) Function - gets/sets the optional trailing modifier =cut sub modifier { if ($_[1]) { $_[0]->{MODIFIER} = $_[1]; } elsif (!defined($_[0]->{DB}) || !defined($_[0]->{ACC})) { croak 'The name of this dbxref is not defined.'; } else { # get-mode return $_[0]->{MODIFIER}; } } =head2 as_string Usage - print $dbxref->as_string() Returns - returns this dbxref ([name "description" {modifier}]) as string Args - none Function - returns this dbxref as string =cut sub as_string { croak 'The name of this dbxref is not defined.' if (!defined($_[0]->{DB}) || !defined($_[0]->{ACC})); my $result = $_[0]->{DB}.':'.$_[0]->{ACC}; $result .= ' "'.$_[0]->{DESCRIPTION}.'"' if (defined $_[0]->{DESCRIPTION} && $_[0]->{DESCRIPTION} ne ''); $result .= ' '.$_[0]->{MODIFIER} if (defined $_[0]->{MODIFIER} && $_[0]->{MODIFIER} ne ''); return $result; } =head2 equals Usage - print $dbxref->equals($another_dbxref) Returns - either 1(true) or 0 (false) Args - the dbxref(OBO::Core::Dbxref) to compare with Function - tells whether this dbxref is equal to the parameter =cut sub equals { if ($_[1] && eval { $_[1]->isa('OBO::Core::Dbxref') }) { if (!defined($_[0]->{DB}) || !defined($_[0]->{ACC})) { croak 'The name of this dbxref is undefined.'; } if (!defined($_[1]->{DB}) || !defined($_[1]->{ACC})) { croak 'The name of the target dbxref is undefined.'; } return (($_[0]->{DB} eq $_[1]->{DB}) && ($_[0]->{ACC} eq $_[1]->{ACC}) && ($_[0]->{DESCRIPTION} eq $_[1]->{DESCRIPTION}) && ($_[0]->{MODIFIER} eq $_[1]->{MODIFIER})); } else { croak "An unrecognized object type (not a OBO::Core::Dbxref) was found: '", $_[1], "'"; } return 0; } 1; __END__ =head1 NAME OBO::Core::Dbxref - A database reference structure. =head1 SYNOPSIS use OBO::Core::Dbxref; use strict; # three new dbxref's my $ref1 = OBO::Core::Dbxref->new; my $ref2 = OBO::Core::Dbxref->new; my $ref3 = OBO::Core::Dbxref->new; $ref1->name("APO:vm"); $ref1->description("this is a description"); $ref1->modifier("{opt=123}"); $ref2->name("APO:ls"); $ref3->name("APO:ea"); my $ref4 = $ref3; my $ref5 = OBO::Core::Dbxref->new; $ref5->name("APO:vm"); $ref5->description("this is a description"); $ref5->modifier("{opt=123}"); =head1 DESCRIPTION A dbxref object encapsules a reference for a universal. =head1 AUTHOR Erick Antezana, Eerick.antezana -@- gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006-2011 by Erick Antezana This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. =cut