File Coverage

GO/Model/Xref.pm
Criterion Covered Total %
statement 34 69 49.2
branch 7 24 29.1
condition 2 8 25.0
subroutine 12 17 70.5
pod 6 9 66.6
total 61 127 48.0


line stmt bran cond sub pod time code
1             # $Id: Xref.pm,v 1.3 2005/02/11 05:44:56 cmungall Exp $
2             #
3             # This GO module is maintained by Chris Mungall
4             #
5             # see also - http://www.geneontology.org
6             # - http://www.godatabase.org/dev
7             #
8             # You may distribute this module under the same terms as perl itself
9              
10             package GO::Model::Xref;
11              
12             =head1 NAME
13              
14             GO::Model::Xref;
15              
16             =head1 SYNOPSIS
17              
18             my $xrefs = $term->dbxref_list();
19             foreach my $xref (@$xrefs) P
20             printf "Term %s has an xref %s:%s\n",
21             $term->name, $xref->xref_key, $xref->dbname;
22             }
23              
24             =head1 DESCRIPTION
25              
26             represents a cross reference to an external database. an Xref is made
27             up of a key (ie the accession number, or whatever the value of the
28             unique field being keyed off of is) and a database name. this should
29             theorerically be enough to uniquely identify any databased entity.
30              
31             =head1 NOTES
32              
33             Like all the GO::Model::* classes, this uses accessor methods to get
34             or set the attributes. by using the accessor method without any
35             arguments gets the value of the attribute. if you pass in an argument,
36             then the attribuet will be set according to that argument.
37              
38             for instance
39              
40             # this sets the value of the attribute
41             $my_object->attribute_name("my value");
42              
43             # this gets the value of the attribute
44             $my_value = $my_object->attribute_name();
45              
46             =cut
47              
48              
49 24     24   137 use Carp qw(cluck confess);
  24         50  
  24         1577  
50 24     24   128 use Exporter;
  24         37  
  24         854  
51 24     24   131 use GO::Utils qw(rearrange);
  24         44  
  24         1209  
52 24     24   123 use GO::Model::Root;
  24         44  
  24         476  
53 24     24   122 use strict;
  24         40  
  24         1661  
54 24     24   117 use vars qw(@ISA);
  24         44  
  24         59475  
