Raw content of BioMart::Registry
<![CDATA[# $Id: Registry.pm,v 1.10.2.1 2008/07/30 15:35:59 syed Exp $
#
# BioMart module for BioMart::Registry
#
# You may distribute this module under the same terms as perl
# itself.
# POD documentation - main docs before the code.
=head1 NAME
BioMart::Registry
=head1 SYNOPSIS
TODO: Synopsis here.
=head1 DESCRIPTION
The registry is created by the initializer
(BioMart::Initializer::getRegistry()) and it acts as a
repository of datasets and links between datasets for
the entire BioMart system, and all client code. The registry
is also responsible for setting up all possible links between
datasets once these are populated with filters and attributes.
=head1 AUTHOR - Arek Kasprzyk, Syed Haider, Andreas Kahari, Damian Smedley
=head1 CONTACT
This module is part of the BioMart project
http://www.biomart.org
Questions can be posted to the mart-dev mailing list:
mart-dev@ebi.ac.uk
=head1 METHODS
=cut
#------------------------------------------------------------------------
package BioMart::Registry;
use strict;
use warnings;
use BioMart::Links;
use Data::Dumper;
use Storable qw(store retrieve freeze nfreeze thaw);
local $Storable::Deparse = 1;
$Storable::forgive_me = 1;
use Cwd;
use BioMart::Dataset::TableSet;
use BioMart::Dataset::GenomicSequence;
use BioMart::Dataset::GenomicMAlign;
use constant INF => 10_000; # Used in __Dijkstra(), must be
# larger than the total number
# of datasets.
# Extends BioMart::Root
use base qw(BioMart::Root);
BEGIN{
# We want to use XML::Parser if installed, as it's faster than XML::SAX
no strict 'refs';
my $fail;
unless( 'XML::'->{'Parser::'} ){ # Check if already used
eval "require XML::Parser";
if( $@ ){ $fail ++ }
else{ XML::Parser->import() }
}
unless( $fail ){ $XML::Simple::PREFERRED_PARSER = 'XML::Parser' }
}
#------------------------------------------------------------------------
=head2 new
Usage : my $registry = BioMart::Registry->new();
Description: Creates a new BioMart::Registry object.
Return type: A BioMart::Registry object.
Exceptions :
Caller :
=cut
sub _new
{
my ($self, @params) = shift;
$self->SUPER::_new(@params);
$self->attr('defaultDatasetName', undef);
$self->attr('virtualSchemas',[]);
$self->attr('mode','MEMORY'); ## default to MEMORY other option is LAZYLOAD
$self->attr('dirPath',undef);
$self->attr('settingsConfParams', undef);
}
#------------------------------------------------------------------------
=head2 getMode
Usage : $registry->getMode()
$registry->setMode('LAZYLOAD'); To set
Description: get the mode, default to MEMORY
Return type: A string
Exceptions : none
Caller : caller
=cut
sub getMode
{
my ($self) = @_;
return $self->get('mode');
}
#------------------------------------------------------------------------
=head2 setMode
Usage : $registry->getMode()
$registry->setMode('LAZYLOAD'); To set
Description: get the mode, default to MEMORY, Also sets the same mode for DATASETI objects
Return type: none
Exceptions : none
Caller : caller
=cut
sub setMode
{
my ($self, $val) = @_;
if ($val)
{
$self->set('mode', $val);
}
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
foreach my $location (@{$virtualSchema->getAllLocations}){
foreach my $dataset (@{$location->getAllDatasets}){
$dataset->setMode($val);
}
}
}
}
#------------------------------------------------------------------------
=head2 getDirPath
Usage : $registry->getDirPath()
$registry->setDirPath('/abc/def/'); To set
Description: get the path to the folder taht contains registry file, where confTrees, _portables, XML directories live
Return type: A string
Exceptions : none
Caller : caller
=cut
sub getDirPath
{
my ($self) = @_;
return $self->get('dirPath');
}
#-------------------------------------------------------------------------
=head2 setDirPath
Usage : $registry->getDirPath()
$registry->setDirPath('/abc/def/'); To set
Description: get the path to the folder taht contains registry file, where confTrees, _portables, XML directories live,
also set the same path for DATASETI objects
Return type: none
Exceptions : none
Caller : caller
=cut
sub setDirPath
{
my ($self, $val) = @_;
if ($val)
{
$self->set('dirPath', $val);
}
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
foreach my $location (@{$virtualSchema->getAllLocations}){
foreach my $dataset (@{$location->getAllDatasets}){
$dataset->setDirPath($val);
}
}
}
}
#------------------------------------------------------------------------
=head2 cleanXMLs
Usage : $registry->cleanXMLs()
Description: deletes all existing XML files from disk, for action => clean, during Initializer->new
Return type: none
Exceptions : none
Caller : caller
=cut
sub cleanXMLs
{
my ($self) = @_;
my $cleanFile = $self->getDirPath();
my $v_schemas = $self->getAllVirtualSchemas();
foreach my $schema (@$v_schemas)
{
my $databases = $self->getAllDatabaseNames($schema->name()); ## databases are locations as per old API calls
foreach my $database_name (@$databases)
{
my $datasets = $self->getAllDataSetsByDatabaseName($schema->name(), $database_name);
foreach my $dataset_name(@$datasets)
{
my $dataset = $self->getDatasetByName($schema->name(), $dataset_name);
my $interfacesList = $dataset->interfaces(); # should return a comma separated list of interfaces
my @interfacesArray = split /,/,$interfacesList;
foreach my $interface(@interfacesArray)
{
my $temp;
$temp = $cleanFile;
$temp .= $schema->name()."/XML/".$dataset->locationName().".".$dataset->name().".".$interface;
#$temp .= $schema->name()."/XML/".$dataset->getParam('configurator')->get('location')->database().".".$dataset->name().".".$interface;
if (-e $temp) { unlink $temp; }
}
}
}
}
}
#------------------------------------------------------------------------
=head2 getAllVirtualSchemaNames
Usage : foreach my $vSchemas (
@{ $registry->getAllVirtualSchemas} ) {...}
Description: get an arrayref of all virtualSchemas within the registry
This will always return at least 'defaultSchema'.
Return type: An arrayref of strings
Exceptions : none
Caller : caller
=cut
sub getAllVirtualSchemaNames {
my ($self,$visible_only) = @_;
my @names;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
if ($visible_only){
push @names, $virtualSchema->name if ($virtualSchema->visible == 1);
}
else{
push @names, $virtualSchema->name;
}
}
@names = sort(@names);
return \@names;
}
#------------------------------------------------------------------------
=head2 getDefaultVirtualSchema
Usage : my $default = $registry->getDefaultVirtualSchema;
Description: gets the default virtualSchema if any as defined in the
registry XML
Return type: String
Exceptions : none
Caller : caller
=cut
sub getDefaultVirtualSchema {
my $self = shift;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
return $virtualSchema->name if ($virtualSchema->default == 1);
}
}
=head2 getAllDatasetNames
Usage : my @dataSetNames =
$registry->getAllDatasetsNames($virtualSchema);
my @visibleDatasetNames =
$registry->getAllDatasetsNames($virtualSchema,
$visible_only);
Description: Gets all names of all datasets within a virtualSchema, or
all visible datasets within a virtualSchema.
If $visible_only is defined, only visible datasets are
returned.
Return type: An array of strings in list context, or a
reference to such an array in scalar context.
Exceptions : none
Caller : caller
=cut
sub getAllDatasetNames {
my ($self, $virtualSchemaName, $visible_only) = @_;
# sort all the dataset Names per Mart based on their displayNames if visible_only = 1
my @dataSetNames;
my %sortedNames;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
next unless ($virtualSchema->name eq $virtualSchemaName);
foreach my $location (@{$virtualSchema->getAllLocations}){
%sortedNames=();
foreach my $dataset (@{$location->getAllDatasets}){
if ($visible_only){
$sortedNames{$dataset->displayName} = $dataset->name if ($dataset->visible == 1);
}
else{
# directly pushing as invisible datasets often has no display Name
push @dataSetNames,$dataset->name;
}
}
if ($visible_only){
foreach my $displayName ( sort keys %sortedNames ) {
push @dataSetNames, $sortedNames{$displayName};
}
}
}
}
return (wantarray() ? @dataSetNames : \@dataSetNames);
}
#------------------------------------------------------------------------
=head2 getAllDisplayNames
Usage : my @dataSetNames =
$registry->getAllDisplayNames($virtualSchema);
my @dataSetNames =
$registry->getAllDisplayNames($virtualSchema,
$visible_only);
Description: Gets all display names of all datasets within
a virtualSchema. If
$visible_only is defined, displayNames are
returned only for visible datasets.
Return type: An array of strings in list context, or a
reference to such an array in scalar context.
Exceptions : none
Caller : caller
=cut
sub getAllDisplayNames {
my ($self, $virtualSchemaName, $visible_only) = @_;
my @dataSetNames;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
next unless ($virtualSchema->name eq $virtualSchemaName);
foreach my $location (@{$virtualSchema->getAllLocations}){
if ($visible_only){
push @dataSetNames, @{$location->getAllVisibleDatasetDisplayNames};
}
else {
foreach my $dataset (@{$location->getAllDatasets}){
push @dataSetNames,$dataset->displayName;
}
}
}
}
return (wantarray() ? @dataSetNames : \@dataSetNames);
}
#------------------------------------------------------------------------
=head2 getLinksBetween
Usage : my @link = $registry->getLinkBetween($virtualSchema,
$exportingDatasetName,
$importingDatasetName);
Description: Returns the BioMart::Links object that links
the given exportingDataset to the given
importingDataset within the given virtualSchema, if one exists.
Return type: BioMart::Dataset::Links object, or undef it no link exists
between the two datasets within the given virtualSchema.
Exceptions : exporting or importing DatasetName are not known in the
configuration
Caller :
=cut
sub getLinkBetween {
my ($self,$virtualSchema,$exportingDatasetName,$importingDatasetName) = @_;
my $link;
my $exportingDatasetEntry = $self->__fetchDatasetEntry($virtualSchema,
$exportingDatasetName);
my $importingDatasetEntry = $self->__fetchDatasetEntry($virtualSchema,
$importingDatasetName);
LINK: foreach my $li (@{ $exportingDatasetEntry->{'links'} }) {
my $targetDatasetName = $li->targetDataset();
if ($importingDatasetName && $importingDatasetName eq $targetDatasetName) {
$link = $li;
last LINK;
}
}
return $link;
}
#------------------------------------------------------------------------
=head2 getDatasetByName
Usage : my $dataSet =
$registry->getDatasetByName($virtualSchema, $DatasetName);
Description: Gets a named dataset from the registry within the given
virtualSchema.
Return type: A BioMart::DatasetI object, or undef
Exceptions : none
Caller : caller
=cut
sub getDatasetByName {
my ($self, $virtualSchema, $dataSetName ,$martUser) = @_;
my $dataSetEntry = $self->__fetchDatasetEntry($virtualSchema, $dataSetName,
$martUser);
return $dataSetEntry;
}
#------------------------------------------------------------------------
=head2 getAttribute
Usage : my $att = $registry->getAttribute($dataset, $attribute,
$schema, $interface);
Description: Retrieve attribute object given its internal name and dataset
Return type: A BioMart::Configuration::Attribute object, or undef
Exceptions : none
Caller : caller
=cut
sub getAttribute {
my ($self, $dataset_name, $attributename, $schema_name, $interface) = @_;
$schema_name ||= 'default';
$interface ||= 'default';
# Retrieve config-info for this dataset, return undef if can't be found
my $dataset_obj = $self->getDatasetByName($schema_name,$dataset_name);
if(!defined($dataset_obj)) {
my $errmsg =
"Dataset $schema_name\.$dataset_name not found in registry";
BioMart::Exception::Configuration->throw($errmsg);
}
my $dataset_conf = $dataset_obj->getConfigurationTree($interface);
BioMart::Exception::Configuration->throw("No config-tree found for dataset $schema_name\.
$dataset_name") if (!$dataset_conf);
# Query config-tree for attribute, return undef if we can't find it
my $attribute = $dataset_conf->getAttributeByName($attributename);
if(!defined($attribute)) {
my $errmsg = "Attribute '$attributename' not found in dataset $schema_name\.$dataset_name";
BioMart::Exception::Configuration->throw($errmsg);
}
# returning softwareVersion each time as thats the only quiet method of doing so
# no additional memory headache as conftree is already requested for a particular att/filter
my $softwareVersion = $dataset_conf->software_version();
if(wantarray())
{
return ($attribute, $softwareVersion);
}
else
{
return $attribute;
}
#return $attribute;
}
=head2 getFilter
Usage : my $filter = $registry->getFilter($dataset, $filtname,
$schema, $interface);
Description: Retrieve filter object given its internal name and dataset
Return type: A BioMart::Configuration::BaseFilter implementing object,
or undef
Exceptions : none
Caller : caller
=cut
sub getFilter {
my ($self, $dataset_name, $filtername, $schema_name, $interface) = @_;
$schema_name ||= 'default';
$interface ||= 'default';
# Retrieve config-info for this dataset, return undef if can't be found
my $dataset_obj = $self->getDatasetByName($schema_name,$dataset_name);
if(!defined($dataset_obj)) {
my $errmsg =
"Dataset $schema_name\.$dataset_name not found in registry";
BioMart::Exception::Configuration->throw($errmsg);
}
my $dataset_conf = $dataset_obj->getConfigurationTree($interface);
BioMart::Exception::Configuration->throw("No config-tree found for dataset $schema_name\.
$dataset_name") if (!$dataset_conf);
# Query config-tree for attribute, return undef if we can't find it
my $filter = $dataset_conf->getFilterByName($filtername);
if(!defined($filter)) {
my $errmsg = "Filter '$filtername' not found in dataset $schema_name\.$dataset_name";
BioMart::Exception::Configuration->throw($errmsg);
}
# returning softwareVersion each time as thats the only quiet method of doing so
# no additional memory headache as conftree is already requested for a particular att/filter
my $softwareVersion = $dataset_conf->software_version();
if(wantarray())
{
return ($filter, $softwareVersion);
}
else
{
return $filter;
}
#return $filter;
}
=head2 getConfigTreeForDataset
Usage : my $confTree = $registry->getConfigTreeForDataset($dataset,
$schema,
$interface);
Description: Retrieve ConfigTree object given its dataset and interface
Return type: A BioMart::Configuration::ConfigurationTree object, or undef
Exceptions : none
Caller : caller
=cut
sub getConfigTreeForDataset {
my ($self, $dataset_name, $schema_name,$interface) = @_;
$schema_name ||= 'default';
$interface ||= 'default';
my $dataset = $self->getDatasetByName($schema_name,$dataset_name);
if(!defined($dataset)) {
my $errmsg = "Can't find dataset $schema_name\.$dataset_name in registry";
BioMart::Exception::Configuration->throw($errmsg);
}
return $dataset->getConfigurationTree($interface);
}
#------------------------------------------------------------------------
=head2 getDefaultDataset
Usage : my $dataset = $registry->getDefaultDataset;
Description: Retrieve the default Schema's default Database' default Dataset
Return type: Dataset object
Exceptions : none
Caller : caller
=cut
sub getDefaultDataset {
my ($self) = @_;
my $default_schema = $self->getDefaultVirtualSchema() || 'default';
my $default_database = $self->getDefaultDatabase($default_schema);
$default_database ||= $self->getAllDatabaseNames($default_schema, 1)->[0];
my $dataset_names = $self->getAllDataSetsByDatabaseName($default_schema, $default_database, 1);
foreach my $dataset_name(@$dataset_names) {
my $dataset = $self->getDatasetByName($default_schema, $dataset_name);
my $is_default = $dataset->getConfigurationTree('default')->defaultDataset();
if($is_default && $is_default eq 'true') {
return $dataset;
}
}
# Return first dset on list if no dsets are flagged as default
return $self->getDatasetByName($default_schema, $dataset_names->[0]);
}
#------------------------------------------------------------------------
=head2 getAllDatabaseNames
Usage : my $databases =
$registry->getAllDatabaseNames($virtualSchema);
my $visible_databases =
$registry->getAllDatabaseNames($virtualSchema,
$visible_only);
Description: Gets a ref to an array of database names from a particular
virtualSchema in the registry. ('defaultSchema' is the
virtualSchema assigned to any database not explicitly
assigned to a virtualSchema).
If $visible_only is defined, returns names only for
visible databases.
Return type: A ref to an array of Strings
Exceptions : none
Caller : caller
=cut
sub getAllDatabaseNames {
my ($self, $virtualSchemaName, $visible_only) = @_;
my @dataBaseNames;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
next unless ($virtualSchema->name eq $virtualSchemaName);
foreach my $location (@{$virtualSchema->getAllLocations}){
if ($visible_only){
push @dataBaseNames,$location->displayName
if ($location->visible == 1);
}
else{
push @dataBaseNames,$location->displayName;
}
}
}
return (wantarray() ? @dataBaseNames : \@dataBaseNames);
}
=head2 getDefaultDatabase
Usage : my $databases =
$registry->getDefaultDatabase($virtualSchema);
Description: Gets the default database name for a particular
virtualScema from the registry.
Return type: String
Exceptions : none
Caller : caller
=cut
sub getDefaultDatabase {
my $self = shift;
my $virtualSchemaName = shift;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
next unless ($virtualSchema->name eq $virtualSchemaName);
foreach my $location (@{$virtualSchema->getAllLocations}){
return $location->displayName if ($location->default && $location->default == 1);
}
# incase no default location, use the first one as default location
foreach my $location (@{$virtualSchema->getAllLocations}) {
return $location->displayName;
}
}
return '';
}
#------------------------------------------------------------------------
=head2 getAllDataSetsByDatabaseName
Usage : my $dataSets =
$registry->getAllDatasetsByDatabaseName($virtualSchema,
$DatabaseName);
my $visible_dataSets =
$registry->getAllDatasetsByDatabaseName($virtualSchema,
$DatabaseName,
$visible_only);
Description: Gets a ref to an array of dataset names from the registry
for a particular database, in a particular virtualSchema.
If $visible_only is defined returns names only for visible
datasets.
Return type: A ref to an array of Strings.
Exceptions : none
Caller : caller
=cut
sub getAllDataSetsByDatabaseName {
my ($self, $virtualSchemaName, $databaseName, $visible_only) = @_;
# sort all the dataset Names in a Mart based on their displayNames if visible_only is true
my @dataSetNames;
my %sortedNames;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
next unless ($virtualSchema->name eq $virtualSchemaName);
foreach my $location (@{$virtualSchema->getAllLocations}){
next unless ($location->displayName eq $databaseName);
%sortedNames=();
foreach my $dataset (@{$location->getAllDatasets}){
if ($visible_only){
$sortedNames{$dataset->displayName} = $dataset->name if ($dataset->visible == 1);
}
else{
# directly pushing as invisible datasets often has no display Name
push @dataSetNames,$dataset->name;
}
}
if ($visible_only){
foreach my $displayName ( sort keys %sortedNames ) {
push @dataSetNames, $sortedNames{$displayName};
}
}
}
}
return (wantarray() ? @dataSetNames : \@dataSetNames);
}
#------------------------------------------------------------------------
=head2 _createAllLinks
Usage : $registry->_createAllLinks();
Description: Investigates all datasets in the registry and
creates all possible links between them. Any
already existing link will be removed.
Also precalculates dataset clusters and
shortest paths between datasets.
Return type:
Exceptions :
Caller :
=cut
sub _createAllLinks {
my ($self) = @_;
warn("Setting possible links between datasets\n");
# Count them
my $totalDSCount = 0;
my $currentDSCount = 0;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
foreach my $location (@{$virtualSchema->getAllLocations}){
$totalDSCount += scalar @{$location->getAllDatasets};
}
}
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
foreach my $location (@{$virtualSchema->getAllLocations}){
foreach my $dataset (@{$location->getAllDatasets}){
delete $dataset->{'links'};
delete $dataset->{'cluster'};
delete $dataset->{'pathHash'};
$currentDSCount++;
printf STDERR "\r....(scanning) %d%%",(100*($currentDSCount/$totalDSCount));
# add any missing placeholder datasets before create links
my $dataSetName = $dataset->name;
my @interfaces = split(/\,/,$dataset->interfaces);
foreach my $interface(@interfaces){
next if (!${$dataset->get('configurationTrees')}
{$interface});# only do for cached configTrees
my $configTree =
#$dataset->getConfigurationTree($interface);
$dataset->getConfigurationTree($interface,'CREATE_ALL_LINKS');
my $configurator = $dataset->getConfigurator();
# incase placeholder datasets not added yet
$configurator->
addPlaceHolderDatasets($configTree,
$virtualSchema->name,
);
}
}
#---------------------reset the configurations trees to 'DISK'
if ($self->getMode() eq 'LAZYLOAD') ### this call is made by Web.pm, when disk flag is set
{
foreach my $dataset (@{$location->getAllDatasets}) {
my $dataSetName = $dataset->name;
my @interfaces = split(/\,/,$dataset->interfaces);
foreach my $interface(@interfaces){
$dataset->setConfigurationTree($interface, 'LAZYLOAD');
}
}
}
#---------------------
}
}
print STDERR "\n";
$currentDSCount = 0;
my $squaredDSCount = $totalDSCount*$totalDSCount;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
foreach my $location (@{$virtualSchema->getAllLocations}){
foreach my $datasetA (@{$location->getAllDatasets}){
foreach my $locationB (@{$virtualSchema->getAllLocations}){
foreach my $datasetB (@{$locationB->getAllDatasets}){
$currentDSCount++;
printf STDERR "\r....(linking) %d%%",(100*($currentDSCount/$squaredDSCount));
next if ($datasetA->name eq $datasetB->name);
$self->__linkDatasets($virtualSchema->name,
$datasetA->name,
$datasetB->name);
}
}
}
}
}
print STDERR "\n";
$currentDSCount = 0;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
foreach my $location (@{$virtualSchema->getAllLocations}){
foreach my $dataset (@{$location->getAllDatasets}){
$currentDSCount++;
printf STDERR "\r....(sorting) %d%%",(100*($currentDSCount/$totalDSCount));
$dataset->{'pathHash'} = $self->__Dijkstra(
$virtualSchema->name, $dataset->name);
}
}
}
print STDERR "\n";
$self->__cluster($totalDSCount);
# add placeholder filts/atts now all datasets initialised as can
# then recover real filts/atts from cached configurationTrees and
# also check the linking is valid
$currentDSCount = 0;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
my $virtualSchemaName = $virtualSchema->name;
foreach my $location (@{$virtualSchema->getAllLocations}){
foreach my $dataset (@{$location->getAllDatasets}){
$currentDSCount++;
printf STDERR "\r....(resolving) %d%%",(100*($currentDSCount/$totalDSCount));
my $dataSetName = $dataset->name;
my @interfaces = split(/\,/,$dataset->interfaces);
foreach my $interface(@interfaces){
next if (!${$dataset->get('configurationTrees')}
{$interface});# only do for cached configTrees
my $configTree =
#$dataset->getConfigurationTree($interface);
$dataset->getConfigurationTree($interface,'CREATE_ALL_LINKS');
my $configurator = $dataset->getConfigurator();
$configurator->addPlaceHolders($configTree,
$virtualSchemaName,
$dataSetName,
$interface);
# cause dependsOn stuff to be distributed and populated
$configurator->resolveDependsOn($configTree,
$virtualSchemaName,
$dataSetName,
$interface);
}
}
#---------------------reset the configurations trees to 'DISK'
if ($self->getMode() eq 'LAZYLOAD') ### this call is made by Web.pm, when disk flag is set
{
foreach my $dataset (@{$location->getAllDatasets}) {
my $dataSetName = $dataset->name;
my @interfaces = split(/\,/,$dataset->interfaces);
foreach my $interface(@interfaces){
$dataset->setConfigurationTree($interface, 'LAZYLOAD');
}
}
}
#---------------------
}
}
print STDERR "\n";
}
#------------------------------------------------------------------------
=head2 getPath
Usage : my @dataSetNames = $registry->getPath($virtualSchema,
$sourceDataset,
$targetDataset);
Description: Returns the shortest path from $sourceDataset
to $targetDataset withing the given virtualSchema.
Return type: Array of scalars (strings, dataset names), or
undef if a path could not be found.
Exceptions :
Caller :
=cut
sub getPath {
my ($self, $virtualSchema, $sourceDataset, $targetDataset) = @_;
my $sourceDatasetEntry = $self->__fetchDatasetEntry($virtualSchema,
$sourceDataset);
my $targetDatasetEntry = $self->__fetchDatasetEntry($virtualSchema,
$targetDataset);
my $pathHash = $sourceDatasetEntry->{'pathHash'};
my @path;
my $currentDataset = $targetDataset;
while (defined $currentDataset) {
unshift @path, $currentDataset;
$currentDataset = $pathHash->{$currentDataset};
}
if (!$path[0] || ($path[0] ne $sourceDataset) ||
!$path[-1] || ($path[-1] ne $targetDataset)) {
return undef;
}
return (wantarray() ? @path : \@path);
}
#------------------------------------------------------------------------
=head2 configure
Usage : $registry->configure();
$registry->configure([['hsapiens_gene_ensembl'],
['mmusculus_gene_ensembl']);
$registry->configure([['hsapiens_gene_ensembl',
'default',
'default'],
['mmusculus_gene_ensembl',
'default',
'default']]);
Description: The method caches configurationTrees in the Dataset
objects for the specified datasets (or all if none are
specified) and builds all possible links between subsystem
by calling Registry::createAllLinks()
Return type:
Exceptions :
Caller :
=cut
sub configure {
my ($self,$datasets) = @_;
if (!$datasets)
{
$self->_getConfigurationTrees;
}
else
{
foreach my $dataset(@{$datasets}){
$self->getConfigTreeForDataset(${$dataset}[0],
${$dataset}[1] || 'default',
${$dataset}[2] || 'default');
}
$self->_createAllLinks();
}
#----------------------------------------------------------------
if ($self->getMode() eq 'LAZYLOAD')
{
my $v_schemas = $self->getAllVirtualSchemas();
foreach my $schema (@$v_schemas)
{
my $databases = $self->getAllDatabaseNames($schema->name()); ## databases are locations as per old API calls
foreach my $database_name (@$databases)
{
my $datasets = $self->getAllDataSetsByDatabaseName($schema->name(), $database_name);
foreach my $dataset_name(@$datasets)
{
my $dataset = $self->getDatasetByName($schema->name(), $dataset_name);
my $interfacesList = $dataset->interfaces(); # should return a comma separated list of interfaces
my @interfacesArray = split /,/,$interfacesList;
foreach my $interface(@interfacesArray)
{
$dataset->setExportables($interface, 'LAZYLOAD');
$dataset->setImportables($interface, 'LAZYLOAD');
}
}
}
}
}
#----------------------------------------------------------------
}
#------------------------------------------------------------------------
=head2 _getConfigurationTrees
Usage : $registry->_getConfigurationTrees();
Description: The method caches all configurationTrees in the Dataset
pbjects and builds all possible links between subsystem by
calling Registry::createAllLinks()
Return type:
Exceptions :
Caller :
=cut
sub _getConfigurationTrees {
my $self = shift;
my $dsCounter;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
foreach my $location (@{$virtualSchema->getAllLocations}){
$dsCounter=0;
foreach my $dataset (@{$location->getAllDatasets}){
my @interfaces = split(/\,/,$dataset->interfaces);
foreach my $interface(@interfaces){
$dsCounter++;
$dataset->getConfigurationTree($interface,$dsCounter);
}
}
}
}
$self->_createAllLinks();
}
sub toXML {
my ($self, $registryXML) = @_;
if ($registryXML) {
$self->{'registryXML'}=$registryXML;
}
return $self->{'registryXML'};
}
=head2 interface_type
Usage : $registry->interface_type
Description: get/set the interface_type
Returntype : string interface_type
Exceptions : none
Caller : caller
=cut
sub interface_type {
my ($self, $value) = @_;
if ($value) {
$self->{'interface_type'}= $value;
}
return $self->{'interface_type'};
}
=head2 addVirtualSchema
Usage : usage
Description: Description
Returntype :
Exceptions : none
Caller : caller
=cut
sub addVirtualSchema {
my ($self, $virtualSchema) = @_;
my $virtualSchemas = $self->get('virtualSchemas');
push @{$virtualSchemas}, $virtualSchema;
}
#------------------------------------------------------------------------
=head2 getVirtualSchemaByName
Usage :
Description: Fetches a virtualSchema entry.
Caller :
=cut
sub getVirtualSchemaByName {
my ($self, $virtualSchemaName) = @_;
my $retSchema;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
return $virtualSchema if ($virtualSchema->name eq $virtualSchemaName);
}
return $retSchema;
}
=head2 getAllVirtualSchemas
Usage : usage
Description: Description
Returntype :
Exceptions : none
Caller : caller
=cut
sub getAllVirtualSchemas {
my $self = shift;
return $self->get('virtualSchemas');
}
=head2 removeVirtualSchema
Usage : usage
Description: Description
Returntype :
Exceptions : none
Caller : caller
=cut
sub removeVirtualSchema {
my ($self,$virtualSchema) = @_;
my $virtualSchemas = $self->getAllVirtualSchemas;
my $i = 0;
foreach my $vs (@$virtualSchemas){
if ($vs->name eq $virtualSchema->name){
splice @$virtualSchemas,$i,1;
last;
}
$i++;
}
}
sub getDatasetsExportingTo {
my ($self,$virtualSchema,$to_dataset) = @_;
my @exporting_datasets;
my $dataset_names = $self->getAllDatasetNames($virtualSchema,1);
foreach my $fr_dataset (@{$dataset_names}){
next if ($fr_dataset eq $to_dataset);
push @exporting_datasets, $fr_dataset if ($self->getLinkBetween(
$virtualSchema,$fr_dataset,$to_dataset));
}
return @exporting_datasets;
}
# only called by linked dataset panel to reverse the order of DBs in linking Menu
sub getDatasetsExportingTo_reverseDBs
{
my ($self,$virtualSchema,$to_dataset) = @_;
my @exporting_datasets;
my $dataset_names = $self->getAllDatasetNames($virtualSchema,1);
foreach my $fr_dataset (@{$dataset_names}) {
next if ($fr_dataset eq $to_dataset);
push @exporting_datasets, $fr_dataset if ($self->getLinkBetween(
$virtualSchema,$fr_dataset,$to_dataset));
}
# get LocationName of this dataset
my $to_datasetLocationName = $self->getDatasetByName($virtualSchema, $to_dataset)->locationDisplayName();
# maintain the same order of datasets by rearrange them as
# the mart of first DS selection should go at the bottom of second dataset list
my @allMarts;
my %martsHash;
my %martsHashDefaultDS;
my @revisedOrder;
foreach my $virtualSchemaObj (@{$self->getAllVirtualSchemas}) {
next unless ($virtualSchemaObj->name eq $virtualSchema);
foreach my $location (@{$virtualSchemaObj->getAllLocations(1)}) {
next if ($location->displayName() eq $to_datasetLocationName);
push @allMarts, $location->displayName();
}
push @allMarts, $to_datasetLocationName;
}
# assigning datasets to their marts, except default datasets, they need to be sorted
foreach my $dsName (@exporting_datasets) {
my $dsObj = $self->getDatasetByName($virtualSchema, $dsName);
my $dbName = $dsObj->locationDisplayName();
if ($dsObj->getConfigurationTree('default')->defaultDataset()) {
#push @{$martsHashDefaultDS{$dbName}}, $dsName;
push @{$martsHash{$dbName}}, $dsName;
}
else {
push @{$martsHash{$dbName}}, $dsName;
}
}
# sorting default datasets and adding them to their respective mart keys
foreach my $dbName (keys %martsHashDefaultDS) {
if ($martsHashDefaultDS{$dbName}) {
foreach my $dsName (reverse sort(@{$martsHashDefaultDS{$dbName}})) {
unshift @{$martsHash{$dbName}}, $dsName;
}
}
}
# determine if splitter-line is required or not.
# this is only required when linking within the mart and across
# marts exists
my $splitter_line = 0;
$splitter_line = 1 if($martsHash{$to_datasetLocationName} && scalar keys %martsHash > 1);
foreach my $martName (@allMarts) {
push @revisedOrder, "splitter-line" if($splitter_line && $martName eq $to_datasetLocationName);
foreach (@{$martsHash{$martName}}) {
push @revisedOrder, $_;
}
}
return @revisedOrder;
}
#------------------------------------------------------------------------
# internal
=head2 __linkDatasets (internal)
Usage : $self->linkDatasets(
$virtualSchema,
$sourceDatasetName,
$targetDatasetName);
Description: Links two datasets in the same virtualSchema, if
possible.
Caller : BioMart::Registry
=cut
sub __linkDatasets {
my ($self, $virtualSchema, $sourceDatasetName, $targetDatasetName) = @_;
my $sourceDataset =
$self->__fetchDatasetEntry($virtualSchema, $sourceDatasetName);
return unless ($sourceDataset);
my $targetDataset =
$self->__fetchDatasetEntry($virtualSchema, $targetDatasetName);
return unless ($targetDataset);
my $link = BioMart::Links->new($self);
$link->sourceDataset($sourceDatasetName);
$link->targetDataset($targetDatasetName);
my $haveLink = 0;
my @sourceInterfaces = split(/\,/,$sourceDataset->interfaces);
my @targetInterfaces = split(/\,/,$targetDataset->interfaces);
foreach my $importable (@{ $targetDataset->getImportables() }) {
foreach my $exportable (@{ $sourceDataset->getExportables() }) {
if ($importable->linkName eq $exportable->linkName) {
# do not link on DAS or GFF type exp/imp pairs
next if ($importable->type() ne 'link' || $exportable->type ne 'link');
# versions must be compatible as well if exists for both
next if (($importable->linkVersion && $exportable->linkVersion)
&& ($importable->linkVersion ne $exportable->linkVersion));
$link->addLink($virtualSchema, $importable->linkName);
$haveLink = 1;
}
}
}
if ($haveLink) {
push @{ $sourceDataset->{'links'} }, $link;
push @{ $targetDataset->{'links'} }, $link;
}
}
#------------------------------------------------------------------------
=head2 __fetchDatasetEntry (internal)
Usage : my $dataSetEntry =
$self->__fetchDatasetEntry($virtualSchema, $DatasetName);
Description: Fetches a dataset entry. Throws an exception if the
dataset does not exist.
Caller : BioMart::Registry
=cut
sub __fetchDatasetEntry {
my ($self, $virtualSchemaName, $dataSetName, $martUser) = @_;
return unless ($virtualSchemaName && $dataSetName);
my $retDataset;
OUTER:foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
next unless ($virtualSchema->name eq $virtualSchemaName);
foreach my $location (@{$virtualSchema->getAllLocations}){
next if ($martUser && $location->martUser && $location->martUser
ne $martUser);
my $dataSetEntry = $location->getDatasetByName($dataSetName);
if (defined $dataSetEntry) {
return $dataSetEntry;
}
}
}
return $retDataset;
}
#------------------------------------------------------------------------
=head2 __Dijkstra (internal)
Usage : my $pathHash = $registry->__Dijkstra($virtualSchema,
$sourceDataset);
Description: Computes all shortest paths from $sourceDataset within
a particular virtualSchema.
See "http://en.wikipedia.org/wiki/Dijkstra's_algorithm"
Caller : BioMart::Registry::createAllLinks()
=cut
sub __Dijkstra {
my ($self, $virtualSchema, $dataSetName) = @_;
my @vertices = $self->getAllDatasetNames($virtualSchema);
my %dist;
my %path;
foreach my $vertex (@vertices) {
$dist{$vertex} = INF;
}
$dist{$dataSetName} = 0;
while (scalar @vertices > 0) {
my $min_vert_idx = 0;
my $min_vert = $vertices[$min_vert_idx];
my $min_dist = $dist{$min_vert};
for (my $vertex_idx = 1;
$vertex_idx < scalar @vertices;
++$vertex_idx) {
my $vertex = $vertices[$vertex_idx];
if ($dist{$vertex} < $min_dist) {
$min_vert_idx = $vertex_idx;
$min_vert = $vertex;
$min_dist = $dist{$vertex};
}
}
if ($min_dist == INF) {
# Exhausted a disjoint set of datasets.
last;
}
splice @vertices, $min_vert_idx, 1;
my @edges = $self->__getLinksFrom($virtualSchema, $min_vert);
foreach my $edge (@edges) {
my $vertex = $edge->targetDataset();
if ($dist{$vertex} > $dist{$min_vert} + 1) {
$dist{$vertex} = $dist{$min_vert} + 1;
$path{$vertex} = $min_vert;
}
}
}
return \%path;
}
#------------------------------------------------------------------------
=head2 __cluster (internal)
Usage : $registry->__cluster();
Description: Finds all of the connected sets of the
datasets within each virtualSchema.
Assigns a cluster ID to the members
of each set.
Caller : BioMart::Registry::createAllLinks()
=cut
sub __cluster {
my $self = shift;
my $totalDSCount = shift;
my $cluster = 0;
my $currentDSCount = 0;
foreach my $virtualSchema (@{$self->getAllVirtualSchemas}){
my $vSchema = $virtualSchema->name;
foreach my $location (@{$virtualSchema->getAllLocations}){
foreach my $seedDatasetEntry (@{$location->getAllDatasets}){
$currentDSCount++;
print STDERR "\r....(clustering) ".$currentDSCount."/".$totalDSCount." ";
my $seedDataset = $seedDatasetEntry->name;
next if (defined $seedDatasetEntry->{'cluster'});
my @vertices = ( $seedDataset );
++$cluster;
while (scalar @vertices > 0) {
my $dataSet = shift @vertices;
print STDERR "\r....(clustering) ".$currentDSCount."/".$totalDSCount." - ".(scalar @vertices)." remain ";
foreach my $otherDataset (
$self->__getDatasetsImportingFrom($vSchema, $dataSet),
$self->__getDatasetsExportingTo($vSchema, $dataSet)) {
my $otherDatasetEntry = $self->getDatasetByName
($vSchema,$otherDataset);
next if ($otherDatasetEntry->{'cluster'});
push @vertices, $otherDataset;
}
my $thisEntry = $self->getDatasetByName($vSchema,$dataSet);
$thisEntry->{'cluster'} = $cluster;
}
}
}
}
print STDERR "\n";
}
#--------------------------------------------------------------------
=head2 __getDatasetsImportingFrom (internal)
Usage : my @dataSetNames =
$registry->__getDatasetsImportingFrom($virtualSchema,
$DatasetName);
Description: Returns the names of the datasets that import
from the named dataset within the given virtualSchema.
Return type: An array of strings in list context, or a
reference to such an array in scalar context.
Exceptions :
Caller :
=cut
sub __getDatasetsImportingFrom {
my ($self, $virtualSchema, $dataSetName) = @_;
my $dataSetEntry = $self->__fetchDatasetEntry($virtualSchema,
$dataSetName);
my @dataSetNames;
foreach my $link (@{ $dataSetEntry->{'links'} }) {
my $targetDatasetName = $link->targetDataset();
my $targetDatasetEntry =
$self->__fetchDatasetEntry($virtualSchema, $targetDatasetName);
my $sourceDatasetName = $link->sourceDataset();
my $sourceDatasetEntry =
$self->__fetchDatasetEntry($virtualSchema, $sourceDatasetName);
if ($sourceDatasetName eq $dataSetName) {
push @dataSetNames, $targetDatasetName;
}
}
return (wantarray() ? @dataSetNames : \@dataSetNames);
}
#------------------------------------------------------------------------
=head2 __getDatasetsExportingTo (internal)
Usage : my @dataSetNames =
$registry->__getDatasetsExportingTo($virtualSchema,
$DatasetName);
Description: Returns the names of the datasets that export
to the named dataset within the given virtualSchema.
Return type: An array of strings in list context, or a
reference to such an array in scalar context.
Exceptions :
Caller :
=cut
sub __getDatasetsExportingTo {
my ($self, $virtualSchema, $dataSetName) = @_;
my $dataSetEntry = $self->__fetchDatasetEntry($virtualSchema,
$dataSetName);
my @dataSetNames;
foreach my $link (@{ $dataSetEntry->{'links'} }) {
my $targetDatasetName = $link->targetDataset();
my $targetDatasetEntry =
$self->__fetchDatasetEntry($virtualSchema, $targetDatasetName);
my $sourceDatasetName = $link->sourceDataset();
my $sourceDatasetEntry =
$self->__fetchDatasetEntry($virtualSchema, $sourceDatasetName);
if ($targetDatasetName eq $dataSetName) {
push @dataSetNames, $sourceDatasetName;
}
}
return (wantarray() ? @dataSetNames : \@dataSetNames);
}
#------------------------------------------------------------------------
=head2 __getLinksFrom (internal)
Usage : my @links =
$registry->__getLinksFrom($virtualSchema, $DatasetName);
Description: Returns all BioMart::Links objects defining
a directional link from the named Dataset to
a Dataset able to import from the named Dataset
within the given virtualSchema.
Return type: An array of BioMart::Links objects in list
context, or a reference to such an array in
scalar context.
Exceptions :
Caller :
=cut
sub __getLinksFrom {
my ($self, $virtualSchema, $dataSetName) = @_;
my $dataSetEntry = $self->__fetchDatasetEntry($virtualSchema,
$dataSetName);
my @links;
foreach my $link (@{ $dataSetEntry->{'links'} }) {
my $targetDatasetName = $link->targetDataset();
my $targetDatasetEntry =
$self->__fetchDatasetEntry($virtualSchema, $targetDatasetName);
my $sourceDatasetName = $link->sourceDataset();
my $sourceDatasetEntry =
$self->__fetchDatasetEntry($virtualSchema, $sourceDatasetName);
if ($sourceDatasetName eq $dataSetName) {
push @links, $link;
}
}
return (wantarray() ? @links : \@links);
}
=head2 settingsParams
Usage : $registry->settingsParams($settingsHash);
Description: adds all params in hash passed to registry
These params come from settings.conf
only used by Web.pm and martview
Return type:
Exceptions :
Caller : Initializer's getRegistry()
=cut
sub settingsParams
{
my ($self, $hash) = @_;
if($hash)
{
$self->set('settingsConfParams', $hash);
}
return $self->get('settingsConfParams');
}
1;
# vim: et
]]>