lib/CXGN/GEM/ExperimentalDesign.pm

   1
   2 package CXGN::GEM::ExperimentalDesign;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base qw | CXGN::DB::Object |;
   8 use Bio::Chado::Schema;
   9 use CXGN::GEM::Experiment;
  10 use CXGN::GEM::Target;
  11 use CXGN::Biosource::Schema;
  12 use CXGN::Metadata::Metadbdata;
  13
  14 use Carp qw| croak cluck |;
  15
  16
  17 ###############
  18 ### PERLDOC ###
  19 ###############
  20
  21 =head1 NAME
  22
  23 CXGN::GEM::ExperimentalDesign
  24 a class to manipulate a experimental design data from the gem schema.
  25
  26 =cut
  27
  28 our $VERSION = '0.01';
  29 $VERSION = eval $VERSION;
  30
  31 =head1 SYNOPSIS
  32
  33  use CXGN::GEM::ExperimentalDesign;
  34
  35  ## Constructor
  36
  37  my $expdesign = CXGN::GEM::ExperimentalDesign->new($schema, $expdesign_id);
  38
  39  ## Simple accessors
  40
  41  my $expdesign_name = $expdesign->get_experimental_design_name();
  42  $expdesign->set_experimental_design_name($new_name);
  43
  44  ## Extended accessors
  45
  46  my @pub_id_list = $expdesign->get_publication_list();
  47  $expdesign->add_publication($pub_id);
  48
  49  my @dbxref_id_list = $expdesign->get_dbxref_list();
  50  $expdesign->add_dbxref($dbxref_id);
  51
  52  ## Metadata functions (aplicable to extended data as pub or dbxref)
  53
  54  my $metadbdata = $expdesign->get_experimental_design_metadbdata();
  55
  56  if ($expdesign->is_experimental_design_obsolete()) {
  57     ## Do something
  58  }
  59
  60  ## Store functions (aplicable to extended data as pub or dbxref)
  61
  62  $expdesign->store($metadbdata);
  63
  64  $expdesign->obsolete_experimental_design($metadata, 'change to obsolete test');
  65
  66
  67 =head1 DESCRIPTION
  68
  69  This object manage the experimental design information of the database
  70  from the tables:
  71
  72    + gem.ge_experimental_design
  73    + gem.ge_experimental_design_dbxref
  74    + gem.ge_experimental_design_pub
  75
  76  This data is stored inside this object as dbic rows objects with the
  77  following structure:
  78
  79   %ExperimentalDesign_Object = (
  80
  81        ge_expdesign_row        => GeExperimentalDesign_row,
  82
  83        ge_expdesign_dbxref_row => [ @GeExperimentalDesignDbxref_rows],
  84
  85        ge_expdesign_pub_row    => [ @GeExperimentalDesignPub_rows],
  86
  87   );
  88
  89
  90 =head1 AUTHOR
  91
  92 Aureliano Bombarely <ab782@cornell.edu>
  93
  94
  95 =head1 CLASS METHODS
  96
  97 The following class methods are implemented:
  98
  99 =cut
 100
 101
 102 ############################
 103 ### GENERAL CONSTRUCTORS ###
 104 ############################
 105
 106 =head2 constructor new
 107
 108   Usage: my $expdesign = CXGN::GEM::ExperimentalDesign->new($schema,
 109                                                             $expdesign_id);
 110
 111   Desc: Create a new experimentla design object
 112
 113   Ret: a CXGN::GEM::ExperimentalDesign object
 114
 115   Args: a $schema a schema object, preferentially created using:
 116         CXGN::GEM::Schema->connect(
 117                    sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
 118                    %other_parameters );
 119         A $expdesign, a scalar.
 120         If $expdesign_id is omitted, an empty experimental design object is
 121         created.
 122
 123   Side_Effects: accesses the database, check if exists the database columns that
 124                  this object use.  die if the id is not an integer.
 125
 126   Example: my $sample = CXGN::GEM::ExperimentalDesign->new($schema,
 127                                                            $expdesign_id);
 128
 129 =cut
 130
 131 sub new {
 132     my $class = shift;
 133     my $schema = shift ||
 134         croak("PARAMETER ERROR: None schema object was supplied to the $class->new() function.\n");
 135     my $id = shift;
 136
 137     ### First, bless the class to create the object and set the schema into de object
 138     ### (set_schema comes from CXGN::DB::Object).
 139
 140     my $self = $class->SUPER::new($schema);
 141     $self->set_schema($schema);
 142
 143     ### Second, check that ID is an integer. If it is right go and get all the data for
 144     ### this row in the database and after that get the data for expdesign.
 145     ### If don't find any, create an empty oject.
 146     ### If it is not an integer, die
 147
 148     my $expdesign;
 149     my @expdesign_pubs = ();
 150     my @expdesign_dbxrefs = ();
 151
 152     if (defined $id) {
 153         unless ($id =~ m/^\d+$/) {  ## The id can be only an integer... so it is better if we detect this fail before.
 154
 155             croak("\nDATA TYPE ERROR: The experimental_design_id ($id) for $class->new() IS NOT AN INTEGER.\n\n");
 156         }
 157
 158         ## Get the ge_expdesign_row object using a search based in the expdesign_id
 159
 160         ($expdesign) = $schema->resultset('GeExperimentalDesign')
 161                               ->search( { experimental_design_id => $id } );
 162
 163
 164         ## If is not defined the $expdesign (the id does not exist in the db), it will create an empty object
 165
 166         if (defined $expdesign) {
 167
 168             ## Search experimenatl_design_pub associations (ge_experimental_design_pub_row objects) based in the expdesign_id
 169
 170             @expdesign_pubs = $schema->resultset('GeExperimentalDesignPub')
 171                                      ->search( { experimental_design_id => $id } );
 172
 173             ## Search experimental_design_dbxref associations
 174
 175             @expdesign_dbxrefs = $schema->resultset('GeExperimentalDesignDbxref')
 176                                         ->search( { experimental_design_id => $id } );
 177         }
 178         else {
 179             $expdesign = $schema->resultset('GeExperimentalDesign')
 180                                 ->new({});                              ### Create an empty object;
 181         }
 182     }
 183     else {
 184         $expdesign = $schema->resultset('GeExperimentalDesign')
 185                             ->new({});                              ### Create an empty object;
 186     }
 187
 188         ## Finally it will load the rows into the object.
 189         $self->set_geexpdesign_row($expdesign);
 190         $self->set_geexpdesignpub_rows(\@expdesign_pubs);
 191         $self->set_geexpdesigndbxref_rows(\@expdesign_dbxrefs);
 192
 193     return $self;
 194 }
 195
 196 =head2 constructor new_by_name
 197
 198   Usage: my $expdesign = CXGN::GEM::ExperimentalDesign->new_by_name($schema,
 199                                                                     $name);
 200
 201   Desc: Create a new ExperimentalDesign object using experimental_design_name
 202
 203   Ret: a CXGN::GEM::ExperimentalDesign object
 204
 205   Args: a $schema a schema object, preferentially created using:
 206         CXGN::GEM::Schema->connect(
 207                    sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
 208                    %other_parameters );
 209         a $experimental_design_name, a scalar
 210
 211   Side_Effects: accesses the database,
 212                 return a warning if the experimental design name do not exists
 213                 into the db
 214
 215   Example: my $expdesign = CXGN::GEM::ExperimentalDesign->new_by_name( $schema,
 216                                                                        $name  );
 217
 218 =cut
 219
 220 sub new_by_name {
 221     my $class = shift;
 222     my $schema = shift ||
 223         croak("PARAMETER ERROR: None schema object was supplied to the $class->new_by_name() function.\n");
 224     my $name = shift;
 225
 226     ### It will search the experimental_design_id for this name and it will get the experimental_design_id for that using the new
 227     ### method to create a new object. If the name don't exists into the database it will create a empty object and
 228     ### it will set the experimental_design_name for it
 229
 230     my $expdesign;
 231
 232     if (defined $name) {
 233         my ($expdesign_row) = $schema->resultset('GeExperimentalDesign')
 234                                      ->search({ experimental_design_name => $name });
 235
 236         unless (defined $expdesign_row) {
 237
 238             cluck("\nDATABASE OUTPUT WARNING: experimental_design_name ($name) for $class->new_by_name() DON'T EXISTS INTO THE DB.\n" );
 239
 240             ## If do not exists any experimental design with this name, it will return a warning and it will create an empty
 241             ## object with the exprimental design name set in it.
 242
 243             $expdesign = $class->new($schema);
 244             $expdesign->set_experimental_design_name($name);
 245         }
 246         else {
 247
 248             ## if exists it will take the experimental_design_id to create the object with the new constructor
 249             $expdesign = $class->new( $schema, $expdesign_row->get_column('experimental_design_id') );
 250         }
 251     }
 252     else {
 253         $expdesign = $class->new($schema);                              ### Create an empty object;
 254     }
 255
 256     return $expdesign;
 257 }
 258
 259
 260
 261 ##################################
 262 ### DBIX::CLASS ROWS ACCESSORS ###
 263 ##################################
 264
 265 =head2 accessors get_geexpdesign_row, set_geexpdesign_row
 266
 267   Usage: my $geexpdesign_row = $self->get_geexpdesign_row();
 268          $self->set_geexpdesign_row($geexpdesign_row_object);
 269
 270   Desc: Get or set a geexpdesign row object into a experimental
 271         design object
 272
 273   Ret:   Get => $geexpdesign_row_object, a row object
 274                 (CXGN::GEM::Schema::GeExperimentalDesign).
 275          Set => none
 276
 277   Args:  Get => none
 278          Set => $geexpdesign_row_object, a row object
 279                 (CXGN::GEM::Schema::GeExperimentalDesign).
 280
 281   Side_Effects: With set check if the argument is a row object. If fail, dies.
 282
 283   Example: my $geexpdesign_row = $self->get_geexpdesign_row();
 284            $self->set_geexpdesign_row($geexpdesign_row);
 285
 286 =cut
 287
 288 sub get_geexpdesign_row {
 289   my $self = shift;
 290
 291   return $self->{geexpdesign_row};
 292 }
 293
 294 sub set_geexpdesign_row {
 295   my $self = shift;
 296   my $geexpdesign_row = shift
 297       || croak("FUNCTION PARAMETER ERROR: None geexpdesign_row object was supplied for $self->set_geexpdesign_row function.\n");
 298
 299   if (ref($geexpdesign_row) ne 'CXGN::GEM::Schema::GeExperimentalDesign') {
 300       croak("SET ARGUMENT ERROR: $geexpdesign_row isn't a geexpdesign_row obj. (CXGN::GEM::Schema::GeExperimentalDesign).\n");
 301   }
 302   $self->{geexpdesign_row} = $geexpdesign_row;
 303 }
 304
 305
 306
 307 =head2 accessors get_geexpdesignpub_rows, set_geexpdesignpub_rows
 308
 309   Usage: my @geexpdesignpub_rows = $self->get_geexpdesignpub_rows();
 310          $self->set_geexpdesignpub_rows(\@geexpdesignpub_rows);
 311
 312   Desc: Get or set a list of geexpdesignpub rows object into an
 313         experimental design object
 314
 315   Ret:   Get => @geexpdesignpub_row_object, a list of row objects
 316                 (CXGN::GEM::Schema::GeExperimentalDesignPub).
 317          Set => none
 318
 319   Args:  Get => none
 320          Set => \@gexpdesignpub_row_object, an array ref of row objects
 321                 (CXGN::GEM::Schema::GeExperimentalDesignPub).
 322
 323   Side_Effects: With set check if the argument is a row object. If fail, dies.
 324
 325   Example: my @geexpdesignpub_rows = $self->get_geexpdesignpub_rows();
 326            $self->set_geexpdesignpub_rows(\@geexpdesignpub_rows);
 327
 328 =cut
 329
 330 sub get_geexpdesignpub_rows {
 331   my $self = shift;
 332
 333   return @{$self->{geexpdesignpub_rows}};
 334 }
 335
 336 sub set_geexpdesignpub_rows {
 337   my $self = shift;
 338   my $geexpdesignpub_row_aref = shift
 339       || croak("FUNCTION PARAMETER ERROR: None geexpdesignpub_row array ref was supplied for $self->set_geexpdesignpub_rows function.\n");
 340
 341   if (ref($geexpdesignpub_row_aref) ne 'ARRAY') {
 342       croak("SET ARGUMENT ERROR: $geexpdesignpub_row_aref isn't an array reference for $self->set_geexpdesignpub_rows function.\n");
 343   }
 344   else {
 345       foreach my $geexpdesignpub_row (@{$geexpdesignpub_row_aref}) {
 346           if (ref($geexpdesignpub_row) ne 'CXGN::GEM::Schema::GeExperimentalDesignPub') {
 347               croak("SET ARGUMENT ERROR:$geexpdesignpub_row isn't geexpdesignpub_row obj(CXGN::GEM::Schema::GeExperimentalDesignPub).\n");
 348           }
 349       }
 350   }
 351   $self->{geexpdesignpub_rows} = $geexpdesignpub_row_aref;
 352 }
 353
 354
 355 =head2 accessors get_geexpdesigndbxref_rows, set_geexpdesigndbxref_rows
 356
 357   Usage: my @geexpdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
 358          $self->set_geexpdesigndbxref_rows(\@geexpdesigndbxref_rows);
 359
 360   Desc: Get or set a list of geexpdesigndbxref rows object into an
 361         experimental design object
 362
 363   Ret:   Get => @geexpdesigndbxref_row_object, a list of row objects
 364                 (CXGN::GEM::Schema::GeExperimentalDesignDbxref).
 365          Set => none
 366
 367   Args:  Get => none
 368          Set => \@gexpdesigndbxref_row_object, an array ref of row objects
 369                 (CXGN::GEM::Schema::GeExperimentalDesignDbxref).
 370
 371   Side_Effects: With set check if the argument is a row object. If fail, dies.
 372
 373   Example: my @geexpdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
 374            $self->set_geexpdesigndbxref_rows(\@geexpdesigndbxref_rows);
 375
 376 =cut
 377
 378 sub get_geexpdesigndbxref_rows {
 379   my $self = shift;
 380
 381   return @{$self->{geexpdesigndbxref_rows}};
 382 }
 383
 384 sub set_geexpdesigndbxref_rows {
 385   my $self = shift;
 386   my $geexpdesigndbxref_row_aref = shift
 387       || croak("FUNCTION PARAMETER ERROR: None geexpdesigndbxref_row array ref was supplied for $self->set_geexpdesigndbxref_rows().\n");
 388
 389   if (ref($geexpdesigndbxref_row_aref) ne 'ARRAY') {
 390       croak("SET ARGUMENT ERROR: $geexpdesigndbxref_row_aref isn't an array reference for $self->set_geexpdesigndbxref_rows function.\n");
 391   }
 392   else {
 393       foreach my $geexpdesigndbxref_row (@{$geexpdesigndbxref_row_aref}) {
 394           if (ref($geexpdesigndbxref_row) ne 'CXGN::GEM::Schema::GeExperimentalDesignDbxref') {
 395               croak("SET ARGUMENT ERROR:$geexpdesigndbxref_row isn't geexpdesigndbxref_row obj.\n");
 396           }
 397       }
 398   }
 399   $self->{geexpdesigndbxref_rows} = $geexpdesigndbxref_row_aref;
 400 }
 401
 402
 403
 404 ##############################################
 405 ### DATA ACCESSORS FOR EXPERIMENTAL DESIGN ###
 406 ##############################################
 407
 408 =head2 get_experimental_design_id, force_set_experimental_design_id
 409
 410   Usage: my $expdesign_id = $expdesign->get_experimental_design_id();
 411          $expdesign->force_set_experimental_design_id($expdesign_id);
 412
 413   Desc: get or set a experimental_design_id in a experimental design object.
 414         set method should be USED WITH PRECAUTION
 415         If you want set a experimental_design_id that do not exists into the
 416         database you should consider that when you store this object you
 417         CAN STORE a experimental_design_id that do not follow the
 418         gem.ge_experimental_design_experimental_design_id_seq
 419
 420   Ret:  get=> $expdesign_id, a scalar.
 421         set=> none
 422
 423   Args: get=> none
 424         set=> $expdesign_id, a scalar (constraint: it must be an integer)
 425
 426   Side_Effects: none
 427
 428   Example: my $expdesign_id = $expdesign->get_experimental_design_id();
 429
 430 =cut
 431
 432 sub get_experimental_design_id {
 433   my $self = shift;
 434   return $self->get_geexpdesign_row->get_column('experimental_design_id');
 435 }
 436
 437 sub force_set_experimental_design_id {
 438   my $self = shift;
 439   my $data = shift ||
 440       croak("FUNCTION PARAMETER ERROR: None experimental_design_id was supplied for force_set_experimental_design_id function");
 441
 442   unless ($data =~ m/^\d+$/) {
 443       croak("DATA TYPE ERROR: The experimental_design_id ($data) for $self->force_set_experimental_design_id() ISN'T AN INTEGER.\n");
 444   }
 445
 446   $self->get_geexpdesign_row()
 447        ->set_column( experimental_design_id => $data );
 448
 449 }
 450
 451 =head2 accessors get_experimental_design_name, set_experimental_design_name
 452
 453   Usage: my $expdesign_name = $expdesign->get_experimental_design_name();
 454          $expdesign->set_experimental_design_name($expdesign_name);
 455
 456   Desc: Get or set the experimental_design_name from experimental design object.
 457
 458   Ret:  get=> $experimental_design_name, a scalar
 459         set=> none
 460
 461   Args: get=> none
 462         set=> $experimental_design_name, a scalar
 463
 464   Side_Effects: none
 465
 466   Example: my $expdesign_name = $sample->get_experimental_design_name();
 467            $expdesign->set_experimental_design_name($new_name);
 468 =cut
 469
 470 sub get_experimental_design_name {
 471   my $self = shift;
 472   return $self->get_geexpdesign_row->get_column('experimental_design_name');
 473 }
 474
 475 sub set_experimental_design_name {
 476   my $self = shift;
 477   my $data = shift
 478       || croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->set_experimental_design_name function.\n");
 479
 480   $self->get_geexpdesign_row()
 481        ->set_column( experimental_design_name => $data );
 482 }
 483
 484 =head2 accessors get_design_type, set_design_type
 485
 486   Usage: my $expdesign_type = $expdesign->get_design_type();
 487          $expdesign->set_design_type($expdesign_type);
 488
 489   Desc: Get or set design_type from a experimental design object.
 490
 491   Ret:  get=> $expdesign_type, a scalar
 492         set=> none
 493
 494   Args: get=> none
 495         set=> $expdesign_type, a scalar
 496
 497   Side_Effects: none
 498
 499   Example: my $expdesign_type = $expdesign->get_design_type();
 500
 501 =cut
 502
 503 sub get_design_type {
 504   my $self = shift;
 505   return $self->get_geexpdesign_row->get_column('design_type');
 506 }
 507
 508 sub set_design_type {
 509   my $self = shift;
 510   my $data = shift
 511       || croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->set_design_type function.\n");
 512
 513   $self->get_geexpdesign_row()
 514        ->set_column( design_type => $data );
 515 }
 516
 517 =head2 accessors get_description, set_description
 518
 519   Usage: my $description = $expdesign->get_description();
 520          $expdesign->set_description($description);
 521
 522   Desc: Get or set the description from an experimental design object
 523
 524   Ret:  get=> $description, a scalar
 525         set=> none
 526
 527   Args: get=> none
 528         set=> $description, a scalar
 529
 530   Side_Effects: none
 531
 532   Example: my $description = $expdesign->get_description();
 533            $expdesign->set_description($description);
 534 =cut
 535
 536 sub get_description {
 537   my $self = shift;
 538   return $self->get_geexpdesign_row->get_column('description');
 539 }
 540
 541 sub set_description {
 542   my $self = shift;
 543   my $data = shift;
 544
 545   $self->get_geexpdesign_row()
 546        ->set_column( description => $data );
 547 }
 548
 549
 550 ###################################################
 551 ### DATA ACCESSORS FOR EXPERIMENTAL DESIGN PUBS ###
 552 ###################################################
 553
 554 =head2 add_publication
 555
 556   Usage: $expdesign->add_publication($pub_id);
 557
 558   Desc: Add a publication to the pub_ids associated to experimental design
 559         object using different arguments as pub_id, title or dbxref_accession
 560
 561   Ret:  None
 562
 563   Args: $pub_id, a publication id.
 564         To use with $pub_id:
 565           $expdesign->add_publication($pub_id);
 566         To use with $pub_title
 567           $expdesign->add_publication({ title => $pub_title } );
 568         To use with pubmed accession
 569           $expdesign->add_publication({ dbxref_accession => $accesssion});
 570
 571   Side_Effects: die if the parameter is not an object
 572
 573   Example: $expdesign->add_publication($pub_id);
 574
 575 =cut
 576
 577 sub add_publication {
 578     my $self = shift;
 579     my $pub = shift ||
 580         croak("FUNCTION PARAMETER ERROR: None pub was supplied for $self->add_publication function.\n");
 581
 582     my $pub_id;
 583     if ($pub =~ m/^\d+$/) {
 584         $pub_id = $pub;
 585     }
 586     elsif (ref($pub) eq 'HASH') {
 587         my $pub_row;
 588         if (exists $pub->{'title'}) {
 589             ($pub_row) = $self->get_schema()
 590                               ->resultset('Pub::Pub')
 591                               ->search( {title => $pub->{'title'} });
 592         }
 593         elsif (exists $pub->{'dbxref_accession'}) {
 594                 ($pub_row) = $self->get_schema()
 595                               ->resultset('Pub::Pub')
 596                               ->search(
 597                                         { 'dbxref.accession' => $pub->{'dbxref_accession'} },
 598                                         { join => { 'pub_dbxrefs' => 'dbxref' } },
 599                                       );
 600
 601         }
 602
 603         unless (defined $pub_row) {
 604             croak("DATABASE ARGUMENT ERROR: Publication data used as argument for $self->add_publication function don't exists in DB.\n");
 605         }
 606         $pub_id = $pub_row->get_column('pub_id');
 607
 608     }
 609     else {
 610         croak("SET ARGUMENT ERROR: The publication ($pub) isn't a pub_id, or hash with title or dbxref_accession keys.\n");
 611     }
 612     my $expdesignpub_row = $self->get_schema()
 613                                 ->resultset('GeExperimentalDesignPub')
 614                                 ->new({ pub_id => $pub_id});
 615
 616     if (defined $self->get_experimental_design_id() ) {
 617         $expdesignpub_row->set_column( experimental_design_id => $self->get_experimental_design_id() );
 618     }
 619
 620     my @expdesignpub_rows = $self->get_geexpdesignpub_rows();
 621     push @expdesignpub_rows, $expdesignpub_row;
 622     $self->set_geexpdesignpub_rows(\@expdesignpub_rows);
 623 }
 624
 625 =head2 get_publication_list
 626
 627   Usage: my @pub_list = $expdesign->get_publication_list();
 628
 629   Desc: Get a list of publications associated to this experimental design.
 630
 631   Ret: An array of pub_ids by default, but can be titles
 632        or accessions using an argument 'title' or 'dbxref.accession'
 633
 634   Args: None or a column to get.
 635
 636   Side_Effects: die if the parameter is not an object
 637
 638   Example: my @pub_id_list = $expdesign->get_publication_list();
 639            my @pub_title_list = $expdesign->get_publication_list('title');
 640            my @pub_title_accs = $expdesign->get_publication_list('dbxref.accession');
 641
 642
 643 =cut
 644
 645 sub get_publication_list {
 646     my $self = shift;
 647     my $field = shift;
 648
 649     my @pub_list = ();
 650
 651     my @expdesignpub_rows = $self->get_geexpdesignpub_rows();
 652     foreach my $expdesignpub_row (@expdesignpub_rows) {
 653         my $pub_id = $expdesignpub_row->get_column('pub_id');
 654         my ($pub_row) = $self->get_schema()
 655                              ->resultset('Pub::Pub')
 656                              ->search(
 657                                        { 'me.pub_id' => $pub_id },
 658                                        {
 659                                          '+select' => ['dbxref.accession'],
 660                                          '+as'     => ['accession'],
 661                                          join => { 'pub_dbxrefs' => 'dbxref' },
 662                                        }
 663                                      );
 664
 665         if (defined $field) {
 666             push @pub_list, $pub_row->get_column($field);
 667         }
 668         else {
 669             push @pub_list, $pub_row->get_column('pub_id');
 670         }
 671     }
 672
 673     return @pub_list;
 674 }
 675
 676
 677 #####################################################
 678 ### DATA ACCESSORS FOR EXPERIMENTAL DESIGN DBXREF ###
 679 #####################################################
 680
 681 =head2 add_dbxref
 682
 683   Usage: $expdesign->add_dbxref($dbxref_id);
 684
 685   Desc: Add a dbxref to the dbxref_ids associated to experimental design
 686         object using dbxref_id or accesion + database_name
 687
 688   Ret:  None
 689
 690   Args: $dbxref_id, a dbxref id.
 691         To use with accession and dbxname:
 692           $expdesign->add_dbxref(
 693                                    {
 694                                       accession => $accesssion,
 695                                       dbxname   => $dbxname,
 696                                    }
 697                                 );
 698
 699   Side_Effects: die if the parameter is not an hash reference
 700
 701   Example: $expdesign->add_dbxref($dbxref_id);
 702            $expdesign->add_dbxref(
 703                                    {
 704                                       accession => 'GSE3380',
 705                                       dbxname   => 'GEO Accession Display',
 706                                    }
 707                                  );
 708
 709
 710 =cut
 711
 712 sub add_dbxref {
 713     my $self = shift;
 714     my $dbxref = shift ||
 715         croak("FUNCTION PARAMETER ERROR: None dbxref data was supplied for $self->add_dbxref function.\n");
 716
 717     my $dbxref_id;
 718
 719     ## If the imput parameter is an integer, treat it as id, if not do it as hash reference
 720
 721     if ($dbxref =~ m/^\d+$/) {
 722         $dbxref_id = $dbxref;
 723     }
 724     elsif (ref($dbxref) eq 'HASH') {
 725         if (exists $dbxref->{'dbxname'}) {
 726             my ($db_row) = $self->get_schema()
 727                                  ->resultset('General::Db')
 728                                  ->search( { name => $dbxref->{'dbxname'} });
 729             if (defined $db_row) {
 730                 my $db_id = $db_row->get_column('db_id');
 731
 732                 my ($dbxref_row) = $self->get_schema()
 733                                         ->resultset('General::Dbxref')
 734                                         ->search(
 735                                                    {
 736                                                       accession => $dbxref->{'accession'},
 737                                                       db_id     => $db_id,
 738                                                    }
 739                                                 );
 740                 if (defined $dbxref_row) {
 741                     $dbxref_id = $dbxref_row->get_column('dbxref_id');
 742                 }
 743                 else {
 744                     croak("DATABASE ARGUMENT ERROR: accession specified as argument in function $self->add_dbxref dont exists in db.\n");
 745                 }
 746             }
 747             else {
 748                 croak("DATABASE ARGUMENT ERROR: dbxname specified as argument in function $self->add_dbxref dont exists in db.\n");
 749             }
 750         }
 751         else {
 752             croak("INPUT ARGUMENT ERROR: None dbxname was supplied as hash ref. argument in the function $self->add_dbxref.\n ");
 753         }
 754     }
 755     else {
 756         croak("SET ARGUMENT ERROR: The dbxref ($dbxref) isn't a dbxref_id, or hash ref. with accession and dbxname keys.\n");
 757     }
 758
 759     my $expdesigndbxref_row = $self->get_schema()
 760                                    ->resultset('GeExperimentalDesignDbxref')
 761                                    ->new({ dbxref_id => $dbxref_id});
 762
 763     if (defined $self->get_experimental_design_id() ) {
 764         $expdesigndbxref_row->set_column( experimental_design_id => $self->get_experimental_design_id() );
 765     }
 766
 767     my @expdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
 768     push @expdesigndbxref_rows, $expdesigndbxref_row;
 769     $self->set_geexpdesigndbxref_rows(\@expdesigndbxref_rows);
 770 }
 771
 772 =head2 get_dbxref_list
 773
 774   Usage: my @dbxref_id_list = $expdesign->get_dbxref_list();
 775
 776   Desc: Get a list of dbxref_id associated to this experimental design.
 777
 778   Ret: An array of dbxref_id
 779
 780   Args: None or a column to get.
 781
 782   Side_Effects: die if the parameter is not an object
 783
 784   Example: my @dbxref_id_list = $expdesign->get_dbxref_list();
 785
 786 =cut
 787
 788 sub get_dbxref_list {
 789     my $self = shift;
 790
 791     my @dbxref_list = ();
 792
 793     my @expdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
 794     foreach my $expdesigndbxref_row (@expdesigndbxref_rows) {
 795         my $dbxref_id = $expdesigndbxref_row->get_column('dbxref_id');
 796         push @dbxref_list, $dbxref_id;
 797     }
 798
 799     return @dbxref_list;
 800 }
 801
 802
 803 #####################################
 804 ### METADBDATA ASSOCIATED METHODS ###
 805 #####################################
 806
 807 =head2 accessors get_experimental_design_metadbdata
 808
 809   Usage: my $metadbdata = $expdesign->get_experimental_design_metadbdata();
 810
 811   Desc: Get metadata object associated to experimental design data
 812         (see CXGN::Metadata::Metadbdata).
 813
 814   Ret:  A metadbdata object (CXGN::Metadata::Metadbdata)
 815
 816   Args: Optional, a metadbdata object to transfer metadata creation variables
 817
 818   Side_Effects: none
 819
 820   Example: my $metadbdata = $sample->get_experimental_design_metadbdata();
 821            my $metadbdata =
 822               $sample->get_experimental_design_metadbdata($metadbdata);
 823
 824 =cut
 825
 826 sub get_experimental_design_metadbdata {
 827   my $self = shift;
 828   my $metadata_obj_base = shift;
 829
 830   my $metadbdata;
 831   my $metadata_id = $self->get_geexpdesign_row
 832                          ->get_column('metadata_id');
 833
 834   if (defined $metadata_id) {
 835       $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
 836       if (defined $metadata_obj_base) {
 837
 838           ## This will transfer the creation data from the base object to the new one
 839           $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
 840           $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
 841       }
 842   }
 843   else {
 844
 845       ## If do not exists the metadata_id, check the possible reasons.
 846       my $experimental_design_id = $self->get_experimental_design_id();
 847       if (defined $experimental_design_id) {
 848           croak("DATABASE INTEGRITY ERROR: The metadata_id for the experimental_design_id=$experimental_design_id is undefined.\n");
 849       }
 850       else {
 851           croak("OBJECT MANAGEMENT ERROR: Object haven't defined any experimental_design_id. Probably it hasn't been stored yet.\n");
 852       }
 853   }
 854
 855   return $metadbdata;
 856 }
 857
 858 =head2 is_experimental_design_obsolete
 859
 860   Usage: $expdesign->is_experimental_design_obsolete();
 861
 862   Desc: Get obsolete field form metadata object associated to
 863         protocol data (see CXGN::Metadata::Metadbdata).
 864
 865   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
 866
 867   Args: none
 868
 869   Side_Effects: none
 870
 871   Example: unless ($expdesign->is_experimental_design_obsolete()) {
 872                    ## do something
 873            }
 874
 875 =cut
 876
 877 sub is_experimental_design_obsolete {
 878   my $self = shift;
 879
 880   my $metadbdata = $self->get_experimental_design_metadbdata();
 881   my $obsolete = $metadbdata->get_obsolete();
 882
 883   if (defined $obsolete) {
 884       return $obsolete;
 885   }
 886   else {
 887       return 0;
 888   }
 889 }
 890
 891
 892 =head2 accessors get_experimental_design_pub_metadbdata
 893
 894   Usage: my %metadbdata = $expdesign->get_experimental_design_pub_metadbdata();
 895
 896   Desc: Get metadata object associated to tool data
 897         (see CXGN::Metadata::Metadbdata).
 898
 899   Ret:  A hash with keys=pub_id and values=metadbdata object
 900         (CXGN::Metadata::Metadbdata) for pub relation
 901
 902   Args: Optional, a metadbdata object to transfer metadata creation variables
 903
 904   Side_Effects: none
 905
 906   Example: my %metadbdata = $expdesign->get_experimental_design_pub_metadbdata();
 907            my %metadbdata =
 908                  $expdesign->get_experimental_design_pub_metadbdata($metadbdata);
 909
 910 =cut
 911
 912 sub get_experimental_design_pub_metadbdata {
 913   my $self = shift;
 914   my $metadata_obj_base = shift;
 915
 916   my %metadbdata;
 917   my @geexpdesignpub_rows = $self->get_geexpdesignpub_rows();
 918
 919   foreach my $geexpdesignpub_row (@geexpdesignpub_rows) {
 920       my $pub_id = $geexpdesignpub_row->get_column('pub_id');
 921       my $metadata_id = $geexpdesignpub_row->get_column('metadata_id');
 922
 923       if (defined $metadata_id) {
 924           my $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
 925           if (defined $metadata_obj_base) {
 926
 927               ## This will transfer the creation data from the base object to the new one
 928               $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
 929               $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
 930           }
 931           $metadbdata{$pub_id} = $metadbdata;
 932       }
 933       else {
 934           my $expdesign_pub_id = $geexpdesignpub_row->get_column('experimental_design_pub_id');
 935           unless (defined $expdesign_pub_id) {
 936               croak("OBJECT MANIPULATION ERROR: Object $self haven't any experimental_design_pub_id. Probably it hasn't been stored\n");
 937           }
 938           else {
 939               croak("DATABASE INTEGRITY ERROR: The metadata_id for the experimental_design_pub_id=$expdesign_pub_id is undefined.\n");
 940           }
 941       }
 942   }
 943   return %metadbdata;
 944 }
 945
 946 =head2 is_experimental_design_pub_obsolete
 947
 948   Usage: $expdesign->is_experimental_design_pub_obsolete($pub_id);
 949
 950   Desc: Get obsolete field form metadata object associated to
 951         protocol data (see CXGN::Metadata::Metadbdata).
 952
 953   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
 954
 955   Args: $pub_id, a publication_id
 956
 957   Side_Effects: none
 958
 959   Example: unless ( $expdesign->is_experimental_design_pub_obsolete($pub_id) ) {
 960                 ## do something
 961            }
 962
 963 =cut
 964
 965 sub is_experimental_design_pub_obsolete {
 966   my $self = shift;
 967   my $pub_id = shift;
 968
 969   my %metadbdata = $self->get_experimental_design_pub_metadbdata();
 970   my $metadbdata = $metadbdata{$pub_id};
 971
 972   my $obsolete = 0;
 973   if (defined $metadbdata) {
 974       $obsolete = $metadbdata->get_obsolete() || 0;
 975   }
 976   return $obsolete;
 977 }
 978
 979
 980 =head2 accessors get_experimental_design_dbxref_metadbdata
 981
 982   Usage: my %metadbdata =
 983             $expdesign->get_experimental_design_dbxref_metadbdata();
 984
 985   Desc: Get metadata object associated to tool data
 986         (see CXGN::Metadata::Metadbdata).
 987
 988   Ret:  A hash with keys=dbxref_id and values=metadbdata object
 989         (CXGN::Metadata::Metadbdata) for pub relation
 990
 991   Args: Optional, a metadbdata object to transfer metadata creation variables
 992
 993   Side_Effects: none
 994
 995   Example: my %metadbdata =
 996               $expdesign->get_experimental_design_dbxref_metadbdata();
 997            my %metadbdata =
 998               $expdesign->get_experimental_design_dbxref_metadbdata($metadbdata);
 999