55              
56             @ISA = qw(GO::Model::Root Exporter);
57              
58              
59             sub _valid_params {
60 1156     1156   4357 return qw(id xref_key xref_keytype xref_dbname xref_desc name);
61             }
62              
63             sub _valid_dbnames {
64 0     0   0 return qw(go gxd sgd tair mgi fb sp sp_kw egad
65             ec medline pmid isbn omim embl publication U);
66             }
67              
68              
69             =head2 xref_key
70              
71             Alias - acc
72             Alias - accession
73             Usage -
74             Returns -
75             Args -
76              
77             accessor: gets/sets the key/id of the cross reference
78              
79             =cut
80              
81             sub xref_key {
82 1739     1739 1 7859 my $self = shift;
83 1739 100       5305 $self->{xref_key} = shift if @_;
84 1739 50 66     5625 if ($self->{xref_dbname} &&
85             $self->{xref_dbname} =~ /interpro/i) {
86 0 0 0     0 if ($self->{xref_key} && $self->{xref_key} =~ /(\S+) (.*)/) {
87 0         0 $self->{xref_key} = $1;
88 0         0 $self->{xref_desc} = $2;
89             }
90             }
91 1739         6755 return $self->{xref_key};
92             }
93             *accession = \&xref_key;
94             *acc = \&xref_key;
95              
96              
97             =head2 xref_keytype
98              
99             Usage -
100             Returns -
101             Args -
102              
103             accessor: gets/sets the key/id type of the cross reference
104              
105              
106             =cut
107              
108             sub xref_keytype {
109 841     841 1 1045 my $self = shift;
110 841 50       2341 $self->{xref_keytype} = shift if @_;
111 841         3193 return $self->{xref_keytype};
112             }
113              
114              
115             =head2 as_str
116              
117             Usage -
118             Returns -
119             Args -
120              
121             =cut
122              
123             sub as_str {
124 106     106 1 408 my $self=shift;
125             # cluck unless defined $self->xref_dbname;
126             # cluck unless defined $self->xref_key;
127 106         187 return $self->xref_dbname().":".$self->xref_key();
128             }
129              
130              
131             =head2 xref_dbname
132              
133             Alias - dbname
134             Usage -
135             Returns -
136             Args -
137              
138             accessor: gets/sets the database name of the cross reference
139              
140             must be a valid database name
141              
142             =cut
143              
144             sub xref_dbname {
145 1262     1262 1 1704 my $self = shift;
146 1262 100       4291 $self->{xref_dbname} = shift if @_;
147 1262         5271 return $self->{xref_dbname};
148             }
149             *dbname = \&xref_dbname;
150              
151             =head2 xref_desc
152              
153             Alias - name
154             Usage -
155             Returns -
156             Args -
157              
158             accessor: gets/sets the description of the accession no
159              
160             useful for interpro
161              
162             =cut
163              
164             sub xref_desc {
165 934     934 1 1143 my $self = shift;
166 934 50       2536 $self->{xref_desc} = shift if @_;
167 934         3498 return $self->{xref_desc};
168             }
169             *name = \&xref_desc;
170              
171             sub to_idl_struct {
172 0     0 0   my $self = shift;
173             return
174             {
175 0           dbname=>$self->xref_dbname,
176             keyvalue=>$self->xref_key,
177             };
178             }
179              
180              
181             =head2 to_xml
182              
183             Usage - print $xref->to_xml()
184             Returns - string
185             Args - indent [integer]
186              
187             XML representation; you probably shouldnt call this directly, this
188             will be called by entities that own xrefs
189              
190             =cut
191              
192             sub to_xml {
193 0     0 1   my $self = shift;
194 0   0       my $indent = shift || "";
195              
196 0           my $text = $indent."\n";
197 0           $text .= $indent." ".
198             $self->xref_dbname."\n";
199 0 0         if ( $self->xref_keytype ) {
200 0 0         if ( $self->xref_keytype =~ /personal communication/ ) {
201 0           $text .= $indent." ".
202             $self->xref_keytype."\n";
203 0           $text .= $indent." ".
204             $self->xref_key."\n";
205             }
206             else {
207 0 0         if ($self->xref_keytype !~ /acc/) {
208 0           $text .= $indent." ".
209             $self->xref_keytype."\n";
210             }
211 0           $text .= $indent." ".
212             $self->xref_key."\n";
213             }
214             }
215             else {
216 0           $text .= $indent." ".$self->xref_key."\n";
217             }
218 0           $text .= $indent."\n";
219 0           return $text;
220             }
221              
222             sub to_ptuples {
223 0     0 0   my $self = shift;
224 0           my ($th) =
225             rearrange([qw(tuples)], @_);
226 0           my @s = ();
227 0           my @desc = ($self->xref_desc);
228 0 0         pop @desc unless $desc[0];
229 0           push(@s,
230             ["xref",
231             $self->as_str,
232             $self->xref_dbname,
233             $self->xref_key,
234             @desc,
235             ]);
236 0           @s;
237             }
238              
239             # **** EXPERIMENTAL CODE ****
240             # the idea is to be homogeneous and use graphs for
241             # everything; eg gene products are nodes in a graph,
242             # associations are arcs
243             # cf rdf, daml+oil etc
244              
245             # args - optional graph to add to
246             sub graphify {
247 0     0 0   my $self = shift;
248 0           my ($ref, $subg, $opts) =
249             rearrange([qw(ref graph opts)], @_);
250              
251 0 0         $opts = {} unless $opts;
252 0 0         $subg = $self->apph->create_graph_obj unless $subg;
253              
254 0           my $t =
255             $self->apph->create_term_obj({name=>$self->as_str,
256             acc=>$self->as_str});
257 0           $subg->add_node($t);
258 0           $subg->add_arc($t, $ref, "hasXref");
259 0           return $subg;
260             }
261              
262             1;