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


line stmt bran cond sub pod time code
1             # $Id: OBO_ID.pm 2010-09-29 erick.antezana $
2             #
3             # Module : OBO_ID.pm
4             # Purpose : A OBO_ID.
5             # License : Copyright (c) 2006-2014 by Erick Antezana. All rights reserved.
6             # This program is free software; you can redistribute it and/or
7             # modify it under the same terms as Perl itself.
8             # Contact : Erick Antezana
9             #
10              
11             package OBO::XO::OBO_ID;
12              
13 13     13   4149 use strict;
  13         25  
  13         5433  
14            
15             sub new {
16 41     41 0 117 my $class = shift;
17 41         44 my $self = {};
18              
19 41         49 $self->{IDSPACE} = undef; # string
20 41         29 $self->{LOCALID} = undef; # localID (string)
21              
22 41         56 bless ($self, $class);
23 41         56 return $self;
24             }
25              
26             =head2 idspace
27              
28             Usage - print $id->idspace() or $id->idspace($idspace)
29             Returns - the idspace (string)
30             Args - the idspace (string)
31             Function - gets/sets the idspace # TODO this is actually the LocalIDSpace
32            
33             =cut
34              
35             sub idspace {
36 5     5 1 21 my ($self, $ns) = @_;
37 5 50       13 if ($ns) { $self->{IDSPACE} = $ns }
  5         12  
38 5         17 return $self->{IDSPACE};
39             }
40              
41             =head2 localID
42              
43             Usage - print $id->localID() or $id->localID($name)
44             Returns - the localID (string)
45             Args - the localID (string)
46             Function - gets/sets the localID
47            
48             =cut
49              
50             sub localID {
51 5     5 1 16 my ($self, $n) = @_;
52 5 50       12 if ($n) { $self->{LOCALID} = $n }
  5         6  
53 5         9 return $self->{LOCALID};
54             }
55              
56             =head2 id_as_string
57              
58             Usage - print $id->id_as_string() or $id->id_as_string("XO:X0000001")
59             Returns - the id as string (scalar)
60             Args - the id as string
61             Function - gets/sets the id as string
62            
63             =cut
64              
65             sub id_as_string () {
66 154     154 1 138 my ($self, $id_as_string) = @_;
67 154 100 66     680 if ( defined $id_as_string && $id_as_string =~ /(\w+):(\d+)/ ) {
    100 66        
68 34         67 $self->{IDSPACE} = $1;
69 34         60 my $factor = '1'.0 x length($2);
70 34         167 $self->{LOCALID} = substr($2 + $factor, 1, 7); # trick: forehead zeros # TODO
71             } elsif ($self->{IDSPACE} && $self->{LOCALID}) {
72 119         297 return $self->{IDSPACE}.':'.$self->{LOCALID};
73             }
74             }
75             *id = \&id_as_string;
76              
77             =head2 equals
78              
79             Usage - print $id->equals($id)
80             Returns - 1 (true) or 0 (false)
81             Args - the other ID (OBO::XO::OBO_ID)
82             Function - tells if two IDs are equal
83            
84             =cut
85              
86             sub equals () {
87 2     2 1 8 my ($self, $target) = @_;
88 2   33     17 return (($self->{IDSPACE} eq $target->{IDSPACE}) &&
89             ($self->{LOCALID} == $target->{LOCALID}));
90             }
91              
92             =head2 next_id
93              
94             Usage - $id->next_id()
95             Returns - the next ID (OBO::XO::OBO_ID)
96             Args - none
97             Function - returns the next ID, which is new
98            
99             =cut
100              
101             sub next_id () {
102 2     2 1 4 my $self = shift;
103 2         4 my $next_id = OBO::XO::OBO_ID->new();
104 2         3 $next_id->{IDSPACE} = $self->{IDSPACE};
105 2         5 my $factor = '1'.0 x length($self->{LOCALID});
106 2         6 $next_id->{LOCALID} = substr($factor + 1 + $self->{LOCALID}, 1, 7); # trick: forehead zeros
107 2         5 return $next_id;
108             }
109              
110             =head2 previous_id
111              
112             Usage - $id->previous_id()
113             Returns - the previous ID (OBO::XO::OBO_ID)
114             Args - none
115             Function - returns the previous ID, which is new
116            
117             =cut
118              
119             sub previous_id () {
120 2     2 1 3 my $self = shift;
121 2         4 my $previous_id = OBO::XO::OBO_ID->new();
122 2         4 $previous_id->{IDSPACE} = $self->{IDSPACE};
123 2         4 my $factor = '1'.0 x length($self->{LOCALID});
124 2         5 $previous_id->{LOCALID} = substr(($factor + $self->{LOCALID}) - 1, 1, 7); # trick: forehead zeros
125 2         5 return $previous_id;
126             }
127              
128             1;
129              
130             __END__