Skip to content

Commit

Permalink
feat(megafusion): rename arriba contigs
Browse files Browse the repository at this point in the history
  • Loading branch information
@jemten
jemten committed Mar 5, 2021
1 parent 98a0c25 commit 08152c2
Show file tree
Hide file tree
Showing 3 changed files with 136 additions and 15 deletions.
42 changes: 41 additions & 1 deletion lib/MIP/Language/Perl.pm
View file
Expand Up @@ -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) = @_;
Expand All @@ -142,6 +143,7 @@ sub perl_base {
my $inplace;
my $n;
my $print;
my $print_newline;
my $use_container;

my $tmpl = {
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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};
Expand All @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -369,6 +389,7 @@ sub perl_nae_oneliners {
autosplit => $autosplit,
command_line => $command_line,
n => $n,
print_newline => $print_newline,
use_container => $use_container,
}
);
Expand Down Expand Up @@ -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;
84 changes: 82 additions & 2 deletions lib/MIP/Recipes/Analysis/Megafusion.pm
View file
Expand Up @@ -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 {

Expand Down Expand Up @@ -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(
Expand Down Expand Up @@ -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,
}
Expand Down Expand Up @@ -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;
25 changes: 13 additions & 12 deletions t/perl_base.t
View file
Expand Up @@ -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, } );
}
Expand All @@ -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},
Expand Down

0 comments on commit 08152c2

Please sign in to comment.