~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/Location/Atomic.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# $Id: Atomic.pm,v 1.10 2003/12/18 13:15:20 jason Exp $
 
1
# $Id: Atomic.pm,v 1.16.4.1 2006/10/02 23:10:21 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::Location::Atomic
4
4
# Cared for by Jason Stajich <jason@bioperl.org>
36
36
Bioperl modules. Send your comments and suggestions preferably to one
37
37
of the Bioperl mailing lists.  Your participation is much appreciated.
38
38
 
39
 
  bioperl-l@bioperl.org             - General discussion
40
 
  http://bio.perl.org/MailList.html - About the mailing lists
 
39
  bioperl-l@bioperl.org                  - General discussion
 
40
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
41
41
 
42
42
=head2 Reporting Bugs
43
43
 
44
44
Report bugs to the Bioperl bug tracking system to help us keep track
45
 
the bugs and their resolution.  Bug reports can be submitted via email
46
 
or the web:
 
45
the bugs and their resolution.  Bug reports can be submitted via the
 
46
web:
47
47
 
48
 
  bioperl-bugs@bio.perl.org
49
 
  http://bugzilla.bioperl.org/
 
48
  http://bugzilla.open-bio.org/
50
49
 
51
50
=head1 AUTHOR - Jason Stajich
52
51
 
53
 
Email jason@bioperl.org
 
52
Email jason-at-bioperl-dot-org
54
53
 
55
54
=head1 APPENDIX
56
55
 
63
62
 
64
63
 
65
64
package Bio::Location::Atomic;
66
 
use vars qw(@ISA);
67
65
use strict;
68
66
 
69
 
use Bio::Root::Root;
70
 
use Bio::LocationI;
71
 
 
72
 
@ISA = qw(Bio::Root::Root Bio::LocationI);
 
67
use Bio::Location::WidestCoordPolicy;
 
68
 
 
69
use base qw(Bio::Root::Root Bio::LocationI);
 
70
 
 
71
our $coord_policy = Bio::Location::WidestCoordPolicy->new();
73
72
 
74
73
sub new { 
75
74
    my ($class, @args) = @_;
85
84
        Bio::Root::Root->_load_module($class);
86
85
      };
87
86
    if ( $@ ) {
88
 
        Bio::Root::RootI->throw("$class cannot be found\nException $@");
 
87
        Bio::Root::Root->throw("$class cannot be found\nException $@");
89
88
      }
90
89
    bless $self,$class;
91
90
 
181
180
  #return $self->{'_strand'} || 0;
182
181
}
183
182
 
 
183
=head2 flip_strand
 
184
 
 
185
  Title   : flip_strand
 
186
  Usage   : $location->flip_strand();
 
187
  Function: Flip-flop a strand to the opposite
 
188
  Returns : None
 
189
  Args    : None
 
190
 
 
191
=cut
 
192
 
 
193
 
 
194
sub flip_strand {
 
195
    my $self= shift;
 
196
    $self->strand($self->strand * -1);
 
197
}
 
198
 
 
199
 
 
200
=head2 seq_id
 
201
 
 
202
  Title   : seq_id
 
203
  Usage   : my $seqid = $location->seq_id();
 
204
  Function: Get/Set seq_id that location refers to
 
205
  Returns : seq_id (a string)
 
206
  Args    : [optional] seq_id value to set
 
207
 
 
208
=cut
 
209
 
 
210
 
 
211
sub seq_id {
 
212
    my ($self, $seqid) = @_;
 
213
    if( defined $seqid ) {
 
214
        $self->{'_seqid'} = $seqid;
 
215
    }
 
216
    return $self->{'_seqid'};
 
217
}
 
218
 
184
219
=head2 length
185
220
 
186
221
 Title   : length
315
350
  Title   : location_type
316
351
  Usage   : my $location_type = $location->location_type();
317
352
  Function: Get location type encoded as text
318
 
  Returns : string ('EXACT', 'WITHIN', 'BETWEEN')
 
353
  Returns : string ('EXACT', 'WITHIN', 'IN-BETWEEN')
319
354
  Args    : none
320
355
 
321
356
=cut
387
422
    return $str;
388
423
}
389
424
 
 
425
 
 
426
=head2 coordinate_policy
 
427
 
 
428
  Title   : coordinate_policy
 
429
  Usage   : $policy = $location->coordinate_policy();
 
430
            $location->coordinate_policy($mypolicy); # set may not be possible
 
431
  Function: Get the coordinate computing policy employed by this object.
 
432
 
 
433
            See L<Bio::Location::CoordinatePolicyI> for documentation
 
434
            about the policy object and its use.
 
435
 
 
436
            The interface *does not* require implementing classes to
 
437
            accept setting of a different policy. The implementation
 
438
            provided here does, however, allow to do so.
 
439
 
 
440
            Implementors of this interface are expected to initialize
 
441
            every new instance with a
 
442
            L<Bio::Location::CoordinatePolicyI> object. The
 
443
            implementation provided here will return a default policy
 
444
            object if none has been set yet. To change this default
 
445
            policy object call this method as a class method with an
 
446
            appropriate argument. Note that in this case only
 
447
            subsequently created Location objects will be affected.
 
448
 
 
449
  Returns : A L<Bio::Location::CoordinatePolicyI> implementing object.
 
450
  Args    : On set, a L<Bio::Location::CoordinatePolicyI> implementing object.
 
451
 
 
452
See L<Bio::Location::CoordinatePolicyI> for more information
 
453
 
 
454
 
 
455
=cut
 
456
 
 
457
sub coordinate_policy {
 
458
    my ($self, $policy) = @_;
 
459
 
 
460
    if(defined($policy)) {
 
461
        if(! $policy->isa('Bio::Location::CoordinatePolicyI')) {
 
462
            $self->throw("Object of class ".ref($policy)." does not implement".
 
463
                         " Bio::Location::CoordinatePolicyI");
 
464
        }
 
465
        if(ref($self)) {
 
466
            $self->{'_coordpolicy'} = $policy;
 
467
        } else {
 
468
            # called as class method
 
469
            $coord_policy = $policy;
 
470
        }
 
471
    }
 
472
    return (ref($self) && exists($self->{'_coordpolicy'}) ?
 
473
            $self->{'_coordpolicy'} : $coord_policy);
 
474
}
 
475
 
 
476
 
390
477
# comments, not function added by jason 
391
478
#
392
479
# trunc is untested, and as of now unannounced method for truncating a