· 8 years ago · Apr 19, 2018, 04:52 PM
1
2=head1 NAME
3
4CXGN::Biosource::ProtocolTool
5a class to manipulate a biosource tool data.
6
7Version: 0.1
8
9=head1 SYNOPSIS
10
11 use CXGN::Biosource::ProtocolTool;
12
13 my $tool = CXGN::Biosource::ProtocolTool->new($schema, $tool_id);
14
15 $tool->set_tool_data(%tool_data);
16 my %tool_data = $tool->get_tool_data();
17
18 if ($tool->is_obsolete()) {
19 print "This is obsolete tool";
20 }
21
22 $tool->store($metadbdata);
23 $tool->obsolete($metadbdata, 'testing obsolete');
24
25
26=head1 DESCRIPTION
27
28 This object manage the protocol information of the database
29 from the tables:
30
31 + biosource.bs_tool
32 + biosource.bs_tool_pub
33
34 This data is stored inside this object as dbic rows objects.
35
36
37=head1 AUTHOR
38
39Aureliano Bombarely <ab782@cornell.edu>
40
41
42=head1 CLASS METHODS
43
44The following class methods are implemented:
45
46=cut
47
48use strict;
49use warnings;
50
51package CXGN::Biosource::ProtocolTool;
52
53use base qw | CXGN::DB::Object |;
54use File::Basename;
55use CXGN::Biosource::Schema;
56use CXGN::Metadata::Schema;
57use CXGN::Metadata::Metadbdata;
58use Bio::Chado::Schema;
59use Carp qw| croak cluck |;
60
61
62############################
63### GENERAL CONSTRUCTORS ###
64############################
65
66=head2 constructor new
67
68 Usage: my $tool = CXGN::Biosource::ProtocolTool->new($schema, $tool_id);
69
70 Desc: Create a new tool (protocoltool) object
71
72 Ret: a CXGN::Biosource::ProtocolTool object
73
74 Args: a $schema a schema object, preferentially created using:
75 CXGN::Biosource::Schema->connect(
76 sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
77 %other_parameters );
78 a $tool_id, if $tool_id is omitted, an empty tool object is
79 created.
80
81 Side_Effects: accesses the database, check if exists the database columns that
82 this object use. die if the id is not an integer.
83
84 Example: my $tool = CXGN::Biosource::ProtocolTool->new($schema, $tool_id);
85
86=cut
87
88sub new {
89 my $class = shift;
90 my $schema = shift ||
91 croak("PARAMETER ERROR: None schema object was supplied to the $class->new() function.\n");
92 my $id = shift;
93
94 ### First, bless the class to create the object and set the schema into de object
95 ### (set_schema comes from CXGN::DB::Object).
96
97 my $self = $class->SUPER::new($schema);
98 $self->set_schema($schema);
99
100 ### Second, check that ID is an integer. If it is right go and get all the data for
101 ### this row in the database and after that get the data for tool.
102 ### If don't find any, create an empty oject.
103 ### If it is not an integer, die
104
105 my $tool;
106 my @tool_pub_rows;
107
108 if (defined $id) {
109 unless ($id =~ m/^\d+$/) { ## The id can be only an integer... so it is better if we detect this fail before.
110
111 croak("\nDATA TYPE ERROR: The tool_id ($id) for $class->new() IS NOT AN INTEGER.\n\n");
112 }
113 ($tool) = $schema->resultset('BsTool')
114 ->search({ tool_id => $id });
115
116 unless (defined $tool) { ## If tool_id don't exists into the db, it will warning with cluck and create an empty object
117
118 cluck("\nDATABASE WARNING: Tool_id ($id) for $class->new() DON'T EXISTS INTO THE DB.\nIt'll be created an empty obj.\n" );
119
120 $tool = $schema->resultset('BsTool')
121 ->new({});
122 }
123 else { ## If exists tool_id in the database will get pub associated to them
124
125 @tool_pub_rows = $schema->resultset('BsToolPub')
126 ->search({ tool_id => $id });
127
128 }
129 }
130 else {
131 $tool = $schema->resultset('BsTool')
132 ->new({}); ### Create an empty object;
133 }
134
135 ## Finally it will load the dbiref_row and dbipath_row into the object.
136 $self->set_bstool_row($tool);
137 $self->set_bstoolpub_rows(\@tool_pub_rows);
138
139 return $self;
140}
141
142=head2 constructor new_by_name
143
144 Usage: my $tool = CXGN::Biosource::ProtocolTool->new_by_name($schema, $tool_name);
145
146 Desc: Create a new Tool (ProtocolTool) object using protocol_name
147
148 Ret: a CXGN::Biosource::ProtocolTool object
149
150 Args: a $schema a schema object, preferentially created using:
151 CXGN::Biosource::Schema->connect(
152 sub{ CXGN::DB::Connection->new()->get_actual_dbh()},
153 %other_parameters );
154 a $tool_name, a scalar
155
156 Side_Effects: accesses the database,
157 return a warning if the protocol name do not exists into the db
158
159 Example: my $tool = CXGN::Biosource::ProtocolTool->new_by_name( $schema, $name);
160
161=cut
162
163sub new_by_name {
164 my $class = shift;
165 my $schema = shift ||
166 croak("PARAMETER ERROR: None schema object was supplied to the $class->new_by_name() function.\n");
167 my $name = shift;
168
169 ### It will search the protocol_id for this name and it will get the protocol_id for that using the new
170 ### method to create a new object. If the name don't exists into the database it will create a empty object and
171 ### it will set the protocol_name for it
172
173 my $tool;
174
175 if (defined $name) {
176 my ($tool_row) = $schema->resultset('BsTool')
177 ->find({ tool_name => $name });
178
179 unless (defined $tool_row) { ## If tool_row don't exists into the db, it will warning with cluck
180 ## and it will create an object with this name
181
182 cluck("\nDATABASE WARNING: Tool_name ($name) for $class->new() DON'T EXISTS INTO THE DB.\n" );
183
184 $tool = $class->new($schema);
185 $tool->set_tool_name($name);
186 }
187 else {
188 $tool = $class->new($schema, $tool_row->get_column('tool_id'));
189 }
190 }
191 else {
192 $tool = $class->new($schema); ### Create an empty object;
193 }
194
195 return $tool;
196}
197
198##################################
199### DBIX::CLASS ROWS ACCESSORS ###
200##################################
201
202=head2 accessors get_bstool_row, set_bstool_row
203
204 Usage: my $bstool_row_object = $self->get_bstool_row();
205 $self->set_bstool_row($bstool_row_object);
206
207 Desc: Get or set a bstool row object into a tool object
208
209 Ret: Get => $bstool_row_object, a row object
210 (CXGN::Biosource::Schema::BsTool).
211 Set => none
212
213 Args: Get => none
214 Set => $bstool_row_object, a row object
215 (CXGN::Biosource::Schema::BsTool).
216
217 Side_Effects: With set check if the argument is a row object. If fail, dies.
218
219 Example: my $bstool_row_object = $self->get_bstool_row();
220 $self->set_bstool_row($bstool_row_object);
221
222=cut
223
224sub get_bstool_row {
225 my $self = shift;
226
227 return $self->{bstool_row};
228}
229
230sub set_bstool_row {
231 my $self = shift;
232 my $bstool_row = shift
233 || croak("FUNCTION PARAMETER ERROR: None bstool_row object was supplied for set_bstool_row function.\n");
234
235 if (ref($bstool_row) ne 'CXGN::Biosource::Schema::BsTool') {
236 croak("SET ARGUMENT ERROR: $bstool_row isn't a bstool_row obj. (CXGN::Biosource::Schema::BsTool).\n");
237 }
238 $self->{bstool_row} = $bstool_row;
239}
240
241
242=head2 accessors get_bstoolpub_rows, set_bstoolpub_rows
243
244 Usage: my @bstoolpub_rows = $self->get_bstoolpub_rows();
245 $self->set_bstoolpub_rows(\@bstoolpub_rows);
246
247 Desc: Get or set a list of bstoolpub rows object into a tool object
248
249 Ret: Get => @bstoolpub_row_object, a list of row objects
250 (CXGN::Biosource::Schema::BsTool).
251 Set => none
252
253 Args: Get => none
254 Set => @bstoolpub_row_object, an array ref of row objects
255 (CXGN::Biosource::Schema::BsTool).
256
257 Side_Effects: With set check if the argument is a row object. If fail, dies.
258
259 Example: my @bstoolpub_rows = $self->get_bstoolpub_rows();
260 $self->set_bstoolpub_rows(\@bstoolpub_rows);
261
262=cut
263
264sub get_bstoolpub_rows {
265 my $self = shift;
266
267 return @{$self->{bstoolpub_rows}};
268}
269
270sub set_bstoolpub_rows {
271 my $self = shift;
272 my $bstoolpub_row_aref = shift
273 || croak("FUNCTION PARAMETER ERROR: None bstoolpub_row array ref was supplied for set_bstoolpub_rows function.\n");
274
275 if (ref($bstoolpub_row_aref) ne 'ARRAY') {
276 croak("SET ARGUMENT ERROR: $bstoolpub_row_aref isn't an array reference.\n");
277 }
278 else {
279 foreach my $bstoolpub_row (@{$bstoolpub_row_aref}) {
280 if (ref($bstoolpub_row) ne 'CXGN::Biosource::Schema::BsToolPub') {
281 croak("SET ARGUMENT ERROR: $bstoolpub_row isn't a bstoolpub_row obj. (CXGN::Biosource::Schema::BsToolPub).\n");
282 }
283 }
284 }
285 $self->{bstoolpub_rows} = $bstoolpub_row_aref;
286}
287
288
289######################
290### DATA ACCESSORS ###
291######################
292
293=head2 get_tool_id, force_set_tool_id
294
295 Usage: my $tool_id = $tool->get_tool_id();
296 $tool->force_set_tool_id($tool_id);
297
298 Desc: get or set a tool_id in a tool object.
299 set method should be USED WITH PRECAUTION
300 If you want set a tool_id that do not exists into the database you
301 should consider that when you store this object you CAN STORE a
302 tool_id that do not follow the biosource.bs_tool_tool_id_seq
303
304 Ret: get=> $tool_id, a scalar.
305 set=> none
306
307 Args: get=> none
308 set=> $tool_id, a scalar (constraint: it must be an integer)
309
310 Side_Effects: none
311
312 Example: my $tool_id = $tool->get_tool_id();
313
314=cut
315
316sub get_tool_id {
317 my $self = shift;
318 return $self->get_bstool_row->get_column('tool_id');
319}
320
321sub force_set_tool_id {
322 my $self = shift;
323 my $data = shift ||
324 croak("FUNCTION PARAMETER ERROR: None tool_id was supplied for force_set_tool_id function");
325
326 unless ($data =~ m/^\d+$/) {
327 croak("DATA TYPE ERROR: The tool_id ($data) for $self->force_set_tool_id() ISN'T AN INTEGER.\n");
328 }
329
330 $self->get_bstool_row()
331 ->set_column( tool_id => $data );
332
333}
334
335=head2 accessors get_tool_name, set_tool_name
336
337 Usage: my $tool_name = $tool->get_tool_name();
338 $tool->set_tool_name($tool_name);
339
340 Desc: Get or set the tool_name from tool object.
341
342 Ret: get=> $tool_name, a scalar
343 set=> none
344
345 Args: get=> none
346 set=> $tool_name, a scalar
347
348 Side_Effects: none
349
350 Example: my $tool_name = $tool->get_tool_name();
351 $tool->set_tool_name($new_name);
352=cut
353
354sub get_tool_name {
355 my $self = shift;
356 return $self->get_bstool_row->get_column('tool_name');
357}
358
359sub set_tool_name {
360 my $self = shift;
361 my $data = shift
362 || croak("FUNCTION PARAMETER ERROR: None data was supplied for set_tool_name function to CXGN::Biosource::ProtocolTool.\n");
363
364 $self->get_bstool_row()
365 ->set_column( tool_name => $data );
366}
367
368=head2 accessors get_tool_type, set_tool_type
369
370 Usage: my $tool_type = $tool->get_tool_type();
371 $tool->set_tool_type($tool_type);
372
373 Desc: Get or set tool_type from a tool object.
374
375 Ret: get=> $tool_type, a scalar
376 set=> none
377
378 Args: get=> none
379 set=> $tool_type, a scalar
380
381 Side_Effects: none
382
383 Example: my $tool_type = $tool->get_tool_type();
384 $tool->set_tool_type($tool_type);
385
386=cut
387
388sub get_tool_type {
389 my $self = shift;
390 return $self->get_bstool_row->get_column('tool_type');
391}
392
393sub set_tool_type {
394 my $self = shift;
395 my $data = shift
396 || croak("FUNCTION PARAMETER ERROR: None data was supplied for set_tool_type function to CXGN::Biosource::ProtocolTool.\n");
397
398 $self->get_bstool_row()
399 ->set_column( tool_type => $data );
400}
401
402=head2 accessors get_tool_description, set_tool_description
403
404 Usage: my $tool_description = $tool->get_tool_description();
405 $tool->set_tool_description($tool_description);
406
407 Desc: Get or set the tool_description from a tool object
408
409 Ret: get=> $tool_description, a scalar
410 set=> none
411
412 Args: get=> none
413 set=> $tool_description, a scalar
414
415 Side_Effects: none
416
417 Example: my $tool_description = $tool->get_tool_description();
418 $protocol->set_tool_description($tool_description);
419=cut
420
421sub get_tool_description {
422 my $self = shift;
423 return $self->get_bstool_row->get_column('tool_description');
424}
425
426sub set_tool_description {
427 my $self = shift;
428 my $data = shift;
429
430 $self->get_bstool_row()
431 ->set_column( tool_description => $data );
432}
433
434=head2 accessors get_tool_weblink, set_tool_weblink
435
436 Usage: my $tool_weblink = $tool->get_tool_weblink();
437 $tool->set_tool_weblink($tool_weblink);
438
439 Desc: Get or set the tool_weblink from a tool object
440
441 Ret: get=> $tool_weblink, a scalar
442 set=> none
443
444 Args: get=> none
445 set=> $tool_weblink, a scalar
446
447 Side_Effects: none
448
449 Example: my $tool_weblink = $tool->get_tool_weblink();
450 $protocol->set_tool_weblink($tool_weblink);
451=cut
452
453sub get_tool_weblink {
454 my $self = shift;
455 return $self->get_bstool_row->get_column('tool_weblink');
456}
457
458sub set_tool_weblink {
459 my $self = shift;
460 my $data = shift;
461
462 $self->get_bstool_row()
463 ->set_column( tool_weblink => $data );
464}
465
466=head2 accessors get_file_id, set_file_id
467
468 Usage: my $file_id = $tool->get_file_id();
469 $tool->set_file_id($file_id);
470
471 Desc: Get or set the file_id from a tool object
472
473 Ret: get=> $file_id, a scalar, an integer
474 set=> none
475
476 Args: get=> none
477 set=> $file_id, a scalar, an integer
478
479 Side_Effects: For set, die if the $file_id is not an integer
480
481 Example: my $file_id = $tool->get_file_id();
482 $protocol->set_file_id($file_id);
483=cut
484
485sub get_file_id {
486 my $self = shift;
487 return $self->get_bstool_row->get_column('file_id');
488}
489
490sub set_file_id {
491 my $self = shift;
492 my $data = shift;
493
494 unless ($data =~ m/^\d+$/) {
495 croak("DATA TYPE ERROR: The file_id ($data) for $self->set_file_id() ISN'T AN INTEGER.\n");
496 }
497
498 $self->get_bstool_row()
499 ->set_column( file_id => $data );
500}
501
502
503=head2 accessors get_file_name, set_file_id_by_name
504
505 Usage: my $file_name = $tool->get_file_name();
506 $tool->set_file_id_by_name($file_name);
507
508 Desc: Get the file name associated to a file_id in the tool object
509 Set the file_id in the tool object using file_name
510 IMPORTANT: The schema used in the object creation must contains
511 the metadata classes
512
513 Ret: get=> $file_name, a scalar
514 set=> none
515
516 Args: get=> none
517 set=> $file_name, a scalar
518
519 Side_Effects: For set, die if the $file_name is not in the db
520
521 Example: my $file_name = $tool->get_file_name();
522 $protocol->set_file_id_by_name($file_name);
523=cut
524
525sub get_file_name {
526 my $self = shift;
527 my $file_id = $self->get_file_id();
528
529 my $filename;
530 if (defined $file_id) {
531 my ($file_row) = $self->get_schema()
532 ->resultset('MdFiles')
533 ->search({ file_id => $file_id });
534
535 if (defined $file_row) {
536 $filename = $file_row->get_column('dirname') . $file_row->get_column('basename');
537 }
538 }
539 return $filename;
540}
541
542sub set_file_id_by_name {
543 my $self = shift;
544 my $data = shift
545 || croak("FUNCTION PARAMETER ERROR: None data was supplied for set_file_id_by__name function to CXGN::Biosource::ProtocolTool.\n");
546
547 my ($basename, $dirname) = fileparse($data);
548
549 my ($file_row) = $self->get_schema()
550 ->resultset('MdFiles')
551 ->search( { basename => $basename,
552 dirname => $dirname } );
553
554 if (defined $file_row) {
555 $self->set_file_id( $file_row->get_column('file_id') );
556 }
557 else {
558 croak("DATABASE ASSOCIATED ERROR: The file ($data) don't exists in the metadata.md_files table.\n");
559 }
560}
561
562=head2 accessors get_tool_data, set_tool_data
563
564 Usage: my %tool_data = $tool->get_tool_data();
565 $tool->set_tool_data(%tool_data);
566
567 Desc: Get or set tool data table from a tool object
568 as hash with key=column_name and value=data
569
570 Ret: get=> %tool_data, a hash with key=column_name and
571 value=data
572 set=> none
573
574 Args: get=> none
575 set=> \%tool_data, a hash reference with key=column_name
576 and value=data
577
578 Side_Effects: For set, die if \%tool_data is not an hash
579 reference
580
581 Example: my %tool_data = $tool->get_tool_data();
582 $tool->set_tool_data(%tool_data);
583=cut
584
585sub get_tool_data {
586 my $self = shift;
587 return $self->get_bstool_row->get_columns();
588}
589
590sub set_tool_data {
591 my $self = shift;
592 my $data_href = shift ||
593 croak("FUNCTION PARAMETER ERROR: None hash ref. was supplied for set_tool_data function to CXGN::Biosource::ProtocolTool.\n");
594
595 if (ref($data_href) ne 'HASH') {
596 croak("DATA TYPE ERROR: The hash ref ($data_href) for $self->set_file_id() ISN'T AN HASH REFERENCE.\n");
597 }
598
599 $self->get_bstool_row()
600 ->set_columns($data_href);
601}
602
603
604#####################################
605### PUBLICATION RELATED FUNCTIONS ###
606#####################################
607
608=head2 add_publication
609
610 Usage: $tool->add_publication($pub_row);
611
612 Desc: Add a publication to the pub_ids associated to tool object
613
614 Ret: None
615
616 Args: $pub_row, a publication row object.
617 To use with $pub_id:
618 $tool->add_publication($pub_id);
619 To use with $pub_title
620 $tool->add_publication({ title => $pub_title } );
621 To use with pubmed accession
622 $tool->add_publication({ dbxref_accession => $accesssion});
623
624 Side_Effects: die if the parameter is not an object
625
626 Example: $tool->add_publication($pub_id);
627
628=cut
629
630sub add_publication {
631 my $self = shift;
632 my $pub = shift ||
633 croak("FUNCTION PARAMETER ERROR: None pub was supplied for add_publication function to CXGN::Biosource::ProtocolTool.\n");
634
635 my $pub_id;
636 if ($pub =~ m/^\d+$/) {
637 $pub_id = $pub;
638 }
639 elsif (ref($pub) eq 'HASH') {
640 my $pub_row;
641 if (exists $pub->{'title'}) {
642 ($pub_row) = $self->get_schema()
643 ->resultset('Pub::Pub')
644 ->search( {title => $pub->{'title'} });
645 }
646 elsif (exists $pub->{'dbxref_accession'}) {
647 ($pub_row) = $self->get_schema()
648 ->resultset('Pub::Pub')
649 ->search(
650 { 'dbxref.accession' => $pub->{'dbxref_accession'} },
651 { join => { 'pub_dbxref' => 'dbxref' } },
652 );
653 }
654
655 unless (defined $pub_row) {
656 croak("DATABASE ARGUMENT ERROR: Publication data used as argument for add_publication function don't exists in the DB.\n");
657 }
658 $pub_id = $pub_row->get_column('pub_id');
659
660 }
661 else {
662 croak("SET ARGUMENT ERROR: The publication ($pub) isn't a pub_id, or hash with title or dbxref_accession keys.\n");
663 }
664
665 my $toolpub_row = $self->get_schema()
666 ->resultset('BsToolPub')
667 ->new({ pub_id => $pub_id});
668
669 if (defined $self->get_tool_id() ) {
670 $toolpub_row->set_column( tool_id => $self->get_tool_id() );
671 }
672
673 my @toolpub_rows = $self->get_bstoolpub_rows();
674 push @toolpub_rows, $toolpub_row;
675 $self->set_bstoolpub_rows(\@toolpub_rows);
676}
677
678=head2 get_publication_list
679
680 Usage: my @pub_list = $tool->get_publication_list();
681
682 Desc: Get a list of publications associated to this tool
683
684 Ret: An array of pub_ids by default, but can be titles
685 or accessions using an argument
686
687 Args: None or a column to get.
688
689 Side_Effects: die if the parameter is not an object
690
691 Example: my @pub_id_list = $tool->get_publication_list();
692 my @pub_title_list = $tool->get_publication_list('title');
693 my @pub_title_accs = $tool->get_publication_list('dbxref.accession');
694
695
696=cut
697
698sub get_publication_list {
699 my $self = shift;
700 my $field = shift;
701
702 my @pub_list = ();
703
704 my @toolpub_rows = $self->get_bstoolpub_rows();
705 foreach my $toolpub_row (@toolpub_rows) {
706 my $pub_id = $toolpub_row->get_column('pub_id');
707 my ($pub_row) = $self->get_schema()
708 ->resultset('Pub::Pub')
709 ->search(
710 { pub_id => $pub_id },
711 {
712 '+columns' => ['dbxref.accession'],
713 join => { 'pub_dbxref' => 'dbxref' }
714 }
715 );
716 if (defined $field) {
717 push @pub_list, $pub_row->get_column($field);
718 }
719 else {
720 push @pub_list, $pub_row->get_column('pub_id');
721 }
722 }
723
724 return @pub_list;
725}
726
727#####################################
728### METADBDATA ASSOCIATED METHODS ###
729#####################################
730
731=head2 accessors get_metadbdata
732
733 Usage: my $metadbdata = $tool->get_metadbdata();
734
735 Desc: Get metadata object associated to tool data (see CXGN::Metadata::Metadbdata).
736
737 Ret: A metadbdata object (CXGN::Metadata::Metadbdata)
738
739 Args: Optional, a metadbdata object to transfer metadata creation variables
740
741 Side_Effects: none
742
743 Example: my $metadbdata = $tool->get_metadbdata();
744 my $metadbdata = $tool->get_metadbdata($metadbdata);
745
746=cut
747
748sub get_metadbdata {
749 my $self = shift;
750 my $metadata_obj_base = shift;
751
752 my $metadbdata;
753 my $metadata_id = $self->get_bstool_row
754 ->get_column('metadata_id');
755
756 if (defined $metadata_id) {
757 $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
758 if (defined $metadata_obj_base) {
759
760 ## This will transfer the creation data from the base object to the new one
761 $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
762 $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
763 }
764 }
765 else {
766 my $tool_id = $self->get_tool_id();
767 croak("DATABASE INTEGRITY ERROR: The metadata_id for the tool_id=$tool_id is undefined.\n");
768 }
769
770 return $metadbdata;
771}
772
773=head2 is_obsolete
774
775 Usage: $tool->is_obsolete();
776
777 Desc: Get obsolete field form metadata object associated to
778 protocol data (see CXGN::Metadata::Metadbdata).
779
780 Ret: 0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
781
782 Args: none
783
784 Side_Effects: none
785
786 Example: unless ($tool->is_obsolete()) { ## do something }
787
788=cut
789
790sub is_obsolete {
791 my $self = shift;
792
793 my $metadbdata = $self->get_metadbdata();
794 my $obsolete = $metadbdata->get_obsolete();
795
796 if (defined $obsolete) {
797 return $obsolete;
798 }
799 else {
800 return 0;
801 }
802}
803
804
805=head2 accessors get_tool_pub_metadbdata
806
807 Usage: my %metadbdata = $tool->get_tool_pub_metadbdata();
808
809 Desc: Get metadata object associated to tool data
810 (see CXGN::Metadata::Metadbdata).
811
812 Ret: A hash with keys=pub_id and values=metadbdata object
813 (CXGN::Metadata::Metadbdata)
814
815 Args: Optional, a metadbdata object to transfer metadata creation variables
816
817 Side_Effects: none
818
819 Example: my %metadbdata = $tool->get_tool_metadbdata();
820 my %metadbdata = $tool->get_tool_metadbdata($metadbdata);
821
822=cut
823
824sub get_tool_pub_metadbdata {
825 my $self = shift;
826 my $metadata_obj_base = shift;
827
828 my %metadbdata;
829 my @bstoolpub_rows = $self->get_bstoolpub_row();
830
831 foreach my $bstoolpub_row (@bstoolpub_rows) {
832 my $pub_id = $bstoolpub_row->get_column('pub_id');
833 my $metadata_id = $bstoolpub_row->get_column('metadata_id');
834
835 if (defined $metadata_id) {
836 my $metadbdata = CXGN::Metadata::Metadbdata->new($self->get_schema(), undef, $metadata_id);
837 if (defined $metadata_obj_base) {
838
839 ## This will transfer the creation data from the base object to the new one
840 $metadbdata->set_object_creation_date($metadata_obj_base->get_object_creation_date());
841 $metadbdata->set_object_creation_user($metadata_obj_base->get_object_creation_user());
842 }
843 $metadbdata{$pub_id} = $metadbdata;
844 }
845 else {
846 my $tool_pub_id = $bstoolpub_row->get_column('tool_pub_id');
847 croak("DATABASE INTEGRITY ERROR: The metadata_id for the tool_pub_id=$tool_pub_id is undefined.\n");
848 }
849 }
850 return %metadbdata;
851}
852
853=head2 is_tool_pub_obsolete
854
855 Usage: $tool->is_tool_pub_obsolete($pub_id);
856
857 Desc: Get obsolete field form metadata object associated to
858 protocol data (see CXGN::Metadata::Metadbdata).
859
860 Ret: 0 -> false (it is not obsolete) or 1 -> true (it is obsolete)
861
862 Args: $pub_id, a publication_id
863
864 Side_Effects: none
865
866 Example: unless ( $tool->is_tool_pub_obsolete($pub_id) ) { ## do something }
867
868=cut
869
870sub is_tool_pub_obsolete {
871 my $self = shift;
872 my $pub_id = shift;
873
874 my %metadbdata = $self->get_tool_pub_metadbdata();
875 my $metadbdata = $metadbdata{$pub_id};
876
877 my $obsolete = 0;
878 if (defined $metadbdata) {
879 $obsolete = $metadbdata->get_obsolete() || 0;
880 }
881 return $obsolete;
882
883}
884
885
886#######################
887### STORING METHODS ###
888#######################
889
890=head2 store
891
892 Usage: my $tool = $tool->store($metadata);
893
894 Desc: Store in the database the tool data for the tool object
895
896 Ret: $tool, the tool object with the data updated
897
898 Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
899
900 Side_Effects: Die if:
901 1- None metadata object is supplied.
902 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
903 object
904
905 Example: my $tool = $tool->store($metadata);
906
907=cut
908
909sub store {
910 my $self = shift;
911
912 ## FIRST, check the metadata_id supplied as parameter
913 my $metadata = shift
914 || croak("STORE ERROR: None metadbdata object was supplied to $self->store().\n");
915
916 unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
917 croak("STORE ERROR: Metadbdata supplied to $self->store() is not CXGN::Metadata::Metadbdata object.\n");
918 }
919
920 ## It is not necessary check the current user used to store the data because should be the same than the used
921 ## to create a metadata_id. In the medadbdata object, it is checked.
922
923 ## SECOND, check if exists or not group_id.
924 ## if exists group_id => update
925 ## if do not exists group_id => insert
926
927 my $bstool_row = $self->get_bstool_row();
928 my $tool_id = $bstool_row->get_column('tool_id');
929
930 unless (defined $tool_id) { ## NEW INSERT and DISCARD CHANGES
931
932 my $metadata_id = $metadata->store()
933 ->get_metadata_id();
934
935 $bstool_row->set_column( metadata_id => $metadata_id ); ## Set the metadata_id column
936
937 $bstool_row->insert()
938 ->discard_changes(); ## It will set the row with the updated row
939
940 }
941 else { ## UPDATE IF SOMETHING has change
942
943 my @columns_changed = $bstool_row->is_changed();
944
945 if (scalar(@columns_changed) > 0) { ## ...something has change, it will take
946
947 my @modification_note_list; ## the changes and the old metadata object for
948 foreach my $col_changed (@columns_changed) { ## this dbiref and it will create a new row
949 push @modification_note_list, "set value in $col_changed column";
950 }
951
952 my $modification_note = join ', ', @modification_note_list;
953
954 my $mod_metadata_id = $self->get_metadbdata($metadata)
955 ->store({ modification_note => $modification_note })
956 ->get_metadata_id();
957
958 $bstool_row->set_column( metadata_id => $mod_metadata_id );
959
960 $bstool_row->update()
961 ->discard_changes();
962 }
963 }
964 return $self;
965}
966
967
968=head2 obsolete
969
970 Usage: my $tool = $tool->obsolete($metadata, $note, 'REVERT');
971
972 Desc: Change the status of a data to obsolete.
973 If revert tag is used the obsolete status will be reverted to 0 (false)
974
975 Ret: $tool, the tool object updated with the db data.
976
977 Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
978 $note, a note to explain the cause of make this data obsolete
979 optional, 'REVERT'.
980
981 Side_Effects: Die if:
982 1- None metadata object is supplied.
983 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
984
985 Example: my $tool = $tool->obsolete($metadata, 'change to obsolete test');
986
987=cut
988
989sub obsolete {
990 my $self = shift;
991
992 ## FIRST, check the metadata_id supplied as parameter
993
994 my $metadata = shift
995 || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete().\n");
996
997 unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
998 croak("OBSOLETE ERROR: Metadbdata object supplied to $self->obsolete is not CXGN::Metadata::Metadbdata obj.\n");
999 }
1000
1001 my $obsolete_note = shift
1002 || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete().\n");
1003
1004 my $revert_tag = shift;
1005
1006
1007 ## If exists the tag revert change obsolete to 0
1008
1009 my $obsolete = 1;
1010 my $modification_note = 'change to obsolete';
1011 if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1012 $obsolete = 0;
1013 $modification_note = 'revert obsolete';
1014 }
1015
1016 ## Create a new metadata with the obsolete tag
1017
1018 my $mod_metadata_id = $self->get_metadbdata($metadata)
1019 ->store( { modification_note => $modification_note,
1020 obsolete => $obsolete,
1021 obsolete_note => $obsolete_note } )
1022 ->get_metadata_id();
1023
1024 ## Modify the group row in the database
1025
1026 my $bstool_row = $self->get_bstool_row();
1027
1028 $bstool_row->set_column( metadata_id => $mod_metadata_id );
1029
1030 $bstool_row->update()
1031 ->discard_changes();
1032
1033 return $self;
1034}
1035
1036
1037=head2 store_pub_associations
1038
1039 Usage: my $tool = $tool->store_pub_associations($metadata);
1040
1041 Desc: Store in the database the pub association for the tool object
1042
1043 Ret: $tool, the tool object with the data updated
1044
1045 Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1046
1047 Side_Effects: Die if:
1048 1- None metadata object is supplied.
1049 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1050 object
1051
1052 Example: my $tool = $tool->store_pub_associations($metadata);
1053
1054=cut
1055
1056sub store_pub_associations {
1057 my $self = shift;
1058
1059 ## FIRST, check the metadata_id supplied as parameter
1060 my $metadata = shift
1061 || croak("STORE ERROR: None metadbdata object was supplied to $self->store_pub_associations().\n");
1062
1063 unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1064 croak("STORE ERROR: Metadbdata supplied to $self->store_pub_associations() is not CXGN::Metadata::Metadbdata object.\n");
1065 }
1066
1067 ## It is not necessary check the current user used to store the data because should be the same than the used
1068 ## to create a metadata_id. In the medadbdata object, it is checked.
1069
1070 ## SECOND, check if exists or not group_id.
1071 ## if exists tool_pub_id => update
1072 ## if do not exists tool_pub_id => insert
1073
1074 my @bstoolpub_rows = $self->get_bstoolpub_rows();
1075
1076 foreach my $bstoolpub_row (@bstoolpub_rows) {
1077
1078 my $tool_pub_id = $bstoolpub_row->get_column('tool_pub_id');
1079
1080 unless (defined $tool_pub_id) { ## NEW INSERT and DISCARD CHANGES
1081
1082 my $metadata_id = $metadata->store()
1083 ->get_metadata_id();
1084
1085 $bstoolpub_row->set_column( metadata_id => $metadata_id ); ## Set the metadata_id column
1086
1087 $bstoolpub_row->insert()
1088 ->discard_changes(); ## It will set the row with the updated row
1089
1090 }
1091 else { ## UPDATE IF SOMETHING has change
1092
1093 my @columns_changed = $bstoolpub_row->is_changed();
1094
1095 if (scalar(@columns_changed) > 0) { ## ...something has change, it will take
1096
1097 my @modification_note_list; ## the changes and the old metadata object for
1098 foreach my $col_changed (@columns_changed) { ## this dbiref and it will create a new row
1099 push @modification_note_list, "set value in $col_changed column";
1100 }
1101
1102 my $modification_note = join ', ', @modification_note_list;
1103
1104 my $mod_metadata_id = $self->get_metadbdata($metadata)
1105 ->store({ modification_note => $modification_note })
1106 ->get_metadata_id();
1107
1108 $bstoolpub_row->set_column( metadata_id => $mod_metadata_id );
1109
1110 $bstoolpub_row->update()
1111 ->discard_changes();
1112 }
1113 }
1114 }
1115 return $self;
1116}
1117
1118
1119=head2 obsolete_pub_association
1120
1121 Usage: my $tool = $tool->obsolete_pub_association($metadata, $note, $pub_id, 'REVERT');
1122
1123 Desc: Change the status of a data to obsolete.
1124 If revert tag is used the obsolete status will be reverted to 0 (false)
1125
1126 Ret: $tool, the tool object updated with the db data.
1127
1128 Args: $metadata, a metadata object (CXGN::Metadata::Metadbdata object).
1129 $note, a note to explain the cause of make this data obsolete
1130 $pub_id, a publication id associated to this tool
1131 optional, 'REVERT'.
1132
1133 Side_Effects: Die if:
1134 1- None metadata object is supplied.
1135 2- The metadata supplied is not a CXGN::Metadata::Metadbdata
1136
1137 Example: my $tool = $tool->obsolete_pub_association($metadata,
1138 'change to obsolete test',
1139 $pub_id );
1140
1141=cut
1142
1143sub obsolete_pub_association {
1144 my $self = shift;
1145
1146 ## FIRST, check the metadata_id supplied as parameter
1147
1148 my $metadata = shift
1149 || croak("OBSOLETE ERROR: None metadbdata object was supplied to $self->obsolete_pub_association().\n");
1150
1151 unless (ref($metadata) eq 'CXGN::Metadata::Metadbdata') {
1152 croak("OBSOLETE ERROR: Metadbdata object supplied to $self->obsolete_pub_association is not CXGN::Metadata::Metadbdata obj.\n");
1153 }
1154
1155 my $obsolete_note = shift
1156 || croak("OBSOLETE ERROR: None obsolete note was supplied to $self->obsolete_pub_association().\n");
1157
1158 my $pub_id = shift
1159 || croak("OBSOLETE ERROR: None pub_id was supplied to $self->obsolete_pub_association().\n");
1160
1161 my $revert_tag = shift;
1162
1163
1164 ## If exists the tag revert change obsolete to 0
1165
1166 my $obsolete = 1;
1167 my $modification_note = 'change to obsolete';
1168 if (defined $revert_tag && $revert_tag =~ m/REVERT/i) {
1169 $obsolete = 0;
1170 $modification_note = 'revert obsolete';
1171 }
1172
1173 ## Create a new metadata with the obsolete tag
1174
1175 my $mod_metadata_id = $self->get_metadbdata($metadata)
1176 ->store( { modification_note => $modification_note,
1177 obsolete => $obsolete,
1178 obsolete_note => $obsolete_note } )
1179 ->get_metadata_id();
1180
1181 ## Modify the group row in the database
1182
1183 my @bstoolpub_rows = $self->get_bstoolpub_row();
1184 foreach my $bstoolpub_row (@bstoolpub_rows) {
1185 if ($bstoolpub_row->get_column($pub_id) == $pub_id) {
1186
1187 $bstoolpub_row->set_column( metadata_id => $mod_metadata_id );
1188
1189 $bstoolpub_row->update()
1190 ->discard_changes();
1191
1192 }
1193 }
1194 return $self;
1195}
1196
1197
1198
1199
1200
1201
1202###########
1203return 1;##
1204###########