package Bio::CDAT;
use Bio::CDAT::Root;
our @ISA = qw(Bio::CDAT::Root);

my $REV = '$Rev: 2259 $';
our $VERSION = '0.01';

=head1 NAME

Bio::CDAT - Integrated character data and tree handling.

=head1 SYNOPSIS

 use Bio::CDAT;

 # For example, connect Bio::NEXUS objects
 use Bio::NEXUS::Tree;
 use Bio::NEXUS::CharactersBlock;

 my $cdat   = new Bio::CDAT;
 my $tree   = new Bio::NEXUS::Tree;
 my $matrix = new Bio::NEXUS::CharactersBlock;

 # the cdat object assigns unique IDs to the 
 # objects added to it
 my $matrix_id = $cdat->add_matrix( $matrix );
 my $tree_id   = $cdat->add_forest( $tree );

 # the purpose of the 'add_listener' call is to
 # tell the cdat object which 'observable' object
 # (identified by UID) is listened to by which
 # listener (also identified by UID), and what
 # action to take if the observable changes state
 $cdat->add_listener( 

     # listener is the object that responds to changes
     'listener'   => $matrix_id,

     # observable is the object that the listener
     # keeps an eye on
     'observable' => $tree_id,

     # handler is a code reference defining a response
     # by the listener to change in the observable
     'handler'    => sub { 
         my ( $self, $observable, $method, @args ) = @_;
         my $msg = <<"HERE_DOC_WITH_SUBST";

   ========== EVENT HANDLER TRIGGERED ==========

     INVOCANT: '$observable'
       METHOD: '$method'
     LISTENER: '$self'
         ARGS: '@args' 

   ==============================================

 HERE_DOC_WITH_SUBST

         # 'debug', 'info', 'warning' and 'fatal' are
         # defined by Bio::CDAT::Root (which Bio::CDAT 
         # Bio::CDATinherits from).
         $cdat->info($msg) if $method eq 'set_name';  

         # matrix's response to tree method call
         $self->set_charlabels( [ "Listener of: '@args'" ] );      
     },
 );

 # will trigger handler
 $tree->set_name( 'Untitled_tree' ); 

 # prints "Listener of: 'Untitled_tree'"
 print @{ $matrix->get_charlabels }, "\n"; 

 # increase log level to show info messages
 $Bio::CDAT::Root::LOGLEVEL++;

 # will trigger handler, print info
 $tree->set_name( 'New CDAT tree' ); 

 # decrease log level
 $Bio::CDAT::Root::LOGLEVEL--;

 # prints "Listener of: 'New CDAT tree'"
 print @{ $matrix->get_charlabels }, "\n"; 


=head1 DESCRIPTION

The Bio::CDAT ("Character Data And Tree") module provides an
architecture to maintain referential integrity between
phylogenetic data objects. It does so by letting objects
listen for changes in other objects, changes that trigger
handlers on the listeners so that they can respond to the
new state of the observed object.

=head1 METHODS

=head2 CONSTRUCTOR

=over

=item new()

 Type    : Constructor
 Title   : new
 Usage   : my $cdat = new Bio::CDAT;
 Function: Initializes a Bio::CDAT object.
 Returns : A Bio::CDAT object.
 Args    : NONE

=cut

sub new {
    my $class = shift;
    my $self = {
        'taxa'      => {},
        'trees'     => {},
        'matrices'  => {},
        'listeners' => {},
    };
    bless $self, $class;
    return $self;
}

=back

=head2 MUTATORS

=over

=item add_matrix()

 Type    : Mutator
 Title   : add_matrix
 Usage   : my $matrix_id = $cdat->add_matrix( $matrix );
 Function: Adds a matrix to the Bio::CDAT object
 Returns : The unique ID assigned to the matrix
 Args    : A matrix object (AS YET NO INTERFACE FOR THIS)

=cut

sub add_matrix {
    my ( $self, $matrix, $handlers ) = @_;
    my $id = $self->get_id_for_object($matrix);
    if ( not $id ) {
        $self->initialize_object($matrix);
        $id = $self->get_id_for_object($matrix);
        $self->info("Initialized cdat wrapper for $matrix (id: $id)");
    }    
    $self->{'matrices'}->{$id} = $handlers;
    if ( $handlers ) {
        for my $observable_id ( keys %$handlers ) {
            $self->add_listener( $id, $observable_id, $handlers->{$observable_id} );
            $self->debug("$matrix (id: $id) watches observable id $observable_id");
        }
    }
    $self->info("Added $matrix (id: $id) to cdat container");
    return $id;
}

