G::IO EmblI
Included librariesPackage variablesGeneral documentationMethods
Package variables
Privates (from "my" definitions)
%FH;
Included modules
Carp
G::Messenger
IO::File
IO::Zlib
Inherit
G::IO::GenBankO G::IO::Handler
Synopsis
No synopsis!
Description
No description!
Methods
DESTROY
No description
Code
getnucs
No description
Code
new
No description
Code
next_locus
No description
Code
open_gb
No description
Code
read_features
No description
Code
read_locus
No description
Code
Methods description
None available.
Methods code
DESTROYdescriptionprevnextTop
sub DESTROY {
    return unless($FH{$_[0]->{INSTANCE}});
    close ($FH{$_[0]->{INSTANCE}});
    delete($FH{$_[0]->{INSTANCE}});
}
getnucsdescriptionprevnextTop
sub getnucs {
    my $this = shift;

    my $fh = $FH{$this->{INSTANCE}};
    while(<$fh>){
	return if (/^\/\//);
	next if (/^\S/);
	s/[^A-Za-z]//g;
	$this->{"SEQ"} .= lc($_);
    }
}
newdescriptionprevnextTop
sub new {
    my $pkg = shift;
    my $this = {};

    return bless $this;
}
next_locusdescriptionprevnextTop
sub next_locus {
    my $this = shift;
    my $msg = shift;

    my $file = $this->{FILENAME};
    my $inst = $this->{INSTANCE};

    undef %{$this};

    $this->{FILENAME} = $file;
    $this->{INSTANCE} = $inst;

    my $ret = $this->read_locus($msg);
    $ret = $this->read_features() if($ret < 50);
    $ret = $this->getnucs() if($ret < 99);

    if (length($this->{SEQ}) > 0 || $this->{LOCUS}->{id}){
	$this->set_gene_aliases();
	$this->seq_info() unless($msg);
	return 1;
    }else{
	return 0;
    }
}
open_gbdescriptionprevnextTop
sub open_gb {
    my $this = shift;
    my $filename = shift;
    $this->{FILENAME} = $filename;
    $this->{INSTANCE} = $filename . '-' . time() . '-' . rand();
    $FH{$this->{INSTANCE}} = new IO::File;

    if($filename =~ /\.gz$/){
        $FH{$this->{INSTANCE}} = new IO::Zlib;
        $FH{$this->{INSTANCE}}->open($filename, 'rb') or croak("Error at G::IO::EmblI: $!\n");;
    }else{
        $FH{$this->{INSTANCE}} = new IO::File;
        open($FH{$this->{INSTANCE}}, $filename) or croak("Error at G::IO::EmblI: $!\n");
    }

    return $FH{$this->{INSTANCE}};
}
read_featuresdescriptionprevnextTop
sub read_features {
    local($_);
    my $this = shift;
    my $num = -1;
    my $cds = 0;
    $this->{"CDS0"}->{dummy} = 1;

    my $fh = $FH{$this->{INSTANCE}};
    while(<$fh>){
        my $tmpline;
        JUMPLABEL: if(length($tmpline)){
	    $_ = $tmpline;
        };

	next if (/^XX/ || /^FH/);
	my $tmpline2 = $_;

	if(/^\/\//){
	    return 99;
	}elsif (/^SQ\s+(.*)/){
	    $this->{"BASE_COUNT"} = $1;
	    return 50;
	}elsif (/^FT {3}(\S+)\s+(.*)$/ && $_ !~ /\//){
	    my $key = $1;
	    my $feature = $2;

	    $num ++;
	    $this->{"FEATURE$num"}->{"feature"} = $num;
	    $this->{"FEATURE$num"}->{"type"} = $1;
	    $this->{"FEATURE$num"}->{"on"} = 1;
	    
	    if ($this->{"FEATURE$num"}->{"type"} eq "CDS"){
		$cds ++;
		$this->{"FEATURE$num"}->{"cds"} = $cds;
	    }

	    s/\. \./\.\./g; #for (1. .2) type irregular format
	    s/\^/\.\./g;    #for (1^2) type irregular format

	    my $part_left = tr/\<//d;  #for (<1..2) type irregular format
	    my $part_right = tr/\>//d; #for (1..2>) type irregular format
	    $this->{"FEATURE$num"}->{"partial"} = "$part_left $part_right";

	    if (/join/){
		if (/complement\(join/){
		    $this->{"FEATURE$num"}->{"direction"} = "complement";
		    s/complement//;
		}else{
		    $this->{"FEATURE$num"}->{"direction"} = "direct";
		}

                my $fth = $_;

                while(<$fh>){
                    $tmpline = $_;
                    last if($tmpline =~ /\// || $tmpline =~ /ORIGIN/ || $tmpline =~ /^ {5}\S+/);
                    $fth .= $tmpline;
                }

		substr($fth, 0, 19) = '';
		$fth =~ s/join//g;
		$fth =~ s/\(//g;
		$fth =~ s/\)//g;
		$fth =~ s/ //g;
		$fth =~ s/\n//g;
		$fth =~ s/complement/c/g;

		my $tmpfth = $fth;
		$tmpfth =~ s/c//g;
		my @choparray = split(/\.\./, $tmpfth);
		$this->{"FEATURE$num"}->{"start"} = shift @choparray;
		$this->{"FEATURE$num"}->{"end"} = pop @choparray;
		$this->{"FEATURE$num"}->{"join"} = $fth;

		if ($fth =~ /\:/){
		    $this->{"FEATURE$num"}->{"partial"} = $fth;
		}
	    }elsif (/\?/){
		$this->{"FEATURE$num"}->{"type"} = "partial_$key";
		$this->{"FEATURE$num"}->{"partial"} = $feature;
		msg_error("Partial feature: $feature\n");
	    }elsif (/complement\((\d+)\.\.(\d+)\)/){
		$this->{"FEATURE$num"}->{"direction"} = "complement";
		$this->{"FEATURE$num"}->{"start"} = $1;
		$this->{"FEATURE$num"}->{"end"} = $2;
	    }elsif (/(\d+)\.\.(\d+)/){
		$this->{"FEATURE$num"}->{"direction"} = "direct";
		$this->{"FEATURE$num"}->{"start"} = $1;
		$this->{"FEATURE$num"}->{"end"} = $2;
	    }elsif (/\s+complement\((\d+)\)/){
		$this->{"FEATURE$num"}->{"direction"} = "complement";
		$this->{"FEATURE$num"}->{"start"} = $1;
		$this->{"FEATURE$num"}->{"end"} = $1;
	    }elsif (/\s+(\d+)/){
		$this->{"FEATURE$num"}->{"direction"} = "direct";
		$this->{"FEATURE$num"}->{"start"} = $1;
		$this->{"FEATURE$num"}->{"end"} = $1;
	    }elsif (/replace\((\d+)\,\"/){
		$this->{"FEATURE$num"}->{"direction"} = "direct";
		$this->{"FEATURE$num"}->{"direction"} = "complement" if (/complement/);
		$this->{"FEATURE$num"}->{"start"} = $1;
		$this->{"FEATURE$num"}->{"end"} = $1;
		$this->{"FEATURE$num"}->{"partial"} = $_;
	    }elsif (/(\d+).*\.\..*(\d+)/){
		$this->{"FEATURE$num"}->{"direction"} = "direct";
		$this->{"FEATURE$num"}->{"direction"} = "complement" if (/complement/);
		$this->{"FEATURE$num"}->{"start"} = $1;
		$this->{"FEATURE$num"}->{"end"} = $2;
		$this->{"FEATURE$num"}->{"partial"} = $_;
	    }else{
		msg_error("Irregular location feature: $key $feature\n");
	    }

	}else{
	    if (/\/(\w+)\=\"([^\"]+)\"/){
		if(length($this->{"FEATURE$num"}->{"$1"})){
		    $this->{"FEATURE$num"}->{"$1"} .= "\t" . $2;
		}else{
		    $this->{"FEATURE$num"}->{"$1"} = $2;
		}
	    }elsif (/\/(\w+)\=\"([^\"]+)/){
		my $tag = $1;
		my $tmp = $2;
		my $line;
		while(<$fh>){
		    substr($_, 0, 2) = '';
		    if (!/\"/){
			$tmp .= $_;
		    }elsif (/([^\"]+)\"/){
			$tmp .= $1;
			last;
		    }
		}
		$tmp =~ s/\s+/ /g;
		$tmp =~ s/ //g if ($tag eq 'translation');
		$this->{"FEATURE$num"}->{$tag} = $tmp;
	    }elsif (/\/(\w+)\=([\d|\d+])/){
		$this->{"FEATURE$num"}->{$1} = $2;
	    }elsif (/\/(\w+)\=\((.*)\)/){
		$this->{"FEATURE$num"}->{$1} = $2;
	    }elsif (/\/(\w+)\=(.*)/){
		$this->{"FEATURE$num"}->{$1} = $2;
	    }elsif (/\/(\w+)/){
		$this->{"FEATURE$num"}->{$1} .= '1';
	    }else{
		chomp($tmpline2);
		msg_error("Irregular feature line: $tmpline2") unless(/^FT/);
	    }
	}
    }
}
read_locusdescriptionprevnextTop
sub read_locus {
    my $this = shift;
    my $msg = shift;
    local($_);

    my $fh = $FH{$this->{INSTANCE}};
    while(<$fh>){
	$this->{COMMENT} .= $_;

	if(/^FH/ || /^FT/){
	    return 10;
	}elsif(/^\/\//){
	    return 99;
	}elsif(/^SQ\s+(.*)/){
	    $this->{"BASE_COUNT"} = $1;

	    return 50;
	}elsif (/^ID/){
	    s/\;/ /g;
	    s/ BP\.//g;
	    my @locus_line = split(/\s\s+/);
	    shift @locus_line;
	    
	    if ($#locus_line == 7){
		$this->{"LOCUS"}->{"circular"} = $_ =~ /circular/ ? 1:0;
		($this->{"LOCUS"}->{"id"},
		 undef,
		 undef,
		 $this->{"LOCUS"}->{"nucleotide"},
		 $this->{"LOCUS"}->{"type"},
		 undef,
		 $this->{"LOCUS"}->{"length"}
		 ) = @locus_line;
	    }elsif ($#locus_line == 6){
		$this->{"LOCUS"}->{"circular"} = $_ =~ /circular/ ? 1:0;
		($this->{"LOCUS"}->{"id"},
		 undef,
		 undef,
		 $this->{"LOCUS"}->{"nucleotide"},
		 $this->{"LOCUS"}->{"type"},
		 $this->{"LOCUS"}->{"length"}
		 ) = @locus_line;
	    }else{
		msg_error("ERROR: Unknown LOCUS definition\n") if ($msg ne 'no msg');
		$this->{"LOCUS"}->{"circular"} = $_ =~ /circular/ ? 1:0;
	    }
	}elsif(/^AC\s+(.*)\;/ && length($this->{LOCUS}->{id}) < 1){
	    $this->{LOCUS}->{id} = $1;
	}elsif(/^DT\s+(.*) /){
	    $this->{LOCUS}->{date} = $1;
	}
    }
}
General documentation
No general documentation available.