None available.
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 %-15.15s %15.15s %-7.7s %-8.8s %-3.3s %11.11s\n",@locus;
printf OUT "%s%sFEATURES %11s Location/Qualifiers\n", $gb->{HEADER}, $gb->{COMMENT};
foreach my $feat ($gb->feature()){
if($gb->{$feat}->{"direction"} eq "direct"){
if($gb->{$feat}->{join}){
my $tmpJoinLine = $gb->{$feat}->{join};
$z = 0;
my @tmpjoin = ();
foreach my $joinsegment (split(/,/, $tmpJoinLine)){
if($joinsegment =~ /c/){
$joinsegment =~ s/c//g;
push(@tmpjoin, 'complement(' . $joinsegment . ')');
}else{
push(@tmpjoin, $joinsegment);
}
}
my $join = 'join(';
for $tmpJoinLine (@tmpjoin){
if(length($join) + length($tmpJoinLine) <=58){
$join .= $tmpJoinLine . ',';
}else{
if($z == 0){
printf OUT "%-4.4s %-15.15s %s\n", $dummy, $gb->{$feat}->{type}, $join;
}else{
printf OUT "%-20.20s %s\n", $dummy, $join;
}
$z ++;
$join = $tmpJoinLine . ',';
}
}
substr($join, -1, 1) = ')';
if($z == 0){
printf OUT "%-4.4s %-15.15s %s\n", $dummy, $gb->{$feat}->{type}, $join;
}else{
printf OUT "%-20.20s %s\n", $dummy, $join;
}
}else{
my @partial = split(/ /,$gb->{$feat}->{"partial"});
if($partial[1] == 1 && $partial[0] == 1){
printf OUT "%-4.4s %-15.15s %s\n",
"$dummy","$gb->{$feat}->{type}",
"<$gb->{$feat}->{start}..>$gb->{$feat}->{end}";
}elsif($partial[1] == 1){
printf OUT "%-4.4s %-15.15s %s\n",
"$dummy","$gb->{$feat}->{type}",
"$gb->{$feat}->{start}..>$gb->{$feat}->{end}";
}elsif($partial[0] == 1){
printf OUT "%-4.4s %-15.15s %s\n",
"$dummy","$gb->{$feat}->{type}",
"<$gb->{$feat}->{start}..$gb->{$feat}->{end}";
}else{
printf OUT "%-4.4s %-15.15s %s\n","$dummy",
"$gb->{$feat}->{type}",
"$gb->{$feat}->{start}..$gb->{$feat}->{end}";
}
}
}elsif($gb->{$feat}->{"direction"} ne "direct"){
if($gb->{$feat}->{join}){
my $tmpJoinLine = $gb->{$feat}->{join};
$z = 0;
my @tmpjoin = ();
foreach my $joinsegment (split(/,/, $tmpJoinLine)){
if($joinsegment =~ /c/){
$joinsegment =~ s/c//g;
push(@tmpjoin, 'complement(' . $joinsegment . ')');
}else{
push(@tmpjoin, $joinsegment);
}
}
my $join = 'complement(join(';
for $tmpJoinLine (@tmpjoin){
if(length($join) + length($tmpJoinLine) <=58){
$join .= $tmpJoinLine . ',';
}else{
if($z == 0){
printf OUT "%-4.4s %-15.15s %s\n", $dummy, $gb->{$feat}->{type}, $join;
}else{
printf OUT "%-20.20s %s\n", $dummy, $join;
}
$z ++;
$join = $tmpJoinLine . ',';
}
}
substr($join, -1, 1) = '))';
if($z == 0){
printf OUT "%-4.4s %-15.15s %s\n", $dummy, $gb->{$feat}->{type}, $join;
}else{
printf OUT "%-20.20s %s\n", $dummy, $join;
}
}else{
my @partial = split(/ /,$gb->{$feat}->{"partial"});
if($partial[1] == 1 && $partial[0] == 1){
printf OUT "%-4.4s %-15.15s %s\n",
"$dummy","$gb->{$feat}->{type}",
"complement(<$gb->{$feat}->{start}..>$gb->{$feat}->{end})";
}elsif($partial[1] == 1){
printf OUT "%-4.4s %-15.15s %s\n",
"$dummy","$gb->{$feat}->{type}",
"complement($gb->{$feat}->{start}..>$gb->{$feat}->{end})";
}elsif($partial[0] == 1){
printf OUT "%-4.4s %-15.15s %s\n",
"$dummy","$gb->{$feat}->{type}",
"complement(<$gb->{$feat}->{start}..$gb->{$feat}->{end})";
}else{
printf OUT "%-4.4s %-15.15s %s\n","$dummy",
"$gb->{$feat}->{type}",
"complement($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 . '"';
$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 %s\n",$dummy,$tmpline;
$tmpline = $word . ' ';
}
}
printf OUT "%-20.20s %s\n",$dummy,$tmpline;
}else{
for($i = 0;$i < $lng;$i += 58){
my $pr = substr($str,$i,58);
printf OUT "%-20.20s %s\n",$dummy,$pr;
}
}
}else{
printf OUT "%-20.20s %s\n","$dummy",$str;
}
}
}else{
if($key eq 'transl_except'){
$gb->{$feat}->{$key} = '(' . $gb->{$feat}->{$key} . ')';
}
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 %s\n",$dummy,$tmpline) unless(length($tmpline) < 1);
$tmpline = $word . ' ';
}
}
printf OUT "%-20.20s %s\n",$dummy,$tmpline;
}else{
for($i = 0;$i < $lng;$i += 58){
my $pr = substr($str,$i,58);
printf OUT "%-20.20s %s\n",$dummy,$pr;
}
}
}else{
printf OUT "%-20.20s %s\n","$dummy",$str;
}
}
}
}
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;} |