File: | lib/Pipeline/Simple.pm |
Coverage: | 81.0% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | #----------------------------------------------------------------- | ||||||
2 | # Pipeline::Simple | ||||||
3 | # Author: Heikki Lehvaslaiho <heikki.lehvaslaiho@gmail.com> | ||||||
4 | # For copyright and disclaimer see Pipeline::Simple.pod. | ||||||
5 | # | ||||||
6 | # Lightweight workflow manager | ||||||
7 | ## no critic | ||||||
8 | package Pipeline::Simple; | ||||||
9 | # ABSTRACT: Simple workflow manager | ||||||
10 | |||||||
11 | 2 2 2 | 495 3 32 | use strict; | ||||
12 | 2 2 2 | 6 6 40 | use warnings; | ||||
13 | 2 2 2 | 392 11190 14 | use autodie; | ||||
14 | ## use critic | ||||||
15 | |||||||
16 | 2 2 2 | 54134 4 61 | use Carp; | ||||
17 | 2 2 2 | 7 3 90 | use File::Basename; | ||||
18 | 2 2 2 | 591 3035 74 | use File::Copy; | ||||
19 | 2 2 2 | 831 11090 12 | use XML::Simple; | ||||
20 | 2 2 2 | 100 4 72 | use Data::Dumper; | ||||
21 | 2 2 2 | 9792 61057 15 | use Log::Log4perl qw(get_logger :levels :no_extra_logdie_message); | ||||
22 | |||||||
23 | |||||||
24 | #----------------------------------------------------------------- | ||||||
25 | # Global variables | ||||||
26 | #----------------------------------------------------------------- | ||||||
27 | |||||||
28 | my $logger_level = { | ||||||
29 | '-1' => $WARN, | ||||||
30 | '0' => $INFO, | ||||||
31 | '1' => $DEBUG, | ||||||
32 | }; | ||||||
33 | |||||||
34 | #----------------------------------------------------------------- | ||||||
35 | # new | ||||||
36 | #----------------------------------------------------------------- | ||||||
37 | sub new { | ||||||
38 | 3 | 1 | 12 | my ($class, @args) = @_; | |||
39 | |||||||
40 | # create an object | ||||||
41 | 3 | 40 | my $self = bless {}, ref ($class) || $class; | ||||
42 | |||||||
43 | # set all @args into this object with 'set' values | ||||||
44 | 3 | 15 | my (%args) = (@args == 1 ? (value => $args[0]) : @args); | ||||
45 | |||||||
46 | # do dir() first so that we know where to write the log | ||||||
47 | 3 | 11 | $self->dir($args{'dir'}) if defined $args{'dir'}; | ||||
48 | |||||||
49 | # start logging | ||||||
50 | 3 | 8 | $self->_configure_logging; | ||||
51 | |||||||
52 | 3 | 16 | foreach my $key (keys %args) { | ||||
53 | 8 | 18 | next if $key eq 'config'; # this needs to be evaluated last | ||||
54 | 7 | 15 | next if $key eq 'dir'; # done this | ||||
55 | ## no critic | ||||||
56 | 2 2 2 | 290 4 4120 | no strict 'refs'; | ||||
57 | ## use critic | ||||||
58 | 6 | 16 | $self->$key($args{$key}); | ||||
59 | } | ||||||
60 | # delayed to find out verbosity level | ||||||
61 | 3 | 7 | $self->logger->info("Logging started"); | ||||
62 | |||||||
63 | # this argument needs to be done last | ||||||
64 | 3 | 31 | $self->config($args{'config'}) if defined $args{'config'}; | ||||
65 | |||||||
66 | # look into dir() if config not given | ||||||
67 | 3 | 14 | $self->config($self->dir. '/config.xml') | ||||
68 | if not $self->{config} and defined $self->dir and -e $self->dir. '/config.xml'; | ||||||
69 | |||||||
70 | # die if no config found | ||||||
71 | 3 | 14 | $self->logger->fatal("pipeline config file not provided or not found in pwd") | ||||
72 | if not $self->{config} and not $self->debug; | ||||||
73 | |||||||
74 | # done | ||||||
75 | 3 | 29 | return $self; | ||||
76 | } | ||||||
77 | |||||||
78 | |||||||
79 | #----------------------------------------------------------------- | ||||||
80 | # Configure the logger | ||||||
81 | #----------------------------------------------------------------- | ||||||
82 | |||||||
83 | sub _configure_logging { | ||||||
84 | 3 | 6 | my $self = shift; | ||||
85 | |||||||
86 | 3 | 6 | my $logger_config = q( | ||||
87 | log4perl.category.Pipeline = INFO, Screen | ||||||
88 | log4perl.appender.Screen = Log::Log4perl::Appender::Screen | ||||||
89 | log4perl.appender.Screen.stderr = 1 | ||||||
90 | log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout | ||||||
91 | ); | ||||||
92 | |||||||
93 | 3 | 22 | Log::Log4perl->init_once( \$logger_config ); | ||||
94 | 3 | 4005 | my $logger = Log::Log4perl->get_logger("Pipeline"); | ||||
95 | |||||||
96 | 3 | 55 | if ($self->dir) { | ||||
97 | 1 | 2 | my $to_file = Log::Log4perl::Appender->new | ||||
98 | ("Log::Log4perl::Appender::File", | ||||||
99 | name => 'Log', | ||||||
100 | filename => $self->dir. '/pipeline.log', | ||||||
101 | mode => 'append'); | ||||||
102 | 1 | 1515 | my $pattern = '%d [%r] %p %L | %m%n'; | ||||
103 | 1 | 9 | my $layout = Log::Log4perl::Layout::PatternLayout->new ($pattern); | ||||
104 | 1 | 383 | $to_file->layout ($layout); | ||||
105 | |||||||
106 | 1 | 9 | $logger->add_appender($to_file); | ||||
107 | } | ||||||
108 | |||||||
109 | 3 | 470 | $logger->level( $INFO ); | ||||
110 | |||||||
111 | 3 | 1324 | $self->logger($logger); | ||||
112 | |||||||
113 | } | ||||||
114 | |||||||
115 | |||||||
116 | |||||||
117 | #----------------------------------------------------------------- | ||||||
118 | # | ||||||
119 | #----------------------------------------------------------------- | ||||||
120 | |||||||
121 | sub verbose { | ||||||
122 | 4 | 1 | 13 | my ($self, $value) = @_; | |||
123 | 4 | 11 | if (defined $value) { | ||||
124 | 3 | 6 | $self->{_verbose} = $value; | ||||
125 | |||||||
126 | # verbose = -1 0 1 | ||||||
127 | # log level = WARN INFO DEBUG | ||||||
128 | |||||||
129 | 3 | 6 | $self->logger->level( $logger_level->{$value} ); | ||||
130 | } | ||||||
131 | 4 | 3446 | return $self->{_verbose}; | ||||
132 | } | ||||||
133 | |||||||
134 | sub id { | ||||||
135 | 66 | 1 | 135 | my ($self, $value) = @_; | |||
136 | 66 | 170 | if (defined $value) { | ||||
137 | 11 | 24 | $self->{_id} = $value; | ||||
138 | } | ||||||
139 | 66 | 288 | return $self->{_id}; | ||||
140 | } | ||||||
141 | |||||||
142 | sub description { | ||||||
143 | 7 | 1 | 19 | my ($self, $value) = @_; | |||
144 | 7 | 66 | if (defined $value) { | ||||
145 | 3 | 8 | $self->{_description} = $value; | ||||
146 | } | ||||||
147 | 7 | 33 | return $self->{_description}; | ||||
148 | } | ||||||
149 | |||||||
150 | sub name { | ||||||
151 | 12 | 1 | 28 | my ($self, $value) = @_; | |||
152 | 12 | 31 | if (defined $value) { | ||||
153 | 3 | 8 | $self->{_name} = $value; | ||||
154 | } | ||||||
155 | 12 | 85 | return $self->{_name}; | ||||
156 | } | ||||||
157 | |||||||
158 | sub path { | ||||||
159 | 2 | 1 | 5 | my ($self, $value) = @_; | |||
160 | 2 | 5 | if (defined $value) { | ||||
161 | 1 | 2 | $self->{_path} = $value; | ||||
162 | } | ||||||
163 | 2 | 11 | return $self->{_path}; | ||||
164 | } | ||||||
165 | |||||||
166 | sub next_id { | ||||||
167 | 1 | 1 | 2 | my ($self, $value) = @_; | |||
168 | 1 | 3 | if (defined $value) { | ||||
169 | 1 | 3 | $self->{_next_id} = $value; | ||||
170 | } | ||||||
171 | 1 | 6 | return $self->{_next_id}; | ||||
172 | } | ||||||
173 | |||||||
174 | |||||||
175 | sub input { | ||||||
176 | 1 | 1 | 3 | my ($self, $value) = @_; | |||
177 | 1 | 3 | if (defined $value) { | ||||
178 | 1 | 2 | $self->{_input} = $value; | ||||
179 | } | ||||||
180 | 1 | 6 | return $self->{_input}; | ||||
181 | } | ||||||
182 | |||||||
183 | |||||||
184 | sub itype { | ||||||
185 | 3 | 1 | 6 | my ($self, $value) = @_; | |||
186 | 3 | 8 | if (defined $value) { | ||||
187 | 1 | 2 | $self->{_itype} = $value; | ||||
188 | } | ||||||
189 | 3 | 16 | return $self->{_itype}; | ||||
190 | } | ||||||
191 | |||||||
192 | sub add { | ||||||
193 | 1 | 1 | 3 | my ($self, $value) = @_; | |||
194 | 1 | 4 | if (defined $value) { | ||||
195 | 1 | 2 | $self->{_add} = $value; | ||||
196 | } | ||||||
197 | 1 | 7 | return $self->{_add}; | ||||
198 | } | ||||||
199 | |||||||
200 | sub start { | ||||||
201 | 2 | 1 | 7 | my ($self, $value) = @_; | |||
202 | 2 | 8 | if (defined $value) { | ||||
203 | 1 | 6 | $self->{_start} = $value; | ||||
204 | } | ||||||
205 | 2 | 11 | return $self->{_start}; | ||||
206 | } | ||||||
207 | |||||||
208 | |||||||
209 | sub stop { | ||||||
210 | 1 | 1 | 4 | my ($self, $value) = @_; | |||
211 | 1 | 4 | if (defined $value) { | ||||
212 | 1 | 3 | $self->{_stop} = $value; | ||||
213 | } | ||||||
214 | 1 | 7 | return $self->{_stop}; | ||||
215 | } | ||||||
216 | |||||||
217 | |||||||
218 | sub debug { | ||||||
219 | 4 | 1 | 8 | my ($self, $value) = @_; | |||
220 | 4 | 10 | if (defined $value) { | ||||
221 | 2 | 3 | $self->{_debug} = $value; | ||||
222 | } | ||||||
223 | 4 | 12 | return $self->{_debug}; | ||||
224 | } | ||||||
225 | |||||||
226 | sub logger { | ||||||
227 | 28 | 1 | 77 | my ($self, $value) = @_; | |||
228 | 28 | 85 | if (defined $value) { | ||||
229 | 3 | 7 | $self->{_logger} = $value; | ||||
230 | } | ||||||
231 | 28 | 224 | return $self->{_logger}; | ||||
232 | } | ||||||
233 | |||||||
234 | sub config { | ||||||
235 | 2 | 1 | 5 | my ($self, $config) = @_; | |||
236 | |||||||
237 | 2 | 6 | if ($config) { | ||||
238 | 2 | 4 | $self->logger->info("Using config file: ". $config); | ||||
239 | 2 2 | 3644 15 | my $pwd = `pwd`; chomp $pwd; | ||||
240 | 2 | 53 | $self->logger->debug("pwd: $pwd"); | ||||
241 | 2 | 41 | die unless -e $config; | ||||
242 | # copy the pipeline config | ||||||
243 | |||||||
244 | 2 | 10 | if ($self->dir and not -e $self->dir."/config.xml") { | ||||
245 | #print "--->", `pwd`, "\n"; | ||||||
246 | 1 | 3 | copy $config, $self->dir."/config.xml"; | ||||
247 | 1 | 192 | $self->logger->debug("Config [$config] file copied to: ". | ||||
248 | $self->dir."/config.xml"); | ||||||
249 | } | ||||||
250 | |||||||
251 | 2 | 16 | $self->{config} = XMLin($self->dir."/config.xml", KeyAttr => {step => 'id'}); | ||||
252 | |||||||
253 | # set pipeline start parameters | ||||||
254 | 2 | 69640 | $self->id('s0'); | ||||
255 | 2 | 13 | $self->name($self->{config}->{name} || ''); | ||||
256 | 2 | 18 | $self->description($self->{config}->{description} || ''); | ||||
257 | |||||||
258 | # go through all steps once | ||||||
259 | 2 | 4 | my $nexts; # hashref for finding start point(s) | ||||
260 | 2 2 | 5 16 | for my $id (sort keys %{$self->{config}->{step}}) { | ||||
261 | 8 | 18 | my $step = $self->{config}->{step}->{$id}; | ||||
262 | |||||||
263 | # bless all steps into Pipeline objects | ||||||
264 | 8 | 29 | bless $step, ref($self); | ||||
265 | |||||||
266 | #print "ERROR: $id already exists\n" if defined $self->step($id); | ||||||
267 | # create the list of all steps to be used by each_step() | ||||||
268 | 8 | 17 | $step->id($id); | ||||
269 | 8 8 | 13 17 | push @{$self->{steps}}, $step; | ||||
270 | |||||||
271 | #turn a next hashref into an arrayref, (fixing XML::Simple complication) | ||||||
272 | 8 | 25 | unless ( ref($step->{next}) eq 'ARRAY' ) { | ||||
273 | 6 | 12 | my $next = $step->{next}; | ||||
274 | 6 | 12 | delete $step->{next}; | ||||
275 | 6 6 | 7 13 | push @{$step->{next}}, $next; | ||||
276 | } | ||||||
277 | |||||||
278 | # a step without a parent is a starting point | ||||||
279 | 8 8 | 14 16 | foreach my $next (@{$step->{next}}) { | ||||
280 | 10 | 33 | $nexts->{$next->{id}}++ if $next->{id}; | ||||
281 | } | ||||||
282 | } | ||||||
283 | |||||||
284 | # store starting points | ||||||
285 | 2 | 11 | foreach my $step ($self->each_step) { | ||||
286 | 8 2 | 17 6 | push @{$self->{next}}, { id => $step->id} | ||||
287 | unless $nexts->{$step->id} | ||||||
288 | } | ||||||
289 | |||||||
290 | #run needs to fail if starting input values are not set! | ||||||
291 | |||||||
292 | # insert the startup value into the appropriate starting step | ||||||
293 | # unless we are reading old config | ||||||
294 | 2 | 10 | if ($self->itype and $self->input) { # only if new starting input value has been given | ||||
295 | 0 | 0 | my $real_start_id; | ||||
296 | 0 | 0 | for my $step_id ( $self->each_next) { | ||||
297 | 0 | 0 | my $step = $self->step($step_id); | ||||
298 | |||||||
299 | # if input type is right, insert the value | ||||||
300 | # note only one of the each type can be used | ||||||
301 | 0 0 | 0 0 | foreach my $arg (@{$step->{arg}}) { | ||||
302 | #print Dumper $arg; | ||||||
303 | 0 | 0 | next unless $arg->{key} eq 'in' and | ||||
304 | defined $arg->{type} and | ||||||
305 | $arg->{type} eq $self->itype; | ||||||
306 | #print Dumper $self->itype, $step->id, $arg; | ||||||
307 | 0 | 0 | $arg->{value} = $self->input; | ||||
308 | #print Dumper $arg; | ||||||
309 | 0 | 0 | $real_start_id = $step_id; | ||||
310 | } | ||||||
311 | } | ||||||
312 | 0 | 0 | $self->{next} = undef; | ||||
313 | 0 0 | 0 0 | push @{$self->{next}}, { id => $real_start_id}; | ||||
314 | } | ||||||
315 | } | ||||||
316 | 2 | 17 | return $self->{config}; | ||||
317 | } | ||||||
318 | |||||||
319 | #----------------------------------------------------------------- | ||||||
320 | # | ||||||
321 | #----------------------------------------------------------------- | ||||||
322 | sub dir { | ||||||
323 | 18 | 1 | 39 | my ($self, $dir) = @_; | |||
324 | 18 | 47 | if ($dir) { | ||||
325 | 2 | 40 | mkdir $dir unless -e $dir and -d $dir; | ||||
326 | 2 | 115 | croak "Can not create project directory $dir" | ||||
327 | unless -e $dir and -d $dir; | ||||||
328 | 2 | 6 | $self->{_dir} = $dir; | ||||
329 | } | ||||||
330 | 18 | 144 | $self->{_dir}; | ||||
331 | } | ||||||
332 | |||||||
333 | #----------------------------------------------------------------- | ||||||
334 | # | ||||||
335 | #----------------------------------------------------------------- | ||||||
336 | sub step { | ||||||
337 | 8 | 1 | 16 | my ($self) = shift; | |||
338 | 8 | 20 | my $id = shift; | ||||
339 | 8 | 23 | return $self->{config}->{step}->{$id}; | ||||
340 | } | ||||||
341 | |||||||
342 | sub each_next { | ||||||
343 | 32 28 40 32 | 1 | 66 79 108 77 | map { $_->{id} } grep { $_->{id} } @{shift->{next}}; | |||
344 | } | ||||||
345 | |||||||
346 | sub each_step { | ||||||
347 | 6 6 | 1 | 46 32 | @{shift->{steps}}; | |||
348 | } | ||||||
349 | |||||||
350 | |||||||
351 | |||||||
352 | sub run { | ||||||
353 | 1 | 1 | 2 | my ($self) = shift; | |||
354 | 1 | 3 | unless ($self->dir) { | ||||
355 | 0 | 0 | $self->logger->fatal("Need an output directory to run()"); | ||||
356 | 0 | 0 | croak "Need an output directory to run()"; | ||||
357 | } | ||||||
358 | |||||||
359 | ### | ||||||
360 | # check for input file and warn if not found | ||||||
361 | |||||||
362 | 1 | 15 | chdir $self->{_dir}; | ||||
363 | |||||||
364 | # | ||||||
365 | # Determine where in the pipeline to start | ||||||
366 | # | ||||||
367 | |||||||
368 | 1 | 55 | my @steps; # array of next execution points | ||||
369 | |||||||
370 | # User has given a starting point id | ||||||
371 | 1 | 5 | if ($self->start) { | ||||
372 | 0 | 0 | push @steps, $self->start; | ||||
373 | 0 | 0 | $self->logger->info("Starting at [". $self->start. "]" ); | ||||
374 | } | ||||||
375 | # determine where the execution of the pipeline was interrupted | ||||||
376 | else { | ||||||
377 | 1 | 3 | open my $LOG, '<', $self->dir. "/pipeline.log" | ||||
378 | or $self->logger->fatal("Can't open ". $self->dir. | ||||||
379 | "/pipeline.log for reading: $!"); | ||||||
380 | 1 | 63 | my $in_execution; | ||||
381 | |||||||
382 | # take only the previous run | ||||||
383 | 1 | 2 | my @log; | ||||
384 | 1 | 25 | while (<$LOG>) { | ||||
385 | 0 | 0 | push @log, $_; | ||||
386 | 0 | 0 | @log = () if /Run started/; | ||||
387 | #print scalar @log, "\n"; | ||||||
388 | } | ||||||
389 | # print "========================\n"; | ||||||
390 | # print "@log"; | ||||||
391 | 1 | 3 | for (@log) { | ||||
392 | 0 | 0 | next unless /\[(\d+)\]/; | ||||
393 | 0 | 0 | undef $in_execution; # start of a new run | ||||
394 | 0 | 0 | next unless /\| (Running|Finished) +\[(\w+)\]/; | ||||
395 | 0 | 0 | $in_execution->{$2}++ if $1 eq 'Running'; | ||||
396 | 0 | 0 | delete $in_execution->{$2} if $1 eq 'Finished'; | ||||
397 | # print Dumper $in_execution; | ||||||
398 | } | ||||||
399 | |||||||
400 | 1 | 5 | @steps = sort keys %$in_execution; | ||||
401 | 1 | 13 | if (not @steps and scalar @log > 2) { | ||||
402 | 0 | 0 | $self->logger->warn("Pipeline is already finished. ". | ||||
403 | "Drop -config and define the start step to rerun" ); | ||||||
404 | 0 | 0 | exit 0; | ||||
405 | } | ||||||
406 | elsif (@steps) { | ||||||
407 | 0 | 0 | $self->logger->info("Continuing at ". $steps[0] ); | ||||
408 | } else { | ||||||
409 | # start from beginning | ||||||
410 | 1 | 4 | @steps = $self->each_next; | ||||
411 | 1 | 5 | $self->logger->info("Starting at [". $steps[0] . "]"); | ||||
412 | } | ||||||
413 | } | ||||||
414 | |||||||
415 | # | ||||||
416 | # Execute one step at a time | ||||||
417 | # | ||||||
418 | |||||||
419 | 1 | 18 | $self->logger->info("Run started"); | ||||
420 | |||||||
421 | 1 | 9 | while (my $step_id = shift @steps) { | ||||
422 | 4 | 10 | $self->logger->debug("steps: [". join (", ", @steps). "]"); | ||||
423 | 4 | 41 | my $step = $self->step($step_id); | ||||
424 | 4 | 9 | croak "ERROR: Step [$step_id] does not exist" unless $step; | ||||
425 | # check that we got an object | ||||||
426 | |||||||
427 | # check that the input file exists | ||||||
428 | 4 4 | 8 15 | foreach my $arg (@{$step->{arg}}) { | ||||
429 | 11 | 35 | next unless $arg->{key} eq 'in'; | ||||
430 | 4 | 31 | next unless $arg->{type} =~ /file|dir/ ; | ||||
431 | } | ||||||
432 | |||||||
433 | 4 | 12 | my $command = $step->render; | ||||
434 | 4 | 9 | $self->logger->info("Running [". $step->id . "] $command" ); | ||||
435 | 4 | 7031 | `$command`; | ||||
436 | 4 | 58 | $self->logger->info("Finished [". $step->id . "]" ); | ||||
437 | |||||||
438 | # Add next step(s) to the execution queue unless | ||||||
439 | # the user has asked to stop here | ||||||
440 | 4 | 61 | if ( defined $self->{_stop} and $step->id eq $self->{_stop} ) { | ||||
441 | 0 | 0 | $self->logger->info("Stopping at [". $step->id . "]" ); | ||||
442 | } else { | ||||||
443 | 4 | 15 | push @steps, $step->each_next | ||||
444 | } | ||||||
445 | |||||||
446 | } | ||||||
447 | 1 | 15 | 1; | ||||
448 | } | ||||||
449 | |||||||
450 | |||||||
451 | #----------------------------------------------------------------- | ||||||
452 | # Render a step into a command line string | ||||||
453 | #----------------------------------------------------------------- | ||||||
454 | |||||||
455 | sub render { | ||||||
456 | 20 | 1 | 51 | my ($step, $display) = @_; | |||
457 | |||||||
458 | # $step ||= $self; | ||||||
459 | # print "\n"; print Dumper $step; print "\n"; | ||||||
460 | |||||||
461 | 20 | 34 | my $str; | ||||
462 | # path to program | ||||||
463 | 20 | 51 | if (defined $step->{path}) { | ||||
464 | 0 | 0 | $str .= $step->{path}; | ||||
465 | 0 | 0 | $str .= '/' unless substr($str, -1, 1) eq '/' ; | ||||
466 | } | ||||||
467 | # program name | ||||||
468 | 20 | 67 | $str .= $step->{name} || ''; | ||||
469 | |||||||
470 | # arguments | ||||||
471 | 20 | 43 | my $endstr = ''; | ||||
472 | 20 20 | 29 59 | foreach my $arg (@{$step->{arg}}) { | ||||
473 | |||||||
474 | 48 | 233 | if (defined $arg->{type} and $arg->{type} eq 'unnamed') { | ||||
475 | #$str .= ' "'. $arg->{value}. '"'; | ||||||
476 | 6 | 13 | $str .= ' '. $arg->{value}; | ||||
477 | 6 | 13 | next; | ||||
478 | } | ||||||
479 | |||||||
480 | 42 | 184 | if (defined $arg->{type} and $arg->{type} eq 'redir') { | ||||
481 | 30 | 88 | if ($arg->{key} eq 'in') { | ||||
482 | 12 | 31 | $endstr .= " < ". $arg->{value}; | ||||
483 | } | ||||||
484 | elsif ($arg->{key} eq 'out') { | ||||||
485 | 18 | 42 | $endstr .= " > ". $arg->{value}; | ||||
486 | } else { | ||||||
487 | 0 | 0 | croak "Unknown key ". $arg->{key}; | ||||
488 | } | ||||||
489 | 30 | 61 | next; | ||||
490 | } | ||||||
491 | |||||||
492 | 12 | 29 | if (defined $arg->{value}) { | ||||
493 | 0 | 0 | $str .= " -". $arg->{key}. "=". $arg->{value}; | ||||
494 | } else { | ||||||
495 | 12 | 33 | $str .= " -". $arg->{key}; | ||||
496 | } | ||||||
497 | |||||||
498 | } | ||||||
499 | 20 | 42 | $str .= $endstr; | ||||
500 | |||||||
501 | 20 | 62 | $str =~ s/(['"])/\\$1/g if $display; | ||||
502 | |||||||
503 | 20 | 96 | return $str; | ||||
504 | } | ||||||
505 | |||||||
506 | sub stringify { | ||||||
507 | 1 | 1 | 3 | my ($self) = @_; | |||
508 | |||||||
509 | 1 | 2 | my @res; | ||||
510 | # add checks for duplicated ids | ||||||
511 | |||||||
512 | # add check for a next pointer that leads nowhere | ||||||
513 | |||||||
514 | 1 | 4 | my @steps = $self->each_next; | ||||
515 | 1 | 2 | my $outputs; #hashref for storing input and output filenames | ||||
516 | 1 | 4 | while (my $step_id = shift @steps) { | ||||
517 | 4 | 10 | my $step = $self->step($step_id); | ||||
518 | 4 | 7 | push @res, $step->id, "\n"; | ||||
519 | 4 | 11 | push @res, "\t", $step->render('4display'), " # "; | ||||
520 | 4 3 | 11 7 | map { push @res, "->", $_, " " } $step->each_next; | ||||
521 | |||||||
522 | 4 | 9 | push @steps, $step->each_next; | ||||
523 | |||||||
524 | 4 4 | 7 14 | foreach my $arg (@{$step->{arg}}) { | ||||
525 | 11 | 49 | if ($arg->{key} eq 'out') { | ||||
526 | 4 | 7 | for ($step->each_next) { | ||||
527 | 3 | 17 | push @res, "\n\t", "WARNING: Output file [". | ||||
528 | $arg->{value}."] is read by [", | ||||||
529 | $outputs->{$arg->{value}}, "] and [$_]" | ||||||
530 | if $outputs->{$arg->{value}}; | ||||||
531 | |||||||
532 | 3 | 9 | $outputs->{$arg->{value}} = $_; | ||||
533 | } | ||||||
534 | } | ||||||
535 | elsif ($arg->{key} eq 'in' and $arg->{type} ne 'redir') { | ||||||
536 | 1 | 10 | my $prev_step_id = $outputs->{$arg->{value}} || ''; | ||||
537 | 1 | 3 | push @res, "\n\t". "ERROR: Output from the previous step is not [". | ||||
538 | ($arg->{value} || ''). "]" | ||||||
539 | if $prev_step_id ne $step->id and $prev_step_id eq $self->id; | ||||||
540 | } | ||||||
541 | # test for steps not refencesed by other steps (missing next tag) | ||||||
542 | } | ||||||
543 | 4 | 18 | push @res, "\n"; | ||||
544 | } | ||||||
545 | 1 | 14 | return join '', @res; | ||||
546 | } | ||||||
547 | |||||||
548 | |||||||
549 | sub graphviz { | ||||||
550 | 2 | 1 | 5 | my $self = shift; | |||
551 | 2 | 5 | my $function = shift; | ||||
552 | |||||||
553 | 2 | 637 | require GraphViz; | ||||
554 | 2 | 40793 | my $g= GraphViz->new; | ||||
555 | |||||||
556 | 2 | 76 | my $end; | ||||
557 | 2 | 9 | $g->add_node($self->id, | ||||
558 | label => $self->id. " : ". | ||||||
559 | $self->render('4display'), rank => 'top'); | ||||||
560 | 2 2 | 85 11 | map { $g->add_edge('s0' => $_) } $self->each_next; | ||||
561 | 2 | 6306 | if ($self->description) { | ||||
562 | 2 | 6 | $g->add_node('desc', label => $self->description, | ||||
563 | shape => 'box', rank => 'top'); | ||||||
564 | 2 | 91 | $g->add_edge('s0' => 'desc'); | ||||
565 | } | ||||||
566 | |||||||
567 | 2 | 36 | foreach my $step ($self->each_step) { | ||||
568 | 8 | 200 | $g->add_node($step->id, label => $step->id. " : ". ($step->name||'') ); | ||||
569 | 8 | 269 | if ($step->each_next) { | ||||
570 | 4 6 | 10 91 | map { $g->add_edge($step->id => $_, label => $step->render('display') ) } | ||||
571 | $step->each_next; | ||||||
572 | } else { | ||||||
573 | 4 | 8 | $end++; | ||||
574 | 4 | 20 | $g->add_node($end, label => ' '); | ||||
575 | 4 | 137 | $g->add_edge($step->id => $end, label => $step->render('display') ); | ||||
576 | } | ||||||
577 | |||||||
578 | } | ||||||
579 | 2 | 46 | return $g->as_dot; | ||||
580 | |||||||
581 | } | ||||||
582 | |||||||
583 | 1; |