|
0
|
1 # $Id: Range.pm,v 1.7 2001/06/18 08:27:53 heikki Exp $
|
|
|
2 #
|
|
|
3 # bioperl module for Bio::LiveSeq::Range
|
|
|
4 #
|
|
|
5 # Cared for by Joseph Insana <insana@ebi.ac.uk> <jinsana@gmx.net>
|
|
|
6 #
|
|
|
7 # Copyright Joseph Insana
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10 #
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::LiveSeq::Range - Range abstract class for LiveSeq
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 # documentation needed
|
|
|
20
|
|
|
21 =head1 DESCRIPTION
|
|
|
22
|
|
|
23 This is used as parent for exon and intron classes.
|
|
|
24
|
|
|
25 =head1 AUTHOR - Joseph A.L. Insana
|
|
|
26
|
|
|
27 Email: Insana@ebi.ac.uk, jinsana@gmx.net
|
|
|
28
|
|
|
29 Address:
|
|
|
30
|
|
|
31 EMBL Outstation, European Bioinformatics Institute
|
|
|
32 Wellcome Trust Genome Campus, Hinxton
|
|
|
33 Cambs. CB10 1SD, United Kingdom
|
|
|
34
|
|
|
35 =head1 APPENDIX
|
|
|
36
|
|
|
37 The rest of the documentation details each of the object
|
|
|
38 methods. Internal methods are usually preceded with a _
|
|
|
39
|
|
|
40 =cut
|
|
|
41
|
|
|
42 # Let the code begin...
|
|
|
43
|
|
|
44 package Bio::LiveSeq::Range;
|
|
|
45 $VERSION=1.6;
|
|
|
46
|
|
|
47 # Version history:
|
|
|
48 # Mon Mar 20 22:21:44 GMT 2000 v 1.0 begun
|
|
|
49 # Tue Mar 21 00:50:05 GMT 2000 v 1.1 new() added
|
|
|
50 # Tue Mar 21 02:44:45 GMT 2000 v 1.2 private start(), more checks in new()
|
|
|
51 # Thu Mar 23 19:06:03 GMT 2000 v 1.3 follows() replaces is_downstream
|
|
|
52 # Wed Apr 12 16:35:12 BST 2000 v 1.4 added valid()
|
|
|
53 # Mon Jun 26 15:25:14 BST 2000 v 1.44 ranges with start=end are now accepted / valid() removed because inherited now from SeqI
|
|
|
54 # Tue Jun 27 14:06:06 BST 2000 v 1.5 croak changed to carp and return(-1) in new() function
|
|
|
55 # Wed Mar 28 16:47:36 BST 2001 v 1.6 carp -> warn,throw (coded methods in SeqI)
|
|
|
56
|
|
|
57 use strict;
|
|
|
58 use vars qw($VERSION @ISA);
|
|
|
59 use Bio::LiveSeq::SeqI 3.2; # uses SeqI, inherits from it
|
|
|
60 @ISA=qw(Bio::LiveSeq::SeqI);
|
|
|
61
|
|
|
62 =head2 new
|
|
|
63
|
|
|
64 Title : new
|
|
|
65 Usage : $range1 = Bio::LiveSeq::Range->new(-seq => $obj_ref,
|
|
|
66 -start => $beginlabel,
|
|
|
67 -end => $endlabel, -strand => 1);
|
|
|
68
|
|
|
69 Function: generates a new Bio::LiveSeq::Range
|
|
|
70 Returns : reference to a new object of class Range
|
|
|
71 Errorcode -1
|
|
|
72 Args : two labels, an obj_ref and an integer
|
|
|
73 strand 1=forward strand, strand -1=reverse strand
|
|
|
74 if strand not specified, it defaults to 1
|
|
|
75 the -seq argument must point to the underlying DNA LiveSeq object
|
|
|
76
|
|
|
77 =cut
|
|
|
78
|
|
|
79 sub new {
|
|
|
80 my ($thing, %args) = @_;
|
|
|
81 my $class = ref($thing) || $thing;
|
|
|
82 my ($obj,%range);
|
|
|
83
|
|
|
84 my ($seq,$start,$end,$strand)=($args{-seq},$args{-start},$args{-end},$args{-strand});
|
|
|
85
|
|
|
86 $obj = \%range;
|
|
|
87 $obj = bless $obj, $class;
|
|
|
88
|
|
|
89 unless ($seq->valid($start)) {
|
|
|
90 $obj->warn("$class not initialised because start label not valid");
|
|
|
91 return (-1);
|
|
|
92 }
|
|
|
93 unless ($seq->valid($end)) {
|
|
|
94 $obj->warn("$class not initialised because end label not valid");
|
|
|
95 return (-1);
|
|
|
96 }
|
|
|
97 unless (defined $strand) {
|
|
|
98 $strand = 1;
|
|
|
99 }
|
|
|
100 if (($strand != 1)&&($strand != -1)) {
|
|
|
101 $obj->warn("$class not initialised because strand identifier not valid. Use 1 (forward strand) or -1 (reverse strand).");
|
|
|
102 return (-1);
|
|
|
103 }
|
|
|
104 if ($start eq $end) {
|
|
|
105 $obj->warn("$class reports: start and end label are the same....");
|
|
|
106 } else {
|
|
|
107 unless ($seq->follows($start,$end,$strand)==1) {
|
|
|
108 $obj->warn("Fatal: end label $end doesn't follow start label $start for strand $strand!");
|
|
|
109 return (-1);
|
|
|
110 }
|
|
|
111 }
|
|
|
112 #if ($strand == 1) {
|
|
|
113 # unless ($seq->is_downstream($start,$end)==1) {
|
|
|
114 # croak "Fatal: end label not downstream of start label for forward strand!";
|
|
|
115 # }
|
|
|
116 #} else {
|
|
|
117 # unless ($seq->is_upstream($start,$end)==1) {
|
|
|
118 # croak "Fatal: end label not upstream of start label for reverse strand!";
|
|
|
119 # }
|
|
|
120 #}
|
|
|
121 $obj->{'seq'}=$seq;
|
|
|
122 $obj->{'start'}=$start;
|
|
|
123 $obj->{'end'}=$end;
|
|
|
124 $obj->{'strand'}=$strand;
|
|
|
125 return $obj;
|
|
|
126 }
|
|
|
127
|
|
|
128 =head2 valid
|
|
|
129
|
|
|
130 Title : valid
|
|
|
131 Usage : $boolean = $obj->valid($label)
|
|
|
132 Function: tests if a label exists AND is part of the object
|
|
|
133 Returns : boolean
|
|
|
134 Args : label
|
|
|
135
|
|
|
136 =cut
|
|
|
137
|
|
|
138 1;
|
