[Bio] / Sprout / SproutSubsys.pm Repository:
ViewVC logotype

Annotation of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.14 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package SproutSubsys;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use PageBuilder;
8 :     use FIG;
9 :     use Sprout;
10 :    
11 :     =head1 Sprout Subsystem Object
12 :    
13 :     =head2 Introduction
14 :    
15 :     This object emulates the capabilities of the FIG-style C<Subsystem> object, but
16 :     uses Sprout methods to retrieve the data. This object can be dropped in place of
17 :     the UnvSubsys object to create subsystem displays for the Sprout rather than the
18 :     SEED.
19 :    
20 :     The structure created by the constructor contains the following data members.
21 :    
22 :     =over 4
23 :    
24 :     =item name
25 :    
26 :     Name of the subsystem. This is needed for any further database accesses required.
27 :    
28 :     =item curator
29 :    
30 :     Name of the subsystem's official curator.
31 :    
32 :     =item notes
33 :    
34 :     General notes about the subsystem.
35 :    
36 :     =item sprout
37 :    
38 :     Sprout object for accessing the database. This is a genuine Sprout object, not
39 :     an SFXlate object.
40 :    
41 :     =item genomeHash
42 :    
43 :     Map of genome IDs to row indices.
44 :    
45 :     =item genomes
46 :    
47 :     List of [genomeID, variantCode] tuples in row order.
48 :    
49 :     =item roleHash
50 :    
51 :     Map of role IDs and abbreviations to column indices. In other words, plugging
52 :     either a full-blown role ID or its abbreviation into this hash will return
53 :     the role's column index.
54 :    
55 :     =item roles
56 :    
57 :     List of [roleID, abbreviation] tuples in column order.
58 :    
59 : parrello 1.9 =item dir
60 :    
61 :     Directory root for the diagram and image files.
62 :    
63 : parrello 1.1 =item reactionHash
64 :    
65 :     Map of role IDs to a list of the reactions catalyzed by the role.
66 :    
67 :     =item colorHash
68 :    
69 :     Map of PEG IDs to cluster numbers. This is used to create color maps for
70 :     display of a subsystem's PEGs.
71 :    
72 : parrello 1.12 =item hopeReactions
73 :    
74 :     Map of roles to EC numbers for the Hope reactions. This object is not loaded
75 :     until it is needed.
76 :    
77 : parrello 1.1 =back
78 :    
79 :     =cut
80 :    
81 :     #: Constructor SproutSubsys->new();
82 :    
83 :     =head2 Public Methods
84 :    
85 :     =head3 new
86 :    
87 : parrello 1.12 my $sub = Subsystem->new($subName, $sprout);
88 : parrello 1.1
89 :     Load the subsystem.
90 :    
91 :     =over 4
92 :    
93 :     =item subName
94 :    
95 :     Name of the desired subsystem.
96 :    
97 :     =item sprout
98 :    
99 :     Sprout or SFXlate object for accessing the Sprout data store.
100 :    
101 :     =back
102 :    
103 :     =cut
104 :    
105 :     sub new {
106 :     # Get the parameters.
107 :     my ($class, $subName, $sprout) = @_;
108 :     # Insure we have a Sprout object.
109 :     if (ref $sprout eq 'SFXlate') {
110 :     $sprout = $sprout->{sprout};
111 :     }
112 :     # Declare the return value.
113 :     my $retVal;
114 : parrello 1.14 # Get the subsystem's object.
115 :     my $subsystemObject = $sprout->GetEntity('Subsystem', $subName);
116 :     if (! defined $subsystemObject) {
117 :     # Here we're stuck.
118 :     Confess("Subsystem \"$subName\" not found in database.");
119 :     } else {
120 :     # We've found it, so get the major data.
121 :     my ($curator, $notes, $description) = $subsystemObject->Values(['Subsystem(curator)', 'Subsystem(notes)',
122 :     'Subsystem(description)']);
123 : parrello 1.1 # Get the genome IDs and variant codes for the rows. The list returned
124 :     # by GetAll will be a list of 2-tuples, each consisting of a genome ID
125 :     # and a subsystem variant code.
126 :     my @genomes = $sprout->GetAll(['ParticipatesIn'],
127 :     'ParticipatesIn(to-link) = ? ORDER BY ParticipatesIn(variant-code), ParticipatesIn(from-link)',
128 :     [$subName], ['ParticipatesIn(from-link)',
129 :     'ParticipatesIn(variant-code)']);
130 :     # Create the genome ID directory. This is a hash that maps a genome ID to its
131 :     # row index.
132 :     my $idx = 0;
133 :     my %genomeHash = map { $_->[0] => $idx++ } @genomes;
134 :     # Get the role IDs and abbreviations. The list returned by GetAll will be
135 :     # a list of 2-tuples, each consisting of a role ID and abbreviation. The
136 :     # 2-tuples will be ordered by the spreadsheet column number.
137 : parrello 1.11 my @roles = $sprout->GetAll(['OccursInSubsystem'],
138 : parrello 1.1 'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
139 : parrello 1.11 [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)']);
140 : parrello 1.1 # Now we need to create the role ID directory and the reaction hash.
141 :     # The role ID directory maps role IDs and their abbreviations to column numbers.
142 :     # The reaction hash maps a role ID to a list of the IDs for the reactions it
143 :     # catalyzes.
144 :     my %roleHash = ();
145 : parrello 1.11 my %abbrHash = ();
146 : parrello 1.1 my %reactionHash = ();
147 :     for ($idx = 0; $idx <= $#roles; $idx++) {
148 :     # Get the role ID and abbreviation for this column's role.
149 :     my ($roleID, $abbr) = @{$roles[$idx]};
150 :     # Put them both in the role directory.
151 :     $roleHash{$roleID} = $idx;
152 :     $roleHash{$abbr} = $idx;
153 : parrello 1.11 # Put the full name in the abbreviation directory.
154 :     $abbrHash{$abbr} = $roleID;
155 : parrello 1.1 # Get this role's reactions.
156 :     my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
157 :     [$roleID], 'Catalyzes(to-link)');
158 :     # Put them in the reaction hash.
159 : parrello 1.3 if (@reactions > 0) {
160 :     $reactionHash{$roleID} = \@reactions;
161 :     }
162 : parrello 1.1 }
163 : parrello 1.9 # Find the subsystem directory.
164 :     my $subDir = Subsystem::get_dir_from_name($subName);
165 :     Trace("Subsystem directory is $subDir.") if T(3);
166 : parrello 1.1 # Create the subsystem object.
167 :     $retVal = {
168 :     # Name of the subsystem. This is needed for any further database
169 :     # accesses required.
170 :     name => $subName,
171 : parrello 1.9 # Directory root for diagram and image files.
172 :     dir => $subDir,
173 : parrello 1.1 # Name of the subsystem's official curator.
174 :     curator => $curator,
175 :     # General notes about the subsystem.
176 :     notes => $notes,
177 :     # Sprout object for accessing the database.
178 :     sprout => $sprout,
179 :     # Map of genome IDs to row indices.
180 :     genomeHash => \%genomeHash,
181 :     # List of [genomeID, variantCode] tuples in row order.
182 :     genomes => \@genomes,
183 :     # Map of role IDs and abbreviations to column indices.
184 :     roleHash => \%roleHash,
185 :     # List of [roleID, abbreviation] tuples in column order.
186 :     roles => \@roles,
187 :     # Map of PEG IDs to cluster numbers.
188 :     colorHash => {},
189 : parrello 1.11 # Map of abbreviations to role names.
190 :     abbrHash => \%abbrHash,
191 : parrello 1.2 # Map of role IDs to reactions.
192 :     reactionHash => \%reactionHash,
193 : parrello 1.1 };
194 :     # Bless and return it.
195 :     bless $retVal, $class;
196 :     }
197 :     return $retVal;
198 :     }
199 :    
200 : parrello 1.12 =head3 get_row
201 :    
202 :     my $rowData = $sub->get_row($rowIndex);
203 :    
204 :     Return the specified row in the subsystem spreadsheet. The row consists
205 :     of a list of lists. Each position in the major list represents the role
206 :     for that position, and contains a list of the IDs for the features that
207 :     perform the role.
208 :    
209 :     =over 4
210 :    
211 :     =item rowIndex
212 :    
213 :     Index of the row to return. A row contains data for a single genome.
214 :    
215 :     =item RETURN
216 :    
217 :     Returns a reference to a list of lists. Each element in the list represents
218 :     a spreadsheet column (role) and contains a list of features that perform the
219 :     role.
220 :    
221 :     =back
222 :    
223 :     =cut
224 :    
225 :     sub get_row {
226 :     # Get the parameters.
227 :     my ($self, $rowIndex) = @_;
228 :     # Get the genome ID for the specified row's genome.
229 :     my $genomeID = $self->{genomes}->[$rowIndex]->[0];
230 :     # Read the row from the database. We won't get exactly what we want. Instead, we'll
231 :     # get a list of triplets, each consisting of a role name, a feature ID, and a cluster
232 :     # number. We need to convert this into a list of lists and stash the clustering information
233 :     # in the color hash.
234 :     my @rowData = $self->{sprout}->GetAll([qw(Subsystem HasSSCell IsGenomeOf IsRoleOf ContainsFeature)],
235 :     "Subsystem(id) = ? AND IsGenomeOf(from-link) = ?",
236 :     [$self->{name}, $genomeID],
237 :     [qw(IsRoleOf(from-link) ContainsFeature(to-link)
238 :     ContainsFeature(cluster-number))]);
239 :     # Now we do the conversion. We must first create an array of empty lists, one per
240 :     # row index.
241 :     my @retVal = map { [] } @{$self->{roles}};
242 :     # Get the hash for converting role IDs to role indexes.
243 :     my $roleHash = $self->{roleHash};
244 :     # Now we stash all the feature IDs in the appropriate columns of the row list.
245 :     for my $rowDatum (@rowData) {
246 :     # Get the role ID, the peg ID, and the cluster number.
247 :     my ($role, $peg, $cluster) = @{$rowDatum};
248 :     # Put the peg in the role's peg list.
249 :     push @{$retVal[$roleHash->{$role}]}, $peg;
250 :     # Put the cluster number in the color hash.
251 :     $self->{colorHash}->{$peg} = $cluster;
252 :     }
253 :     # Return the result.
254 :     return \@retVal;
255 :     }
256 :    
257 : parrello 1.14 =head3 get_roles_for_genome
258 :    
259 :     my @roles = $sub->get_roles_for_genome($genome_id);
260 :    
261 :     Return a list of the roles in this subsystem that have nonempty
262 :     spreadsheet cells for the given genome.
263 :    
264 :     =over 4
265 :    
266 :     =item genome_id
267 :    
268 :     ID of the relevant genome.
269 :    
270 :     =item RETURN
271 :    
272 :     Returns a list of role IDs.
273 :    
274 :     =back
275 :    
276 :     =cut
277 :    
278 :     sub get_roles_for_genome {
279 :     # Get the parameters.
280 :     my ($self, $genome_id) = @_;
281 :     # This next statement gets all of the nonempty cells for the genome's row and memorizes
282 :     # the roles by rolling them into a hash. The query connects four relationship tables on
283 :     # a single common key-- the spreadsheet cell ID. The IsGenomeOf table insures the cell is for the
284 :     # correct genome. The HasSSCell table insures that it belongs to the correct subsystem. The
285 :     # ContainsFeature table insures that it contains at least one feature. Finally, IsRoleOf tells
286 :     # us the cell's role. If a cell has more than one feature, the result list from the query will return
287 :     # one instance of the role for every distinct feature. The hash collapses the duplicates automatically.
288 :     my %retVal = map { $_ => 1 } $self->{sprout}->GetFlat([qw(ContainsFeature HasSSCell IsGenomeOf IsRoleOf)],
289 :     "HasSSCell(from-link) = ? AND IsGenomeOf(from-link) = ?",
290 :     [$self->{name}, $genome_id], 'IsRoleOf(from-link)');
291 :     # Return the result.
292 :     return keys %retVal;
293 :     }
294 :    
295 : parrello 1.12 =head3 get_abbr_for_role
296 :    
297 :     my $abbr = $sub->get_abbr_for_role($name);
298 :    
299 :     Get this subsystem's abbreviation for the specified role.
300 :    
301 :     =over 4
302 :    
303 :     =item name
304 :    
305 :     Name of the relevant role.
306 :    
307 :     =item RETURN
308 :    
309 :     Returns the abbreviation for the role. Each subsystem has its own abbreviation
310 :     system; the abbreviations make it easier to display the subsystem spreadsheet.
311 :    
312 :     =back
313 :    
314 :     =cut
315 :    
316 : parrello 1.14 sub get_abbr_for_role {
317 : parrello 1.12 # Get the parameters.
318 :     my ($self, $name) = @_;
319 :     # Get the index for this role.
320 :     my $idx = $self->get_role_index($name);
321 :     # Return the abbreviation.
322 :     return $self->get_role_abbr($idx);
323 :     }
324 :    
325 :     =head3 get_subsetC
326 :    
327 :     my @columns = $sub->get_subsetC($subsetName);
328 :    
329 :     Return a list of the column numbers for the columns in the named role
330 :     subset.
331 :    
332 :     =over 4
333 :    
334 :     =item subsetName
335 :    
336 :     Name of the subset whose columns are desired.
337 :    
338 :     =item RETURN
339 :    
340 :     Returns a list of the indices for the columns in the named subset.
341 :    
342 :     =back
343 :    
344 :     =cut
345 :    
346 :     sub get_subsetC {
347 :     # Get the parameters.
348 :     my ($self, $subsetName) = @_;
349 :     # Get the roles in the subset.
350 :     my @roles = $self->get_subsetC_roles($subsetName);
351 :     # Convert them to indices.
352 :     my $roleHash = $self->{roleHash};
353 :     my @retVal = map { $roleHash->{$_} } @roles;
354 :     # Return the result.
355 :     return @retVal;
356 :     }
357 :    
358 : parrello 1.1 =head3 get_genomes
359 :    
360 : parrello 1.12 my @genomeList = $sub->get_genomes();
361 : parrello 1.1
362 :     Return a list of the genome IDs for this subsystem. Each genome corresponds to a row
363 :     in the subsystem spreadsheet. Indexing into this list returns the ID of the genome
364 :     in the specified row.
365 :    
366 :     =cut
367 :    
368 :     sub get_genomes {
369 :     # Get the parameters.
370 :     my ($self) = @_;
371 :     # Return a list of the genome IDs. The "genomes" member contains a 2-tuple
372 :     # with the genome ID followed by the variant code. We only return the
373 :     # genome IDs.
374 :     my @retVal = map { $_->[0] } @{$self->{genomes}};
375 :     return @retVal;
376 :     }
377 :    
378 :     =head3 get_variant_code
379 :    
380 : parrello 1.12 my $code = $sub->get_variant_code($gidx);
381 : parrello 1.1
382 :     Return the variant code for the specified genome. Each subsystem has multiple
383 :     variants which involve slightly different chemical reactions, and each variant
384 :     has an associated variant code. When a genome is connected to the spreadsheet,
385 :     the subsystem variant used by the genome must be specified.
386 :    
387 :     =over 4
388 :    
389 :     =item gidx
390 :    
391 :     Row index for the genome whose variant code is desired.
392 :    
393 :     =item RETURN
394 :    
395 :     Returns the variant code for the specified genome.
396 :    
397 :     =back
398 :    
399 :     =cut
400 :    
401 :     sub get_variant_code {
402 :     # Get the parameters.
403 :     my ($self, $gidx) = @_;
404 :     # Extract the variant code for the specified row index. It is the second
405 :     # element of the tuple from the "genomes" member.
406 : parrello 1.5 my $retVal = $self->{genomes}->[$gidx]->[1];
407 : parrello 1.1 return $retVal;
408 :     }
409 :    
410 :     =head3 get_curator
411 :    
412 : parrello 1.12 my $userName = $sub->get_curator();
413 : parrello 1.1
414 :     Return the name of this subsystem's official curator.
415 :    
416 :     =cut
417 :    
418 :     sub get_curator {
419 :     # Get the parameters.
420 :     my ($self) = @_;
421 :     # Return the curator member.
422 :     return $self->{curator};
423 :     }
424 :    
425 :     =head3 get_notes
426 :    
427 : parrello 1.12 my $text = $sub->get_notes();
428 : parrello 1.1
429 :     Return the descriptive notes for this subsystem.
430 :    
431 :     =cut
432 :    
433 :     sub get_notes {
434 :     # Get the parameters.
435 :     my ($self) = @_;
436 :     # Return the notes member.
437 :     return $self->{notes};
438 :     }
439 :    
440 : parrello 1.13 =head3 get_description
441 :    
442 :     my $text = $sub->get_description();
443 :    
444 :     Return the description for this subsystem.
445 :    
446 :     =cut
447 :    
448 :     sub get_description
449 :     {
450 :     my($self) = @_;
451 :     return $self->{description};
452 :     }
453 :    
454 : parrello 1.1 =head3 get_roles
455 :    
456 : parrello 1.12 my @roles = $sub->get_roles();
457 : parrello 1.1
458 :     Return a list of the subsystem's roles. Each role corresponds to a column
459 :     in the subsystem spreadsheet. The list entry at a specified position in
460 :     the list will contain the ID of that column's role.
461 :    
462 :     =cut
463 :    
464 :     sub get_roles {
465 :     # Get the parameters.
466 :     my ($self) = @_;
467 :     # Return the list of role IDs. The role IDs are stored as the first
468 :     # element of each 2-tuple in the "roles" member.
469 :     my @retVal = map { $_->[0] } @{$self->{roles}};
470 :     return @retVal;
471 :     }
472 :    
473 :     =head3 get_reactions
474 :    
475 : parrello 1.12 my $reactHash = $sub->get_reactions();
476 : parrello 1.1
477 :     Return a reference to a hash that maps each role ID to a list of the reactions
478 :     catalyzed by the role.
479 :    
480 :     =cut
481 :    
482 :     sub get_reactions {
483 :     # Get the parameters.
484 :     my ($self) = @_;
485 :     # Return the reaction hash member.
486 :     return $self->{reactionHash};
487 :     }
488 :    
489 :     =head3 get_subset_namesC
490 :    
491 : parrello 1.12 my @subsetNames = $sub->get_subset_namesC();
492 : parrello 1.1
493 :     Return a list of the names for all the column (role) subsets. Given a subset
494 :     name, you can use the L</get_subsetC_roles> method to get the roles in the
495 :     subset.
496 :    
497 :     =cut
498 :    
499 :     sub get_subset_namesC {
500 :     # Get the parameters.
501 :     my ($self) = @_;
502 :     # Get the sprout object and use it to retrieve the subset names.
503 :     my $sprout = $self->{sprout};
504 :     my @subsets = $sprout->GetFlat(['HasRoleSubset'], 'HasRoleSubset(from-link) = ?',
505 :     [$self->{name}], 'HasRoleSubset(to-link)');
506 :     # The sprout subset names are prefixed by the subsystem name. We need to pull the
507 :     # prefix off before we return the results. The prefixing character is a colon (:),
508 :     # so we search for the last colon to get ourselves the true subset name.
509 :     my @retVal = map { $_ =~ /:([^:]+)$/; $1 } @subsets;
510 :     return @retVal;
511 :     }
512 :    
513 : parrello 1.12 =head3 get_subset_names
514 :    
515 :     my @subsetNames = $sub->get_subset_names();
516 :    
517 :     Return the names of the column subsets.
518 :    
519 :     =cut
520 :    
521 :     sub get_subset_names{
522 :     # Get the parameters.
523 :     my ($self) = @_;
524 :     # Return the result.
525 :     return $self->get_subset_namesC();
526 :     }
527 :    
528 : parrello 1.1 =head3 get_role_abbr
529 :    
530 : parrello 1.12 my $abbr = $sub->get_role_abbr($ridx);
531 : parrello 1.1
532 :     Return the abbreviation for the role in the specified column. The abbreviation
533 :     is a shortened identifier that is not necessarily unique, but is more likely to
534 :     fit in a column heading.
535 :    
536 :     =over 4
537 :    
538 :     =item ridx
539 :    
540 :     Column index for the role whose abbreviation is desired.
541 :    
542 :     =item RETURN
543 :    
544 :     Returns an abbreviated name for the role corresponding to the indexed column.
545 :    
546 :     =back
547 :    
548 :     =cut
549 :    
550 :     sub get_role_abbr {
551 :     # Get the parameters.
552 :     my ($self, $ridx) = @_;
553 :     # Return the role abbreviation. The abbreviation is the second element
554 :     # in the 2-tuple for the specified column in the "roles" member.
555 :     my $retVal = $self->{roles}->[$ridx]->[1];
556 :     return $retVal;
557 :     }
558 :    
559 : parrello 1.12 =head3 get_hope_reactions
560 :    
561 : parrello 1.14 my %reactionHash = $subsys->get_hope_reactions();
562 : parrello 1.12
563 :     Return a hash mapping the roles of this subsystem to the EC numbers for
564 :     the reactions used in scenarios (if any). It may return an empty hash
565 :     if the Hope reactions are not yet known.
566 :    
567 :     =cut
568 :    
569 :     sub get_hope_reactions {
570 :     # Get the parameters.
571 :     my ($self) = @_;
572 :     # Try to get the hope reactions from the object.
573 :     my $retVal = $self->{hopeReactions};
574 :     if (! defined($retVal)) {
575 :     # They do not exist, so we must create them.
576 :     $retVal = FIGRules::GetHopeReactions($self, $self->{dir});
577 :     # Insure we have it if we need it again.
578 :     $self->{hopeReactions} = $retVal;
579 :     }
580 :     # Return the result.
581 : parrello 1.14 return %{$retVal};
582 : parrello 1.12 }
583 :    
584 : parrello 1.1 =head3 get_role_index
585 :    
586 : parrello 1.12 my $idx = $sub->get_role_index($role);
587 : parrello 1.1
588 :     Return the column index for the role with the specified ID.
589 :    
590 :     =over 4
591 :    
592 :     =item role
593 :    
594 :     ID (full name) or abbreviation of the role whose column index is desired.
595 :    
596 :     =item RETURN
597 :    
598 :     Returns the column index for the role with the specified name or abbreviation.
599 :    
600 :     =back
601 :    
602 :     =cut
603 :    
604 :     sub get_role_index {
605 :     # Get the parameters.
606 :     my ($self, $role) = @_;
607 :     # The role index is directly available from the "roleHash" member.
608 :     my $retVal = $self->{roleHash}->{$role};
609 :     return $retVal;
610 :     }
611 :    
612 :     =head3 get_subsetC_roles
613 :    
614 : parrello 1.12 my @roles = $sub->get_subsetC_roles($subname);
615 : parrello 1.1
616 :     Return the names of the roles contained in the specified role (column) subset.
617 :    
618 :     =over 4
619 :    
620 :     =item subname
621 :    
622 :     Name of the role subset whose roles are desired.
623 :    
624 :     =item RETURN
625 :    
626 :     Returns a list of the role names for the columns in the named subset.
627 :    
628 :     =back
629 :    
630 :     =cut
631 :    
632 :     sub get_subsetC_roles {
633 :     # Get the parameters.
634 :     my ($self, $subname) = @_;
635 :     # Get the sprout object. We need it to be able to get the subset data.
636 :     my $sprout = $self->{sprout};
637 :     # Convert the subset name to Sprout format. In Sprout, the subset name is
638 :     # prefixed by the subsystem name in order to get a unique subset ID.
639 :     my $subsetID = $self->{name} . ":$subname";
640 :     # Get a list of the role names for this subset.
641 :     my @roleNames = $sprout->GetFlat(['ConsistsOfRoles'], 'ConsistsOfRoles(from-link) = ?',
642 :     [$subsetID], 'ConsistsOfRoles(to-link)');
643 :     # Sort them by column number. We get the column number from the role hash.
644 :     my $roleHash = $self->{roleHash};
645 :     my @retVal = sort { $roleHash->{$a} <=> $roleHash->{$b} } @roleNames;
646 :     # Return the sorted list.
647 :     return @retVal;
648 :     }
649 :    
650 :     =head3 get_genome_index
651 :    
652 : parrello 1.12 my $idx = $sub->get_genome_index($genome);
653 : parrello 1.1
654 :     Return the row index for the genome with the specified ID.
655 :    
656 :     =over 4
657 :    
658 :     =item genome
659 :    
660 :     ID of the genome whose row index is desired.
661 :    
662 :     =item RETURN
663 :    
664 :     Returns the row index for the genome with the specified ID, or an undefined
665 :     value if the genome does not participate in the subsystem.
666 :    
667 :     =back
668 :    
669 :     =cut
670 :    
671 :     sub get_genome_index {
672 :     # Get the parameters.
673 :     my ($self, $genome) = @_;
674 :     # Get the genome row index from the "genomeHash" member.
675 :     my $retVal = $self->{genomeHash}->{$genome};
676 :     return $retVal;
677 :     }
678 :    
679 :     =head3 get_cluster_number
680 :    
681 : parrello 1.12 my $number = $sub->get_cluster_number($pegID);
682 : parrello 1.1
683 :     Return the cluster number for the specified PEG, or C<-1> if the
684 :     cluster number for the PEG is unknown or it is not clustered.
685 :    
686 :     The cluster number is read into the color hash by the
687 :     L</get_pegs_from_cell> method. If the incoming PEG IDs do not
688 :     come from the most recent cell retrievals, the information returned
689 :     will be invalid. This is a serious design flaw which needs to be
690 :     fixed soon.
691 :    
692 :     =over 4
693 :    
694 :     =item pegID
695 :    
696 :     ID of the PEG whose cluster number is desired.
697 : parrello 1.4
698 :     =item RETURN
699 :    
700 :     Returns the appropriate cluster number.
701 : parrello 1.1
702 :     =back
703 :    
704 :     =cut
705 :     #: Return Type $;
706 :     sub get_cluster_number {
707 :     # Get the parameters.
708 :     my ($self, $pegID) = @_;
709 :     # Declare the return variable.
710 :     my $retVal = -1;
711 :     # Check for a cluster number in the color hash.
712 :     if (exists $self->{colorHash}->{$pegID}) {
713 :     $retVal = $self->{colorHash}->{$pegID};
714 :     }
715 :     # Return the result.
716 :     return $retVal;
717 :     }
718 :    
719 :     =head3 get_pegs_from_cell
720 :    
721 : parrello 1.12 my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
722 : parrello 1.1
723 :     Return a list of the peg IDs for the features in the specified spreadsheet cell.
724 :    
725 :     =over 4
726 :    
727 :     =item rowstr
728 :    
729 :     Genome row, specified either as a row index or a genome ID.
730 :    
731 :     =item colstr
732 :    
733 :     Role column, specified either as a column index, a role name, or a role
734 :     abbreviation.
735 :    
736 :     =item RETURN
737 :    
738 :     Returns a list of PEG IDs. The PEGs in the list belong to the genome in the
739 :     specified row and perform the role in the specified column. If the indicated
740 :     row and column does not exist, returns an empty list.
741 :    
742 :     =back
743 :    
744 :     =cut
745 :    
746 :     sub get_pegs_from_cell {
747 :     # Get the parameters.
748 :     my ($self, $rowstr, $colstr) = @_;
749 :     # Get the sprout object for accessing the database.
750 :     my $sprout = $self->{sprout};
751 :     # We need to convert the incoming row and column identifiers. We need a
752 :     # numeric column index and a character genome ID to create the ID for the
753 :     # subsystem spreadsheet cell. First, the column index: note that our version
754 :     # of "get_role_index" conveniently works for both abbreviations and full role IDs.
755 :     my $colIdx = ($colstr =~ /^(\d+)$/ ? $colstr : $self->get_role_index($colstr));
756 :     # Next the genome ID. In this case, we convert any number we find to a string.
757 :     # This requires a little care to avoid a run-time error if the row number is
758 :     # out of range.
759 :     my $genomeID = $rowstr;
760 :     if ($rowstr =~ /^(\d+)$/) {
761 :     # Here we need to convert the row number to an ID. Insure the number is in
762 :     # range. Note that if we do have a row number out of range, the genome ID
763 :     # will be invalid, and our attempt to read from the database will return an
764 :     # empty list.
765 :     my $genomeList = $self->{genomes};
766 :     if ($rowstr >= 0 && $rowstr < @{$genomeList}) {
767 :     $genomeID = $genomeList->[$rowstr]->[0];
768 :     }
769 :     }
770 :     # Construct the spreadsheet cell ID from the information we have.
771 : parrello 1.7 my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
772 : parrello 1.1 # Get the list of PEG IDs and cluster numbers for the indicated cell.
773 :     my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
774 :     [$cellID], ['ContainsFeature(to-link)',
775 :     'ContainsFeature(cluster-number)']);
776 :     # Copy the pegs into the return list, and save the cluster numbers in the color hash.
777 :     my @retVal = ();
778 :     for my $pegEntry (@pegList) {
779 :     my ($peg, $cluster) = @{$pegEntry};
780 :     $self->{colorHash}->{$peg} = $cluster;
781 :     push @retVal, $peg;
782 :     }
783 :     # Return the list. If the spreadsheet cell was empty or non-existent, we'll end
784 :     # up returning an empty list.
785 :     return @retVal;
786 :     }
787 :    
788 : parrello 1.10 =head3 get_subsetR
789 : parrello 1.8
790 : parrello 1.12 my @genomes = $sub->get_subsetR($subName);
791 : parrello 1.10
792 :     Return the genomes in the row subset indicated by the specified subset name.
793 :    
794 :     =over 4
795 :    
796 :     =item subName
797 :    
798 :     Name of the desired row subset, or C<All> to get all of the rows.
799 :    
800 :     =item RETURN
801 :    
802 :     Returns a list of genome IDs corresponding to the named subset.
803 :    
804 :     =back
805 :    
806 :     =cut
807 :    
808 :     sub get_subsetR {
809 :     # Get the parameters.
810 :     my ($self, $subName) = @_;
811 :     # Look for the specified row subset in the database. A row subset is identified using
812 :     # the subsystem name and the subset name. The special subset "All" is actually
813 :     # represented in the database, so we don't need to check for it.
814 :     my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
815 :     ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
816 :     return @rows;
817 :     }
818 : parrello 1.8
819 : parrello 1.4 =head3 get_diagrams
820 :    
821 : parrello 1.12 my @list = $sub->get_diagrams();
822 : parrello 1.4
823 :     Return a list of the diagrams associated with this subsystem. Each diagram
824 :     is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,
825 :     page_link, img_link]> where
826 :    
827 :     =over 4
828 :    
829 :     =item diagram_id
830 :    
831 :     ID code for this diagram.
832 :    
833 :     =item diagram_name
834 :    
835 :     Displayable name of the diagram.
836 :    
837 :     =item page_link
838 :    
839 :     URL of an HTML page containing information about the diagram.
840 :    
841 :     =item img_link
842 :    
843 :     URL of an HTML page containing an image for the diagram.
844 :    
845 :     =back
846 :    
847 :     Note that the URLs are in fact for CGI scripts with parameters that point them
848 :     to the correct place. Though Sprout has diagram information in it, it has
849 :     no relationship to the diagrams displayed in SEED, so the work is done entirely
850 :     on the SEED side.
851 :    
852 :     =cut
853 :    
854 :     sub get_diagrams {
855 :     # Get the parameters.
856 :     my ($self) = @_;
857 :     # Get the diagram IDs.
858 : parrello 1.9 my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
859 : parrello 1.6 Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
860 : parrello 1.4 # Create the return variable.
861 :     my @retVal = ();
862 :     # Loop through the diagram IDs.
863 :     for my $diagramID (@diagramIDs) {
864 : parrello 1.6 Trace("Processing diagram $diagramID.") if T(3);
865 : parrello 1.9 my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
866 :     Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3);
867 : parrello 1.6 push @retVal, [$diagramID, $name, $link, $imgLink];
868 : parrello 1.4 }
869 : parrello 1.6 # Return the result.
870 :     return @retVal;
871 : parrello 1.4 }
872 :    
873 : parrello 1.9 =head3 get_diagram
874 :    
875 : parrello 1.12 my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
876 : parrello 1.9
877 :     Get the information (if any) for the specified diagram. The diagram corresponds
878 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
879 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
880 :     where I<$dir> is the subsystem directory. The diagram's name is extracted from
881 :     a tiny file containing the name, and then the links are computed using the
882 :     subsystem name and the diagram ID. The parameters are as follows.
883 :    
884 :     =over 4
885 :    
886 :     =item id
887 :    
888 :     ID code for the desired diagram.
889 :    
890 :     =item RETURN
891 :    
892 :     Returns a three-element list. The first element is the diagram name, the second
893 :     a URL for displaying information about the diagram, and the third a URL for
894 :     displaying the diagram image.
895 :    
896 :     =back
897 :    
898 :     =cut
899 :    
900 :     sub get_diagram {
901 :     my($self, $id) = @_;
902 :     my $name = Subsystem::GetDiagramName($self->{dir}, $id);
903 : parrello 1.11 my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
904 : parrello 1.9 return($name, $link, $img_link);
905 :     }
906 :    
907 :    
908 :     =head3 get_diagram_html_file
909 :    
910 : parrello 1.12 my $fileName = $sub->get_diagram_html_file($id);
911 : parrello 1.9
912 :     Get the HTML file (if any) for the specified diagram. The diagram corresponds
913 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
914 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
915 :     where I<$dir> is the subsystem directory. If an HTML file exists, it will be
916 :     named C<diagram.html> in the diagram directory. The parameters are as follows.
917 :    
918 :     =over 4
919 :    
920 :     =item id
921 :    
922 :     ID code for the desired diagram.
923 :    
924 :     =item RETURN
925 :    
926 :     Returns the name of an HTML diagram file, or C<undef> if no such file exists.
927 :    
928 :     =back
929 :    
930 :     =cut
931 :    
932 :     sub get_diagram_html_file {
933 :     my ($self, $id) = @_;
934 :     my $retVal;
935 :     my $ddir = "$self->{dir}/diagrams/$id";
936 :     if (-d $ddir) {
937 :     my $html = "$ddir/diagram.html";
938 :     if (-f $html) {
939 :     $retVal = $html;
940 :     }
941 :     }
942 :     return $retVal;
943 :     }
944 :    
945 : parrello 1.11 =head3 is_new_diagram
946 :    
947 : parrello 1.12 my $flag = $sub->is_new_diagram($id);
948 : parrello 1.11
949 :     Return TRUE if the specified diagram is in the new format, else FALSE.
950 :    
951 :     =over 4
952 :    
953 :     =item id
954 :    
955 :     ID code (e.g. C<d03>) of the relevant diagram.
956 :    
957 :     =item RETURN
958 :    
959 :     Returns TRUE if the diagram is in the new format, else FALSE.
960 :    
961 :     =back
962 :    
963 :     =cut
964 :    
965 :     sub is_new_diagram {
966 :     my ($self, $id) = @_;
967 :    
968 :     my $image_map = $self->get_diagram_html_file($id);
969 :     if ($image_map) {
970 :     Trace("Image map found for diagram $id at $image_map.") if T(3);
971 :     open(IN, "$image_map") or Confess("Unable to open file $image_map.");
972 :     my $header = <IN>;
973 :     close(IN);
974 : parrello 1.12
975 : parrello 1.11 if ($header =~ /\<map name=\"GraffleExport\"\>/) {
976 :     return 1;
977 :     }
978 :     }
979 :    
980 :     return undef;
981 :     }
982 :    
983 :     =head3 get_role_from_abbr
984 :    
985 : parrello 1.12 my $roleName = $sub->get_role_from_abbr($abbr);
986 : parrello 1.11
987 :     Return the role name corresponding to an abbreviation.
988 :    
989 :     =over 4
990 :    
991 :     =item abbr
992 :    
993 :     Abbreviation name of the relevant role.
994 :    
995 :     =item RETURN
996 :    
997 :     Returns the full name of the specified role.
998 :    
999 :     =back
1000 :    
1001 :     =cut
1002 :    
1003 :     sub get_role_from_abbr {
1004 :     # Get the parameters.
1005 :     my($self, $abbr) = @_;
1006 :     # Get the role name from the abbreviation hash.
1007 :     my $retVal = $self->{abbrHash}->{$abbr};
1008 :     # Check for a case incompatability.
1009 :     if (! defined $retVal) {
1010 :     $retVal = $self->{abbrHash}->{lcfirst $abbr};
1011 :     }
1012 :     # Return the result.
1013 :     return $retVal;
1014 :     }
1015 :    
1016 :    
1017 : parrello 1.9 =head3 get_name
1018 :    
1019 : parrello 1.12 my $name = $sub->get_name();
1020 : parrello 1.9
1021 :     Return the name of this subsystem.
1022 :    
1023 :     =cut
1024 :    
1025 :     sub get_name {
1026 :     # Get the parameters.
1027 :     my ($self) = @_;
1028 :     # Return the result.
1029 :     return $self->{name};
1030 :     }
1031 :    
1032 :     =head3 open_diagram_image
1033 :    
1034 : parrello 1.12 my ($type, $fh) = $sub->open_diagram_image($id);
1035 : parrello 1.9
1036 :     Open a diagram's image file and return the type and file handle.
1037 :    
1038 :     =over 4
1039 :    
1040 :     =item id
1041 :    
1042 :     ID of the desired diagram
1043 :    
1044 :     =item RETURN
1045 :    
1046 :     Returns a 2-tuple containing the diagram's MIME type and an open filehandle
1047 :     for the diagram's data. If the diagram does not exist, the type will be
1048 :     returned as <undef>.
1049 :    
1050 :     =back
1051 :    
1052 :     =cut
1053 :    
1054 :     sub open_diagram_image {
1055 :     # Get the parameters.
1056 :     my ($self, $id) = @_;
1057 :     # Declare the return variables.
1058 :     my ($type, $fh);
1059 :     # Get the diagram directory.
1060 :     my $img_base = "$self->{dir}/diagrams/$id/diagram";
1061 :     # Get a list of file extensions and types.
1062 :     my %types = (png => "image/png",
1063 :     gif => "image/gif",
1064 :     jpg => "image/jpeg");
1065 :     # This is my new syntax for the for-each-while loop.
1066 :     # We loop until we run out of keys or come up with a type value.
1067 :     for my $ext (keys %types) { last if (defined $type);
1068 :     my $myType = $types{$ext};
1069 :     # Compute a file name for this diagram.
1070 :     my $file = "$img_base.$ext";
1071 :     # If it exists, try to open it.
1072 :     if (-f $file) {
1073 :     $fh = Open(undef, "<$file");
1074 :     $type = $myType;
1075 :     }
1076 :     }
1077 :     # Return the result.
1078 :     return ($type, $fh);
1079 :     }
1080 :    
1081 : parrello 1.1
1082 : parrello 1.12 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3