The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Bio::ConnectDots::ConnectorQuery;
use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS %DEFAULTS);
use strict;
#use lib "/users/ywang/temp";
use Bio::ConnectDots::Util;
use Bio::ConnectDots::Connector;
use Bio::ConnectDots::Dot;
use Bio::ConnectDots::ConnectorQuery::Constraint;
use Bio::ConnectDots::ConnectorQuery::Alias;
use Bio::ConnectDots::ConnectorQuery::Join;
use Bio::ConnectDots::Parser;
use Bio::ConnectDots::ConnectorQuery::Inner;
use Bio::ConnectDots::ConnectorQuery::Outer;
use Class::AutoClass;
@ISA = qw(Class::AutoClass); # AutoClass must be first!!

@AUTO_ATTRIBUTES=qw(connectortable constraints joins
		    name2ct_alias name2cs_alias
		    _ct_aliases _cs_aliases);
@OTHER_ATTRIBUTES=qw(ct_aliases cs_aliases);
%SYNONYMS=(rods=>'joins');
%DEFAULTS=(_ct_aliases=>[],_cs_aliases=>[],
	   joins=>[],joins=>[],constraints=>[]);
Class::AutoClass::declare(__PACKAGE__);

sub connectdots {$_[0]->connectortable->connectdots;}
sub name {$_[0]->connectortable->name;}
sub columns {$_[0]->connectortable->columns;}
sub column2cs {$_[0]->connectortable->column2cs;}
sub db {$_[0]->connectortable->db;}

sub ct_aliases {
  my $self=shift @_;
  my $name2ct_alias=$self->name2ct_alias;
  if (@_) {
    $self->throw("Cannot set ct_aliases: name2ct_alias is already set and it takes precedence")
      if $name2ct_alias;
    return $self->_ct_aliases(@_);
  }
  $name2ct_alias? [values %$name2ct_alias]: $self->_ct_aliases;
}
sub cs_aliases {
  my $self=shift @_;
  my $name2cs_alias=$self->name2cs_alias;
  if (@_) {
    $self->throw("Cannot set cs_aliases: name2cs_alias is already set and it takes precedence")
      if $name2cs_alias;
    return $self->_cs_aliases(@_);
  }
  $name2cs_alias? [values %$name2cs_alias]: $self->_cs_aliases;
}
sub aliases {
  my @aliases=(@{$_[0]->ct_aliases},@{$_[0]->cs_aliases});
  wantarray? @aliases: \@aliases;
}

sub execute {
  my($self)=@_;
  $self->parse;			# parse syntax
  $self->normalize;		# normalize syntax
  $self->validate;		# do semantic checks
  $self->db_execute;	# really execute -- implemented in subclasses
}

sub parse {
  my($self)=@_;
  $self->parse_aliases;
  $self->parse_constraints;
  $self->parse_joins;
}
sub normalize {
  my($self)=@_;
  $self->normalize_aliases;
  $self->normalize_constraints;
  $self->normalize_joins;
  $self->fill_aliases;		# fill in additional aliases from Constraints and Join
}
sub validate {
  my($self)=@_;
  $self->validate_aliases;
  $self->validate_constraints;
  $self->validate_joins;
  $self->prune_aliases;		# remove any aliases not mentioned in constraints or joins
  $self->set_columns;		# set output columns & check for uniqueness
}
sub fill_aliases {
  my($self)=@_;
  for my $constraint (@{$self->constraints}) {
    my $term=$constraint->term;
    $self->fill_aliases_term($term);
  }
  for my $join (@{$self->joins}) {
    my $term=$join->term0;
    $self->fill_aliases_term($term);
    my $term=$join->term1;
    $self->fill_aliases_term($term);
  }
}
sub fill_aliases_term {
  my($self,$term)=@_;
  my $alias=$term->ct_alias;
  my $old_alias=$self->name2ct_alias->{$alias};
  $self->name2ct_alias->{$alias}=
    new Bio::ConnectDots::ConnectorQuery::Alias(-target_name=>$alias,-alias_name=>$alias)
      if $alias && !$old_alias;
  my $alias=$term->cs_alias;
  my $old_alias=$self->name2cs_alias->{$alias};
  $self->name2cs_alias->{$alias}=
    new Bio::ConnectDots::ConnectorQuery::Alias(-target_name=>$alias,-alias_name=>$alias)
      if $alias && !$old_alias;
}
sub prune_aliases {
  my($self)=@_;
  my @aliases=(map({$_->alias} @{$self->constraints}),map({$_->aliases} @{$self->joins}));
  my %aliases;
  @aliases{@aliases}=@aliases;
  my $pruned=[];
  my($name2ct_alias,$name2cs_alias)=($self->name2ct_alias,$self->name2cs_alias);
  while(my($alias_name,$alias)=each %$name2ct_alias) {
    delete $name2ct_alias->{$alias_name} unless $aliases{$alias};
  }
  while(my($alias_name,$alias)=each %$name2cs_alias) {
    delete $name2cs_alias->{$alias_name} unless $aliases{$alias};
  }
}
sub set_columns {
  my($self)=@_;
  my $column2cs=$self->column2cs;
  for my $ct_alias (@{$self->ct_aliases}) {
    my $ct=$ct_alias->target_object;
    while(my($column,$cs)=each %{$ct->column2cs}) {
      my $out_column=$self->out_column($ct_alias,$column);
      $self->throw("Duplicate output column $out_column from ConnectorTable ".$ct->name)
	if defined $column2cs->{$out_column};
      $column2cs->{$out_column}=$cs;
    }
  }
  for my $cs_alias (@{$self->cs_aliases}) {
    my $cs=$cs_alias->target_object;
    my $out_column=$self->out_column($cs_alias);
    $self->throw("Duplicate output column $out_column for ConnectorSet ".$cs->name)
      if defined $column2cs->{$out_column};
    $column2cs->{$out_column}=$cs;
  }
}
sub out_column {
  my $self=shift @_;
  my $out_column;
  my($ct_alias,$ct_column,$cs_aliase);
  if (@_==1) {
    my($cs_alias)=@_;
    $out_column=$cs_alias->alias_name;
  } elsif (@_==2) {
    my($ct_alias,$column)=@_;
    $out_column=$ct_alias->alias_name.'_'.$column;
  } else {
    $self->throw("Wrong number parameters to out_column: should be 1 or 2, not".(@_+0));
  }
  $out_column;
}

