← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:46:14 2015

Filename/Users/ap13/perl5/lib/perl5/Bio/Seq/SeqBuilder.pm
StatementsExecuted 7 statements in 948µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11114µs27µsBio::Seq::SeqBuilder::::BEGIN@128Bio::Seq::SeqBuilder::BEGIN@128
1118µs506µsBio::Seq::SeqBuilder::::BEGIN@133Bio::Seq::SeqBuilder::BEGIN@133
0000s0sBio::Seq::SeqBuilder::::add_object_conditionBio::Seq::SeqBuilder::add_object_condition
0000s0sBio::Seq::SeqBuilder::::add_slot_valueBio::Seq::SeqBuilder::add_slot_value
0000s0sBio::Seq::SeqBuilder::::add_unwanted_slotBio::Seq::SeqBuilder::add_unwanted_slot
0000s0sBio::Seq::SeqBuilder::::add_wanted_slotBio::Seq::SeqBuilder::add_wanted_slot
0000s0sBio::Seq::SeqBuilder::::get_object_conditionsBio::Seq::SeqBuilder::get_object_conditions
0000s0sBio::Seq::SeqBuilder::::get_unwanted_slotsBio::Seq::SeqBuilder::get_unwanted_slots
0000s0sBio::Seq::SeqBuilder::::get_wanted_slotsBio::Seq::SeqBuilder::get_wanted_slots
0000s0sBio::Seq::SeqBuilder::::make_objectBio::Seq::SeqBuilder::make_object
0000s0sBio::Seq::SeqBuilder::::newBio::Seq::SeqBuilder::new
0000s0sBio::Seq::SeqBuilder::::remove_object_conditionsBio::Seq::SeqBuilder::remove_object_conditions
0000s0sBio::Seq::SeqBuilder::::remove_unwanted_slotsBio::Seq::SeqBuilder::remove_unwanted_slots
0000s0sBio::Seq::SeqBuilder::::remove_wanted_slotsBio::Seq::SeqBuilder::remove_wanted_slots
0000s0sBio::Seq::SeqBuilder::::sequence_factoryBio::Seq::SeqBuilder::sequence_factory
0000s0sBio::Seq::SeqBuilder::::want_allBio::Seq::SeqBuilder::want_all
0000s0sBio::Seq::SeqBuilder::::want_noneBio::Seq::SeqBuilder::want_none
0000s0sBio::Seq::SeqBuilder::::want_objectBio::Seq::SeqBuilder::want_object
0000s0sBio::Seq::SeqBuilder::::want_slotBio::Seq::SeqBuilder::want_slot
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1#
2# BioPerl module for Bio::Seq::SeqBuilder
3#
4# Please direct questions and support issues to <bioperl-l@bioperl.org>
5#
6# Cared for by Hilmar Lapp <hlapp at gmx.net>
7#
8# Copyright Hilmar Lapp
9#
10# You may distribute this module under the same terms as perl itself
11
12#
13# (c) Hilmar Lapp, hlapp at gmx.net, 2002.
14# (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
15#
16# You may distribute this module under the same terms as perl itself.
17# Refer to the Perl Artistic License (see the license accompanying this
18# software package, or see http://www.perl.com/language/misc/Artistic.html)
19# for the terms under which you may use, modify, and redistribute this module.
20#
21# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
22# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
23# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
24#
25
26# POD documentation - main docs before the code
27
28=head1 NAME
29
30Bio::Seq::SeqBuilder - Configurable object builder for sequence stream parsers
31
32=head1 SYNOPSIS
33
34 use Bio::SeqIO;
35
36 # usually you won't instantiate this yourself - a SeqIO object -
37 # you will have one already
38 my $seqin = Bio::SeqIO->new(-fh => \*STDIN, -format => "genbank");
39 my $builder = $seqin->sequence_builder();
40
41 # if you need only sequence, id, and description (e.g. for
42 # conversion to FASTA format):
43 $builder->want_none();
44 $builder->add_wanted_slot('display_id','desc','seq');
45
46 # if you want everything except the sequence and features
47 $builder->want_all(1); # this is the default if it's untouched
48 $builder->add_unwanted_slot('seq','features');
49
50 # if you want only human sequences shorter than 5kb and skip all
51 # others
52 $builder->add_object_condition(sub {
53 my $h = shift;
54 return 0 if $h->{'-length'} > 5000;
55 return 0 if exists($h->{'-species'}) &&
56 ($h->{'-species'}->binomial() ne "Homo sapiens");
57 return 1;
58 });
59
60 # when you are finished with configuring the builder, just use
61 # the SeqIO API as you would normally
62 while(my $seq = $seqin->next_seq()) {
63 # do something
64 }
65
66=head1 DESCRIPTION
67
68This is an implementation of L<Bio::Factory::ObjectBuilderI> used by
69parsers of rich sequence streams. It provides for a relatively
70easy-to-use configurator of the parsing flow.
71
72Configuring the parsing process may be for you if you need much less
73information, or much less sequence, than the stream actually
74contains. Configuration can in both cases speed up the parsing time
75considerably, because unwanted sections or the rest of unwanted
76sequences are skipped over by the parser. This configuration could
77also conserve memory if you're running out of available RAM.
78
79See the methods of the class-specific implementation section for
80further documentation of what can be configured.
81
82=head1 FEEDBACK
83
84=head2 Mailing Lists
85
86User feedback is an integral part of the evolution of this and other
87Bioperl modules. Send your comments and suggestions preferably to
88the Bioperl mailing list. Your participation is much appreciated.
89
90 bioperl-l@bioperl.org - General discussion
91 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
92
93=head2 Support
94
95Please direct usage questions or support issues to the mailing list:
96
97I<bioperl-l@bioperl.org>
98
99rather than to the module maintainer directly. Many experienced and
100reponsive experts will be able look at the problem and quickly
101address it. Please include a thorough description of the problem
102with code and data examples if at all possible.
103
104=head2 Reporting Bugs
105
106Report bugs to the Bioperl bug tracking system to help us keep track
107of the bugs and their resolution. Bug reports can be submitted via
108the web:
109
110 https://github.com/bioperl/bioperl-live/issues
111
112=head1 AUTHOR - Hilmar Lapp
113
114Email hlapp at gmx.net
115
116=head1 APPENDIX
117
118The rest of the documentation details each of the object methods.
119Internal methods are usually preceded with a _
120
121=cut
122
123
124# Let the code begin...
125
126
127package Bio::Seq::SeqBuilder;
128228µs241µs
# spent 27µs (14+13) within Bio::Seq::SeqBuilder::BEGIN@128 which was called: # once (14µs+13µs) by Bio::SeqIO::BEGIN@331 at line 128
use strict;
# spent 27µs making 1 call to Bio::Seq::SeqBuilder::BEGIN@128 # spent 13µs making 1 call to strict::import
129
130# Object preamble - inherits from Bio::Root::Root
131
132
1332912µs21.00ms
# spent 506µs (8+498) within Bio::Seq::SeqBuilder::BEGIN@133 which was called: # once (8µs+498µs) by Bio::SeqIO::BEGIN@331 at line 133
use base qw(Bio::Root::Root Bio::Factory::ObjectBuilderI);
# spent 506µs making 1 call to Bio::Seq::SeqBuilder::BEGIN@133 # spent 498µs making 1 call to base::import
134
13512µsmy %slot_param_map = ("add_SeqFeature" => "features",
136 );
1371700nsmy %param_slot_map = ("features" => "add_SeqFeature",
138 );
139
140=head2 new
141
142 Title : new
143 Usage : my $obj = Bio::Seq::SeqBuilder->new();
144 Function: Builds a new Bio::Seq::SeqBuilder object
145 Returns : an instance of Bio::Seq::SeqBuilder
146 Args :
147
148=cut
149
150sub new {
151 my($class,@args) = @_;
152
153 my $self = $class->SUPER::new(@args);
154
155 $self->{'wanted_slots'} = [];
156 $self->{'unwanted_slots'} = [];
157 $self->{'object_conds'} = [];
158 $self->{'_objhash'} = {};
159 $self->want_all(1);
160
161 return $self;
162}
163
164=head1 Methods for implementing L<Bio::Factory::ObjectBuilderI>
165
166=cut
167
168=head2 want_slot
169
170 Title : want_slot
171 Usage :
172 Function: Whether or not the object builder wants to populate the
173 specified slot of the object to be built.
174
175 The slot can be specified either as the name of the
176 respective method, or the initialization parameter that
177 would be otherwise passed to new() of the object to be
178 built.
179
180 Note that usually only the parser will call this
181 method. Use add_wanted_slots and add_unwanted_slots for
182 configuration.
183
184 Example :
185 Returns : TRUE if the object builder wants to populate the slot, and
186 FALSE otherwise.
187 Args : the name of the slot (a string)
188
189
190=cut
191
192sub want_slot{
193 my ($self,$slot) = @_;
194 my $ok = 0;
195
196 $slot = substr($slot,1) if substr($slot,0,1) eq '-';
197 if($self->want_all()) {
198 foreach ($self->get_unwanted_slots()) {
199 # this always overrides in want-all mode
200 return 0 if($slot eq $_);
201 }
202 if(! exists($self->{'_objskel'})) {
203 $self->{'_objskel'} = $self->sequence_factory->create_object();
204 }
205 if(exists($param_slot_map{$slot})) {
206 $ok = $self->{'_objskel'}->can($param_slot_map{$slot});
207 } else {
208 $ok = $self->{'_objskel'}->can($slot);
209 }
210 return $ok if $ok;
211 # even if the object 'cannot' do this slot, it might have been
212 # added to the list of wanted slot, so carry on
213}
214 foreach ($self->get_wanted_slots()) {
215 if($slot eq $_) {
216 $ok = 1;
217 last;
218 }
219 }
220 return $ok;
221}
222
223=head2 add_slot_value
224
225 Title : add_slot_value
226 Usage :
227 Function: Adds one or more values to the specified slot of the object
228 to be built.
229
230 Naming the slot is the same as for want_slot().
231
232 The object builder may further filter the content to be
233 set, or even completely ignore the request.
234
235 If this method reports failure, the caller should not add
236 more values to the same slot. In addition, the caller may
237 find it appropriate to abandon the object being built
238 altogether.
239
240 This implementation will allow the caller to overwrite the
241 return value from want_slot(), because the slot is not
242 checked against want_slot().
243
244 Note that usually only the parser will call this method,
245 but you may call it from anywhere if you know what you are
246 doing. A derived class may be used to further manipulate
247 the value to be added.
248
249 Example :
250 Returns : TRUE on success, and FALSE otherwise
251 Args : the name of the slot (a string)
252 parameters determining the value to be set
253
254 OR
255
256 alternatively, a list of slotname/value pairs in the style
257 of named parameters as they would be passed to new(), where
258 each element at an even index is the parameter (slot) name
259 starting with a dash, and each element at an odd index is
260 the value of the preceding name.
261
262=cut
263
264sub add_slot_value{
265 my ($self,$slot,@args) = @_;
266
267 my $h = $self->{'_objhash'};
268 return unless $h;
269 # multiple named parameter variant of calling?
270 if((@args > 1) && (@args % 2) && (substr($slot,0,1) eq '-')) {
271 unshift(@args, $slot);
272 while(@args) {
273 my $key = shift(@args);
274 $h->{$key} = shift(@args);
275 }
276 } else {
277 if($slot eq 'add_SeqFeature') {
278 $slot = '-'.$slot_param_map{$slot};
279 $h->{$slot} = [] unless $h->{$slot};
280 push(@{$h->{$slot}}, @args);
281 } else {
282 $slot = '-'.$slot unless substr($slot,0,1) eq '-';
283 $h->{$slot} = $args[0];
284 }
285 }
286 return 1;
287}
288
289=head2 want_object
290
291 Title : want_object
292 Usage :
293 Function: Whether or not the object builder is still interested in
294 continuing with the object being built.
295
296 If this method returns FALSE, the caller should not add any
297 more values to slots, or otherwise risks that the builder
298 throws an exception. In addition, make_object() is likely
299 to return undef after this method returned FALSE.
300
301 Note that usually only the parser will call this
302 method. Use add_object_condition for configuration.
303
304 Example :
305 Returns : TRUE if the object builder wants to continue building
306 the present object, and FALSE otherwise.
307 Args : none
308
309=cut
310
311sub want_object{
312 my $self = shift;
313
314 my $ok = 1;
315 foreach my $cond ($self->get_object_conditions()) {
316 $ok = &$cond($self->{'_objhash'});
317 last unless $ok;
318 }
319 delete $self->{'_objhash'} unless $ok;
320 return $ok;
321}
322
323=head2 make_object
324
325 Title : make_object
326 Usage :
327 Function: Get the built object.
328
329 This method is allowed to return undef if no value has ever
330 been added since the last call to make_object(), or if
331 want_object() returned FALSE (or would have returned FALSE)
332 before calling this method.
333
334 For an implementation that allows consecutive building of
335 objects, a caller must call this method once, and only
336 once, between subsequent objects to be built. I.e., a call
337 to make_object implies 'end_object.'
338
339 Example :
340 Returns : the object that was built
341 Args : none
342
343=cut
344
345sub make_object{
346 my $self = shift;
347
348 my $obj;
349 if(exists($self->{'_objhash'}) && %{$self->{'_objhash'}}) {
350 $obj = $self->sequence_factory->create_object(%{$self->{'_objhash'}});
351 }
352 $self->{'_objhash'} = {}; # reset
353 return $obj;
354}
355
356=head1 Implementation specific methods
357
358These methods allow to conveniently configure this sequence object
359builder as to which slots are desired, and under which circumstances a
360sequence object should be abandoned altogether. The default mode is
361want_all(1), which means the builder will report all slots as wanted
362that the object created by the sequence factory supports.
363
364You can add specific slots you want through add_wanted_slots(). In
365most cases, you will want to call want_none() before in order to relax
366zero acceptance through a list of wanted slots.
367
368Alternatively, you can add specific unwanted slots through
369add_unwanted_slots(). In this case, you will usually want to call
370want_all(1) before (which is the default if you never touched the
371builder) to restrict unrestricted acceptance.
372
373I.e., want_all(1) means want all slots except for the unwanted, and
374want_none() means only those explicitly wanted.
375
376If a slot is in both the unwanted and the wanted list, the following
377rules hold. In want-all mode, the unwanted list overrules. In
378want-none mode, the wanted list overrides the unwanted list. If this
379is confusing to you, just try to avoid having slots at the same time
380in the wanted and the unwanted lists.
381
382=cut
383
384=head2 get_wanted_slots
385
386 Title : get_wanted_slots
387 Usage : $obj->get_wanted_slots($newval)
388 Function: Get the list of wanted slots
389 Example :
390 Returns : a list of strings
391 Args :
392
393
394=cut
395
396sub get_wanted_slots{
397 my $self = shift;
398
399 return @{$self->{'wanted_slots'}};
400}
401
402=head2 add_wanted_slot
403
404 Title : add_wanted_slot
405 Usage :
406 Function: Adds the specified slots to the list of wanted slots.
407 Example :
408 Returns : TRUE
409 Args : an array of slot names (strings)
410
411=cut
412
413sub add_wanted_slot{
414 my ($self,@slots) = @_;
415
416 my $myslots = $self->{'wanted_slots'};
417 foreach my $slot (@slots) {
418 if(! grep { $slot eq $_; } @$myslots) {
419 push(@$myslots, $slot);
420 }
421 }
422 return 1;
423}
424
425=head2 remove_wanted_slots
426
427 Title : remove_wanted_slots
428 Usage :
429 Function: Removes all wanted slots added previously through
430 add_wanted_slots().
431 Example :
432 Returns : the previous list of wanted slot names
433 Args : none
434
435=cut
436
437sub remove_wanted_slots{
438 my $self = shift;
439 my @slots = $self->get_wanted_slots();
440 $self->{'wanted_slots'} = [];
441 return @slots;
442}
443
444=head2 get_unwanted_slots
445
446 Title : get_unwanted_slots
447 Usage : $obj->get_unwanted_slots($newval)
448 Function: Get the list of unwanted slots.
449 Example :
450 Returns : a list of strings
451 Args : none
452
453=cut
454
455sub get_unwanted_slots{
456 my $self = shift;
457
458 return @{$self->{'unwanted_slots'}};
459}
460
461=head2 add_unwanted_slot
462
463 Title : add_unwanted_slot
464 Usage :
465 Function: Adds the specified slots to the list of unwanted slots.
466 Example :
467 Returns : TRUE
468 Args : an array of slot names (strings)
469
470=cut
471
472sub add_unwanted_slot{
473 my ($self,@slots) = @_;
474
475 my $myslots = $self->{'unwanted_slots'};
476 foreach my $slot (@slots) {
477 if(! grep { $slot eq $_; } @$myslots) {
478 push(@$myslots, $slot);
479 }
480 }
481 return 1;
482}
483
484=head2 remove_unwanted_slots
485
486 Title : remove_unwanted_slots
487 Usage :
488 Function: Removes the list of unwanted slots added previously through
489 add_unwanted_slots().
490 Example :
491 Returns : the previous list of unwanted slot names
492 Args : none
493
494=cut
495
496sub remove_unwanted_slots{
497 my $self = shift;
498 my @slots = $self->get_unwanted_slots();
499 $self->{'unwanted_slots'} = [];
500 return @slots;
501}
502
503=head2 want_none
504
505 Title : want_none
506 Usage :
507 Function: Disables all slots. After calling this method, want_slot()
508 will return FALSE regardless of slot name.
509
510 This is different from removed_wanted_slots() in that it
511 also sets want_all() to FALSE. Note that it also resets the
512 list of unwanted slots in order to avoid slots being in
513 both lists.
514
515 Example :
516 Returns : TRUE
517 Args : none
518
519=cut
520
521sub want_none{
522 my $self = shift;
523
524 $self->want_all(0);
525 $self->remove_wanted_slots();
526 $self->remove_unwanted_slots();
527 return 1;
528}
529
530=head2 want_all
531
532 Title : want_all
533 Usage : $obj->want_all($newval)
534 Function: Whether or not this sequence object builder wants to
535 populate all slots that the object has. Whether an object
536 supports a slot is generally determined by what can()
537 returns. You can add additional 'virtual' slots by calling
538 add_wanted_slot.
539
540 This will be ON by default. Call $obj->want_none() to
541 disable all slots.
542
543 Example :
544 Returns : TRUE if this builder wants to populate all slots, and
545 FALSE otherwise.
546 Args : on set, new value (a scalar or undef, optional)
547
548=cut
549
550sub want_all{
551 my $self = shift;
552
553 return $self->{'want_all'} = shift if @_;
554 return $self->{'want_all'};
555}
556
557=head2 get_object_conditions
558
559 Title : get_object_conditions
560 Usage :
561 Function: Get the list of conditions an object must meet in order to
562 be 'wanted.' See want_object() for where this is used.
563
564 Conditions in this implementation are closures (anonymous
565 functions) which are passed one parameter, a hash reference
566 the keys of which are equal to initialization
567 paramaters. The closure must return TRUE to make the object
568 'wanted.'
569
570 Conditions will be implicitly ANDed.
571
572 Example :
573 Returns : a list of closures
574 Args : none
575
576=cut
577
578sub get_object_conditions{
579 my $self = shift;
580
581 return @{$self->{'object_conds'}};
582}
583
584=head2 add_object_condition
585
586 Title : add_object_condition
587 Usage :
588 Function: Adds a condition an object must meet in order to be 'wanted.'
589 See want_object() for where this is used.
590
591 Conditions in this implementation must be closures
592 (anonymous functions). These will be passed one parameter,
593 which is a hash reference with the sequence object
594 initialization parameters being the keys.
595
596 Conditions are implicitly ANDed. If you want other
597 operators, perform those tests inside of one closure
598 instead of multiple. This will also be more efficient.
599
600 Example :
601 Returns : TRUE
602 Args : the list of conditions
603
604=cut
605
606sub add_object_condition{
607 my ($self,@conds) = @_;
608
609 if(grep { ref($_) ne 'CODE'; } @conds) {
610 $self->throw("conditions against which to validate an object ".
611 "must be anonymous code blocks");
612 }
613 push(@{$self->{'object_conds'}}, @conds);
614 return 1;
615}
616
617=head2 remove_object_conditions
618
619 Title : remove_object_conditions
620 Usage :
621 Function: Removes the conditions an object must meet in order to be
622 'wanted.'
623 Example :
624 Returns : The list of previously set conditions (an array of closures)
625 Args : none
626
627=cut
628
629sub remove_object_conditions{
630 my $self = shift;
631 my @conds = $self->get_object_conditions();
632 $self->{'object_conds'} = [];
633 return @conds;
634}
635
636=head1 Methods to control what type of object is built
637
638=cut
639
640=head2 sequence_factory
641
642 Title : sequence_factory
643 Usage : $obj->sequence_factory($newval)
644 Function: Get/set the sequence factory to be used by this object
645 builder.
646 Example :
647 Returns : the Bio::Factory::SequenceFactoryI implementing object to use
648 Args : on set, new value (a Bio::Factory::SequenceFactoryI
649 implementing object or undef, optional)
650
651=cut
652
653sub sequence_factory{
654 my $self = shift;
655
656 if(@_) {
657 delete $self->{'_objskel'};
658 return $self->{'sequence_factory'} = shift;
659 }
660 return $self->{'sequence_factory'};
661}
662
66315µs1;