Beautiful Code [178]
The definition of the option() method occupies lines 22–31. I read the factory object and the requested option name from the subroutine argument list. I then call the built-in lc() function to put the option name into lowercase, in order to shield the method's behavior from developers who forget whether an option is named -height or -Height. I look for the existence of a like-named key in the options hash that I created in new(), and if it is present, I return the corresponding value. Otherwise, I use the option name to index into %GENERIC_OPTIONS and return that value. If there is no corresponding key in either the options hash or %GENERIC_OPTIONS, I end up returning an undefined value.
The make_glyph() method (lines 32–44) demonstrates how Perl can dynamically load a module at runtime. I first look up the desired glyph type by using option() to look up the value of the glyph option. Note that the key/value pair glyph=>'generic' is defined in %GENERIC_OPTIONS; this means that if the programmer neglected to ask for a specific glyph type, option() returns generic.
I now load the requested glyph class if needed. By convention, all subclasses of Bio:: Graphics::Glyph are named Bio::Graphics::Glyph:subclass_name. The generic glyph has a Perl class of Bio::Graphics::Glyph::generic, the arrow glyph lives in Bio::Graphics::Glyph:: arrow, and so forth. I use a string concatention operation (.) to create the fully qualified class name. I then compile and load this class into memory using require $glyph_class. The call to require is wrapped inside a string and passed to the Perl compiler using eval(). This is done to prevent Perl from trying to invoke require() at the time the Factory definition is compiled. To avoid unnecessary recompilation, I load the class only if I detect that its new() constructor does not already exist, indicating that the class is not yet loaded.
I loop through each feature passed in the @_ subroutine argument array, invoking the selected glyph class's new() constructor. Each newly created glyph is placed on an array, which I then return to the caller.
The last line of the module is 1, which ends all Perl modules for mostly historical reasons.
Notice that the design of the glyph constructor has now been extended so that each glyph is constructed using two named arguments: the feature and the factory object. By passing a copy of the factory, each glyph can get at its relevant options. Here are excerpts of two relevant methods from Bio::Graphics::Glyph:
factory( )
This returns the factory object that was passed to the glyph when it was constructed:
sub factory {
my $self = shift;
return $self->{factory};
}
option( )
This is a pass-through method to get the value of a named option:
sub option {
my $self = shift;
my ($option_name) = @_;
return $self->factory->option($option_name);
}
The glyph calls factory() to get its factory and immediately calls the factory's option() method to get the value of the option specified on the subroutine argument list.
12.2.5. Code Example
To put it all together, Example 12-4 is a simple illustration of Bio::Graphics in action. Its output is shown in Figure 12-2.
Example 12-4. A script that uses Bio::Graphics
Code View: Scroll / Show All
1 #!/usr/bin/perl
2 use strict;
3 use Bio::Graphics;
4 use Bio::SeqFeature::Generic;
5 my $bsg = 'Bio::SeqFeature::Generic';
6 my $span = $bsg->new(-start=>1,-end=>1000);
7 my $test1_feat = $bsg->new(-start=>300,-end=>700,
8 -display_name=>'Test Feature',
9 -source_tag=>'This is only a test');
10 my $test2_feat = $bsg->new(-start=>650,-end=>800,
11 -display_name=>'Test Feature 2');
12 my $panel = Bio::Graphics::Panel->new(-width=>600,-length=>$span->length,
13 -pad_left=>12,-pad_right=>12);
14 $panel->add_track($span,-glyph=>'arrow',-double=>1,-tick=>2);
15 $panel->add_track([$test1_feat,$test2_feat],
16 -glyph => 'box',
17 -bgcolor =>