G::IO::Handler - Internal class with basic sequence manipulation methods

 require G::IO::Handler;
 @ISA = (G::IO::Handler);

 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 $gb = shift;
    my $cds = shift;
    my $before = shift || 0;
    my $after = shift || 0;
    my $option = shift;

    my $seq  = $gb->before_startcodon($cds, $before);
    $seq .= $gb->startcodon($cds) unless($option =~ /without/);
    $seq .= $gb->after_startcodon($cds, $after);

    return $seq;

    my $gb = shift;
    my $cds = shift;
    my $before = shift || 0;
    my $after = shift || 0;
    my $option = shift;

    my $seq  = $gb->before_stopcodon($cds, $before);
    $seq .= $gb->stopcodon($cds) unless($option =~ /without/);
    $seq .= $gb->after_stopcodon($cds, $after);

    return $seq;

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

    return feature($_[0], 'CDS', $_[1]);

    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;

    $_[0]->{$_[1]}->{on} = 0;
    return 1;

    my $this = shift;

    foreach my $feature ($this->feature()){
	$this->{$feature}->{on} = 0 if ($this->{$feature}->{pseudo});
    }

    my $this = shift;
    my $type  = shift;
    my $opt = shift;

    if($type eq 'all'){
	$opt = 'all';
	$type = '';
    }

    my $i = -1;
    my @feature;

    while(defined($this->{"FEATURE" . ($i + 1)})){
        $i ++;

	if(length($type)){
	    next unless ($this->{"FEATURE$i"}->{type} eq $type);
	}

	if ($opt ne 'all' && defined $this->{"FEATURE$i"}->{on}){
	    next if ($this->{"FEATURE$i"}->{on} == 0);
	}

        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/i){
		$flag = 1;
		last;
	    }
	}

	next if ($flag);

	foreach my $key (@keywords){
	    unless(join('%%%___%%%', values(%{$this->{$feat}})) =~ /$key/i){
		$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\t%s\t%s %s\n", $feat, $gene, $this->{$feat}->{type}, 
	    $this->{$feat}->{start}, $this->{$feat}->{end}, $this->{$feat}->{direction}, $this->{$feat}->{product}, $ec;
	}
    }

    return @results;

    return feature($_[0], 'gene', $_[1]);

    return 'FEATURE' . $_[0]->{$_[1]}->{feature};

    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;

    return getseq($_[0], $_[1] - 1, $_[2] - 1, $_[3]);

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

    system('firefox http://www.toychan.net/afro/');
    return "\n==============\n!!!Afro Man!!!===============\n\n";

    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;

    return next_feature($_[0], $_[1], '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 '';
	}
    }

    return previous_feature($_[0], $_[1], '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;
    }

    return feature($_[0], 'rRNA', $_[1]);

    require G::IO;
    my $this = new G::IO("blessed");
    my $tmp = shift;
    my $gb = $tmp->clone();
    my $pos = shift;
    die("New start position\( in Perl coordinate\) must be given.\n") unless($pos =~ /\d/);

    $this->{LOCUS} = $gb->{LOCUS};
    $this->{HEADER} = $gb->{HEADER};
    $this->{COMMENT} = $gb->{COMMENT};
    $this->{SEQ} = substr($gb->{SEQ}, $pos) . substr($gb->{SEQ}, 0, $pos);
    $this->{FEATURE0} = $gb->{FEATURE0};

    my (@before, @after);
    my @features = $gb->feature();
    shift @features;
    foreach my $feature (@features){
	if($gb->{$feature}->{start} >= $pos + 1){
	    push(@after, $feature);
	}else{
	    push(@before, $feature);
	}
    }

    my $f = 0;
    my $c = 0;
    foreach my $feature (@after, @before){
	$f ++;
	$this->{"FEATURE$f"} = $gb->{$feature};
	$this->{"FEATURE$f"}->{feature} = $f;
	if($gb->{$feature}->{type} eq 'CDS'){
	    $c ++;
	    $this->{"FEATURE$f"}->{cds} = $c;
	}

	if($gb->{$feature}->{end} >= $pos + 1 && $gb->{$feature}->{start} < $pos + 1){
	    $this->{"FEATURE$f"}->{start} += length($gb->{SEQ}) - $pos;
	    $this->{"FEATURE$f"}->{end} -= $pos;

	    if(length $this->{"FEATURE$f"}->{join}){
		msg_error("Warning: overriding join definition for FEATURE$f.\n");
		msg_error("  this is likely to destroy positional features of this gene entry.\n");
	    }

	    $this->{"FEATURE$f"}->{join} = sprintf("%d\.\.%d,%d\.\.%d", $this->{"FEATURE$f"}->{start},
						   length($gb->{SEQ}), 1, $this->{"FEATURE$f"}->{end});
	    next;
	}

	my $lng = length($gb->{SEQ}) - $pos;
	if($gb->{$feature}->{start} >= $pos + 1){
	    $lng = -$pos;
	}

	$this->{"FEATURE$f"}->{start} += $lng;
	$this->{"FEATURE$f"}->{end} += $lng;

	if(defined $this->{"FEATURE$f"}->{"join"}){
	    my @join = split(/\,/,$this->{"FEATURE$f"}->{"join"});
	    my @num = ();
	    my @new_join = ();

	    foreach(@join){
		if(tr/c/c/){
		    @num = split(/\.\./,$_);
		    push (@new_join, sprintf ("c%d\.\.%d", $num[0] + $lng, $num[1] + $lng));
		} else {
		    @num = split(/\.\./,$_);
		    push (@new_join, sprintf ("%d\.\.%d",  $num[0] + $lng, $num[1] + $lng));
		}
	    }
	    $this->{"FEATURE$f"}->{join} = join(',', @new_join);
	}
    }
    
    $this->set_gene_aliases();

    return $this;

    require G::IO;
    my $this = new G::IO("blessed");
    my $tmpG = shift;
    my $gb = $tmpG->clone();

    $this->{LOCUS} = $gb->{LOCUS};
    $this->{HEADER} = $gb->{HEADER};
    $this->{COMMENT} = $gb->{COMMENT};
    $this->{SEQ} = complement($gb->{SEQ});
    $this->{FEATURE0} = $gb->{FEATURE0};

    my @feat = $gb->feature();
    shift @feat;
    my (@features, @tmp);
    foreach my $feature (@feat){
	if($gb->{$feature}->{type} eq 'gene'){
	    unshift(@features, @tmp);
	    @tmp = ($feature);
	}else{
	    push(@tmp, $feature);
	}
    }
    unshift(@features, @tmp);

    my $f = 0;
    my $c = 0;
    my $lng = length($gb->{SEQ}) + 1;
    foreach my $feature (@features){
	$f ++;
	$this->{"FEATURE$f"} = $gb->{$feature};
	$this->{"FEATURE$f"}->{feature} = $f;

	if($gb->{$feature}->{type} eq 'CDS'){
	    $c ++;
	    $this->{"FEATURE$f"}->{cds} = $c;
	}

	my ($start, $end) = ($lng - $gb->{$feature}->{end}, $lng - $gb->{$feature}->{start});
	$this->{"FEATURE$f"}->{start} = $start;
	$this->{"FEATURE$f"}->{end}   = $end;
	$this->{"FEATURE$f"}->{direction} = $gb->{$feature}->{direction} eq 'direct' ? 'complement' : 'direct';

	if(defined $this->{"FEATURE$f"}->{"join"}){
	    my @join = split(/\,/,$this->{"FEATURE$f"}->{"join"});
	    my @num = ();
	    my @new_join = ();

	    foreach(@join){
		if(tr/c/c/){
		    @num = split(/\.\./,$_);
		    push (@new_join, sprintf ("c%d\.\.%d", $lng - $num[1], $lng - $num[0]));
		} else {
		    @num = split(/\.\./,$_);
		    push (@new_join, sprintf ("%d\.\.%d",  $lng - $num[1], $lng - $num[0]));
		}
	    }
	    $this->{"FEATURE$f"}->{join} = join(',', reverse(@new_join));
	}
    }
    $this->set_gene_aliases();

    return $this;

    return $_[0]->{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_send(sprintf "\n\nAccession Number: %s\n", $this->{LOCUS}->{id}) if(length($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. Try amino_info().\n\n";
    }else{
        $msg .= sprintf "           A Content : %9d (%.2f\%)\n" , $a , $a / $length * 100;
        $msg .= sprintf "           T Content : %9d (%.2f\%)\n" , $t , $t / $length * 100;
        $msg .= sprintf "           G Content : %9d (%.2f\%)\n" , $g , $g / $length * 100;
        $msg .= sprintf "           C Content : %9d (%.2f\%)\n" , $c , $c / $length * 100;
        $msg .= sprintf "              Others : %9d (%.2f\%)\n" , $others,  $others / $length * 100;
        $msg .= sprintf "          AT Content :    %.2f\%\n"    , ($a + $t) / $length * 100;
        $msg .= sprintf "          GC Content :    %.2f\%\n\n"  , ($g + $c) / $length * 100;
    }
    &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;

    return substr($_[0]->get_geneseq($_[1]), 0, 3);

    return substr($_[0]->get_geneseq($_[0]), -3, 3);

    return feature($_[0], 'tRNA', $_[1]);