sub
new {
my
(
$class
,
@args
) =
@_
;
if
(!
grep
{
lc
(
$_
) eq
'-is_coding'
; }
@args
) {
push
(
@args
,
'-is_coding'
, 0);
}
my
$self
=
$class
->SUPER::new(
@args
);
my
(
$primary
,
$prim
) =
$self
->_rearrange([
qw(PRIMARY PRIMARY_TAG)
],
@args
);
$self
->primary_tag(
'intron'
)
unless
$primary
||
$prim
;
return
$self
;
}
sub
upstream_Exon {
my
(
$self
,
$exon
) =
@_
;
if
(
$exon
) {
$self
->{
'_intron_location'
} =
undef
;
$self
->throw(
"'$exon' is not a FAST::Bio::SeqFeature::Gene::ExonI"
)
unless
$exon
->isa(
'FAST::Bio::SeqFeature::Gene::ExonI'
);
$self
->{
'_upstream_exon'
} =
$exon
;
}
return
$self
->{
'_upstream_exon'
};
}
sub
downstream_Exon {
my
(
$self
,
$exon
) =
@_
;
if
(
$exon
) {
$self
->{
'_intron_location'
} =
undef
;
$self
->throw(
"'$exon' is not a FAST::Bio::SeqFeature::Gene::ExonI"
)
unless
$exon
->isa(
'FAST::Bio::SeqFeature::Gene::ExonI'
);
$self
->{
'_downstream_exon'
} =
$exon
;
}
return
$self
->{
'_downstream_exon'
};
}
sub
phase {
my
(
$self
) =
@_
;
return
$self
->downstream_Exon->phase;
}
sub
acceptor_splice_site {
my
(
$self
,
$ss_start
,
$ss_end
) =
@_
;
$ss_start
= 21
unless
defined
$ss_start
;
$ss_end
= 3
unless
defined
$ss_end
;
if
(
$self
->strand < 0){
my
$tmp
=
$ss_start
;
$ss_start
=
$ss_end
;
$ss_end
=
$tmp
;
}
my
$intron_end
=
$self
->location->end;
my
$down_exon
=
$self
->downstream_Exon;
my
$acceptor
;
if
(
$self
->strand < 0){
$ss_start
=
$ss_start
>
$down_exon
->
length
?
$down_exon
->
length
:
$ss_start
;
$ss_end
=
$ss_end
>
$self
->
length
-2 ?
$self
->
length
-2 :
$ss_end
;
$acceptor
= FAST::Bio::SeqFeature::Generic->new(
-start
=>
$self
->start - (
$ss_start
) ,
-end
=>
$self
->start + (
$ss_end
+1),
-strand
=>
$self
->strand,
-primary_tag
=>
"donor splice site"
);
}
else
{
$ss_start
=
$ss_start
>
$self
->
length
-2 ?
$self
->
length
-2 :
$ss_start
;
$ss_end
=
$ss_end
>
$down_exon
->
length
?
$down_exon
->
length
:
$ss_end
;
$acceptor
= FAST::Bio::SeqFeature::Generic->new(
-start
=>
$self
->end - (
$ss_start
+ 1),
-end
=>
$self
->end +
$ss_end
,
-strand
=>
$self
->strand,
-primary_tag
=>
"donor splice site"
);
}
$acceptor
->attach_seq(
$self
->entire_seq);
return
$acceptor
;
}
sub
donor_splice_site {
my
(
$self
,
$ss_start
,
$ss_end
) =
@_
;
$ss_start
= 3
unless
defined
$ss_start
;
$ss_end
= 10
unless
defined
$ss_end
;
if
(
$self
->strand < 0){
my
$tmp
=
$ss_start
;
$ss_start
=
$ss_end
;
$ss_end
=
$tmp
;
}
my
$up_exon
=
$self
->upstream_Exon;
my
$donor
;
if
(
$self
->strand < 0){
$ss_end
=
$ss_end
>
$up_exon
->
length
?
$up_exon
->
length
:
$ss_end
;
$ss_start
=
$ss_start
>
$self
->
length
-2 ?
$self
->
length
-2 :
$ss_start
;
$donor
= FAST::Bio::SeqFeature::Generic->new(
-start
=>
$self
->end - (
$ss_start
+1),
-end
=>
$self
->end + (
$ss_end
),
-strand
=>
$self
->strand,
-primary_tag
=>
"acceptor splice site"
);
}
else
{
$ss_start
=
$ss_start
>
$up_exon
->
length
?
$up_exon
->
length
:
$ss_start
;
$ss_end
=
$ss_end
>
$self
->
length
-2 ?
$self
->
length
-2 :
$ss_end
;
$donor
= FAST::Bio::SeqFeature::Generic->new(
-start
=>
$self
->start -
$ss_start
,
-end
=>
$self
->start +(
$ss_end
+1),
-strand
=>
$self
->strand,
-primary_tag
=>
"acceptor splice site"
);
}
$donor
->attach_seq(
$self
->entire_seq);
return
$donor
;
}
sub
location {
my
(
$self
) =
@_
;
unless
(
$self
->{
'_intron_location'
}) {
my
$loc
= FAST::Bio::Location::Simple->new;
my
$up_exon
=
$self
->upstream_Exon;
my
$down_exon
=
$self
->downstream_Exon;
my
$up_seq
=
$up_exon
->entire_seq;
my
$down_seq
=
$down_exon
->entire_seq;
unless
(
ref
(
$up_seq
) eq
ref
(
$down_seq
) ) {
$self
->throw(
"upstream and downstream exons are attached to different sequences\n'$up_seq' and '$down_seq'"
);
}
my
$up_strand
=
$up_exon
->strand;
my
$down_strand
=
$down_exon
->strand;
unless
(
$up_strand
==
$down_strand
) {
$self
->throw(
"upstream and downstream exons are on different strands "
.
"('$up_strand' and '$down_strand')"
);
}
$loc
->strand(
$up_strand
);
my
(
$exon_end
,
$exon_start
);
if
(
$up_strand
== 1) {
$exon_end
=
$up_exon
->end;
$exon_start
=
$down_exon
->start;
}
else
{
$exon_end
=
$down_exon
->end;
$exon_start
=
$up_exon
->start;
}
unless
(
$exon_end
<
$exon_start
) {
$self
->throw(
"Intron gap begins after '$exon_end' and ends before '$exon_start'"
);
}
$loc
->start(
$exon_end
+ 1);
$loc
->end (
$exon_start
- 1);
$self
->{
'_intron_location'
} =
$loc
;
}
return
$self
->{
'_intron_location'
};
}
1;