File Coverage

blib/lib/OBO/XO/OBO_ID.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	6	8	75.0
condition	5	9	55.5
subroutine	8	8	100.0
pod	6	7	85.7
total	62	69	89.8

# $Id: OBO_ID.pm 2010-09-29 erick.antezana $
#
# Module  : OBO_ID.pm
# Purpose : A OBO_ID.
# 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::XO::OBO_ID;

use strict;

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

	$self->{IDSPACE} = undef; # string
	$self->{LOCALID} = undef; # localID (string)

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

=head2 idspace

  Usage    - print $id->idspace() or $id->idspace($idspace)
  Returns  - the idspace (string)
  Args     - the idspace (string)
  Function - gets/sets the idspace # TODO this is actually the LocalIDSpace

=cut

sub idspace {
	my ($self, $ns) = @_;
	if ($ns) { $self->{IDSPACE} = $ns }
	return $self->{IDSPACE};
}

=head2 localID

  Usage    - print $id->localID() or $id->localID($name)
  Returns  - the localID (string)
  Args     - the localID (string)
  Function - gets/sets the localID

=cut

sub localID {
	my ($self, $n) = @_;
	if ($n) { $self->{LOCALID} = $n }
	return $self->{LOCALID};
}

=head2 id_as_string

  Usage    - print $id->id_as_string() or $id->id_as_string("XO:X0000001")
  Returns  - the id as string (scalar)
  Args     - the id as string
  Function - gets/sets the id as string

=cut

sub id_as_string () {
	my ($self, $id_as_string) = @_;
	if ( defined $id_as_string && $id_as_string =~ /(\w+):(\d+)/ ) {
		$self->{IDSPACE} = $1;
		my $factor = '1'.0 x length($2);
		$self->{LOCALID} = substr($2 + $factor, 1, 7); # trick: forehead zeros # TODO
	} elsif ($self->{IDSPACE} && $self->{LOCALID}) {
		return $self->{IDSPACE}.':'.$self->{LOCALID};
	}
}
*id = \&id_as_string;

=head2 equals

  Usage    - print $id->equals($id)
  Returns  - 1 (true) or 0 (false)
  Args     - the other ID (OBO::XO::OBO_ID)
  Function - tells if two IDs are equal

=cut

sub equals () {
	my ($self, $target) = @_;
	return (($self->{IDSPACE} eq $target->{IDSPACE}) &&
			($self->{LOCALID} == $target->{LOCALID}));
}

=head2 next_id

  Usage    - $id->next_id()
  Returns  - the next ID (OBO::XO::OBO_ID)
  Args     - none
  Function - returns the next ID, which is new

=cut

sub next_id () {
	my $self = shift;
	my $next_id = OBO::XO::OBO_ID->new();
	$next_id->{IDSPACE} = $self->{IDSPACE};
	my $factor = '1'.0 x length($self->{LOCALID});
	$next_id->{LOCALID} = substr($factor + 1 + $self->{LOCALID}, 1, 7); # trick: forehead zeros
	return $next_id;
}

=head2 previous_id

  Usage    - $id->previous_id()
  Returns  - the previous ID (OBO::XO::OBO_ID)
  Args     - none
  Function - returns the previous ID, which is new

=cut

sub previous_id () {
	my $self = shift;
	my $previous_id = OBO::XO::OBO_ID->new();
	$previous_id->{IDSPACE} = $self->{IDSPACE};
	my $factor = '1'.0 x length($self->{LOCALID});
	$previous_id->{LOCALID} = substr(($factor + $self->{LOCALID}) - 1, 1, 7); # trick: forehead zeros
	return $previous_id;
}

1;

__END__