G::IO GenBankO
Package variablesGeneral documentationMethods
Package variables
No package variables defined.
Included modules
G::Messenger
Synopsis
No synopsis!
Description
No description!
Methods
make_gb
No description
Code
output
No description
Code
Methods description
None available.
Methods code
make_gbdescriptionprevnextTop
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 $tmpJoinLine = $gb->{$feat}->{join};

		my @tmpjoin = ();
		foreach my $joinsegment (split(/,/, $tmpJoinLine)){
		    if($joinsegment =~ /c/){
			$joinsegment =~ s/c//g;
			push(@tmpjoin, 'complement(' . $joinsegment . ')');
		    }else{
			push(@tmpjoin, $joinsegment);
		    }
		}
		
		$tmpJoinLine = join(',', @tmpjoin);

		my $join = "join"."(". $tmpJoinLine .")";
		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 my $key (sort keys(%{$gb->{$feat}})){
            next if($key eq "on" || $key eq "partial" || $key eq "start" || $key eq "end" 
	       || $key eq "feature" || $key eq "type" || $key eq "direction" 
	       || $key eq "join" || $key eq "cds");

	    if($gb->{$feat}->{$key} =~ /\t/){
		foreach my $multiplekey (split(/\t/, $gb->{$feat}->{$key})){
		    my $str = "/" . $key . "=" . "\"" . $multiplekey . "\"";
		    printf OUT "%-20.20s %-58.58s\n","$dummy",$str;
		}
	    }else{
		my $str = "/".$key."="."\"".$gb->{$feat}->{$key}."\"";
		$lng = length($str);
		if($lng >= 58 ){
		    if($str =~ /\s/){
			my $tmpline = "";
			foreach my $word (split(/ /, $str)){
			    if(length($tmpline) + length($word) < 58){
				$tmpline .= $word . ' ';
			    }else{
				printf OUT "%-20.20s %-58.58s\n",$dummy,$tmpline;
				$tmpline = $word . ' ';
			    }
			}
			printf OUT "%-20.20s %-58.58s\n",$dummy,$tmpline;
		    }else{
			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;
}
outputdescriptionprevnextTop
sub output {
    my $gb = shift;
    my $file = shift;

    make_gb($gb, $file);
}
General documentation
No general documentation available.