BioPerl
view release on metacpan or search on metacpan
Bio/DB/TFBS/transfac_pro.pm view on Meta::CPAN
-gene => $data[1],
-species => $taxon,
-description => $data[2],
-upstream => $upstream);
$self->{got_map}->{$id} = $map; # prevents infinite recurse when we call get_factor below
# spawn all the factors that belong on this gene map
# get_factor_ids(-gene => ...) only works for genes that encode factors;
# have to go via sites
foreach my $sid ($self->get_site_ids(-gene => $id)) {
foreach my $fid ($self->get_factor_ids(-site => $sid)) {
# it is quite deliberate that we deeply recurse to arrive at the
# correct answer, which involves pulling in most of the database
no warnings "recursion";
$self->get_factor($fid);
}
}
return $map;
}
=head2 get_seq
Title : get_seq
Usage : my $seq = $obj->get_seq($id);
Function: Get the sequence of a site. The sequence will be annotated with the
the tags 'relative_start', 'relative_end', 'relative_type' and
'relative_to'.
Returns : Bio::Seq
Args : string - a site id ('R...')
=cut
sub get_seq {
my ($self, $id) = @_;
$id || return;
my $data = $self->{site}->{data}->{$id} || return;
my @data = split(SEPARATOR, $data);
my $seq = Bio::Seq->new(-seq => $data[2],
-accession_number => $id,
-description => $data[6] ? 'Genomic sequence' : 'Consensus or artificial sequence',
-id => $data[0],
-strand => 1,
-alphabet => $data[7] || 'dna',
-species => $data[6]);
my $annot = $seq->annotation;
my $sv = Bio::Annotation::SimpleValue->new(-tagname => 'relative_start', -value => $data[4] || 1);
$annot->add_Annotation($sv);
$sv = Bio::Annotation::SimpleValue->new(-tagname => 'relative_end', -value => $data[5] || ($data[4] || 1 + length($data[2]) - 1));
$annot->add_Annotation($sv);
$sv = Bio::Annotation::SimpleValue->new(-tagname => 'relative_type', -value => $data[3] || 'artificial');
$annot->add_Annotation($sv);
$sv = Bio::Annotation::SimpleValue->new(-tagname => 'relative_to', -value => $data[1]);
$annot->add_Annotation($sv);
return $seq;
}
=head2 get_fragment
Title : get_fragment
Usage : my $seq = $obj->get_fragment($id);
Function: Get the sequence of a fragment.
Returns : Bio::Seq
Args : string - a site id ('FR...')
=cut
sub get_fragment {
my ($self, $id) = @_;
$id || return;
my $data = $self->{fragment}->{data}->{$id} || return;
my @data = split(SEPARATOR, $data);
# accession = id gene_id1 gene_id2 species_tax_id_or_raw_string sequence source
return new Bio::Seq( -seq => $data[4],
-accession_number => $id,
-description => 'Between genes '.$data[1].' and '.$data[2],
-species => $data[3],
-id => $data[0],
-alphabet => 'dna' );
}
=head2 get_matrix
Title : get_matrix
Usage : my $matrix = $obj->get_matrix($id);
Function: Get a matrix that describes a binding site.
Returns : Bio::Matrix::PSM::SiteMatrix
Args : string - a matrix id ('M...'), optionally a sequence string from
which base frequencies will be calculated for the matrix model
(default 0.25 each)
=cut
sub get_matrix {
my ($self, $id, $seq) = @_;
$id || return;
$seq ||= 'atgc';
$seq = lc($seq);
my $data = $self->{matrix}->{data}->{$id} || return;
my @data = split(SEPARATOR, $data);
$data[4] || $self->throw("Matrix data missing for $id");
my ($a, $c, $g, $t);
foreach my $position (split(INTERNAL_SEPARATOR, $data[4])) {
my ($a_count, $c_count, $g_count, $t_count) = split("\t", $position);
push(@{$a}, $a_count);
push(@{$c}, $c_count);
push(@{$g}, $g_count);
push(@{$t}, $t_count);
}
# our psms include a simple background model so we can use
# sequence_match_weight() if desired
my $a_freq = ($seq =~ tr/a//) / length($seq);
my $c_freq = ($seq =~ tr/c//) / length($seq);
my $g_freq = ($seq =~ tr/g//) / length($seq);
my $t_freq = ($seq =~ tr/t//) / length($seq);
my $psm = Bio::Matrix::PSM::SiteMatrix->new(-pA => $a,
-pC => $c,
-pG => $g,
-pT => $t,
-id => $data[0],
-accession_number => $id,
-sites => $data[3],
-width => scalar(@{$a}),
-correction => 1,
-model => { A => $a_freq, C => $c_freq, G => $g_freq, T => $t_freq } );
#*** used to make a Bio::Matrix::PSM::Psm and add references, but it
Bio/DB/TFBS/transfac_pro.pm view on Meta::CPAN
}
# -id -name -species -site -factor -reference
sub get_gene_ids {
my $self = shift;
return $self->_get_ids('gene', @_);
}
=head2 get_site_ids
Title : get_site_ids
Usage : my @ids = $obj->get_site_ids(-key => $value);
Function: Get all the site ids that are associated with the supplied
args.
Returns : list of strings (ids)
Args : -key => value, where value is a string id, and key is one of:
-id -species -gene -matrix -factor -reference
=cut
sub get_site_ids {
my $self = shift;
return $self->_get_ids('site', @_);
}
=head2 get_matrix_ids
Title : get_matrix_ids
Usage : my @ids = $obj->get_matrix_ids(-key => $value);
Function: Get all the matrix ids that are associated with the supplied
args.
Returns : list of strings (ids)
Args : -key => value, where value is a string id, and key is one of:
-id -name -site -factor -reference
=cut
sub get_matrix_ids {
my $self = shift;
return $self->_get_ids('matrix', @_);
}
=head2 get_factor_ids
Title : get_factor_ids
Usage : my @ids = $obj->get_factor_ids(-key => $value);
Function: Get all the factor ids that are associated with the supplied
args.
Returns : list of strings (ids)
Args : -key => value, where value is a string id, and key is one of:
-id -name -species -interactors -gene -matrix -site -reference
NB: -gene only gets factor ids for genes that encode factors
=cut
sub get_factor_ids {
my $self = shift;
return $self->_get_ids('factor', @_);
}
=head2 get_fragment_ids
Title : get_fragment_ids
Usage : my @ids = $obj->get_fragment_ids(-key => $value);
Function: Get all the fragment ids that are associated with the supplied
args.
Returns : list of strings (ids)
Args : -key => value, where value is a string id, and key is one of:
-id -species -gene -factor -reference
=cut
sub get_fragment_ids {
my $self = shift;
return $self->_get_ids('fragment', @_);
}
=head2 Helper methods
=cut
# internal method which does the indexing
sub _build_index {
my ($self, $dat_dir, $force) = @_;
# MLDBM would give us transparent complex data structures with DB_File,
# allowing just one index file, but its yet another requirement and we
# don't strictly need it
my $index_dir = $self->index_directory;
my $gene_index = "$index_dir/gene.dat.index";
my $reference_index = "$index_dir/reference.dat.index";
my $matrix_index = "$index_dir/matrix.dat.index";
my $factor_index = "$index_dir/factor.dat.index";
my $fragment_index = "$index_dir/fragment.dat.index";
my $site_index = "$index_dir/site.dat.index";
my $reference_dat = "$dat_dir/reference.dat";
if (! -e $reference_index || $force) {
open my $REF, '<', $reference_dat or $self->throw("Could not read reference file '$reference_dat': $!");
my %references;
unlink $reference_index;
my $ref = tie(%references, 'DB_File', $reference_index, O_RDWR|O_CREAT, 0644, $DB_HASH)
or $self->throw("CCould not open file '$reference_index': $!");
my %pubmed;
my $reference_pubmed = $reference_index.'.pubmed';
unlink $reference_pubmed;
my $pub = tie(%pubmed, 'DB_File', $reference_pubmed, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$reference_pubmed': $!");
my %gene;
my $reference_gene = $gene_index.'.reference';
unlink $reference_gene;
my $gene = tie(%gene, 'DB_File', $reference_gene, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$reference_gene': $!");
my %site;
my $reference_site = $site_index.'.reference';
unlink $reference_site;
my $site = tie(%site, 'DB_File', $reference_site, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$reference_site': $!");
my %fragment;
my $reference_fragment = $fragment_index.'.reference';
unlink $reference_fragment;
my $fragment = tie(%fragment, 'DB_File', $reference_fragment, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$reference_fragment': $!");
my %factor;
my $reference_factor = $factor_index.'.reference';
unlink $reference_factor;
my $factor = tie(%factor, 'DB_File', $reference_factor, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$reference_factor': $!");
my %matrix;
my $reference_matrix = $matrix_index.'.reference';
unlink $reference_matrix;
my $matrix = tie(%matrix, 'DB_File', $reference_matrix, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$reference_matrix': $!");
# skip the first three header lines
<$REF>; <$REF>; <$REF>;
my @data;
while (<$REF>) {
if (/^AC (\S+)/) {
$data[0] = $1;
}
elsif (/^RX PUBMED: (\d+)/) {
$data[1] = $1;
$pub->put("$1", $data[0]);
}
elsif (/^RA (.+)\n$/) {
$data[2] = $1;
}
elsif (/^RT (.+?)\.?\n$/) {
$data[3] = $1;
}
elsif (/^RL (.+?)\.?\n$/) {
$data[4] = $1;
}
elsif (/^GE TRANSFAC: (\w\d+)/) {
$gene->put($data[0], "$1");
}
elsif (/^BS TRANSFAC: (\w\d+)/) {
$site->put($data[0], "$1");
}
elsif (/^FA TRANSFAC: (\w\d+)/) {
$factor->put($data[0], "$1");
}
elsif (/^FR TRANSFAC: (FR\d+)/) {
$fragment->put($data[0], "$1");
}
elsif (/^MX TRANSFAC: (\w\d+)/) {
$matrix->put($data[0], "$1");
}
elsif (/^\/\//) {
# end of a record, store previous data and reset
# accession = pubmed authors title location
$references{$data[0]} = join(SEPARATOR, ($data[1] || '',
$data[2] || '',
$data[3] || '',
$data[4] || ''));
@data = ();
}
}
close $REF;
$ref = $pub = $gene = $site = $fragment = $factor = $matrix = undef;
untie %references;
untie %pubmed;
untie %gene;
untie %site;
untie %fragment;
untie %factor;
untie %matrix;
}
my $gene_dat = "$dat_dir/gene.dat";
if (! -e $gene_index || $force) {
open my $GEN, '<', $gene_dat or $self->throw("Could not read gene file '$gene_dat': $!");
my %genes;
unlink $gene_index;
my $gene = tie(%genes, 'DB_File', $gene_index, O_RDWR|O_CREAT, 0644, $DB_HASH)
or $self->throw("Could not open file '$gene_index': $!");
my %id;
my $gene_id = $gene_index.'.id';
unlink $gene_id;
my $id = tie(%id, 'DB_File', $gene_id, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$gene_id': $!");
my %name;
my $gene_name = $gene_index.'.name';
unlink $gene_name;
my $name = tie(%name, 'DB_File', $gene_name, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$gene_name': $!");
my %species;
my $gene_species = $gene_index.'.species';
unlink $gene_species;
my $species = tie(%species, 'DB_File', $gene_species, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$gene_species': $!");
my %site;
my $gene_site = $site_index.'.gene';
unlink $gene_site;
my $site = tie(%site, 'DB_File', $gene_site, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$gene_site': $!");
my %factor;
my $gene_factor = $factor_index.'.gene';
unlink $gene_factor;
my $factor = tie(%factor, 'DB_File', $gene_factor, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$gene_factor': $!");
my %fragment;
my $gene_fragment = $fragment_index.'.gene';
unlink $gene_fragment;
my $fragment = tie(%fragment, 'DB_File', $gene_fragment, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$gene_fragment': $!");
my %reference;
my $gene_reference = $reference_index.'.gene';
unlink $gene_reference;
my $reference = tie(%reference, 'DB_File', $gene_reference, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$gene_reference': $!");
# skip the first three header lines
<$GEN>; <$GEN>; <$GEN>;
my @data;
while (<$GEN>) {
if (/^AC (\S+)/) {
$data[0] = $1;
}
elsif (/^ID (\S+)/) {
$data[1] = $1;
$id->put("$1", $data[0]);
}
elsif (/^SD (.+)$/) {
$data[2] = lc("$1");
$name->put(lc("$1"), $data[0]);
}
elsif (/^SY (.+)\.$/) {
foreach (split('; ', lc("$1"))) {
$name->put($_, $data[0]);
}
}
elsif (/^DE (.+)$/) {
$data[3] = $1;
}
elsif (/^OS (.+)$/) {
my $raw_species = $1;
my $taxid = $self->_species_to_taxid($raw_species);
$data[4] = $taxid || $raw_species;
$species->put($data[4], $data[0]);
}
elsif (/^RN .+?(RE\d+)/) {
$reference->put($data[0], "$1");
}
elsif (/^BS .+?(R\d+)/) {
$site->put($data[0], "$1");
}
elsif (/^FA (T\d+)/) {
$factor->put($data[0], "$1");
}
elsif (/^BR (FR\d+)/) {
$fragment->put($data[0], "$1");
}
elsif (/^\/\//) {
# end of a record, store previous data and reset
# accession = id name description species_tax_id_or_raw_string
$genes{$data[0]} = join(SEPARATOR, ($data[1] || '',
$data[2] || '',
$data[3] || '',
$data[4] || ''));
@data = ();
}
}
close $GEN;
$gene = $id = $name = $species = $site = $factor = $reference = undef;
untie %genes;
untie %id;
untie %name;
untie %species;
untie %site;
untie %factor;
untie %reference;
}
my $site_dat = "$dat_dir/site.dat";
if (! -e $site_index || $force) {
open my $SIT, '<', $site_dat or $self->throw("Could not read site file '$site_dat': $!");
my %sites;
unlink $site_index;
my $site = tie(%sites, 'DB_File', $site_index, O_RDWR|O_CREAT, 0644, $DB_HASH)
or $self->throw("Could not open file '$site_index': $!");
my %id;
my $site_id = $site_index.'.id';
unlink $site_id;
my $id = tie(%id, 'DB_File', $site_id, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$site_id': $!");
my %species;
my $site_species = $site_index.'.species';
unlink $site_species;
my $species = tie(%species, 'DB_File', $site_species, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$site_species': $!");
my %qualities;
my $site_qualities = $site_index.'.qual';
unlink $site_qualities;
my $quality = tie(%qualities, 'DB_File', $site_qualities, O_RDWR|O_CREAT, 0644, $DB_HASH)
or $self->throw("Could not open file '$site_qualities': $!");
my %gene;
my $site_gene = $gene_index.'.site';
unlink $site_gene;
my $gene = tie(%gene, 'DB_File', $site_gene, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$site_gene': $!");
my %matrix;
my $site_matrix = $matrix_index.'.site';
Bio/DB/TFBS/transfac_pro.pm view on Meta::CPAN
$matrix = $id = $name = $site = $factor = $reference = undef;
untie %matrices;
untie %id;
untie %name;
untie %site;
untie %factor;
untie %reference;
}
my $factor_dat = "$dat_dir/factor.dat";
if (! -e $factor_index || $force) {
open my $FAC, '<', $factor_dat or $self->throw("Could not read factor file '$factor_dat': $!");
my %factors;
unlink $factor_index;
my $factor = tie(%factors, 'DB_File', $factor_index, O_RDWR|O_CREAT, 0644, $DB_HASH)
or $self->throw("Could not open file '$factor_index': $!");
my %id;
my $factor_id = $factor_index.'.id';
unlink $factor_id;
my $id = tie(%id, 'DB_File', $factor_id, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_id': $!");
my %name;
my $factor_name = $factor_index.'.name';
unlink $factor_name;
my $name = tie(%name, 'DB_File', $factor_name, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_name': $!");
my %species;
my $factor_species = $factor_index.'.species';
unlink $factor_species;
my $species = tie(%species, 'DB_File', $factor_species, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_species': $!");
my %interactors;
my $factor_interactors = $factor_index.'.interactors';
unlink $factor_interactors;
my $interact = tie(%interactors, 'DB_File', $factor_interactors, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_interactors': $!");
my %gene;
my $factor_gene = $gene_index.'.factor';
unlink $factor_gene;
my $gene = tie(%gene, 'DB_File', $factor_gene, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_gene': $!");
my %matrix;
my $factor_matrix = $matrix_index.'.factor';
unlink $factor_matrix;
my $matrix = tie(%matrix, 'DB_File', $factor_matrix, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_matrix': $!");
my %site;
my $factor_site = $site_index.'.factor';
unlink $factor_site;
my $site = tie(%site, 'DB_File', $factor_site, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_site': $!");
my %fragment;
my $factor_fragment = $fragment_index.'.factor';
unlink $factor_fragment;
my $fragment = tie(%fragment, 'DB_File', $factor_fragment, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_fragment': $!");
my %reference;
my $factor_reference = $reference_index.'.factor';
unlink $factor_reference;
my $reference = tie(%reference, 'DB_File', $factor_reference, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$factor_reference': $!");
# skip the first three header lines
<$FAC>; <$FAC>; <$FAC>;
my @data;
my $sequence = '';
while (<$FAC>) {
if (/^AC (\S+)/) {
$data[0] = $1;
}
elsif (/^ID (\S+)/) {
# IDs are always the same as AC? Is this needed?
$data[1] = $1;
$id->put("$1", $data[0]);
}
elsif (/^FA (.+)$/) {
$data[2] = $1;
$name->put("$1", $data[0]);
}
elsif (/^OS (.+)$/) {
# This is the species the actual factor came from, which may
# differ from the species of any sequences it is described as
# binding to. Not all factors that have a species have a gene,
# so can't delegate species to a gene lookup.
my $raw_species = $1;
my $taxid = $self->_species_to_taxid($raw_species);
$data[3] = $taxid || $raw_species;
$species->put($data[3], $data[0]);
}
elsif (/^GE (G\d+)/) {
$gene->put($data[0], "$1");
}
elsif (/^SQ (.+)$/) {
$sequence .= $1;
}
elsif (/^IN (T\d+)/) {
$interact->put($data[0], "$1");
}
elsif (/^MX (M\d+)/) {
$matrix->put($data[0], "$1");
}
elsif (/^BS (R\d+)/) {
$site->put($data[0], "$1");
}
elsif (/^BR (FR\d+)/) {
$fragment->put($data[0], "$1");
}
elsif (/^RN .+?(RE\d+)/) {
$reference->put($data[0], "$1");
}
elsif (/^\/\//) {
# end of a record, store previous data and reset
# accession = id name species sequence
$factors{$data[0]} = join(SEPARATOR, ($data[1] || '',
$data[2] || '',
$data[3] || '',
$sequence));
@data = ();
$sequence = '';
}
}
close $FAC;
$factor = $id = $name = $species = $interact = $gene = $matrix = $site = $fragment = $reference = undef;
untie %factors;
untie %id;
untie %name;
untie %species;
untie %interactors;
untie %gene;
untie %matrix;
untie %site;
untie %fragment;
untie %reference;
}
my $fragment_dat = "$dat_dir/fragment.dat";
if (! -e $fragment_index || $force) {
if (open my $FRA, '<', $fragment_dat) {
my %fragments;
unlink $fragment_index;
my $fragment = tie(%fragments, 'DB_File', $fragment_index, O_RDWR|O_CREAT, 0644, $DB_HASH)
or $self->throw("Could not open file '$fragment_index': $!");
my %id;
my $fragment_id = $fragment_index.'.id';
unlink $fragment_id;
my $id = tie(%id, 'DB_File', $fragment_id, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$fragment_id': $!");
my %qualities;
my $fragment_qualities = $fragment_index.'.qual';
unlink $fragment_qualities;
my $quality = tie(%qualities, 'DB_File', $fragment_qualities, O_RDWR|O_CREAT, 0644, $DB_HASH)
or $self->throw("Could not open file '$fragment_qualities': $!");
my %species;
my $fragment_species = $fragment_index.'.species';
unlink $fragment_species;
my $species = tie(%species, 'DB_File', $fragment_species, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$fragment_species': $!");
my %gene;
my $fragment_gene = $gene_index.'.fragment';
unlink $fragment_gene;
my $gene = tie(%gene, 'DB_File', $fragment_gene, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$fragment_gene': $!");
my %factor;
my $fragment_factor = $factor_index.'.fragment';
unlink $fragment_factor;
my $factor = tie(%factor, 'DB_File', $fragment_factor, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$fragment_factor': $!");
my %reference;
my $fragment_reference = $reference_index.'.fragment';
unlink $fragment_reference;
my $reference = tie(%reference, 'DB_File', $fragment_reference, O_RDWR|O_CREAT, 0644, $DB_BTREE)
or $self->throw("Could not open file '$fragment_reference': $!");
# skip the first three header lines
<$FRA>; <$FRA>; <$FRA>;
my @data;
while (<$FRA>) {
if (/^AC (\S+)/) {
$data[0] = $1;
}
elsif (/^ID (\S+)/) {
# IDs are always the same as AC? Is this needed?
$data[1] = $1;
$id->put("$1", $data[0]);
}
elsif (/^DE Gene: (G\d+)(?:.+Gene: (G\d+))?/) {
my ($gene1, $gene2) = ($1, $2);
$data[2] = $gene1;
$data[3] = $gene2; # could be undef
$gene->put($data[0], $gene1);
$gene->put($data[0], $gene2) if $gene2;
}
elsif (/^OS (.+)$/) {
# As per the site.dat parsing
my $raw_species = $1;
my $taxid = $self->_species_to_taxid($raw_species);
$data[4] = $taxid || $raw_species;
$species->put($data[4], $data[0]);
}
elsif (/^SQ [atcgn]*([ATCGN]+)[atcgn]*/) {
$data[5] .= $1;
# there can be (usually are) multiple SQ lines with a single
# long seq split over them. The 'real' sequence is in caps
}
elsif (/^SC Build (\S+):$/) {
$data[6] = $1;
# maybe parse it out a little more? We have build,
# chromosomal coords and strand, eg.
# SC Build HSA_May2004: Chr.2 43976692..43978487 (FORWARD).
}
elsif (/^RN .+?(RE\d+)/) {
$reference->put($data[0], "$1");
}
elsif (/^BF (T\d+); .+?; Quality: (\d)/) {
$factor->put($data[0], "$1");
$qualities{$data[0].SEPARATOR.$1} = $2;
}
elsif (/^\/\//) {
# end of a record, store previous data and reset
# accession = id gene_id1 gene_id2 species_tax_id_or_raw_string sequence source
$fragments{$data[0]} = join(SEPARATOR, ($data[1] || '',
$data[2] || '',
$data[3] || '',
$data[4] || '',
$data[5] || '',
$data[6] || ''));
@data = ();
}
}
close $FRA;
$fragment = $id = $species = $quality = $gene = $factor = $reference = undef;
untie %fragments;
untie %id;
untie %species;
untie %qualities;
untie %gene;
untie %factor;
untie %reference;
}
else {
$self->warn("Could not read fragment file '$fragment_dat', assuming you have an old version of Transfac Pro with no fragment.dat file");
}
}
}
# connect the internal db handle
sub _db_connect {
my $self = shift;
return if $self->{'_initialized'};
my $index_dir = $self->index_directory;
my $gene_index = "$index_dir/gene.dat.index";
my $reference_index = "$index_dir/reference.dat.index";
my $matrix_index = "$index_dir/matrix.dat.index";
my $factor_index = "$index_dir/factor.dat.index";
my $site_index = "$index_dir/site.dat.index";
my $fragment_index = "$index_dir/fragment.dat.index";
foreach ($gene_index, $reference_index, $matrix_index, $factor_index, $site_index, $fragment_index) {
if (! -e $_) {
#$self->warn("Index files have not been created");
#return 0;
}
}
# reference
{
$self->{reference}->{data} = {};
tie (%{$self->{reference}->{data}}, 'DB_File', $reference_index, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$reference_index': $!");
my $reference_pubmed = $reference_index.'.pubmed';
$self->{reference}->{pubmed} = tie (%{$self->{reference}->{pubmed}}, 'DB_File', $reference_pubmed, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$reference_pubmed': $!");
my $reference_gene = $gene_index.'.reference';
$self->{gene}->{reference} = tie (%{$self->{gene}->{reference}}, 'DB_File', $reference_gene, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$reference_gene': $!");
my $reference_site = $site_index.'.reference';
$self->{site}->{reference} = tie (%{$self->{site}->{reference}}, 'DB_File', $reference_site, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$reference_site': $!");
my $reference_fragment = $fragment_index.'.reference';
$self->{fragment}->{reference} = tie (%{$self->{fragment}->{reference}}, 'DB_File', $reference_fragment, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$reference_fragment': $!");
my $reference_factor = $factor_index.'.reference';
$self->{factor}->{reference} = tie (%{$self->{factor}->{reference}}, 'DB_File', $reference_factor, undef, 0644, $DB_BTREE) || $self->throw("Cannot open file '$reference_factor': $!");
my $reference_matrix = $matrix_index.'.reference';
$self->{matrix}->{reference} = tie (%{$self->{matrix}->{reference}}, 'DB_File', $reference_matrix, undef, 0644, $DB_BTREE) || $self->throw("Cannot open file '$reference_matrix': $!");
}
# gene
{
$self->{gene}->{data} = {};
tie (%{$self->{gene}->{data}}, 'DB_File', $gene_index, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$gene_index': $!");
my $gene_id = $gene_index.'.id';
$self->{gene}->{id} = tie(%{$self->{gene}->{id}}, 'DB_File', $gene_id, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$gene_id': $!");
my $gene_name = $gene_index.'.name';
$self->{gene}->{name} = tie(%{$self->{gene}->{name}}, 'DB_File', $gene_name, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$gene_name': $!");
my $gene_species = $gene_index.'.species';
$self->{gene}->{species} = tie(%{$self->{gene}->{species}}, 'DB_File', $gene_species, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$gene_species': $!");
my $gene_site = $site_index.'.gene';
$self->{site}->{gene} = tie(%{$self->{site}->{gene}}, 'DB_File', $gene_site, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$gene_site': $!");
my $gene_fragment = $fragment_index.'.gene';
$self->{fragment}->{gene} = tie(%{$self->{fragment}->{gene}}, 'DB_File', $gene_fragment, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$gene_fragment': $!");
my $gene_factor = $factor_index.'.gene';
$self->{factor}->{gene} = tie(%{$self->{factor}->{gene}}, 'DB_File', $gene_factor, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$gene_factor': $!");
my $gene_reference = $reference_index.'.gene';
$self->{reference}->{gene} = tie(%{$self->{reference}->{gene}}, 'DB_File', $gene_reference, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$gene_reference': $!");
}
# site
{
$self->{site}->{data} = {};
tie (%{$self->{site}->{data}}, 'DB_File', $site_index, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$site_index': $!");
my $site_id = $site_index.'.id';
$self->{site}->{id} = tie(%{$self->{site}->{id}}, 'DB_File', $site_id, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$site_id': $!");
my $site_species = $site_index.'.species';
$self->{site}->{species} = tie(%{$self->{site}->{species}}, 'DB_File', $site_species, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file $site_species': $!");
#*** quality not actually used by anything (yet)
my $site_qualities = $site_index.'.qual';
$self->{quality} = {};
tie(%{$self->{quality}}, 'DB_File', $site_qualities, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$site_qualities': $!");
my $site_gene = $gene_index.'.site';
$self->{gene}->{site} = tie(%{$self->{gene}->{site}}, 'DB_File', $site_gene, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$site_gene': $!");
my $site_matrix = $matrix_index.'.site';
$self->{matrix}->{site} = tie(%{$self->{matrix}->{site}}, 'DB_File', $site_matrix, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$site_matrix': $!");
my $site_factor = $factor_index.'.site';
$self->{factor}->{site} = tie(%{$self->{factor}->{site}}, 'DB_File', $site_factor, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$site_factor': $!");
my $site_reference = $reference_index.'.site';
$self->{reference}->{site} = tie(%{$self->{reference}->{site}}, 'DB_File', $site_reference, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$site_reference': $!");
}
# fragment (may not be in older databases)
if (-e $fragment_index) {
$self->{fragment}->{data} = {};
tie (%{$self->{fragment}->{data}}, 'DB_File', $fragment_index, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$fragment_index': $!");
my $fragment_id = $fragment_index.'.id';
$self->{fragment}->{id} = tie(%{$self->{fragment}->{id}}, 'DB_File', $fragment_id, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$fragment_id': $!");
my $fragment_species = $fragment_index.'.species';
$self->{fragment}->{species} = tie(%{$self->{fragment}->{species}}, 'DB_File', $fragment_species, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file $fragment_species': $!");
#*** quality not actually used by anything (yet)
my $fragment_qualities = $fragment_index.'.qual';
$self->{fragment_quality} = {};
tie(%{$self->{fragment_quality}}, 'DB_File', $fragment_qualities, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$fragment_qualities': $!");
my $fragment_gene = $gene_index.'.fragment';
$self->{gene}->{fragment} = tie(%{$self->{gene}->{fragment}}, 'DB_File', $fragment_gene, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$fragment_gene': $!");
my $fragment_factor = $factor_index.'.fragment';
$self->{factor}->{fragment} = tie(%{$self->{factor}->{fragment}}, 'DB_File', $fragment_factor, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$fragment_factor': $!");
my $fragment_reference = $reference_index.'.fragment';
$self->{reference}->{fragment} = tie(%{$self->{reference}->{fragment}}, 'DB_File', $fragment_reference, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$fragment_reference': $!");
}
else {
die "no fragment_index at '$fragment_index'\n";
}
# matrix
{
$self->{matrix}->{data} = {};
tie (%{$self->{matrix}->{data}}, 'DB_File', $matrix_index, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$matrix_index': $!");
my $matrix_id = $matrix_index.'.id';
$self->{matrix}->{id} = tie(%{$self->{matrix}->{id}}, 'DB_File', $matrix_id, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$matrix_id': $!");
my $matrix_name = $matrix_index.'.name';
$self->{matrix}->{name} = tie(%{$self->{matrix}->{name}}, 'DB_File', $matrix_name, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$matrix_name': $!");
my $matrix_site = $site_index.'.matrix';
$self->{site}->{matrix} = tie(%{$self->{site}->{matrix}}, 'DB_File', $matrix_site, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$matrix_site': $!");
my $matrix_factor = $factor_index.'.matrix';
$self->{factor}->{matrix} = tie(%{$self->{factor}->{matrix}}, 'DB_File', $matrix_factor, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$matrix_factor': $!");
my $matrix_reference = $reference_index.'.matrix';
$self->{reference}->{matrix} = tie(%{$self->{reference}->{matrix}}, 'DB_File', $matrix_reference, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$matrix_reference': $!");
}
# factor
{
$self->{factor}->{data} = {};
tie (%{$self->{factor}->{data}}, 'DB_File', $factor_index, O_RDWR, undef, $DB_HASH) || $self->throw("Cannot open file '$factor_index': $!");
my $factor_id = $factor_index.'.id';
$self->{factor}->{id} = tie(%{$self->{factor}->{id}}, 'DB_File', $factor_id, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file 'factor_id': $!");
my $factor_name = $factor_index.'.name';
$self->{factor}->{name} = tie(%{$self->{factor}->{name}}, 'DB_File', $factor_name, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_name': $!");
my $factor_species = $factor_index.'.species';
$self->{factor}->{species} = tie(%{$self->{factor}->{species}}, 'DB_File', $factor_species, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_species': $!");
my $factor_interactors = $factor_index.'.interactors';
$self->{factor}->{interactors} = tie(%{$self->{factor}->{interactors}}, 'DB_File', $factor_interactors, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_interactors': $!");
my $factor_gene = $gene_index.'.factor';
$self->{gene}->{factor} = tie(%{$self->{gene}->{factor}}, 'DB_File', $factor_gene, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_gene': $!");
my $factor_matrix = $matrix_index.'.factor';
$self->{matrix}->{factor} = tie(%{$self->{matrix}->{factor}}, 'DB_File', $factor_matrix, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_matrix': $!");
my $factor_site = $site_index.'.factor';
$self->{site}->{factor} = tie(%{$self->{site}->{factor}}, 'DB_File', $factor_site, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_site': $!");
my $factor_fragment = $fragment_index.'.factor';
$self->{fragment}->{factor} = tie(%{$self->{fragment}->{factor}}, 'DB_File', $factor_fragment, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_fragment': $!");
my $factor_reference = $reference_index.'.factor';
$self->{reference}->{factor} = tie(%{$self->{reference}->{factor}}, 'DB_File', $factor_reference, O_RDWR, undef, $DB_BTREE) || $self->throw("Cannot open file '$factor_reference': $!");
}
$self->{'_initialized'} = 1;
}
=head2 index_directory
Title : index_directory
Function : Get/set the location that index files are stored. (this module
will index the supplied database)
Usage : $obj->index_directory($newval)
Returns : value of index_directory (a scalar)
Args : on set, new value (a scalar or undef, optional)
=cut
sub index_directory {
my $self = shift;
return $self->{'index_directory'} = shift if @_;
return $self->{'index_directory'};
}
# resolve a transfac species string into an ncbi taxid
sub _species_to_taxid {
my ($self, $raw_species) = @_;
$raw_species or return;
my $species_string;
my @split = split(', ', $raw_species);
(@split > 1) ? ($species_string = $split[1]) : ($species_string = $split[0]);
my $ncbi_taxid;
if ($species_string =~ /^[A-Z]\S+ \S+$/) {
SWITCH: for ($species_string) {
# some species don't classify so custom handling
/^Darnel ryegrass/ && do { $ncbi_taxid = 34176; last; };
/^Coix lacryma/ && do { $ncbi_taxid = 4505; last; };
/^Rattus spec/ && do { $ncbi_taxid = 10116; last; };
/^Mus spec/ && do { $ncbi_taxid = 10090; last; };
/^Equus spec/ && do { $ncbi_taxid = 9796; last; };
/^Cavia sp/ && do { $ncbi_taxid = 10141; last; };
/^Marsh marigold/ && do { $ncbi_taxid = 3449; last; };
/^Phalaenopsis sp/ && do { $ncbi_taxid = 36900; last; };
/^Anthirrhinum majus/ && do { $ncbi_taxid = 4151; last; };
/^Equus spec/ && do { $ncbi_taxid = 9796; last; };
/^Lycopodium spec/ && do { $ncbi_taxid = 13840; last; };
/^Autographa californica/ && do { $ncbi_taxid = 307456; last; };
/^E26 AEV/ && do { $ncbi_taxid = 31920; last; };
/^Pseudocentrotus miliaris/ && do { $ncbi_taxid = 7677; last; }; # the genus is 7677 but this species isn't there
/^SL3-3 (?:retro)?virus/ && do { $ncbi_taxid = 53454; last; }; # 53454 is unclassified MLV-related, SL3-3 a variant of that?
/^Petunia sp/ && do { $ncbi_taxid = 4104; last; };
}
if (! $ncbi_taxid && defined $self->{_tax_db}) {
($ncbi_taxid) = $self->{_tax_db}->get_taxonids($species_string);
}
}
else {
( run in 0.930 second using v1.01-cache-2.11-cpan-364913b4093 )