File Coverage

blib/lib/OBO/Core/Dbxref.pm

Criterion	Covered	Total	%
statement	44	53	83.0
branch	24	34	70.5
condition	14	33	42.4
subroutine	11	11	100.0
pod	7	8	87.5
total	100	139	71.9

# $Id: Dbxref.pm 2014-03-29 erick.antezana $
#
# Module  : Dbxref.pm
# Purpose : Reference structure.
# License : Copyright (c) 2006-2014 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__