G::IO
EmblI
Package variables
Privates (from "my" definitions)
$infile;
Included modules
Inherit
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 |
| new | 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
sub close_gb
{ my $this = shift;
close(EMBL);} | sub filepath
{ my $this = shift;
return $infile;} | sub getnucs
{ my $this = shift;
while(<EMBL>){
return if (/^\/\//);
next if (/^\S/);
s/[^A-Za-z]//g;
$this->{"SEQ"} .= lc($_);
}} | sub goto_features
{ my $this = shift;
while(<EMBL>){
last if (/^FH/);
}} | sub goto_origin
{ my $this = shift;
while(<EMBL>){
last if (/^SQ/);
}} | sub new
{ my $pkg = shift;
my $filename = shift;
my $option = shift;
my $this = {};
bless $this;
return $this;} | sub next_locus
{ my $this = shift;
my $msg = shift;
undef %{$this};
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;
}} | 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(EMBL);
next unless ($char =~ /[a-zA-Z]/);
$len --;
$this->{SEQ} .= lc($char);
}
$this->{position} = tell EMBL;
return $char;} | sub open_gb
{ my $this = shift;
my $filename = shift;
$infile = $filename;
open(EMBL, $filename) || die("Error at G::IO::EmblI: $!\n");
return *EMBL;} | sub read_features
{ local($_);
my $this = shift;
my $num = -1;
my $cds = 0;
$this->{"CDS0"}->{dummy} = 1;
while(<EMBL>){
next if (/^XX/ || /^FH/);
my $tmpline = $_;
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;
s/\^/\.\./g;
my $part_left = tr/\<//d;
my $part_right = tr/\>//d;
$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 EMBL;
while($line !~ /\//){
$fth .= substr($line, 2);
$line = <EMBL>;
$linenum = tell EMBL;
$linenum -= length($line);
}
seek EMBL, $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(<EMBL>){
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($tmpline);
msg_error("Irregular feature line: $tmpline") unless(/^FT/);
}
}
}} | sub read_header
{ my $this = shift; } | sub read_locus
{ my $this = shift;
my $msg = shift;
local($_);
while(<EMBL>){
$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"} = 1;
($this->{"LOCUS"}->{"id"},
undef,
undef,
$this->{"LOCUS"}->{"nucleotide"},
$this->{"LOCUS"}->{"type"},
undef,
$this->{"LOCUS"}->{"length"}
) = @locus_line;
}elsif ($#locus_line == 6){
$this->{"LOCUS"}->{"circular"} = 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"} = 0;
}
}elsif(/^AC\s+(.*)\;/ && length($this->{LOCUS}->{id}) < 1){
$this->{LOCUS}->{id} = $1;
}elsif(/^DT\s+(.*) /){
$this->{LOCUS}->{date} = $1;
}
}} | | rewind_genome | description | prev | next | Top |
sub rewind_genome
{ my $this = shift;
seek EMBL, $this->{origin}, 0;
return 1;} | General documentation
No general documentation available.