ensembl-hive  2.6
HivePipeline.pm
Go to the documentation of this file.
1 =head1 LICENSE
2 
3 Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
4 Copyright [2016-2024] EMBL-European Bioinformatics Institute
5 
6 Licensed under the Apache License, Version 2.0 (the "License");
7 you may not use this file except in compliance with the License.
8 You may obtain a copy of the License at
9 
10  http://www.apache.org/licenses/LICENSE-2.0
11 
12 Unless required by applicable law or agreed to in writing, software
13 distributed under the License is distributed on an "AS IS" BASIS,
14 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 See the License for the specific language governing permissions and
16 limitations under the License.
17 
18 =cut
19 
20 package Bio::EnsEMBL::Hive::HivePipeline;
21 
22 use strict;
23 use warnings;
24 
27 use Bio::EnsEMBL::Hive::Utils ('stringify', 'destringify', 'throw');
31 
32  # needed for offline graph generation:
35 
36 use constant {
37  TWEAK_ERROR_MSG => {
38  PARSE_ERROR => 'Tweak cannot be parsed',
39  ACTION_ERROR => 'Action is not supported',
40  FIELD_ERROR => 'Field not recognized',
41  VALUE_ERROR => 'Invalid value',
42  },
43  TWEAK_ACTION => {
44  '=' => 'SET',
45  '+' => 'SET',
46  '?' => 'SHOW',
47  '#' => 'DELETE',
48  },
49  TWEAK_OBJECT_TYPE => {
50  PIPELINE => 'Pipeline',
51  ANALYSIS => 'Analysis',
52  RESOURCE_CLASS => 'Resource class',
53  },
54 };
55 
56 
57 sub hive_dba { # The adaptor for HivePipeline objects
58  my $self = shift @_;
59 
60  if(@_) {
61  $self->{'_hive_dba'} = shift @_;
62  $self->{'_hive_dba'}->hive_pipeline($self) if $self->{'_hive_dba'};
63  }
64  return $self->{'_hive_dba'};
65 }
66 
67 
68 sub display_name {
69  my $self = shift @_;
70 
71  if(my $dbc = $self->hive_dba && $self->hive_dba->dbc) {
72  return $dbc->dbname . '@' .($dbc->host||'');
73  } else {
74  return '(unstored '.$self->hive_pipeline_name.')';
75  }
76 }
77 
78 
79 sub unambig_key { # based on DBC's URL if present, otherwise on pipeline_name
80  my $self = shift @_;
81 
82  if(my $dbc = $self->hive_dba && $self->hive_dba->dbc) {
83  return Bio::EnsEMBL::Hive::Utils::URL::hash_to_unambig_url( $dbc->to_url_hash );
84  } else {
85  return 'unstored:'.$self->hive_pipeline_name;
86  }
87 }
88 
89 
90 sub collection_of {
91  my $self = shift @_;
92  my $type = shift @_;
93 
94  if (@_) {
95  $self->{'_cache_by_class'}->{$type} = shift @_;
96  } elsif (not $self->{'_cache_by_class'}->{$type}) {
97 
98  if( (my $hive_dba = $self->hive_dba) and ($type ne 'NakedTable') and ($type ne 'Accumulator') and ($type ne 'Job') and ($type ne 'AnalysisJob')) {
99  my $adaptor = $hive_dba->get_adaptor( $type );
100  my $all_objects = $adaptor->fetch_all();
101  if(@$all_objects and UNIVERSAL::can($all_objects->[0], 'hive_pipeline') ) {
102  $_->hive_pipeline($self) for @$all_objects;
103  }
104  $self->{'_cache_by_class'}->{$type} = Bio::EnsEMBL::Hive::Utils::Collection->new( $all_objects );
105 # warn "initialized collection_of($type) by loading all ".scalar(@$all_objects)."\n";
106  } else {
107  $self->{'_cache_by_class'}->{$type} = Bio::EnsEMBL::Hive::Utils::Collection->new();
108 # warn "initialized collection_of($type) as an empty one\n";
109  }
110  }
111 
112  return $self->{'_cache_by_class'}->{$type};
113 }
114 
115 
116 sub find_by_query {
117  my $self = shift @_;
118  my $query_params = shift @_;
119  my $no_die = shift @_;
120 
121  if(my $object_type = delete $query_params->{'object_type'}) {
122  my $object;
123 
124  if($object_type eq 'Accumulator' or $object_type eq 'NakedTable') {
125 
126  unless($object = $self->collection_of($object_type)->find_one_by( %$query_params )) {
127 
128  my @specific_adaptor_params = ($object_type eq 'NakedTable')
129  ? ('table_name' => $query_params->{'table_name'},
130  $query_params->{'insertion_method'}
131  ? ('insertion_method' => $query_params->{'insertion_method'})
132  : ()
133  )
134  : ();
135  ($object) = $self->add_new_or_update( $object_type, # NB: add_new_or_update returns a list
136  %$query_params,
137  $self->hive_dba ? ('adaptor' => $self->hive_dba->get_adaptor($object_type, @specific_adaptor_params)) : (),
138  );
139  }
140  } elsif($object_type eq 'AnalysisJob' or $object_type eq 'Semaphore') {
141  my $id_name = { 'AnalysisJob' => 'job_id', 'Semaphore' => 'semaphore_id' }->{$object_type};
142  my $dbID = $query_params->{$id_name};
143  my $coll = $self->collection_of($object_type);
144  unless($object = $coll->find_one_by( 'dbID' => $dbID )) {
145 
146  my $adaptor = $self->hive_dba->get_adaptor( $object_type );
147  if( $object = $adaptor->fetch_by_dbID( $dbID ) ) {
148  $coll->add( $object );
149  }
150  }
151  } else {
152  $object = $self->collection_of($object_type)->find_one_by( %$query_params );
153  }
154 
155  return $object if $object || $no_die;
156  throw("Could not find an '$object_type' object from query ".stringify($query_params)." in ".$self->display_name);
157 
158  } else {
159  throw("Could not find or guess the object_type from the query ".stringify($query_params)." , so could not find the object");
160  }
161 }
162 
163 sub test_connections {
164  my $self = shift;
165 
166  my @warnings;
167 
168  foreach my $dft ($self->collection_of('DataflowTarget')->list) {
169  my $analysis_url = $dft->to_analysis_url;
170  if ($analysis_url =~ m{^\w+$}) {
171  my $heir_analysis = $self->collection_of('Analysis')->find_one_by('logic_name', $analysis_url)
172  or push @warnings, "Could not find a local analysis named '$analysis_url' (dataflow from analysis '".($dft->source_dataflow_rule->from_analysis->logic_name)."')";
173  }
174  }
175 
176  foreach my $cf ($self->collection_of('AnalysisCtrlRule')->list) {
177  my $analysis_url = $cf->condition_analysis_url;
178  if ($analysis_url =~ m{^\w+$}) {
179  my $heir_analysis = $self->collection_of('Analysis')->find_one_by('logic_name', $analysis_url)
180  or push @warnings, "Could not find a local analysis named '$analysis_url' (control-flow for analysis '".($cf->ctrled_analysis->logic_name)."')";
181  }
182 
183  }
184 
185  if (@warnings) {
186  push @warnings, '', 'Please fix these before running the pipeline';
187  warn join("\n", '', '# ' . '-' x 26 . '[WARNINGS]' . '-' x 26, '', @warnings), "\n";
188  }
189 }
190 
191 
192 sub new { # construct an attached or a detached Pipeline object
193  my $class = shift @_;
194 
195  my $self = bless {}, $class;
196 
197  my %dba_flags = @_;
198  my $existing_dba = delete $dba_flags{'-dba'};
199 
200  if(%dba_flags) {
201  my $hive_dba = Bio::EnsEMBL::Hive::DBSQL::DBAdaptor->new( %dba_flags );
202  $self->hive_dba( $hive_dba );
203  } elsif ($existing_dba) {
204  $self->hive_dba( $existing_dba );
205  } else {
206 # warn "Created a standalone pipeline";
207  }
208 
209  Bio::EnsEMBL::Hive::TheApiary->pipelines_collection->add( $self );
210 
211  return $self;
212 }
213 
214 
215  # If there is a DBAdaptor, collection_of() will fetch a collection on demand:
216 sub invalidate_collections {
217  my $self = shift @_;
218 
219  delete $self->{'_cache_by_class'};
220  return;
221 }
222 
223 
224 sub save_collections {
225  my $self = shift @_;
226 
227  my $hive_dba = $self->hive_dba();
228 
229  my @adaptor_types = ('MetaParameters', 'PipelineWideParameters', 'ResourceClass', 'ResourceDescription', 'Analysis', 'AnalysisStats', 'AnalysisCtrlRule', 'DataflowRule', 'DataflowTarget');
230 
231  foreach my $AdaptorType (reverse @adaptor_types) {
232  my $adaptor = $hive_dba->get_adaptor( $AdaptorType );
233  my $coll = $self->collection_of( $AdaptorType );
234  if( my $dark_collection = $coll->dark_collection) {
235  foreach my $obj_to_be_deleted ( $coll->dark_collection->list ) {
236  $adaptor->remove( $obj_to_be_deleted );
237 # warn "Deleted ".(UNIVERSAL::can($obj_to_be_deleted, 'toString') ? $obj_to_be_deleted->toString : stringify($obj_to_be_deleted))."\n";
238  }
239  $coll->dark_collection( undef );
240  }
241  }
242 
243  foreach my $AdaptorType (@adaptor_types) {
244  my $adaptor = $hive_dba->get_adaptor( $AdaptorType );
245  my $class = 'Bio::EnsEMBL::Hive::'.$AdaptorType;
246  my $coll = $self->collection_of( $AdaptorType );
247  foreach my $storable_object ( $coll->list ) {
248  $adaptor->store_or_update_one( $storable_object, $class->unikey() );
249 # warn "Stored/updated ".$storable_object->toString()."\n";
250  }
251  }
252 
253  my $job_adaptor = $hive_dba->get_AnalysisJobAdaptor;
254  foreach my $analysis ( $self->collection_of( 'Analysis' )->list ) {
255  if(my $our_jobs = $analysis->jobs_collection ) {
256  $job_adaptor->store( $our_jobs );
257 # foreach my $job (@$our_jobs) {
258 # warn "Stored ".$job->toString()."\n";
259 # }
260  }
261  }
262 }
263 
264 
265 sub add_new_or_update {
266  my $self = shift @_;
267  my $type = shift @_;
268 
269  # $verbose is an extra optional argument that sits between the type and the object hash
270  my $verbose = scalar(@_) % 2 ? shift : 0;
271 
272  my $class = 'Bio::EnsEMBL::Hive::'.$type;
273  my $coll = $self->collection_of( $type );
274 
275  my $object;
276  my $newly_made = 0;
277 
278  if( my $unikey_keys = $class->unikey() ) {
279  my %other_pairs = @_;
280  my %unikey_pairs;
281  @unikey_pairs{ @$unikey_keys} = delete @other_pairs{ @$unikey_keys };
282 
283  if( $object = $coll->find_one_by( %unikey_pairs ) ) {
284  my $found_display = $verbose && (UNIVERSAL::can($object, 'toString') ? $object->toString : stringify($object));
285  if(keys %other_pairs) {
286  print "Updating $found_display with (".stringify(\%other_pairs).")\n" if $verbose;
287  if( ref($object) eq 'HASH' ) {
288  @$object{ keys %other_pairs } = values %other_pairs;
289  } else {
290  while( my ($key, $value) = each %other_pairs ) {
291  $object->$key($value);
292  }
293  }
294  } else {
295  print "Found a matching $found_display\n" if $verbose;
296  }
297  } elsif( my $dark_coll = $coll->dark_collection) {
298  if( my $shadow_object = $dark_coll->find_one_by( %unikey_pairs ) ) {
299  $dark_coll->forget( $shadow_object );
300  my $found_display = $verbose && (UNIVERSAL::can($shadow_object, 'toString') ? $shadow_object->toString : stringify($shadow_object));
301  print "Undeleting $found_display\n" if $verbose;
302  }
303  }
304  } else {
305  warn "$class doesn't redefine unikey(), so unique objects cannot be identified";
306  }
307 
308  unless( $object ) {
309  $object = $class->can('new') ? $class->new( @_ ) : { @_ };
310  $newly_made = 1;
311 
312  $coll->add( $object );
313 
314  $object->hive_pipeline($self) if UNIVERSAL::can($object, 'hive_pipeline');
315 
316  my $found_display = $verbose && (UNIVERSAL::can($object, 'toString') ? $object->toString : 'naked entry '.stringify($object));
317  print "Created a new $found_display\n" if $verbose;
318  }
319 
320  return ($object, $newly_made);
321 }
322 
323 
324 =head2 get_source_analyses
325 
326  Description: returns a listref of analyses that do not have local inflow ("source analyses")
327 
328 =cut
329 
330 sub get_source_analyses {
331  my $self = shift @_;
332 
333  my %analyses_to_discard = map {scalar($_->to_analysis) => 1} $self->collection_of( 'DataflowTarget' )->list;
334 
335  return [grep {!$analyses_to_discard{"$_"}} $self->collection_of( 'Analysis' )->list];
336 }
337 
338 
339 =head2 _meta_value_by_key
340 
341  Description: getter/setter for a particular meta_value from 'MetaParameters' collection given meta_key
342 
343 =cut
344 
345 sub _meta_value_by_key {
346  my $self = shift @_;
347  my $meta_key= shift @_;
348 
349  my $hash = $self->collection_of( 'MetaParameters' )->find_one_by( 'meta_key', $meta_key );
350 
351  if(@_) {
352  my $new_value = shift @_;
353 
354  if($hash) {
355  $hash->{'meta_value'} = $new_value;
356  } else {
357  ($hash) = $self->add_new_or_update( 'MetaParameters',
358  'meta_key' => $meta_key,
359  'meta_value' => $new_value,
360  );
361  }
362  }
363 
364  return $hash && $hash->{'meta_value'};
365 }
366 
367 
368 =head2 hive_use_param_stack
369 
370  Description: getter/setter via MetaParameters. Defines which one of two modes of parameter propagation is used in this pipeline
371 
372 =cut
373 
374 sub hive_use_param_stack {
375  my $self = shift @_;
376 
377  return $self->_meta_value_by_key('hive_use_param_stack', @_) // 0;
378 }
379 
380 
381 =head2 hive_pipeline_name
382 
383  Description: getter/setter via MetaParameters. Defines the symbolic name of the pipeline.
384 
385 =cut
386 
387 sub hive_pipeline_name {
388  my $self = shift @_;
389 
390  return $self->_meta_value_by_key('hive_pipeline_name', @_) // '';
391 }
392 
393 
394 =head2 hive_auto_rebalance_semaphores
395 
396  Description: getter/setter via MetaParameters. Defines whether beekeeper should attempt to rebalance semaphores on each iteration.
397 
398 =cut
399 
400 sub hive_auto_rebalance_semaphores {
401  my $self = shift @_;
402 
403  return $self->_meta_value_by_key('hive_auto_rebalance_semaphores', @_) // '0';
404 }
405 
406 
407 =head2 hive_use_triggers
408 
409  Description: getter via MetaParameters. Defines whether SQL triggers are used to automatically update AnalysisStats counters
410 
411 =cut
412 
413 sub hive_use_triggers {
414  my $self = shift @_;
415 
416  if(@_) {
417  throw('HivePipeline::hive_use_triggers is not settable, it is only a getter');
418  }
419 
420  return $self->_meta_value_by_key('hive_use_triggers') // '0';
421 }
422 
423 =head2 hive_default_max_retry_count
424 
425  Description: getter/setter via MetaParameters. Defines the default value for analysis_base.max_retry_count
426 
427 =cut
428 
429 sub hive_default_max_retry_count {
430  my $self = shift @_;
431 
432  return $self->_meta_value_by_key('hive_default_max_retry_count', @_) // 0;
433 }
434 
435 
436 =head2 list_all_hive_tables
437 
438  Description: getter via MetaParameters. Lists the (MySQL) table names used by the HivePipeline
439 
440 =cut
441 
442 sub list_all_hive_tables {
443  my $self = shift @_;
444 
445  if(@_) {
446  throw('HivePipeline::list_all_hive_tables is not settable, it is only a getter');
447  }
448 
449  return [ split /,/, ($self->_meta_value_by_key('hive_all_base_tables') // '') ];
450 }
451 
452 
453 =head2 list_all_hive_views
454 
455  Description: getter via MetaParameters. Lists the (MySQL) view names used by the HivePipeline
456 
457 =cut
458 
459 sub list_all_hive_views {
460  my $self = shift @_;
461 
462  if(@_) {
463  throw('HivePipeline::list_all_hive_views is not settable, it is only a getter');
464  }
465 
466  return [ split /,/, ($self->_meta_value_by_key('hive_all_views') // '') ];
467 }
468 
469 
470 =head2 hive_sql_schema_version
471 
472  Description: getter via MetaParameters. Defines the Hive SQL schema version of the database if it has been stored
473 
474 =cut
475 
476 sub hive_sql_schema_version {
477  my $self = shift @_;
478 
479  if(@_) {
480  throw('HivePipeline::hive_sql_schema_version is not settable, it is only a getter');
481  }
482 
483  return $self->_meta_value_by_key('hive_sql_schema_version') // 'N/A';
484 }
485 
486 
487 =head2 params_as_hash
488 
489  Description: returns the destringified contents of the 'PipelineWideParameters' collection as a hash
490 
491 =cut
492 
493 sub params_as_hash {
494  my $self = shift @_;
495 
496  my $collection = $self->collection_of( 'PipelineWideParameters' );
497  return { map { $_->{'param_name'} => destringify($_->{'param_value'}) } $collection->list() };
498 }
499 
500 
501 =head2 get_cached_hive_current_load
502 
503  Description: Proxy for RoleAdaptor::get_hive_current_load() that caches the last value.
504 
505 =cut
506 
507 sub get_cached_hive_current_load {
508  my $self = shift @_;
509 
510  if (not exists $self->{'_cached_hive_load'}) {
511  if ($self->hive_dba) {
512  $self->{'_cached_hive_load'} = $self->hive_dba->get_RoleAdaptor->get_hive_current_load();
513  } else {
514  $self->{'_cached_hive_load'} = 0;
515  }
516  }
517  return $self->{'_cached_hive_load'};
518 }
519 
520 
521 =head2 invalidate_hive_current_load
522 
523  Description: Method that forces the next get_cached_hive_current_load() call to fetch a fresh value from the database
524 
525 =cut
526 
527 sub invalidate_hive_current_load {
528  my $self = shift @_;
529 
530  delete $self->{'_cached_hive_load'};
531 }
532 
533 
534 =head2 print_diagram
535 
536  Description: prints a "Unicode art" textual representation of the pipeline's flow diagram
537 
538 =cut
539 
540 sub print_diagram {
541  my $self = shift @_;
542 
543  print ''.('─'x20).'[ '.$self->display_name.' ]'.('─'x20)."\n";
544 
545  my %seen = ();
546  foreach my $source_analysis ( @{ $self->get_source_analyses } ) {
547  print "\n";
548  $source_analysis->print_diagram_node($self, '', \%seen);
549  }
550  foreach my $cyclic_analysis ( $self->collection_of( 'Analysis' )->list ) {
551  next if $seen{$cyclic_analysis};
552  print "\n";
553  $cyclic_analysis->print_diagram_node($self, '', \%seen);
554  }
555 }
556 
557 
558 =head2 apply_tweaks
559 
560  Description: changes attributes of Analyses|ResourceClasses|ResourceDescriptions or values of pipeline/analysis parameters
561 
562 =cut
563 
564 sub apply_tweaks {
565  my $self = shift @_;
566  my $tweaks = shift @_;
567  my @response;
568  my $responseStructure;
569  my $need_write = 0;
570  $responseStructure->{Tweaks} = [];
571  foreach my $tweak (@$tweaks) {
572  push @response, "\nTweak.Request\t$tweak\n";
573 
574  if($tweak=~/^pipeline\.param\[(\w+)\](\?|#|=(.+))$/) {
575  my ($param_name, $operator, $new_value_str) = ($1, $2, $3);
576  my $pwp_collection = $self->collection_of( 'PipelineWideParameters' );
577  my $hash_pair = $pwp_collection->find_one_by('param_name', $param_name);
578  my $value = $hash_pair ? $hash_pair->{'param_value'} : undef;
579  my $tweakStructure;
580  $tweakStructure->{Action} = TWEAK_ACTION->{substr($operator, 0, 1)};
581  $tweakStructure->{Object}->{Type} = TWEAK_OBJECT_TYPE->{PIPELINE};
582  $tweakStructure->{Object}->{Id} = undef;
583  $tweakStructure->{Object}->{Name} = undef;
584  $tweakStructure->{Return}->{Field} = $param_name;
585  $tweakStructure->{Return}->{OldValue} = $value;
586 
587  if($operator eq '?') {
588  $tweakStructure->{Return}->{NewValue} = $value;
589  push @response, "Tweak.Show \tpipeline.param[$param_name] ::\t"
590  . ($hash_pair ? $hash_pair->{'param_value'} : '(missing_value)') . "\n";
591  } elsif($operator eq '#') {
592  $tweakStructure->{Return}->{NewValue} = undef;
593  if ($hash_pair) {
594  $need_write = 1;
595  $pwp_collection->forget_and_mark_for_deletion( $hash_pair );
596  push @response, "Tweak.Deleting\tpipeline.param[$param_name] ::\t".stringify($hash_pair->{'param_value'})." --> (missing value)\n";
597  } else {
598  push @response, "Tweak.Deleting\tpipeline.param[$param_name] skipped (does not exist)\n";
599  }
600  } else {
601  $need_write = 1;
602  my $new_value = destringify( $new_value_str );
603  $new_value_str = stringify($new_value);
604  $tweakStructure->{Return}->{NewValue} = $new_value_str;
605  if($hash_pair) {
606  push @response, "Tweak.Changing\tpipeline.param[$param_name] ::\t$hash_pair->{'param_value'} --> $new_value_str\n";
607 
608  $hash_pair->{'param_value'} = $new_value_str;
609  } else {
610  push @response, "Tweak.Adding \tpipeline.param[$param_name] ::\t(missing value) --> $new_value_str\n";
611  $self->add_new_or_update( 'PipelineWideParameters',
612  'param_name' => $param_name,
613  'param_value' => $new_value_str,
614  );
615  }
616  }
617  push @{$responseStructure->{Tweaks}}, $tweakStructure;
618 
619  } elsif($tweak=~/^pipeline\.(\w+)(\?|=(.+))$/) {
620  my ($attrib_name, $operator, $new_value_str) = ($1, $2, $3);
621  my $tweakStructure;
622  $tweakStructure->{Object}->{Type} = TWEAK_OBJECT_TYPE->{PIPELINE};
623  $tweakStructure->{Object}->{Id} = undef;
624  $tweakStructure->{Object}->{Name} = undef;
625  $tweakStructure->{Return}->{Field} = $attrib_name;
626  $tweakStructure->{Action} = TWEAK_ACTION->{substr($operator, 0, 1)};
627 
628  if($self->can($attrib_name)) {
629  my $old_value = stringify( $self->$attrib_name() );
630  $tweakStructure->{Return}->{OldValue} = $old_value;
631  if($operator eq '?') {
632  $tweakStructure->{Return}->{NewValue} = $old_value;
633  push @response, "Tweak.Show \tpipeline.$attrib_name ::\t$old_value\n";
634  } else {
635  $tweakStructure->{Return}->{NewValue} = $new_value_str;
636  push @response, "Tweak.Changing\tpipeline.$attrib_name ::\t$old_value --> $new_value_str\n";
637 
638  $self->$attrib_name( $new_value_str );
639  $need_write = 1;
640  }
641 
642  } else {
643  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{FIELD_ERROR};
644  push @response, "Tweak.Error \tCould not find the pipeline-wide '$attrib_name' method\n";
645  }
646  push @{$responseStructure->{Tweaks}}, $tweakStructure;
647  } elsif($tweak=~/^analysis\[([^\]]+)\]\.param\[(\w+)\](\?|#|=(.+))$/) {
648  my ($analyses_pattern, $param_name, $operator, $new_value_str) = ($1, $2, $3, $4);
649  my $analyses = $self->collection_of( 'Analysis' )->find_all_by_pattern( $analyses_pattern );
650  push @response, "Tweak.Found \t".scalar(@$analyses)." analyses matching the pattern '$analyses_pattern'\n";
651 
652  my $new_value = destringify( $new_value_str );
653  $new_value_str = stringify( $new_value );
654 
655  foreach my $analysis (@$analyses) {
656  my $analysis_name = $analysis->logic_name;
657  my $old_value = $analysis->parameters;
658  my $param_hash = destringify( $old_value );
659  my $tweakStructure;
660  $tweakStructure->{Object}->{Type} = TWEAK_OBJECT_TYPE->{ANALYSIS};
661  $tweakStructure->{Action} = TWEAK_ACTION->{substr($operator, 0, 1)};
662  $tweakStructure->{Object}->{Id} = defined $analysis->dbID ? $analysis->dbID + 0 : undef;
663  $tweakStructure->{Object}->{Name} = $analysis_name;
664  $tweakStructure->{Return}->{Field} = $param_name;
665  $tweakStructure->{Return}->{OldValue} = exists($param_hash->{ $param_name }) ? stringify($param_hash->{ $param_name }) : undef;
666 
667  if($operator eq '?') {
668  $tweakStructure->{Return}->{NewValue} = $tweakStructure->{Return}->{OldValue};
669  push @response, "Tweak.Show \tanalysis[$analysis_name].param[$param_name] ::\t"
670  . (exists($param_hash->{ $param_name }) ? stringify($param_hash->{ $param_name }) : '(missing value)')
671  ."\n";
672  } elsif($operator eq '#') {
673  $tweakStructure->{Return}->{NewValue} = undef;
674  push @response, "Tweak.Deleting\tanalysis[$analysis_name].param[$param_name] ::\t".stringify($param_hash->{ $param_name })." --> (missing value)\n";
675 
676  delete $param_hash->{ $param_name };
677  $analysis->parameters( stringify($param_hash) );
678  $need_write = 1;
679  } else {
680  $tweakStructure->{Return}->{NewValue} = $new_value_str;
681  if(exists($param_hash->{ $param_name })) {
682  push @response, "Tweak.Changing\tanalysis[$analysis_name].param[$param_name] ::\t".stringify($param_hash->{ $param_name })." --> $new_value_str\n";
683  } else {
684  push @response, "Tweak.Adding \tanalysis[$analysis_name].param[$param_name] ::\t(missing value) --> $new_value_str\n";
685  }
686 
687  $param_hash->{ $param_name } = $new_value;
688  $analysis->parameters( stringify($param_hash) );
689  $need_write = 1;
690  }
691  push @{$responseStructure->{Tweaks}}, $tweakStructure;
692  }
693 
694 
695  } elsif($tweak=~/^analysis\[([^\]]+)\]\.(wait_for|flow_into)(\?|#|\+?=(.+))$/) {
696 
697  my ($analyses_pattern, $attrib_name, $operation, $new_value_str) = ($1, $2, $3, $4);
698  $operation=~/^(\?|#|\+?=)/;
699  my $operator = $1;
700 
701  my $analyses = $self->collection_of( 'Analysis' )->find_all_by_pattern( $analyses_pattern );
702  push @response, "Tweak.Found \t".scalar(@$analyses)." analyses matching the pattern '$analyses_pattern'\n";
703 
704  my $new_value = destringify( $new_value_str );
705 
706  foreach my $analysis (@$analyses) {
707  my $analysis_name = $analysis->logic_name;
708  my $tweakStructure;
709  $tweakStructure->{Object}->{Type} = TWEAK_OBJECT_TYPE->{ANALYSIS};
710  $tweakStructure->{Action} = TWEAK_ACTION->{substr($operator, 0, 1)};
711  $tweakStructure->{Object}->{Id} = defined $analysis->dbID ? $analysis->dbID + 0 : undef;
712  $tweakStructure->{Object}->{Name} = $analysis_name;
713  $tweakStructure->{Return}->{Field} = $attrib_name;
714  if( $attrib_name eq 'wait_for' ) {
715  my $cr_collection = $self->collection_of( 'AnalysisCtrlRule' );
716  my $acr_collection = $analysis->control_rules_collection;
717  $tweakStructure->{Return}->{OldValue} = [map { $_->condition_analysis_url } @$acr_collection];
718  if($operator eq '?') {
719  $tweakStructure->{Return}->{NewValue} = $tweakStructure->{Return}->{OldValue};
720  push @response, "Tweak.Show \tanalysis[$analysis_name].wait_for ::\t[".join(', ', map { $_->condition_analysis_url } @$acr_collection )."]\n";
721  }
722 
723  if($operator eq '#' or $operator eq '=') { # delete the existing rules
724  $tweakStructure->{Return}->{NewValue} = undef;
725  foreach my $c_rule ( @$acr_collection ) {
726  $cr_collection->forget_and_mark_for_deletion( $c_rule );
727  $need_write = 1;
728 
729  push @response, "Tweak.Deleting\t".$c_rule->toString." --> (missing value)\n";
730  }
731  }
732 
733  if($operator eq '=' or $operator eq '+=') { # create new rules
734  Bio::EnsEMBL::Hive::Utils::PCL::parse_wait_for($self, $analysis, $new_value);
735  my $acr_collection = $analysis->control_rules_collection;
736  foreach my $c_rule ( @$acr_collection ) {
737  push @response, "Tweak.Adding\t".$c_rule->toString."\n";
738  }
739  $tweakStructure->{Return}->{NewValue} = [map { $_->condition_analysis_url } @$acr_collection];
740 
741  $need_write = 1;
742  }
743 
744  } elsif( $attrib_name eq 'flow_into' ) {
745  $tweakStructure->{Warning} = "Value can't be displayed";
746  if($operator eq '?') {
747  # FIXME: should not recurse
748  #$analysis->print_diagram_node($self, '', {}); TODO: refactor with formatter.pm
749  }
750 
751  if($operator eq '#' or $operator eq '=') { # delete the existing rules
752  my $dfr_collection = $self->collection_of( 'DataflowRule' );
753  my $dft_collection = $self->collection_of( 'DataflowTarget' );
754 
755  foreach my $group ( @{$analysis->get_grouped_dataflow_rules} ) {
756  my ($funnel_dfr, $fan_dfrs, $funnel_df_targets) = @$group;
757 
758  foreach my $df_rule (@$fan_dfrs, $funnel_dfr) {
759 
760  foreach my $df_target ( @{$df_rule->get_my_targets} ) {
761  $dft_collection->forget_and_mark_for_deletion( $df_target );
762 
763  push @response, "Tweak.Deleting\t".$df_target->toString." --> (missing value)\n";
764  }
765  $dfr_collection->forget_and_mark_for_deletion( $df_rule );
766  $need_write = 1;
767 
768  push @response, "Tweak.Deleting\t".$df_rule->toString." --> (missing value)\n";
769  }
770  }
771  }
772 
773  if($operator eq '=' or $operator eq '+=') { # create new rules
774  $need_write = 1;
775  Bio::EnsEMBL::Hive::Utils::PCL::parse_flow_into($self, $analysis, $new_value );
776  }
777  }
778  push @{$responseStructure->{Tweaks}}, $tweakStructure;
779  }
780 
781  } elsif($tweak=~/^analysis\[([^\]]+)\]\.(\w+)(\?|#|=(.+))$/) {
782 
783  my ($analyses_pattern, $attrib_name, $operator, $new_value_str) = ($1, $2, $3, $4);
784 
785  my $analyses = $self->collection_of( 'Analysis' )->find_all_by_pattern( $analyses_pattern );
786  push @response, "Tweak.Found \t".scalar(@$analyses)." analyses matching the pattern '$analyses_pattern'\n";
787 
788  my $new_value = destringify( $new_value_str );
789 
790  foreach my $analysis (@$analyses) {
791 
792  my $analysis_name = $analysis->logic_name;
793  my $tweakStructure;
794  $tweakStructure->{Object}->{Type} = TWEAK_OBJECT_TYPE->{ANALYSIS};
795  $tweakStructure->{Object}->{Id} = defined $analysis->dbID ? $analysis->dbID + 0 : undef;
796  $tweakStructure->{Object}->{Name} = $analysis_name;
797  $tweakStructure->{Action} = TWEAK_ACTION->{substr($operator, 0, 1)};
798  $tweakStructure->{Return}->{Field} = $attrib_name;
799  if( $attrib_name eq 'resource_class' ) {
800  $tweakStructure->{Return}->{OldValue} = $analysis->resource_class->name;
801 
802  if($operator eq '?') {
803  $tweakStructure->{Return}->{NewValue} = $tweakStructure->{Return}->{OldValue};
804  my $old_value = $analysis->resource_class;
805  push @response, "Tweak.Show \tanalysis[$analysis_name].resource_class ::\t".$old_value->name."\n";
806  } elsif($operator eq '#') {
807  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{ACTION_ERROR};
808  push @response, "Tweak.Error \tDeleting of an Analysis' resource-class is not supported\n";
809  } else {
810  $tweakStructure->{Return}->{NewValue} = $new_value_str;
811  my $old_value = $analysis->resource_class;
812  push @response, "Tweak.Changing\tanalysis[$analysis_name].resource_class ::\t".$old_value->name." --> $new_value_str\n";
813 
814  my $resource_class;
815  if($resource_class = $self->collection_of( 'ResourceClass' )->find_one_by( 'name', $new_value )) {
816  push @response, "Tweak.Found \tresource_class[$new_value_str]\n";
817  $analysis->resource_class( $resource_class );
818  $need_write = 1;
819  } else {
820  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{VALUE_ERROR};
821  push @response, "Tweak.Error \t'$new_value_str' is not a known resource-class\n";
822  }
823  }
824 
825  } elsif( $attrib_name eq 'is_excluded' ) {
826  my $analysis_stats = $analysis->stats();
827  $tweakStructure->{Return}->{OldValue} = $analysis_stats->is_excluded();
828  if($operator eq '?') {
829  $tweakStructure->{Return}->{NewValue} = $tweakStructure->{Return}->{OldValue};
830  push @response, "Tweak.Show \tanalysis[$analysis_name].is_excluded ::\t".$analysis_stats->is_excluded()."\n";
831  } elsif($operator eq '#') {
832  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{ACTION_ERROR};
833  push @response, "Tweak.Error \tDeleting of excluded status is not supported\n";
834  } else {
835  $tweakStructure->{Return}->{NewValue} = $new_value_str;
836  if(!($new_value =~ /^[01]$/)) {
837  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{VALUE_ERROR};
838  push @response, "Tweak.Error \tis_excluded can only be 0 (no) or 1 (yes)\n";
839  } elsif ($new_value == $analysis_stats->is_excluded()) {
840  push @response, "Tweak.Info \tanalysis[$analysis_name].is_excluded is already $new_value, leaving as is\n";
841  } else {
842  push @response, "Tweak.Changing\tanalysis[$analysis_name].is_excluded ::\t" .
843  $analysis_stats->is_excluded() . " --> $new_value_str\n";
844  $analysis_stats->is_excluded($new_value);
845  $need_write = 1;
846  }
847  }
848 
849  } elsif( $attrib_name eq 'dbID' ) {
850  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{ACTION_ERROR};
851  push @response, "Tweak.Error \tChanging the dbID of an Analysis is not supported\n";
852 
853  } elsif($analysis->can($attrib_name)) {
854  my $old_value = stringify($analysis->$attrib_name());
855  $tweakStructure->{Return}->{OldValue} = $old_value;
856  if($operator eq '?') {
857  $tweakStructure->{Return}->{NewValue} = $tweakStructure->{Return}->{OldValue};
858  push @response, "Tweak.Show \tanalysis[$analysis_name].$attrib_name ::\t$old_value\n";
859  } elsif($operator eq '#') {
860  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{ACTION_ERROR};
861  push @response, "Tweak.Error \tDeleting of Analysis attributes is not supported\n";
862  } else {
863  $tweakStructure->{Return}->{NewValue} = stringify($new_value);
864  push @response, "Tweak.Changing\tanalysis[$analysis_name].$attrib_name ::\t$old_value --> ".stringify($new_value)."\n";
865  $analysis->$attrib_name( $new_value );
866  $need_write = 1;
867  }
868  } else {
869  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{FIELD_ERROR};
870  push @response, "Tweak.Error \tAnalysis does not support '$attrib_name' attribute\n";
871  }
872 
873  push @{$responseStructure->{Tweaks}}, $tweakStructure;
874  }
875 
876  } elsif($tweak=~/^resource_class\[([^\]]+)\]\.(\w+)(\?|=(.+))$/) {
877  my ($rc_pattern, $meadow_type, $operator, $new_value_str) = ($1, $2, $3, $4);
878 
879  my $resource_classes = $self->collection_of( 'ResourceClass' )->find_all_by_pattern( $rc_pattern );
880  push @response, "Tweak.Found \t".scalar(@$resource_classes)." resource_classes matching the pattern '$rc_pattern'\n";
881 
882  if($operator eq '?') {
883  foreach my $rc (@$resource_classes) {
884  my $rc_name = $rc->name;
885  my $tweakStructure;
886  $tweakStructure->{Object}->{Type} = TWEAK_OBJECT_TYPE->{RESOURCE_CLASS};
887  $tweakStructure->{Object}->{Id} = defined $rc->dbID ? $rc->dbID + 0 : undef;
888  $tweakStructure->{Object}->{Name} = $rc_name;
889  $tweakStructure->{Action} = TWEAK_ACTION->{substr($operator, 0, 1)};
890 
891  if(my $rd = $self->collection_of( 'ResourceDescription' )->find_one_by('resource_class', $rc, 'meadow_type', $meadow_type)) {
892  my ($submission_cmd_args, $worker_cmd_args) = ($rd->submission_cmd_args, $rd->worker_cmd_args);
893  push @response, "Tweak.Show \tresource_class[$rc_name].$meadow_type ::\t".stringify([$submission_cmd_args, $worker_cmd_args])."\n";
894  $tweakStructure->{Return}->{OldValue} = stringify([$submission_cmd_args, $worker_cmd_args]);
895  } else {
896  push @response, "Tweak.Show \tresource_class[$rc_name].$meadow_type ::\t(missing values)\n";
897  $tweakStructure->{Return}->{OldValue} = undef;
898  }
899  $tweakStructure->{Return}->{Field} = $meadow_type;
900  $tweakStructure->{Return}->{NewValue} = $tweakStructure->{Return}->{OldValue};
901  push @{$responseStructure->{Tweaks}}, $tweakStructure;
902  }
903 
904  } else {
905 
906  # Auto-vivification of the ResourceClass
907  unless (@$resource_classes) {
908  push @response, "Tweak.Adding \tresource_class[$rc_pattern]\n";
909  my ($resource_class) = $self->add_new_or_update( 'ResourceClass', # NB: add_new_or_update returns a list
910  'name' => $rc_pattern,
911  );
912  push @$resource_classes, $resource_class;
913  $need_write = 1;
914  }
915 
916  my $new_value = destringify( $new_value_str );
917  my ($new_submission_cmd_args, $new_worker_cmd_args) = (ref($new_value) eq 'ARRAY') ? @$new_value : ($new_value, '');
918 
919  foreach my $rc (@$resource_classes) {
920  my $rc_name = $rc->name;
921  my $tweakStructure;
922  $tweakStructure->{Object}->{Type} = TWEAK_OBJECT_TYPE->{RESOURCE_CLASS};
923  $tweakStructure->{Action} = TWEAK_ACTION->{substr($operator, 0, 1)};
924  $tweakStructure->{Object}->{Id} = defined $rc->dbID ? $rc->dbID + 0 : undef;
925  $tweakStructure->{Object}->{Name} = $rc_name;
926 
927  if(my $rd = $self->collection_of( 'ResourceDescription' )->find_one_by('resource_class', $rc, 'meadow_type', $meadow_type)) {
928  my ($submission_cmd_args, $worker_cmd_args) = ($rd->submission_cmd_args, $rd->worker_cmd_args);
929  push @response, "Tweak.Changing\tresource_class[$rc_name].$meadow_type :: "
930  .stringify([$submission_cmd_args, $worker_cmd_args])." --> "
931  .stringify([$new_submission_cmd_args, $new_worker_cmd_args])."\n";
932 
933  $rd->submission_cmd_args( $new_submission_cmd_args );
934  $rd->worker_cmd_args( $new_worker_cmd_args );
935  $tweakStructure->{Return}->{OldValue} = stringify([$submission_cmd_args, $worker_cmd_args]);
936 
937  } else {
938  push @response, "Tweak.Adding \tresource_class[$rc_name].$meadow_type :: (missing values) --> "
939  .stringify([$new_submission_cmd_args, $new_worker_cmd_args])."\n";
940 
941  my ($rd) = $self->add_new_or_update( 'ResourceDescription', # NB: add_new_or_update returns a list
942  'resource_class' => $rc,
943  'meadow_type' => $meadow_type,
944  'submission_cmd_args' => $new_submission_cmd_args,
945  'worker_cmd_args' => $new_worker_cmd_args,
946  );
947  $tweakStructure->{Return}->{OldValue} = undef;
948  }
949  $tweakStructure->{Return}->{Field} = $meadow_type;
950  $tweakStructure->{Return}->{NewValue} = stringify([$new_submission_cmd_args, $new_worker_cmd_args]);
951  push @{$responseStructure->{Tweaks}}, $tweakStructure;
952  $need_write = 1;
953  }
954  }
955 
956 
957  } else {
958  my $tweakStructure;
959  $tweakStructure->{Error} = TWEAK_ERROR_MSG->{PARSE_ERROR};
960  push @response, "Tweak.Error \tFailed to parse the tweak\n";
961  push @{$responseStructure->{Tweaks}}, $tweakStructure;
962  }
963 
964  }
965  return $need_write, \@response, $responseStructure;
966 }
967 
968 1;
Bio::EnsEMBL::Hive::Utils
Definition: Collection.pm:4
Bio::EnsEMBL::Hive::Utils::URL
Definition: URL.pm:11
Bio::EnsEMBL::Hive::NakedTable
Definition: NakedTable.pm:10
Bio::EnsEMBL::Hive::Utils::Collection
Definition: Collection.pm:5
Bio::EnsEMBL::Hive::HivePipeline
Definition: HivePipeline.pm:13
Bio::EnsEMBL::Hive
Definition: DockerSwarm.pm:5
Bio::EnsEMBL::Hive::Utils::PCL
Definition: PCL.pm:12
Bio::EnsEMBL::Hive::Accumulator
Definition: Accumulator.pm:11
Bio::EnsEMBL::Hive::HivePipeline::hive_pipeline_name
public hive_pipeline_name()
Bio::EnsEMBL::Hive::DBSQL::DBAdaptor
Definition: DBAdaptor.pm:31
Bio::EnsEMBL::Hive::TheApiary
Definition: TheApiary.pm:16