G::Prelude - Internal class with basic sequence manipulation methods

 use G::Prelude;
 @ISA = (G::Prelude);

 Intended for internal use only. Super class for the core. Provides 
 the native methods.

    my $this = shift;
    my $object = shift;
    my $length = shift || 100;

    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);
    }

    my $this = shift;
    my $object = shift;
    my $length = shift || 100;

    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);
    }

    my $this = shift;
    my $object = shift;
    my $length = shift || 100;

    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);
    }

    my $this = shift;
    my $object = shift;
    my $length = shift || 100;

    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);
    }

    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;

    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;

    my $this = shift;
    my $key = shift;

    $this->{$key}->{on} = 0;

    return 1;

    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;

    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};

    my $this = shift;

    my @args = @_;
    my (@keywords, %keyhash, @results);
    my $i = 0;

    while(defined $args[$i]){
        if (substr($args[$i], 0, 1) eq '-' && substr($args[$i], 1, 1) !~ /[0-9]/){
            $keyhash{substr($args[$i],1)} = $args[$i + 1];
            $i += 2;
        }else{
	    push(@keywords, $args[$i]);
            $i ++;
        }
    }

    foreach my $feat ($this->feature()){
	my $flag = 0;

	foreach my $key (keys %keyhash){
	    my $val = $keyhash{$key};

	    unless($this->{$feat}->{$key} =~ /$val/){
		$flag = 1;
		last;
	    }
	}

	next if ($flag);

	foreach my $key (@keywords){
	    unless(join('%%%___%%%', values(%{$this->{$feat}})) =~ /$key/){
		$flag = 1;
		last;
	    }
	}
    
	push(@results, $feat) unless($flag);
    }

    if(msg_ask_interface() eq 'Shell'){
	foreach my $feat (@results){
	    my $gene = $this->{$feat}->{gene} || $this->{$feat}->{locus_tag} || $feat;
	    my $ec = $this->{$feat}->{EC_number};
	    $ec =~ s/\s+/,/g;
	    $ec = '(' . $ec . ')' if (length $ec);

	    printf "     %s\t%s\t%s\t%s %s\n", $feat, $gene, $this->{$feat}->{type}, $this->{$feat}->{product}, $ec;
	}
    }

    return @results;

    my $this = shift;

    return feature($this, 'gene');

    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};

    my $this = shift;
    my $object = shift;

    my $cdsseq = '';

    if($this->{$object}->{start} > $this->{$object}->{end}){
	$cdsseq = substr($this->{SEQ}, $this->{$object}->{start} - 1) . 
	    $this->get_gbkseq(1, $this->{$object}->{end});
    }else{
	$cdsseq = $this->get_gbkseq($this->{$object}->{start}, 
				    $this->{$object}->{end});
    }

    $cdsseq = &complement($cdsseq) 
	if ($this->{$object}->{direction} eq 'complement');

    return $cdsseq;

    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;

    my $this = shift;
    my $start = shift;
    my $end = shift;
    my $option = shift;

    return getseq($this, $start - 1, $end - 1, $option);

    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;

    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;

    my $this = shift;
    my $start = shift;
    my $end = shift;
    my $option = shift;

    if($start < $end){
	return substr($this->{SEQ}, $start, $end-$start+1);
    }else{
	if($option =~ /circ/){
	    return substr($this->{SEQ}, $start) . 
		substr($this->{SEQ}, 0, $end + 1);
	}else{
	    my ($start2, $end2) = sort {$a <=> $b} ($start, $end);
	    return substr($this->{SEQ}, $start, $end-$start+1);
	}
    }

    my $nuc = shift;
    my $val = "\n==============\n!!!Afro Man!!!===============\n\n";

    system('firefox http://www.toychan.net/afro/');

    return $val;

    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;

    my $this = shift;
    my $feature = shift;

    return next_feature($this, $feature, 'CDS');

    my $this = shift;
    my $feature = shift || 'FEATURE0';
    my $opt = shift;

    $feature = $this->{$feature}->{left} if ($feature =~ /^INTER/);

    my $i = $this->{$feature}->{feature};
    $i ++;

    while(defined(%{$this->{"FEATURE$i"}})){
	my $feat = "FEATURE$i";
	$i ++;

	if(length($opt)){
	    next unless($this->{$feat}->{type} eq $opt);
	}

	return $feat;
    }

    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 '';
	}
    }

    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 '';
	}
    }

    my $this = shift;
    my $feature = shift;

    return previous_feature($this, $feature, 'CDS');

    my $this = shift;
    my $feature = shift || 'FEATURE0';
    my $opt = shift;

    $feature = $this->{$feature}->{right} if ($feature =~ /^INTER/);

    my $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;
    }

    my $this = shift;

    return feature($this, 'rRNA');

    my $this = shift;

    return $this->{SEQ};

    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);

    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;

    my $this = shift;
    my $object = shift;

    return substr($this->get_geneseq($object), 0, 3);

    my $this = shift;
    my $object = shift;

    return substr($this->get_geneseq($object), -3, 3);

    my $this = shift;

    return feature($this, 'tRNA');