G
Prelude
Summary
G::Prelude - Internal class with basic sequence manipulation methods
Package variables
Privates (from "my" definitions)
%feat2idHash = ()
$intergenic = 0
%gene2idHash = ()
Included modules
Synopsis
use G::Prelude;
@ISA = (G::Prelude);
Description
Intended for internal use only. Super class for the core. Provides
the native methods.
Methods
| after_startcodon | No description | Code |
| after_stopcodon | No description | Code |
| before_startcodon | No description | Code |
| before_stopcodon | No description | Code |
| cds | No description | Code |
| clone | No description | Code |
| del_key | No description | Code |
| feature | No description | Code |
| feature2id | No description | Code |
| gene | No description | Code |
| gene2id | No description | Code |
| get_cdsseq | No description | Code |
| get_exon | No description | Code |
| get_gbkseq | No description | Code |
| get_geneseq | No description | Code |
| get_intron | No description | Code |
| getseq | No description | Code |
| hairpin_cut | No description | Code |
| intergenic | No description | Code |
| next_cds | No description | Code |
| next_feature | No description | Code |
| pos2feature | No description | Code |
| pos2gene | No description | Code |
| previous_cds | No description | Code |
| previous_feature | No description | Code |
| rRNA | No description | Code |
| seq | No description | Code |
| seq_info | No description | Code |
| set_intergenic | No description | Code |
| startcodon | No description | Code |
| stopcodon | No description | Code |
| tRNA | No description | Code |
Methods description
None available.
Methods code
| after_startcodon | description | prev | next | Top |
sub after_startcodon
{ my $this = shift;
my $object = shift;
my $length = shift;
if ($this->{$object}->{direction} eq 'complement'){
return
complement(substr($this->{SEQ},
$this->{$object}->{end} - 1 - 3 - $length + 1,
$length));
}else{
return
substr($this->{SEQ},
$this->{$object}->{start} + 3 - 1,
$length);
}} | sub after_stopcodon
{ my $this = shift;
my $object = shift;
my $length = shift;
if ($this->{$object}->{direction} eq 'complement'){
return
complement(substr($this->{SEQ},
$this->{$object}->{start} - 1 - $length,
$length));
}else{
return
substr($this->{SEQ},
$this->{$object}->{end} +1 - 1,
$length);
}} | sub before_startcodon
{ my $this = shift;
my $object = shift;
my $length = shift;
if ($this->{$object}->{direction} eq 'complement'){
return
complement(substr($this->{SEQ},
$this->{$object}->{end},
$length));
}else{
return
substr($this->{SEQ},
$this->{$object}->{start} - 1 - $length,
$length);
}} | sub before_stopcodon
{ my $this = shift;
my $object = shift;
my $length = shift;
if ($this->{$object}->{direction} eq 'complement'){
return
complement(substr($this->{SEQ},
$this->{$object}->{start} + 3 - 1,
$length));
}else{
return
substr($this->{SEQ},
$this->{$object}->{end} - 3 - 1 - $length + 1,
$length);
}} | sub cds
{ my $this = shift;
my $opt = shift || '';
my $i = 0;
my @cds;
while(defined(%{$this->{"FEATURE" . ($i + 1)}})){
$i ++;
next if ($this->{"FEATURE$i"}->{type} ne 'CDS');
if ($opt ne 'all'){
next if ($this->{"FEATURE$i"}->{on} == 0);
my $id = $this->{"FEATURE$i"}->{cds};
next if ($this->{"CDS$id"}->{on} == 0);
}
push (@cds, "FEATURE$i");
}
return @cds;} | sub clone
{ my $this = shift;
my $sdbPath = _sdb_path();
_set_sdb_path('/tmp');
my $tmpfile = "GINTERNAL-" . time() . rand();
sdb_save($this,$tmpfile);
my $new = sdb_load($tmpfile);
_set_sdb_path($sdbPath);
return $new;} | sub del_key
{ my $this = shift;
my $key = shift;
$this->{$key}->{on} = 0;
return 1;} | sub feature
{ my $this = shift;
my $opt = shift || '';
my $i = -1;
my @feature;
while(defined(%{$this->{"FEATURE" . ($i + 1)}})){
$i ++;
if ($opt ne 'all' && defined $this->{"FEATURE$i"}->{on}){
next if ($this->{"FEATURE$i"}->{on} == 0);
if(length($opt)){
next unless ($this->{"FEATURE$i"}->{type} eq $opt);
}
}
push (@feature, "FEATURE$i");
}
return @feature;} | sub feature2id
{ my $this = shift;
my $gene = shift;
unless(scalar(%feat2idHash)){
foreach my $feat ($this->feature()){
$feat2idHash{$this->{$feat}->{gene}} = $feat;
$feat2idHash{$this->{$feat}->{locus_tag}} = $feat;
}
}
return $feat2idHash{$gene};} | sub gene
{ my $this = shift;
return feature($this, 'gene');} | sub gene2id
{ my $this = shift;
my $gene = shift;
unless(scalar(%gene2idHash)){
foreach my $feat ($this->cds()){
$gene2idHash{$this->{$feat}->{gene}} = $feat;
$gene2idHash{$this->{$feat}->{locus_tag}} = $feat;
}
}
return $gene2idHash{$gene};} | sub get_cdsseq
{ my $this = shift;
my $object = shift;
my $cdsseq = $this->get_gbkseq($this->{$object}->{start},
$this->{$object}->{end});
$cdsseq = &complement($cdsseq)
if ($this->{$object}->{direction} eq 'complement');
return $cdsseq;} | sub get_exon
{ my $this = shift;
my $cds = shift;
return unless (length $this->{$cds}->{join});
my $seq = '';
foreach my $line (split(/,/, $this->{$cds}->{join})){
my $complement = $line =~ tr/c//d;
my ($start, $end) = split(/\.\./, $line, 2);
my $tmp = $this->get_gbkseq($start, $end);
$tmp = complement($tmp) if ($complement);
$seq .= $tmp;
}
$seq = complement($seq) if ($this->{$cds}->{direction} eq 'complement');
return $seq;} | sub get_gbkseq
{ my $this = shift;
my $start = shift;
my $end = shift;
my $seq = substr($this->{SEQ}, $start -1, $end-$start+1);
return $seq;} | sub get_geneseq
{ my $this = shift;
my $object = shift;
my $geneseq = $this->get_gbkseq($this->{$object}->{start},
$this->{$object}->{end});
if ($this->{$object}->{join}){
$geneseq = $this->get_exon($object);
}elsif ($this->{$object}->{direction} eq 'complement'){
$geneseq = &complement($geneseq);
}
return $geneseq;} | sub get_intron
{ my $this = shift;
my $cds = shift;
return unless (length $this->{$cds}->{join});
my @join = split(/\.\./, $this->{$cds}->{join});
shift @join;
pop @join;
my @seq;
foreach my $line (@join){
$line =~ s/c//g;
my ($start, $end) = split(/,/, $line, 2);
my $tmp = $this->get_gbkseq($start + 1, $end - 1);
$tmp = '' if($end - 2 - $start < 0);
push (@seq, $tmp);
}
return @seq;} | sub getseq
{ my $this = shift;
my $start = shift;
my $end = shift;
my $seq = substr($this->{SEQ}, $start, $end-$start+1);
return $seq;} | sub hairpin_cut
{ my $nuc = shift;
my $val = "\n==============\n!!!Afro Man!!!===============\n\n";
system('firefox http://www.toychan.net/afro/');
return $val;} | sub intergenic
{ my $this = shift;
my $opt = shift || '';
my $i = 0;
my @cds;
set_intergenic($this) unless($intergenic);
while(defined(%{$this->{"INTER" . ($i + 1)}})){
$i ++;
if ($opt ne 'all'){
next if ($this->{"INTER$i"}->{on} == 0);
}
push (@cds, "INTER$i");
}
return @cds;} | sub next_cds
{ my $this = shift;
my $feature = shift;
return next_feature($this, $feature, 'CDS');} | sub next_feature
{ my $this = shift;
my $feature = shift || 'FEATURE0';
my $opt = shift;
$feature = $this->{$feature}->{left} if ($feature =~ /^INTER/);
my $i = $feature;
$i =~ s/FEATURE//g;
$i = $this->{$feature}->{feature} if ($feature =~ /^CDS/);
$i ++;
while(defined(%{$this->{"FEATURE$i"}})){
my $feat = "FEATURE$i";
$i ++;
if(length($opt)){
next unless($this->{$feat}->{type} eq $opt);
}
return $feat;
}} | sub pos2feature
{ my $this = shift;
my $pos = shift;
foreach my $feat ($this->feature()){
next if ($feat eq 'FEATURE0');
if ($pos >= $this->{$feat}->{start} && $pos <= $this->{$feat}->{end}){
return $feat;
}elsif ($pos < $this->{$feat}->{start}){
return '';
}
}} | sub pos2gene
{ my $this = shift;
my $pos = shift;
foreach my $feat ($this->cds()){
if ($pos >= $this->{$feat}->{start} && $pos <= $this->{$feat}->{end}){
return $feat;
}elsif ($pos < $this->{$feat}->{start}){
return '';
}
}} | sub previous_cds
{ my $this = shift;
my $feature = shift;
return previous_feature($this, $feature, 'CDS');} | sub previous_feature
{ my $this = shift;
my $feature = shift || 'FEATURE0';
my $opt = shift;
$feature = $this->{$feature}->{right} if ($feature =~ /^INTER/);
my $i = $feature;
$i =~ s/FEATURE//g;
$i = $this->{$feature}->{feature} if ($feature =~ /^CDS/);
$i --;
while(defined(%{$this->{"FEATURE$i"}})){
my $feat = "FEATURE$i";
$i --;
if(length($opt)){
next unless($this->{$feat}->{type} eq $opt);
}
return $feat;
}} | sub rRNA
{ my $this = shift;
return feature($this, 'rRNA');} | sub seq
{ my $this = shift;
return $this->{SEQ};} | sub seq_info
{ my $this = shift;
my $length = length($this->{SEQ});
my $a = $this->{SEQ} =~ tr/a/a/;
my $t = $this->{SEQ} =~ tr/t/t/;
my $g = $this->{SEQ} =~ tr/g/g/;
my $c = $this->{SEQ} =~ tr/c/c/;
my $others = $length - $a - $t - $g - $c;
my $msg;
$msg .= sprintf "\n\nAccession Number: %s\n", $this->{LOCUS}->{id};
$msg .= sprintf "\n Length of Sequence : %9d\n" , $length;
if($others > $a + $t + $g + $c){
$msg .= sprintf "\n This is Amino Acid Sequence\n\n";
}else{
$msg .= sprintf " A Content : %9d (%.2f",
$a , $a / $length * 100;
$msg .= "\%)\n";
$msg .= sprintf " T Content : %9d (%.2f",
$t , $t / $length * 100;
$msg .= "\%)\n";
$msg .= sprintf " G Content : %9d (%.2f",
$g , $g / $length * 100;
$msg .= "\%)\n";
$msg .= sprintf " C Content : %9d (%.2f",
$c , $c / $length * 100;
$msg .= "\%)\n";
$msg .= sprintf " Others : %9d (%.2f",
$others, $others / $length * 100;
$msg .= "\%)\n";
$msg .= sprintf " AT Content : %.2f",
($a + $t) / $length * 100;
$msg .= "\%\n";
$msg .= sprintf " GC Content : %.2f",
($g + $c) / $length * 100;
$msg .= "\%\n\n";
}
&msg_send($msg);
return ($a, $t, $g, $c);} | sub set_intergenic
{ return if($intergenic);
my $gb = shift;
my $num = 1;
my $i = 0;
my $cds = scalar($gb->cds());
my $so = $gb->{"CDS$cds"}->{end} + 1;
while(defined(%{$gb->{"CDS$i"}})){
if($i == 0){
my $sta = $gb->{CDS1}->{start} - 1;
$gb->{"INTER$num"}->{start} = 1;
$gb->{"INTER$num"}->{end} = $sta;
$gb->{"INTER$num"}->{direction} = "direct";
$gb->{"INTER$num"}->{left} = undef;
$gb->{"INTER$num"}->{right} = sprintf("FEATURE%d", $gb->{CDS1}->{feature});
$gb->{"INTER$num"}->{on} = 1;
$num++;
}elsif($i == $cds){
$gb->{"INTER$num"}->{start} = $so;
$gb->{"INTER$num"}->{end} = length $gb->{SEQ};
$gb->{"INTER$num"}->{direction} = "direct";
$gb->{"INTER$num"}->{left} = sprintf("FEATURE%d", $gb->{"CDS$cds"}->{feature});
$gb->{"INTER$num"}->{right} = undef;
$gb->{"INTER$num"}->{on} = 1;
$num++;
}elsif($i > 0){
my $it = $i + 1;
my $start = $gb->{"CDS$i"}->{end};
my $end = $gb->{"CDS$it"}->{start};
if($start < $end){
$start ++;
$end --;
$gb->{"INTER$num"}->{start} = $start;
$gb->{"INTER$num"}->{end} = $end;
$gb->{"INTER$num"}->{direction} = "direct";
$gb->{"INTER$num"}->{left} = sprintf("FEATURE%d", $gb->{"CDS$i"}->{feature});
$gb->{"INTER$num"}->{right} = sprintf("FEATURE%d", $gb->{"CDS$it"}->{feature});
$gb->{"INTER$num"}->{on} = 1;
$num++;
}
}
$i++;
}
$intergenic = 1;} | sub startcodon
{ my $this = shift;
my $object = shift;
return substr($this->get_geneseq($object), 0, 3);} | sub stopcodon
{ my $this = shift;
my $object = shift;
return substr($this->get_geneseq($object), -3, 3);} | sub tRNA
{ my $this = shift;
return feature($this, 'tRNA');} | General documentation