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

Annotation of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3