File Coverage

blib/lib/BioX/Workflow.pm
Criterion Covered Total %
statement 298 383 77.8
branch 72 128 56.2
condition 3 9 33.3
subroutine 45 50 90.0
pod 17 28 60.7
total 435 598 72.7


line stmt bran cond sub pod time code
1             package BioX::Workflow;
2              
3 2     2   512219 use 5.008_005;
  2         5  
4             our $VERSION = '1.0.1';
5              
6 2     2   456 use Moose;
  2         285015  
  2         10  
7 2     2   9522 use File::Find::Rule;
  2         12193  
  2         10  
8 2     2   81 use File::Basename;
  2         4  
  2         117  
9 2     2   9 use File::Path qw(make_path remove_tree);
  2         2  
  2         94  
10 2     2   8 use Cwd qw(abs_path getcwd);
  2         2  
  2         65  
11 2     2   498 use Data::Dumper;
  2         4738  
  2         74  
12 2     2   1338 use List::Compare;
  2         27410  
  2         56  
13 2     2   708 use YAML::XS 'LoadFile';
  2         3731  
  2         95  
14 2     2   855 use Config::Any;
  2         12265  
  2         47  
15              
16             #use String::CamelCase qw(camelize decamelize wordsplit);
17 2     2   10 use Data::Dumper;
  2         2  
  2         74  
18 2     2   7 use Class::Load ':all';
  2         2  
  2         194  
19 2     2   778 use IO::File;
  2         12302  
  2         208  
20 2     2   883 use Interpolation E => 'eval';
  2         6354  
  2         8  
21 2     2   1165 use Text::Template qw(fill_in_file fill_in_string);
  2         4805  
  2         102  
22 2     2   883 use Data::Pairs;
  2         3054  
  2         74  
23 2     2   1033 use Storable qw(dclone);
  2         4419  
  2         105  
24 2     2   806 use MooseX::Types::Path::Tiny qw/Path Paths AbsPath/;
  2         274095  
  2         10  
25 2     2   4842 use List::Uniq ':all';
  2         1112  
  2         256  
26              
27             #use Carp::Always;
28              
29              
30             extends 'BioX::Wrapper';
31             with 'MooseX::Getopt::Usage';
32             with 'MooseX::Getopt::Usage::Role::Man';
33             with 'MooseX::SimpleConfig';
34              
35             with 'MooseX::Object::Pluggable';
36              
37 2     2   708 use MooseX::FileAttribute;
  2         473948  
  2         8  
