#!/usr/bin/env perl
#
# Copyright 2008-2010 Tim Rayner
# 
# This file is part of Bio::MAGETAB.
# 
# Bio::MAGETAB is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
# 
# Bio::MAGETAB is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with Bio::MAGETAB.  If not, see <http://www.gnu.org/licenses/>.
#
# $Id: 003_edge.t 333 2010-06-02 16:41:31Z tfrayner $

use strict;
use warnings;

use Test::More qw(no_plan);
use Test::Exception;

BEGIN {
    use_ok( 'Bio::MAGETAB::Edge' );
}

INIT {
    use lib 't/testlib';
    use CommonTests qw(test_class);
}

use Bio::MAGETAB::Source;
use Bio::MAGETAB::Sample;
use Bio::MAGETAB::Extract;
use Bio::MAGETAB::Protocol;
use Bio::MAGETAB::ProtocolApplication;

my $so = Bio::MAGETAB::Source->new(  name => 'test source'  );
my $sa = Bio::MAGETAB::Sample->new(  name => 'test sample'  );
my $ex = Bio::MAGETAB::Extract->new( name => 'test extract' );

my $pr = Bio::MAGETAB::Protocol->new( name => 'test protocol' );
my $pa = Bio::MAGETAB::ProtocolApplication->new(
    protocol => $pr,
    date     => '2008-01-01',
);

my %required_attr = (
    inputNode            => $so,
    outputNode           => $sa,
);

my %optional_attr = (
    protocolApplications => [ $pa ],
);

my %bad_attr = (
    inputNode            => [],
    outputNode           => 'test',
    protocolApplications => 'test',
);

my $pa2 = Bio::MAGETAB::ProtocolApplication->new(
    protocol => $pr,
    date     => '2008-01-02',
);

my %secondary_attr = (
    inputNode            => $sa,
    outputNode           => $ex,
    protocolApplications => [ $pa2 ],
);

my $obj = test_class(
    'Bio::MAGETAB::Edge',
    \%required_attr,
    \%optional_attr,
    \%bad_attr,
    \%secondary_attr,
);

ok( $obj->isa('Bio::MAGETAB::BaseClass'), 'object has correct superclass' );

my $ex2 = Bio::MAGETAB::Extract->new( name => 'test extract 2' );
my $ex3 = Bio::MAGETAB::Extract->new( name => 'test extract 3' );

# Test reciprocal relationship between nodes and edges.
is( $obj->get_outputNode(), $sa, 'initial state prior to reciprocity test' );
lives_ok( sub{ $obj->set_outputNode($ex2) }, 'setting outputNode via self' );
is_deeply( $ex2->get_inputEdges(), $obj, 'sets inputEdges in target node' );
lives_ok( sub{ $ex3->set_inputEdges( [ $obj ] ) }, 'setting inputEdges via target node' );
is( $obj->get_outputNode(), $ex3, 'sets outputNode in self' );

# Test for reciprocal relationship establishment on instantiation.
my $obj2;
lives_ok( sub{ $obj2 = Bio::MAGETAB::Edge->new( inputNode => $ex, outputNode => $ex2 ) },
          'edge instantiation with nodes' );
is( $obj2->get_inputNode(), $ex, 'sets inputNode' );
is( $obj2->get_outputNode(), $ex2, 'and outputNode' );
is_deeply( $ex->get_outputEdges(), $obj2, 'and outputEdges in target node' );
is_deeply( [ sort $ex2->get_inputEdges() ], [ sort $obj, $obj2 ], 'and inputEdges in target node' );

# Test implicit deletion upon setting. We've just tested $ex2->get_inputEdges and $ex->get_outputEdges...
lives_ok( sub { $obj2->set_outputNode( $ex3 ) }, 'resetting outputNode succeeds' );
is_deeply( [ sort $ex2->get_inputEdges() ], [ $obj ], 'and deletes the inputEdge on the old node' );
lives_ok( sub { $obj2->set_inputNode( $ex3 ) }, 'resetting inputNode succeeds' );
is_deeply( [ sort $ex->get_outputEdges() ], [ ], 'and deletes the outputEdge on the old node' );

# N.B. we don't bother testing the reciprocal deletion-on-set, because
# a node repointing to a new edge will break the old edge (since both
# input and output are required on an edge). This is a fairly bad
# state of affairs to get into, and it's assumed for now that any
# developer doing this must know what they're doing. FIXME we need a
# note in the docs to this effect (i.e. always update via Edge if
# you're remodelling your graph).

# This should live, and allow garbage collection to destroy both the
# edge and any protocol apps attached to it. The edge still references
# $ex2, but the ref is weakened. This is okay because edges don't have
# multiple outputNodes etc. and so aren't really reusable. FIXME
# consider removing the edge object from any Bio::MAGETAB container,
# though.
lives_ok( sub{ $ex2->clear_inputEdges() }, 'attempt to disconnect edges from node succeeds' );