← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to Bio/Seq/Meta/Array.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Seq/Meta/Array.pm
1
 
# $Id: Array.pm,v 1.13.4.1 2006/10/02 23:10:27 sendu Exp $
 
1
# $Id: Array.pm 15012 2008-11-24 04:50:37Z cjfields $
2
2
#
3
3
# BioPerl module for Bio::Seq::Meta::Array
4
4
#
20
20
  use Bio::LocatableSeq;
21
21
  use Bio::Seq::Meta::Array;
22
22
 
23
 
  my $seq = Bio::LocatableSeq->new(-id=>'test',
 
23
  my $seq = Bio::Seq::Meta::Array->new(-id=>'test',
24
24
                                   -seq=>'ACTGCTAGCT',
25
25
                                   -start=>2434,
26
26
                                   -start=>2443,
27
27
                                   -strand=>1,
28
28
                                   -varbose=>1, # to see warnings
29
29
                                  );
30
 
  bless $seq, Bio::Seq::Meta::Array;
31
 
  # the existing sequence object can be a Bio::PrimarySeq, too
32
30
 
33
31
  # to test this is a meta seq object
34
32
  $seq->isa("Bio::Seq::Meta::Array")
71
69
 
72
70
=head1 SEE ALSO
73
71
 
74
 
L<Bio::LocatableSeq>, 
75
 
L<Bio::Seq::MetaI>, 
76
 
L<Bio::Seq::Meta>, 
 
72
L<Bio::LocatableSeq>,
 
73
L<Bio::Seq::MetaI>,
 
74
L<Bio::Seq::Meta>,
77
75
L<Bio::Seq::Quality>
78
76
 
 
77
=head1 NOTE
 
78
 
 
79
This Bio::Seq::MetaI implementation inherits from Bio::LocatableSeq, which
 
80
itself inherits from Bio::PrimarySeq. It is not a Bio::SeqI, so bless-ing
 
81
objects of this class into a Bio::SeqI or vice versa and will not work as
 
82
expected (see bug 2262). This may be addressed in a future refactor of
 
83
Bio::LocatableSeq.
 
84
 
79
85
=head1 FEEDBACK
80
86
 
81
87
=head2 Mailing Lists
383
389
    $start =~ /^[+]?\d+$/ and $start > 0 or
384
390
        $self->throw("Need at least a positive integer start value");
385
391
    $start--;
386
 
 
 
392
    my $meta_len = scalar(@{$self->{_meta}->{$name}});
387
393
    if (defined $value) {
388
394
        my $arrayref;
389
395
 
417
423
        return $arrayref;
418
424
 
419
425
    } else {
420
 
 
421
 
        $end or $end = $self->length;
422
 
        $end = $self->length if $end > $self->length;
 
426
        # don't set by seq length; use meta array length instead; bug 2478
 
427
        $end ||= $meta_len;
 
428
        if ($end > $meta_len) {
 
429
            $self->warn("End is longer than meta sequence $name length; resetting to $meta_len");
 
430
            $end = $meta_len;
 
431
        }
 
432
        # warn but don't reset (push use of trunc() instead)
 
433
        $self->warn("End is longer than sequence length; use trunc() \n".
 
434
                    "if you want a fully truncated object") if $end > $self->length;
423
435
        $end--;
424
436
        return [@{$self->{_meta}->{$name}}[$start..$end]];
425
 
 
426
437
    }
427
438
}
428
439
 
650
661
 
651
662
    # test arguments
652
663
    $start =~ /^[+]?\d+$/ and $start > 0 or
653
 
        $self->throw("Need at least a positive integer start value as start");
 
664
        $self->throw("Need at least a positive integer start value as start; got [$start]");
654
665
    $end =~ /^[+]?\d+$/ and $end > 0 or
655
 
        $self->throw("Need at least a positive integer start value as end");
 
666
        $self->throw("Need at least a positive integer start value as end; got [$end]");
656
667
    $end >= $start or
657
 
        $self->throw("End position has to be larger or equal to start");
 
668
        $self->throw("End position has to be larger or equal to start; got [$start..$end]");
658
669
    $end <= $self->length or
659
 
        $self->throw("End position can not be larger than sequence length");
660
 
 
 
670
        $self->throw("End position can not be larger than sequence length; got [$end]");
661
671
 
662
672
    my $new = $self->SUPER::trunc($start, $end);
663
673
    $start--;