G::IO GenBankI
Package variablesGeneral documentationMethods
Package variables
Privates (from "my" definitions)
$infile;
Included modules
G::Messenger
Synopsis
No synopsis!
Description
No description!
Methods
close_gb
No description
Code
filepath
No description
Code
getnucs
No description
Code
goto_features
No description
Code
goto_origin
No description
Code
next_locus
No description
Code
next_seq
No description
Code
open_gb
No description
Code
read_features
No description
Code
read_header
No description
Code
read_locus
No description
Code
rewind_genome
No description
Code
Methods description
None available.
Methods code
close_gbdescriptionprevnextTop
sub close_gb {
    my $this = shift;
    close(GENBANK);
}
filepathdescriptionprevnextTop
sub filepath {
    my $this = shift;

    return $infile;
}
getnucsdescriptionprevnextTop
sub getnucs {
    my $this = shift;

    while(<GENBANK>){
	last if (/\/\//);
	s/[^A-Za-z]//g;
	$this->{"SEQ"} .= lc($_);
    }
}
goto_featuresdescriptionprevnextTop
sub goto_features {
    my $this = shift;
    while(<GENBANK>){
	last if (/^FEATURES/);
    }
}
goto_origindescriptionprevnextTop
sub goto_origin {
    my $this = shift;
    while(<GENBANK>){
	last if (/^ORIGIN/);
    }
}
next_locusdescriptionprevnextTop
sub next_locus {
    my $this = shift;
    my $msg = shift;
    undef %{$this};
    $this->read_locus($msg);
    $this->read_header();
    $this->read_features();
    $this->getnucs();

    if (length($this->{SEQ}) > 0){
	$this->set_gene_aliases();
	$this->seq_info() unless($msg);
	return 1;
    }else{
	return 0;
    }
}
next_seqdescriptionprevnextTop
sub next_seq {
    my $this = shift;
    my $len = '100';
    my $opt = shift;
    my $char = '1';
    $len = $opt if ($opt);
    $this->{SEQ} = '';

    while($len > 0 && $char ne ''){
	$char = getc(GENBANK);
	next unless ($char =~ /[a-zA-Z]/);
	$len --;
	$this->{SEQ} .= lc($char);
    }
    $this->{position} = tell GENBANK;

    return $char;
}
open_gbdescriptionprevnextTop
sub open_gb {
    my $this = shift;
    my $filename = shift;
    $infile = $filename;
    
    open(GENBANK, $filename) || die("Error at G::IO::GenBankI: $!\n");
    return *GENBANK;
}
read_featuresdescriptionprevnextTop
sub read_features {
    local($_);
    my $this = shift;
    my $num = -1;
    my $cds = 0;
    my $transexc = 0;
    $this->{"CDS0"}->{dummy} = 1;

    while(<GENBANK>){
	if (/^BASE COUNT/){
	    s/BASE COUNT //g;
	    $this->{"BASE_COUNT"} = $_;
	}elsif (/^ORIGIN/){
	    last;
	}elsif (/^ {5}(\S+)\s+(.*)$/ && $_ !~ /\//){
	    my $key = $1;
	    my $feature = $2;
	    $transexc = 0;
	    $num ++;

	    $this->{"FEATURE$num"}->{feature} = $num;
	    $this->{"FEATURE$num"}->{type} = $key;
	    $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 $line = $_; my $fth = ''; my $linenum = tell GENBANK; while($line !~ /\//){ $fth .= $line; last unless ($line =~ /^ {6}/); $line = <GENBANK>; $linenum = tell GENBANK; $linenum -= length($line); } seek GENBANK, $linenum, 0; 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 ($line =~ /\:/){ $this->{"FEATURE$num"}->{"partial"} = $line; } }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(<GENBANK>){ 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+)=\((.*)\)/){ my $key = $1; my $val = $2; if ($key eq 'transl_except'){ if ($transexc == 0){ $this->{"FEATURE$num"}->{$key} = $2; }else{ $this->{"FEATURE$num"}->{"$key" . $transexc} = $2; } $transexc ++; }else{ $this->{"FEATURE$num"}->{$key} = $val; } }elsif (/\/(\w+)=(.*)/){ $this->{"FEATURE$num"}->{$1} = $2; }elsif (/\/(\w+)/){ $this->{"FEATURE$num"}->{$1} .= '1'; } } }
}
read_headerdescriptionprevnextTop
sub read_header {
    my $this = shift;
    my $line = '';

    while($line = <GENBANK>){
#	if ($line =~ /^COMMENT/){
# s/COMMENT //g;
# while($line = <GENBANK>){
# last if ($line =~ /^FEATURES/);
# last unless (substr($line, 0, 1) eq ' ');
# $line =~ s/ +//g;
# $this->{"COMMENT"} .= $line;
# }
# }
last if ($line =~ /^FEATURES/); $this->{HEADER} .= $line; }
}
read_locusdescriptionprevnextTop
sub read_locus {
    my $this = shift;
    my $msg = shift;
    my $tmp = '';
    local($_);

    while(<GENBANK>){
	next unless (/LOCUS/);

	my @locus_line = split;
	shift @locus_line;

	if ($#locus_line == 6){
	    $this->{"LOCUS"}->{"circular"} = 1;
	    ($this->{"LOCUS"}->{"id"},
	     $this->{"LOCUS"}->{"length"},
	     undef,
	     $this->{"LOCUS"}->{"nucleotide"},
	     undef,
	     $this->{"LOCUS"}->{"type"},
	     $this->{"LOCUS"}->{"date"}) = @locus_line;
	}elsif ($#locus_line == 5){
	    $this->{"LOCUS"}->{"circular"} = 0;
	    ($this->{"LOCUS"}->{"id"},
	     $this->{"LOCUS"}->{"length"},
	     undef,
	     $this->{"LOCUS"}->{"nucleotide"},
	     $this->{"LOCUS"}->{"type"},
	     $this->{"LOCUS"}->{"date"}) = @locus_line;
	}else{
	    msg_error("ERROR: Unknown LOCUS definition\n") if ($msg ne 'no msg');
	    $this->{"LOCUS"}->{"circular"} = 0;
	    $this->{"LOCUS"}->{"id"} = shift @locus_line;
	}
	last;
    }
}
rewind_genomedescriptionprevnextTop
sub rewind_genome {
    my $this = shift;
    seek GENBANK, $this->{origin}, 0;
    return 1;
}
General documentation
No general documentation available.