From 08152c2c75071abc3f5ad2d0bc5354783afcc202 Mon Sep 17 00:00:00 2001 From: jemten Date: Fri, 5 Mar 2021 11:02:47 +0100 Subject: [PATCH] feat(megafusion): rename arriba contigs --- lib/MIP/Language/Perl.pm | 42 ++++++++++++- lib/MIP/Recipes/Analysis/Megafusion.pm | 84 +++++++++++++++++++++++++- t/perl_base.t | 25 ++++---- 3 files changed, 136 insertions(+), 15 deletions(-) diff --git a/lib/MIP/Language/Perl.pm b/lib/MIP/Language/Perl.pm index 5f7014857..88065d2b8 100644 --- a/lib/MIP/Language/Perl.pm +++ b/lib/MIP/Language/Perl.pm @@ -129,7 +129,8 @@ sub perl_base { ## : $command_line => Enter one line of program ## : $inplace => In place edit ## : $n => Iterate over filename arguments -## : $p => Print line +## : $print => Print line +## : $print_newline => Print newline at the end of line ## : $use_container => Use container perl instead of main (this) process perl my ($arg_href) = @_; @@ -142,6 +143,7 @@ sub perl_base { my $inplace; my $n; my $print; + my $print_newline; my $use_container; my $tmpl = { @@ -175,6 +177,12 @@ sub perl_base { store => \$print, strict_type => 1, }, + print_newline => { + allow => [ undef, 0, 1 ], + default => 0, + store => \$print_newline, + strict_type => 1, + }, use_container => => { allow => [ undef, 0, 1 ], default => 0, @@ -208,6 +216,10 @@ sub perl_base { push @commands, q{-p}; } + if ($print_newline) { + + push @commands, q{-l}; + } if ($command_line) { push @commands, q{-e}; @@ -228,6 +240,7 @@ sub perl_nae_oneliners { ## : $oneliner_cmd => Command to execute ## : $oneliner_name => Perl oneliner name ## : $oneliner_parameter => Feed a parameter to the oneliner program +## : $print_newline => Print newline at end of line ## : $stderrfile_path => Stderrfile path ## : $stderrfile_path_append => Append stderr info to file path ## : $stdinfile_path => Stdinfile path @@ -243,6 +256,7 @@ sub perl_nae_oneliners { my $oneliner_cmd; my $oneliner_name; my $oneliner_parameter; + my $print_newline; my $stderrfile_path; my $stderrfile_path_append; my $stdinfile_path; @@ -294,6 +308,11 @@ sub perl_nae_oneliners { store => \$oneliner_parameter, strict_type => 1, }, + print_newline => { + allow => [ undef, 0, 1 ], + store => \$print_newline, + strict_type => 1, + }, stderrfile_path => { store => \$stderrfile_path, strict_type => 1, @@ -339,6 +358,7 @@ sub perl_nae_oneliners { get_vcf_header_id_line => \&_get_vcf_header_id_line, get_vcf_loqusdb_headers => \&_get_vcf_loqusdb_headers, get_vcf_sample_ids => \&_get_vcf_sample_ids, + reformat_arriba_contig_name => \&_reformat_arriba_contig_name, reformat_sacct_headers => \&_reformat_sacct_headers, remove_decomposed_asterisk_records => \&_remove_decomposed_asterisk_records, synonyms_grch37_to_grch38 => \&_synonyms_grch37_to_grch38, @@ -369,6 +389,7 @@ sub perl_nae_oneliners { autosplit => $autosplit, command_line => $command_line, n => $n, + print_newline => $print_newline, use_container => $use_container, } ); @@ -991,4 +1012,23 @@ sub _write_contigs_size_file { return $write_contigs_size; } +sub _reformat_arriba_contig_name { + +## Function : Prepend chr prefix to contig names +## Returns : $reformat_arriba_contig_name + + my ($arg_href) = @_; + + ## For each column with contig info + my $reformat_arriba_contig_name = q?'foreach my $contig (@F[4,5]) ?; + + ## Prepend chr prefix + $reformat_arriba_contig_name .= q?{ $contig=~s/(^\d+:\d+)/chr$1/g; } ?; + + ## Write to STDOUT + $reformat_arriba_contig_name .= q?print join qq{\t}, @F;'?; + + return $reformat_arriba_contig_name; +} + 1; diff --git a/lib/MIP/Recipes/Analysis/Megafusion.pm b/lib/MIP/Recipes/Analysis/Megafusion.pm index cde8c5a07..347110e05 100644 --- a/lib/MIP/Recipes/Analysis/Megafusion.pm +++ b/lib/MIP/Recipes/Analysis/Megafusion.pm @@ -13,9 +13,10 @@ use warnings qw{ FATAL utf8 }; ## CPANM use autodie qw{ :all }; +use Readonly; ## MIPs lib/ -use MIP::Constants qw{ $DOT $LOG_NAME $NEWLINE $UNDERSCORE }; +use MIP::Constants qw{ $DOT $GENOME_VERSION $LOG_NAME $NEWLINE $UNDERSCORE }; BEGIN { @@ -153,6 +154,7 @@ sub analysis_megafusion { $fusion_file_path{$fusion_caller_recipe}{infile_path} = $io{out}{file_path}; $fusion_file_path{$fusion_caller_recipe}{file_name_prefix} = $io{out}{file_name_prefixes}[0]; + $fusion_file_path{$fusion_caller_recipe}{infile_name} = $io{out}{file_names}[0]; } my %recipe = parse_recipe_prerequisites( @@ -215,13 +217,22 @@ sub analysis_megafusion { FUSION_RECIPE: foreach my $fusion_recipe ( keys %fusion_file_path ) { + my $infile_path = _reformat_arriba_file( + { + filehandle => $filehandle, + fusion_recipe => $fusion_recipe, + infile_href => $fusion_file_path{$fusion_recipe}, + temp_directory => $active_parameter_href->{temp_directory}, + } + ); + my $megafusion_outfile_path = $outdir_path . $fusion_file_path{$fusion_recipe}{file_name_prefix} . $outfile_suffix; megafusion( { config_file_path => $config_path{$fusion_recipe}, filehandle => $filehandle, - infile_path => $fusion_file_path{$fusion_recipe}{infile_path}, + infile_path => $infile_path, sample_id => $sample_id, stdoutfile_path => $megafusion_outfile_path, } @@ -301,4 +312,73 @@ sub analysis_megafusion { return 1; } +sub _reformat_arriba_file { + +## Function : Prepend chr prefix to arriba tsv file for grch38 +## Returns : $megafusion_infile_path +## Arguments: $filehandle => Filehandle +## : $fusion_recipe => Fusion recipe +## : $infile_href => Infile hash {REF} +## : $temp_directory => Temporary directory path + + my ($arg_href) = @_; + + ## Flatten argument(s) + my $filehandle; + my $fusion_recipe; + my $infile_href; + my $temp_directory; + + my $tmpl = { + filehandle => { + defined => 1, + required => 1, + store => \$filehandle, + }, + fusion_recipe => { + defined => 1, + required => 1, + store => \$fusion_recipe, + strict_type => 1, + }, + infile_href => { + default => {}, + defined => 1, + required => 1, + store => \$infile_href, + strict_type => 1, + }, + temp_directory => { + defined => 1, + required => 1, + store => \$temp_directory, + strict_type => 1, + }, + }; + + check( $tmpl, $arg_href, 1 ) or croak q{Could not parse arguments!}; + + use MIP::Language::Perl qw{ perl_nae_oneliners }; + + Readonly my $GENOME_VERSION_38 => 38; + + return $infile_href->{infile_path} + if ( ( $GENOME_VERSION eq $GENOME_VERSION_38 ) or ( $fusion_recipe ne q{arriba_ar} ) ); + + say {$filehandle} q{## Reformat Arriba contig names before merging}; + my $megafusion_infile_path = catfile( $temp_directory, $infile_href->{infile_name} ); + perl_nae_oneliners( + { + filehandle => $filehandle, + oneliner_name => q{reformat_arriba_contig_name}, + print_newline => 1, + stdinfile_path => $infile_href->{infile_path}, + stdoutfile_path => $megafusion_infile_path, + use_container => 1, + } + ); + say {$filehandle} $NEWLINE; + + return $megafusion_infile_path; +} 1; diff --git a/t/perl_base.t b/t/perl_base.t index 3dbe3cbbe..89fce80cc 100644 --- a/t/perl_base.t +++ b/t/perl_base.t @@ -23,16 +23,13 @@ use lib catdir( dirname($Bin), q{lib} ); use MIP::Constants qw{ $COMMA $SPACE }; use MIP::Test::Commands qw{ test_function }; - BEGIN { use MIP::Test::Fixtures qw{ test_import }; ### Check all internal dependency modules and imports ## Modules with import - my %perl_module = ( - q{MIP::Language::Perl} => [qw{ perl_base }], -); + my %perl_module = ( q{MIP::Language::Perl} => [qw{ perl_base }], ); test_import( { perl_module_href => \%perl_module, } ); } @@ -54,26 +51,30 @@ my @function_base_commands = qw{ perl }; ## to enable testing of each individual argument my %specific_argument = ( - autosplit => { + autosplit => { input => 1, expected_output => q{-a}, }, - n => { - input => 1, - expected_output => q{-n}, - }, - command_line => { + command_line => { input => 1, expected_output => q{-e}, }, - inplace => { + inplace => { input => 1, expected_output => q{-i}, }, - print => { + n => { + input => 1, + expected_output => q{-n}, + }, + print => { input => 1, expected_output => q{-p}, }, + print_newline => { + input => 1, + expected_output => q{-l}, + }, use_container => => { input => 1, expected_output => q{perl},