1000 =cut
1001
1002 sub get_experimental_design_dbxref_metadbdata {
1003   my $self = shift;
1004   my $metadata_obj_base = shift;
1005
1006   my %metadbdata;
1007   my @geexpdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
1008
1009   foreach my $geexpdesigndbxref_row (@geexpdesigndbxref_rows) {
1010       my $dbxref_id = $geexpdesigndbxref_row->get_column('dbxref_id');
1011       my $metadata_id = $geexpdesigndbxref_row->get_column('metadata_id');
1012
1013       if (defined $metadata_id) {
1014           my $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
1015           if (defined $metadata_obj_base) {
1016
1017               ## This will transfer the creation data from the base object to the new one
1018               $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
1019               $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
1020           }
1021           $metadbdata{$dbxref_id} = $metadbdata;
1022       }
1023       else {
1024           my $expdesign_dbxref_id = $geexpdesigndbxref_row->get_column('experimental_design_dbxref_id');
1025           unless (defined $expdesign_dbxref_id) {
1026               croak("OBJECT MANIPULATION ERROR: Object $self haven't any experimental_design_dbxref_id.Probably it hasn't been stored\n");
1027           }
1028           else {
1029               croak("DATABASE INTEGRITY ERROR: metadata_id for the experimental_design_dbxref_id=$expdesign_dbxref_id is undefined.\n");
1030           }
1031       }
1032   }
1033   return %metadbdata;
1034 }
1035
1036 =head2 is_experimental_design_dbxref_obsolete
1037
1038   Usage: $expdesign->is_experimental_design_dbxref_obsolete($dbxref_id);
1039
1040   Desc: Get obsolete field form metadata object associated to
1041         protocol data (see CXGN::Metadata::Metadbdata).
1042
1043   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
1044
1045   Args: $dbxref_id, a dbxref_id
1046
1047   Side_Effects: none
1048
1049   Example: unless ($expdesign->is_experimental_design_dbxref_obsolete($dbxref_id)){
1050                 ## do something
1051            }
1052
1053 =cut
1054
1055 sub is_experimental_design_dbxref_obsolete {
1056   my $self = shift;
1057   my $dbxref_id = shift;
1058
1059   my %metadbdata = $self->get_experimental_design_dbxref_metadbdata();
1060   my $metadbdata = $metadbdata{$dbxref_id};
1061
1062   my $obsolete = 0;
1063   if (defined $metadbdata) {
1064       $obsolete = $metadbdata->get_obsolete() || 0;
1065   }
1066   return $obsolete;
1067 }
1068
1069
1070
1071 #######################
1072 ### STORING METHODS ###
1073 #######################
1074
1075
1076 =head2 store
1077
1078   Usage: $expdesign->store($metadbdata);
1079
1080   Desc: Store in the database the all experimental design data for the
1081         experimental design object.
1082         See the methods store_experimental_design, store_pub_associations
1083         and store_dbxref_associations for more details
1084
1085   Ret: None
1086
1087   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1088
1089   Side_Effects: Die if:
1090                 1- None metadata object is supplied.
1091                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1092                    object
1093
1094   Example: $expdesign->store($metadata);
1095
1096 =cut
1097
1098 sub store {
1099     my $self = shift;
1100
1101     ## FIRST, check the metadata_id supplied as parameter
1102     my $metadata = shift
1103         || croak("STORE ERROR: None metadbdata object was supplied to $self->store().\n");
1104
1105     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1106         croak("STORE ERROR: Metadbdata supplied to $self->store() is not CXGN::Metadata::Metadbdata object.\n");
1107     }
1108
1109     ## SECOND, the store functions return the updated object, so it will chain the different store functions
1110
1111     $self->store_experimental_design($metadata);
1112     $self->store_pub_associations($metadata);
1113     $self->store_dbxref_associations($metadata);
1114 }
1115
1116
1117
1118 =head2 store_experimental_design
1119
1120   Usage: $expdesign->store_experimental_design($metadata);
1121
1122   Desc: Store in the database the experimental data for the experimental
1123         design object (Only the geexpdesign row, don't store any
1124         experimental_design_pub or experimental_design_dbxref data)
1125
1126   Ret: None
1127
1128   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1129
1130   Side_Effects: Die if:
1131                 1- None metadata object is supplied.
1132                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1133                    object
1134
1135   Example: $expdesign->store_experimental_design($metadata);
1136
1137 =cut
1138
1139 sub store_experimental_design {
1140     my $self = shift;
1141
1142     ## FIRST, check the metadata_id supplied as parameter
1143     my $metadata = shift
1144         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_experimental_design().\n");
1145
1146     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1147         croak("STORE ERROR: Metadbdata supplied to $self->store_experimental_design() is not CXGN::Metadata::Metadbdata object.\n");
1148     }
1149
1150     ## It is not necessary check the current user used to store the data because should be the same than the used
1151     ## to create a metadata_id. In the medadbdata object, it is checked.
1152
1153     ## SECOND, check if exists or not experimental_design_id.
1154     ##   if exists experimental_design_id         => update
1155     ##   if do not exists experimental_design_id  => insert
1156
1157     my $geexpdesign_row = $self->get_geexpdesign_row();
1158     my $expdesign_id = $geexpdesign_row->get_column('experimental_design_id');
1159
1160     unless (defined $expdesign_id) {                                   ## NEW INSERT and DISCARD CHANGES
1161
1162         my $metadata_id = $metadata->store()
1163                                    ->get_metadata_id();
1164
1165         $geexpdesign_row->set_column( metadata_id => $metadata_id );   ## Set the metadata_id column
1166
1167         $geexpdesign_row->insert()
1168                         ->discard_changes();                           ## It will set the row with the updated row
1169
1170         ## Now we set the experimental_design_id value for all the rows that depends of it
1171
1172         my @geexpdesignpub_rows = $self->get_geexpdesignpub_rows();
1173         foreach my $geexpdesignpub_row (@geexpdesignpub_rows) {
1174             $geexpdesignpub_row->set_column( experimental_design_id => $geexpdesign_row->get_column('experimental_design_id'));
1175         }
1176
1177         my @geexpdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
1178         foreach my $geexpdesigndbxref_row (@geexpdesigndbxref_rows) {
1179             $geexpdesigndbxref_row->set_column( experimental_design_id => $geexpdesign_row->get_column('experimental_design_id'));
1180         }
1181
1182
1183     }
1184     else {                                                            ## UPDATE IF SOMETHING has change
1185
1186         my @columns_changed = $geexpdesign_row->is_changed();
1187
1188         if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1189
1190             my @modification_note_list;                             ## the changes and the old metadata object for
1191             foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1192                 push @modification_note_list, "set value in $col_changed column";
1193             }
1194
1195             my $modification_note = join ', ', @modification_note_list;
1196
1197             my $mod_metadata_id = $self->get_experimental_design_metadbdata($metadata)
1198                                        ->store({ modification_note => $modification_note })
1199                                        ->get_metadata_id();
1200
1201             $geexpdesign_row->set_column( metadata_id => $mod_metadata_id );
1202
1203             $geexpdesign_row->update()
1204                             ->discard_changes();
1205         }
1206     }
1207 }
1208
1209
1210 =head2 obsolete_experimental_design
1211
1212   Usage: $expdesign->obsolete_experimental_design($metadata, $note, 'REVERT');
1213
1214   Desc: Change the status of a data to obsolete.
1215         If revert tag is used the obsolete status will be reverted to 0 (false)
1216
1217   Ret: None
1218
1219   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1220         $note, a note to explain the cause of make this data obsolete
1221         optional, 'REVERT'.
1222
1223   Side_Effects: Die if:
1224                 1- None metadata object is supplied.
1225                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1226
1227   Example: $expdesign->obsolete_experimental_design($metadata, 'change to obsolete test');
1228
1229 =cut
1230
1231 sub obsolete_experimental_design {
1232     my $self = shift;
1233
1234     ## FIRST, check the metadata_id supplied as parameter
1235
1236     my $metadata = shift
1237         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_experimental_design().\n");
1238
1239     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1240         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_experimental_design isn't CXGN::Metadata::Metadbdata obj.\n");
1241     }
1242
1243     my $obsolete_note = shift
1244         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_experimental_design().\n");
1245
1246     my $revert_tag = shift;
1247
1248
1249     ## If exists the tag revert change obsolete to 0
1250
1251     my $obsolete = 1;
1252     my $modification_note = 'change to obsolete';
1253     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1254         $obsolete = 0;
1255         $modification_note = 'revert obsolete';
1256     }
1257
1258     ## Create a new metadata with the obsolete tag
1259
1260     my $mod_metadata_id = $self->get_experimental_design_metadbdata($metadata)
1261                                ->store( { modification_note => $modification_note,
1262                                           obsolete          => $obsolete,
1263                                           obsolete_note     => $obsolete_note } )
1264                                ->get_metadata_id();
1265
1266     ## Modify the group row in the database
1267
1268     my $geexpdesign_row = $self->get_geexpdesign_row();
1269
1270     $geexpdesign_row->set_column( metadata_id => $mod_metadata_id );
1271
1272     $geexpdesign_row->update()
1273                     ->discard_changes();
1274 }
1275
1276
1277 =head2 store_pub_associations
1278
1279   Usage: $expdesign->store_pub_associations($metadata);
1280
1281   Desc: Store in the database the pub association for the experimental design
1282         object
1283
1284   Ret: None
1285
1286   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1287
1288   Side_Effects: Die if:
1289                 1- None metadata object is supplied.
1290                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1291                    object
1292
1293   Example: $expdesign->store_pub_associations($metadata);
1294
1295 =cut
1296
1297 sub store_pub_associations {
1298     my $self = shift;
1299
1300     ## FIRST, check the metadata_id supplied as parameter
1301     my $metadata = shift
1302         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_pub_associations().\n");
1303
1304     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1305         croak("STORE ERROR: Metadbdata supplied to $self->store_pub_associations() is not CXGN::Metadata::Metadbdata object.\n");
1306     }
1307
1308     ## It is not necessary check the current user used to store the data because should be the same than the used
1309     ## to create a metadata_id. In the medadbdata object, it is checked.
1310
1311     ## SECOND, check if exists or not experimental_design_pub_id.
1312     ##   if exists experimental_design_pub_id         => update
1313     ##   if do not exists experimental_design_pub_id  => insert
1314
1315     my @geexpdesignpub_rows = $self->get_geexpdesignpub_rows();
1316
1317     foreach my $geexpdesignpub_row (@geexpdesignpub_rows) {
1318
1319         my $expdesign_pub_id = $geexpdesignpub_row->get_column('experimental_design_pub_id');
1320         my $pub_id = $geexpdesignpub_row->get_column('pub_id');
1321
1322         unless (defined $expdesign_pub_id) {                                ## NEW INSERT and DISCARD CHANGES
1323
1324             my $metadata_id = $metadata->store()
1325                                        ->get_metadata_id();
1326
1327             $geexpdesignpub_row->set_column( metadata_id => $metadata_id );    ## Set the metadata_id column
1328
1329             $geexpdesignpub_row->insert()
1330                                ->discard_changes();                            ## It will set the row with the updated row
1331
1332         }
1333         else {                                                                 ## UPDATE IF SOMETHING has change
1334
1335             my @columns_changed = $geexpdesignpub_row->is_changed();
1336
1337             if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1338
1339                 my @modification_note_list;                             ## the changes and the old metadata object for
1340                 foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1341                     push @modification_note_list, "set value in $col_changed column";
1342                 }
1343
1344                 my $modification_note = join ', ', @modification_note_list;
1345
1346                 my %aspub_metadata = $self->get_experimental_design_pub_metadbdata($metadata);
1347                 my $mod_metadata_id = $aspub_metadata{$pub_id}->store({ modification_note => $modification_note })
1348                                                               ->get_metadata_id();
1349
1350                 $geexpdesignpub_row->set_column( metadata_id => $mod_metadata_id );
1351
1352                 $geexpdesignpub_row->update()
1353                                    ->discard_changes();
1354             }
1355         }
1356     }
1357 }
1358
1359 =head2 obsolete_pub_association
1360
1361   Usage: $expdesign->obsolete_pub_association($metadata, $note, $pub_id, 'REVERT');
1362
1363   Desc: Change the status of a data to obsolete.
1364         If revert tag is used the obsolete status will be reverted to 0 (false)
1365
1366   Ret: None
1367
1368   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1369         $note, a note to explain the cause of make this data obsolete
1370         $pub_id, a publication id associated to this tool
1371         optional, 'REVERT'.
1372
1373   Side_Effects: Die if:
1374                 1- None metadata object is supplied.
1375                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1376
1377   Example: $expdesign->obsolete_pub_association($metadata,
1378                                                 'change to obsolete test',
1379                                                 $pub_id );
1380
1381 =cut
1382
1383 sub obsolete_pub_association {
1384     my $self = shift;
1385
1386     ## FIRST, check the metadata_id supplied as parameter
1387
1388     my $metadata = shift
1389         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_pub_association().\n");
1390
1391     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1392         croak("OBSOLETE ERROR: Metadbdata object supplied to $self->obsolete_pub_association is not CXGN::Metadata::Metadbdata obj.\n");
1393     }
1394
1395     my $obsolete_note = shift
1396         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_pub_association().\n");
1397
1398     my $pub_id = shift
1399         || croak("OBSOLETE ERROR: None pub_id was supplied to $self->obsolete_pub_association().\n");
1400
1401     my $revert_tag = shift;
1402
1403
1404     ## If exists the tag revert change obsolete to 0
1405
1406     my $obsolete = 1;
1407     my $modification_note = 'change to obsolete';
1408     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1409         $obsolete = 0;
1410         $modification_note = 'revert obsolete';
1411     }
1412
1413     ## Create a new metadata with the obsolete tag
1414
1415     my %aspub_metadata = $self->get_experimental_design_pub_metadbdata($metadata);
1416     my $mod_metadata_id = $aspub_metadata{$pub_id}->store( { modification_note => $modification_note,
1417                                                              obsolete          => $obsolete,
1418                                                              obsolete_note     => $obsolete_note } )
1419                                                   ->get_metadata_id();
1420
1421     ## Modify the group row in the database
1422
1423     my @geexpdesignpub_rows = $self->get_geexpdesignpub_rows();
1424     foreach my $geexpdesignpub_row (@geexpdesignpub_rows) {
1425         if ($geexpdesignpub_row->get_column('pub_id') == $pub_id) {
1426
1427             $geexpdesignpub_row->set_column( metadata_id => $mod_metadata_id );
1428
1429             $geexpdesignpub_row->update()
1430                                ->discard_changes();
1431         }
1432     }
1433 }
1434
1435
1436 =head2 store_dbxref_associations
1437
1438   Usage: $expdesign->store_dbxref_associations($metadata);
1439
1440   Desc: Store in the database the dbxref association for the experimental design
1441         object
1442
1443   Ret: None
1444
1445   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1446
1447   Side_Effects: Die if:
1448                 1- None metadata object is supplied.
1449                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1450                    object
1451
1452   Example: $expdesign->store_dbxref_associations($metadata);
1453
1454 =cut
1455
1456 sub store_dbxref_associations {
1457     my $self = shift;
1458
1459     ## FIRST, check the metadata_id supplied as parameter
1460     my $metadata = shift
1461         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_dbxref_associations().\n");
1462
1463     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1464         croak("STORE ERROR: Metadbdata supplied to $self->store_dbxref_associations() is not CXGN::Metadata::Metadbdata object.\n");
1465     }
1466
1467     ## It is not necessary check the current user used to store the data because should be the same than the used
1468     ## to create a metadata_id. In the medadbdata object, it is checked.
1469
1470     ## SECOND, check if exists or not experimental_design_dbxref_id.
1471     ##   if exists experimental_design_dbxref_id         => update
1472     ##   if do not exists experimental_design_dbxref_id  => insert
1473
1474     my @geexpdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
1475
1476     foreach my $geexpdesigndbxref_row (@geexpdesigndbxref_rows) {
1477
1478         my $expdesign_dbxref_id = $geexpdesigndbxref_row->get_column('experimental_design_dbxref_id');
1479         my $dbxref_id = $geexpdesigndbxref_row->get_column('dbxref_id');
1480
1481         unless (defined $expdesign_dbxref_id) {                                ## NEW INSERT and DISCARD CHANGES
1482
1483             my $metadata_id = $metadata->store()
1484                                        ->get_metadata_id();
1485
1486             $geexpdesigndbxref_row->set_column( metadata_id => $metadata_id );    ## Set the metadata_id column
1487
1488             $geexpdesigndbxref_row->insert()
1489                                   ->discard_changes();                            ## It will set the row with the updated row
1490
1491         }
1492         else {                                                                    ## UPDATE IF SOMETHING has change
1493
1494             my @columns_changed = $geexpdesigndbxref_row->is_changed();
1495
1496             if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1497
1498                 my @modification_note_list;                             ## the changes and the old metadata object for
1499                 foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1500                     push @modification_note_list, "set value in $col_changed column";
1501                 }
1502
1503                 my $modification_note = join ', ', @modification_note_list;
1504
1505                 my %asdbxref_metadata = $self->get_experimental_design_dbxref_metadbdata($metadata);
1506                 my $mod_metadata_id = $asdbxref_metadata{$dbxref_id}->store({ modification_note => $modification_note })
1507                                                                     ->get_metadata_id();
1508
1509                 $geexpdesigndbxref_row->set_column( metadata_id => $mod_metadata_id );
1510
1511                 $geexpdesigndbxref_row->update()
1512                                    ->discard_changes();
1513             }
1514         }
1515     }
1516 }
1517
1518 =head2 obsolete_dbxref_association
1519
1520   Usage: $expdesign->obsolete_dbxref_association($metadata, $note, $dbxref_id, 'REVERT');
1521
1522   Desc: Change the status of a data to obsolete.
1523         If revert tag is used the obsolete status will be reverted to 0 (false)
1524
1525   Ret: None
1526
1527   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1528         $note, a note to explain the cause of make this data obsolete
1529         $dbxref_id, a dbxref id
1530         optional, 'REVERT'.
1531
1532   Side_Effects: Die if:
1533                 1- None metadata object is supplied.
1534                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1535
1536   Example: $expdesign->obsolete_dbxref_association($metadata,
1537                                                 'change to obsolete test',
1538                                                 $dbxref_id );
1539
1540 =cut
1541
1542 sub obsolete_dbxref_association {
1543     my $self = shift;
1544
1545     ## FIRST, check the metadata_id supplied as parameter
1546
1547     my $metadata = shift
1548         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_dbxref_association().\n");
1549
1550     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1551         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_dbxref_association is not CXGN::Metadata::Metadbdata obj.\n");
1552     }
1553
1554     my $obsolete_note = shift
1555         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_dbxref_association().\n");
1556
1557     my $dbxref_id = shift
1558         || croak("OBSOLETE ERROR: None dbxref_id was supplied to $self->obsolete_dbxref_association().\n");
1559
1560     my $revert_tag = shift;
1561
1562
1563     ## If exists the tag revert change obsolete to 0
1564
1565     my $obsolete = 1;
1566     my $modification_note = 'change to obsolete';
1567     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1568         $obsolete = 0;
1569         $modification_note = 'revert obsolete';
1570     }
1571
1572     ## Create a new metadata with the obsolete tag
1573
1574     my %asdbxref_metadata = $self->get_experimental_design_dbxref_metadbdata($metadata);
1575     my $mod_metadata_id = $asdbxref_metadata{$dbxref_id}->store( { modification_note => $modification_note,
1576                                                                    obsolete          => $obsolete,
1577                                                                    obsolete_note     => $obsolete_note } )
1578                                                         ->get_metadata_id();
1579
1580     ## Modify the group row in the database
1581
1582     my @geexpdesigndbxref_rows = $self->get_geexpdesigndbxref_rows();
1583     foreach my $geexpdesigndbxref_row (@geexpdesigndbxref_rows) {
1584         if ($geexpdesigndbxref_row->get_column('dbxref_id') == $dbxref_id) {
1585
1586             $geexpdesigndbxref_row->set_column( metadata_id => $mod_metadata_id );
1587
1588             $geexpdesigndbxref_row->update()
1589                                   ->discard_changes();
1590         }
1591     }
1592 }
1593
1594 #####################
1595 ### OTHER METHODS ###
1596 #####################
1597
1598
1599 =head2 get_experiment_list
1600
1601   Usage: my @experiments = $expdesign->get_experiment_list();
1602
1603   Desc: Get a list of CXGN::GEM::Experiment objects.
1604
1605   Ret:  An array with a list of CXGN::GEM::Experiment objects.
1606
1607   Args: none
1608
1609   Side_Effects: die if the experiment_design_object have not any
1610                 experimental_design_id
1611
1612   Example: my @experiments = $expdesign->get_experiment_list();
1613
1614 =cut
1615
1616 sub get_experiment_list {
1617    my $self = shift;
1618
1619    my @experiments = ();
1620
1621    my $experimental_design_id = $self->get_experimental_design_id();
1622
1623    unless (defined $experimental_design_id) {
1624        croak("OBJECT MANIPULATION ERROR: The $self object haven't any experimental_design_id. Probably it hasn't store yet.\n");
1625    }
1626
1627    my @exp_rows = $self->get_schema()
1628                        ->resultset('GeExperiment')
1629                        ->search( { experimental_design_id => $experimental_design_id } );
1630
1631    foreach my $exp_row (@exp_rows) {
1632        my $experiment = CXGN::GEM::Experiment->new($self->get_schema(), $exp_row->get_column('experiment_id'));
1633
1634        push @experiments, $experiment;
1635    }
1636
1637    return @experiments;
1638 }
1639
1640
1641 =head2 get_po_sorted_experiment_list
1642
1643   Usage: my @experiments = $expdesign->get_po_sorted_experiment_list();
1644
1645   Desc: Get a list of CXGN::GEM::Experiment objects, ordered by its PO
1646
1647   Ret:  An array with a list of CXGN::GEM::Experiment objects.
1648
1649   Args: none
1650
1651   Side_Effects: die if the experiment_design_object have not any
1652                 experimental_design_id
1653
1654   Example: my @experiments = $expdesign->get_experiment_list();
1655
1656 =cut
1657
1658 sub get_po_sorted_experiment_list {
1659    my $self = shift;
1660
1661    my @experiments_sorted = ();
1662    my @experiments = $self->get_experiment_list();
1663
1664    ## Define the PO Root accessions (they will be used to define the
1665    ## shortest path and to sepparate PO in structure or develop based
1666    ## in its path)
1667
1668    my $po_structure_root = 'PO:0009011';
1669    my $po_development_root = 'PO:0009012';
1670
1671    ## First, transfer the PO annotations from sample to experiments
1672
1673    ## Define the hash that will contain the paths
1674
1675    my %experiment_objs = ();
1676    my %default_experiment_objs = ();
1677    my %exp_structure_popath = ();
1678    my %exp_develop_popath = ();
1679    my %str_popath_count = ();
1680    my %dev_popath_count = ();
1681
1682    foreach my $exp (@experiments) {
1683
1684        my %exp_po = ();
1685        my @targets = $exp->get_target_list();
1686        my $experiment_id = $exp->get_experiment_id();
1687
1688        ## Store the experiment objects in a hash with key=experiment_id
1689        ## to access to them faster after the order
1690
1691        my $exp_name = $exp->get_experiment_name();
1692        $experiment_objs{$experiment_id} = $exp;
1693
1694        ## Store the names to sort alphabetically by default if none dbxref is associated
1695        ## with the experiments of this expdesign
1696        $default_experiment_objs{$exp_name} = $exp;
1697
1698
1699        foreach my $target (@targets) {
1700
1701            my $target_name = $target->get_target_name();
1702            my @samples = $target->get_sample_list();
1703
1704            foreach my $sample (@samples) {
1705
1706                my $sample_name = $sample->get_sample_name();
1707                my %dbxref_po = $sample->get_dbxref_related('PO');
1708
1709                foreach my $dbxref_id (keys %dbxref_po) {
1710                    unless (exists $exp_po{$dbxref_id}) {
1711                        $exp_po{$dbxref_id} = $dbxref_po{$dbxref_id};
1712                    }
1713                }
1714            }
1715        }
1716
1717        ## Now it will take the path as PO:XXXXXXXX from each cvterm (PO)
1718        ## (It will use PO:XXXXXX instead cvterm_id to be able to have the same
1719        ## order independently from the cvterm load in the database).
1720        ## The last element will be always the cvterm.name, so after the path
1721        ## it will be orther by name
1722
1723        foreach my $dbxrefid (keys %exp_po) {
1724
1725            ## Define the path
1726
1727            my @path;
1728
1729            my $cvterm_id = $exp_po{$dbxrefid}->{'cvterm.cvterm_id'};
1730            my $complete_accession = $exp_po{$dbxrefid}->{'db.name'} . ':' . $exp_po{$dbxrefid}->{'dbxref.accession'};
1731
1732            ## Last element in the path (first element to be added) will be the cvterm.name
1733
1734            push @path, $exp_po{$dbxrefid}->{'cvterm.name'};
1735
1736            ## It will take the path for that cvterm (only parents... so pathdistance > 0)
1737
1738            my @cvtermpath_rows = $self->get_schema()
1739                                       ->resultset('Cv::Cvtermpath')
1740                                       ->search(
1741                                                 { subject_id => $cvterm_id, pathdistance => { '>', 0 }  },
1742                                                 { order_by => 'pathdistance',  }
1743                                               );
1744
1745            ## This will get all the path for this cvterm, they are redundant so
1746            ## it will remove this redundancy using a hash
1747
1748            my %parent_po_terms = ();
1749
1750            foreach my $cvtermpath_row (@cvtermpath_rows) {
1751
1752                my $parent_cvterm_id = $cvtermpath_row->get_column('object_id');
1753                my $parent_distance = $cvtermpath_row->get_column('pathdistance');
1754
1755                my ($parent_cvterm_row) = $self->get_schema()
1756                                               ->resultset('Cv::Cvterm')
1757                                               ->search({'cvterm_id' => $parent_cvterm_id});
1758
1759                my ($dbxref_row) = $self->get_schema()
1760                                               ->resultset('General::Dbxref')
1761                                               ->search({'dbxref_id' => $parent_cvterm_row->get_column('dbxref_id')});
1762
1763                my ($db_row) = $self->get_schema()
1764                                    ->resultset('General::Db')
1765                                    ->search({'db_id' => $dbxref_row->get_column('db_id')});
1766
1767                ## Now it will add the po_terms from closest to farest... in the array the first element will be the root
1768                ## (the farest parent po term)
1769
1770                if (defined $dbxref_row && defined $db_row) {
1771
1772                    my $po_term = $db_row->get_column('name') . ':' . $dbxref_row->get_column('accession');
1773                    unless (exists $parent_po_terms{$po_term}) {
1774
1775                        ## The last po_term added should be the roots 'PO:0009011' or 'PO:0009012'
1776
1777                        my $last = 0;
1778                        if (defined $path[0]) {
1779                            if ($path[0] eq $po_structure_root) {
1780                                $last = 1;
1781                            }
1782                            elsif ($path[0] eq $po_development_root) {
1783                                $last = 1;
1784                            }
1785                        }
1786
1787                        if ($last == 0) {
1788                            unshift @path, $po_term;
1789                        }
1790
1791                        $parent_po_terms{$po_term} = $parent_distance;
1792                    }
1793                }
1794            }
1795
1796            ## Now it will add the path to two different hashes, po_structure and po_development, corresponding with the two
1797            ## different roots for po terms ()
1798
1799            ## Each parent-root will be $path[0]
1800            ## Define the po_path, and store the count for each po_path. Later, if some po_path_count (by structure) > 0
1801            ## it will take a secondary order (by development)
1802
1803            my $po_path = join(',', @path);
1804
1805            if ($path[0] eq $po_structure_root) { ## That means 'plant structure'
1806                unless (exists $exp_structure_popath{$experiment_id}) {
1807                    $exp_structure_popath{$experiment_id} = $po_path;
1808                    unless (exists $str_popath_count{$po_path}) {
1809                        $str_popath_count{$po_path} = 1;
1810                    }
1811                    else {
1812                        $str_popath_count{$po_path}++;
1813                    }
1814                }
1815            }
1816            elsif ($path[0] eq $po_development_root) { ## That means 'plant growth and development stages'
1817                unless (exists $exp_develop_popath{$experiment_id}) {
1818                    $exp_develop_popath{$experiment_id} = $po_path;
1819                    unless (exists $dev_popath_count{$po_path}) {
1820                        $dev_popath_count{$po_path} = 1;
1821                    }
1822                    else {
1823                        $dev_popath_count{$po_path}++;
1824                    }
1825                }
1826            }
1827        }
1828    }
1829
1830    ## Now it will take all the experiments from the object
1831
1832    my %exp_combined_po;
1833
1834    foreach my $exp_id (keys %experiment_objs) {
1835        my $exp_str_po = $exp_structure_popath{$exp_id} || 'Z';
1836        my $exp_dev_po = $exp_develop_popath{$exp_id} || 'Z';
1837
1838        $exp_combined_po{$exp_id} = $exp_str_po . '-' . $exp_dev_po . '-' . $experiment_objs{$exp_id}->get_experiment_name();
1839    }
1840
1841    ## Finally it will be sorted by the values in the exp_combined_po... if there are some dbxref associated with these
1842    ## experiments, if not, return a list sorted by default by alphabetical name
1843
1844    if (scalar(keys %exp_structure_popath) > 0 && scalar(keys %exp_develop_popath) > 0) {
1845        foreach my $sort_exp_id (sort {$exp_combined_po{$a} cmp $exp_combined_po{$b}} keys %exp_combined_po) {
1846            push @experiments_sorted, $experiment_objs{$sort_exp_id};
1847        }
1848    }
1849    else {
1850        foreach my $experim_name (sort keys %default_experiment_objs) {
1851            push @experiments_sorted, $default_experiment_objs{$experim_name};
1852        }
1853    }
1854
1855    return @experiments_sorted;
1856 }
1857
1858 =head2 get_target_list
1859
1860   Usage: my @targets = $expdesign->get_target_list();
1861
1862   Desc: Get a list of CXGN::GEM::Target objects.
1863
1864   Ret:  An array with a list of CXGN::GEM::Target objects.
1865
1866   Args: none
1867
1868   Side_Effects: die if the experiment_design_object have not any
1869                 experimental_design_id
1870
1871   Example: my @targets = $expdesign->get_target_list();
1872
1873 =cut
1874
1875 sub get_target_list {
1876    my $self = shift;
1877
1878    my @targets = ();
1879
1880    my $experimental_design_id = $self->get_experimental_design_id();
1881
1882    unless (defined $experimental_design_id) {
1883        croak("OBJECT MANIPULATION ERROR: The $self object haven't any experimental_design_id. Probably it hasn't store yet.\n");
1884    }
1885
1886    my @exp_rows = $self->get_schema()
1887                        ->resultset('GeExperiment')
1888                        ->search( { experimental_design_id => $experimental_design_id } );
1889
1890    foreach my $exp_row (@exp_rows) {
1891        my $experiment_id = $exp_row->get_column('experiment_id');
1892
1893        my @target_rows = $self->get_schema()
1894                        ->resultset('GeTarget')
1895                        ->search( { experiment_id => $experiment_id } );
1896
1897        foreach my $target_row (@target_rows) {
1898            my $target = CXGN::GEM::Target->new($self->get_schema(), $target_row->get_column('target_id') );
1899
1900            push @targets, $target;
1901        }
1902    }
1903
1904    return @targets;
1905 }
1906
1907
1908
1909
1910
1911
1912
1913
1914 ####
1915 1;##
1916 ####