lib/CXGN/GEM/Template.pm

   1 package CXGN::GEM::Template;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw | CXGN::DB::Object |;
   7 use Bio::Chado::Schema;
   8 use CXGN::Biosource::Schema;
   9 use CXGN::Metadata::Metadbdata;
  10 use CXGN::Metadata::Dbiref;
  11 use CXGN::Metadata::Dbipath;
  12 use CXGN::GEM::Platform;
  13
  14 use Carp qw| croak cluck carp |;
  15
  16
  17
  18 ###############
  19 ### PERLDOC ###
  20 ###############
  21
  22 =head1 NAME
  23
  24 CXGN::GEM::Template
  25 a class to manipulate a template data from the gem schema.
  26
  27 =cut
  28
  29 our $VERSION = '0.01';
  30 $VERSION = eval $VERSION;
  31
  32 =head1 SYNOPSIS
  33
  34  use CXGN::GEM::Template;
  35
  36  ## Constructor
  37
  38   my $template = CXGN::GEM::Template->new($schema, $template_id);
  39   my $template = CXGN::GEM::Template->new_by_name($schema, $template_id);
  40
  41  ## Simple accessors (template_name, template_type, platform_id, )
  42
  43   my $template_name = $template->get_template_name();
  44   $template->set_template_name($template_name);
  45
  46  ## Extended accessors (dbxref, dbiref)
  47
  48   my @dbxref_list_id = $template->get_dbxref_list();
  49   $template->add_dbxref($dbxref_id);
  50
  51  ## Metadata functions (aplicable to extended data as dbxref or target_element)
  52
  53   my $metadbdata = $template->get_template_metadbdata();
  54   unless ($template->is_template_obsolete()) {
  55                    ## do something
  56            }
  57
  58  ## Store functions (aplicable to extended data as dbxref or target_element)
  59
  60   $template->store($metadata);
  61   $template->obsolete_template($metadata, $note, 'REVERT');
  62
  63  ## Functions related with other objects
  64
  65   my $platform = $template->get_platform();
  66   my @dbirefs = $template->get_dbiref_obj_list();
  67
  68 =head1 DESCRIPTION
  69
  70  This object manage the target information of the database
  71  from the tables:
  72
  73    + gem.ge_template
  74    + gem.ge_template_dbxref
  75    + gem.ge_template_dbiref
  76
  77  This data is stored inside this object as dbic rows objects with the
  78  following structure:
  79
  80   %Template_Object = (
  81
  82        ge_template_row        => GeTemplate_row,
  83
  84        ge_template_dbxref_row => [ @GeTemplateDbxref_rows],
  85
  86        ge_template_dbiref_row => [ @GeTemplateDbiref_rows],
  87
  88   );
  89
  90
  91 =head1 AUTHOR
  92
  93 Aureliano Bombarely <ab782@cornell.edu>
  94
  95
  96 =head1 CLASS METHODS
  97
  98 The following class methods are implemented:
  99
 100 =cut
 101
 102
 103 ############################
 104 ### GENERAL CONSTRUCTORS ###
 105 ############################
 106
 107 =head2 constructor new
 108
 109   Usage: my $template = CXGN::GEM::Template->new($schema, $template_id);
 110
 111   Desc: Create a new template object
 112
 113   Ret: a CXGN::GEM::Template 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 $template_id, a scalar.
 120         If $template_id is omitted, an empty template object is created.
 121
 122   Side_Effects: access to database, check if exists the database columns that
 123                  this object use.  die if the id is not an integer.
 124
 125   Example: my $template = CXGN::GEM::Template->new($schema, $template_id);
 126
 127 =cut
 128
 129 sub new {
 130     my $class = shift;
 131     my $schema = shift ||
 132         croak("PARAMETER ERROR: None schema object was supplied to the $class->new() function.\n");
 133     my $id = shift;
 134
 135     ### First, bless the class to create the object and set the schema into de object
 136     ### (set_schema comes from CXGN::DB::Object).
 137
 138     my $self = $class->SUPER::new($schema);
 139     $self->set_schema($schema);
 140
 141     ### Second, check that ID is an integer. If it is right go and get all the data for
 142     ### this row in the database and after that get the data for template
 143     ### If don't find any, create an empty oject.
 144     ### If it is not an integer, die
 145
 146     my $template;
 147     my @template_dbxrefs = ();
 148     my @template_dbirefs = ();
 149
 150     if (defined $id) {
 151         unless ($id =~ m/^\d+$/) {  ## The id can be only an integer... so it is better if we detect this fail before.
 152
 153             croak("\nDATA TYPE ERROR: The template_id ($id) for $class->new() IS NOT AN INTEGER.\n\n");
 154         }
 155
 156         ## Get the ge_template_row object using a search based in the template_id
 157
 158         ($template) = $schema->resultset('GeTemplate')
 159                              ->search( { template_id => $id } );
 160
 161         if (defined $template) {
 162
 163             ## Search template_dbxref associations
 164
 165             @template_dbxrefs = $schema->resultset('GeTemplateDbxref')
 166                                        ->search( { template_id => $id } );
 167
 168             ## Search template_dbxref associations
 169
 170             @template_dbirefs = $schema->resultset('GeTemplateDbiref')
 171                                        ->search( { template_id => $id } );
 172         }
 173         else {
 174                 $template = $schema->resultset('GeTemplate')
 175                            ->new({});                              ### Create an empty object;
 176         }
 177     }
 178     else {
 179         $template = $schema->resultset('GeTemplate')
 180                            ->new({});                              ### Create an empty object;
 181     }
 182
 183     ## Finally it will load the rows into the object.
 184     $self->set_getemplate_row($template);
 185     $self->set_getemplatedbxref_rows(\@template_dbxrefs);
 186     $self->set_getemplatedbiref_rows(\@template_dbirefs);
 187
 188     return $self;
 189 }
 190
 191 =head2 constructor new_by_name
 192
 193   Usage: my $template = CXGN::GEM::Template->new_by_name($schema, $name);
 194
 195   Desc: Create a new Experiment object using template_name
 196
 197   Ret: a CXGN::GEM::Template object
 198
 199   Args: a $schema a schema object, preferentially created using:
 200         CXGN::GEM::Schema->connect(
 201                    sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
 202                    %other_parameters );
 203         a $template_name, a scalar
 204
 205   Side_Effects: accesses the database,
 206                 return a warning if the experiment name do not exists
 207                 into the db
 208
 209   Example: my $template = CXGN::GEM::Template->new_by_name($schema, $name);
 210
 211 =cut
 212
 213 sub new_by_name {
 214     my $class = shift;
 215     my $schema = shift ||
 216         croak("PARAMETER ERROR: None schema object was supplied to the $class->new_by_name() function.\n");
 217     my $name = shift;
 218
 219     ### It will search the template_id for this name and it will get the template_id for that using the new
 220     ### method to create a new object. If the name don't exists into the database it will create a empty object and
 221     ### it will set the template_name for it
 222
 223     my $template;
 224
 225     if (defined $name) {
 226         my ($template_row) = $schema->resultset('GeTemplate')
 227                                     ->search({ template_name => $name });
 228
 229         unless (defined $template_row) {
 230             warn("DATABASE OUTPUT WARNING: template_name ($name) for $class->new_by_name() DON'T EXISTS INTO THE DB.\n");
 231
 232             ## If do not exists any template with this name, it will return a warning and it will create an empty
 233             ## object with the template name set in it.
 234
 235             $template = $class->new($schema);
 236             $template->set_template_name($name);
 237         }
 238         else {
 239
 240             ## if exists it will take the template_id to create the object with the new constructor
 241             $template = $class->new( $schema, $template_row->get_column('template_id') );
 242         }
 243     }
 244     else {
 245         $template = $class->new($schema);                              ### Create an empty object;
 246     }
 247
 248     return $template;
 249 }
 250
 251
 252 ##################################
 253 ### DBIX::CLASS ROWS ACCESSORS ###
 254 ##################################
 255
 256 =head2 accessors get_getemplate_row, set_getemplate_row
 257
 258   Usage: my $getemplate_row = $self->get_getemplate_row();
 259          $self->set_getemplate_row($getemplate_row_object);
 260
 261   Desc: Get or set a getemplate row object into a template
 262         object
 263
 264   Ret:   Get => $getemplate_row_object, a row object
 265                 (CXGN::GEM::Schema::GeTemplate).
 266          Set => none
 267
 268   Args:  Get => none
 269          Set => $getemplate_row_object, a row object
 270                 (CXGN::GEM::Schema::GeTemplate).
 271
 272   Side_Effects: With set check if the argument is a row object. If fail, dies.
 273
 274   Example: my $getemplate_row = $self->get_getemplate_row();
 275            $self->set_getemplate_row($getemplate_row);
 276
 277 =cut
 278
 279 sub get_getemplate_row {
 280   my $self = shift;
 281
 282   return $self->{getemplate_row};
 283 }
 284
 285 sub set_getemplate_row {
 286   my $self = shift;
 287   my $getemplate_row = shift
 288       || croak("FUNCTION PARAMETER ERROR: None getemplate_row object was supplied for $self->set_getemplate_row function.\n");
 289
 290   if (ref($getemplate_row) ne 'CXGN::GEM::Schema::GeTemplate') {
 291       croak("SET ARGUMENT ERROR: $getemplate_row isn't a getemplate_row obj. (CXGN::GEM::Schema::GeTemplate).\n");
 292   }
 293   $self->{getemplate_row} = $getemplate_row;
 294 }
 295
 296
 297 =head2 accessors get_getemplatedbxref_rows, set_getemplatedbxref_rows
 298
 299   Usage: my @getemplatedbxref_rows = $self->get_getemplatedbxref_rows();
 300          $self->set_getemplatedbxref_rows(\@getemplatedbxref_rows);
 301
 302   Desc: Get or set a list of getemplatedbxref rows object into an
 303         template object
 304
 305   Ret:   Get => @getemplatedbxref_row_object, a list of row objects
 306                 (CXGN::GEM::Schema::GeTemplateDbxref).
 307          Set => none
 308
 309   Args:  Get => none
 310          Set => \@getemplatedbxref_row_object, an array ref of row objects
 311                 (CXGN::GEM::Schema::GeTemplateDbxref).
 312
 313   Side_Effects: With set check if the argument is a row object. If fail, dies.
 314
 315   Example: my @getemplatedbxref_rows = $self->get_getemplatedbxref_rows();
 316            $self->set_getemplatedbxref_rows(\@getemplatedbxref_rows);
 317
 318 =cut
 319
 320 sub get_getemplatedbxref_rows {
 321   my $self = shift;
 322
 323   return @{$self->{getemplatedbxref_rows}};
 324 }
 325
 326 sub set_getemplatedbxref_rows {
 327   my $self = shift;
 328   my $getemplatedbxref_row_aref = shift
 329       || croak("FUNCTION PARAMETER ERROR:None getemplatedbxref_row array ref was supplied for $self->set_getemplatedbxref_rows().\n");
 330
 331   if (ref($getemplatedbxref_row_aref) ne 'ARRAY') {
 332       croak("SET ARGUMENT ERROR: $getemplatedbxref_row_aref isn't an array reference for $self->set_getemplatedbxref_rows().\n");
 333   }
 334   else {
 335       foreach my $getemplatedbxref_row (@{$getemplatedbxref_row_aref}) {
 336           if (ref($getemplatedbxref_row) ne 'CXGN::GEM::Schema::GeTemplateDbxref') {
 337               croak("SET ARGUMENT ERROR:$getemplatedbxref_row isn't getemplatedbxref_row obj.\n");
 338           }
 339       }
 340   }
 341   $self->{getemplatedbxref_rows} = $getemplatedbxref_row_aref;
 342 }
 343
 344
 345 =head2 accessors get_getemplatedbiref_rows, set_getemplatedbiref_rows
 346
 347   Usage: my @getemplatedbiref_rows = $self->get_getemplatedbiref_rows();
 348          $self->set_getemplatedbiref_rows(\@getemplatedbiref_rows);
 349
 350   Desc: Get or set a list of getemplatedbiref rows object into an
 351         template object
 352
 353   Ret:   Get => @getemplatedbiref_row_object, a list of row objects
 354                 (CXGN::GEM::Schema::GeTemplateDbiref).
 355          Set => none
 356
 357   Args:  Get => none
 358          Set => \@getemplatedbxref_row_object, an array ref of row objects
 359                 (CXGN::GEM::Schema::GeTemplateDbiref).
 360
 361   Side_Effects: With set check if the argument is a row object. If fail, dies.
 362
 363   Example: my @getemplatedbiref_rows = $self->get_getemplatedbiref_rows();
 364            $self->set_getemplatedbiref_rows(\@getemplatedbiref_rows);
 365
 366 =cut
 367
 368 sub get_getemplatedbiref_rows {
 369   my $self = shift;
 370
 371   return @{$self->{getemplatedbiref_rows}};
 372 }
 373
 374 sub set_getemplatedbiref_rows {
 375   my $self = shift;
 376   my $getemplatedbiref_row_aref = shift
 377       || croak("FUNCTION PARAMETER ERROR:None getemplatedbiref_row array ref was supplied for $self->set_getemplatedbiref_rows().\n");
 378
 379   if (ref($getemplatedbiref_row_aref) ne 'ARRAY') {
 380       croak("SET ARGUMENT ERROR: $getemplatedbiref_row_aref isn't an array reference for $self->set_getemplatedbiref_rows().\n");
 381   }
 382   else {
 383       foreach my $getemplatedbiref_row (@{$getemplatedbiref_row_aref}) {
 384           if (ref($getemplatedbiref_row) ne 'CXGN::GEM::Schema::GeTemplateDbiref') {
 385               croak("SET ARGUMENT ERROR:$getemplatedbiref_row isn't getemplatedbiref_row obj.\n");
 386           }
 387       }
 388   }
 389   $self->{getemplatedbiref_rows} = $getemplatedbiref_row_aref;
 390 }
 391
 392
 393 ###################################
 394 ### DATA ACCESSORS FOR TEMPLATE ###
 395 ###################################
 396
 397 =head2 get_template_id, force_set_template_id
 398
 399   Usage: my $template_id = $template->get_template_id();
 400          $template->force_set_template_id($template_id);
 401
 402   Desc: get or set a template_id in a template object.
 403         set method should be USED WITH PRECAUTION
 404         If you want set a template_id that do not exists into the
 405         database you should consider that when you store this object you
 406         CAN STORE a experiment_id that do not follow the
 407         gem.ge_template_template_id_seq
 408
 409   Ret:  get=> $template_id, a scalar.
 410         set=> none
 411
 412   Args: get=> none
 413         set=> $template_id, a scalar (constraint: it must be an integer)
 414
 415   Side_Effects: none
 416
 417   Example: my $template_id = $template->get_template_id();
 418
 419 =cut
 420
 421 sub get_template_id {
 422   my $self = shift;
 423   return $self->get_getemplate_row->get_column('template_id');
 424 }
 425
 426 sub force_set_template_id {
 427   my $self = shift;
 428   my $data = shift ||
 429       croak("FUNCTION PARAMETER ERROR: None template_id was supplied for force_set_template_id function");
 430
 431   unless ($data =~ m/^\d+$/) {
 432       croak("DATA TYPE ERROR: The template_id ($data) for $self->force_set_template_id() ISN'T AN INTEGER.\n");
 433   }
 434
 435   $self->get_getemplate_row()
 436        ->set_column( template_id => $data );
 437
 438 }
 439
 440 =head2 accessors get_template_name, set_template_name
 441
 442   Usage: my $template_name = $template->get_template_name();
 443          $template->set_template_name($template_name);
 444
 445   Desc: Get or set the template_name from template object.
 446
 447   Ret:  get=> $template_name, a scalar
 448         set=> none
 449
 450   Args: get=> none
 451         set=> $template_name, a scalar
 452
 453   Side_Effects: none
 454
 455   Example: my $template_name = $template->get_template_name();
 456            $template->set_template_name($new_name);
 457 =cut
 458
 459 sub get_template_name {
 460   my $self = shift;
 461   return $self->get_getemplate_row->get_column('template_name');
 462 }
 463
 464 sub set_template_name {
 465   my $self = shift;
 466   my $data = shift
 467       || croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->set_template_name function.\n");
 468
 469   $self->get_getemplate_row()
 470        ->set_column( template_name => $data );
 471 }
 472
 473
 474 =head2 accessors get_template_type, set_template_type
 475
 476   Usage: my $template_type = $template->get_template_type();
 477          $template->set_template_type($template_type);
 478
 479   Desc: Get or set the template_type from template object.
 480
 481   Ret:  get=> $template_type, a scalar
 482         set=> none
 483
 484   Args: get=> none
 485         set=> $template_type, a scalar
 486
 487   Side_Effects: none
 488
 489   Example: my $template_type = $template->get_template_type();
 490            $template->set_template_type($type);
 491 =cut
 492
 493 sub get_template_type {
 494   my $self = shift;
 495   return $self->get_getemplate_row->get_column('template_type');
 496 }
 497
 498 sub set_template_type {
 499   my $self = shift;
 500   my $data = shift
 501       || croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->set_template_type function.\n");
 502
 503   $self->get_getemplate_row()
 504        ->set_column( template_type => $data );
 505 }
 506
 507
 508 =head2 accessors get_platform_id, set_platform_id
 509
 510   Usage: my $platform_id = $template->get_platform_id();
 511          $template->set_platform_id($platform_id);
 512
 513   Desc: Get or set platform_id from a template object.
 514
 515   Ret:  get=> $platform_id, a scalar
 516         set=> none
 517
 518   Args: get=> none
 519         set=> $platform_id, a scalar
 520
 521   Side_Effects: For the set accessor, die if the platform_id don't
 522                 exists into the database
 523
 524   Example: my $platform_id = $template->get_platform_id();
 525            $template->set_platform_id($platform_id);
 526 =cut
 527
 528 sub get_platform_id {
 529   my $self = shift;
 530   return $self->get_getemplate_row->get_column('platform_id');
 531 }
 532
 533 sub set_platform_id {
 534   my $self = shift;
 535   my $data = shift
 536       || croak("FUNCTION PARAMETER ERROR: None data was supplied for $self->set_platform_id function.\n");
 537
 538   unless ($data =~ m/^\d+$/) {
 539       croak("DATA TYPE ERROR: The experiment_id ($data) for $self->set_experiment_id() ISN'T AN INTEGER.\n");
 540   }
 541
 542   $self->get_getemplate_row()
 543        ->set_column( platform_id => $data );
 544 }
 545
 546
 547 ##########################################
 548 ### DATA ACCESSORS FOR TEMPLATE DBXREF ###
 549 ##########################################
 550
 551 =head2 add_dbxref
 552
 553   Usage: $template->add_dbxref($dbxref_id);
 554
 555   Desc: Add a dbxref to the dbxref_ids associated to sample
 556         object using dbxref_id or accesion + database_name
 557
 558   Ret:  None
 559
 560   Args: $dbxref_id, a dbxref id.
 561         To use with accession and dbxname:
 562           $template->add_dbxref(
 563                                {
 564                                  accession => $accesssion,
 565                                  dbxname   => $dbxname,
 566                                }
 567                              );
 568
 569   Side_Effects: die if the parameter is not an hash reference
 570
 571   Example: $template->add_dbxref($dbxref_id);
 572            $template->add_dbxref(
 573                                 {
 574                                   accession => 'GSE3380',
 575                                   dbxname   => 'GEO Accession Display',
 576                                 }
 577                               );
 578 =cut
 579
 580 sub add_dbxref {
 581     my $self = shift;
 582     my $dbxref = shift ||
 583         croak("FUNCTION PARAMETER ERROR: None dbxref data was supplied for $self->add_dbxref function.\n");
 584
 585     my $dbxref_id;
 586
 587     ## If the imput parameter is an integer, treat it as id, if not do it as hash reference
 588
 589     if ($dbxref =~ m/^\d+$/) {
 590         $dbxref_id = $dbxref;
 591     }
 592     elsif (ref($dbxref) eq 'HASH') {
 593         if (exists $dbxref->{'dbxname'}) {
 594             my ($db_row) = $self->get_schema()
 595                                  ->resultset('General::Db')
 596                                  ->search( { name => $dbxref->{'dbxname'} });
 597             if (defined $db_row) {
 598                 my $db_id = $db_row->get_column('db_id');
 599
 600                 my ($dbxref_row) = $self->get_schema()
 601                                         ->resultset('General::Dbxref')
 602                                         ->search(
 603                                                    {
 604                                                       accession => $dbxref->{'accession'},
 605                                                       db_id     => $db_id,
 606                                                    }
 607                                                 );
 608                 if (defined $dbxref_row) {
 609                     $dbxref_id = $dbxref_row->get_column('dbxref_id');
 610                 }
 611                 else {
 612                     croak("DATABASE ARGUMENT ERROR: accession specified as argument in function $self->add_dbxref dont exists in db.\n");
 613                 }
 614             }
 615             else {
 616                 croak("DATABASE ARGUMENT ERROR: dbxname specified as argument in function $self->add_dbxref dont exists in db.\n");
 617             }
 618         }
 619         else {
 620             croak("INPUT ARGUMENT ERROR: None dbxname was supplied as hash ref. argument in the function $self->add_dbxref.\n ");
 621         }
 622     }
 623     else {
 624         croak("SET ARGUMENT ERROR: The dbxref ($dbxref) isn't a dbxref_id, or hash ref. with accession and dbxname keys.\n");
 625     }
 626
 627     my $templatedbxref_row = $self->get_schema()
 628                                 ->resultset('GeTemplateDbxref')
 629                                 ->new({ dbxref_id => $dbxref_id});
 630
 631     if (defined $self->get_template_id() ) {
 632         $templatedbxref_row->set_column( template_id => $self->get_template_id() );
 633     }
 634
 635     my @templatedbxref_rows = $self->get_getemplatedbxref_rows();
 636     push @templatedbxref_rows, $templatedbxref_row;
 637     $self->set_getemplatedbxref_rows(\@templatedbxref_rows);
 638 }
 639
 640 =head2 get_dbxref_list
 641
 642   Usage: my @dbxref_list_id = $template->get_dbxref_list();
 643
 644   Desc: Get a list of dbxref_id associated to this template.
 645
 646   Ret: An array of dbxref_id
 647
 648   Args: None or a column to get.
 649
 650   Side_Effects: die if the parameter is not an object
 651
 652   Example: my @dbxref_id_list = $template->get_dbxref_list();
 653
 654 =cut
 655
 656 sub get_dbxref_list {
 657     my $self = shift;
 658
 659     my @dbxref_list = ();
 660
 661     my @templatedbxref_rows = $self->get_getemplatedbxref_rows();
 662     foreach my $templatedbxref_row (@templatedbxref_rows) {
 663         my $dbxref_id = $templatedbxref_row->get_column('dbxref_id');
 664         push @dbxref_list, $dbxref_id;
 665     }
 666
 667     return @dbxref_list;
 668 }
 669
 670
 671 ##########################################
 672 ### DATA ACCESSORS FOR TEMPLATE DBIREF ###
 673 ##########################################
 674
 675 =head2 add_dbiref
 676
 677   Usage: $template->add_dbiref($dbiref_id);
 678
 679   Desc: Add a dbiref to the dbiref_ids associated to sample
 680         object using dbiref_id or accesion + internal_path
 681
 682   Ret:  None
 683
 684   Args: $dbiref_id, a dbiref id.
 685         To use with accession and dbxname:
 686           $template->add_dbiref(
 687                                {
 688                                  accession => $accesssion,
 689                                  dbipath   => $dbipath,
 690                                }
 691                              );
 692
 693   Side_Effects: die if the parameter is not an hash reference
 694
 695   Example: $template->add_dbiref($dbiref_id);
 696            $template->add_dbiref(
 697                                 {
 698                                   accession => '450000,
 699                                   dbipath   => 'sgn.unigene.unigene_id',
 700                                 }
 701                               );
 702 =cut
 703
 704 sub add_dbiref {
 705     my $self = shift;
 706     my $dbiref = shift ||
 707         croak("FUNCTION PARAMETER ERROR: None dbiref data was supplied for $self->add_dbiref function.\n");
 708
 709     my $dbiref_id;
 710
 711     ## If the imput parameter is an integer, treat it as id, if not do it as hash reference
 712
 713     if ($dbiref =~ m/^\d+$/) {
 714         $dbiref_id = $dbiref;
 715     }
 716     elsif (ref($dbiref) eq 'HASH') {
 717         my $aref_dbipath = $dbiref->{'dbipath'} ||
 718             croak("INPUT ARGUMENT ERROR: None dbipath aref was specified as argument for $self->add_dbiref() function.\n");
 719         my $accession = $dbiref->{'accession'} ||
 720             croak("INPUT ARGUMENT ERROR: None accession was specified as argument for $self->add_dbiref() function.\n");
 721
 722         ## Check if the aref_dbipath is an array reference.
 723
 724         my $dbipath;
 725         unless (ref($aref_dbipath) eq 'ARRAY') {
 726             croak("TYPE ARGUMENT ERROR: Dbipath array reference supplied to $self->add_dbiref() is not an array reference.\n");
 727         }
 728         else {
 729             $dbipath = join('.', @{$aref_dbipath});
 730         }
 731
 732         ## Now it will get the dbiref data using a constructor
 733
 734         my $dbiref_obj = CXGN::Metadata::Dbiref->new_by_accession($self->get_schema, $accession, $aref_dbipath);
 735
 736         $dbiref_id = $dbiref_obj->get_dbiref_id() ||
 737             croak("DATABASE INPUT ERROR: Do not exists any dbiref_id with accession=$accession and dbipath=$dbipath.\n");
 738     }
 739     else {
 740         croak("INPUT ARGUMENT ERROR: The parameters supplied to $self->add_dbiref() function have wrong format.\n");
 741     }
 742
 743     ## Finally, it will add the dbiref_id to the row
 744
 745     my $templatedbiref_row = $self->get_schema()
 746                                   ->resultset('GeTemplateDbiref')
 747                                   ->new({ dbiref_id => $dbiref_id});
 748
 749     if (defined $self->get_template_id() ) {
 750         $templatedbiref_row->set_column( template_id => $self->get_template_id() );
 751     }
 752
 753     my @templatedbiref_rows = $self->get_getemplatedbiref_rows();
 754     push @templatedbiref_rows, $templatedbiref_row;
 755     $self->set_getemplatedbiref_rows(\@templatedbiref_rows);
 756 }
 757
 758 =head2 get_dbiref_list
 759
 760   Usage: my @dbiref_list_id = $template->get_dbiref_list();
 761
 762   Desc: Get a list of dbiref_id associated to this template.
 763
 764   Ret: An array of dbiref_id
 765
 766   Args: None or a column to get.
 767
 768   Side_Effects: die if the parameter is not an object
 769
 770   Example: my @dbiref_list = $template->get_dbiref_list();
 771
 772 =cut
 773
 774 sub get_dbiref_list {
 775     my $self = shift;
 776
 777     my @dbiref_list = ();
 778
 779     my @templatedbiref_rows = $self->get_getemplatedbiref_rows();
 780     foreach my $templatedbiref_row (@templatedbiref_rows) {
 781         my $dbiref_id = $templatedbiref_row->get_column('dbiref_id');
 782         push @dbiref_list, $dbiref_id;
 783     }
 784
 785     return @dbiref_list;
 786 }
 787
 788
 789
 790 #####################################
 791 ### METADBDATA ASSOCIATED METHODS ###
 792 #####################################
 793
 794 =head2 accessors get_template_metadbdata
 795
 796   Usage: my $metadbdata = $template->get_template_metadbdata();
 797
 798   Desc: Get metadata object associated to template data
 799         (see CXGN::Metadata::Metadbdata).
 800
 801   Ret:  A metadbdata object (CXGN::Metadata::Metadbdata)
 802
 803   Args: Optional, a metadbdata object to transfer metadata creation variables
 804
 805   Side_Effects: none
 806
 807   Example: my $metadbdata = $template->get_template_metadbdata();
 808            my $metadbdata = $template->get_template_metadbdata($metadbdata);
 809
 810 =cut
 811
 812 sub get_template_metadbdata {
 813   my $self = shift;
 814   my $metadata_obj_base = shift;
 815
 816   my $metadbdata;
 817   my $metadata_id = $self->get_getemplate_row
 818                          ->get_column('metadata_id');
 819
 820   if (defined $metadata_id) {
 821       $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
 822       if (defined $metadata_obj_base) {
 823
 824           ## This will transfer the creation data from the base object to the new one
 825           $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
 826           $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
 827       }
 828   }
 829   else {
 830
 831       ## If do not exists the metadata_id, check the possible reasons.
 832       my $template_id = $self->get_template_id();
 833       if (defined $template_id) {
 834           croak("DATABASE INTEGRITY ERROR: The metadata_id for the template_id=$template_id is undefined.\n");
 835       }
 836       else {
 837           croak("OBJECT MANAGEMENT ERROR: Object haven't defined any template_id. Probably it hasn't been stored yet.\n");
 838       }
 839   }
 840
 841   return $metadbdata;
 842 }
 843
 844 =head2 is_template_obsolete
 845
 846   Usage: $template->is_template_obsolete();
 847
 848   Desc: Get obsolete field form metadata object associated to
 849         protocol data (see CXGN::Metadata::Metadbdata).
 850
 851   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
 852
 853   Args: none
 854
 855   Side_Effects: none
 856
 857   Example: unless ($template->is_template_obsolete()) {
 858                    ## do something
 859            }
 860
 861 =cut
 862
 863 sub is_template_obsolete {
 864   my $self = shift;
 865
 866   my $metadbdata = $self->get_template_metadbdata();
 867   my $obsolete = $metadbdata->get_obsolete();
 868
 869   if (defined $obsolete) {
 870       return $obsolete;
 871   }
 872   else {
 873       return 0;
 874   }
 875 }
 876
 877
 878 =head2 accessors get_template_dbxref_metadbdata
 879
 880   Usage: my %metadbdata = $template->get_template_dbxref_metadbdata();
 881
 882   Desc: Get metadata object associated to tool data
 883         (see CXGN::Metadata::Metadbdata).
 884
 885   Ret:  A hash with keys=dbxref_id and values=metadbdata object
 886         (CXGN::Metadata::Metadbdata) for dbxref relation
 887
 888   Args: Optional, a metadbdata object to transfer metadata creation variables
 889
 890   Side_Effects: none
 891
 892   Example: my %metadbdata = $template->get_template_dbxref_metadbdata();
 893            my %metadbdata =
 894               $template->get_template_dbxref_metadbdata($metadbdata);
 895
 896 =cut
 897
 898 sub get_template_dbxref_metadbdata {
 899   my $self = shift;
 900   my $metadata_obj_base = shift;
 901
 902   my %metadbdata;
 903   my @getemplatedbxref_rows = $self->get_getemplatedbxref_rows();
 904
 905   foreach my $getemplatedbxref_row (@getemplatedbxref_rows) {
 906       my $dbxref_id = $getemplatedbxref_row->get_column('dbxref_id');
 907       my $metadata_id = $getemplatedbxref_row->get_column('metadata_id');
 908
 909       if (defined $metadata_id) {
 910           my $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
 911           if (defined $metadata_obj_base) {
 912
 913               ## This will transfer the creation data from the base object to the new one
 914               $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
 915               $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
 916           }
 917           $metadbdata{$dbxref_id} = $metadbdata;
 918       }
 919       else {
 920           my $template_dbxref_id = $getemplatedbxref_row->get_column('template_dbxref_id');
 921           unless (defined $template_dbxref_id) {
 922               croak("OBJECT MANIPULATION ERROR: Object $self haven't any template_dbxref_id. Probably it hasn't been stored\n");
 923           }
 924           else {
 925               croak("DATABASE INTEGRITY ERROR: metadata_id for the template_dbxref_id=$template_dbxref_id is undefined.\n");
 926           }
 927       }
 928   }
 929   return %metadbdata;
 930 }
 931
 932 =head2 is_template_dbxref_obsolete
 933
 934   Usage: $template->is_template_dbxref_obsolete($dbxref_id);
 935
 936   Desc: Get obsolete field form metadata object associated to
 937         protocol data (see CXGN::Metadata::Metadbdata).
 938
 939   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
 940
 941   Args: $dbxref_id, a dbxref_id
 942
 943   Side_Effects: none
 944
 945   Example: unless ($template->is_template_dbxref_obsolete($dbxref_id)){
 946                 ## do something
 947            }
 948
 949 =cut
 950
 951 sub is_template_dbxref_obsolete {
 952   my $self = shift;
 953   my $dbxref_id = shift;
 954
 955   my %metadbdata = $self->get_template_dbxref_metadbdata();
 956   my $metadbdata = $metadbdata{$dbxref_id};
 957
 958   my $obsolete = 0;
 959   if (defined $metadbdata) {
 960       $obsolete = $metadbdata->get_obsolete() || 0;
 961   }
 962   return $obsolete;
 963 }
 964
 965
 966 =head2 accessors get_template_dbiref_metadbdata
 967
 968   Usage: my %metadbdata = $template->get_template_dbiref_metadbdata();
 969
 970   Desc: Get metadata object associated to tool data
 971         (see CXGN::Metadata::Metadbdata).
 972
 973   Ret:  A hash with keys=dbiref_id and values=metadbdata object
 974         (CXGN::Metadata::Metadbdata) for dbiref relation
 975
 976   Args: Optional, a metadbdata object to transfer metadata creation variables
 977
 978   Side_Effects: none
 979
 980   Example: my %metadbdata = $template->get_template_dbiref_metadbdata();
 981            my %metadbdata =
 982               $template->get_template_dbiref_metadbdata($metadbdata);
 983
 984 =cut
 985
 986 sub get_template_dbiref_metadbdata {
 987   my $self = shift;
 988   my $metadata_obj_base = shift;
 989
 990   my %metadbdata;
 991   my @getemplatedbiref_rows = $self->get_getemplatedbiref_rows();
 992
 993   foreach my $getemplatedbiref_row (@getemplatedbiref_rows) {
 994       my $dbiref_id = $getemplatedbiref_row->get_column('dbiref_id');
 995       my $metadata_id = $getemplatedbiref_row->get_column('metadata_id');
 996
 997       if (defined $metadata_id) {
 998           my $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
 999           if (defined $metadata_obj_base) {
1000
1001               ## This will transfer the creation data from the base object to the new one
1002               $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
1003               $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
1004           }
1005           $metadbdata{$dbiref_id} = $metadbdata;
1006       }
1007       else {
1008           my $template_dbiref_id = $getemplatedbiref_row->get_column('template_dbiref_id');
1009           unless (defined $template_dbiref_id) {
1010               croak("OBJECT MANIPULATION ERROR: Object $self haven't any template_dbiref_id. Probably it hasn't been stored\n");
1011           }
1012           else {
1013               croak("DATABASE INTEGRITY ERROR: metadata_id for the template_dbiref_id=$template_dbiref_id is undefined.\n");
1014           }
1015       }
1016   }
1017   return %metadbdata;
1018 }
1019
1020 =head2 is_template_dbiref_obsolete
1021
1022   Usage: $template->is_template_dbiref_obsolete($dbxref_id);
1023
1024   Desc: Get obsolete field form metadata object associated to
1025         protocol data (see CXGN::Metadata::Metadbdata).
1026
1027   Ret:  0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
1028
1029   Args: $dbiref_id, a dbiref_id
1030
1031   Side_Effects: none
1032
1033   Example: unless ($template->is_template_dbiref_obsolete($dbiref_id)){
1034                 ## do something
1035            }
1036
1037 =cut
1038
1039 sub is_template_dbiref_obsolete {
1040   my $self = shift;
1041   my $dbiref_id = shift;
1042
1043   my %metadbdata = $self->get_template_dbiref_metadbdata();
1044   my $metadbdata = $metadbdata{$dbiref_id};
1045
1046   my $obsolete = 0;
1047   if (defined $metadbdata) {
1048       $obsolete = $metadbdata->get_obsolete() || 0;
1049   }
1050   return $obsolete;
1051 }
1052
1053
1054
1055 #######################
1056 ### STORING METHODS ###
1057 #######################
1058
1059
1060 =head2 store
1061
1062   Usage: $template->store($metadbdata);
1063
1064   Desc: Store in the database the all template data for the
1065         template object.
1066         See the methods store_template, store_dbxref_associations and
1067         store_dbiref_associations for more details
1068
1069   Ret: None
1070
1071   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1072
1073   Side_Effects: Die if:
1074                 1- None metadata object is supplied.
1075                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1076                    object
1077
1078   Example: $template->store($metadata);
1079
1080 =cut
1081
1082 sub store {
1083     my $self = shift;
1084
1085     ## FIRST, check the metadata_id supplied as parameter
1086     my $metadata = shift
1087         || croak("STORE ERROR: None metadbdata object was supplied to $self->store().\n");
1088
1089     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1090         croak("STORE ERROR: Metadbdata supplied to $self->store() is not CXGN::Metadata::Metadbdata object.\n");
1091     }
1092
1093     ## SECOND, the store functions return the updated object, so it will chain the different store functions
1094
1095     $self->store_template($metadata);
1096     $self->store_dbxref_associations($metadata);
1097     $self->store_dbiref_associations($metadata);
1098
1099 }
1100
1101
1102 =head2 store_template
1103
1104   Usage: $template->store_template($metadata);
1105
1106   Desc: Store in the database the template data for the template
1107         object (Only the getemplate row, don't store any
1108         template_dbxref or template_dbiref data)
1109
1110   Ret: None
1111
1112   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1113
1114   Side_Effects: Die if:
1115                 1- None metadata object is supplied.
1116                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1117                    object
1118
1119   Example: $template->store_template($metadata);
1120
1121 =cut
1122
1123 sub store_template {
1124     my $self = shift;
1125
1126     ## FIRST, check the metadata_id supplied as parameter
1127     my $metadata = shift
1128         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_template().\n");
1129
1130     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1131         croak("STORE ERROR: Metadbdata supplied to $self->store_template() is not CXGN::Metadata::Metadbdata object.\n");
1132     }
1133
1134     ## It is not necessary check the current user used to store the data because should be the same than the used
1135     ## to create a metadata_id. In the medadbdata object, it is checked.
1136
1137     ## SECOND, check if exists or not template_id.
1138     ##   if exists template_id         => update
1139     ##   if do not exists template_id  => insert
1140
1141     my $getemplate_row = $self->get_getemplate_row();
1142     my $template_id = $getemplate_row->get_column('template_id');
1143
1144     unless (defined $template_id) {                                   ## NEW INSERT and DISCARD CHANGES
1145
1146         $metadata->store();
1147         my $metadata_id = $metadata->get_metadata_id();
1148
1149         $getemplate_row->set_column( metadata_id => $metadata_id );   ## Set the metadata_id column
1150
1151         $getemplate_row->insert()
1152                        ->discard_changes();                           ## It will set the row with the updated row
1153
1154         ## Now we set the template_id value for all the rows that depends of it
1155
1156         my @getemplatedbxref_rows = $self->get_getemplatedbxref_rows();
1157         foreach my $getemplatedbxref_row (@getemplatedbxref_rows) {
1158             $getemplatedbxref_row->set_column( template_id => $getemplate_row->get_column('template_id'));
1159         }
1160
1161         my @getemplatedbiref_rows = $self->get_getemplatedbiref_rows();
1162         foreach my $getemplatedbiref_row (@getemplatedbiref_rows) {
1163             $getemplatedbiref_row->set_column( template_id => $getemplate_row->get_column('template_id'));
1164         }
1165
1166
1167     }
1168     else {                                                            ## UPDATE IF SOMETHING has change
1169
1170         my @columns_changed = $getemplate_row->is_changed();
1171
1172         if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1173
1174             my @modification_note_list;                             ## the changes and the old metadata object for
1175             foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1176                 push @modification_note_list, "set value in $col_changed column";
1177             }
1178
1179             my $modification_note = join ', ', @modification_note_list;
1180
1181             my $mod_metadata = $self->get_template_metadbdata($metadata);
1182             $mod_metadata->store({ modification_note => $modification_note });
1183             my $mod_metadata_id = $mod_metadata->get_metadata_id();
1184
1185             $getemplate_row->set_column( metadata_id => $mod_metadata_id );
1186
1187             $getemplate_row->update()
1188                          ->discard_changes();
1189         }
1190     }
1191 }
1192
1193
1194 =head2 obsolete_template
1195
1196   Usage: $template->obsolete_template($metadata, $note, 'REVERT');
1197
1198   Desc: Change the status of a data to obsolete.
1199         If revert tag is used the obsolete status will be reverted to 0 (false)
1200
1201   Ret: None
1202
1203   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1204         $note, a note to explain the cause of make this data obsolete
1205         optional, 'REVERT'.
1206
1207   Side_Effects: Die if:
1208                 1- None metadata object is supplied.
1209                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1210
1211   Example: $template->obsolete_template($metadata, 'change to obsolete test');
1212
1213 =cut
1214
1215 sub obsolete_template {
1216     my $self = shift;
1217
1218     ## FIRST, check the metadata_id supplied as parameter
1219
1220     my $metadata = shift
1221         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_template().\n");
1222
1223     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1224         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_template isn't CXGN::Metadata::Metadbdata obj.\n");
1225     }
1226
1227     my $obsolete_note = shift
1228         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_template().\n");
1229
1230     my $revert_tag = shift;
1231
1232
1233     ## If exists the tag revert change obsolete to 0
1234
1235     my $obsolete = 1;
1236     my $modification_note = 'change to obsolete';
1237     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1238         $obsolete = 0;
1239         $modification_note = 'revert obsolete';
1240     }
1241
1242     ## Create a new metadata with the obsolete tag
1243
1244     my $mod_metadata = $self->get_template_metadbdata($metadata);
1245     $mod_metadata->store( { modification_note => $modification_note,
1246                             obsolete          => $obsolete,
1247                             obsolete_note     => $obsolete_note } );
1248     my $mod_metadata_id = $mod_metadata->get_metadata_id();
1249
1250     ## Modify the group row in the database
1251
1252     my $getemplate_row = $self->get_getemplate_row();
1253
1254     $getemplate_row->set_column( metadata_id => $mod_metadata_id );
1255
1256     $getemplate_row->update()
1257                  ->discard_changes();
1258 }
1259
1260
1261 =head2 store_dbxref_associations
1262
1263   Usage: $template->store_dbxref_associations($metadata);
1264
1265   Desc: Store in the database the dbxref association for the template
1266         object
1267
1268   Ret: None
1269
1270   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1271
1272   Side_Effects: Die if:
1273                 1- None metadata object is supplied.
1274                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1275                    object
1276
1277   Example: $template->store_dbxref_associations($metadata);
1278
1279 =cut
1280
1281 sub store_dbxref_associations {
1282     my $self = shift;
1283
1284     ## FIRST, check the metadata_id supplied as parameter
1285     my $metadata = shift
1286         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_dbxref_associations().\n");
1287
1288     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1289         croak("STORE ERROR: Metadbdata supplied to $self->store_dbxref_associations() is not CXGN::Metadata::Metadbdata object.\n");
1290     }
1291
1292     ## It is not necessary check the current user used to store the data because should be the same than the used
1293     ## to create a metadata_id. In the medadbdata object, it is checked.
1294
1295     ## SECOND, check if exists or not template_dbxref_id.
1296     ##   if exists template_dbxref_id         => update
1297     ##   if do not exists template_dbxref_id  => insert
1298
1299     my @getemplatedbxref_rows = $self->get_getemplatedbxref_rows();
1300
1301     foreach my $getemplatedbxref_row (@getemplatedbxref_rows) {
1302
1303         my $template_dbxref_id = $getemplatedbxref_row->get_column('template_dbxref_id');
1304         my $dbxref_id = $getemplatedbxref_row->get_column('dbxref_id');
1305
1306         unless (defined $template_dbxref_id) {                                ## NEW INSERT and DISCARD CHANGES
1307
1308             $metadata->store();
1309             my $metadata_id = $metadata->get_metadata_id();
1310
1311             $getemplatedbxref_row->set_column( metadata_id => $metadata_id );    ## Set the metadata_id column
1312
1313             $getemplatedbxref_row->insert()
1314                                ->discard_changes();                            ## It will set the row with the updated row
1315
1316         }
1317         else {                                                                    ## UPDATE IF SOMETHING has change
1318
1319             my @columns_changed = $getemplatedbxref_row->is_changed();
1320
1321             if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1322
1323                 my @modification_note_list;                             ## the changes and the old metadata object for
1324                 foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1325                     push @modification_note_list, "set value in $col_changed column";
1326                 }
1327
1328                 my $modification_note = join ', ', @modification_note_list;
1329
1330                 my %asdbxref_metadata = $self->get_template_dbxref_metadbdata($metadata);
1331                 my $mod_metadata = $asdbxref_metadata{$dbxref_id}->store({ modification_note => $modification_note });
1332                 my $mod_metadata_id = $mod_metadata->get_metadata_id();
1333
1334                 $getemplatedbxref_row->set_column( metadata_id => $mod_metadata_id );
1335
1336                 $getemplatedbxref_row->update()
1337                                    ->discard_changes();
1338             }
1339         }
1340     }
1341 }
1342
1343 =head2 obsolete_dbxref_association
1344
1345   Usage: $template->obsolete_dbxref_association($metadata, $note, $dbxref_id, 'REVERT');
1346
1347   Desc: Change the status of a data to obsolete.
1348         If revert tag is used the obsolete status will be reverted to 0 (false)
1349
1350   Ret: None
1351
1352   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1353         $note, a note to explain the cause of make this data obsolete
1354         $dbxref_id, a dbxref id
1355         optional, 'REVERT'.
1356
1357   Side_Effects: Die if:
1358                 1- None metadata object is supplied.
1359                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1360
1361   Example: $template->obsolete_dbxref_association($metadata,
1362                                                     'change to obsolete test',
1363                                                     $dbxref_id );
1364
1365 =cut
1366
1367 sub obsolete_dbxref_association {
1368     my $self = shift;
1369
1370     ## FIRST, check the metadata_id supplied as parameter
1371
1372     my $metadata = shift
1373         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_dbxref_association().\n");
1374
1375     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1376         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_dbxref_association is not CXGN::Metadata::Metadbdata obj.\n");
1377     }
1378
1379     my $obsolete_note = shift
1380         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_dbxref_association().\n");
1381
1382     my $dbxref_id = shift
1383         || croak("OBSOLETE ERROR: None dbxref_id was supplied to $self->obsolete_dbxref_association().\n");
1384
1385     my $revert_tag = shift;
1386
1387
1388     ## If exists the tag revert change obsolete to 0
1389
1390     my $obsolete = 1;
1391     my $modification_note = 'change to obsolete';
1392     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1393         $obsolete = 0;
1394         $modification_note = 'revert obsolete';
1395     }
1396
1397     ## Create a new metadata with the obsolete tag
1398
1399     my %asdbxref_metadata = $self->get_template_dbxref_metadbdata($metadata);
1400     my $mod_metadata_id = $asdbxref_metadata{$dbxref_id}->store( { modification_note => $modification_note,
1401                                                                    obsolete          => $obsolete,
1402                                                                    obsolete_note     => $obsolete_note } )
1403                                                         ->get_metadata_id();
1404
1405     ## Modify the group row in the database
1406
1407     my @getemplatedbxref_rows = $self->get_getemplatedbxref_rows();
1408     foreach my $getemplatedbxref_row (@getemplatedbxref_rows) {
1409         if ($getemplatedbxref_row->get_column('dbxref_id') == $dbxref_id) {
1410
1411             $getemplatedbxref_row->set_column( metadata_id => $mod_metadata_id );
1412
1413             $getemplatedbxref_row->update()
1414                                ->discard_changes();
1415         }
1416     }
1417 }
1418
1419
1420 =head2 store_dbiref_associations
1421
1422   Usage: $template->store_dbiref_associations($metadata);
1423
1424   Desc: Store in the database the dbiref association for the template
1425         object
1426
1427   Ret: None
1428
1429   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1430
1431   Side_Effects: Die if:
1432                 1- None metadata object is supplied.
1433                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1434                    object
1435
1436   Example: $template->store_dbiref_associations($metadata);
1437
1438 =cut
1439
1440 sub store_dbiref_associations {
1441     my $self = shift;
1442
1443     ## FIRST, check the metadata_id supplied as parameter
1444     my $metadata = shift
1445         || croak("STORE ERROR: None metadbdata object was supplied to $self->store_dbxref_associations().\n");
1446
1447     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1448         croak("STORE ERROR: Metadbdata supplied to $self->store_dbxref_associations() is not CXGN::Metadata::Metadbdata object.\n");
1449     }
1450
1451     ## It is not necessary check the current user used to store the data because should be the same than the used
1452     ## to create a metadata_id. In the medadbdata object, it is checked.
1453
1454     ## SECOND, check if exists or not template_dbiref_id.
1455     ##   if exists template_dbiref_id         => update
1456     ##   if do not exists template_dbiref_id  => insert
1457
1458     my @getemplatedbiref_rows = $self->get_getemplatedbiref_rows();
1459
1460     foreach my $getemplatedbiref_row (@getemplatedbiref_rows) {
1461
1462         my $template_dbiref_id = $getemplatedbiref_row->get_column('template_dbiref_id');
1463         my $dbiref_id = $getemplatedbiref_row->get_column('dbiref_id');
1464
1465         unless (defined $template_dbiref_id) {                                ## NEW INSERT and DISCARD CHANGES
1466
1467             $metadata->store();
1468             my $metadata_id = $metadata->get_metadata_id();
1469
1470             $getemplatedbiref_row->set_column( metadata_id => $metadata_id );    ## Set the metadata_id column
1471
1472             $getemplatedbiref_row->insert()
1473                                  ->discard_changes();                            ## It will set the row with the updated row
1474
1475         }
1476         else {                                                                    ## UPDATE IF SOMETHING has change
1477
1478             my @columns_changed = $getemplatedbiref_row->is_changed();
1479
1480             if (scalar(@columns_changed) > 0) {                         ## ...something has change, it will take
1481
1482                 my @modification_note_list;                             ## the changes and the old metadata object for
1483                 foreach my $col_changed (@columns_changed) {            ## this dbiref and it will create a new row
1484                     push @modification_note_list, "set value in $col_changed column";
1485                 }
1486
1487                 my $modification_note = join ', ', @modification_note_list;
1488
1489                 my %asdbiref_metadata = $self->get_template_dbiref_metadbdata($metadata);
1490                 my $mod_metadata = $asdbiref_metadata{$dbiref_id}->store({ modification_note => $modification_note });
1491                 my $mod_metadata_id = $mod_metadata->get_metadata_id();
1492
1493                 $getemplatedbiref_row->set_column( metadata_id => $mod_metadata_id );
1494
1495                 $getemplatedbiref_row->update()
1496                                      ->discard_changes();
1497             }
1498         }
1499     }
1500 }
1501
1502 =head2 obsolete_dbiref_association
1503
1504   Usage: $template->obsolete_dbiref_association($metadata, $note, $dbiref_id, 'REVERT');
1505
1506   Desc: Change the status of a data to obsolete.
1507         If revert tag is used the obsolete status will be reverted to 0 (false)
1508
1509   Ret: None
1510
1511   Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1512         $note, a note to explain the cause of make this data obsolete
1513         $dbiref_id, a dbiref id
1514         optional, 'REVERT'.
1515
1516   Side_Effects: Die if:
1517                 1- None metadata object is supplied.
1518                 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1519
1520   Example: $template->obsolete_dbxref_association($metadata,
1521                                                     'change to obsolete test',
1522                                                     $dbiref_id );
1523
1524 =cut
1525
1526 sub obsolete_dbiref_association {
1527     my $self = shift;
1528
1529     ## FIRST, check the metadata_id supplied as parameter
1530
1531     my $metadata = shift
1532         || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_dbiref_association().\n");
1533
1534     unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1535         croak("OBSOLETE ERROR: Metadbdata obj. supplied to $self->obsolete_dbiref_association is not CXGN::Metadata::Metadbdata obj.\n");
1536     }
1537
1538     my $obsolete_note = shift
1539         || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_dbiref_association().\n");
1540
1541     my $dbiref_id = shift
1542         || croak("OBSOLETE ERROR: None dbiref_id was supplied to $self->obsolete_dbiref_association().\n");
1543
1544     my $revert_tag = shift;
1545
1546
1547     ## If exists the tag revert change obsolete to 0
1548
1549     my $obsolete = 1;
1550     my $modification_note = 'change to obsolete';
1551     if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1552         $obsolete = 0;
1553         $modification_note = 'revert obsolete';
1554     }
1555
1556     ## Create a new metadata with the obsolete tag
1557
1558     my %asdbiref_metadata = $self->get_template_dbiref_metadbdata($metadata);
1559     my $mod_metadata_id = $asdbiref_metadata{$dbiref_id}->store( { modification_note => $modification_note,
1560                                                                    obsolete          => $obsolete,
1561                                                                    obsolete_note     => $obsolete_note } )
1562                                                         ->get_metadata_id();
1563
1564     ## Modify the group row in the database
1565
1566     my @getemplatedbiref_rows = $self->get_getemplatedbiref_rows();
1567     foreach my $getemplatedbiref_row (@getemplatedbiref_rows) {
1568         if ($getemplatedbiref_row->get_column('dbiref_id') == $dbiref_id) {
1569
1570             $getemplatedbiref_row->set_column( metadata_id => $mod_metadata_id );
1571
1572             $getemplatedbiref_row->update()
1573                                ->discard_changes();
1574         }
1575     }
1576 }
1577
1578
1579 #####################
1580 ### OTHER METHODS ###
1581 #####################
1582
1583 =head2 get_platform
1584
1585   Usage: my $platform = $template->get_platform();
1586
1587   Desc: Get a CXGN::GEM::PLatform object associate with
1588         the temnplate
1589
1590   Ret:  A CXGN::GEM::Platform object.
1591
1592   Args: none
1593
1594   Side_Effects: die if the template object have not any
1595                 experiment_id
1596
1597   Example: my $platform = $template->get_platform();
1598
1599 =cut
1600
1601 sub get_platform {
1602    my $self = shift;
1603
1604    my $platform_id = $self->get_platform_id();
1605
1606    unless (defined $platform_id) {
1607        croak("OBJECT MANIPULATION ERROR: The $self object haven't any platform_id. Probably it hasn't store yet.\n");
1608    }
1609
1610    my $platform = CXGN::GEM::Platform->new($self->get_schema(), $platform_id);
1611
1612    return $platform;
1613 }
1614
1615 =head2 get_dbiref_obj_list
1616
1617   Usage: my @dbirefs = $template->get_dbiref_obj_list();
1618
1619   Desc: Get a list CXGN::GEM::Dbiref object associated with the
1620         template_id
1621
1622   Ret: An array with a list of CXGN::Metadata::Dbiref objects.
1623
1624   Args: none
1625
1626   Side_Effects: die if the template_object have not any
1627                 template_id
1628
1629   Example: my @dbirefs = $platform->get_dbiref_obj_list();
1630
1631 =cut
1632
1633 sub get_dbiref_obj_list {
1634    my $self = shift;
1635
1636    my @dbirefs = ();
1637
1638    my $template_id = $self->get_template_id();
1639
1640    unless (defined $template_id) {
1641        croak("OBJECT MANIPULATION ERROR: The $self object haven't any template_id. Probably it hasn't store yet.\n");
1642    }
1643
1644    my @dbiref_ids = $self->get_dbiref_list();
1645
1646    foreach my $dbiref_id (@dbiref_ids) {
1647        my $dbiref = CXGN::Metadata::Dbiref->new($self->get_schema(), $dbiref_id);
1648
1649        push @dbirefs, $dbiref;
1650    }
1651
1652    return @dbirefs;
1653
1654 }
1655
1656 =head2 get_internal_accessions
1657
1658   Usage: my @iref_accessions = $template->get_internal_accession($type);
1659
1660   Desc: Get a list of internal accessions for the specified type
1661
1662   Ret: An array with a list of accessions
1663
1664   Args: $type, an scalar to match with dbipath associated with
1665         dbiref (for example unigene will match with sgn.unigene.unigene_id)
1666
1667   Side_Effects: if type does not match, it will return an empty object
1668                 die if the object has not any template_id
1669                 if $type is undef, it will return everything that match
1670                 with \w+
1671
1672   Example: my @iref_accessions = $template->get_internal_accession('unigene');
1673
1674 =cut
1675
1676 sub get_internal_accessions {
1677    my $self = shift;
1678    my $type = shift || '\w+';
1679
1680    my @iref_accessions = ();
1681
1682    my $template_id = $self->get_template_id();
1683
1684    unless (defined $template_id) {
1685        croak("OBJECT MANIPULATION ERROR: The $self object haven't any template_id. Probably it hasn't store yet.\n");
1686    }
1687
1688    my @dbirefs = $self->get_dbiref_obj_list();
1689
1690    foreach my $dbiref (@dbirefs) {
1691        my $iref_accession = $dbiref->get_accession();
1692        my @dbipath = $dbiref->get_dbipath_obj()
1693                             ->get_dbipath();
1694
1695        my $dbipath = join('.', @dbipath);
1696        if ($dbipath =~ m/$type/) {
1697            push @iref_accessions, $iref_accession;
1698        }
1699    }
1700
1701    return @iref_accessions;
1702
1703 }
1704
1705
1706 ####
1707 1;##
1708 ####