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