The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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_sdrf.t 900 2008-05-13 13:07:43Z tfrayner $

use strict;
use warnings;

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

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

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

use Bio::MAGETAB::Normalization;
use Bio::MAGETAB::Extract;

my $norm = Bio::MAGETAB::Normalization->new( name => 'test norm' );

my %required_attr = (
    nodes          => [ $norm ],
);

my %optional_attr = (
    rowNumber      => 10,
);

my %bad_attr = (
    nodes          => 'test',
    rowNumber      => 'test',
);

my $norm2 = Bio::MAGETAB::Normalization->new( name => 'test norm 2' );

my %secondary_attr = (
    nodes          => [ $norm, $norm2 ],
    rowNumber      => 23,
);

my $obj = test_class(
    'Bio::MAGETAB::SDRFRow',
    \%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 sdrfRows.
is_deeply( [ sort $obj->get_nodes() ], [ $norm ],
           'initial state prior to reciprocity test' );
lives_ok( sub{ $obj->set_nodes( [ $ex2 ] ) }, 'setting nodes via self' );
is_deeply( $ex2->get_sdrfRows(), $obj, 'sets sdrfRows in target node' );
lives_ok( sub{ $ex3->set_sdrfRows( [ $obj ] ) }, 'setting sdrfRows via target node' );
is_deeply( [ sort $obj->get_nodes() ], [ sort $ex2, $ex3 ], 'adds nodes to self' );

# Check that we can update the sdrfRows on a node (reflexively).
my $obj2;
lives_ok( sub{ $obj2 = Bio::MAGETAB::SDRFRow->new( nodes => [ $ex2, $ex3 ] ) },
          'SDRFRow initialization succeeds' );
is_deeply( [ sort $obj2->get_nodes() ], [ sort $ex2, $ex3 ], 'setting nodes correctly' );
is_deeply( [ sort $ex2->get_sdrfRows() ], [ sort $obj, $obj2 ], 'and adds sdrfRow to target correctly' );

# Check that we can selectively delete nodes from an SDRFRow (reflexively).
lives_ok( sub{ $ex3->clear_sdrfRows() }, 'node can clear sdrfRow' );
is( $ex3->get_sdrfRows(), undef, 'sdrfRow cleared correctly' );
is_deeply( [ $obj2->get_nodes() ], [ $ex2 ], 'and updates SDRFRow nodes correctly' );

# Check that the implicit deletion when setting works okay
is_deeply( [ sort $ex2->get_sdrfRows() ], [ sort $obj, $obj2 ], 'related nodes retain correct SDRFRow linkage' );
lives_ok( sub{ $obj2->set_nodes( [ $ex3 ] ) }, 'resetting node linkage succeeds' );
is_deeply( [ sort $ex2->get_sdrfRows() ], [ $obj ], 'and implicitly deletes SDRFRow from old node' );

# And the reverse.
is_deeply( [ sort $obj->get_nodes() ], [ $ex2 ], 'related SDRFRows retain correct node linkage' );
lives_ok( sub{ $ex2->set_sdrfRows( [ $obj2 ] ) }, 'resetting SDRFRow linkage succeeds' );
is_deeply( [ sort $obj->get_nodes() ], [ ], 'and implicitly deletes node from old SDRFRow' );