sub parse_aliases {
  my($self)=@_;
  my $ct_aliases=parse Bio::ConnectDots::ConnectorQuery::Alias($self->ct_aliases);
  $self->ct_aliases($ct_aliases);
  my $cs_aliases=parse Bio::ConnectDots::ConnectorQuery::Alias($self->cs_aliases);
  $self->cs_aliases($cs_aliases);
}
# convert alias ARRAY to HASH -- check for inconsistent duplicate entries
sub normalize_aliases {
  my($self)=@_;
  my $name2ct_alias=$self->_normalize_aliases($self->ct_aliases);
  $self->name2ct_alias($name2ct_alias);
  my $name2cs_alias=$self->_normalize_aliases($self->cs_aliases);
  $self->name2cs_alias($name2cs_alias);
}
sub _normalize_aliases {
  my($self,$aliases)=@_;
  my $normalized={};
  for my $alias (@$aliases) {
    my $alias_name=$alias->alias_name;
    my $target_name=$alias->target_name;
    my $old_alias=$normalized->{$alias_name};
    my $old_target=$old_alias && $old_alias->target_name;
    $self->throw("Duplicate alias $alias_name refers to different targets: $old_target vs. $target_name") if $old_target && $old_target ne $target_name;
    $normalized->{$alias_name}=new Bio::ConnectDots::ConnectorQuery::Alias(-target_name=>$target_name,-alias_name=>$alias_name);
  }
  wantarray? %$normalized: $normalized;
}

sub validate_aliases {
  my($self)=@_;
  $self->_validate_aliases($self->name2ct_alias,$self->connectdots->name2ct,0);
  $self->_validate_aliases($self->name2cs_alias,$self->connectdots->name2cs,1);
}
sub _validate_aliases {
  my($self,$name2alias,$name2object,$cs)=@_;
  my $cs2version = $self->connectortable->cs2version;
  while(my($alias_name,$alias_obj)=each %$name2alias) {
		if ($cs) {
	  	my $csname=$alias_obj->target_name;
	    my $version=$cs2version->{$csname};
			# make sure object exists  	
	  	$self->throw("Unknown ConnectorSet: $csname") unless $name2object->{$csname};
	  	$self->throw("Unknown version: $version for connectorset $csname") unless $version;
	    $alias_obj->validate($name2object,$version);
		} else {
			# make sure object exists  	
	  	my $ctname=$alias_obj->target_name;
	  	$self->throw("Unknown ConnectorTable: $ctname") unless $name2object->{$ctname};
	    $alias_obj->validate($name2object);
		}
  }
}

sub parse_constraints {
  my($self)=@_;
  my $constraints=parse Bio::ConnectDots::ConnectorQuery::Constraint($self->constraints);
  $self->constraints($constraints);
}
sub normalize_constraints {
  my($self)=@_;
  my $constraints=$self->constraints;
  my $normalized=[];
  @$normalized=map {$_->normalize} @$constraints;
  $self->constraints($normalized);
}
sub validate_constraints {
  my($self)=@_;
  my $constraints=$self->constraints;
  my($name2ct_alias,$name2cs_alias)=($self->name2ct_alias,$self->name2cs_alias);
  map {$_->validate($name2ct_alias,$name2cs_alias)} @$constraints;
}

sub parse_joins {
  my($self)=@_;
  my $joins=parse Bio::ConnectDots::ConnectorQuery::Join($self->joins);
  $self->joins($joins);
}
sub normalize_joins {
  my($self)=@_;
  my $joins=$self->joins;
  my $normalized=[];
  @$normalized=map {$_->normalize} @$joins;
  $self->joins($normalized);
}
sub validate_joins {
  my($self,$ct_alias,$cs_alias)=@_;
  my $joins=$self->joins;
  my($name2ct_alias,$name2cs_alias)=($self->name2ct_alias,$self->name2cs_alias);
  map {$_->validate($name2ct_alias,$name2cs_alias)} @$joins;
}

1;
__END__
=head1 NAME

Bio::ConnectDots::ConnectorQuery

=head1 DESCRIPTION

Base class for the query subclasses relating to ConnectorTables

Allowable input formats for constraints are

  'data op constant AND ...' (note: op is optional)

  or ARRAY of the following

  'data op constant AND ...'
  [<data> <constant>]
  [<data> op <constant>]
  {alias=>'data op constant'
   {
    alias=>[<data> <constant>]}
   {
     alias=>[<data> op <constant>]}
   {
     alias=>{columm=>'data op constant'}, ...}
   {
     alias=>{columm=>[<data> <constant>]}, ...}
   {
     alias=>{columm=>[<data> op <constant>]}, ...}

or HASH containing any hash form where data is 
  
  alias or alias.label or alias.column.label

label is 

  label_name or [label_name ...] or '*'
   
constant is 

  string or [string...]

=head1 AUTHOR - David Burdick, Nat Goodman

Email dburdick@systemsbiology.org, natg@shore.net

=head1 COPYRIGHT

Copyright (c) 2005 Institute for Systems Biology (ISB). All Rights Reserved.

This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.



=cut