The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/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: 014_persistence.t 333 2010-06-02 16:41:31Z tfrayner $

# Basic tests for the Persistence module. FIXME this needs to be
# extended to test insertion, update, retrieval and deletion of all
# instantiable Bio::MAGETAB classes.

use strict;
use warnings;

use Test::More tests => 21;
use Test::Exception;
use File::Spec;

use Bio::MAGETAB;

my $dbfile = File::Spec->catfile('t','test_sqlite.db');
if ( -e $dbfile ) {
    unlink $dbfile or die("Error unlinking pre-existing test database file: $!");
}

my $dsn    = "dbi:SQLite:$dbfile";

SKIP: {

    eval {
        require Tangram;
        require DBI;
        require DBD::SQLite;
    };

    skip 'Tests require Tangram, DBI and DBD::SQLite to be installed',
	21 if $@;

    require_ok( 'Bio::MAGETAB::Util::Persistence');

    my $db;
    lives_ok( sub{ $db = Bio::MAGETAB::Util::Persistence->new( dbparams => [ $dsn ] )},
              'Persistence object instantiates okay');

    lives_ok( sub{ $db->deploy() }, 'and deploys database schema');

    lives_ok( sub{ $db->connect() }, 'to which we can successfully connect');

    {
        my $cv = Bio::MAGETAB::ControlledTerm->new({ category => 'testcat',
                                                     value    => 'testval', });
        lives_ok( sub{ $db->insert( $cv ) }, 'and insert a ControlledTerm');
        $cv->set_accession( '12345' );
        lives_ok( sub{ $db->update( $cv ) }, 'update the ControlledTerm' );

        lives_ok( sub{ $db->insert(
            Bio::MAGETAB::Sample->new({ name         => 'test_sample',
                                        namespace    => 'me',
                                        materialType => $cv, }) ) },
                  'insert a Sample');
    }

    my $rem;
    lives_ok( sub{ $rem = $db->remote('Bio::MAGETAB::ControlledTerm') },
              'retrieve remote term');
    my @ncv;
    lives_ok( sub{ @ncv = $db->select( $rem, $rem->{category} eq 'testcat' & $rem->{value} eq 'testval') },
              'and use it to query the database');
    is( ref $ncv[0], 'Bio::MAGETAB::ControlledTerm', 'to retrieve an object with the desired class');
    is( $ncv[0]->get_accession(), '12345', 'with the correctly updated accession');

    lives_ok( sub{ $db->erase( $ncv[0] ) }, 'calls to erase live');
    lives_ok( sub{ @ncv = $db->select( $rem ) }, 'retrieval of all terms');
    is( scalar @ncv, 0, 'now gives an empty array' );
    
    lives_ok( sub{ $db->insert( Bio::MAGETAB::Source->new({
        name         => 'test_source',
        providers    => [ map { Bio::MAGETAB::Contact->new({ lastName => $_ }) } qw( me them others ) ]
    }))}, 'insert a Source');

    my $obj;
    lives_ok( sub{ $obj = $db->remote( 'Bio::MAGETAB::Source' ) },
              'we can retrieve a remote Source object');

    my @sources;
    lives_ok( sub{ @sources = $db->select( $obj, $obj->{name} eq 'test_source' )},
              'and use it to query the database');

    is( ref $sources[0], 'Bio::MAGETAB::Source', 'to retrieve an object with the desired class');

    dies_ok( sub{ $sources[0]->set_name(undef) }, 'which obeys the original Moose type constraints');

    is( $sources[0]->get_name(), 'test_source', 'and has the correct name attribute' );

    is_deeply( [ sort map { $_->get_lastName() } $sources[0]->get_providers() ],
               [ qw( me others them ) ],
               'and links to the correct provider Contacts');

    unlink $dbfile or die("Error unlinking test database file: $!");
}