File Coverage

blib/lib/OBO/Core/Def.pm

Criterion	Covered	Total	%
statement	78	82	95.1
branch	22	30	73.3
condition	3	6	50.0
subroutine	11	11	100.0
pod	4	5	80.0
total	118	134	88.0

# $Id: Def.pm 2013-09-17 erick.antezana $
#
# Module  : Def.pm
# Purpose : Definition 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::Def;

use OBO::Util::DbxrefSet;

use Carp;
use strict;
use warnings;

sub new {
	my $class           = shift;
	my $self            = {};

	$self->{TEXT}       = undef;                       # required, scalar (1)
	$self->{DBXREF_SET} = OBO::Util::DbxrefSet->new(); # required, Dbxref (0..n)

	bless ($self, $class);
	return $self;
}

=head2 text

  Usage    - print $def->text() or $def->text($text)
  Returns  - the definition text (string)
  Args     - the definition text (string)
  Function - gets/sets the definition text

=cut

sub text {
	if ($_[1]) { $_[0]->{TEXT} = $_[1] }
	return $_[0]->{TEXT};
}

=head2 dbxref_set

  Usage    - $def->dbxref_set() or $def->dbxref_set($dbxref_set)
  Returns  - the definition dbxref set (OBO::Util::DbxrefSet)
  Args     - the definition dbxref set (OBO::Util::DbxrefSet)
  Function - gets/sets the definition dbxref set

=cut

sub dbxref_set {
	$_[0]->{DBXREF_SET} = $_[1] if ($_[1]);
	return $_[0]->{DBXREF_SET};
}

=head2 dbxref_set_as_string

  Usage    - $definition->dbxref_set_as_string() or $definition->dbxref_set_as_string("[GOC:elh, PMID:9334324, UM-BBD_pathwayID:2\,4\,5-t]")
  Returns  - the dbxref set (string) of this definition; [] if the set is empty
  Args     - the dbxref set (string) describing the source(s) of this definition
  Function - gets/sets the dbxref set of this definition. The set operation actually *adds* the new dbxrefs to the existing set
  Remark   - make sure that colons (,) are scaped (\,) when necessary

=cut

sub dbxref_set_as_string {
	my $dbxref_as_string = $_[1];
	if ($dbxref_as_string) {
		my $xref_set = $_[0]->{DBXREF_SET};

		__dbxref($xref_set, $dbxref_as_string);

		$_[0]->{DBXREF_SET} = $xref_set; # We are overwriting the existing set; otherwise, add the new elements to the existing set!
	}
	my @result = (); # a Set?
	foreach my $dbxref (sort {lc($b->as_string()) cmp lc($a->as_string())} $_[0]->dbxref_set()->get_set()) {
		unshift @result, $dbxref->as_string();
	}
	return '['.join(', ', @result).']';
}

=head2 equals

  Usage    - $def->equals($another_def)
  Returns  - either 1 (true) or 0 (false)
  Args     - the definition to compare with
  Function - tells whether this definition is equal to the parameter

=cut

sub equals {
	my ($self, $target) = @_;
	my $result = 0;
	if ($target && eval { $target->isa('OBO::Core::Def') }) {

		if (!defined($self->{TEXT})) {
			croak 'The text of this definition is undefined.';
		}
		if (!defined($target->{TEXT})) {
			croak 'The text of the target definition is undefined.';
		}

		$result = (($self->{TEXT} eq $target->{TEXT}) && ($self->{DBXREF_SET}->equals($target->{DBXREF_SET})));
	} else {
		croak "An unrecognized object type (not a OBO::Core::Def) was found: '", $target, "'";
	}
	return $result;
}

sub __dbxref () {
	caller eq __PACKAGE__ or croak "You cannot call this (__dbxref) prived method!";
	#
	# $_[0] ==> set
	# $_[1] ==> dbxref string
	#
	my $dbxref_set       = $_[0];
	my $dbxref_as_string = $_[1];

	$dbxref_as_string =~ s/^\[//;
	$dbxref_as_string =~ s/\]$//;
	$dbxref_as_string =~ s/\\,/;;;;/g;  # trick to keep the comma's
	$dbxref_as_string =~ s/\\"/;;;;;/g; # trick to keep the double quote's

	my @lineas = $dbxref_as_string =~ /\"([^\"]*)\"/g; # get the double-quoted pieces
	foreach my $l (@lineas) {
		my $cp = $l;
		$l =~ s/,/;;;;/g; # trick to keep the comma's
		$dbxref_as_string =~ s/\Q$cp\E/$l/;
	}

	my @dbxrefs = split (',', $dbxref_as_string);

	my $r_db_acc      = qr/([ \*\.\w-]*):([ '\#~\w:\\\+\?\{\}\$\/\(\)\[\]\.=&!%_-]*)/o;
	my $r_desc        = qr/\s+\"([^\"]*)\"/o;
	my $r_mod         = qr/\s+(\{[\w ]+=[\w ]+\})/o;

	foreach my $entry (@dbxrefs) {
		my ($match, $db, $acc, $desc, $mod) = undef;
		my $dbxref = OBO::Core::Dbxref->new();
		if ($entry =~ m/$r_db_acc$r_desc$r_mod?/) {
			$db    = __unescape($1);
			$acc   = __unescape($2);
			$desc  = __unescape($3);
			$mod   = __unescape($4) if ($4);
		} elsif ($entry =~ m/$r_db_acc$r_desc?$r_mod?/) {
			$db    = __unescape($1);
			$acc   = __unescape($2);
			$desc  = __unescape($3) if ($3);
			$mod   = __unescape($4) if ($4);
		} else {
			croak "ERROR: Check the 'dbxref' field of '", $entry, "'.";
		}

		# set the dbxref:
		$dbxref->name($db.':'.$acc);
		$dbxref->description($desc) if (defined $desc);
		$dbxref->modifier($mod) if (defined $mod);
		$dbxref_set->add($dbxref);
	}
}

sub __unescape {
	caller eq __PACKAGE__ or die;
	my $match = $_[0];
	$match =~ s/;;;;;/\\"/g;
	$match =~ s/;;;;/\\,/g;
	return $match;
}

1;

__END__