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