G::IO

GenBankO

Summary Included libraries Package variables Synopsis Description General documentation Methods

Summary
G::IO::GenBankO
Package variables top
Globals (from use vars definitions)
$AUTOLOAD
@INC
$VERSION = '1.0'
Included modulestop
G::Messenger
strict
Inherit top
Unavailable
Synopsistop
 use G::IO::GenBankO;
@ISA = (G::IO::GenBankO);
Descriptiontop
 GenBank output.
Intended for internal use only.


Methodstop
make_gbNo descriptionCode
outputNo descriptionCode

Methods description


Methods code

make_gbdescriptiontopprevnext
sub make_gb {
    my $gb = shift;
    my $file = shift;
    my $output = shift;
    my ($type, $dummy, $i, $p, $q, $z, $lng);
    
    if ($output eq "attach"){
        open(OUT, '>>' . $file) || die($!);
    }else {
        open(OUT, '>' . $file) || die("hoge", $!);
    }

    if($gb->{LOCUS}->{circular} eq "1"){
	$type = "circular";
    }else{
        $type = "linear";
    }

    my @locus = ("LOCUS", $gb->{LOCUS}->{id}, "$gb->{LOCUS}->{length}bp", 
		 $gb->{LOCUS}->{nucleotide}, $type, $gb->{LOCUS}->{type}, 
		 $gb->{LOCUS}->{date});

    printf OUT "%-11.11s %-10.10s %-12.12s %-5.5s %-9.9s %-9.9s%-10.10s\n",@locus;
    printf OUT "$gb->{HEADER}$gb->{COMMENT}FEATURES %11sLocation/Qualifiers\n";

    foreach my $feat ($gb->feature()){
	if($gb->{$feat}->{"direction"} eq "direct"){
            if($gb->{$feat}->{join}){
		my $join = "join"."(".$gb->{$feat}->{join}.")";
		my $position = rindex($join,',',58);
		for($z = 0; $z <= length($join); $z += 58){
                    my $join_cut = substr($join,$z,58);
                    if($z == 0){
			printf OUT "%-4.4s %-15.15s %-58.58s\n","$dummy","$gb->{$feat}->{type}","$join_cut";
                    }else{
                        printf OUT "%-20.20s %-58.58s\n","$dummy","$join_cut";
                    }
		}
            }else{
                my @partial = split(/ /,$gb->{$feat}->{"partial"});
                if($partial[1] == 1){
                    printf OUT "%-4.4s %-15.15s %-58.58s\n",
			    "$dummy","$gb->{$feat}->{type}",
			    "$gb->{$feat}->{start}..>$gb->{$feat}->{end}";
                }elsif($partial[0] == 1){
                    printf OUT "%-4.4s %-15.15s %-58.58s\n",
			    "$dummy","$gb->{$feat}->{type}",
			    "<$gb->{$feat}->{start}..$gb->{$feat}->{end}";
                }else{
                    printf OUT "%-4.4s %-15.15s %-58.58s\n","$dummy",
			    "$gb->{$feat}->{type}",
			    "$gb->{$feat}->{start}..$gb->{$feat}->{end}";
		}
            }
	}elsif($gb->{$feat}->{"direction"} ne "direct"){
            if($gb->{$feat}->{join}){
		my $join = $gb->{$feat}->{"direction"}."("."join"."(".$gb->{$feat}->{join}.")".")";
		
                for($z = 0; $z < length($join); $z += 58){
                    my $join_cut = substr($join,$z,58);
                    if($z == 0){
                        printf OUT "%-4.4s %-15.15s %-58.58s\n",
			       "$dummy","$gb->{$feat}->{type}","$join_cut";
                    }else{
                        printf OUT "%-20.20s %-58.58s\n","$dummy","$join_cut";
		    }
		}
            }else{
                printf OUT "%-4.4s %-15.15s %-58.58s\n",
			"$dummy","$gb->{$feat}->{type}",
			"$gb->{$feat}->{direction}($gb->{$feat}->{start}..$gb->{$feat}->{end})";
            }
	}

        foreach (keys(%{$gb->{$feat}})){
            next if($_ eq "on" || $_ eq "partial" || $_ eq "start" || $_ eq "end" 
	       || $_ eq "feature" || $_ eq "type" || $_ eq "direction" 
	       || $_ eq "join" || $_ eq "cds");

	    my $str = "/".$_."="."\"".$gb->{$feat}->{$_}."\"";
	    $lng = length($str);
	    if($lng >= 58 ){
		for($i = 0;$i < $lng;$i += 58){
		    my $pr = substr($str,$i,58);
		    printf OUT "%-20.20s %-58.58s\n","$dummy",$pr;
		}
	    }else{
		printf OUT "%-20.20s %-58.58s\n","$dummy",$str;
	    }
	}
    }

    print OUT "BASE COUNT $gb->{BASE_COUNT}\n";
    print OUT "ORIGIN\n";
    for($p = 0;$p<=length($gb->{SEQ});$p += 60){
	my $seq_prt = "";
        my $seq = substr($gb->{SEQ},$p,60);
	for($q = 0;$q<=60;$q += 10){
            my $seq_splt = substr($seq,$q,10);
            $seq_prt .= $seq_splt." ";
        }
        printf OUT "%9.9s %-66.66s\n",$p+1,"$seq_prt";
    }
    print OUT "//\n";

    close(OUT);

    return 1;
}
outputdescriptiontopprevnext
sub output {
    my $gb = shift;
    my $file = shift;

    make_gb($gb, $file);
}

General documentation

AUTHOR top
Kazuharu Gaou Arakawa, gaou@g-language.org
SEE ALSO top
perl(1).