=item add_forest()

 Type    : Mutator
 Title   : add_forest
 Usage   : my $forest_id = $cdat->add_forest( $forest );
 Function: Adds a forest to the Bio::CDAT object
 Returns : The unique ID assigned to the forest
 Args    : A forest object (MAYBE A SINGLE TREE INSTEAD?)

=cut

sub add_forest {
    my ( $self, $forest, $handlers ) = @_;
    my $id = $self->get_id_for_object($forest);
    if ( not $id ) {
        $self->initialize_object($forest);
        $id = $self->get_id_for_object($forest);
        $self->info("Initialized cdat wrapper for $forest (id: $id)");
    }    
    $self->{'matrices'}->{$id} = $handlers;
    if ( $handlers ) {
        for my $observable_id ( keys %$handlers ) {
            $self->add_listener( $id, $observable_id, $handlers->{$observable_id} );
            $self->debug("$forest (id: $id) watches observable id $observable_id");
        }
    }
    $self->info("Added $forest (id: $id) to cdat container");
    return $id;
}

=item add_taxon()

 Type    : Mutator
 Title   : add_taxon
 Usage   : my $taxon_id = $cdat->add_taxon( $taxon );
 Function: Adds a taxon to the Bio::CDAT object
 Returns : The unique ID assigned to the taxon
 Args    : A taxon object (RIGHT NOW THIS IS A tie'd STRING)

=cut

sub add_taxon {
    my ( $self, $taxon, $handlers ) = @_;
    $self->{'taxa'}->{$taxon} = $handlers;
    tie $taxon, 'Bio::CDAT::Taxon', $handlers;
    return $self;
}

=item add_listener()

 Type    : Mutator
 Title   : add_listener
 Usage   : $cdat->add_listener(
               listener   => $lid,
               observable => $oid,
               handler    => \&handler 
           );
 Function: Implements observable/listener infrastructures
 Returns : $self
 Args    : 'listener'   => UID assigned by $cdat to listener
           'observable' => UID assigned by $cdat to observable
           'handler'    => a CODE reference

=cut

sub add_listener {
    my $self     = shift;
    my %args     = @_;
    my $id       = $args{ 'listener'  };
    my $obs_id   = $args{ 'observable'};
    my $handler  = $args{ 'handler'   };
    $self->{'listeners'}->{$obs_id} = {} if not $self->{'listeners'}->{$obs_id};
    $self->{'listeners'}->{$obs_id}->{$id} = $handler;
    $self->debug("Added listener (id: $id) for observable (id: $obs_id)");        
    return $self;    
}  

=item remove_matrix()

 Type    : Mutator
 Title   : remove_matrix
 Usage   : $cdat->remove_matrix( $matrix );
 Function: Removes a matrix from the Bio::CDAT object
 Returns : $self
 Args    : A matrix object

=cut

sub remove_matrix {
    my ( $self, $matrix ) = @_;
    my $id = $self->get_id_for_object($matrix);
    $self->notify_listeners( 
        'observable' => $matrix, 
        'method'     => 'DESTROY', 
        'args'       => \@_,    
    );
    delete $self->{'matrices'}->{$id};
    $self->debug("Removed $matrix (id: $id) from cdat container");
    return $self;
}

=item remove_forest()

 Type    : Mutator
 Title   : remove_forest
 Usage   : $cdat->remove_forest( $forest );
 Function: Removes a forest from the Bio::CDAT object
 Returns : $self
 Args    : A forest object

=cut

sub remove_forest {
    my ( $self, $forest ) = @_;
    my $id = $self->get_id_for_object($forest);
    $self->notify_listeners( 
        'observable' => $forest, 
        'method'     => 'DESTROY',
        'args'       => \@_,    
    );
    delete $self->{'matrices'}->{$id};
    $self->debug("Removed $forest (id: $id) from cdat container");
    return $self;
}

=item remove_taxon()

 Type    : Mutator
 Title   : remove_taxon
 Usage   : $cdat->remove_taxon( $taxon );
 Function: Removes a taxon from the Bio::CDAT object
 Returns : $self
 Args    : A taxon object

=cut

sub remove_taxon {
    my ( $self, $taxon ) = @_;
    delete $self->{'taxa'}->{$taxon};
    return $self;
}

=item remove_observable()

 Type    : Mutator
 Title   : remove_observable
 Usage   : $cdat->remove_observable( $observable );
 Function: Removes an observable from the Bio::CDAT object
 Returns : $self
 Args    : An observable object

=cut

sub remove_observable {
    my ( $self, $observable ) = @_;
    my $obs_id = $self->get_id_for_object($observable);
    if ( not $self->{'listeners'}->{$obs_id} ) {
        $self->info("$observable (id: $obs_id) not an observable");
    }
    else {
        delete $self->{'listeners'}->{$obs_id};
    }
    return $self;
}

=back

=head2 ACCESSORS

=over

=item get_matrices()

 Type    : Accessor
 Title   : get_matrices
 Usage   : my @matrices = @{ $cdat->get_matrices };
 Function: Retrieves matrices contained by $cdat
 Returns : ARRAY ref of matrices
 Args    : NONE

=cut

sub get_matrices {
    my $self = shift;
    my @matrices;
    for my $id ( keys %{ $self->{'matrices'} } ) {
        push @matrices, $self->get_object_by_id( $id );
    }
    return \@matrices;
}

=item get_forests()

 Type    : Accessor
 Title   : get_forests
 Usage   : my @forests = @{ $cdat->get_forests };
 Function: Retrieves forests contained by $cdat
 Returns : ARRAY ref of forests
 Args    : NONE

=cut

sub get_forests {
    my $self = shift;
    my @trees;
    for my $id ( keys %{ $self->{'trees'} } ) {
        push @trees, $self->get_by_id( $id );
    }
    return \@trees;
}

=item get_taxa()

 Type    : Accessor
 Title   : get_taxa
 Usage   : my @taxa = @{ $cdat->get_taxa };
 Function: Retrieves taxa contained by $cdat
 Returns : ARRAY ref of taxa
 Args    : NONE

=cut

sub get_taxa {
    my $self = shift;
    my @taxa = keys %{ $self->{'taxa'} };
    return \@taxa;
}

=back

=head2 METHODS

=over

=item notify_listeners()

 Type    : Method
 Title   : notify_listeners
 Usage   : $cdat->notify_listeners(
               'observable' => $oid, 
               'args'       => \@args, 
               'method'     => $method,
           );
 Function: Retrieves matrices contained by $cdat
 Returns : $self
 Args    : 'observable' => UID assigned by $cdat
           'args'       => array ref of args passed to $method
           'method'     => method name
 Notes   : This method is typically not used directly.
           Rather, the method is called by the cdat architecture.

=cut

sub notify_listeners {
    my $self = shift;
    my %args = @_;
    my $obs_id = $args{'observable'};
    my $method = $args{'method'};        
    my @args   = @{ $args{'args'} };
    my $object = $self->get_object_by_id( $obs_id );
    if ( not $self->{'listeners'}->{$obs_id} ) {
        $self->debug("No listeners attached to $object method '$method'");
    }
    else {
        for my $listener_id ( keys %{ $self->{'listeners'}->{$obs_id} } ) {
            $self->debug("Invoking handler defined by listener '$listener_id'");
            my $handler  = $self->{'listeners'}->{$obs_id}->{$listener_id}; 
            my $listener = $self->get_object_by_id( $listener_id );
            $handler->( $listener, $object, $method, @args ) if $listener;
        }
    }    
    return $self;    
}

=back

=head1 SEE ALSO

=over

=item L<Bio::CDAT::Root>

The Bio::CDAT object inherits from the Bio::CDAT::Root, 
which defines logging and exception handling methods.

=back

=head1 AUTHOR

Rutger A. Vos,

=over

=item email: C<< rvosa@sfu.ca >>

=item web page: L<http://www.sfu.ca/~rvosa/>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2005 Rutger A. Vos, All Rights Reserved. This program is free
software; you can redistribute it and/or modify it under the same terms as Perl
itself.

=cut

1;