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 369 2012-07-17 18:01:48Z tfrayner $

use strict;
use warnings;

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

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

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

use Bio::MAGETAB::Normalization;
use Bio::MAGETAB::SDRFRow;
use Bio::MAGETAB::Source;
use Bio::MAGETAB::LabeledExtract;
use Bio::MAGETAB::Assay;
use Bio::MAGETAB::ControlledTerm;
use Bio::MAGETAB::Edge;

sub create_nodes {

    my @types = @_;

    my @nodes;
    foreach my $type ( @types ) {
        my $class = "Bio::MAGETAB::$type";
        my $object;
        if ( $type eq 'LabeledExtract' ) {
            my $cv = Bio::MAGETAB::ControlledTerm->new(
                category => 'Label', value => 'test label',
            );
            $object = $class->new( name => $type, label => $cv );
        }
        elsif ( $type eq 'Assay' ) {
            my $cv = Bio::MAGETAB::ControlledTerm->new(
                category => 'Tech', value => 'test tech',
            );
            $object = $class->new( name => $type, technologyType => $cv );
        }
        else {
            $object = $class->new( name => $type );
        }
        if ( scalar @nodes ) {
            Bio::MAGETAB::Edge->new(
                inputNode  => $nodes[-1],
                outputNode => $object,
            );
        }
        push @nodes, $object;
    }
    return @nodes;
}

my $norm = Bio::MAGETAB::Normalization->new( name => 'test norm' );
my $row  = Bio::MAGETAB::SDRFRow->new( nodes => [ $norm ] );

my %required_attr = (
    uri            => 'file://localhost/data/sdrf1.txt',
);

my %optional_attr = (
    sdrfRows       => [ $row ],
);

my %bad_attr = (
    sdrfRows       => 'test',
    uri            => [],
);

my $norm2 = Bio::MAGETAB::Normalization->new( name => 'test norm 2' );
my $row2  = Bio::MAGETAB::SDRFRow->new( nodes => [ $norm2 ] );

my %secondary_attr = (
    sdrfRows       => [ $row, $row2 ],
    uri            => 'file://localhost/data/sdrf2.txt',
);

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

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

{
    # Test the add_nodes method with a valid chain of nodes.
    my @nodes = create_nodes( qw(Source LabeledExtract Assay Normalization) );
    my @branch = create_nodes( qw(Assay Normalization) );
    Bio::MAGETAB::Edge->new(
        inputNode  => $nodes[1],
        outputNode => $branch[0],
    );
    lives_ok( sub { $obj->clear_sdrfRows() }, 'we can clear the sdrfRows attribute' );
    ok( ! $obj->has_sdrfRows(), 'and has_sdrfRows agrees' );
    lives_ok( sub { $obj->add_nodes( \@nodes ) }, 'add_nodes is okay with valid node list' );
    ok( $obj->has_sdrfRows(), 'has_sdrfRows agrees' );
    my @rows = $obj->get_sdrfRows();
    is( scalar @rows, 2, 'and get_sdrfRows returns the correct number of rows' );
    my $channel = $rows[0]->get_channel();
    ok( defined $channel, 'with a defined channel' );
    is( $channel->get_value(), 'test label', 'having the right value' );
}

{
    # Try add_nodes with an invalid chain (multiple LEs).
    my @nodes2 = create_nodes( qw(LabeledExtract LabeledExtract) );
    dies_ok( sub{ $obj->add_nodes( \@nodes2 ) }, 'adding multiple chaines LEs fails' );
}

# Check that cycles are detected and handled.
{
    my @nodes3 = create_nodes( qw(Source LabeledExtract Assay) );
    Bio::MAGETAB::Edge->new(
        inputNode  => $nodes3[2],
        outputNode => $nodes3[0],
    );
    dies_ok( sub{ $obj->add_nodes( \@nodes3 ) },
             'adding chains with no starting nodes (all one cycle) fails' );
}
{
    my @nodes4 = create_nodes( qw(Source LabeledExtract Assay) );
    Bio::MAGETAB::Edge->new(
        inputNode  => $nodes4[2],
        outputNode => $nodes4[1],
    );
    dies_ok( sub{ $obj->add_nodes( \@nodes4 ) },
             'adding chains containing cycles fails' );
}

# Check that splitting and recombining is not flagged by the cycle check.
{
    my @nodes5 = create_nodes( qw(Source LabeledExtract Assay) );
    my $cv = Bio::MAGETAB::ControlledTerm->new(
        category => 'Label', value => 'test label',
    );
    my $le = Bio::MAGETAB::LabeledExtract->new( name => 'test branch', label => $cv );
    Bio::MAGETAB::Edge->new(
        inputNode  => $nodes5[0],
        outputNode => $le,
    );
    Bio::MAGETAB::Edge->new(
        inputNode  => $le,
        outputNode => $nodes5[2],
    );
    lives_ok( sub{ $obj->add_nodes( [ @nodes5, $le ] ) },
              'adding splitting followed by pooling succeeds' );
}