Mercurial > repos > mahtabm > ensemb_rep_gvl
comparison variant_effect_predictor/Bio/LiveSeq/Range.pm @ 0:2bc9b66ada89 draft default tip
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 06:29:17 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:2bc9b66ada89 |
---|---|
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; |