38             # For pretty man pages!
39             $ENV{TERM} = 'xterm-256color';
40              
41             =encoding utf-7
42              
43             =head1 NAME
44              
45             BioX::Workflow - A very opinionated template based workflow writer.
46              
47             =head1 SYNOPSIS
48              
49             Most of the functionality can be accessed through the biox-workflow.pl script.
50              
51             biox-workflow.pl --workflow /path/to/workflow.yml
52              
53             This module was written with Bioinformatics workflows in mind, but should be extensible to any sort of workflow or pipeline.
54              
55             =head1 Usage
56              
57             Please check out the full Usage Docs at L<BioX::Workflow::Usage>
58              
59             =head1 In Code Documenation
60              
61             You shouldn't really need to look here unless you have some reason to do some serious hacking.
62              
63             =head2 Attributes
64              
65             Moose attributes. Technically any of these can be changed, but may break everything.
66              
67             =head2 comment_char
68              
69             =cut
70              
71             has '+comment_char' => (
72             predicate => 'has_comment_char',
73             clearer => 'clear_comment_char',
74             );
75              
76             =head2 coerce_paths
77              
78             =cut
79              
80             has 'coerce_paths' => (
81             is => 'rw',
82             isa => 'Bool',
83             default => 1,
84             predicate => 'has_coerce_paths',
85             );
86              
87             =head2 select_rules
88              
89             Select a subsection of rules
90              
91             =cut
92              
93             has 'select_rules' => (
94             traits => ['Array'],
95             is => 'rw',
96             isa => 'ArrayRef[Str]',
97             default => sub { [] },
98             required => 0,
99             handles => {
100             all_select_rules => 'elements',
101             add_select_rule => 'push',
102             map_select_rules => 'map',
103             filter_select_rules => 'grep',
104             find_select_rule => 'first',
105             get_select_rule => 'get',
106             join_select_rules => 'join',
107             count_select_rules => 'count',
108             has_select_rules => 'count',
109             has_no_select_rules => 'is_empty',
110             sorted_select_rules => 'sort',
111             },
112             documentation => q{Select a subselection of rules.},
113             );
114              
115             =head2 match_rules
116              
117             Select a subsection of rules by regexp
118              
119             =cut
120              
121             has 'match_rules' => (
122             traits => ['Array'],
123             is => 'rw',
124             isa => 'ArrayRef[Str]',
125             default => sub { [] },
126             required => 0,
127             handles => {
128             all_match_rules => 'elements',
129             add_match_rule => 'push',
130             map_match_rules => 'map',
131             filter_match_rules => 'grep',
132             find_match_rule => 'first',
133             get_match_rule => 'get',
134             join_match_rules => 'join',
135             count_match_rules => 'count',
136             has_match_rules => 'count',
137             has_no_match_rules => 'is_empty',
138             sorted_match_rules => 'sort',
139             },
140             documentation => q{Select a subselection of rules by regular expression},
141             );
142              
143             =head3 resample
144              
145             Boolean value get new samples based on indir/file_rule or no
146              
147             Samples are found at the beginning of the workflow, based on the global indir variable and the file_find.
148              
149             Chances are you don't want to set resample to try, because these files probably won't exist outside of the indirectory until the pipeline is run.
150              
151             One example of doing so, shown in the gemini.yml in the examples directory, is looking for uncompressed files, .vcf extension, compressing them, and
152             then resampling based on the .vcf.gz extension.
153              
154             =cut
155              
156             has 'resample' => (
157             traits => ['NoGetopt'],
158             is => 'rw',
159             isa => 'Bool',
160             default => 0,
161             predicate => 'has_resample',
162             clearer => 'clear_resample',
163             );
164              
165             =head2 find_by_dir
166              
167             Use this option when you sample names are by directory
168             The default is to find samples by filename
169              
170             /SAMPLE1
171             SAMPLE1_r1.fastq.gz
172             SAMPLE1_r2.fastq.gz
173             /SAMPLE2
174             SAMPLE2_r1.fastq.gz
175             SAMPLE2_r2.fastq.gz
176              
177             =cut
178              
179             has 'find_by_dir' => (
180             is => 'rw',
181             isa => 'Bool',
182             default => 0,
183             documentation => q{Use this option when you sample names are directories},
184             predicate => 'has_find_by_dir',
185             clearer => 'clear_find_by_dir',
186             );
187              
188             =head2 by_sample_outdir
189              
190             outdir/
191             /outdir/SAMPLE1
192             /rule1
193             /rule2
194             /rule3
195             /outdir/SAMPLE2
196             /rule1
197             /rule2
198             /rule3
199              
200             Instead of
201              
202             /outdir
203             /rule1
204             /rule2
205              
206             This feature is not particularly well supported, and may break when mixed with other methods, particularly --resample
207              
208             =cut
209              
210             has 'by_sample_outdir' => (
211             is => 'rw',
212             isa => 'Bool',
213             default => 0,
214             documentation => q{When you want your output by sample},
215             clearer => 'clear_by_sample_outdir',
216             predicate => 'has_by_sample_outdir',
217             );
218              
219             =head3 min
220              
221             Print the workflow as 2 files.
222              
223             #run-workflow.sh
224             export SAMPLE=sampleN && ./run_things
225              
226             =cut
227              
228             has 'min' => (
229             is => 'rw',
230             isa => 'Bool',
231             default => 0,
232             );
233              
234             =head3 number_rules
235              
236             Instead of
237             outdir/
238             rule1
239             rule2
240              
241             outdir/
242             001-rule1
243             002-rule2
244              
245             =cut
246              
247             has 'number_rules' => (
248             is => 'rw',
249             isa => 'Bool',
250             default => 0,
251             );
252              
253             has 'counter_rules' => (
254             traits => ['Counter'],
255             is => 'rw',
256             isa => 'Num',
257             default => 1,
258             handles => {
259             inc_counter_rules => 'inc',
260             dec_counter_rules => 'dec',
261             reset_counter_rules => 'reset',
262             },
263             );
264              
265             =head3 auto_name
266              
267             Auto_name - Create outdirectory based on rulename
268              
269             global:
270             - outdir: /home/user/workflow/processed
271             rule:
272             normalize:
273             process:
274             dostuff {$self->indir}/{$sample}.in >> {$self->outdir}/$sample.out
275              
276             Would create your directory structure /home/user/workflow/processed/normalize (if it doesn't exist)
277              
278             =cut
279              
280             has 'auto_name' => (
281             traits => ['Bool'],
282             is => 'rw',
283             isa => 'Bool',
284             default => 1,
285              
286             #clearer => 'clear_auto_name',
287             predicate => 'has_auto_name',
288             handles => {
289             enforce_struct => 'set',
290             clear_enforce_struct => 'unset',
291             clear_auto_name => 'unset',
292             },
293             );
294              
295             =head3 auto_input
296              
297             This is similar to the auto_name function in the BioX::Workflow.
298             Instead this says each input should be the previous output.
299              
300             =cut
301              
302             has 'auto_input' => (
303             is => 'rw',
304             isa => 'Bool',
305             default => 1,
306             clearer => 'clear_auto_input',
307             predicate => 'has_auto_input',
308             );
309              
310             # Getting rid of this - its the same as auto_name
311             # Put it in auto_name for compatibility
312              
313             #has 'enforce_struct' => (
314             #is => 'rw',
315             #isa => 'Bool',
316             #default => 1,
317             #clearer => 'clear_enforce_struct',
318             #predicate => 'has_enforce_struct',
319             #);
320              
321             =head3 verbose
322              
323             Output some more things
324              
325             =cut
326              
327             has 'verbose' => (
328             is => 'rw',
329             isa => 'Bool',
330             default => 1,
331             clearer => 'clear_verbose',
332             predicate => 'has_verbose',
333             );
334              
335             =head3 wait
336              
337             Print "wait" at the end of each rule
338              
339             =cut
340              
341             has 'wait' => (
342             is => 'rw',
343             isa => 'Bool',
344             default => 1,
345             documentation =>
346             q(Print 'wait' at the end of each rule. If you are running as a plain bash script you probably don't need this.),
347             clearer => 'clear_wait',
348             predicate => 'has_wait',
349             );
350              
351             =head3 override_process
352              
353             local:
354             - override_process: 1
355              
356             =cut
357              
358             has 'override_process' => (
359             traits => ['Bool'],
360             is => 'rw',
361             isa => 'Bool',
362             default => 0,
363             predicate => 'has_override_process',
364             documentation =>
365             q(Instead of for my $sample (@sample){ DO STUFF } just DOSTUFF),
366             handles => {
367             set_override_process => 'set',
368             clear_override_process => 'unset',
369             },
370             );
371              
372             =head3 indir outdir
373              
374             =cut
375              
376             has 'indir' => (
377             is => 'rw',
378             isa => AbsPath,
379             coerce => 1,
380             default => sub { getcwd(); },
381             predicate => 'has_indir',
382             clearer => 'clear_indir',
383             documentation => q(Directory to look for samples),
384             );
385              
386             has 'outdir' => (
387             is => 'rw',
388             isa => AbsPath,
389             coerce => 1,
390             default => sub { getcwd(); },
391             predicate => 'has_outdir',
392             clearer => 'clear_outdir',
393             documentation => q(Output directories for rules and processes),
394             );
395              
396             =head3 create_outdir
397              
398             =cut
399              
400             has 'create_outdir' => (
401             is => 'rw',
402             isa => 'Bool',
403             predicate => 'has_create_outdir',
404             clearer => 'clear_create_outdir',
405             documentation =>
406             q(Create the outdir. You may want to turn this off if doing a rule that doesn't write anything, such as checking if files exist),
407             default => 1,
408             );
409              
410             =head3 INPUT OUTPUT
411              
412             Special variables that can have input/output
413              
414             These variables are also used in L<BioX::Workflow::Plugin::Drake>
415              
416             =cut
417              
418             has 'OUTPUT' => (
419             is => 'rw',
420             isa => 'Str|Undef',
421             predicate => 'has_OUTPUT',
422             clearer => 'clear_OUTPUT',
423             documentation =>
424             q(Maybe clean up your code some. At the end of each process the OUTPUT becomes
425             the INPUT. Best when putting a single file through a stream of processes.)
426             );
427              
428             has 'INPUT' => (
429             is => 'rw',
430             isa => 'Str|Undef',
431             predicate => 'has_INPUT',
432             clearer => 'clear_INPUT',
433             documentation => q(See $OUTPUT)
434             );
435              
436             =head3 file_rule
437              
438             Rule to find files
439              
440             =cut
441              
442             has 'file_rule' => (
443             is => 'rw',
444             isa => 'Str',
445             default => sub { return "(.*)"; },
446             clearer => 'clear_file_rule',
447             predicate => 'has_file_rule',
448             );
449              
450             =head3 No GetOpt Here
451              
452             =cut
453              
454             has 'yaml' => (
455             traits => ['NoGetopt'],
456             is => 'rw',
457             );
458              
459             =head3 attr
460              
461             attributes read in from runtime
462              
463             =cut
464              
465             has 'attr' => (
466             traits => ['NoGetopt'],
467             is => 'rw',
468             isa => 'Data::Pairs',
469             );
470              
471             =head3 global_attr
472              
473             Attributes defined in the global section of the yaml file
474              
475             =cut
476              
477             has 'global_attr' => (
478             traits => ['NoGetopt'],
479             is => 'rw',
480             isa => 'Data::Pairs',
481             lazy => 1,
482             default => sub {
483             my $self = shift;
484              
485             my $n = Data::Pairs->new(
486             [ { resample => $self->resample },
487             { wait => $self->wait },
488             { auto_input => $self->auto_input },
489             { coerce_paths => $self->coerce_paths },
490             { auto_name => $self->auto_name },
491             { indir => $self->indir },
492             { outdir => $self->outdir },
493             { min => $self->min },
494             { override_process => $self->override_process },
495             { rule_based => $self->rule_based },
496             { verbose => $self->verbose },
497             { create_outdir => $self->create_outdir },
498             ]
499             );
500             return $n;
501             }
502             );
503              
504             =head3 local_attr
505              
506             Attributes defined in the rules->rulename->local section of the yaml file
507              
508             =cut
509              
510             has 'local_attr' => (
511             traits => ['NoGetopt'],
512             is => 'rw',
513             isa => 'Data::Pairs',
514             );
515              
516             =head3 local_rule
517              
518             =cut
519              
520             has 'local_rule' => (
521             traits => ['NoGetopt'],
522             is => 'rw',
523             isa => 'HashRef'
524             );
525              
526             =head3 infiles
527              
528             Infiles to be processed
529              
530             =cut
531              
532             has 'infiles' => (
533             traits => ['NoGetopt'],
534             is => 'rw',
535             isa => 'ArrayRef',
536             );
537              
538             =head3 samples
539              
540             =cut
541              
542             has 'samples' => (
543             traits => ['Array'],
544             is => 'rw',
545             isa => 'ArrayRef',
546             default => sub { [] },
547             required => 0,
548             handles => {
549             all_samples => 'elements',
550             add_sample => 'push',
551             map_samples => 'map',
552             filter_samples => 'grep',
553             find_sample => 'first',
554             get_sample => 'get',
555             join_samples => 'join',
556             count_samples => 'count',
557             has_samples => 'count',
558             has_no_samples => 'is_empty',
559             sorted_samples => 'sort',
560             },
561             documentation =>
562             q{Supply samples on the command line as --samples sample1 --samples sample2, or find through file_rule.}
563             );
564              
565             =head3 process
566              
567             Do stuff
568              
569             =cut
570              
571             has 'process' => (
572             traits => ['NoGetopt'],
573             is => 'rw',
574             isa => 'Str',
575             );
576              
577             =head3 key
578              
579             Do stuff
580              
581             =cut
582              
583             has 'key' => (
584             traits => ['NoGetopt'],
585             is => 'rw',
586             isa => 'Str',
587             );
588              
589             =head3 workflow
590              
591             Path to workflow workflow. This must be a YAML file.
592              
593             =cut
594              
595             has_file 'workflow' => (
596             is => 'rw',
597             required => 1,
598             must_exist => 1,
599             documentation => q{Your configuration workflow file.},
600             );
601              
602             =head3 rule_based
603              
604             This is the default. The outer loop are the rules, not the samples
605              
606             =cut
607              
608             has 'rule_based' => (
609             is => 'rw',
610             isa => 'Bool',
611             default => 1,
612             );
613              
614             =head3 sample_based
615              
616             Default Value. The outer loop is samples, not rules. Must be set in your global values or on the command line --sample_based 1
617              
618             If you ever have resample: 1 in your config you should NOT set this value to true!
619              
620             =cut
621              
622             has 'sample_based' => (
623             is => 'rw',
624             isa => 'Bool',
625             default => 0,
626             );
627              
628             =head3 save_object_env
629              
630             Save object env. This will save all the variables. Useful for debugging, but gets unweildly for larger workflows.
631              
632             =cut
633              
634             has 'save_object_env' => (
635             is => 'rw',
636             isa => 'Bool',
637             default => 0,
638             predicate => 'has_save_object_env',
639             clearer => 'clear_save_object_env',
640             );
641              
642             =head2 stash
643              
644             This isn't ever used in the code. Its just there incase you want to do some things with override_process
645              
646             It uses Moose::Meta::Attribute::Native::Trait::Hash and supports all the methods.
647              
648             set_stash => 'set',
649             get_stash => 'get',
650             has_no_stash => 'is_empty',
651             num_stashs => 'count',
652             delete_stash => 'delete',
653             stash_pairs => 'kv',
654              
655             =cut
656              
657             has 'stash' => (
658             is => 'rw',
659             isa => 'HashRef',
660             traits => ['Hash'],
661             default => sub { {} },
662             handles => {
663             set_stash => 'set',
664             get_stash => 'get',
665             has_no_stash => 'is_empty',
666             num_stashs => 'count',
667             delete_stash => 'delete',
668             stash_pairs => 'kv',
669             },
670             );
671              
672             =head2 _classes
673              
674             Saves a snapshot of the entire namespace for the initial environment, and each rule.
675              
676             =cut
677              
678             has '_classes' => (
679             traits => ['NoGetopt'],
680             is => 'rw',
681             isa => 'HashRef',
682             default => sub { return {} },
683             required => 0,
684             predicate => 'has_classes',
685             clearer => 'clear_classes',
686             );
687              
688             =head2 Subroutines
689              
690             Subroutines can also be overriden and/or extended in the usual Moose fashion.
691              
692             =head3 run
693              
694             Starting point.
695              
696             =cut
697              
698             sub run {
699 0     0 1 0 my ($self) = shift;
700              
701 0         0 print "#!/bin/bash\n\n";
702              
703 0         0 $self->print_opts;
704              
705 0         0 $self->init_things;
706              
707 0         0 $self->write_workflow_meta('start');
708              
709 0         0 $self->write_pipeline;
710              
711 0         0 $self->write_workflow_meta('end');
712             }
713              
714             sub write_workflow_meta {
715 6     6 0 33 my $self = shift;
716 6         11 my $type = shift;
717              
718 6 50       129 return unless $self->verbose;
719              
720 6 100       35 if ( $type eq "start" ) {
    50          
721 3         25 print "$self->{comment_char}\n";
722 3         16 print "$self->{comment_char} Starting Workflow\n";
723 3         14 print "$self->{comment_char}\n";
724 3         13 print "$self->{comment_char}\n";
725 3         15 print "$self->{comment_char} Global Variables:\n";
726              
727 3         73 my @keys = $self->global_attr->get_keys();
728              
729 3         98 foreach my $k (@keys) {
730 45 50       61 next unless $k;
731 45         1006 my ($v) = $self->global_attr->get_values($k);
732 45         2096 print "$self->{comment_char}\t$k: " . $v . "\n";
733             }
734 3         21 print "$self->{comment_char}\n";
735             }
736             elsif ( $type eq "end" ) {
737 3         48 print "$self->{comment_char}\n";
738 3         17 print "$self->{comment_char} Ending Workflow\n";
739 3         31 print "$self->{comment_char}\n";
740             }
741             }
742              
743             sub init_things {
744 6     6 0 7073 my $self = shift;
745              
746 6         193 $self->key('global');
747 6         17 $self->workflow_load;
748              
749 6         22 $self->class_load;
750 6         17 $self->plugin_load;
751              
752             #Darn you data pairs and your shallow copies!
753 6         15 $self->set_global_yaml;
754 6         133 $self->attr( dclone( $self->global_attr ) );
755              
756 6         20 $self->create_attr;
757 6         1655 $self->eval_attr;
758              
759 6         515 $self->make_outdir;
760 6         106 $self->get_samples;
761              
762             #Save our initial environment
763 6         23 $self->save_env;
764             }
765              
766             sub set_global_yaml {
767 6     6 0 10 my $self = shift;
768              
769 6 50       120 return unless exists $self->yaml->{global};
770              
771 6         119 my $aref = $self->yaml->{global};
772 6         10 for my $a (@$aref){
773 24         23 while (my ($key, $value) = each(%{$a})) {
  48         1020  
774 24         618 $self->global_attr->set($key => $value);
775             }
776             }
777             }
778              
779             =head2 save_env
780              
781             At each rule save the env for debugging purposes.
782              
783             =cut
784              
785             sub save_env {
786 15     15 1 31 my $self = shift;
787              
788 15 50       354 return unless $self->save_object_env;
789              
790 0         0 $DB::single = 2;
791 0         0 $self->_classes->{ $self->key } = dclone($self);
792 0         0 return;
793 0         0 $DB::single = 2;
794             }
795              
796             sub workflow_load {
797 6     6 0 7 my $self = shift;
798              
799 6         28 my $cfg = Config::Any->load_files(
800             { files => [ $self->workflow ], use_ext => 1 } );
801              
802 6         24291 for (@$cfg) {
803 6         17 my ( $filename, $config ) = %$_;
804 6         198 $self->yaml($config);
805             }
806             }
807              
808             =head3 make_outdir
809              
810             Set initial indir and outdir
811              
812             =cut
813              
814             sub make_outdir {
815 99     99 1 93 my ($self) = @_;
816              
817 99 50       2009 return unless $self->create_outdir;
818              
819 99 50       275 if ( $self->{outdir} =~ m/\{\$/ ) {
820 0         0 return;
821             }
822 99 100       2256 make_path( $self->outdir ) if !-d $self->outdir;
823             }
824              
825             =head3 get_samples
826              
827             Get basename of the files. Can add optional rules.
828              
829             sample.vcf.gz and sample.vcf would be sample if the file_rule is (.vcf)$|(.vcf.gz)$
830              
831             Also gets the full path to infiles
832              
833             Instead of doing
834              
835             foreach my $sample (@$self->samples){
836             dostuff
837             }
838              
839             Could have
840              
841             foreach my $infile (@$self->infiles){
842             dostuff
843             }
844              
845             =cut
846              
847             sub get_samples {
848 6     6 1 12 my ($self) = shift;
849 6         6 my ( @whole, @basename, $text );
850              
851 6 50 33     187 if ( $self->has_samples && !$self->resample ) {
852 0         0 my (@samples) = $self->sorted_samples;
853 0         0 $self->samples( \@samples );
854 0         0 return;
855             }
856              
857 6         140 $text = $self->file_rule;
858              
859 6 100       142 if ( $self->find_by_dir ) {
860 2         59 @whole = find(
861             directory => name => qr/$text/,
862             maxdepth => 1,
863             in => $self->indir
864             );
865              
866             #File find puts directory we are looking in, not just subdirs
867 2         2055 @basename = grep { $_ != basename( $self->{indir} ) } @basename;
  0         0  
868 2         5 @basename = map { basename($_) } @whole;
  10         207  
869 2         9 @basename = sort(@basename);
870             }
871             else {
872 4         110 @whole = find(
873             file => name => qr/$text/,
874             maxdepth => 1,
875             in => $self->indir
876             );
877              
878             #AAAH DOESN"T WORK
879             #@basename = map { my @tmp = fileparse($_); my($m) = $tmp[0] =~ qr/$text/; $m } @whole ;
880 4         3355 @basename = map { $self->match_samples( $_, $text ) } @whole;
  20         33  
881 4         17 @basename = uniq(@basename);
882 4         199 @basename = sort(@basename);
883             }
884              
885 6         174 $self->samples( \@basename );
886 6         133 $self->infiles( \@whole );
887              
888 6 50       127 if ( $self->verbose ) {
889 6         293 print "$self->{comment_char}\n";
890             print "$self->{comment_char} Samples: ",
891 6         15 join( ", ", @{ $self->samples } ) . "\n";
  6         157  
892 6         40 print "$self->{comment_char}\n";
893             }
894             }
895              
896             =head2 match_samples
897              
898             Match samples based on regex written in file_rule
899              
900             =cut
901              
902             sub match_samples {
903 20     20 1 16 my $self = shift;
904 20         18 my $file = shift;
905 20         15 my $text = shift;
906              
907 20         210 my @tmp = fileparse($_);
908 20         108 my ($m) = $tmp[0] =~ qr/$text/;
909              
910 20         44 return $m;
911             }
912              
913             =head3 plugin_load
914              
915             Load plugins defined in yaml with MooseX::Object::Pluggable
916              
917             =cut
918              
919             sub plugin_load {
920 6     6 1 10 my ($self) = shift;
921              
922 6 50       133 return unless $self->yaml->{plugins};
923              
924 0         0 my $modules = $self->yaml->{plugins};
925              
926 0         0 foreach my $m (@$modules) {
927 0         0 $self->load_plugin($m);
928             }
929             }
930              
931             =head3 class_load
932              
933             Load classes defined in yaml with Class::Load
934              
935             =cut
936              
937             sub class_load {
938 6     6 1 11 my ($self) = shift;
939              
940 6 50       138 return unless $self->yaml->{use};
941              
942 0         0 my $modules = $self->yaml->{use};
943              
944 0         0 foreach my $m (@$modules) {
945 0         0 load_class($m);
946             }
947             }
948              
949             =head3 make_template
950              
951             Make the template for interpolating strings
952              
953             =cut
954              
955             sub make_template {
956 764     764 1 802 my ( $self, $input ) = @_;
957              
958 764         2424 my $template = Text::Template->new(
959             TYPE => 'STRING',
960             SOURCE => "$E{$input}",
961             );
962              
963 764         49852 return $template;
964             }
965              
966             =head3 create_attr
967              
968             make attributes
969              
970             =cut
971              
972             sub create_attr {
973 15     15 1 21 my ($self) = shift;
974              
975 15         83 my $meta = __PACKAGE__->meta;
976              
977 15         277 $meta->make_mutable;
978              
979 15         9044 my %seen = ();
980              
981 15         65 for my $attr ( $meta->get_all_attributes ) {
982 728         2334 $seen{ $attr->name } = 1;
983             }
984              
985             # Data Pairs is so much prettier
986 15         447 my @keys = $self->attr->get_keys();
987              
988 15         466 foreach my $k (@keys) {
989 220         4493 my ($v) = $self->attr->get_values($k);
990              
991 220 100       9166 if ( !exists $seen{$k} ) {
992 3 100       10 if ( $k =~ m/_dir$/ ) {
993 1 50       24 if ( $self->coerce_paths ) {
994 1         9 $meta->add_attribute(
995             $k => (
996             is => 'rw',
997             isa => AbsPath,
998             coerce => 1,
999             predicate => "has_$k",
1000             clearer => "clear_$k"
1001             )
1002             );
1003             }
1004             else {
1005 0         0 $meta->add_attribute(
1006             $k => (
1007             is => 'rw',
1008             isa => AbsPath,
1009             coerce => 0,
1010             predicate => "has_$k",
1011             clearer => "clear_$k"
1012             )
1013             );
1014             }
1015             }
1016             else {
1017 2         13 $meta->add_attribute(
1018             $k => (
1019             is => 'rw',
1020             predicate => "has_$k",
1021             clearer => "clear_$k"
1022             )
1023             );
1024             }
1025             }
1026 220 50       25608 $self->$k($v) if defined $v;
1027             }
1028              
1029 15         286 $meta->make_immutable;
1030             }
1031              
1032             sub eval_attr {
1033 60     60 0 64 my $self = shift;
1034 60         52 my $sample = shift;
1035              
1036 60         1339 my @keys = $self->attr->get_keys();
1037              
1038 60         1646 foreach my $k (@keys) {
1039 899 50       1418 next unless $k;
1040 899         18974 my ($v) = $self->attr->get_values($k);
1041 899 100       38810 next unless $v;
1042              
1043 719         1023 my $template = $self->make_template($v);
1044 719         606 my $text;
1045 719 100       1007 if ($sample) {
1046 545         1411 $text = $template->fill_in(
1047             HASH => { self => \$self, sample => $sample } );
1048             }
1049             else {
1050 174         403 $text = $template->fill_in( HASH => { self => \$self } );
1051             }
1052              
1053 719         128887 $self->$k($text);
1054             }
1055              
1056             #$self->make_outdir if $self->attr->exists('OUTPUT');
1057 60 50       2197 $self->make_outdir if $self->create_outdir;
1058             }
1059              
1060             sub clear_attr {
1061 0     0 0 0 my $self = shift;
1062              
1063 0         0 my @keys = $self->attr->get_keys();
1064              
1065 0         0 foreach my $k (@keys) {
1066 0         0 my ($v) = $self->attr->get_values($k);
1067 0 0       0 next unless $v;
1068              
1069 0         0 my $clear = "clear_$k";
1070 0         0 $self->$clear;
1071             }
1072             }
1073              
1074             sub write_pipeline {
1075 3     3 0 15 my ($self) = shift;
1076              
1077             #Min and Sample_Based Mode will break with --resample
1078 3 50       73 if ( $self->min ) {
    50          
    50          
1079 0         0 $self->write_min_files;
1080 0         0 $self->process_rules;
1081             }
1082             elsif ( $self->sample_based ) {
1083              
1084             #Store the samples
1085 0         0 my $sample_store = $self->samples;
1086 0         0 foreach my $sample (@$sample_store) {
1087 0         0 $self->samples( [$sample] );
1088 0         0 $self->process_rules;
1089             }
1090             }
1091             elsif ( $self->rule_based ) {
1092 3         9 $self->process_rules;
1093             }
1094             else {
1095 0         0 die print "Workflow must be rule based or sample based!\n";
1096             }
1097             }
1098              
1099             sub write_min_files {
1100 0     0 0 0 my ($self) = shift;
1101              
1102 0 0       0 open( my $fh, '>', 'run-workflow.sh' )
1103             or die print "Could not open file $!\n";
1104              
1105 0         0 print $fh "#!/bin/bash\n\n";
1106              
1107 0         0 my $cwd = getcwd();
1108 0         0 foreach my $sample ( @{ $self->samples } ) {
  0         0  
1109 0         0 print $fh <<EOF;
1110             export SAMPLE=$sample && ./workflow.sh
1111             EOF
1112             }
1113              
1114 0         0 close $fh;
1115              
1116 0         0 chmod 0777, 'run-workflow.sh';
1117              
1118 0         0 $self->samples( ["\${SAMPLE}"] );
1119             }
1120              
1121             sub process_rules {
1122 3     3 0 5 my $self = shift;
1123              
1124 3         4 my $process;
1125 3         65 $process = $self->yaml->{rules};
1126              
1127 3 50       8 die print "Where are the rules?\n" unless $process;
1128              
1129 3         4 foreach my $p ( @{$process} ) {
  3         6  
1130 9 50       22 next unless $p;
1131 9 50       213 if($self->number_rules){
1132 0         0 my @keys = keys %{$p};
  0         0  
1133 0         0 my $result = sprintf("%04d", $self->counter_rules);
1134 0         0 my $newkey = $keys[0];
1135 0         0 $newkey = $result.'-'.$newkey;
1136 0         0 $p->{$newkey} = dclone($p->{$keys[0]});
1137 0         0 delete $p->{$keys[0]};
1138             }
1139 9         191 $self->local_rule($p);
1140 9         23 $self->dothings;
1141 9         281 $self->inc_counter_rules;
1142             }
1143             }
1144              
1145             sub dothings {
1146 9     9 0 12 my ($self) = shift;
1147              
1148 9         25 $self->check_keys;
1149              
1150 9         33 $self->init_process_vars;
1151              
1152 9         426 $DB::single=2;
1153 9 50       281 if ( $self->has_select_rules ) {
    50          
1154 0         0 my $p = $self->key;
1155 0 0   0   0 if ( !$self->filter_select_rules( sub {/^$p$/} ) ) {
  0         0  
1156 0         0 $self->OUTPUT_to_INPUT;
1157 0         0 $self->clear_process_vars;
1158              
1159 0         0 $self->pkey( $self->key );
1160 0 0       0 $self->indir( $self->outdir . "/" . $self->pkey )
1161             if $self->auto_name;
1162 0         0 return;
1163             }
1164             }
1165             elsif ( $self->has_match_rules ) {
1166 0         0 my $p = $self->key;
1167 0 0   0   0 if ( !$self->map_match_rules( sub {$p =~ m/$_/} ) ) {
  0         0  
1168 0         0 $self->OUTPUT_to_INPUT;
1169 0         0 $self->clear_process_vars;
1170              
1171 0         0 $self->pkey( $self->key );
1172 0 0       0 $self->indir( $self->outdir . "/" . $self->pkey )
1173             if $self->auto_name;
1174 0         0 return;
1175             }
1176             }
1177              
1178 9         210 $self->process( $self->local_rule->{ $self->key }->{process} );
1179              
1180 9         40 $self->write_rule_meta('before_meta');
1181              
1182 9         20 $self->write_process();
1183              
1184 9         18 $self->write_rule_meta('after_meta');
1185              
1186 9         21 $self->clear_process_vars;
1187              
1188 9 50       402 $self->indir( $self->outdir . "/" . $self->pkey ) if $self->auto_name;
1189             }
1190              
1191             =head2 check_keys
1192              
1193             There should be one key and one key only!
1194              
1195             =cut
1196              
1197             sub check_keys {
1198 9     9 1 9 my $self = shift;
1199 9         9 my @keys = keys %{ $self->local_rule };
  9         206  
1200              
1201 9 50       43 if ( $#keys > 0 ) {
    50          
1202 0         0 die print
1203             "We have a problem! There should only be one key. Please see the documentation!\n";
1204             }
1205             elsif ( !@keys ) {
1206 0         0 die print "There are no rules. Please see the documenation.\n";
1207             }
1208             else {
1209 9         206 $self->key( $keys[0] );
1210             }
1211              
1212 9 50       185 if ( !exists $self->local_rule->{ $self->key }->{process} ) {
1213 0         0 die print "There is no process key! Dying...\n";
1214             }
1215             }
1216              
1217             =head2 clear_process_vars
1218              
1219             Clear the process vars
1220              
1221             =cut
1222              
1223             sub clear_process_vars {
1224 9     9 1 11 my $self = shift;
1225              
1226 9         214 $self->attr->clear;
1227 9         266 $self->local_attr->clear;
1228              
1229 9         44 $self->add_attr('global_attr');
1230 9         345 $self->eval_attr;
1231             }
1232              
1233             =head2 init_process_vars
1234              
1235             Initialize the process vars
1236              
1237             =cut
1238              
1239             sub init_process_vars {
1240 9     9 1 11 my $self = shift;
1241              
1242 9 50       211 if ( $self->auto_name ) {
1243 9         182 $self->outdir( $self->outdir . "/" . $self->key );
1244 9 100       207 $self->make_outdir() unless $self->by_sample_outdir;
1245             }
1246              
1247             #TODO move this over to local
1248 9 50 33     667 if ( exists $self->local_rule->{ $self->key }->{override_process}
1249             && $self->local_rule->{ $self->key }->{override_process} == 1 )
1250             {
1251 0         0 $self->override_process(1);
1252             }
1253             else {
1254 9         488 $self->override_process(0);
1255             }
1256              
1257 9         49 $self->local_attr( Data::Pairs->new( [] ) );
1258 9 100       185 if ( exists $self->local_rule->{ $self->key }->{local} ) {
1259             $self->local_attr(
1260             Data::Pairs->new(
1261             dclone( $self->local_rule->{ $self->key }->{local} )
1262 2         42 )
1263             );
1264             }
1265              
1266             #Make sure these aren't reset to global
1267             ##YAY FOR TESTS
1268 9 50       182 $self->local_attr->set( 'outdir' => $self->outdir )
1269             unless $self->local_attr->exists('outdir');
1270 9 50       323 $self->local_attr->set( 'indir' => $self->indir )
1271             unless $self->local_attr->exists('indir');
1272              
1273 9         156 $self->add_attr('local_attr');
1274 9         355 $self->create_attr;
1275 9 50       2593 $self->get_samples if $self->resample;
1276              
1277             #Why did I have this in write rule meta?
1278 9 50       203 if ( $self->auto_input ) {
1279 9 50       224 $self->local_attr->set( 'OUTPUT' => $self->OUTPUT )
1280             if $self->has_OUTPUT;
1281 9 50       196 $self->local_attr->set(
1282             'INPUT' => $self->global_attr->get_values('INPUT') )
1283             if $self->global_attr->exists('INPUT');
1284             }
1285             }
1286              
1287             =head2 add_attr
1288              
1289             Add the local attr onto the global attr
1290              
1291             =cut
1292              
1293             sub add_attr {
1294 18     18 1 19 my $self = shift;
1295 18         22 my $type = shift;
1296              
1297 18         419 my @keys = $self->$type->get_keys();
1298              
1299 18         348 foreach my $key (@keys) {
1300 156 50       3750 next unless $key;
1301              
1302 156         3373 my ($v) = $self->$type->get_values($key);
1303 156         8724 $self->attr->set( $key => $v );
1304             }
1305              
1306             }
1307              
1308             =head2 write_rule_meta
1309              
1310             =cut
1311              
1312             sub write_rule_meta {
1313 18     18 1 22 my ( $self, $meta ) = @_;
1314              
1315 18         356 print "\n$self->{comment_char}\n";
1316 18 100       43 if ( $meta eq "after_meta" ) {
1317 9         50 print "$self->{comment_char} Ending $self->{key}\n";
1318             }
1319 18         102 print "$self->{comment_char}\n\n";
1320              
1321 18 100       38 return unless $meta eq "before_meta";
1322 9         46 print "$self->{comment_char} Starting $self->{key}\n";
1323 9         41 print "$self->{comment_char}\n\n";
1324              
1325 9 50       229 if ( $self->verbose ) {
1326 9         62 print "\n\n$self->{comment_char}\n";
1327 9         43 print "$self->{comment_char} Variables \n";
1328 9         212 print "$self->{comment_char} Indir: " . $self->indir . "\n";
1329 9         309 print "$self->{comment_char} Outdir: " . $self->outdir . "\n";
1330              
1331 9 100       277 if ( exists $self->local_rule->{ $self->key }->{local} ) {
1332              
1333 2         15 print "$self->{comment_char} Local Variables:\n";
1334              
1335 2         48 my @keys = $self->local_attr->get_keys();
1336              
1337 2         33 foreach my $k (@keys) {
1338 7         175 my ($v) = $self->local_attr->get_values($k);
1339 7         165 print "$self->{comment_char}\t$k: " . $v . "\n";
1340             }
1341             }
1342              
1343 9 50       207 if ( $self->resample ) {
1344             print "$self->{comment_char} Resampling Samples: ",
1345 0         0 join( ", ", @{ $self->samples } ) . "\n";
  0         0  
1346             }
1347 9         71 print "$self->{comment_char}\n\n";
1348             }
1349              
1350             }
1351              
1352             =head3 write_process
1353              
1354             Fill in the template with the process
1355              
1356             =cut
1357              
1358             has 'pkey' => (
1359             is => 'rw',
1360             isa => 'Str|Undef',
1361             predicate => 'has_pkey'
1362             );
1363              
1364             sub write_process {
1365 9     9 1 12 my ($self) = @_;
1366              
1367 9         11 my ( $template, $tmp, $newprocess, $sample, $origout, $origin );
1368              
1369 9         191 $origout = $self->outdir;
1370 9         178 $origin = $self->indir;
1371              
1372 9         25 $self->save_env;
1373              
1374 9 50       204 if ( !$self->override_process ) {
1375 9         12 foreach my $sample ( @{ $self->samples } ) {
  9         189  
1376 45 100       1028 $self->process_by_sample_outdir($sample)
1377             if $self->by_sample_outdir;
1378 45         1380 $self->eval_attr($sample);
1379 45         1223 my $data = { self => \$self, sample => $sample };
1380 45         92 $self->process_template($data);
1381 45         1080 $self->outdir($origout);
1382 45         893 $self->indir($origin);
1383             }
1384             }
1385             else {
1386 0         0 $self->eval_attr;
1387 0         0 my $data = { self => \$self };
1388 0         0 $self->process_template($data);
1389             }
1390              
1391 9 50       185 if ( $self->wait ) {
1392 9         78 print "\nwait\n";
1393             }
1394              
1395 9         27 $self->OUTPUT_to_INPUT;
1396              
1397 9         184 $self->pkey( $self->key );
1398              
1399             #$self->outdir($origout);
1400             #$self->indir($origin);
1401             }
1402              
1403             =head3 process_by_sample_outdir
1404              
1405             Make sure indir/outdirs are named appropriated for samples when using by
1406              
1407             =cut
1408              
1409             sub process_by_sample_outdir {
1410 30     30 1 36 my $self = shift;
1411 30         33 my $sample = shift;
1412              
1413 30         24 my ( $tt, $key );
1414 30         584 $tt = $self->outdir;
1415 30         581 $key = $self->key;
1416 30         138 $tt =~ s/$key/$sample\/$key/;
1417 30         836 $self->outdir($tt);
1418 30         57 $self->make_outdir;
1419 30         4946 $self->attr->set( 'outdir' => $self->outdir );
1420              
1421 30         2024 $tt = $self->indir;
1422 30 50       70 if ( $tt =~ m/\{\$self/ ) {
    100          
1423 0         0 $tt = "$tt/{\$sample}";
1424 0         0 $self->indir($tt);
1425             }
1426             elsif ( $self->has_pkey ) {
1427 20         403 $key = $self->pkey;
1428 20         75 $tt =~ s/$key/$sample\/$key/;
1429 20         546 $self->indir($tt);
1430             }
1431             else {
1432 10         20 $tt = "$tt/$sample";
1433 10         218 $self->indir($tt);
1434             }
1435 30         605 $self->attr->set( 'indir' => $self->indir );
1436             }
1437              
1438             =head3 OUTPUT_to_INPUT
1439              
1440             If we are using auto_input chain INPUT/OUTPUT
1441              
1442             =cut
1443              
1444             sub OUTPUT_to_INPUT {
1445 9     9 1 13 my $self = shift;
1446              
1447             #Change the output to input
1448 9 50 33     201 if ( $self->auto_input && $self->local_attr->exists('OUTPUT') ) {
1449 0         0 my ( $tmp, $indir, $outdir ) = (
1450             $self->local_attr->get_values('OUTPUT'),
1451             $self->indir, $self->outdir
1452             );
1453 0         0 $tmp =~ s/{\$self->outdir}/{\$self->indir}/g;
1454 0         0 $self->INPUT($tmp);
1455              
1456             #This is not the best way of doing this....
1457 0         0 $self->global_attr->set( INPUT => $self->INPUT );
1458             }
1459             else {
1460 9         381 $self->clear_OUTPUT();
1461             }
1462             }
1463              
1464             sub process_template {
1465 45     45 0 46 my ( $self, $data ) = @_;
1466              
1467 45         32 my ( $tmp, $template );
1468              
1469 45         1031 $template = $self->make_template( $self->process );
1470 45         100 $template->fill_in( HASH => $data, OUTPUT => \*STDOUT );
1471              
1472 45 50       5557 $self->INPUT( $self->local_attr->get_values('INPUT') )
1473             if $self->local_attr->exists('INPUT');
1474 45 50       1662 $self->OUTPUT( $self->local_attr->get_values('OUTPUT') )
1475             if $self->local_attr->exists('OUTPUT');
1476              
1477 45         1114 print "\n\n";
1478             }
1479              
1480             __PACKAGE__->meta->make_immutable;
1481              
1482             1;
1483              
1484             __END__
1485              
1486              
1487             =head1 DESCRIPTION
1488              
1489             BioX::Workflow - A very opinionated template based workflow writer.
1490              
1491             =head1 AUTHOR
1492              
1493             Jillian Rowe E<lt>jillian.e.rowe@gmail.comE<gt>
1494              
1495             =head1 Acknowledgements
1496              
1497             Before version 0.03
1498              
1499             This module was originally developed at and for Weill Cornell Medical
1500             College in Qatar within ITS Advanced Computing Team. With approval from
1501             WCMC-Q, this information was generalized and put on github, for which
1502             the authors would like to express their gratitude.
1503              
1504             As of version 0.03:
1505              
1506             This modules continuing development is supported by NYU Abu Dhabi in the Center for Genomics and Systems Biology.
1507             With approval from NYUAD, this information was generalized and put on bitbucket, for which
1508             the authors would like to express their gratitude.
1509              
1510             =head1 COPYRIGHT
1511              
1512             Copyright 2015- Weill Cornell Medical College in Qatar
1513              
1514             =head1 LICENSE
1515              
1516             This library is free software; you can redistribute it and/or modify
1517             it under the same terms as Perl itself.
1518              
1519             =head1 SEE ALSO
1520              
1521             =cut