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;