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

Annotation of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (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 :     =back
73 :    
74 :     =cut
75 :    
76 :     #: Constructor SproutSubsys->new();
77 :    
78 :     =head2 Public Methods
79 :    
80 :     =head3 new
81 :    
82 :     C<< my $sub = Subsystem->new($subName, $sprout); >>
83 :    
84 :     Load the subsystem.
85 :    
86 :     =over 4
87 :    
88 :     =item subName
89 :    
90 :     Name of the desired subsystem.
91 :    
92 :     =item sprout
93 :    
94 :     Sprout or SFXlate object for accessing the Sprout data store.
95 :    
96 :     =back
97 :    
98 :     =cut
99 :    
100 :     sub new {
101 :     # Get the parameters.
102 :     my ($class, $subName, $sprout) = @_;
103 :     # Insure we have a Sprout object.
104 :     if (ref $sprout eq 'SFXlate') {
105 :     $sprout = $sprout->{sprout};
106 :     }
107 :     # Declare the return value.
108 :     my $retVal;
109 :     # Get the subsystem's data fields.
110 :     my ($curator, $notes) = $sprout->GetEntityValues('Subsystem', $subName, ['Subsystem(curator)',
111 :     'Subsystem(notes)']);
112 :     # Only proceed if we found the subsystem.
113 :     if (defined $curator) {
114 :     # Get the genome IDs and variant codes for the rows. The list returned
115 :     # by GetAll will be a list of 2-tuples, each consisting of a genome ID
116 :     # and a subsystem variant code.
117 :     my @genomes = $sprout->GetAll(['ParticipatesIn'],
118 :     'ParticipatesIn(to-link) = ? ORDER BY ParticipatesIn(variant-code), ParticipatesIn(from-link)',
119 :     [$subName], ['ParticipatesIn(from-link)',
120 :     'ParticipatesIn(variant-code)']);
121 :     # Create the genome ID directory. This is a hash that maps a genome ID to its
122 :     # row index.
123 :     my $idx = 0;
124 :     my %genomeHash = map { $_->[0] => $idx++ } @genomes;
125 :     # Get the role IDs and abbreviations. The list returned by GetAll will be
126 :     # a list of 2-tuples, each consisting of a role ID and abbreviation. The
127 :     # 2-tuples will be ordered by the spreadsheet column number.
128 :     my @roles = $sprout->GetAll(['OccursInSubsystem', 'Role'],
129 :     'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
130 :     [$subName], ['OccursInSubsystem(from-link)', 'Role(abbr)']);
131 :     # Now we need to create the role ID directory and the reaction hash.
132 :     # The role ID directory maps role IDs and their abbreviations to column numbers.
133 :     # The reaction hash maps a role ID to a list of the IDs for the reactions it
134 :     # catalyzes.
135 :     my %roleHash = ();
136 :     my %reactionHash = ();
137 :     for ($idx = 0; $idx <= $#roles; $idx++) {
138 :     # Get the role ID and abbreviation for this column's role.
139 :     my ($roleID, $abbr) = @{$roles[$idx]};
140 :     # Put them both in the role directory.
141 :     $roleHash{$roleID} = $idx;
142 :     $roleHash{$abbr} = $idx;
143 :     # Get this role's reactions.
144 :     my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
145 :     [$roleID], 'Catalyzes(to-link)');
146 :     # Put them in the reaction hash.
147 : parrello 1.3 if (@reactions > 0) {
148 :     $reactionHash{$roleID} = \@reactions;
149 :     }
150 : parrello 1.1 }
151 : parrello 1.9 # Find the subsystem directory.
152 :     my $subDir = Subsystem::get_dir_from_name($subName);
153 :     Trace("Subsystem directory is $subDir.") if T(3);
154 : parrello 1.1 # Create the subsystem object.
155 :     $retVal = {
156 :     # Name of the subsystem. This is needed for any further database
157 :     # accesses required.
158 :     name => $subName,
159 : parrello 1.9 # Directory root for diagram and image files.
160 :     dir => $subDir,
161 : parrello 1.1 # Name of the subsystem's official curator.
162 :     curator => $curator,
163 :     # General notes about the subsystem.
164 :     notes => $notes,
165 :     # Sprout object for accessing the database.
166 :     sprout => $sprout,
167 :     # Map of genome IDs to row indices.
168 :     genomeHash => \%genomeHash,
169 :     # List of [genomeID, variantCode] tuples in row order.
170 :     genomes => \@genomes,
171 :     # Map of role IDs and abbreviations to column indices.
172 :     roleHash => \%roleHash,
173 :     # List of [roleID, abbreviation] tuples in column order.
174 :     roles => \@roles,
175 :     # Map of PEG IDs to cluster numbers.
176 :     colorHash => {},
177 : parrello 1.2 # Map of role IDs to reactions.
178 :     reactionHash => \%reactionHash,
179 : parrello 1.1 };
180 :     # Bless and return it.
181 :     bless $retVal, $class;
182 :     }
183 :     return $retVal;
184 :     }
185 :    
186 :     =head3 get_genomes
187 :    
188 :     C<< my @genomeList = $sub->get_genomes(); >>
189 :    
190 :     Return a list of the genome IDs for this subsystem. Each genome corresponds to a row
191 :     in the subsystem spreadsheet. Indexing into this list returns the ID of the genome
192 :     in the specified row.
193 :    
194 :     =cut
195 :    
196 :     sub get_genomes {
197 :     # Get the parameters.
198 :     my ($self) = @_;
199 :     # Return a list of the genome IDs. The "genomes" member contains a 2-tuple
200 :     # with the genome ID followed by the variant code. We only return the
201 :     # genome IDs.
202 :     my @retVal = map { $_->[0] } @{$self->{genomes}};
203 :     return @retVal;
204 :     }
205 :    
206 :     =head3 get_variant_code
207 :    
208 :     C<< my $code = $sub->get_variant_code($gidx); >>
209 :    
210 :     Return the variant code for the specified genome. Each subsystem has multiple
211 :     variants which involve slightly different chemical reactions, and each variant
212 :     has an associated variant code. When a genome is connected to the spreadsheet,
213 :     the subsystem variant used by the genome must be specified.
214 :    
215 :     =over 4
216 :    
217 :     =item gidx
218 :    
219 :     Row index for the genome whose variant code is desired.
220 :    
221 :     =item RETURN
222 :    
223 :     Returns the variant code for the specified genome.
224 :    
225 :     =back
226 :    
227 :     =cut
228 :    
229 :     sub get_variant_code {
230 :     # Get the parameters.
231 :     my ($self, $gidx) = @_;
232 :     # Extract the variant code for the specified row index. It is the second
233 :     # element of the tuple from the "genomes" member.
234 : parrello 1.5 my $retVal = $self->{genomes}->[$gidx]->[1];
235 : parrello 1.1 return $retVal;
236 :     }
237 :    
238 :     =head3 get_curator
239 :    
240 :     C<< my $userName = $sub->get_curator(); >>
241 :    
242 :     Return the name of this subsystem's official curator.
243 :    
244 :     =cut
245 :    
246 :     sub get_curator {
247 :     # Get the parameters.
248 :     my ($self) = @_;
249 :     # Return the curator member.
250 :     return $self->{curator};
251 :     }
252 :    
253 :     =head3 get_notes
254 :    
255 :     C<< my $text = $sub->get_notes(); >>
256 :    
257 :     Return the descriptive notes for this subsystem.
258 :    
259 :     =cut
260 :    
261 :     sub get_notes {
262 :     # Get the parameters.
263 :     my ($self) = @_;
264 :     # Return the notes member.
265 :     return $self->{notes};
266 :     }
267 :    
268 :     =head3 get_roles
269 :    
270 :     C<< my @roles = $sub->get_roles(); >>
271 :    
272 :     Return a list of the subsystem's roles. Each role corresponds to a column
273 :     in the subsystem spreadsheet. The list entry at a specified position in
274 :     the list will contain the ID of that column's role.
275 :    
276 :     =cut
277 :    
278 :     sub get_roles {
279 :     # Get the parameters.
280 :     my ($self) = @_;
281 :     # Return the list of role IDs. The role IDs are stored as the first
282 :     # element of each 2-tuple in the "roles" member.
283 :     my @retVal = map { $_->[0] } @{$self->{roles}};
284 :     return @retVal;
285 :     }
286 :    
287 :     =head3 get_reactions
288 :    
289 :     C<< my $reactHash = $sub->get_reactions(); >>
290 :    
291 :     Return a reference to a hash that maps each role ID to a list of the reactions
292 :     catalyzed by the role.
293 :    
294 :     =cut
295 :    
296 :     sub get_reactions {
297 :     # Get the parameters.
298 :     my ($self) = @_;
299 :     # Return the reaction hash member.
300 :     return $self->{reactionHash};
301 :     }
302 :    
303 :     =head3 get_subset_namesC
304 :    
305 :     C<< my @subsetNames = $sub->get_subset_namesC(); >>
306 :    
307 :     Return a list of the names for all the column (role) subsets. Given a subset
308 :     name, you can use the L</get_subsetC_roles> method to get the roles in the
309 :     subset.
310 :    
311 :     =cut
312 :    
313 :     sub get_subset_namesC {
314 :     # Get the parameters.
315 :     my ($self) = @_;
316 :     # Get the sprout object and use it to retrieve the subset names.
317 :     my $sprout = $self->{sprout};
318 :     my @subsets = $sprout->GetFlat(['HasRoleSubset'], 'HasRoleSubset(from-link) = ?',
319 :     [$self->{name}], 'HasRoleSubset(to-link)');
320 :     # The sprout subset names are prefixed by the subsystem name. We need to pull the
321 :     # prefix off before we return the results. The prefixing character is a colon (:),
322 :     # so we search for the last colon to get ourselves the true subset name.
323 :     my @retVal = map { $_ =~ /:([^:]+)$/; $1 } @subsets;
324 :     return @retVal;
325 :     }
326 :    
327 :     =head3 get_role_abbr
328 :    
329 :     C<< my $abbr = $sub->get_role_abbr($ridx); >>
330 :    
331 :     Return the abbreviation for the role in the specified column. The abbreviation
332 :     is a shortened identifier that is not necessarily unique, but is more likely to
333 :     fit in a column heading.
334 :    
335 :     =over 4
336 :    
337 :     =item ridx
338 :    
339 :     Column index for the role whose abbreviation is desired.
340 :    
341 :     =item RETURN
342 :    
343 :     Returns an abbreviated name for the role corresponding to the indexed column.
344 :    
345 :     =back
346 :    
347 :     =cut
348 :    
349 :     sub get_role_abbr {
350 :     # Get the parameters.
351 :     my ($self, $ridx) = @_;
352 :     # Return the role abbreviation. The abbreviation is the second element
353 :     # in the 2-tuple for the specified column in the "roles" member.
354 :     my $retVal = $self->{roles}->[$ridx]->[1];
355 :     return $retVal;
356 :     }
357 :    
358 :     =head3 get_role_index
359 :    
360 :     C<< my $idx = $sub->get_role_index($role); >>
361 :    
362 :     Return the column index for the role with the specified ID.
363 :    
364 :     =over 4
365 :    
366 :     =item role
367 :    
368 :     ID (full name) or abbreviation of the role whose column index is desired.
369 :    
370 :     =item RETURN
371 :    
372 :     Returns the column index for the role with the specified name or abbreviation.
373 :    
374 :     =back
375 :    
376 :     =cut
377 :    
378 :     sub get_role_index {
379 :     # Get the parameters.
380 :     my ($self, $role) = @_;
381 :     # The role index is directly available from the "roleHash" member.
382 :     my $retVal = $self->{roleHash}->{$role};
383 :     return $retVal;
384 :     }
385 :    
386 :     =head3 get_subsetC_roles
387 :    
388 :     C<< my @roles = $sub->get_subsetC_roles($subname); >>
389 :    
390 :     Return the names of the roles contained in the specified role (column) subset.
391 :    
392 :     =over 4
393 :    
394 :     =item subname
395 :    
396 :     Name of the role subset whose roles are desired.
397 :    
398 :     =item RETURN
399 :    
400 :     Returns a list of the role names for the columns in the named subset.
401 :    
402 :     =back
403 :    
404 :     =cut
405 :    
406 :     sub get_subsetC_roles {
407 :     # Get the parameters.
408 :     my ($self, $subname) = @_;
409 :     # Get the sprout object. We need it to be able to get the subset data.
410 :     my $sprout = $self->{sprout};
411 :     # Convert the subset name to Sprout format. In Sprout, the subset name is
412 :     # prefixed by the subsystem name in order to get a unique subset ID.
413 :     my $subsetID = $self->{name} . ":$subname";
414 :     # Get a list of the role names for this subset.
415 :     my @roleNames = $sprout->GetFlat(['ConsistsOfRoles'], 'ConsistsOfRoles(from-link) = ?',
416 :     [$subsetID], 'ConsistsOfRoles(to-link)');
417 :     # Sort them by column number. We get the column number from the role hash.
418 :     my $roleHash = $self->{roleHash};
419 :     my @retVal = sort { $roleHash->{$a} <=> $roleHash->{$b} } @roleNames;
420 :     # Return the sorted list.
421 :     return @retVal;
422 :     }
423 :    
424 :     =head3 get_genome_index
425 :    
426 :     C<< my $idx = $sub->get_genome_index($genome); >>
427 :    
428 :     Return the row index for the genome with the specified ID.
429 :    
430 :     =over 4
431 :    
432 :     =item genome
433 :    
434 :     ID of the genome whose row index is desired.
435 :    
436 :     =item RETURN
437 :    
438 :     Returns the row index for the genome with the specified ID, or an undefined
439 :     value if the genome does not participate in the subsystem.
440 :    
441 :     =back
442 :    
443 :     =cut
444 :    
445 :     sub get_genome_index {
446 :     # Get the parameters.
447 :     my ($self, $genome) = @_;
448 :     # Get the genome row index from the "genomeHash" member.
449 :     my $retVal = $self->{genomeHash}->{$genome};
450 :     return $retVal;
451 :     }
452 :    
453 :     =head3 get_cluster_number
454 :    
455 :     C<< my $number = $sub->get_cluster_number($pegID); >>
456 :    
457 :     Return the cluster number for the specified PEG, or C<-1> if the
458 :     cluster number for the PEG is unknown or it is not clustered.
459 :    
460 :     The cluster number is read into the color hash by the
461 :     L</get_pegs_from_cell> method. If the incoming PEG IDs do not
462 :     come from the most recent cell retrievals, the information returned
463 :     will be invalid. This is a serious design flaw which needs to be
464 :     fixed soon.
465 :    
466 :     =over 4
467 :    
468 :     =item pegID
469 :    
470 :     ID of the PEG whose cluster number is desired.
471 : parrello 1.4
472 :     =item RETURN
473 :    
474 :     Returns the appropriate cluster number.
475 : parrello 1.1
476 :     =back
477 :    
478 :     =cut
479 :     #: Return Type $;
480 :     sub get_cluster_number {
481 :     # Get the parameters.
482 :     my ($self, $pegID) = @_;
483 :     # Declare the return variable.
484 :     my $retVal = -1;
485 :     # Check for a cluster number in the color hash.
486 :     if (exists $self->{colorHash}->{$pegID}) {
487 :     $retVal = $self->{colorHash}->{$pegID};
488 :     }
489 :     # Return the result.
490 :     return $retVal;
491 :     }
492 :    
493 :     =head3 get_pegs_from_cell
494 :    
495 :     C<< my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr); >>
496 :    
497 :     Return a list of the peg IDs for the features in the specified spreadsheet cell.
498 :    
499 :     =over 4
500 :    
501 :     =item rowstr
502 :    
503 :     Genome row, specified either as a row index or a genome ID.
504 :    
505 :     =item colstr
506 :    
507 :     Role column, specified either as a column index, a role name, or a role
508 :     abbreviation.
509 :    
510 :     =item RETURN
511 :    
512 :     Returns a list of PEG IDs. The PEGs in the list belong to the genome in the
513 :     specified row and perform the role in the specified column. If the indicated
514 :     row and column does not exist, returns an empty list.
515 :    
516 :     =back
517 :    
518 :     =cut
519 :    
520 :     sub get_pegs_from_cell {
521 :     # Get the parameters.
522 :     my ($self, $rowstr, $colstr) = @_;
523 :     # Get the sprout object for accessing the database.
524 :     my $sprout = $self->{sprout};
525 :     # We need to convert the incoming row and column identifiers. We need a
526 :     # numeric column index and a character genome ID to create the ID for the
527 :     # subsystem spreadsheet cell. First, the column index: note that our version
528 :     # of "get_role_index" conveniently works for both abbreviations and full role IDs.
529 :     my $colIdx = ($colstr =~ /^(\d+)$/ ? $colstr : $self->get_role_index($colstr));
530 :     # Next the genome ID. In this case, we convert any number we find to a string.
531 :     # This requires a little care to avoid a run-time error if the row number is
532 :     # out of range.
533 :     my $genomeID = $rowstr;
534 :     if ($rowstr =~ /^(\d+)$/) {
535 :     # Here we need to convert the row number to an ID. Insure the number is in
536 :     # range. Note that if we do have a row number out of range, the genome ID
537 :     # will be invalid, and our attempt to read from the database will return an
538 :     # empty list.
539 :     my $genomeList = $self->{genomes};
540 :     if ($rowstr >= 0 && $rowstr < @{$genomeList}) {
541 :     $genomeID = $genomeList->[$rowstr]->[0];
542 :     }
543 :     }
544 :     # Construct the spreadsheet cell ID from the information we have.
545 : parrello 1.7 my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
546 : parrello 1.1 # Get the list of PEG IDs and cluster numbers for the indicated cell.
547 :     my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
548 :     [$cellID], ['ContainsFeature(to-link)',
549 :     'ContainsFeature(cluster-number)']);
550 :     # Copy the pegs into the return list, and save the cluster numbers in the color hash.
551 :     my @retVal = ();
552 :     for my $pegEntry (@pegList) {
553 :     my ($peg, $cluster) = @{$pegEntry};
554 :     $self->{colorHash}->{$peg} = $cluster;
555 :     push @retVal, $peg;
556 :     }
557 :     # Return the list. If the spreadsheet cell was empty or non-existent, we'll end
558 :     # up returning an empty list.
559 :     return @retVal;
560 :     }
561 :    
562 : parrello 1.10 =head3 get_subsetR
563 : parrello 1.8
564 : parrello 1.10 C<< my @genomes = $sub->get_subsetR($subName); >>
565 :    
566 :     Return the genomes in the row subset indicated by the specified subset name.
567 :    
568 :     =over 4
569 :    
570 :     =item subName
571 :    
572 :     Name of the desired row subset, or C<All> to get all of the rows.
573 :    
574 :     =item RETURN
575 :    
576 :     Returns a list of genome IDs corresponding to the named subset.
577 :    
578 :     =back
579 :    
580 :     =cut
581 :    
582 :     sub get_subsetR {
583 :     # Get the parameters.
584 :     my ($self, $subName) = @_;
585 :     # Look for the specified row subset in the database. A row subset is identified using
586 :     # the subsystem name and the subset name. The special subset "All" is actually
587 :     # represented in the database, so we don't need to check for it.
588 :     my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
589 :     ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
590 :     return @rows;
591 :     }
592 : parrello 1.8
593 : parrello 1.4 =head3 get_diagrams
594 :    
595 :     C<< my @list = $sub->get_diagrams(); >>
596 :    
597 :     Return a list of the diagrams associated with this subsystem. Each diagram
598 :     is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,
599 :     page_link, img_link]> where
600 :    
601 :     =over 4
602 :    
603 :     =item diagram_id
604 :    
605 :     ID code for this diagram.
606 :    
607 :     =item diagram_name
608 :    
609 :     Displayable name of the diagram.
610 :    
611 :     =item page_link
612 :    
613 :     URL of an HTML page containing information about the diagram.
614 :    
615 :     =item img_link
616 :    
617 :     URL of an HTML page containing an image for the diagram.
618 :    
619 :     =back
620 :    
621 :     Note that the URLs are in fact for CGI scripts with parameters that point them
622 :     to the correct place. Though Sprout has diagram information in it, it has
623 :     no relationship to the diagrams displayed in SEED, so the work is done entirely
624 :     on the SEED side.
625 :    
626 :     =cut
627 :    
628 :     sub get_diagrams {
629 :     # Get the parameters.
630 :     my ($self) = @_;
631 :     # Get the diagram IDs.
632 : parrello 1.9 my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
633 : parrello 1.6 Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
634 : parrello 1.4 # Create the return variable.
635 :     my @retVal = ();
636 :     # Loop through the diagram IDs.
637 :     for my $diagramID (@diagramIDs) {
638 : parrello 1.6 Trace("Processing diagram $diagramID.") if T(3);
639 : parrello 1.9 my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
640 :     Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3);
641 : parrello 1.6 push @retVal, [$diagramID, $name, $link, $imgLink];
642 : parrello 1.4 }
643 : parrello 1.6 # Return the result.
644 :     return @retVal;
645 : parrello 1.4 }
646 :    
647 : parrello 1.9 =head3 get_diagram
648 :    
649 :     C<< my ($name, $pageURL, $imgURL) = $sub->get_diagram($id); >>
650 :    
651 :     Get the information (if any) for the specified diagram. The diagram corresponds
652 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
653 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
654 :     where I<$dir> is the subsystem directory. The diagram's name is extracted from
655 :     a tiny file containing the name, and then the links are computed using the
656 :     subsystem name and the diagram ID. The parameters are as follows.
657 :    
658 :     =over 4
659 :    
660 :     =item id
661 :    
662 :     ID code for the desired diagram.
663 :    
664 :     =item RETURN
665 :    
666 :     Returns a three-element list. The first element is the diagram name, the second
667 :     a URL for displaying information about the diagram, and the third a URL for
668 :     displaying the diagram image.
669 :    
670 :     =back
671 :    
672 :     =cut
673 :    
674 :     sub get_diagram {
675 :     my($self, $id) = @_;
676 :     my $name = Subsystem::GetDiagramName($self->{dir}, $id);
677 :     my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self->{name}, $id, 1);
678 :     return($name, $link, $img_link);
679 :     }
680 :    
681 :    
682 :     =head3 get_diagram_html_file
683 :    
684 :     C<< my $fileName = $sub->get_diagram_html_file($id); >>
685 :    
686 :     Get the HTML file (if any) for the specified diagram. The diagram corresponds
687 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
688 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
689 :     where I<$dir> is the subsystem directory. If an HTML file exists, it will be
690 :     named C<diagram.html> in the diagram directory. The parameters are as follows.
691 :    
692 :     =over 4
693 :    
694 :     =item id
695 :    
696 :     ID code for the desired diagram.
697 :    
698 :     =item RETURN
699 :    
700 :     Returns the name of an HTML diagram file, or C<undef> if no such file exists.
701 :    
702 :     =back
703 :    
704 :     =cut
705 :    
706 :     sub get_diagram_html_file {
707 :     my ($self, $id) = @_;
708 :     my $retVal;
709 :     my $ddir = "$self->{dir}/diagrams/$id";
710 :     if (-d $ddir) {
711 :     my $html = "$ddir/diagram.html";
712 :     if (-f $html) {
713 :     $retVal = $html;
714 :     }
715 :     }
716 :     return $retVal;
717 :     }
718 :    
719 :     =head3 get_name
720 :    
721 :     C<< my $name = $sub->get_name(); >>
722 :    
723 :     Return the name of this subsystem.
724 :    
725 :     =cut
726 :    
727 :     sub get_name {
728 :     # Get the parameters.
729 :     my ($self) = @_;
730 :     # Return the result.
731 :     return $self->{name};
732 :     }
733 :    
734 :     =head3 open_diagram_image
735 :    
736 :     C<< my ($type, $fh) = $sub->open_diagram_image($id); >>
737 :    
738 :     Open a diagram's image file and return the type and file handle.
739 :    
740 :     =over 4
741 :    
742 :     =item id
743 :    
744 :     ID of the desired diagram
745 :    
746 :     =item RETURN
747 :    
748 :     Returns a 2-tuple containing the diagram's MIME type and an open filehandle
749 :     for the diagram's data. If the diagram does not exist, the type will be
750 :     returned as <undef>.
751 :    
752 :     =back
753 :    
754 :     =cut
755 :    
756 :     sub open_diagram_image {
757 :     # Get the parameters.
758 :     my ($self, $id) = @_;
759 :     # Declare the return variables.
760 :     my ($type, $fh);
761 :     # Get the diagram directory.
762 :     my $img_base = "$self->{dir}/diagrams/$id/diagram";
763 :     # Get a list of file extensions and types.
764 :     my %types = (png => "image/png",
765 :     gif => "image/gif",
766 :     jpg => "image/jpeg");
767 :     # This is my new syntax for the for-each-while loop.
768 :     # We loop until we run out of keys or come up with a type value.
769 :     for my $ext (keys %types) { last if (defined $type);
770 :     my $myType = $types{$ext};
771 :     # Compute a file name for this diagram.
772 :     my $file = "$img_base.$ext";
773 :     # If it exists, try to open it.
774 :     if (-f $file) {
775 :     $fh = Open(undef, "<$file");
776 :     $type = $myType;
777 :     }
778 :     }
779 :     # Return the result.
780 :     return ($type, $fh);
781 :     }
782 :    
783 : parrello 1.1
784 : parrello 1.4 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3