Mercurial > repos > jjohnson > crest
view Transcript.pm @ 1:4f6952e0af48 default tip
CREST - add crest.loc.sample
author | Jim Johnson <jj@umn.edu> |
---|---|
date | Wed, 08 Feb 2012 16:08:01 -0600 |
parents | acc8d8bfeb9a |
children |
line wrap: on
line source
package Transcript; use strict; use Carp; use Data::Dumper; # we are going to use a light weight Transcript model here my @Transcript_slots; BEGIN { @Transcript_slots = qw(NAME REFSEQ_ID CHR START END STRAND CDS_START CDS_END EXONS TYPE); } use enum @Transcript_slots; my %attribute = ( name => NAME, refseq_id => REFSEQ_ID, chr => CHR, start => START, end => END, strand => STRAND, cds_start => CDS_START, cds_end => CDS_END, exons => EXONS, type => TYPE, ); #using an array instead of a hash for the node sub _accessor { my $index = shift; return sub { my $self = shift; return undef unless $self; if (@_) { $self->[$index] = shift; } return $self->[$index]; }; } while(my($at, $idx) = each %attribute) { no strict 'refs'; *$at = _accessor($idx); } sub new { my $class = shift; my $obj = []; if (@_) { my %arg = @_; $obj->[NAME] = $arg{-NAME} if($arg{-NAME}); $obj->[REFSEQ_ID] = $arg{-REFSEQ_ID} if($arg{-REFSEQ_ID}); $obj->[CHR] = $arg{-CHR} if($arg{-CHR}); $obj->[START] = $arg{-START} if($arg{-START}); $obj->[END] = $arg{-END} if($arg{-END}); $obj->[STRAND] = $arg{-STRAND} if($arg{-STRAND}); $obj->[CDS_START] = $arg{-CDS_START} if($arg{-CDS_START}); $obj->[CDS_END] = $arg{-CDS_END} if($arg{-CDS_END}); $obj->[EXONS] = $arg{-EXONS} if($arg{-EXONS}); $obj->[TYPE] = $arg{-TYPE} if($arg{-TYPE}); } return bless $obj, $class; } sub get_start { my ($self, $pos, $ext) = @_; my @tmp; foreach my $e( @{$self->[EXONS]} ) { if($e->[1] < $pos) { push @tmp, $e; next; } last; } my $len = 0; while(scalar @tmp > 0) { my $e = pop @tmp; if($e->[1] >= $pos) { my $l = $pos - $e->[0]; if($l + $len < $ext) { $len = $l; next; } return $pos - $ext; } if($e->[1] - $e->[0] + 1 + $len < $ext) { $len += ($e->[1] - $e->[0] + 1); next; } return ($e->[1] - $ext + $len); } return $self->start; } sub get_end { my ($self, $pos, $ext) = @_; my @tmp = @{$self->[EXONS]}; my $len = 0; while(scalar @tmp > 0) { my $e = shift @tmp; next if($e->[1] < $pos); if($e->[0] <= $pos ) { return $pos + $ext if($e->[1] - $pos >= $ext); $len = $e->[1] - $pos; next; } if($e->[1] - $e->[0] + 1 + $len < $ext) { $len += ($e->[1] - $e->[0] + 1); next; } return ($e->[0] + $ext - $len); } return $self->end; } sub overlap { my $self = shift; my $range = shift; croak "Range must be a ref of array" unless(ref($range) eq 'ARRAY'); foreach my $e ( @{$self->[EXONS]} ) { return 1 if($e->[0] <= $range->[1] && $e->[1] >= $range->[0]); } return; } 1;