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

Annotation of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3