Bio/LiveSeq/Range.pm

   1 # $Id$
   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 =head1 APPENDIX
  30
  31 The rest of the documentation details each of the object
  32 methods. Internal methods are usually preceded with a _
  33
  34 =cut
  35
  36 # Let the code begin...
  37
  38 package Bio::LiveSeq::Range;
  39 use strict;
  40 use base qw(Bio::LiveSeq::SeqI);
  41
  42 =head2 new
  43
  44   Title   : new
  45   Usage   : $range1 = Bio::LiveSeq::Range->new(-seq => $obj_ref,
  46                                                -start => $beginlabel,
  47                                                -end => $endlabel, -strand => 1);
  48
  49   Function: generates a new Bio::LiveSeq::Range
  50   Returns : reference to a new object of class Range
  51   Errorcode -1
  52   Args    : two labels, an obj_ref and an integer
  53             strand 1=forward strand, strand -1=reverse strand
  54             if strand not specified, it defaults to 1
  55             the -seq argument must point to the underlying DNA LiveSeq object
  56
  57 =cut
  58
  59 sub new {
  60   my ($thing, %args) = @_;
  61   my $class = ref($thing) || $thing;
  62   my ($obj,%range);
  63
  64   my ($seq,$start,$end,$strand)=($args{-seq},$args{-start},$args{-end},$args{-strand});
  65
  66   $obj = \%range;
  67   $obj = bless $obj, $class;
  68
  69   unless ($seq->valid($start)) {
  70     $obj->warn("$class not initialised because start label not valid");
  71     return (-1);
  72   }
  73   unless ($seq->valid($end)) {
  74     $obj->warn("$class not initialised because end label not valid");
  75     return (-1);
  76   }
  77   unless (defined $strand) {
  78     $strand = 1;
  79   }
  80   if (($strand != 1)&&($strand != -1)) {
  81     $obj->warn("$class not initialised because strand identifier not valid. Use 1 (forward strand) or -1 (reverse strand).");
  82     return (-1);
  83   }
  84   if ($start eq $end) {
  85     $obj->warn("$class reports: start and end label are the same....");
  86   } else {
  87     unless ($seq->follows($start,$end,$strand)==1) {
  88       $obj->warn("Fatal: end label $end doesn't follow start label $start for strand $strand!");
  89       return (-1);
  90     }
  91   }
  92   #if ($strand == 1) {
  93   #  unless ($seq->is_downstream($start,$end)==1) {
  94   #    croak "Fatal: end label not downstream of start label for forward strand!";
  95   #  }
  96   #} else {
  97   #  unless ($seq->is_upstream($start,$end)==1) {
  98   #    croak "Fatal: end label not upstream of start label for reverse strand!";
  99   #  }
 100   #}
 101   $obj->{'seq'}=$seq;
 102   $obj->{'start'}=$start;
 103   $obj->{'end'}=$end;
 104   $obj->{'strand'}=$strand;
 105   return $obj;
 106 }
 107
 108 =head2 valid
 109
 110   Title   : valid
 111   Usage   : $boolean = $obj->valid($label)
 112   Function: tests if a label exists AND is part of the object
 113   Returns : boolean
 114   Args    : label
 115
 116 =cut
 117
 118 1;