Bio/LiveSeq/Range.pm

   1 #
   2 # bioperl module for Bio::LiveSeq::Range
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Joseph Insana <insana@ebi.ac.uk> <jinsana@gmx.net>
   7 #
   8 # Copyright Joseph Insana
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11 #
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::LiveSeq::Range - Range abstract class for LiveSeq
  17
  18 =head1 SYNOPSIS
  19
  20   # documentation needed
  21
  22 =head1 DESCRIPTION
  23
  24 This is used as parent for exon and intron classes.
  25
  26 =head1 AUTHOR - Joseph A.L. Insana
  27
  28 Email:  Insana@ebi.ac.uk, jinsana@gmx.net
  29
  30 =head1 APPENDIX
  31
  32 The rest of the documentation details each of the object
  33 methods. Internal methods are usually preceded with a _
  34
  35 =cut
  36
  37 # Let the code begin...
  38
  39 package Bio::LiveSeq::Range;
  40 use strict;
  41 use base qw(Bio::LiveSeq::SeqI);
  42
  43 =head2 new
  44
  45   Title   : new
  46   Usage   : $range1 = Bio::LiveSeq::Range->new(-seq => $obj_ref,
  47                                                -start => $beginlabel,
  48                                                -end => $endlabel, -strand => 1);
  49
  50   Function: generates a new Bio::LiveSeq::Range
  51   Returns : reference to a new object of class Range
  52   Errorcode -1
  53   Args    : two labels, an obj_ref and an integer
  54             strand 1=forward strand, strand -1=reverse strand
  55             if strand not specified, it defaults to 1
  56             the -seq argument must point to the underlying DNA LiveSeq object
  57
  58 =cut
  59
  60 sub new {
  61   my ($thing, %args) = @_;
  62   my $class = ref($thing) || $thing;
  63   my ($obj,%range);
  64
  65   my ($seq,$start,$end,$strand)=($args{-seq},$args{-start},$args{-end},$args{-strand});
  66
  67   $obj = \%range;
  68   $obj = bless $obj, $class;
  69
  70   unless ($seq->valid($start)) {
  71     $obj->warn("$class not initialised because start label not valid");
  72     return (-1);
  73   }
  74   unless ($seq->valid($end)) {
  75     $obj->warn("$class not initialised because end label not valid");
  76     return (-1);
  77   }
  78   unless (defined $strand) {
  79     $strand = 1;
  80   }
  81   if (($strand != 1)&&($strand != -1)) {
  82     $obj->warn("$class not initialised because strand identifier not valid. Use 1 (forward strand) or -1 (reverse strand).");
  83     return (-1);
  84   }
  85   if ($start eq $end) {
  86     $obj->warn("$class reports: start and end label are the same....");
  87   } else {
  88     unless ($seq->follows($start,$end,$strand)==1) {
  89       $obj->warn("Fatal: end label $end doesn't follow start label $start for strand $strand!");
  90       return (-1);
  91     }
  92   }
  93   #if ($strand == 1) {
  94   #  unless ($seq->is_downstream($start,$end)==1) {
  95   #    croak "Fatal: end label not downstream of start label for forward strand!";
  96   #  }
  97   #} else {
  98   #  unless ($seq->is_upstream($start,$end)==1) {
  99   #    croak "Fatal: end label not upstream of start label for reverse strand!";
 100   #  }
 101   #}
 102   $obj->{'seq'}=$seq;
 103   $obj->{'start'}=$start;
 104   $obj->{'end'}=$end;
 105   $obj->{'strand'}=$strand;
 106   return $obj;
 107 }
 108
 109 =head2 valid
 110
 111   Title   : valid
 112   Usage   : $boolean = $obj->valid($label)
 113   Function: tests if a label exists AND is part of the object
 114   Returns : boolean
 115   Args    : label
 116
 117 =cut
 118
 119 1;