37
37
$seq->isa("Bio::Seq::Meta")
38
38
|| $seq->throw("$seq is not a Bio::Seq::Meta");
40
41
$seq->meta('1234567890');
42
$seq = Bio::Seq::Meta->new(-id=>'test',
48
-verbose=>1, # to see warnings
44
52
$string = $seq->meta_text();
45
53
$substring = $seq->submeta_text(2,5);
46
54
$unique_key = $seq->accession_number();
64
72
The meta information in this class is always one character per residue
65
73
long and blank values are space characters (ASCII 32).
67
The length of the meta data sequence is not dependent on the amount of
68
the meta information. The meta information always covers all the
69
residues. If necessary, the implementation quietly truncates or extends
70
meta information with blank values.
75
After the latest rewrite, the meta information no longer covers all
76
the residues automatically. Methods to check the length of meta
77
information (L<meta_length>)and to see if the ends are flushed to the
78
sequence have been added (L<is_flush>). To force the old
79
functionality, set L<force_flush> to true.
72
81
It is assumed that meta data values do not depend on the nucleotide
73
82
sequence strand value.
99
111
Unlike subseq(), these methods are able to set values. If the range
100
112
is not defined, it defaults to the complete sequence.
104
116
Prefix B<named_> in method names allows the used to attach multiple
105
117
meta strings to one sequence by explicitly naming them. The name is
125
139
Bioperl modules. Send your comments and suggestions preferably to one
126
140
of the Bioperl mailing lists. Your participation is much appreciated.
128
bioperl-l@bioperl.org - General discussion
129
http://bio.perl.org/MailList.html - About the mailing lists
142
bioperl-l@bioperl.org - General discussion
143
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
131
145
=head2 Reporting Bugs
133
147
Report bugs to the Bioperl bug tracking system to help us keep track
134
the bugs and their resolution. Bug reports can be submitted via email
148
the bugs and their resolution. Bug reports can be submitted via the
137
bioperl-bugs@bio.perl.org
138
http://bugzilla.bioperl.org/
151
http://bugzilla.open-bio.org/
140
153
=head1 AUTHOR - Heikki Lehvaslaiho
142
Email heikki@ebi.ac.uk
155
Email heikki-at-bioperl-dot-org
144
157
=head1 CONTRIBUTORS
146
159
Chad Matsalla, bioinformatics@dieselwurks.com
147
161
Aaron Mackey, amackey@virginia.edu
160
174
package Bio::Seq::Meta;
161
use vars qw(@ISA $DEFAULT_NAME $GAP $META_GAP);
175
use vars qw($DEFAULT_NAME $GAP $META_GAP);
163
use Bio::LocatableSeq;
166
178
#use overload '""' => \&to_string;
168
@ISA = qw( Bio::LocatableSeq Bio::Seq::MetaI );
180
use base qw(Bio::LocatableSeq Bio::Seq::MetaI);
197
209
my $self = $class->SUPER::new(@args);
211
my($meta, $forceflush) =
200
212
$self->_rearrange([qw(META
204
217
#$self->{'_meta'} = {};
205
$self->{'_meta'}->{$DEFAULT_NAME} = undef;
218
$self->{'_meta'}->{$DEFAULT_NAME} = "";
207
220
$meta && $self->meta($meta);
221
$forceflush && $self->force_flush($forceflush);
221
235
sequence, it needs to be manipulated after the sequence.
223
237
The length of the returned value always matches the length
238
of the sequence, if force_flush() is set. See L<force_flush>.
226
240
Returns : meta data in a string
227
241
Args : new value, string, optional
279
293
#$self->_test_gap_positions($name) if $self->verbose > 0;
281
return substr($self->{'_meta'}->{$name}, 0, $self->length)
282
if defined $self->{'_meta'}->{$name} and
283
CORE::length($self->{'_meta'}->{$name}) > $self->length;
284
return $self->{'_meta'}->{$name} || (" " x $self->length);
296
return " " x $self->length
297
if $self->force_flush && not defined $self->{'_meta'}->{$name};
300
$self->_do_flush if $self->force_flush;
302
return $self->{'_meta'}->{$name};
287
305
=head2 _test_gap_positions
314
332
my $m = substr $self->{_meta}->{$name}, $i, 1;
315
333
$self->warn("Gap mismatch [$m/$s] in column [". ($i+1). "] of [$name] meta data in seq [". $self->id. "]")
317
#if ($s eq $GAP || $m eq $GAP) && $s ne $m;
318
335
if ($s eq $META_GAP) && $s ne $m;
406
423
$name ||= $DEFAULT_NAME;
408
427
$start =~ /^[+]?\d+$/ and $start > 0 or
409
428
$self->throw("Need at least a positive integer start value");
431
$end ||= $start+length($value)-1;
412
432
$self->warn("You are setting meta values beyond the length of the sequence\n".
413
433
"[$start > ". length($self->seq)."] in sequence ". $self->id)
414
434
if $start > length $self->seq;
416
436
# pad meta data if needed
437
$self->{_meta}->{$name} = () unless defined $self->{_meta}->{$name};
417
438
if (length($self->{_meta}->{$name}) < $start) {
418
$self->{'_meta'}->{$name} .= " " x ( $start - length($self->{'_meta'}->{$name}));
439
$self->{'_meta'}->{$name} .= " " x ( $start - length($self->{'_meta'}->{$name}) -1);
421
my $tail = substr ($self->{_meta}->{$name}, $start-1+length($value));
443
$tail = substr ($self->{_meta}->{$name}, $start-1+length($value))
444
if length($self->{_meta}->{$name}) >= $start-1+length($value);
423
446
substr ($self->{_meta}->{$name}, --$start) = $value;
424
447
$self->{_meta}->{$name} .= $tail;
449
return substr ($self->{_meta}->{$name}, $start, $end - $start + 1);
430
453
$end or $end = length $self->seq;
431
$end = length $self->seq if $end > length $self->seq;
433
455
# pad meta data if needed
434
456
if (length($self->{_meta}->{$name}) < $end) {
463
485
Title : meta_names
464
486
Usage : @meta_names = $obj->meta_names()
465
487
Function: Retrieves an array of meta data set names. The default
466
(unnamed) set name is guarantied to be the first name if it
488
(unnamed) set name is guarantied to be the first name.
468
489
Returns : an array of names
480
501
unshift @r, $DEFAULT_NAME if $self->{'_meta'}->{$DEFAULT_NAME};
508
Title : meta_length()
509
Usage : $meeta_len = $obj->meta_length();
510
Function: return the number of elements in the meta set
518
return $self->named_meta_length($DEFAULT_NAME);
522
=head2 named_meta_length
524
Title : named_meta_length()
525
Usage : $meta_len = $obj->named_meta_length($name);
526
Function: return the number of elements in the named meta set
532
sub named_meta_length {
533
my ($self, $name) = @_;
534
$name ||= $DEFAULT_NAME;
535
return length ($self->{'_meta'}->{$name});
541
Title : force_flush()
542
Usage : $force_flush = $obj->force_flush(1);
543
Function: Automatically pad with empty values or truncate meta values
544
to sequence length. Not done by default.
545
Returns : boolean 1 or 0
546
Args : optional boolean value
548
Note that if you turn this forced padding off, the previously padded
549
values are not changed.
554
my ($self, $value) = @_;
556
if (defined $value) {
558
$self->{force_flush} = 1;
561
$self->{force_flush} = 0;
564
return $self->{force_flush};
572
Function: internal method to do the force that meta values are same
573
length as the sequence . Called from L<force_flush>
583
foreach my $name ( ('DEFAULT', $self->meta_names) ) {
586
if ($self->length > $self->named_meta_length($name)) {
587
$self->{'_meta'}->{$name} .= $META_GAP x ($self->length - $self->named_meta_length($name)) ;
590
elsif ( $self->length < $self->named_meta_length($name) ) {
591
$self->{_meta}->{$name} = substr($self->{_meta}->{$name}, 0, $self->length-1);
601
Usage : $is_flush = $obj->is_flush()
602
or $is_flush = $obj->is_flush($my_meta_name)
603
Function: Boolean to tell if all meta values are in
604
flush with the sequence length.
605
Returns true if force_flush() is set
606
Set verbosity to a positive value to see failed meta sets
607
Returns : boolean 1 or 0
608
Args : optional name of the meta set
615
my ($self, $name) = shift;
617
return 1 if $self->force_flush;
623
$sticky .= "$name " if $self->length != $self->named_meta_length($name);
625
foreach my $m ($self->meta_names) {
626
$sticky .= "$m " if $self->length != $self->named_meta_length($m);
631
print "These meta set are not flush: $sticky\n" if $self->verbose;
485
639
=head1 Bio::PrimarySeqI methods
492
646
the order of residues and their meta information is reversed.
493
647
Returns : A new (fresh) Bio::Seq::Meta object
649
Throws : if the object returns false on is_flush()
651
Note: The method does nothing to meta values, it reorders them, only.
499
656
my $self = shift;
658
$self->throw("Can not get a reverse complement. The object is not flush.")
659
unless $self->is_flush;
501
661
my $new = $self->SUPER::revcom;
502
662
foreach (keys %{$self->{_meta}}) {
503
663
$new->named_meta($_, scalar reverse $self->{_meta}->{$_} );
added
removed
Bio/Seq/Meta.pm
