t/CXGN/GEM/experimentaldesign.t

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5   experimentaldesign.t
   6   A piece of code to test the CXGN::GEM::ExperimentalDesign module
   7
   8 =cut
   9
  10 =head1 SYNOPSIS
  11
  12  perl experimentaldesign.t
  13
  14  Note: To run the complete test the database connection should be done as
  15        postgres user
  16  (web_usr have not privileges to insert new data into the gem tables)
  17
  18  prove experimentaldesign.t
  19
  20  this test needs some environment variables:
  21   export GEM_TEST_METALOADER='metaloader user'
  22   export GEM_TEST_DBDSN='database dsn as:
  23      'dbi:DriverName:database=database_name;host=hostname;port=port'
  24
  25   Example:
  26     export GEM_TEST_DBDSN='dbi:Pg:database=sandbox;host=localhost;'
  27
  28   export GEM_TEST_DBUSER='database user with insert permissions'
  29   export GEM_TEST_DBPASS='database password'
  30
  31 =head1 DESCRIPTION
  32
  33  This script check 95 variables to test the right operation of the
  34  CXGN::GEM::ExperimentalDesign module:
  35
  36 =cut
  37
  38 =head1 AUTHORS
  39
  40  Aureliano Bombarely Gomez
  41  (ab782@cornell.edu)
  42
  43 =cut
  44
  45
  46 use strict;
  47 use warnings;
  48
  49 use Data::Dumper;
  50 use Test::More;
  51 use Test::Exception;
  52
  53 use CXGN::DB::Connection;
  54
  55 ## The tests still need search_path
  56
  57 my @schema_list = ('gem', 'biosource', 'metadata', 'public');
  58 my $schema_list = join(',', @schema_list);
  59 my $set_path = "SET search_path TO $schema_list";
  60
  61 ## First check env. variables and connection
  62
  63 BEGIN {
  64
  65     ## Env. variables have been changed to use biosource specific ones
  66
  67     my @env_variables = qw/GEM_TEST_METALOADER GEM_TEST_DBDSN GEM_TEST_DBUSER GEM_TEST_DBPASS/;
  68
  69     for my $env (@env_variables) {
  70         unless (defined $ENV{$env}) {
  71             plan skip_all => "Environment variable $env not set, aborting";
  72         }
  73     }
  74
  75     eval {
  76         CXGN::DB::Connection->new(
  77                                    $ENV{GEM_TEST_DBDSN},
  78                                    $ENV{GEM_TEST_DBUSER},
  79                                    $ENV{GEM_TEST_DBPASS},
  80                                    {on_connect_do => $set_path}
  81                                  );
  82     };
  83
  84     if ($@ =~ m/DBI connect/) {
  85
  86         plan skip_all => "Could not connect to database";
  87     }
  88
  89     plan tests => 95;
  90 }
  91
  92 BEGIN {
  93     use_ok('CXGN::GEM::Schema');             ## TEST1
  94     use_ok('CXGN::GEM::ExperimentalDesign'); ## TEST2
  95     use_ok('CXGN::GEM::Experiment');         ## TEST3
  96     use_ok('CXGN::GEM::Target');             ## TEST4
  97     use_ok('CXGN::Metadata::Metadbdata');    ## TEST5
  98 }
  99
 100 #if we cannot load the Schema modules, no point in continuing
 101 CXGN::Biosource::Schema->can('connect')
 102     or BAIL_OUT('could not load the CXGN::Biosource::Schema module');
 103 CXGN::Metadata::Schema->can('connect')
 104     or BAIL_OUT('could not load the CXGN::Metadata::Schema module');
 105 Bio::Chado::Schema->can('connect')
 106     or BAIL_OUT('could not load the Bio::Chado::Schema module');
 107 CXGN::GEM::Schema->can('connect')
 108     or BAIL_OUT('could not load the CXGN::GEM::Schema module');
 109
 110
 111 my $creation_user_name = $ENV{GEM_TEST_METALOADER};
 112
 113 ## The GEM schema contain all the metadata, chado and biosource classes so don't need to create another Metadata schema
 114
 115 my $schema = CXGN::GEM::Schema->connect( $ENV{GEM_TEST_DBDSN},
 116                                          $ENV{GEM_TEST_DBUSER},
 117                                          $ENV{GEM_TEST_DBPASS},
 118                                          {on_connect_do => $set_path});
 119
 120 $schema->txn_begin();
 121
 122
 123 ## Get the last values
 124
 125 my %nextvals = $schema->get_nextval();
 126 my $last_metadata_id = $nextvals{'md_metadata'} || 0;
 127 my $last_expdesign_id = $nextvals{'ge_experimental_design'} || 0;
 128 my $last_dbxref_id = $nextvals{'dbxref'} || 0;
 129 my $last_pub_id = $nextvals{'pub'} || 0;
 130
 131
 132 ## Create a empty metadata object to use in the database store functions
 133 my $metadbdata = CXGN::Metadata::Metadbdata->new($schema, $creation_user_name);
 134 my $creation_date = $metadbdata->get_object_creation_date();
 135 my $creation_user_id = $metadbdata->get_object_creation_user_by_id();
 136
 137
 138 #######################################
 139 ## FIRST TEST BLOCK: Basic functions ##
 140 #######################################
 141
 142 ## (TEST FROM 6 to 9)
 143 ## This is the first group of tests, to check if an empty object can store and after can return the data
 144 ## Create a new empty object;
 145
 146 my $expdesign0 = CXGN::GEM::ExperimentalDesign->new($schema, undef);
 147
 148 ## Load of the eight different parameters for an empty object using a hash with keys=root name for tha function and
 149  ## values=value to test
 150
 151 my %test_values_for_empty_object=( experimental_design_id    => $last_expdesign_id+1,
 152                                    experimental_design_name  => 'experimental design test',
 153                                    description               => 'this is a test',
 154                                    design_type               => 'test',
 155                                   );
 156
 157 ## Load the data in the empty object
 158 my @function_keys = sort keys %test_values_for_empty_object;
 159 foreach my $rootfunction (@function_keys) {
 160     my $setfunction = 'set_' . $rootfunction;
 161     if ($rootfunction eq 'experimental_design_id') {
 162         $setfunction = 'force_set_' . $rootfunction;
 163     }
 164     $expdesign0->$setfunction($test_values_for_empty_object{$rootfunction});
 165 }
 166
 167 ## Get the data from the object and store in two hashes. The first %getdata with keys=root_function_name and
 168  ## value=value_get_from_object and the second, %testname with keys=root_function_name and values=name for the test.
 169
 170 my (%getdata, %testnames);
 171 foreach my $rootfunction (@function_keys) {
 172     my $getfunction = 'get_'.$rootfunction;
 173     my $data = $expdesign0->$getfunction();
 174     $getdata{$rootfunction} = $data;
 175     my $testname = 'BASIC SET/GET FUNCTION for ' . $rootfunction.' test';
 176     $testnames{$rootfunction} = $testname;
 177 }
 178
 179 ## And now run the test for each function and value
 180
 181 foreach my $rootfunction (@function_keys) {
 182     is($getdata{$rootfunction}, $test_values_for_empty_object{$rootfunction}, $testnames{$rootfunction})
 183         or diag "Looks like this failed.";
 184 }
 185
 186
 187 ## Testing the die results (TEST 10 to 17)
 188
 189 throws_ok { CXGN::GEM::ExperimentalDesign->new() } qr/PARAMETER ERROR: None schema/,
 190     'TESTING DIE ERROR when none schema is supplied to new() function';
 191
 192 throws_ok { CXGN::GEM::ExperimentalDesign->new($schema, 'no integer')} qr/DATA TYPE ERROR/,
 193     'TESTING DIE ERROR when a non integer is used to create a protocol object with new() function';
 194
 195 throws_ok { CXGN::GEM::ExperimentalDesign->new($schema)->set_geexpdesign_row() } qr/PARAMETER ERROR: None geexpdesign_row/,
 196     'TESTING DIE ERROR when none schema is supplied to set_geexpdesign_row() function';
 197
 198 throws_ok { CXGN::GEM::ExperimentalDesign->new($schema)->set_geexpdesign_row($schema) } qr/SET ARGUMENT ERROR:/,
 199     'TESTING DIE ERROR when argument supplied to set_geexpdesign_row() is not a CXGN::GEM::Schema::GeExperimentalDesign row object';
 200
 201 throws_ok { CXGN::GEM::ExperimentalDesign->new($schema)->force_set_experimental_design_id() } qr/PARAMETER ERROR: None experimental_des/,
 202     'TESTING DIE ERROR when none experimental_design_id is supplied to set_force_experimental_design_id() function';
 203
 204 throws_ok { CXGN::GEM::ExperimentalDesign->new($schema)->force_set_experimental_design_id('non integer') } qr/DATA TYPE ERROR:/,
 205     'TESTING DIE ERROR when argument supplied to set_force_experimental_design_id() is not an integer';
 206
 207 throws_ok { CXGN::GEM::ExperimentalDesign->new($schema)->set_experimental_design_name() } qr/PARAMETER ERROR: None data/,
 208     'TESTING DIE ERROR when none data is supplied to set_experimental_design_name() function';
 209
 210 throws_ok { CXGN::GEM::ExperimentalDesign->new($schema)->set_design_type() } qr/PARAMETER ERROR: None data/,
 211     'TESTING DIE ERROR when none data is supplied to set_design_type() function';
 212
 213
 214
 215
 216 ##########################################################################
 217 ### SECOND TEST BLOCK: Experimental Design Store and Obsolete Functions ##
 218 ##########################################################################
 219
 220 ### Use of store functions.
 221
 222  eval {
 223
 224       my $expdesign2 = CXGN::GEM::ExperimentalDesign->new($schema);
 225       $expdesign2->set_experimental_design_name('experimental_design_test');
 226       $expdesign2->set_design_type('test');
 227       $expdesign2->set_description('This is a description test');
 228
 229       $expdesign2->store_experimental_design($metadbdata);
 230
 231       ## Testing the experimental_design_id and experimental_design_name for the new object stored (TEST 18 to 21)
 232
 233       is($expdesign2->get_experimental_design_id(), $last_expdesign_id+1,
 234          "TESTING STORE_EXPERIMENTAL_DESIGN FUNCTION, checking the experimental_design_id")
 235          or diag "Looks like this failed";
 236       is($expdesign2->get_experimental_design_name(), 'experimental_design_test',
 237          "TESTING STORE_EXPERIMENTAL_DESIGN FUNCTION, checking the experimental_design_name")
 238          or diag "Looks like this failed";
 239       is($expdesign2->get_design_type(), 'test',
 240          "TESTING STORE_EXPERIMENTAL_DESIGN FUNCTION, checking the design type")
 241          or diag "Looks like this failed";
 242       is($expdesign2->get_description(), 'This is a description test',
 243          "TESTING STORE_EXPERIMENTAL_DESIGN FUNCTION, checking description")
 244          or diag "Looks like this failed";
 245
 246
 247       ## Testing the get_medatata function (TEST 22 to 24)
 248
 249       my $obj_metadbdata = $expdesign2->get_experimental_design_metadbdata();
 250       is($obj_metadbdata->get_metadata_id(), $last_metadata_id+1, "TESTING GET_METADATA FUNCTION, checking the metadata_id")
 251         or diag "Looks like this failed";
 252       is($obj_metadbdata->get_create_date(), $creation_date, "TESTING GET_METADATA FUNCTION, checking create_date")
 253         or diag "Looks like this failed";
 254       is($obj_metadbdata->get_create_person_id_by_username, $creation_user_name,
 255          "TESING GET_METADATA FUNCTION, checking create_person by username")
 256         or diag "Looks like this failed";
 257
 258       ## Testing die for store function (TEST 25 and 26)
 259
 260       throws_ok { $expdesign2->store_experimental_design() } qr/STORE ERROR: None metadbdata/,
 261       'TESTING DIE ERROR when none metadbdata object is supplied to store_experimental_design() function';
 262
 263       throws_ok { $expdesign2->store_experimental_design($schema) } qr/STORE ERROR: Metadbdata supplied/,
 264       'TESTING DIE ERROR when argument supplied to store_experimental_design() is not a CXGN::Metadata::Metadbdata object';
 265
 266       ## Testing if it is obsolete (TEST 27)
 267
 268       is($expdesign2->is_experimental_design_obsolete(), 0, "TESTING IS_EXPERIMENTAL_DESIGN_OBSOLETE FUNCTION, checking boolean")
 269           or diag "Looks like this failed";
 270
 271       ## Testing obsolete (TEST 28 to 31)
 272
 273       $expdesign2->obsolete_experimental_design($metadbdata, 'testing obsolete');
 274
 275       is($expdesign2->is_experimental_design_obsolete(), 1,
 276          "TESTING EXPERIMENTAL_DESIGN_OBSOLETE FUNCTION, checking boolean after obsolete the experimental_design")
 277           or diag "Looks like this failed";
 278
 279       is($expdesign2->get_experimental_design_metadbdata()->get_metadata_id, $last_metadata_id+2,
 280          "TESTING EXPERIMENTAL_DESIGN_OBSOLETE, checking metadata_id")
 281           or diag "Looks like this failed";
 282
 283       $expdesign2->obsolete_experimental_design($metadbdata, 'testing obsolete', 'REVERT');
 284
 285       is($expdesign2->is_experimental_design_obsolete(), 0,
 286          "TESTING REVERT EXPERIMENTAL_DESIGN_OBSOLETE FUNCTION, checking boolean after revert obsolete")
 287           or diag "Looks like this failed";
 288
 289       is($expdesign2->get_experimental_design_metadbdata()->get_metadata_id, $last_metadata_id+3,
 290          "TESTING REVERT EXPERIMENTAL_DESIGN_OBSOLETE, for metadata_id")
 291           or diag "Looks like this failed";
 292
 293       ## Testing die for obsolete function (TEST 32 to 34)
 294
 295       throws_ok { $expdesign2->obsolete_experimental_design() } qr/OBSOLETE ERROR: None metadbdata/,
 296       'TESTING DIE ERROR when none metadbdata object is supplied to obsolete_experimental_design() function';
 297
 298       throws_ok { $expdesign2->obsolete_experimental_design($schema) } qr/OBSOLETE ERROR: Metadbdata/,
 299       'TESTING DIE ERROR when argument supplied to obsolete_experimental_design() is not a CXGN::Metadata::Metadbdata object';
 300
 301       throws_ok { $expdesign2->obsolete_experimental_design($metadbdata) } qr/OBSOLETE ERROR: None obsolete note/,
 302       'TESTING DIE ERROR when none obsolete note is supplied to obsolete_experimental_design() function';
 303
 304       ## Testing store for modifications (TEST 35 to 38)
 305
 306       $expdesign2->set_description('This is another test');
 307       $expdesign2->store_experimental_design($metadbdata);
 308
 309       is($expdesign2->get_experimental_design_id(), $last_expdesign_id+1,
 310          "TESTING STORE_EXPERIMENTAL_DESIGN for modifications, checking the experimental_design_id")
 311           or diag "Looks like this failed";
 312       is($expdesign2->get_experimental_design_name(), 'experimental_design_test',
 313          "TESTING STORE_EXPERIMENTAL_DESIGN for modifications, checking the experimental_design_name")
 314           or diag "Looks like this failed";
 315       is($expdesign2->get_description(), 'This is another test',
 316          "TESTING EXPERIMENTAL_DESIGN_SAMPLE for modifications, checking description")
 317           or diag "Looks like this failed";
 318
 319       my $obj_metadbdata2 = $expdesign2->get_experimental_design_metadbdata();
 320       is($obj_metadbdata2->get_metadata_id(), $last_metadata_id+4,
 321          "TESTING STORE_EXPERIMENTAL_DESIGN for modifications, checking new metadata_id")
 322           or diag "Looks like this failed";
 323
 324
 325       ## Testing new by name (TEST 39)
 326
 327       my $expdesign3 = CXGN::GEM::ExperimentalDesign->new_by_name($schema, 'experimental_design_test');
 328       is($expdesign3->get_experimental_design_id(), $last_expdesign_id+1, "TESTING NEW_BY_NAME, checking experimental_design_id")
 329         or diag "Looks like this failed";
 330
 331
 332
 333       ####################################################
 334       ## THIRD BLOCK: Experimental_Design_Pub functions ##
 335       ####################################################
 336
 337       ## Testing of the publication
 338
 339       ## Testing the die when the wrong for the row accessions get/set_geexpdesignpub_rows (TEST 40 to 42)
 340
 341       throws_ok { $expdesign3->set_geexpdesignpub_rows() } qr/FUNCTION PARAMETER ERROR: None geexpdesignpub_row/,
 342       'TESTING DIE ERROR when none data is supplied to set_geexpdesignpub_rows() function';
 343
 344       throws_ok { $expdesign3->set_geexpdesignpub_rows('this is not an integer') } qr/SET ARGUMENT ERROR:/,
 345       'TESTING DIE ERROR when data type supplied to set_geexpdesignpub_rows() function is not an array reference';
 346
 347       throws_ok { $expdesign3->set_geexpdesignpub_rows([$schema, $schema]) } qr/SET ARGUMENT ERROR:/,
 348       'TESTING DIE ERROR when the elements of the array reference supplied to set_geexpdesignpub_rows() function are not row objects';
 349
 350
 351       ## First, it need to add all the rows that the chado schema use for a publication
 352
 353       my $new_db_id = $schema->resultset('General::Db')
 354                               ->new(
 355                                      {
 356                                        name        => 'dbtesting',
 357                                        description => 'this is a test for add a tool-pub relation',
 358                                        urlprefix   => 'http//.',
 359                                        url         => 'www.testingdb.com'
 360                                      }
 361                                    )
 362                                ->insert()
 363                                ->discard_changes()
 364                                ->get_column('db_id');
 365
 366       my $new_dbxref_id1 = $schema->resultset('General::Dbxref')
 367                                   ->new(
 368                                           {
 369                                             db_id       => $new_db_id,
 370                                             accession   => 'TESTDBACC01',
 371                                             version     => '1',
 372                                             description => 'this is a test for add a tool-pub relation',
 373                                           }
 374                                          )
 375                                    ->insert()
 376                                    ->discard_changes()
 377                                    ->get_column('dbxref_id');
 378
 379       my $new_dbxref_id2 = $schema->resultset('General::Dbxref')
 380                                   ->new(
 381                                           {
 382                                             db_id       => $new_db_id,
 383                                             accession   => 'TESTDBACC02',
 384                                             version     => '1',
 385                                             description => 'this is a test for add a tool-pub relation',
 386                                           }
 387                                         )
 388                                    ->insert()
 389                                    ->discard_changes()
 390                                    ->get_column('dbxref_id');
 391
 392       my $new_cv_id = $schema->resultset('Cv::Cv')
 393                               ->new(
 394                                      {
 395                                         name       => 'testingcv',
 396                                         definition => 'this is a test for add a tool-pub relation',
 397                                      }
 398                                    )
 399                               ->insert()
 400                               ->discard_changes()
 401                               ->get_column('cv_id');
 402
 403        my $new_cvterm_id1 = $schema->resultset('Cv::Cvterm')
 404                                   ->new(
 405                                      {
 406                                         cv_id      => $new_cv_id,
 407                                         name       => 'testingcvterm1',
 408                                         definition => 'this is a test for add tool-pub relation',
 409                                         dbxref_id  => $new_dbxref_id1,
 410                                      }
 411                                    )
 412                               ->insert()
 413                               ->discard_changes()
 414                               ->get_column('cvterm_id');
 415
 416       my $new_cvterm_id2 = $schema->resultset('Cv::Cvterm')
 417                                   ->new(
 418                                      {
 419                                         cv_id      => $new_cv_id,
 420                                         name       => 'testingcvterm2',
 421                                         definition => 'this is a test for add tool-pub relation',
 422                                         dbxref_id  => $new_dbxref_id2,
 423                                      }
 424                                    )
 425                               ->insert()
 426                               ->discard_changes()
 427                               ->get_column('cvterm_id');
 428
 429        my $new_pub_id1 = $schema->resultset('Pub::Pub')
 430                                 ->new(
 431                                       {
 432                                            title          => 'testingtitle1',
 433                                            uniquename     => '00000:testingtitle1',
 434                                            type_id        => $new_cvterm_id1,
 435                                        }
 436                                      )
 437                                 ->insert()
 438                                 ->discard_changes()
 439                                 ->get_column('pub_id');
 440
 441       my $new_pub_id2 = $schema->resultset('Pub::Pub')
 442                                 ->new(
 443                                         {
 444                                           title          => 'testingtitle2',
 445                                           uniquename     => '00000:testingtitle2',
 446                                           type_id        => $new_cvterm_id1,
 447                                        }
 448                                       )
 449                                 ->insert()
 450                                 ->discard_changes()
 451                                 ->get_column('pub_id');
 452
 453        my $new_pub_id3 = $schema->resultset('Pub::Pub')
 454                                  ->new(
 455                                         {
 456                                           title          => 'testingtitle3',
 457                                           uniquename     => '00000:testingtitle3',
 458                                           type_id        => $new_cvterm_id1,
 459                                         }
 460                                       )
 461                                  ->insert()
 462                                  ->discard_changes()
 463                                  ->get_column('pub_id');
 464
 465        my @pub_list = ($new_pub_id1, $new_pub_id2, $new_pub_id3);
 466
 467        my $new_pub_dbxref = $schema->resultset('Pub::PubDbxref')
 468                                    ->new(
 469                                            {
 470                                              pub_id    => $new_pub_id3,
 471                                              dbxref_id => $new_dbxref_id1,
 472                                            }
 473                                          )
 474                                    ->insert();
 475
 476       ## TEST 43 AND 44
 477
 478       $expdesign3->add_publication($new_pub_id1);
 479       $expdesign3->add_publication({ title => 'testingtitle2' });
 480       $expdesign3->add_publication({ dbxref_accession => 'TESTDBACC01' });
 481
 482       my @pub_id_list = $expdesign3->get_publication_list();
 483       my $expected_pub_id_list = join(',', sort {$a <=> $b} @pub_list);
 484       my $obtained_pub_id_list = join(',', sort {$a <=> $b} @pub_id_list);
 485
 486       is($obtained_pub_id_list, $expected_pub_id_list, 'TESTING ADD_PUBLICATION and GET_PUBLICATION_LIST, checking pub_id list')
 487            or diag "Looks like this failed";
 488
 489       my @pub_title_list = $expdesign3->get_publication_list('title');
 490       my $expected_pub_title_list = 'testingtitle1,testingtitle2,testingtitle3';
 491       my $obtained_pub_title_list = join(',', sort @pub_title_list);
 492
 493       is($obtained_pub_title_list, $expected_pub_title_list, 'TESTING GET_PUBLICATION_LIST TITLE, checking pub_title list')
 494            or diag "Looks like this failed";
 495
 496
 497       ## Only the third pub has associated a dbxref_id (the rest will be undef) (TEST 45)
 498
 499       my @pub_accession_list = $expdesign3->get_publication_list('accession');
 500       my $expected_pub_accession_list = 'TESTDBACC01';
 501       my $obtained_pub_accession_list = $pub_accession_list[2];
 502
 503       is($obtained_pub_accession_list, $expected_pub_accession_list, 'TESTING GET_PUBLICATION_LIST ACCESSION, checking pub_accession')
 504         or diag "Looks like this failed";
 505
 506       ## Store functions (TEST 46)
 507
 508       $expdesign3->store_pub_associations($metadbdata);
 509
 510       my $expdesign4 = CXGN::GEM::ExperimentalDesign->new($schema, $expdesign3->get_experimental_design_id() );
 511
 512       my @pub_id_list2 = $expdesign4->get_publication_list();
 513       my $expected_pub_id_list2 = join(',', sort {$a <=> $b} @pub_list);
 514       my $obtained_pub_id_list2 = join(',', sort {$a <=> $b} @pub_id_list2);
 515
 516       is($obtained_pub_id_list2, $expected_pub_id_list2, 'TESTING STORE PUB ASSOCIATIONS, checking pub_id list')
 517          or diag "Looks like this failed";
 518
 519       ## Testing die for store function (TEST 47 AND 48)
 520
 521       throws_ok { $expdesign3->store_pub_associations() } qr/STORE ERROR: None metadbdata/,
 522       'TESTING DIE ERROR when none metadbdata object is supplied to store_pub_associations() function';
 523
 524       throws_ok { $expdesign3->store_pub_associations($schema) } qr/STORE ERROR: Metadbdata supplied/,
 525       'TESTING DIE ERROR when argument supplied to store_pub_associations() is not a CXGN::Metadata::Metadbdata object';
 526
 527       ## Testing obsolete functions (TEST 49 to 52)
 528
 529       my $n = 0;
 530       foreach my $pub_assoc (@pub_id_list2) {
 531            $n++;
 532            is($expdesign4->is_experimental_design_pub_obsolete($pub_assoc), 0,
 533             "TESTING GET_EXPERIMENTAL_DESIGN_PUB_METADATA AND IS_EXPERIMENTAL_DESIGN_PUB_OBSOLETE, checking boolean ($n)")
 534                or diag "Looks like this failed";
 535       }
 536
 537       my %expdesignpub_md1 = $expdesign4->get_experimental_design_pub_metadbdata();
 538       is($expdesignpub_md1{$pub_id_list[1]}->get_metadata_id, $last_metadata_id+1,
 539          "TESTING GET_EXPDESIGN_PUB_METADATA, checking metadata_id")
 540          or diag "Looks like this failed";
 541
 542       ## TEST 53 TO 56
 543
 544       $expdesign4->obsolete_pub_association($metadbdata, 'obsolete test for pub', $pub_id_list[1]);
 545       is($expdesign4->is_experimental_design_pub_obsolete($pub_id_list[1]), 1,
 546          "TESTING OBSOLETE EXPERIMENTAL_DESIGN PUB ASSOCIATIONS, checking boolean")
 547            or diag "Looks like this failed";
 548
 549       my %expdesignpub_md2 = $expdesign4->get_experimental_design_pub_metadbdata();
 550       is($expdesignpub_md2{$pub_id_list[1]}->get_metadata_id, $last_metadata_id+5,
 551          "TESTING OBSOLETE EXPERIMENTAL_DESIGN PUB FUNCTION, checking new metadata_id")
 552          or diag "Looks like this failed";
 553
 554       $expdesign4->obsolete_pub_association($metadbdata, 'revert obsolete test for pub', $pub_id_list[1], 'REVERT');
 555       is($expdesign4->is_experimental_design_pub_obsolete($pub_id_list[1]), 0,
 556          "TESTING OBSOLETE PUB ASSOCIATIONS REVERT, checking boolean")
 557            or diag "Looks like this failed";
 558
 559       my %expdesignpub_md2o = $expdesign4->get_experimental_design_pub_metadbdata();
 560       my $expdesignpub_metadata_id2 = $expdesignpub_md2o{$pub_id_list[1]}->get_metadata_id();
 561       is($expdesignpub_metadata_id2, $last_metadata_id+6, "TESTING OBSOLETE PUB FUNCTION REVERT, checking new metadata_id")
 562          or diag "Looks like this failed";
 563
 564       ## Checking the errors for obsolete_pub_asociation (TEST 57 TO 60)
 565
 566       throws_ok { $expdesign4->obsolete_pub_association() } qr/OBSOLETE ERROR: None metadbdata/,
 567       'TESTING DIE ERROR when none metadbdata object is supplied to obsolete_pub_association() function';
 568
 569       throws_ok { $expdesign4->obsolete_pub_association($schema) } qr/OBSOLETE ERROR: Metadbdata/,
 570       'TESTING DIE ERROR when argument supplied to obsolete_pub_association() is not a CXGN::Metadata::Metadbdata object';
 571
 572       throws_ok { $expdesign4->obsolete_pub_association($metadbdata) } qr/OBSOLETE ERROR: None obsolete note/,
 573       'TESTING DIE ERROR when none obsolete note is supplied to obsolete_pub_association() function';
 574
 575       throws_ok { $expdesign4->obsolete_pub_association($metadbdata, 'test note') } qr/OBSOLETE ERROR: None pub_id/,
 576       'TESTING DIE ERROR when none pub_id is supplied to obsolete_pub_association() function';
 577
 578
 579       #######################################################
 580       ## FORTH BLOCK: Experimental_Design_Dbxref functions ##
 581       #######################################################
 582
 583       ## Testing of the dbxref
 584
 585       ## Testing the die when the wrong for the row accessions get/set_geexpdesigndbxref_rows (TEST 61 to 63)
 586
 587       throws_ok { $expdesign3->set_geexpdesigndbxref_rows() } qr/FUNCTION PARAMETER ERROR: None geexpdesigndbxref_row/,
 588       'TESTING DIE ERROR when none data is supplied to set_geexpdesigndbxref_rows() function';
 589
 590       throws_ok { $expdesign3->set_geexpdesigndbxref_rows('this is not an integer') } qr/SET ARGUMENT ERROR:/,
 591       'TESTING DIE ERROR when data type supplied to set_geexpdesigndbxref_rows() function is not an array reference';
 592
 593       throws_ok { $expdesign3->set_geexpdesigndbxref_rows([$schema, $schema]) } qr/SET ARGUMENT ERROR:/,
 594       'TESTING DIE ERROR when the elements of the array reference supplied to set_geexpdesigndbxref_rows() function are not row objects';
 595
 596       ## Check set/get for dbxref (TEST 64)
 597
 598       $expdesign3->add_dbxref($new_dbxref_id1);
 599       $expdesign3->add_dbxref(
 600                                 {
 601                                  accession => 'TESTDBACC02',
 602                                  dbxname   => 'dbtesting',
 603                                 }
 604                              );
 605
 606       my @dbxref_list = ($new_dbxref_id1, $new_dbxref_id2);
 607       my @dbxref_id_list = $expdesign3->get_dbxref_list();
 608       my $expected_dbxref_id_list = join(',', sort {$a <=> $b} @dbxref_list);
 609       my $obtained_dbxref_id_list = join(',', sort {$a <=> $b} @dbxref_id_list);
 610
 611       is($obtained_dbxref_id_list, $expected_dbxref_id_list, 'TESTING ADD_DBXREF and GET_DBXREF_LIST, checking dbxref_id list')
 612            or diag "Looks like this failed";
 613
 614       ## Store function (TEST 65)
 615
 616       $expdesign3->store_dbxref_associations($metadbdata);
 617
 618       my $expdesign5 = CXGN::GEM::ExperimentalDesign->new($schema, $expdesign3->get_experimental_design_id() );
 619
 620       my @dbxref_id_list2 = $expdesign5->get_dbxref_list();
 621       my $expected_dbxref_id_list2 = join(',', sort {$a <=> $b} @dbxref_list);
 622       my $obtained_dbxref_id_list2 = join(',', sort {$a <=> $b} @dbxref_id_list2);
 623
 624       is($obtained_dbxref_id_list2, $expected_dbxref_id_list2, 'TESTING STORE DBXREF ASSOCIATIONS, checking dbxref_id list')
 625          or diag "Looks like this failed";
 626
 627       ## Testing die for store function (TEST 66 AND 67)
 628
 629       throws_ok { $expdesign3->store_dbxref_associations() } qr/STORE ERROR: None metadbdata/,
 630       'TESTING DIE ERROR when none metadbdata object is supplied to store_dbxref_associations() function';
 631
 632       throws_ok { $expdesign3->store_dbxref_associations($schema) } qr/STORE ERROR: Metadbdata supplied/,
 633       'TESTING DIE ERROR when argument supplied to store_dbxref_associations() is not a CXGN::Metadata::Metadbdata object';
 634
 635       ## Testing obsolete functions (TEST 68 to 70)
 636
 637       my $m = 0;
 638       foreach my $dbxref_assoc (@dbxref_id_list2) {
 639            $m++;
 640            is($expdesign5->is_experimental_design_dbxref_obsolete($dbxref_assoc), 0,
 641             "TESTING GET_EXPERIMENTAL_DESIGN_DBXREF_METADATA AND IS_EXPERIMENTAL_DESIGN_DBXREF_OBSOLETE, checking boolean ($m)")
 642                or diag "Looks like this failed";
 643       }
 644
 645       my %expdesigndbxref_md1 = $expdesign5->get_experimental_design_dbxref_metadbdata();
 646       is($expdesigndbxref_md1{$dbxref_id_list[1]}->get_metadata_id, $last_metadata_id+1,
 647          "TESTING GET_EXPDESIGN_DBXREF_METADATA, checking metadata_id")
 648          or diag "Looks like this failed";
 649
 650       ## TEST 71 TO 74
 651
 652       $expdesign5->obsolete_dbxref_association($metadbdata, 'obsolete test for dbxref', $dbxref_id_list[1]);
 653       is($expdesign5->is_experimental_design_dbxref_obsolete($dbxref_id_list[1]), 1,
 654          "TESTING OBSOLETE EXPERIMENTAL_DESIGN DBXREF ASSOCIATIONS, checking boolean")
 655            or diag "Looks like this failed";
 656
 657       my %expdesigndbxref_md2 = $expdesign5->get_experimental_design_dbxref_metadbdata();
 658       is($expdesigndbxref_md2{$dbxref_id_list[1]}->get_metadata_id, $last_metadata_id+7,
 659          "TESTING OBSOLETE EXPERIMENTAL_DESIGN DBXREF FUNCTION, checking new metadata_id")
 660          or diag "Looks like this failed";
 661
 662       $expdesign5->obsolete_dbxref_association($metadbdata, 'revert obsolete test for dbxref', $dbxref_id_list[1], 'REVERT');
 663       is($expdesign5->is_experimental_design_dbxref_obsolete($dbxref_id_list[1]), 0,
 664          "TESTING OBSOLETE DBXREF ASSOCIATIONS REVERT, checking boolean")
 665            or diag "Looks like this failed";
 666
 667       my %expdesigndbxref_md2o = $expdesign5->get_experimental_design_dbxref_metadbdata();
 668       my $expdesigndbxref_metadata_id2 = $expdesigndbxref_md2o{$dbxref_id_list[1]}->get_metadata_id();
 669       is($expdesigndbxref_metadata_id2, $last_metadata_id+8, "TESTING OBSOLETE DBXREF FUNCTION REVERT, checking new metadata_id")
 670          or diag "Looks like this failed";
 671
 672       ## Checking the errors for obsolete_pub_asociation (TEST 75 TO 78)
 673
 674       throws_ok { $expdesign4->obsolete_dbxref_association() } qr/OBSOLETE ERROR: None metadbdata/,
 675       'TESTING DIE ERROR when none metadbdata object is supplied to obsolete_dbxref_association() function';
 676
 677       throws_ok { $expdesign4->obsolete_dbxref_association($schema) } qr/OBSOLETE ERROR: Metadbdata/,
 678       'TESTING DIE ERROR when argument supplied to obsolete_dbxref_association() is not a CXGN::Metadata::Metadbdata object';
 679
 680       throws_ok { $expdesign4->obsolete_dbxref_association($metadbdata) } qr/OBSOLETE ERROR: None obsolete note/,
 681       'TESTING DIE ERROR when none obsolete note is supplied to obsolete_dbxref_association() function';
 682
 683       throws_ok { $expdesign4->obsolete_dbxref_association($metadbdata, 'test note') } qr/OBSOLETE ERROR: None dbxref_id/,
 684       'TESTING DIE ERROR when none dbxref_id is supplied to obsolete_dbxref_association() function';
 685
 686       #########################################
 687       ## FIFTH BLOCK: General Store function ##
 688       #########################################
 689
 690       ## First, check if it die correctly (TEST 79 AND 80)
 691
 692       throws_ok { $expdesign4->store() } qr/STORE ERROR: None metadbdata/,
 693       'TESTING DIE ERROR when none metadbdata object is supplied to store() function';
 694
 695       throws_ok { $expdesign4->store($schema) } qr/STORE ERROR: Metadbdata supplied/,
 696       'TESTING DIE ERROR when argument supplied to store() is not a CXGN::Metadata::Metadbdata object';
 697
 698       my $expdesign6 = CXGN::GEM::ExperimentalDesign->new($schema);
 699       $expdesign6->set_experimental_design_name('another test for expdesign');
 700       $expdesign6->set_design_type('another test for types');
 701       $expdesign6->add_publication($new_pub_id1);
 702       $expdesign6->add_dbxref($new_dbxref_id1);
 703
 704       $expdesign6->store($metadbdata);
 705
 706       ## Checking the parameters stored
 707
 708       ## TEST 81 TO 83
 709
 710       is($expdesign6->get_experimental_design_id(), $last_expdesign_id+2,
 711          "TESTING GENERAL STORE FUNCTION, checking experimental_design_id")
 712           or diag "Looks like this failed";
 713
 714       my @pub_list3 = $expdesign6->get_publication_list();
 715       is($pub_list3[0], $new_pub_id1, "TESTING GENERAL STORE FUNCTION, checking pub_id")
 716         or diag "Looks like this failed";
 717
 718       my @dbxref_list3 = $expdesign6->get_dbxref_list();
 719       is($dbxref_list3[0], $new_dbxref_id1, "TESTING GENERAL STORE FUNCTION, checking dbxref_id")
 720         or diag "Looks like this failed";
 721
 722       #################################################################
 723       ## SIXTH BLOCK: Functions that interact with other GEM objects ##
 724       #################################################################
 725
 726       ## First it will create a two Experiment object and store its data (TEST 84 to 87)
 727
 728       my @exp_names = ('exp test 1', 'exp test 2');
 729
 730       foreach my $exp_name (@exp_names) {
 731           my $experiment = CXGN::GEM::Experiment->new($schema);
 732           $experiment->set_experiment_name($exp_name);
 733           $experiment->set_experimental_design_id($last_expdesign_id+1);
 734           $experiment->set_replicates_nr(3);
 735           $experiment->set_colour_nr(1);
 736
 737           $experiment->store($metadbdata);
 738       }
 739
 740       my $expdesign7 = CXGN::GEM::ExperimentalDesign->new($schema, $last_expdesign_id+1);
 741
 742       ## Now test the get_experiment_list function
 743
 744       my @experiments = $expdesign7->get_experiment_list();
 745       my $o = 0;
 746
 747       foreach my $exp (@experiments) {
 748           my $t = $o+1;
 749           is(ref($exp), 'CXGN::GEM::Experiment', "TESTING GET_EXPERIMENT_LIST function, testing object reference ($t)")
 750               or diag "Looks like this failed";
 751           is($exp->get_experiment_name(), $exp_names[$o], "TESTING GET_EXPERIMENT_LIST function, testing experiment_names ($t)")
 752               or diag "Looks like this failed";
 753           $o++;
 754       }
 755
 756       ## Second it will create a four Target objects and store it
 757
 758       my @target_base_names = ( 'target1', 'target2');
 759       my @target_names = ();
 760
 761       foreach my $exp2 (@experiments) {
 762           my $exp2_id = $exp2->get_experiment_id();
 763           my $exp2_name = $exp2->get_experiment_name();
 764
 765           foreach my $target_base_name (@target_base_names) {
 766               my $target_name = $target_base_name . "_from_" . $exp2_name;
 767               push @target_names, $target_name;
 768
 769               my $target = CXGN::GEM::Target->new($schema);
 770               $target->set_target_name($target_name);
 771               $target->set_experiment_id($exp2_id);
 772
 773               $target->store_target($metadbdata);
 774           }
 775       }
 776
 777       ## This should create four target associated with the experiments, now check it. (TEST 88 to 95)
 778
 779       my @targets = $expdesign7->get_target_list();
 780       my $p = 0;
 781
 782       foreach my $targ (@targets) {
 783           my $u = $p+1;
 784           is(ref($targ), 'CXGN::GEM::Target', "TESTING GET_TARGET_LIST function, testing object reference ($u)")
 785               or diag "Looks like this failed";
 786           is($targ->get_target_name(), $target_names[$p], "TESTING GET_TARGET_LIST function, testing target_names ($u)")
 787               or diag "Looks like this failed";
 788           $p++;
 789       }
 790
 791
 792 };  ## End of the eval function
 793
 794 if ($@) {
 795     print "\nEVAL ERROR:\n\n$@\n";
 796 }
 797
 798
 799  ## RESTORING THE ORIGINAL STATE IN THE DATABASE
 800 ## To restore the original state in the database, rollback (it is in a transaction) and set the table_sequence values.
 801
 802 $schema->txn_rollback();
 803
 804 ## The transaction change the values in the sequence, so if we want set the original value, before the changes
 805  ## we have two options:
 806   ##     1) SELECT setval (<sequence_name>, $last_value_before_change, true); that said, ok your last true value was...
 807    ##    2) SELECT setval (<sequence_name>, $last_value_before_change+1, false); It is false that your last value was ... so the
 808     ##      next time take the value before this.
 809      ##
 810       ##   The option 1 leave the seq information in a original state except if there aren't any value in the seq, that it is
 811        ##   more as the option 2
 812
 813 ## This test does not set the table sequence value anymore (these methods are deprecated)