lib/CXGN/GEM/Platform.pm

   1
   2
   3 package CXGN::GEM::Platform;
   4
   5 use strict;
   6 use warnings;
   7
   8 use base qw | CXGN::DB::Object |;
   9 use Bio::Chado::Schema;
  10 use CXGN::Biosource::Schema;
  11 use CXGN::Biosource::Sample;
  12 use CXGN::Metadata::Metadbdata;
  13 use CXGN::GEM::TechnologyType;
  14 use CXGN::GEM::Template;
  15
  16 use Carp qw| croak cluck carp |;
  17
  18
  19
  20 ###############
  21 ### PERLDOC ###
  22 ###############
  23
  24 =head1 NAME
  25
  26 CXGN::GEM::Platform
  27 a class to manipulate a platform data from the gem schema.
  28
  29 =cut
  30
  31 our $VERSION = '0.01';
  32 $VERSION = eval $VERSION;
  33
  34 =head1 SYNOPSIS
  35
  36  use CXGN::GEM::Platform;
  37
  38  ## Constructors
  39
  40  my $platform = CXGN::GEM::Platform->new($schema, $platform_id);
  41  my $platform = CXGN::GEM::Platform->new_by_name($schema, $name);
  42
  43  ## Simple accessors (platform_name, technology_type_id, description and contact_id)
  44
  45  my $platform_name = $platform->get_platform_name();
  46  $platform->set_platform_name($platform_name);
  47
  48  ## Advance accessors (platform_design, pub and dbxref)
  49
  50  $platform->add_platform_design( $sample_name );
  51  my @sample_id_list = $platform->get_design_list();
  52
  53  $platform->add_dbxref($dbxref_id);
  54  my @dbxref_list_id = $platform->get_publication_list();
  55
  56  $platform->add_publication($pub_id);
  57  my @pub_id_list = $platform->get_publication_list();
  58
  59  ## Metadata objects (also for, platform_design, platform_dbxref and platform_pub)
  60
  61  my $metadbdata = $platform->get_platform_metadbdata();
  62  unless ($platform->is_experiment_obsolete()) {
  63                    ## do something
  64  }
  65
  66  ## Store
  67
  68  $platform->store($metadbdata);
  69
  70  ## Obsolete (also for platform_design, platform_dbxref and platform_pub)
  71
  72  $platform->obsolete_platform($metadata, $note, 'REVERT');
  73
  74
  75
  76 =head1 DESCRIPTION
  77
  78  This object manage the target information of the database
  79  from the tables:
  80
  81    + gem.ge_platform
  82    + gem.ge_platform_design
  83    + gem.ge_platform_dbxref
  84    + gem.ge_platform_pub
  85
  86  This data is stored inside this object as dbic rows objects with the
  87  following structure:
  88
  89   %Platform_Object = (
  90
  91        ge_platform_row        => GePlatform_row,
  92
  93        ge_plaform_design      => [ @GePlatformDesign_rows ],
  94
  95        ge_platform_dbxref_row => [ @GePlatformDbxref_rows ],
  96
  97        ge_platform_pub_row    => [ @GePlatformPub_rows ],
  98
  99   );
 100
 101
 102 =head1 AUTHOR
 103
 104 Aureliano Bombarely <ab782@cornell.edu>
 105
 106
 107 =head1 CLASS METHODS
 108
 109 The following class methods are implemented:
 110
 111 =cut
 112
 113
 114
 115
 116 ############################
 117 ### GENERAL CONSTRUCTORS ###
 118 ############################
 119
 120 =head2 constructor new
 121
 122   Usage: my $platform = CXGN::GEM::Platform->new($schema, $platform_id);
 123
 124   Desc: Create a new platform object
 125
 126   Ret: a CXGN::GEM::Platform object
 127
 128   Args: a $schema a schema object, preferentially created using:
 129         CXGN::GEM::Schema->connect(
 130                    sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
 131                    %other_parameters );
 132         A $platform_id, a scalar.
 133         If $platform_id is omitted, an empty platform object is created.
 134
 135   Side_Effects: access to database, check if exists the database columns that
 136                  this object use.  die if the id is not an integer.
 137
 138   Example: my $platform = CXGN::GEM::Platform->new($schema, $platform_id);
 139
 140 =cut
 141
 142 sub new {
 143     my $class = shift;
 144     my $schema = shift ||
 145         croak("PARAMETER ERROR: No schema object was supplied to the $class->new() function.\n");
 146     my $id = shift;
 147
 148     ### First, bless the class to create the object and set the schema into the object
 149     ### (set_schema comes from CXGN::DB::Object).
 150
 151     my $self = $class->SUPER::new($schema);
 152     $self->set_schema($schema);
 153
 154     ### Second, check that ID is an integer. If it is right go and get all the data for
 155     ### this row in the database and after that get the data for platform
 156     ### If don't find any, create an empty oject.
 157     ### If it is not an integer, die
 158
 159     my $platform;
 160     my @platform_design_rows = ();
 161     my @platform_dbxrefs = ();
 162     my @platform_pubs = ();
 163
 164     if (defined $id) {
 165         unless ($id =~ m/^\d+$/) {  ## The id can be only an integer... so it is better if we detect this fail before.
 166
 167             croak("\nDATA TYPE ERROR: The platform_id ($id) for $class->new() IS NOT AN INTEGER.\n\n");
 168         }
 169
 170         ## Get the ge_platform_row object using a search based in the platform_id
 171
 172         ($platform) = $schema->resultset('GePlatform')
 173                              ->search( { platform_id => $id } );
 174
 175         if (defined $platform) {
 176             ## Search also the platform elements associated to this platform
 177
 178             @platform_design_rows = $schema->resultset('GePlatformDesign')
 179                                            ->search( { platform_id => $id } );
 180
 181             ## Search platform_dbxref associations
 182
 183             @platform_dbxrefs = $schema->resultset('GePlatformDbxref')
 184                                        ->search( { platform_id => $id } );
 185
 186             @platform_pubs = $schema->resultset('GePlatformPub')
 187                                     ->search( { platform_id => $id });
 188         }
 189         else {
 190                 $platform = $schema->resultset('GePlatform')
 191                                    ->new({});                              ### Create an empty object;
 192         }
 193     }
 194     else {
 195         $platform = $schema->resultset('GePlatform')
 196                            ->new({});                              ### Create an empty object;
 197     }
 198
 199     ## Finally it will load the rows into the object.
 200     $self->set_geplatform_row($platform);
 201     $self->set_geplatformdesign_rows(\@platform_design_rows);
 202     $self->set_geplatformdbxref_rows(\@platform_dbxrefs);
 203     $self->set_geplatformpub_rows(\@platform_pubs);
 204
 205     return $self;
 206 }
 207
 208 =head2 constructor new_by_name
 209
 210   Usage: my $platform = CXGN::GEM::Platform->new_by_name($schema, $name);
 211
 212   Desc: Create a new Experiment object using platform_name
 213
 214   Ret: a CXGN::GEM::Platform object
 215
 216   Args: a $schema a schema object, preferentially created using:
 217         CXGN::GEM::Schema->connect(
 218                    sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
 219                    %other_parameters );
 220         a $platform_name, a scalar
 221
 222   Side_Effects: accesses the database,
 223                 return a warning if the experiment name do not exists
 224                 into the db
 225
 226   Example: my $platform = CXGN::GEM::Platform->new_by_name($schema, $name);
 227
 228 =cut
 229
 230 sub new_by_name {
 231     my $class = shift;
 232     my $schema = shift ||
 233         croak("PARAMETER ERROR: None schema object was supplied to the $class->new_by_name() function.\n");
 234     my $name = shift;
 235
 236     ### It will search the platform_id for this name and it will get the platform_id for that using the new
 237     ### method to create a new object. If the name don't exists into the database it will create a empty object and
 238     ### it will set the platform_name for it
 239
 240     my $platform;
 241
 242     if (defined $name) {
 243         my ($platform_row) = $schema->resultset('GePlatform')
 244                                   ->search({ platform_name => $name });
 245
 246         unless (defined $platform_row) {
 247             warn("DATABASE OUTPUT WARNING: platform_name ($name) for $class->new_by_name() DON'T EXISTS INTO THE DB.\n");
 248
 249             ## If do not exists any platform with this name, it will return a warning and it will create an empty
 250             ## object with the platform name set in it.
 251
 252             $platform = $class->new($schema);
 253             $platform->set_platform_name($name);
 254         }
 255         else {
 256
 257             ## if exists it will take the platform_id to create the object with the new constructor
 258             $platform = $class->new( $schema, $platform_row->get_column('platform_id') );
 259         }
 260     }
 261     else {
 262         $platform = $class->new($schema);                              ### Create an empty object;
 263     }
 264
 265     return $platform;
 266 }
 267
 268 =head2 constructor new_by_design
 269
 270   Usage: my $platform = CXGN::GEM::Platform->new_by_design($schema,
 271                                                                \@sample_names);
 272
 273   Desc: Create a new Platform object using a list of a sample_name used
 274         in the design of the platform
 275
 276   Ret: a CXGN::GEM::Platform object
 277
 278   Args: a $schema a schema object, preferentially created using:
 279         CXGN::GEM::Schema->connect(
 280                      sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
 281                      %other_parameters );
 282         a \@sample_names, an array reference with a list of sample
 283         names
 284
 285   Side_Effects: accesses the database,
 286                 return a warning if the platform name do not exists into the db
 287
 288   Example: my $platform = CXGN::GEM::Platform->new_by_design( $schema,
 289                                                                   [$e1, $e2]);
 290
 291 =cut
 292
 293 sub new_by_design {
 294     my $class = shift;
 295     my $schema = shift ||
 296         croak("PARAMETER ERROR: None schema object was supplied to the $class->new_by_name() function.\n");
 297     my $elements_aref = shift;
 298
 299     ### It will search the platform_id for the list of these elements. If find a platform_id it will create a new object with it.
 300     ### if not, it will create an empty object and it will add all the elements over the empty object using the add_element_by_name
 301     ### function (it will search a element in the database and it will add it to the platform)
 302
 303     my $platform;
 304
 305     if (defined $elements_aref) {
 306         if (ref($elements_aref) ne 'ARRAY') {
 307             croak("PARAMETER ERROR: The element array reference supplied to $class->new_by_design() method IS NOT AN ARRAY REF.\n");
 308         }
 309         else {
 310             my $elements_n = scalar(@{$elements_aref});
 311
 312             ## First it will change sample_names by sample_ids
 313
 314             my @sample_ids = ();
 315
 316             foreach my $sample_name ( @{$elements_aref} ) {
 317                 my $sample_id = CXGN::Biosource::Sample->new_by_name($schema, $sample_name)
 318                                                        ->get_sample_id();
 319                 unless (defined $sample_id) {
 320                     croak("DATABASE OUTPUT WARNING: The sample_name=$sample_name do not exists into the biosource.bs_sample_table.");
 321                 }
 322                 else {
 323                     push @sample_ids, $sample_id;
 324                 }
 325             }
 326
 327             ## Dbix::Class search to get an id in a group using the elements of the group
 328
 329             my @geplatform_design_row = $schema->resultset('GePlatformDesign')
 330                                                  ->search( undef,
 331                                                           {
 332                                                             columns  => ['platform_id'],
 333                                                             where    => { sample_id => { -in  => \@sample_ids } },
 334                                                             group_by => [ qw/platform_id/ ],
 335                                                             having   => { 'count(platform_design_id)' => { '=', $elements_n } }
 336                                                           }
 337                                                         );
 338
 339             ## This search will return all the platform_design that contains the elements specified, it will filter
 340             ## by the number of element to take only the rows where have all these elements
 341
 342             my $geplatform_design_row;
 343             foreach my $row (@geplatform_design_row) {
 344                 my $count = $schema->resultset('GePlatformDesign')
 345                                    ->search( platform_id => $row->get_column('platform_id') )
 346                                    ->count();
 347                 if ($count == $elements_n) {
 348                     $geplatform_design_row = $row;
 349                 }
 350             }
 351
 352             unless (defined $geplatform_design_row) {
 353
 354                 ## If platform_id don't exists into the  db, it will warning with carp and create an empty object
 355                 warn("DATABASE OUTPUT WARNING: Elements specified haven't a Platform. It'll be created an empty platform object.\n");
 356                 $platform = $class->new($schema);
 357
 358                 foreach my $element_name (@{$elements_aref}) {
 359                     $platform->add_platform_design($element_name);
 360                 }
 361             }
 362             else {
 363                 $platform = $class->new( $schema, $geplatform_design_row->get_column('platform_id') );
 364             }
 365         }
 366
 367     }
 368     else {
 369             $platform = $class->new($schema);                              ### Create an empty object;
 370     }
 371
 372     return $platform;
 373 }
 374
 375
 376 ##################################
 377 ### DBIX::CLASS ROWS ACCESSORS ###
 378 ##################################
 379
 380 =head2 accessors get_geplatform_row, set_geplatform_row
 381
 382   Usage: my $geplatform_row = $self->get_geplatform_row();
 383          $self->set_geplatform_row($geplatform_row_object);
 384
 385   Desc: Get or set a geplatform row object into a platform
 386         object
 387
 388   Ret:   Get => $geplatform_row_object, a row object
 389                 (CXGN::GEM::Schema::GePlatform).
 390          Set => none
 391
 392   Args:  Get => none
 393          Set => $geplatform_row_object, a row object
 394                 (CXGN::GEM::Schema::GePlatform).
 395
 396   Side_Effects: With set check if the argument is a row object. If fail, dies.
 397
 398   Example: my $geplatform_row = $self->get_geplatform_row();
 399            $self->set_geplatform_row($geplatform_row);
 400
 401 =cut
 402
 403 sub get_geplatform_row {
 404   my $self = shift;
 405
 406   return $self->{geplatform_row};
 407 }
 408
 409 sub set_geplatform_row {
 410   my $self = shift;
 411   my $geplatform_row = shift
 412       || croak("FUNCTION PARAMETER ERROR: None geplatform_row object was supplied for $self->set_geplatform_row function.\n");
 413
 414   if (ref($geplatform_row) ne 'CXGN::GEM::Schema::GePlatform') {
 415       croak("SET ARGUMENT ERROR: $geplatform_row isn't a geplatform_row obj. (CXGN::GEM::Schema::GePlatform).\n");
 416   }
 417   $self->{geplatform_row} = $geplatform_row;
 418 }
 419
 420 =head2 accessors get_geplatformdesign_rows, set_geplatformdesign_rows
 421
 422   Usage: my @geplatformdesign_rows = $self->get_geplatformdesign_rows();
 423          $self->set_geplatformdesign_rows(\@geplatformdesign_rows);
 424
 425   Desc: Get or set a geplatformdesign row object into a platform object
 426         as hash reference where keys = name and value = row object
 427
 428   Ret:   Get => An array reference with GePlatformDesign object
 429          Set => none
 430
 431   Args:  Get => none
 432          Set => An array with GePlatformDesign row objects
 433                 (CXGN::GEM::Schema::GePlatformDesign).
 434
 435   Side_Effects: With set check if the argument is a row object. If fail, dies.
 436
 437   Example:  my @geplatformdesign_rows = $self->get_geplatformdesign_rows();
 438             $self->set_geplatformdesign_rows(\@geplatformdesign_rows);
 439
 440 =cut
 441
 442 sub get_geplatformdesign_rows {
 443   my $self = shift;
 444
 445   return @{$self->{geplatformdesign_rows}};
 446 }
 447
 448 sub set_geplatformdesign_rows {
 449   my $self = shift;
 450   my $geplatformdesign_aref = shift
 451       || croak("FUNCTION PARAMETER ERROR: None ge_platform_design_row hash ref. was supplied for set_geplatformdesign_row function.\n");
 452
 453   if (ref($geplatformdesign_aref) ne 'ARRAY') {
 454       croak("SET ARGUMENT ERROR: array ref. = $geplatformdesign_aref isn't an array reference.\n");
 455   }
 456   else {
 457       my @geplatformdesign = @{$geplatformdesign_aref};
 458
 459       foreach my $element_row (@geplatformdesign) {
 460           unless (ref($element_row) eq 'CXGN::GEM::Schema::GePlatformDesign') {
 461                croak("SET ARGUMENT ERROR: row obj = $element_row isn't a row obj. (GePlatformDesign).\n");
 462           }
 463       }
 464   }
 465   $self->{geplatformdesign_rows} = $geplatformdesign_aref;
 466 }
 467
 468
 469 =head2 accessors get_geplatformdbxref_rows, set_geplatformdbxref_rows
 470
 471   Usage: my @geplatformdbxref_rows = $self->get_geplatformdbxref_rows();
 472          $self->set_geplatformdbxref_rows(\@geplatformdbxref_rows);
 473
 474   Desc: Get or set a list of geplatformdbxref rows object into an
 475         platform object
 476
 477   Ret:   Get => @geplatformdbxref_row_object, a list of row objects
 478                 (CXGN::GEM::Schema::GePlatformDbxref).
 479          Set => none
 480
 481   Args:  Get => none
 482          Set => \@geplatformdbxref_row_object, an array ref of row objects
 483                 (CXGN::GEM::Schema::GePlatformDbxref).
 484
 485   Side_Effects: With set check if the argument is a row object. If fail, dies.
 486
 487   Example: my @geplatformdbxref_rows = $self->get_geplatformdbxref_rows();
 488            $self->set_geplatformdbxref_rows(\@geplatformdbxref_rows);
 489
 490 =cut
 491
 492 sub get_geplatformdbxref_rows {
 493   my $self = shift;
 494
 495   return @{$self->{geplatformdbxref_rows}};
 496 }
 497
 498 sub set_geplatformdbxref_rows {
 499   my $self = shift;
 500   my $geplatformdbxref_row_aref = shift
 501       || croak("FUNCTION PARAMETER ERROR:None geplatformdbxref_row array ref was supplied for $self->set_geplatformdbxref_rows().\n");
 502
 503   if (ref($geplatformdbxref_row_aref) ne 'ARRAY') {
 504       croak("SET ARGUMENT ERROR: $geplatformdbxref_row_aref isn't an array reference for $self->set_geplatformdbxref_rows().\n");
 505   }
 506   else {
 507       foreach my $geplatformdbxref_row (@{$geplatformdbxref_row_aref}) {
 508           if (ref($geplatformdbxref_row) ne 'CXGN::GEM::Schema::GePlatformDbxref') {
 509               croak("SET ARGUMENT ERROR:$geplatformdbxref_row isn't geplatformdbxref_row obj.\n");
 510           }
 511       }
 512   }
 513   $self->{geplatformdbxref_rows} = $geplatformdbxref_row_aref;
 514 }
 515
 516 =head2 accessors get_geplatformpub_rows, set_geplatformpub_rows
 517
 518   Usage: my @geplatformpub_rows = $self->get_geplatformpub_rows();
 519          $self->set_geplatformpub_rows(\@geplatformpub_rows);
 520
 521   Desc: Get or set a list of geplatformpub rows object into an
 522         platform object
 523
 524   Ret:   Get => @geplatformpub_row_object, a list of row objects
 525                 (CXGN::GEM::Schema::GePlatformPub).
 526          Set => none
 527
 528   Args:  Get => none
 529          Set => \@geplatformpub_row_object, an array ref of row objects
 530                 (CXGN::GEM::Schema::GePlatformPub).
 531
 532   Side_Effects: With set check if the argument is a row object. If fail, dies.
 533
 534   Example: my @geplatformpub_rows = $self->get_geplatformpub_rows();
 535            $self->set_geplatformpub_rows(\@geplatformpub_rows);
 536
 537 =cut
 538
 539 sub get_geplatformpub_rows {
 540   my $self = shift;
 541
 542   return @{$self->{geplatformpub_rows}};
 543 }
 544
 545 sub set_geplatformpub_rows {
 546   my $self = shift;
 547   my $geplatformpub_row_aref = shift
 548       || croak("FUNCTION PARAMETER ERROR:None geplatformpub_row array ref was supplied for $self->set_geplatformpub_rows().\n");
 549
 550   if (ref($geplatformpub_row_aref) ne 'ARRAY') {
 551       croak("SET ARGUMENT ERROR: $geplatformpub_row_aref isn't an array reference for $self->set_geplatformpub_rows().\n");
 552   }
 553   else {
 554       foreach my $geplatformpub_row (@{$geplatformpub_row_aref}) {
 555           if (ref($geplatformpub_row) ne 'CXGN::GEM::Schema::GePlatformPub') {
 556               croak("SET ARGUMENT ERROR:$geplatformpub_row isn't geplatformpub_row obj.\n");
 557           }
 558       }
 559   }
 560   $self->{geplatformpub_rows} = $geplatformpub_row_aref;
 561 }
 562
 563 ###################################
 564 ### DATA ACCESSORS FOR PLATFORM ###
 565 ###################################
 566
 567 =head2 get_platform_id, force_set_platform_id
 568
 569   Usage: my $platform_id = $platform->get_platform_id();
 570          $platform->force_set_platform_id($platform_id);
 571
 572   Desc: get or set a platform_id in a platform object.
 573         set method should be USED WITH PRECAUTION
 574         If you want set a platform_id that do not exists into the
 575         database you should consider that when you store this object you
 576         CAN STORE a experiment_id that do not follow the
 577         gem.ge_platform_platform_id_seq
 578
 579   Ret:  get=> $platform_id, a scalar.
 580         set=> none
 581
 582   Args: get=> none
 583         set=> $platform_id, a scalar (constraint: it must be an integer)
 584
 585   Side_Effects: none
 586
 587   Example: my $platform_id = $platform->get_platform_id();
 588
 589 =cut
 590
 591 sub get_platform_id {
 592   my $self = shift;
 593   return $self->get_geplatform_row->get_column('platform_id');
 594 }
 595
 596 sub force_set_platform_id {
 597   my $self = shift;
 598   my $data = shift ||
 599       croak("FUNCTION PARAMETER ERROR: None platform_id was supplied for force_set_platform_id function");
 600
 601   unless ($data =~ m/^\d+$/) {
 602       croak("DATA TYPE ERROR: The platform_id ($data) for $self->force_set_platform_id() ISN'T AN INTEGER.\n");
 603   }
 604
 605   $self->get_geplatform_row()
 606        ->set_column( platform_id => $data );
 607
 608 }
 609
 610 =head2 accessors get_platform_name, set_platform_name
 611
 612   Usage: my $platform_name = $platform->get_platform_name();
 613          $platform->set_platform_name($platform_name);
 614
 615   Desc: Get or set the platform_name from platform object.
 616
 617   Ret:  get=> $platform_name, a scalar
 618         set=> none
 619
 620   Args: get=> none
 621         set=> $platform_name, a scalar
 622
 623   Side_Effects: none
 624
 625   Example: my $platform_name = $platform->get_platform_name();
 626            $platform->set_platform_name($new_name);
 627 =cut
 628
 629 sub get_platform_name {
 630   my $self = shift;
 631   return $self->get_geplatform_row->get_column('platform_name');
 632 }
 633
 634 sub set_platform_name {
 635   my $self = shift;
 636   my $data = shift
 637       || croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->set_platform_name function.\n");
 638
 639   $self->get_geplatform_row()
 640        ->set_column( platform_name => $data );
 641 }
 642
 643 =head2 accessors get_technology_type_id, set_technology_type_id
 644
 645   Usage: my $technology_type_id = $platform->get_technology_type_id();
 646          $platform->set_technology_type_id($technology_type_id);
 647
 648   Desc: Get or set technology_type_id from a platform object.
 649
 650   Ret:  get=> $technology_type_id, a scalar
 651         set=> none
 652
 653   Args: get=> none
 654         set=> $technology_type_id, a scalar
 655
 656   Side_Effects: For the set accessor, die if the technology_type_id don't
 657                 exists into the database
 658
 659   Example: my $technology_type_id = $platform->get_technology_type_id();
 660            $platform->set_technology_type_id($technology_type_id);
 661 =cut
 662
 663 sub get_technology_type_id {
 664   my $self = shift;
 665   return $self->get_geplatform_row->get_column('technology_type_id');
 666 }
 667
 668 sub set_technology_type_id {
 669   my $self = shift;
 670   my $data = shift
 671       || croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->set_technology_type function.\n");
 672
 673   unless ($data =~ m/^\d+$/) {
 674       croak("DATA TYPE ERROR: The technology_type_id ($data) for $self->set_technology_type_id() ISN'T AN INTEGER.\n");
 675   }
 676
 677   $self->get_geplatform_row()
 678        ->set_column( technology_type_id => $data );
 679 }
 680
 681 =head2 accessors get_description, set_description
 682
 683   Usage: my $description = $platform->get_description();
 684          $platform->set_description($description);
 685
 686   Desc: Get or set description from a platform object.
 687
 688   Ret:  get=> $description, a scalar
 689         set=> none
 690
 691   Args: get=> none
 692         set=> $description, a scalar
 693
 694   Side_Effects: None
 695
 696   Example: my $description = $platform->get_description();
 697            $platform->set_description($description);
 698 =cut
 699
 700 sub get_description {
 701   my $self = shift;
 702   return $self->get_geplatform_row->get_column('description');
 703 }
 704
 705 sub set_description {
 706   my $self = shift;
 707   my $data = shift;
 708
 709   $self->get_geplatform_row()
 710        ->set_column( description => $data );
 711 }
 712
 713 =head2 get_contact_id, set_contact_id
 714
 715   Usage: my $contact_id = $platform->get_contact_id();
 716          $platform->set_contact_id($contact_id);
 717
 718   Desc: get or set a contact_id in a platform object.
 719
 720   Ret:  get=> $contact_id, a scalar.
 721         set=> none
 722
 723   Args: get=> none
 724         set=> $contact_id, a scalar (constraint: it must be an integer)
 725
 726   Side_Effects: die if the argument supplied is not an integer
 727
 728   Example: my $contact_id = $platform->get_contact_id();
 729
 730 =cut
 731
 732 sub get_contact_id {
 733   my $self = shift;
 734   return $self->get_geplatform_row->get_column('contact_id');
 735 }
 736
 737 sub set_contact_id {
 738   my $self = shift;
 739   my $data = shift;
 740
 741   unless ($data =~ m/^\d+$/) {
 742       croak("DATA TYPE ERROR: The contact_id ($data) for $self->set_contact_id() ISN'T AN INTEGER.\n");
 743   }
 744
 745   $self->get_geplatform_row()
 746        ->set_column( contact_id => $data );
 747
 748 }
 749
 750 =head2 get_contact_by_username, set_contact_by_username
 751
 752   Usage: my $contact_username = $platform->get_contact_by_username();
 753          $platform->set_contact_by_username($contact_username);
 754
 755   Desc: get or set a contact_id in a platform object using username
 756
 757   Ret:  get=> $contact_username, a scalar.
 758         set=> none
 759
 760   Args: get=> none
 761         set=> $contact_username, a scalar (constraint: it must be an integer)
 762
 763   Side_Effects: die if the argument supplied is not an integer
 764
 765   Example: my $contact = $platform->get_contact_by_username();
 766
 767 =cut
 768
 769 sub get_contact_by_username {
 770   my $self = shift;
 771
 772   my $contact_id = $self->get_geplatform_row
 773                         ->get_column('contact_id');
 774
 775   if (defined $contact_id) {
 776
 777       ## This is a temp simple SQL query. It should be replaced by DBIx::Class search when the person module will be developed
 778
 779       my $query = "SELECT username FROM sgn_people.sp_person WHERE sp_person_id = ?";
 780       my ($username) = $self->get_schema()
 781                             ->storage()
 782                             ->dbh()
 783                             ->selectrow_array($query, undef, $contact_id);
 784
 785       unless (defined $username) {
 786           croak("DATABASE INTEGRITY ERROR: sp_person_id=$contact_id defined in gem.ge_platform don't exists in sp_person table.\n")
 787       }
 788       else {
 789           return $username
 790       }
 791   }
 792 }
 793
 794 sub set_contact_by_username {
 795   my $self = shift;
 796   my $data = shift ||
 797       croak("SET ARGUMENT ERROR: None argument was supplied to the $self->set_contact_by_username function.\n");
 798
 799   my $query = "SELECT sp_person_id FROM sgn_people.sp_person WHERE username = ?";
 800   my ($contact_id) = $self->get_schema()
 801                           ->storage()
 802                           ->dbh()
 803                           ->selectrow_array($query, undef, $data);
 804
 805   unless (defined $contact_id) {
 806       croak("DATABASE COHERENCE ERROR: username=$data supplied to function set_contact_by_username don't exists in sp_person table.\n");
 807   }
 808   else {
 809       $self->get_geplatform_row()
 810            ->set_column( contact_id => $contact_id );
 811   }
 812
 813 }
 814
 815
 816
 817
 818 ##########################################
 819 ### DATA ACCESSORS FOR PLATFORM DESIGN ###
 820 ##########################################
 821
 822 =head2 add_platform_design
 823
 824   Usage: $platform->add_platform_design( $sample_name );
 825
 826   Desc: Add a new platform design element to the platform object
 827
 828   Ret: None
 829
 830   Args: A scalar with the sample_name
 831
 832   Side_Effects: Die if the sample_name don't exists into the database
 833
 834   Example: $platform->add_platform_design('tomato_unigene_dataset');
 835
 836 =cut
 837
 838 sub add_platform_design {
 839     my $self = shift;
 840     my $scalar = shift ||
 841         croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->add_platform_design function.\n");
 842
 843     my $platformdesign_row;
 844
 845     ## Search in the database a sample name (biosource tables) and get the sample_id. Die if don't find anything.
 846
 847     my ($sample_row) = $self->get_schema()
 848                             ->resultset('BsSample')
 849                             ->search( { sample_name => $scalar } );
 850     if (defined $sample_row) {
 851         my $sample_id = $sample_row->get_column('sample_id');
 852
 853         $platformdesign_row = $self->get_schema()
 854                                    ->resultset('GePlatformDesign')
 855                                    ->new({ sample_id => $sample_id});
 856
 857         if (defined $self->get_platform_id() ) {
 858             $platformdesign_row->set_column( platform_id => $self->get_platform_id() );
 859         }
 860     }
 861     else {
 862         croak("DATABASE COHERENCE ERROR for add_platform_design: Sample_name ($scalar) don't exists in database.\n");
 863     }
 864
 865     my @platformdesign_rows = $self->get_geplatformdesign_rows();
 866     push @platformdesign_rows, $platformdesign_row;
 867     $self->set_geplatformdesign_rows(\@platformdesign_rows);
 868 }
 869
 870 =head2 get_design_list
 871
 872   Usage: my @design_list_id = $platform->get_design_list();
 873
 874   Desc: Get a list of sample_names associated to this platform.
 875
 876   Ret: An array of scalars (sample_id by default)
 877
 878   Args: None or a column to get ('sample_name').
 879
 880   Side_Effects: None
 881
 882   Example: my @sample_id_list = $platform->get_design_list();
 883            my @sample_name_list = $platform->get_design_list('sample_name');
 884
 885 =cut
 886
 887 sub get_design_list {
 888     my $self = shift;
 889     my $field = shift;
 890
 891     my @design_list = ();
 892
 893     my @platformdesign_rows = $self->get_geplatformdesign_rows();
 894     foreach my $platformdesign_row (@platformdesign_rows) {
 895         my $sample_id = $platformdesign_row->get_column('sample_id');
 896
 897         if (defined $field && $field =~ m/sample_name/i) {
 898             my ($sample_row) = $self->get_schema()
 899                                     ->resultset('BsSample')
 900                                     ->search( { sample_id => $sample_id } );
 901             if (defined $sample_row) {
 902                 my $sample_name = $sample_row->get_column('sample_name');
 903                 push @design_list, $sample_name;
 904             }
 905         }
 906         else {
 907             push @design_list, $sample_id;
 908         }
 909     }
 910
 911     return @design_list;
 912 }
 913
 914
 915 ##########################################
 916 ### DATA ACCESSORS FOR PLATFORM DBXREF ###
 917 ##########################################
 918
 919 =head2 add_dbxref
 920
 921   Usage: $platform->add_dbxref($dbxref_id);
 922
 923   Desc: Add a dbxref to the dbxref_ids associated to sample
 924         object using dbxref_id or accesion + database_name
 925
 926   Ret:  None
 927
 928   Args: $dbxref_id, a dbxref id.
 929         To use with accession and dbxname:
 930           $platform->add_dbxref(
 931                                {
 932                                  accession => $accesssion,
 933                                  dbxname   => $dbxname,
 934                                }
 935                              );
 936
 937   Side_Effects: die if the parameter is not an hash reference
 938
 939   Example: $platform->add_dbxref($dbxref_id);
 940            $platform->add_dbxref(
 941                                 {
 942                                   accession => 'GSE3380',
 943                                   dbxname   => 'GEO Accession Display',
 944                                 }
 945                               );
 946 =cut
 947
 948 sub add_dbxref {
 949     my $self = shift;
 950     my $dbxref = shift ||
 951         croak("FUNCTION PARAMETER ERROR: None dbxref data was supplied for $self->add_dbxref function.\n");
 952
 953     my $dbxref_id;
 954
 955     ## If the imput parameter is an integer, treat it as id, if not do it as hash reference
 956
 957     if ($dbxref =~ m/^\d+$/) {
 958         $dbxref_id = $dbxref;
 959     }
 960     elsif (ref($dbxref) eq 'HASH') {
 961         if (exists $dbxref->{'dbxname'}) {
 962             my ($db_row) = $self->get_schema()
 963                                  ->resultset('General::Db')
 964                                  ->search( { name => $dbxref->{'dbxname'} });
 965             if (defined $db_row) {
 966                 my $db_id = $db_row->get_column('db_id');
 967
 968                 my ($dbxref_row) = $self->get_schema()
 969                                         ->resultset('General::Dbxref')
 970                                         ->search(
 971                                                    {
 972                                                       accession => $dbxref->{'accession'},
 973                                                       db_id     => $db_id,
 974                                                    }
 975                                                 );
 976                 if (defined $dbxref_row) {
 977                     $dbxref_id = $dbxref_row->get_column('dbxref_id');
 978                 }
 979                 else {
 980                     croak("DATABASE ARGUMENT ERROR: accession specified as argument in function $self->add_dbxref dont exists in db.\n");
 981                 }
 982             }
 983             else {
 984                 croak("DATABASE ARGUMENT ERROR: dbxname specified as argument in function $self->add_dbxref dont exists in db.\n");
 985             }
 986         }
 987         else {
 988             croak("INPUT ARGUMENT ERROR: None dbxname was supplied as hash ref. argument in the function $self->add_dbxref.\n ");
 989         }
 990     }
 991     else {
 992         croak("SET ARGUMENT ERROR: The dbxref ($dbxref) isn't a dbxref_id, or hash ref. with accession and dbxname keys.\n");
 993     }
 994
 995     my $platformdbxref_row = $self->get_schema()
 996                                 ->resultset('GePlatformDbxref')
 997                                 ->new({ dbxref_id => $dbxref_id});
 998
 999     if (defined $self->get_platform_id() ) {
1000         $platformdbxref_row->set_column( platform_id => $self->get_platform_id() );
1001     }
1002
1003     my @platformdbxref_rows = $self->get_geplatformdbxref_rows();
1004     push @platformdbxref_rows, $platformdbxref_row;
1005     $self->set_geplatformdbxref_rows(\@platformdbxref_rows);
1006 }
1007
1008 =head2 get_dbxref_list
1009
1010   Usage: my @dbxref_list_id = $platform->get_publication_list();
1011
1012   Desc: Get a list of dbxref_id associated to this platform.
1013
1014   Ret: An array of dbxref_id
1015
1016   Args: None or a column to get.
1017
1018   Side_Effects: die if the parameter is not an object
1019
1020   Example: my @dbxref_id_list = $platform->get_dbxref_list();
1021
1022 =cut
1023
1024 sub get_dbxref_list {
1025     my $self = shift;
1026
1027     my @dbxref_list = ();
1028
1029     my @platformdbxref_rows = $self->get_geplatformdbxref_rows();
1030     foreach my $platformdbxref_row (@platformdbxref_rows) {
1031         my $dbxref_id = $platformdbxref_row->get_column('dbxref_id');
1032         push @dbxref_list, $dbxref_id;
1033     }
1034
1035     return @dbxref_list;
1036 }
1037
1038 #########################################
1039 ### DATA ACCESSORS FOR PLATFORMS PUBS ###
1040 #########################################
1041
1042 =head2 add_publication
1043
1044   Usage: $platform->add_publication($pub_id);
1045
1046   Desc: Add a publication to the pub_ids associated to platform
1047         object using different arguments as pub_id, title or dbxref_accession
1048
1049   Ret:  None
1050
1051   Args: $pub_id, a publication id.
1052         To use with $pub_id:
1053           $platform->add_publication($pub_id);
1054         To use with $pub_title
1055           $platform->add_publication({ title => $pub_title } );
1056         To use with pubmed accession
1057           $platform->add_publication({ dbxref_accession => $accesssion});
1058
1059   Side_Effects: die if the parameter is not an object
1060
1061   Example: $platform->add_publication($pub_id);
1062
1063 =cut
1064
1065 sub add_publication {
1066     my $self = shift;
1067     my $pub = shift ||
1068         croak("FUNCTION PARAMETER ERROR: None pub was supplied for $self->add_publication function.\n");
1069
1070     my $pub_id;
1071     if ($pub =~ m/^\d+$/) {
1072         $pub_id = $pub;
1073     }
1074     elsif (ref($pub) eq 'HASH') {
1075         my $pub_row;
1076         if (exists $pub->{'title'}) {
1077             ($pub_row) = $self->get_schema()
1078                               ->resultset('Pub::Pub')
1079                               ->search( {title => { 'ilike', '%' . $pub->{'title'} . '%' } });
1080         }
1081         elsif (exists $pub->{'dbxref_accession'}) {
1082                 ($pub_row) = $self->get_schema()
1083                               ->resultset('Pub::Pub')
1084                               ->search(
1085                                         { 'dbxref.accession' => $pub->{'dbxref_accession'} },
1086                                         { join => { 'pub_dbxrefs' => 'dbxref' } },
1087                                       );
1088
1089         }
1090
1091         unless (defined $pub_row) {
1092             croak("DATABASE ARGUMENT ERROR: Publication data used as argument for $self->add_publication function don't exists in DB.\n");
1093         }
1094         $pub_id = $pub_row->get_column('pub_id');
1095
1096     }
1097     else {
1098         croak("SET ARGUMENT ERROR: The publication ($pub) isn't a pub_id, or hash with title or dbxref_accession keys.\n");
1099     }
1100     my $geplatformpub_row = $self->get_schema()
1101                                  ->resultset('GePlatformPub')
1102                                  ->new({ pub_id => $pub_id});
1103
1104     if (defined $self->get_platform_id() ) {
1105         $geplatformpub_row->set_column( platform_id => $self->get_platform_id() );
1106     }
1107
1108     my @geplatformpub_rows = $self->get_geplatformpub_rows();
1109     push @geplatformpub_rows, $geplatformpub_row;
1110     $self->set_geplatformpub_rows(\@geplatformpub_rows);
1111 }
1112
1113 =head2 get_publication_list
1114
1115   Usage: my @pub_list = $platform->get_publication_list();
1116
1117   Desc: Get a list of publications associated to this experimental design.
1118
1119   Ret: An array of pub_ids by default, but can be titles
1120        or accessions using an argument 'title' or 'dbxref.accession'
1121
1122   Args: None or a column to get.
1123
1124   Side_Effects: die if the parameter is not an object
1125
1126   Example: my @pub_id_list = $platform->get_publication_list();
1127            my @pub_title_list = $platform->get_publication_list('title');
1128            my @pub_title_accs = $platform->get_publication_list('dbxref.accession');
1129
1130
1131 =cut
1132
1133 sub get_publication_list {
1134     my $self = shift;
1135     my $field = shift;
1136
1137     my @pub_list = ();
1138
1139     my @platformpub_rows = $self->get_geplatformpub_rows();
1140     foreach my $platformpub_row (@platformpub_rows) {
1141         my $pub_id = $platformpub_row->get_column('pub_id');
1142         my ($pub_row) = $self->get_schema()
1143                              ->resultset('Pub::Pub')
1144                              ->search(
1145                                        { 'me.pub_id' => $pub_id },
1146                                        {
1147                                          '+select' => ['dbxref.accession'],
1148                                          '+as'     => ['accession'],
1149                                          join => { 'pub_dbxrefs' => 'dbxref' },
1150                                        }
1151                                      );
1152
1153         if (defined $field) {
1154             push @pub_list, $pub_row->get_column($field);
1155         }
1156         else {
1157             push @pub_list, $pub_row->get_column('pub_id');
1158         }
1159     }
1160
1161     return @pub_list;
1162 }
1163
1164
1165 #####################################
1166 ### METADBDATA ASSOCIATED METHODS ###
1167 #####################################
1168
1169 =head2 accessors get_platform_metadbdata
1170
1171   Usage: my $metadbdata = $platform->get_platform_metadbdata();
1172
1173   Desc: Get metadata object associated to platform data
1174         (see CXGN::Metadata::Metadbdata).
1175
1176   Ret:  A metadbdata object (CXGN::Metadata::Metadbdata)
1177
1178   Args: Optional, a metadbdata object to transfer metadata creation variables
1179
1180   Side_Effects: none
1181
1182   Example: my $metadbdata = $platform->get_platform_metadbdata();
1183            my $metadbdata = $platform->get_platform_metadbdata($metadbdata);
1184
1185 =cut
1186
1187 sub get_platform_metadbdata {
1188   my $self = shift;
1189   my $metadata_obj_base = shift;
1190
1191   my $metadbdata;
1192   my $metadata_id = $self->get_geplatform_row
1193                          ->get_column('metadata_id');
1194
1195   if (defined $metadata_id) {
1196       $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
1197       if (defined $metadata_obj_base) {
1198
1199           ## This will transfer the creation data from the base object to the new one
1200           $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
1201           $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
1202       }
1203   }
1204   else {
1205
1206       ## If do not exists the metadata_id, check the possible reasons.
1207       my $platform_id = $self->get_platform_id();
1208       if (defined $platform_id) {
1209           croak("DATABASE INTEGRITY ERROR: The metadata_id for the platform_id=$platform_id is undefined.\n");
1210       }
1211       else {
1212           croak("OBJECT MANAGEMENT ERROR: Object haven't defined any platform_id. Probably it hasn't been stored yet.\n");
1213       }
1214   }
1215
1216   return $metadbdata;
1217 }
1218
1219 =head2 is_platform_obsolete
1220
1221   Usage: $platform->is_platform_obsolete();
1222
1223   Desc: Get obsolete field form metadata object associated to
1224         protocol data (see CXGN::Metadata::Metadbdata).
1225
1226   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
1227
1228   Args: none
1229
1230   Side_Effects: none
1231
1232   Example: unless ($platform->is_experiment_obsolete()) {
1233                    ## do something
1234            }
1235
1236 =cut
1237
1238 sub is_platform_obsolete {
1239   my $self = shift;
1240
1241   my $metadbdata = $self->get_platform_metadbdata();
1242   my $obsolete = $metadbdata->get_obsolete();
1243
1244   if (defined $obsolete) {
1245       return $obsolete;
1246   }
1247   else {
1248       return 0;
1249   }
1250 }
1251
1252 =head2 accessors get_platform_design_metadbdata
1253
1254   Usage: my %metadbdata = $platform->get_platform_design_metadbdata();
1255
1256   Desc: Get metadata object associated to platform row
1257         (see CXGN::Metadata::Metadbdata).
1258
1259   Ret:  A hash with key=sample_name and value=metadbdata object
1260         (CXGN::Metadata::Metadbdata)
1261
1262   Args: Optional, a metadbdata object to transfer metadata creation variables
1263
1264   Side_Effects: none
1265
1266   Example: my %metadbdata = $platform->get_platform_design_metadbdata();
1267            my %metadbdata = $platform->get_platform_design_metadbdata($metadbdata);
1268            my $metadbdata_1 = $metadbdata{'sample_name1'};
1269
1270 =cut
1271
1272 sub get_platform_design_metadbdata {
1273   my $self = shift;
1274   my $metadata_obj_base = shift;
1275
1276   my %metadbdata;
1277   my @platformdesign_rows = $self->get_geplatformdesign_rows();
1278
1279   my $platform_id = $self->get_platform_id();
1280   unless (defined $platform_id) {
1281       croak("OBJECT MANIPULATION ERROR: The object $self haven't any platform_id associated. Probably it hasn't been stored\n");
1282   }
1283
1284   foreach my $platformdesign_row (@platformdesign_rows) {
1285       my $metadbdata;
1286       my $metadata_id = $platformdesign_row->get_column('metadata_id');
1287       my $sample_id = $platformdesign_row->get_column('sample_id');
1288
1289       unless (defined $sample_id) {
1290           croak("OBJECT COHERENCE ERROR: The GePlatformDesign row for the get_platform_design_metadbdata() haven't any sample_id.\n");
1291       }
1292
1293       my $sample_name;
1294
1295       my ($sample) = $self->get_schema()
1296                           ->resultset('BsSample')
1297                           ->search({ sample_id => $sample_id });
1298
1299
1300       if (defined $sample) {
1301           $sample_name = $sample->get_column('sample_name');
1302       }
1303       else {
1304           croak("DATABASE COHERENCE ERROR: The sample_id=$sample_id from the platform_design row doesn't exists into the database.");
1305       }
1306
1307       if (defined $metadata_id) {
1308           $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
1309           if (defined $metadata_obj_base) {
1310
1311               ## This will transfer the creation data from the base object to the new one
1312               $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
1313               $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
1314           }
1315           $metadbdata{$sample_name} = $metadbdata;
1316       }
1317       else {
1318           croak("DATABASE INTEGRITY ERROR: metadata_id for sample_name=$sample_name (sample_id=$sample_id) is undefined.\n");
1319       }
1320   }
1321
1322   return %metadbdata;
1323 }
1324
1325 =head2 is_platform_design_obsolete
1326
1327   Usage: $platform->is_platform_design_obsolete($element_name);
1328
1329   Desc: Get obsolete field form metadata object associated to
1330         platform data (see CXGN::Metadata::Metadbdata).
1331
1332   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
1333
1334   Args: $element_name, a scalar, the name for the platform element in the
1335         object
1336
1337   Side_Effects: none
1338
1339   Example: unless ($platform->is_platform_design_obsolete($element_name)) {
1340                 ## do something
1341            };
1342
1343 =cut
1344
1345 sub is_platform_design_obsolete {
1346   my $self = shift;
1347   my $element_name = shift;
1348
1349
1350   if (defined $element_name) {
1351       my %metadbdata = $self->get_platform_design_metadbdata();
1352       my $obsolete = $metadbdata{$element_name}->get_obsolete();
1353
1354       if (defined $obsolete) {
1355           return $obsolete;
1356       }
1357       else {
1358           return 0;
1359       }
1360   }
1361   else {
1362       return 0;
1363   }
1364 }
1365
1366 =head2 accessors get_platform_dbxref_metadbdata
1367
1368   Usage: my %metadbdata = $platform->get_platform_dbxref_metadbdata();
1369
1370   Desc: Get metadata object associated to tool data
1371         (see CXGN::Metadata::Metadbdata).
1372
1373   Ret:  A hash with keys=dbxref_id and values=metadbdata object
1374         (CXGN::Metadata::Metadbdata) for dbxref relation
1375
1376   Args: Optional, a metadbdata object to transfer metadata creation variables
1377
1378   Side_Effects: none
1379
1380   Example: my %metadbdata = $platform->get_platform_dbxref_metadbdata();
1381            my %metadbdata =
1382               $platform->get_platform_dbxref_metadbdata($metadbdata);
1383
1384 =cut
1385
1386 sub get_platform_dbxref_metadbdata {
1387   my $self = shift;
1388   my $metadata_obj_base = shift;
1389
1390   my %metadbdata;
1391   my @geplatformdbxref_rows = $self->get_geplatformdbxref_rows();
1392
1393   foreach my $geplatformdbxref_row (@geplatformdbxref_rows) {
1394       my $dbxref_id = $geplatformdbxref_row->get_column('dbxref_id');
1395       my $metadata_id = $geplatformdbxref_row->get_column('metadata_id');
1396
1397       if (defined $metadata_id) {
1398           my $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
1399           if (defined $metadata_obj_base) {
1400
1401               ## This will transfer the creation data from the base object to the new one
1402               $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
1403               $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
1404           }
1405           $metadbdata{$dbxref_id} = $metadbdata;
1406       }
1407       else {
1408           my $platform_dbxref_id = $geplatformdbxref_row->get_column('platform_dbxref_id');
1409           unless (defined $platform_dbxref_id) {
1410               croak("OBJECT MANIPULATION ERROR: Object $self haven't any platform_dbxref_id. Probably it hasn't been stored\n");
1411           }
1412           else {
1413               croak("DATABASE INTEGRITY ERROR: metadata_id for the platform_dbxref_id=$platform_dbxref_id is undefined.\n");
1414           }
1415       }
1416   }
1417   return %metadbdata;
1418 }
1419
1420 =head2 is_platform_dbxref_obsolete
1421
1422   Usage: $platform->is_platform_dbxref_obsolete($dbxref_id);
1423
1424   Desc: Get obsolete field form metadata object associated to
1425         protocol data (see CXGN::Metadata::Metadbdata).
1426
1427   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
1428
1429   Args: $dbxref_id, a dbxref_id
1430
1431   Side_Effects: none
1432
1433   Example: unless ($platform->is_platform_dbxref_obsolete($dbxref_id)){
1434                 ## do something
1435            }
1436
1437 =cut
1438
1439 sub is_platform_dbxref_obsolete {
1440   my $self = shift;
1441   my $dbxref_id = shift;
1442
1443   my %metadbdata = $self->get_platform_dbxref_metadbdata();
1444   my $metadbdata = $metadbdata{$dbxref_id};
1445
1446   my $obsolete = 0;
1447   if (defined $metadbdata) {
1448       $obsolete = $metadbdata->get_obsolete() || 0;
1449   }
1450   return $obsolete;
1451 }
1452
1453 =head2 accessors get_platform_pub_metadbdata
1454
1455   Usage: my %metadbdata = $platform->get_platform_pub_metadbdata();
1456
1457   Desc: Get metadata object associated to tool data
1458         (see CXGN::Metadata::Metadbdata).
1459
1460   Ret:  A hash with keys=pub_id and values=metadbdata object
1461         (CXGN::Metadata::Metadbdata) for dbxref relation
1462
1463   Args: Optional, a metadbdata object to transfer metadata creation variables
1464
1465   Side_Effects: none
1466
1467   Example: my %metadbdata = $platform->get_platform_pub_metadbdata();
1468            my %metadbdata = $platform->get_platform_pub_metadbdata($metadbdata);
1469
1470 =cut
1471
1472 sub get_platform_pub_metadbdata {
1473   my $self = shift;
1474   my $metadata_obj_base = shift;
1475
1476   my %metadbdata;
1477   my @geplatformpub_rows = $self->get_geplatformpub_rows();
1478
1479   foreach my $geplatformpub_row (@geplatformpub_rows) {
1480       my $pub_id = $geplatformpub_row->get_column('pub_id');
1481       my $metadata_id = $geplatformpub_row->get_column('metadata_id');
1482
1483       if (defined $metadata_id) {
1484           my $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
1485           if (defined $metadata_obj_base) {
1486
1487               ## This will transfer the creation data from the base object to the new one
1488               $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
1489               $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
1490           }
1491           $metadbdata{$pub_id} = $metadbdata;
1492       }
1493       else {
1494           my $platform_pub_id = $geplatformpub_row->get_column('platform_pub_id');
1495           unless (defined $platform_pub_id) {
1496               croak("OBJECT MANIPULATION ERROR: Object $self haven't any platform_pub_id. Probably it hasn't been stored\n");
1497           }
1498           else {
1499               croak("DATABASE INTEGRITY ERROR: metadata_id for the platform_pub_id=$platform_pub_id is undefined.\n");
1500           }
1501       }
1502   }
1503   return %metadbdata;
1504 }
1505
1506 =head2 is_platform_pub_obsolete
1507
1508   Usage: $platform->is_platform_dbxref_obsolete($pub_id);
1509
1510   Desc: Get obsolete field form metadata object associated to
1511         protocol data (see CXGN::Metadata::Metadbdata).
1512
1513   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
1514
1515   Args: $pub_id, a pub_id
1516
1517   Side_Effects: none
1518
1519   Example: unless ($platform->is_platform_pub_obsolete($pub_id)){
1520                 ## do something
1521            }
1522
1523 =cut
1524
1525 sub is_platform_pub_obsolete {
1526   my $self = shift;
1527   my $pub_id = shift;
1528
1529   my %metadbdata = $self->get_platform_pub_metadbdata();
1530   my $metadbdata = $metadbdata{$pub_id};
1531
1532   my $obsolete = 0;
1533   if (defined $metadbdata) {
1534       $obsolete = $metadbdata->get_obsolete() || 0;
1535   }
1536   return $obsolete;
1537 }
1538
1539
1540
1541 #######################
1542 ### STORING METHODS ###
1543 #######################
1544
1545
1546 =head2 store
1547
1548   Usage: $platform->store($metadbdata);
1549
1550   Desc: Store in the database the all platform data for the
1551         platform object.
1552         See the methods store_platform, store_platform_design,
1553         store_dbxref_associations and store_pub_associations for more details
1554
1555   Ret: None
1556
1557   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1558
1559   Side_Effects: Die if:
1560                 1- None metadata object is supplied.
1561                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1562                    object
1563
1564   Example: $platform->store($metadata);
1565
1566 =cut
1567
1568 sub store {
1569     my $self = shift;
1570
1571     ## FIRST, check the metadata_id supplied as parameter
1572     my $metadata = shift
1573         || croak("STORE ERROR: None metadbdata object was supplied to $self->store().\n");
1574
1575     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1576         croak("STORE ERROR: Metadbdata supplied to $self->store() is not CXGN::Metadata::Metadbdata object.\n");
1577     }
1578
1579     ## SECOND, the store functions return the updated object, so it will chain the different store functions
1580
1581     $self->store_platform($metadata);
1582     $self->store_platform_designs($metadata);
1583     $self->store_dbxref_associations($metadata);
1584     $self->store_pub_associations($metadata);
1585 }
1586
1587
1588 =head2 store_platform
1589
1590   Usage: $platform->store_platform($metadata);
1591
1592   Desc: Store in the database the platform data for the platform
1593         object (Only the geplatform row, don't store any
1594         platform_dbxref or platform_design data)
1595
1596   Ret: None
1597
1598   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1599
1600   Side_Effects: Die if:
1601                 1- None metadata object is supplied.
1602                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1603                    object
1604
1605   Example: $platform->store_platform($metadata);
1606
1607 =cut
1608
1609 sub store_platform {
1610     my $self = shift;
1611
1612     ## FIRST, check the metadata_id supplied as parameter
1613     my $metadata = shift
1614         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_platform().\n");
1615
1616     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1617         croak("STORE ERROR: Metadbdata supplied to $self->store_platform() is not CXGN::Metadata::Metadbdata object.\n");
1618     }
1619
1620     ## It is not necessary check the current user used to store the data because should be the same than the used
1621     ## to create a metadata_id. In the medadbdata object, it is checked.
1622
1623     ## SECOND, check if exists or not platform_id.
1624     ##   if exists platform_id         => update
1625     ##   if do not exists platform_id  => insert
1626
1627     my $geplatform_row = $self->get_geplatform_row();
1628     my $platform_id = $geplatform_row->get_column('platform_id');
1629
1630     unless (defined $platform_id) {                                   ## NEW INSERT and DISCARD CHANGES
1631
1632         $metadata->store();
1633         my $metadata_id = $metadata->get_metadata_id();
1634
1635         $geplatform_row->set_column( metadata_id => $metadata_id );   ## Set the metadata_id column
1636
1637         $geplatform_row->insert()
1638                        ->discard_changes();                           ## It will set the row with the updated row
1639
1640         ## Now we set the platform_id value for all the rows that depends of it
1641
1642         my @geplatformdesign_rows = $self->get_geplatformdesign_rows();
1643         foreach my $geplatformdesign_row (@geplatformdesign_rows) {
1644             $geplatformdesign_row->set_column( platform_id => $geplatform_row->get_column('platform_id'));
1645         }
1646
1647         my @geplatformdbxref_rows = $self->get_geplatformdbxref_rows();
1648         foreach my $geplatformdbxref_row (@geplatformdbxref_rows) {
1649             $geplatformdbxref_row->set_column( platform_id => $geplatform_row->get_column('platform_id'));
1650         }
1651
1652         my @geplatformpub_rows = $self->get_geplatformpub_rows();
1653         foreach my $geplatformpub_row (@geplatformpub_rows) {
1654             $geplatformpub_row->set_column( platform_id => $geplatform_row->get_column('platform_id'));
1655         }
1656
1657
1658     }
1659     else {                                                            ## UPDATE IF SOMETHING has change
1660
1661         my @columns_changed = $geplatform_row->is_changed();
1662
1663         if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1664
1665             my @modification_note_list;                             ## the changes and the old metadata object for
1666             foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1667                 push @modification_note_list, "set value in $col_changed column";
1668             }
1669
1670             my $modification_note = join ', ', @modification_note_list;
1671
1672             my $mod_metadata = $self->get_platform_metadbdata($metadata);
1673             $mod_metadata->store({ modification_note => $modification_note });
1674             my $mod_metadata_id = $mod_metadata->get_metadata_id();
1675
1676             $geplatform_row->set_column( metadata_id => $mod_metadata_id );
1677
1678             $geplatform_row->update()
1679                            ->discard_changes();
1680         }
1681     }
1682 }
1683
1684
1685 =head2 obsolete_platform
1686
1687   Usage: $platform->obsolete_platform($metadata, $note, 'REVERT');
1688
1689   Desc: Change the status of a data to obsolete.
1690         If revert tag is used the obsolete status will be reverted to 0 (false)
1691
1692   Ret: None
1693
1694   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1695         $note, a note to explain the cause of make this data obsolete
1696         optional, 'REVERT'.
1697
1698   Side_Effects: Die if:
1699                 1- None metadata object is supplied.
1700                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1701
1702   Example: $platform->obsolete_platform($metadata, 'change to obsolete test');
1703
1704 =cut
1705
1706 sub obsolete_platform {
1707     my $self = shift;
1708
1709     ## FIRST, check the metadata_id supplied as parameter
1710
1711     my $metadata = shift
1712         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_platform().\n");
1713
1714     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1715         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_platform isn't CXGN::Metadata::Metadbdata obj.\n");
1716     }
1717
1718     my $obsolete_note = shift
1719         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_platform().\n");
1720
1721     my $revert_tag = shift;
1722
1723
1724     ## If exists the tag revert change obsolete to 0
1725
1726     my $obsolete = 1;
1727     my $modification_note = 'change to obsolete';
1728     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1729         $obsolete = 0;
1730         $modification_note = 'revert obsolete';
1731     }
1732
1733     ## Create a new metadata with the obsolete tag
1734
1735     my $mod_metadata = $self->get_platform_metadbdata($metadata);
1736     $mod_metadata->store( { modification_note => $modification_note,
1737                             obsolete          => $obsolete,
1738                             obsolete_note     => $obsolete_note } );
1739     my $mod_metadata_id = $mod_metadata->get_metadata_id();
1740
1741     ## Modify the group row in the database
1742
1743     my $geplatform_row = $self->get_geplatform_row();
1744
1745     $geplatform_row->set_column( metadata_id => $mod_metadata_id );
1746
1747     $geplatform_row->update()
1748                    ->discard_changes();
1749 }
1750
1751 =head2 store_platform_designs
1752
1753   Usage: my $platform = $platform->store_platform_designs($metadata);
1754
1755   Desc: Store in the database platform_designs associated to a platform
1756
1757   Ret: None.
1758
1759   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1760
1761   Side_Effects: Die if:
1762                 1- None metadata object is supplied.
1763                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1764                    object
1765
1766   Example: my $platform = $platform->store_platform_designs($metadata);
1767
1768 =cut
1769
1770 sub store_platform_designs {
1771     my $self = shift;
1772
1773     ## FIRST, check the metadata_id supplied as parameter
1774     my $metadata = shift
1775         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_platform_designs().\n");
1776
1777     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1778         croak("STORE ERROR: Metadbdata supplied to $self->store_platform_designs() is not CXGN::Metadata::Metadbdata object.\n");
1779     }
1780
1781     ## It is not necessary check the current user used to store the data because should be the same than the used
1782     ## to create a metadata_id. In the medadbdata object, it is checked.
1783
1784     ## SECOND, check if exists or not platform_designs_id.
1785     ##   if exists platform_designs_id         => update
1786     ##   if do not exists platform_designs_id  => insert
1787
1788     my $platform_id = $self->get_platform_id();
1789
1790     unless (defined $platform_id) {
1791         croak("STORE ERROR: Don't exist platform_id associated to this step.Use store_platform before use store_platform_designs.\n");
1792     }
1793
1794     my @geplatformdesigns_rows = $self->get_geplatformdesign_rows();
1795
1796     foreach my $geplatformdesign_row (@geplatformdesigns_rows) {
1797         my $platform_design_id = $geplatformdesign_row->get_column('platform_design_id');
1798
1799         unless (defined $platform_design_id) {                                  ## NEW INSERT and DISCARD CHANGES
1800
1801             my $metadata_id = $metadata->store()
1802                                        ->get_metadata_id();
1803
1804             $geplatformdesign_row->set_column( metadata_id => $metadata_id );   ## Set the metadata_id column
1805
1806             $geplatformdesign_row->insert()
1807                                  ->discard_changes();                           ## It will set the row with the updated row
1808         }
1809         else {                                                                 ## UPDATE IF SOMETHING has change
1810
1811             my @columns_changed = $geplatformdesign_row->is_changed();
1812
1813             if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1814
1815                 my @modification_note_list;                             ## the changes and the old metadata object for
1816                 foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1817                     push @modification_note_list, "set value in $col_changed column";
1818                 }
1819
1820                 my $modification_note = join ', ', @modification_note_list;
1821
1822                 my %se_metadata = $self->get_platform_design_metadbdata($metadata);
1823                 my $element_name = $geplatformdesign_row->get_column('platform_design_name');
1824                 my $mod_metadata_id = $se_metadata{$element_name}->store({ modification_note => $modification_note })
1825                                                                  ->get_metadata_id();
1826
1827                 $geplatformdesign_row->set_column( metadata_id => $mod_metadata_id );
1828
1829                 $geplatformdesign_row->update()
1830                                     ->discard_changes();
1831             }
1832         }
1833     }
1834 }
1835
1836 =head2 obsolete_platform_design
1837
1838   Usage: my $platform = $platform->obsolete_platform_design( $metadata,
1839                                                         $note,
1840                                                         $element_name,
1841                                                         'REVERT'
1842                                                       );
1843
1844   Desc: Change the status of a data to obsolete.
1845         If revert tag is used the obsolete status will
1846         be reverted to 0 (false)
1847
1848   Ret: none.
1849
1850   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1851         $note, a note to explain the cause of make this data obsolete
1852         $element_name, the sample_element_name that identify this sample_element
1853         optional, 'REVERT'.
1854
1855   Side_Effects: Die if:
1856                 1- None metadata object is supplied.
1857                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1858
1859   Example: my $platform = $platform->obsolete_platform_design( $metadata,
1860                                                           change to obsolete',
1861                                                           $element_name );
1862
1863 =cut
1864
1865 sub obsolete_platform_design {
1866     my $self = shift;
1867
1868     ## FIRST, check the metadata_id supplied as parameter
1869
1870     my $metadata = shift
1871         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_platform_design().\n");
1872
1873     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1874         croak("OBSOLETE ERROR: Metadbdata object supplied to $self->obsolete_platform_design is not CXGN::Metadata::Metadbdata obj.\n");
1875     }
1876
1877     my $obsolete_note = shift
1878         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_platform_design().\n");
1879
1880     my $element_name = shift
1881         || croak("OBSOLETE ERROR: None platform_design_name was supplied to $self->obsolete_platform_design().\n");
1882
1883     my $revert_tag = shift;
1884
1885
1886     ## If exists the tag revert change obsolete to 0
1887
1888     my $obsolete = 1;
1889     my $modification_note = 'change to obsolete';
1890     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1891         $obsolete = 0;
1892         $modification_note = 'revert obsolete';
1893     }
1894
1895     ## Create a new metadata with the obsolete tag
1896
1897     my %platform_design_metadata = $self->get_platform_design_metadbdata($metadata);
1898     my $mod_metadata_id = $platform_design_metadata{$element_name}->store( {
1899                                                                             modification_note => $modification_note,
1900                                                                             obsolete          => $obsolete,
1901                                                                             obsolete_note     => $obsolete_note
1902                                                                           } )
1903                                                                  ->get_metadata_id();
1904
1905     ## Modify the group row in the database
1906
1907     my @geplatformdesign_rows = $self->get_geplatformdesign_rows();
1908
1909     foreach my $geplatformdesign_row (@geplatformdesign_rows) {
1910         my $sample_name;
1911         my $sample_id = $geplatformdesign_row->get_column('sample_id');
1912         if (defined $sample_id) {
1913             my ($sample) = $self->get_schema()
1914                                 ->resultset('BsSample')
1915                                 ->search({ sample_id => $sample_id });
1916
1917             if (defined $sample) {
1918                 $sample_name = $sample->get_column('sample_name');
1919             }
1920         }
1921         if ($sample_name eq $element_name) {
1922             $geplatformdesign_row->set_column( metadata_id => $mod_metadata_id );
1923             $geplatformdesign_row->update()
1924                                  ->discard_changes();
1925         }
1926     }
1927 }
1928
1929
1930 =head2 store_dbxref_associations
1931
1932   Usage: $platform->store_dbxref_associations($metadata);
1933
1934   Desc: Store in the database the dbxref association for the platform
1935         object
1936
1937   Ret: None
1938
1939   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1940
1941   Side_Effects: Die if:
1942                 1- None metadata object is supplied.
1943                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1944                    object
1945
1946   Example: $platform->store_dbxref_associations($metadata);
1947
1948 =cut
1949
1950 sub store_dbxref_associations {
1951     my $self = shift;
1952
1953     ## FIRST, check the metadata_id supplied as parameter
1954     my $metadata = shift
1955         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_dbxref_associations().\n");
1956
1957     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1958         croak("STORE ERROR: Metadbdata supplied to $self->store_dbxref_associations() is not CXGN::Metadata::Metadbdata object.\n");
1959     }
1960
1961     ## It is not necessary check the current user used to store the data because should be the same than the used
1962     ## to create a metadata_id. In the medadbdata object, it is checked.
1963
1964     ## SECOND, check if exists or not platform_dbxref_id.
1965     ##   if exists platform_dbxref_id         => update
1966     ##   if do not exists platform_dbxref_id  => insert
1967
1968     my @geplatformdbxref_rows = $self->get_geplatformdbxref_rows();
1969
1970     foreach my $geplatformdbxref_row (@geplatformdbxref_rows) {
1971
1972         my $platform_dbxref_id = $geplatformdbxref_row->get_column('platform_dbxref_id');
1973         my $dbxref_id = $geplatformdbxref_row->get_column('dbxref_id');
1974
1975         unless (defined $platform_dbxref_id) {                                ## NEW INSERT and DISCARD CHANGES
1976
1977             $metadata->store();
1978             my $metadata_id = $metadata->get_metadata_id();
1979
1980             $geplatformdbxref_row->set_column( metadata_id => $metadata_id );    ## Set the metadata_id column
1981
1982             $geplatformdbxref_row->insert()
1983                                  ->discard_changes();                            ## It will set the row with the updated row
1984
1985         }
1986         else {                                                                    ## UPDATE IF SOMETHING has change
1987
1988             my @columns_changed = $geplatformdbxref_row->is_changed();
1989
1990             if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1991
1992                 my @modification_note_list;                             ## the changes and the old metadata object for
1993                 foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1994                     push @modification_note_list, "set value in $col_changed column";
1995                 }
1996
1997                 my $modification_note = join ', ', @modification_note_list;
1998
1999                 my %asdbxref_metadata = $self->get_platform_dbxref_metadbdata($metadata);
2000                 my $mod_metadata = $asdbxref_metadata{$dbxref_id}->store({ modification_note => $modification_note });
2001                 my $mod_metadata_id = $mod_metadata->get_metadata_id();
2002
2003                 $geplatformdbxref_row->set_column( metadata_id => $mod_metadata_id );
2004
2005                 $geplatformdbxref_row->update()
2006                                    ->discard_changes();
2007             }
2008         }
2009     }
2010 }
2011
2012 =head2 obsolete_dbxref_association
2013
2014   Usage: $platform->obsolete_dbxref_association($metadata, $note, $dbxref_id, 'REVERT');
2015
2016   Desc: Change the status of a data to obsolete.
2017         If revert tag is used the obsolete status will be reverted to 0 (false)
2018
2019   Ret: None
2020
2021   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
2022         $note, a note to explain the cause of make this data obsolete
2023         $dbxref_id, a dbxref id
2024         optional, 'REVERT'.
2025
2026   Side_Effects: Die if:
2027                 1- None metadata object is supplied.
2028                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
2029
2030   Example: $platform->obsolete_dbxref_association($metadata,
2031                                                     'change to obsolete test',
2032                                                     $dbxref_id );
2033
2034 =cut
2035
2036 sub obsolete_dbxref_association {
2037     my $self = shift;
2038
2039     ## FIRST, check the metadata_id supplied as parameter
2040
2041     my $metadata = shift
2042         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_dbxref_association().\n");
2043
2044     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
2045         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_dbxref_association is not CXGN::Metadata::Metadbdata obj.\n");
2046     }
2047
2048     my $obsolete_note = shift
2049         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_dbxref_association().\n");
2050
2051     my $dbxref_id = shift
2052         || croak("OBSOLETE ERROR: None dbxref_id was supplied to $self->obsolete_dbxref_association().\n");
2053
2054     my $revert_tag = shift;
2055
2056
2057     ## If exists the tag revert change obsolete to 0
2058
2059     my $obsolete = 1;
2060     my $modification_note = 'change to obsolete';
2061     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
2062         $obsolete = 0;
2063         $modification_note = 'revert obsolete';
2064     }
2065
2066     ## Create a new metadata with the obsolete tag
2067
2068     my %asdbxref_metadata = $self->get_platform_dbxref_metadbdata($metadata);
2069     my $mod_metadata_id = $asdbxref_metadata{$dbxref_id}->store( { modification_note => $modification_note,
2070                                                                    obsolete          => $obsolete,
2071                                                                    obsolete_note     => $obsolete_note } )
2072                                                         ->get_metadata_id();
2073
2074     ## Modify the group row in the database
2075
2076     my @geplatformdbxref_rows = $self->get_geplatformdbxref_rows();
2077     foreach my $geplatformdbxref_row (@geplatformdbxref_rows) {
2078         if ($geplatformdbxref_row->get_column('dbxref_id') == $dbxref_id) {
2079
2080             $geplatformdbxref_row->set_column( metadata_id => $mod_metadata_id );
2081
2082             $geplatformdbxref_row->update()
2083                                ->discard_changes();
2084         }
2085     }
2086 }
2087
2088 =head2 store_pub_associations
2089
2090   Usage: $platform->store_pub_associations($metadata);
2091
2092   Desc: Store in the database the pub association for the platform
2093         object
2094
2095   Ret: None
2096
2097   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
2098
2099   Side_Effects: Die if:
2100                 1- None metadata object is supplied.
2101                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
2102                    object
2103
2104   Example: $platform->store_pub_associations($metadata);
2105
2106 =cut
2107
2108 sub store_pub_associations {
2109     my $self = shift;
2110
2111     ## FIRST, check the metadata_id supplied as parameter
2112     my $metadata = shift
2113         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_dbxref_associations().\n");
2114
2115     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
2116         croak("STORE ERROR: Metadbdata supplied to $self->store_dbxref_associations() is not CXGN::Metadata::Metadbdata object.\n");
2117     }
2118
2119     ## It is not necessary check the current user used to store the data because should be the same than the used
2120     ## to create a metadata_id. In the medadbdata object, it is checked.
2121
2122     ## SECOND, check if exists or not platform_dbxref_id.
2123     ##   if exists platform_pub_id         => update
2124     ##   if do not exists platform_pub_id  => insert
2125
2126     my @geplatformpub_rows = $self->get_geplatformpub_rows();
2127
2128     foreach my $geplatformpub_row (@geplatformpub_rows) {
2129
2130         my $platform_pub_id = $geplatformpub_row->get_column('platform_pub_id');
2131         my $pub_id = $geplatformpub_row->get_column('pub_id');
2132
2133         unless (defined $platform_pub_id) {                                ## NEW INSERT and DISCARD CHANGES
2134
2135             $metadata->store();
2136             my $metadata_id = $metadata->get_metadata_id();
2137
2138             $geplatformpub_row->set_column( metadata_id => $metadata_id );    ## Set the metadata_id column
2139
2140             $geplatformpub_row->insert()
2141                                  ->discard_changes();                            ## It will set the row with the updated row
2142
2143         }
2144         else {                                                                    ## UPDATE IF SOMETHING has change
2145
2146             my @columns_changed = $geplatformpub_row->is_changed();
2147
2148             if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
2149
2150                 my @modification_note_list;                             ## the changes and the old metadata object for
2151                 foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
2152                     push @modification_note_list, "set value in $col_changed column";
2153                 }
2154
2155                 my $modification_note = join ', ', @modification_note_list;
2156
2157                 my %aspub_metadata = $self->get_platform_pub_metadbdata($metadata);
2158                 my $mod_metadata = $aspub_metadata{$pub_id}->store({ modification_note => $modification_note });
2159                 my $mod_metadata_id = $mod_metadata->get_metadata_id();
2160
2161                 $geplatformpub_row->set_column( metadata_id => $mod_metadata_id );
2162
2163                 $geplatformpub_row->update()
2164                                   ->discard_changes();
2165             }
2166         }
2167     }
2168 }
2169
2170 =head2 obsolete_pub_association
2171
2172   Usage: $platform->obsolete_pub_association($metadata, $note, $pub_id, 'REVERT');
2173
2174   Desc: Change the status of a data to obsolete.
2175         If revert tag is used the obsolete status will be reverted to 0 (false)
2176
2177   Ret: None
2178
2179   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
2180         $note, a note to explain the cause of make this data obsolete
2181         $pub_id, a pub_id
2182         optional, 'REVERT'.
2183
2184   Side_Effects: Die if:
2185                 1- None metadata object is supplied.
2186                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
2187
2188   Example: $platform->obsolete_pub_association($metadata,
2189                                                'change to obsolete test',
2190                                                $pub_id );
2191
2192 =cut
2193
2194 sub obsolete_pub_association {
2195     my $self = shift;
2196
2197     ## FIRST, check the metadata_id supplied as parameter
2198
2199     my $metadata = shift
2200         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_pub_association().\n");
2201
2202     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
2203         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_pub_association is not CXGN::Metadata::Metadbdata obj.\n");
2204     }
2205
2206     my $obsolete_note = shift
2207         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_pub_association().\n");
2208
2209     my $pub_id = shift
2210         || croak("OBSOLETE ERROR: None pub_id was supplied to $self->obsolete_pub_association().\n");
2211
2212     my $revert_tag = shift;
2213
2214
2215     ## If exists the tag revert change obsolete to 0
2216
2217     my $obsolete = 1;
2218     my $modification_note = 'change to obsolete';
2219     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
2220         $obsolete = 0;
2221         $modification_note = 'revert obsolete';
2222     }
2223
2224     ## Create a new metadata with the obsolete tag
2225
2226     my %aspub_metadata = $self->get_platform_pub_metadbdata($metadata);
2227     my $mod_metadata_id = $aspub_metadata{$pub_id}->store( { modification_note => $modification_note,
2228                                                              obsolete          => $obsolete,
2229                                                              obsolete_note     => $obsolete_note } )
2230                                                   ->get_metadata_id();
2231
2232     ## Modify the group row in the database
2233
2234     my @geplatformpub_rows = $self->get_geplatformpub_rows();
2235     foreach my $geplatformpub_row (@geplatformpub_rows) {
2236         if ($geplatformpub_row->get_column('pub_id') == $pub_id) {
2237
2238             $geplatformpub_row->set_column( metadata_id => $mod_metadata_id );
2239
2240             $geplatformpub_row->update()
2241                               ->discard_changes();
2242         }
2243     }
2244 }
2245
2246
2247
2248 #####################
2249 ### OTHER METHODS ###
2250 #####################
2251
2252 =head2 get_technology_type
2253
2254   Usage: my $technologytype = $platform->get_technology_type();
2255
2256   Desc: Get a CXGN::GEM::TechnologyType object.
2257
2258   Ret:  A CXGN::GEM::TechnologyType object.
2259
2260   Args: none
2261
2262   Side_Effects: die if the platform object have not any
2263                 technology_type_id
2264
2265   Example: my $technologytype = $platform->get_technology_type();
2266
2267 =cut
2268
2269 sub get_technology_type {
2270    my $self = shift;
2271
2272    my $technology_type_id = $self->get_technology_type_id();
2273
2274    unless (defined $technology_type_id) {
2275        croak("OBJECT MANIPULATION ERROR: The $self object haven't any technology_type_id. Probably it hasn't store yet.\n");
2276    }
2277
2278    my $techtype = CXGN::GEM::TechnologyType->new($self->get_schema(), $technology_type_id);
2279
2280    return $techtype;
2281 }
2282
2283
2284 =head2 get_template_list
2285
2286   Usage: my @templates = $platform->get_template_list();
2287
2288   Desc: Get a list of CXGN::GEM::Template objects.
2289
2290   Ret:  An array of CXGN::GEM::Templates objects.
2291
2292   Args: none
2293
2294   Side_Effects: die if the platform object have not any
2295                 platform_id
2296
2297   Example: my @templates = $platform->get_template_list();
2298
2299 =cut
2300
2301 sub get_template_list {
2302    my $self = shift;
2303
2304    my @templates = ();
2305
2306    my $platform_id = $self->get_platform_id();
2307
2308    unless (defined $platform_id) {
2309        croak("OBJECT MANIPULATION ERROR: The $self object haven't any platform_id. Probably it hasn't store yet.\n");
2310    }
2311
2312    my @getemplate_rows = $self->get_schema()
2313                               ->resultset('GeTemplate')
2314                               ->search( { platform_id => $platform_id } );
2315
2316    foreach my $getemplate_row (@getemplate_rows) {
2317
2318        my $template = CXGN::GEM::Template->new($self->get_schema(), $getemplate_row->get_column('template_id') );
2319
2320        push @templates, $template;
2321    }
2322
2323    return @templates;
2324 }
2325
2326 =head2 count_templates
2327
2328   Usage: my $template_count = $platform->count_templates();
2329
2330   Desc: Count how many templates has associated this platform
2331
2332   Ret:  $templates_n, a scalar
2333
2334   Args: none
2335
2336   Side_Effects: return undef if the platform has not platform_id
2337
2338   Example: my $templates_n = $platform->count_templates();
2339
2340 =cut
2341
2342 sub count_templates {
2343     my $self = shift;
2344
2345     my $templates_count;
2346
2347     my $platform_id = $self->get_platform_id();
2348
2349     if (defined $platform_id) {
2350         $templates_count = $self->get_schema()
2351                                 ->resultset('GeTemplate')
2352                                 ->search({ platform_id => $platform_id })
2353                                 ->count();
2354     }
2355
2356     return $templates_count;
2357 }
2358
2359 =head2 count_probes
2360
2361   Usage: my $probe_count = $platform->count_probes();
2362
2363   Desc: Count how many probes has associated this platform
2364
2365   Ret:  $probes_count, a scalar
2366
2367   Args: none
2368
2369   Side_Effects: return undef if the platform has not platform_id
2370
2371   Example: my $probes_n = $platform->count_probes();
2372
2373 =cut
2374
2375 sub count_probes {
2376     my $self = shift;
2377
2378     my $probes_count;
2379
2380     my $platform_id = $self->get_platform_id();
2381
2382     if (defined $platform_id) {
2383         $probes_count = $self->get_schema()
2384                              ->resultset('GeProbe')
2385                              ->search({ platform_id => $platform_id })
2386                              ->count();
2387     }
2388
2389     return $probes_count;
2390 }
2391
2392 ####
2393 1;##
2394 ####