File Coverage

blib/lib/Bio/Phylo/Factory.pm
Criterion Covered Total %
statement 27 56 48.2
branch 5 22 22.7
condition n/a
subroutine 6 9 66.6
pod 3 3 100.0
total 41 90 45.5


line stmt bran cond sub pod time code
1             package Bio::Phylo::Factory;
2 51     51   122911 use strict;
  51         110  
  51         1360  
3 51     51   513 use Bio::Phylo::Util::Exceptions 'throw';
  51         91  
  51         2077  
4 51     51   615 use Bio::Phylo::Util::CONSTANT qw'looks_like_hash looks_like_class';
  51         89  
  51         29555  
5             our $AUTOLOAD;
6             my %class = (
7             'taxa' => 'Bio::Phylo::Taxa',
8             'taxon' => 'Bio::Phylo::Taxa::Taxon',
9             'datum' => 'Bio::Phylo::Matrices::Datum',
10             'matrix' => 'Bio::Phylo::Matrices::Matrix',
11             'characters' => 'Bio::Phylo::Matrices::Characters',
12             'character' => 'Bio::Phylo::Matrices::Character',
13             'datatype' => 'Bio::Phylo::Matrices::Datatype',
14             'forest' => 'Bio::Phylo::Forest',
15             'node' => 'Bio::Phylo::Forest::Node',
16             'tree' => 'Bio::Phylo::Forest::Tree',
17             'logger' => 'Bio::Phylo::Util::Logger',
18             'drawer' => 'Bio::Phylo::Treedrawer',
19             'treedrawer' => 'Bio::Phylo::Treedrawer',
20             'project' => 'Bio::Phylo::Project',
21             'annotation' => 'Bio::Phylo::Annotation',
22             'set' => 'Bio::Phylo::Set',
23             'generator' => 'Bio::Phylo::Generator',
24             'xmlwritable' => 'Bio::Phylo::NeXML::Writable',
25             'xmlliteral' => 'Bio::Phylo::NeXML::Meta::XMLLiteral',
26             'meta' => 'Bio::Phylo::NeXML::Meta',
27             'dom' => 'Bio::Phylo::NeXML::DOM',
28             'document' => 'Bio::Phylo::NeXML::DOM::Document',
29             'element' => 'Bio::Phylo::NeXML::DOM::Element',
30             'client' => 'Bio::Phylo::PhyloWS::Client',
31             'server' => 'Bio::Phylo::PhyloWS::Server',
32             'resource' => 'Bio::Phylo::PhyloWS::Resource',
33             'description' => 'Bio::Phylo::PhyloWS::Resource::Description',
34             );
35              
36             sub import {
37 346     346   812 my $package = shift;
38 346 50       157526 $package->register_class(@_) if @_;
39             }
40              
41             =head1 NAME
42              
43             Bio::Phylo::Factory - Creator of objects, reduces hardcoded class names in code
44              
45             =head1 SYNOPSIS
46              
47             use Bio::Phylo::Factory;
48             my $fac = Bio::Phylo::Factory->new;
49             my $node = $fac->create_node( '-name' => 'node1' );
50              
51             # probably prints 'Bio::Phylo::Forest::Node'?
52             print ref $node;
53              
54             =head1 DESCRIPTION
55              
56             The factory module is used to create other objects without having to 'use'
57             their classes. This allows for greater flexibility in Bio::Phylo's design,
58             as class names are no longer hard-coded all over the place.
59              
60             =head1 METHODS
61              
62             =head2 CONSTRUCTOR
63              
64             =over
65              
66             =item new()
67              
68             Factory constructor.
69              
70             Type : Constructor
71             Title : new
72             Usage : my $fac = Bio::Phylo::Factory->new;
73             Function: Initializes a Bio::Phylo::Factory object.
74             Returns : A Bio::Phylo::Factory object.
75             Args : (optional) a hash keyed on short names, with
76             class names for values. For example,
77             'node' => 'Bio::Phylo::Forest::Node', which
78             will allow you to subsequently call $fac->create_node,
79             which will return a Bio::Phylo::Forest::Node object.
80             (Note that this example is enabled by default, so you
81             don't need to specify it.)
82              
83             =cut
84              
85             sub new {
86 329     329 1 1360 my $class = shift;
87 329 50       1138 if (@_) {
88 0         0 my %args = looks_like_hash @_;
89 0         0 while ( my ( $key, $value ) = each %args ) {
90 0 0       0 if ( looks_like_class $value ) {
91 0         0 $class{$key} = $value;
92             }
93             }
94             }
95 329         1135 bless \$class, $class;
96             }
97              
98             =back
99              
100             =head2 FACTORY METHODS
101              
102             =over
103              
104             =item create($class, %args)
105              
106             Type : Factory methods
107             Title : create
108             Usage : my $foo = $fac->create('Foo::Class');
109             Function: Creates an instance of $class, with constructor arguments %args
110             Returns : A Bio::Phylo::* object.
111             Args : $class, a class name (required),
112             %args, constructor arguments (optional)
113              
114             =cut
115              
116             sub create {
117 0     0 1 0 my $self = shift;
118 0         0 my $class = shift;
119 0 0       0 if ( looks_like_class $class ) {
120 0         0 return $class->new(@_);
121             }
122             }
123              
124             =item register_class()
125              
126             Registers the argument class name such that subsequently
127             the factory can instantiates objects of that class. For
128             example, if you register Foo::Bar, the factory will be
129             able to instantiate objects through the create_bar()
130             method.
131              
132             Type : Factory methods
133             Title : register_class
134             Usage : $fac->register_class('Foo::Bar');
135             Function: Registers a class name for instantiation
136             Returns : Invocant
137             Args : $class, a class name (required), or
138             'bar' => 'Foo::Bar', such that you
139             can subsequently call $fac->create_bar()
140              
141             =cut
142              
143             sub register_class {
144 0     0 1 0 my ( $self, @args ) = @_;
145 0         0 my ( $short, $class );
146 0 0       0 if ( @args == 1 ) {
147 0         0 $class = $args[0];
148             }
149             else {
150 0         0 ( $short, $class ) = @args;
151             }
152 0         0 my $path = $class;
153 0         0 $path =~ s|::|/|g;
154 0         0 $path .= '.pm';
155 0 0       0 if ( not $INC{$path} ) {
156 0         0 eval { require $path };
  0         0  
157 0 0       0 if ($@) {
158 0         0 throw 'ExtensionError' => "Can't register $class - $@";
159             }
160             }
161 0 0       0 if ( not defined $short ) {
162 0         0 $short = $class;
163 0         0 $short =~ s/.*://;
164 0         0 $short = lc $short;
165             }
166 0         0 $class{$short} = $class;
167 0         0 return $self;
168             }
169              
170             # need empty destructor here so we don't autoload it
171       0     sub DESTROY {}
172              
173             sub AUTOLOAD {
174 7048     7048   14134 my $self = shift;
175 7048         9799 my $method = $AUTOLOAD;
176 7048         33406 $method =~ s/.*://;
177 7048         12414 my $type = $method;
178 7048         17541 $type =~ s/^create_//;
179 7048 50       16678 if ( exists $class{$type} ) {
    0          
180 7048         11141 my $class = $class{$type};
181 7048         9871 my $path = $class;
182 7048         20731 $path =~ s|::|/|g;
183 7048         12309 $path .= '.pm';
184 7048 100       16368 if ( not $INC{$path} ) {
185            
186             # here we need to do a string eval use so that the
187             # entire symbol table is populated
188 127         44179 require $path;
189             }
190 7048         27449 return $class{$type}->new(@_);
191             }
192             elsif ( $method =~ qr/^[A-Z]+$/ ) {
193 0           return;
194             }
195             else {
196 0           throw 'UnknownMethod' => "No such method: $method";
197             }
198             }
199              
200             =back
201              
202             =head1 SEE ALSO
203              
204             There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo>
205             for any user or developer questions and discussions.
206              
207             =over
208              
209             =item L<Bio::Phylo::Manual>
210              
211             Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>.
212              
213             =back
214              
215             =head1 CITATION
216              
217             If you use Bio::Phylo in published research, please cite it:
218              
219             B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
220             and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
221             I<BMC Bioinformatics> B<12>:63.
222             L<http://dx.doi.org/10.1186/1471-2105-12-63>
223              
224             =cut
225              
226             1;