Parent Directory
| 
Revision Log
Revision 1.9 - (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.8 | |
| 563 : | |||
| 564 : | parrello | 1.4 | =head3 get_diagrams |
| 565 : | |||
| 566 : | C<< my @list = $sub->get_diagrams(); >> | ||
| 567 : | |||
| 568 : | Return a list of the diagrams associated with this subsystem. Each diagram | ||
| 569 : | is represented in the return list as a 4-tuple C<[diagram_id, diagram_name, | ||
| 570 : | page_link, img_link]> where | ||
| 571 : | |||
| 572 : | =over 4 | ||
| 573 : | |||
| 574 : | =item diagram_id | ||
| 575 : | |||
| 576 : | ID code for this diagram. | ||
| 577 : | |||
| 578 : | =item diagram_name | ||
| 579 : | |||
| 580 : | Displayable name of the diagram. | ||
| 581 : | |||
| 582 : | =item page_link | ||
| 583 : | |||
| 584 : | URL of an HTML page containing information about the diagram. | ||
| 585 : | |||
| 586 : | =item img_link | ||
| 587 : | |||
| 588 : | URL of an HTML page containing an image for the diagram. | ||
| 589 : | |||
| 590 : | =back | ||
| 591 : | |||
| 592 : | Note that the URLs are in fact for CGI scripts with parameters that point them | ||
| 593 : | to the correct place. Though Sprout has diagram information in it, it has | ||
| 594 : | no relationship to the diagrams displayed in SEED, so the work is done entirely | ||
| 595 : | on the SEED side. | ||
| 596 : | |||
| 597 : | =cut | ||
| 598 : | |||
| 599 : | sub get_diagrams { | ||
| 600 : | # Get the parameters. | ||
| 601 : | my ($self) = @_; | ||
| 602 : | # Get the diagram IDs. | ||
| 603 : | parrello | 1.9 | my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir}); |
| 604 : | parrello | 1.6 | Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3); |
| 605 : | parrello | 1.4 | # Create the return variable. |
| 606 : | my @retVal = (); | ||
| 607 : | # Loop through the diagram IDs. | ||
| 608 : | for my $diagramID (@diagramIDs) { | ||
| 609 : | parrello | 1.6 | Trace("Processing diagram $diagramID.") if T(3); |
| 610 : | parrello | 1.9 | my ($name, $link, $imgLink) = $self->get_diagram($diagramID); |
| 611 : | Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3); | ||
| 612 : | parrello | 1.6 | push @retVal, [$diagramID, $name, $link, $imgLink]; |
| 613 : | parrello | 1.4 | } |
| 614 : | parrello | 1.6 | # Return the result. |
| 615 : | return @retVal; | ||
| 616 : | parrello | 1.4 | } |
| 617 : | |||
| 618 : | parrello | 1.9 | =head3 get_diagram |
| 619 : | |||
| 620 : | C<< my ($name, $pageURL, $imgURL) = $sub->get_diagram($id); >> | ||
| 621 : | |||
| 622 : | Get the information (if any) for the specified diagram. The diagram corresponds | ||
| 623 : | to a subdirectory of the subsystem's C<diagrams> directory. For example, if the | ||
| 624 : | diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>, | ||
| 625 : | where I<$dir> is the subsystem directory. The diagram's name is extracted from | ||
| 626 : | a tiny file containing the name, and then the links are computed using the | ||
| 627 : | subsystem name and the diagram ID. The parameters are as follows. | ||
| 628 : | |||
| 629 : | =over 4 | ||
| 630 : | |||
| 631 : | =item id | ||
| 632 : | |||
| 633 : | ID code for the desired diagram. | ||
| 634 : | |||
| 635 : | =item RETURN | ||
| 636 : | |||
| 637 : | Returns a three-element list. The first element is the diagram name, the second | ||
| 638 : | a URL for displaying information about the diagram, and the third a URL for | ||
| 639 : | displaying the diagram image. | ||
| 640 : | |||
| 641 : | =back | ||
| 642 : | |||
| 643 : | =cut | ||
| 644 : | |||
| 645 : | sub get_diagram { | ||
| 646 : | my($self, $id) = @_; | ||
| 647 : | my $name = Subsystem::GetDiagramName($self->{dir}, $id); | ||
| 648 : | my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self->{name}, $id, 1); | ||
| 649 : | return($name, $link, $img_link); | ||
| 650 : | } | ||
| 651 : | |||
| 652 : | |||
| 653 : | =head3 get_diagram_html_file | ||
| 654 : | |||
| 655 : | C<< my $fileName = $sub->get_diagram_html_file($id); >> | ||
| 656 : | |||
| 657 : | Get the HTML file (if any) for the specified diagram. The diagram corresponds | ||
| 658 : | to a subdirectory of the subsystem's C<diagrams> directory. For example, if the | ||
| 659 : | diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>, | ||
| 660 : | where I<$dir> is the subsystem directory. If an HTML file exists, it will be | ||
| 661 : | named C<diagram.html> in the diagram directory. The parameters are as follows. | ||
| 662 : | |||
| 663 : | =over 4 | ||
| 664 : | |||
| 665 : | =item id | ||
| 666 : | |||
| 667 : | ID code for the desired diagram. | ||
| 668 : | |||
| 669 : | =item RETURN | ||
| 670 : | |||
| 671 : | Returns the name of an HTML diagram file, or C<undef> if no such file exists. | ||
| 672 : | |||
| 673 : | =back | ||
| 674 : | |||
| 675 : | =cut | ||
| 676 : | |||
| 677 : | sub get_diagram_html_file { | ||
| 678 : | my ($self, $id) = @_; | ||
| 679 : | my $retVal; | ||
| 680 : | my $ddir = "$self->{dir}/diagrams/$id"; | ||
| 681 : | if (-d $ddir) { | ||
| 682 : | my $html = "$ddir/diagram.html"; | ||
| 683 : | if (-f $html) { | ||
| 684 : | $retVal = $html; | ||
| 685 : | } | ||
| 686 : | } | ||
| 687 : | return $retVal; | ||
| 688 : | } | ||
| 689 : | |||
| 690 : | =head3 get_name | ||
| 691 : | |||
| 692 : | C<< my $name = $sub->get_name(); >> | ||
| 693 : | |||
| 694 : | Return the name of this subsystem. | ||
| 695 : | |||
| 696 : | =cut | ||
| 697 : | |||
| 698 : | sub get_name { | ||
| 699 : | # Get the parameters. | ||
| 700 : | my ($self) = @_; | ||
| 701 : | # Return the result. | ||
| 702 : | return $self->{name}; | ||
| 703 : | } | ||
| 704 : | |||
| 705 : | =head3 open_diagram_image | ||
| 706 : | |||
| 707 : | C<< my ($type, $fh) = $sub->open_diagram_image($id); >> | ||
| 708 : | |||
| 709 : | Open a diagram's image file and return the type and file handle. | ||
| 710 : | |||
| 711 : | =over 4 | ||
| 712 : | |||
| 713 : | =item id | ||
| 714 : | |||
| 715 : | ID of the desired diagram | ||
| 716 : | |||
| 717 : | =item RETURN | ||
| 718 : | |||
| 719 : | Returns a 2-tuple containing the diagram's MIME type and an open filehandle | ||
| 720 : | for the diagram's data. If the diagram does not exist, the type will be | ||
| 721 : | returned as <undef>. | ||
| 722 : | |||
| 723 : | =back | ||
| 724 : | |||
| 725 : | =cut | ||
| 726 : | |||
| 727 : | sub open_diagram_image { | ||
| 728 : | # Get the parameters. | ||
| 729 : | my ($self, $id) = @_; | ||
| 730 : | # Declare the return variables. | ||
| 731 : | my ($type, $fh); | ||
| 732 : | # Get the diagram directory. | ||
| 733 : | my $img_base = "$self->{dir}/diagrams/$id/diagram"; | ||
| 734 : | # Get a list of file extensions and types. | ||
| 735 : | my %types = (png => "image/png", | ||
| 736 : | gif => "image/gif", | ||
| 737 : | jpg => "image/jpeg"); | ||
| 738 : | # This is my new syntax for the for-each-while loop. | ||
| 739 : | # We loop until we run out of keys or come up with a type value. | ||
| 740 : | for my $ext (keys %types) { last if (defined $type); | ||
| 741 : | my $myType = $types{$ext}; | ||
| 742 : | # Compute a file name for this diagram. | ||
| 743 : | my $file = "$img_base.$ext"; | ||
| 744 : | # If it exists, try to open it. | ||
| 745 : | if (-f $file) { | ||
| 746 : | $fh = Open(undef, "<$file"); | ||
| 747 : | $type = $myType; | ||
| 748 : | } | ||
| 749 : | } | ||
| 750 : | # Return the result. | ||
| 751 : | return ($type, $fh); | ||
| 752 : | } | ||
| 753 : | |||
| 754 : | parrello | 1.1 | |
| 755 : | parrello | 1.4 | 1; |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |