File Coverage

blib/lib/Bio/ConnectDots/ConnectDots.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Bio::ConnectDots::ConnectDots;

our $VERSION = '1.0.2';

use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS %DEFAULTS);
use strict;
use Bio::ConnectDots::DB;
use Bio::ConnectDots::DB::ConnectDots;
use Bio::ConnectDots::DotSet;
use Bio::ConnectDots::ConnectorSet;
use Bio::ConnectDots::ConnectorTable;
use Bio::ConnectDots::Util;
@ISA = qw(Class::AutoClass);

@AUTO_ATTRIBUTES=qw(db
		    label2dotset id2dotset
		    name2cs id2cs
		    name2dt id2dt
		    name2ct id2ct
		    label2labelid
		   );
@OTHER_ATTRIBUTES=qw(connectorsets dotsets connectortables dottables);
%SYNONYMS=();
%DEFAULTS=();
Class::AutoClass::declare(__PACKAGE__);
my $VERSION=1.0;

sub _init_self {
  my($self,$class,$args)=@_;
  return unless $class eq __PACKAGE__; # to prevent subclasses from re-running this
  my $db=$self->db;
  Bio::ConnectDots::DB::ConnectDots->get($self);
  my $label2labelid= $self->label2labelid({});
  my $connectorsets=$self->connectorsets;
  for my $connectorset (@$connectorsets) {
    my $l2id=$connectorset->label2labelid;
    @$label2labelid{keys %$l2id}=values %$l2id;
  }
}

sub connectorsets {
  my $self=shift;
  if (@_) {
    my $connectorsets=shift;
    my $name2cs=$self->name2cs({});
    my $id2cs=$self->id2cs({});
    for my $connectorset (@$connectorsets) {
      $self->throw("Connectorset must have a version attribute.") unless $connectorset->cs_version;
      $name2cs->{$connectorset->name}{$connectorset->cs_version}=$connectorset;
      $id2cs->{$connectorset->db_id}=$connectorset;
    }
    my $label2labelid=$self->label2labelid({});
    for my $connectorset (@$connectorsets) {
      my $l2id=$connectorset->label2labelid;
      @$label2labelid{keys %$l2id}=values %$l2id;
    }
  }
  my @connectorsets;
  foreach my $csname (keys %{$self->name2cs}) {
	grep { push @connectorsets, $_ } values %{$self->name2cs->{$csname}};
  }
  wantarray? @connectorsets: \@connectorsets;
}
sub dotsets {
  my $self=shift;
  if (@_) {
    my $dotsets=shift;
    my $label2dotset=$self->label2dotset({});
    my $id2dotset=$self->id2dotset({});
    for my $dotset (@$dotsets) {
      $label2dotset->{$dotset->name}=$dotset;
      $id2dotset->{$dotset->db_id}=$dotset;
    }
  }
  my @dotsets=values %{$self->label2dotset};
  wantarray? @dotsets: \@dotsets;
}
sub connectortables {
  my $self=shift;
  if (@_) {
    my $connectortables=shift;
    my $name2ct=$self->name2ct({});
    my $id2ct=$self->id2ct({});
    for my $connectortable (@$connectortables) {
      $name2ct->{$connectortable->name}=$connectortable;
      $id2ct->{$connectortable->db_id}=$connectortable;
    }
  }
  my @connectortables=values %{$self->name2ct};
  wantarray? @connectortables: \@connectortables;
}
sub dottables {
  my $self=shift;
  if (@_) {
    my $dottables=shift;
    my $name2dt=$self->name2dt({});
    my $id2dt=$self->id2dt({});
    for my $dottable (@$dottables) {
      $name2dt->{$dottable->name}=$dottable;
      $id2dt->{$dottable->db_id}=$dottable;
    }
  }
  my @dottables=values %{$self->name2dt};
  wantarray? @dottables: \@dottables;
}

sub connectorset {
  my($self,$name,$version)=@_;
  if (!$version) { # no specified version, get newest
	foreach my $ver (keys %{$self->name2cs->{$name}}) {
	  $version = $ver if $ver gt $version;
	}
  }
  return $self->name2cs->{$name}->{$version};
}

sub dotset {
  my($self,$name)=@_;
  $self->label2dotset->{$name};
}
sub query {
  my($self,@args)=@_;
  my $args=new Class::AutoClass::Args(@args);
  my $query_type=$args->query_type;
  if ($query_type=~/dot/i || $args->input) {
    my $dottable=new Bio::ConnectDots::DotTable(-connectdots=>$self,-db=>$self->db,%$args);
    $dottable->query($args);
    $self->name2dt->{$dottable->name}=$dottable;
  } else {			# assume it's a ConnectorQuery
    my $connectortable=new Bio::ConnectDots::ConnectorTable(-connectdots=>$self,-db=>$self->db,%$args);
    $connectortable->query($args);
    $self->name2ct->{$connectortable->name}=$connectortable;
  }
}
sub connector_query {
  my($self,@args)=@_;
  my $args=new Class::AutoClass::Args(@args);
  my $connectortable=new Bio::ConnectDots::ConnectorTable
    (-connectdots=>$self,-db=>$self->db,%$args);
  $connectortable->query($args);
  $self->name2ct->{$connectortable->name}=$connectortable;
}
sub dot_query {
  my($self,@args)=@_;
  my $args=new Class::AutoClass::Args(@args);
  my $dottable=new Bio::ConnectDots::DotTable
    (-connectdots=>$self,-db=>$self->db,%$args);
  $dottable->query($args);
  $self->name2dt->{$dottable->name}=$dottable;
}


sub _flatten {map {'ARRAY' eq ref $_? @$_: $_} @_;}
1;
__END__