package NGS::Test; use Exporter 'import'; our @EXPORT = qw( form_params create_content data_file_path print_response print_output content_with_static_file ); use FindBin qw($Bin); use Modern::Perl; use Path::Tiny; use IO::All; open my $fh, '>' . path($Bin, 'response.htm') or die $!; my $src_file = path($Bin, 'data', 'data.txt'); # warn $src_file; sub create_content { # for use with Plack::Test tests (D2 >= 0.154) my $test_data = shift; # warn Dumper $test_data; # arrayref, or AoA my $database = shift; # optional, defaults to core my $file_header = _get_file_header($test_data); # warn Dumper $header; my $file_data = join "\n", ( join "\t", @$file_header ), ( join "\n", map { _make_row($_ ) } @$test_data ); # warn $file_data; # write data to temp file: io($src_file)->print($file_data); my $content = _get_content($src_file, $database); return wantarray ? @$content : $content; } sub content_with_static_file { # returns content for use with file on disk my $filename = shift; my $database = shift; # optional, defaults to core my $src_file = path($Bin, 'data', $filename); my $content = _get_content($src_file, $database); return wantarray ? @$content : $content; } sub data_file_path { $src_file } # just returns path/to/data.txt sub construct_request { # only works with Dancer2::Test (pre 0.154) my $test_data = shift; # warn Dumper $test_data; # arrayref, or AoA my $params = _get_form_params(); # polyphen, sift, etc # emulate src data text file: my $file_header = _get_file_header($test_data); # warn Dumper $header; my $file_data = join "\n", ( join "\t", @$file_header ), ( join "\n", map { _make_row($_ ) } @$test_data ); # warn $file_data; my $files = _get_data_file(); $files->{data} = $file_data; my %args = ( headers => [ [ Content_Type => 'form-data' ] ], params => $params, files => [ $files ], ); return \%args; } sub form_params { return _get_form_params(@_) } sub print_output { # for printing WWW::Mechanise content my $response = shift; print $fh $response->{content}; } sub print_response { # for printing Plack::Test output my $response = shift; print $fh $response->as_string; } sub _get_content { my $src_file = shift; my $database = shift; # optional, defaults to core my $params = _get_form_params($database); # polyphen, sift, etc $params->{data_src} = [ $src_file ]; # p $params; my @content = ( 'Content_Type' => 'form-data', 'Content' => $params, ); return \@content; } sub _make_row { my $data = shift; # warn Dumper $data; # arrayref return join "\t", @$data } # returns col headers to match number of samples passed in $test_data: sub _get_file_header { my $test_data = shift; # warn Dumper $test_data; # AoA my $dataset = @{$test_data}[0]; # warn Dumper $dataset; arrayref # no. of sampless = dataset size minus 5 (common cols) / 2 (results in col pairs): my $no_of_samples = ( scalar @$dataset - 5 ) / 2; # warn $no_of_samples; my @cols = qw( Reference Variant Status Max-combined-% Max-combined-of ); push @cols, ( "H$_/10-combined-%", "H$_/10-combined-of", ) for ( 1 .. $no_of_samples ); # H1/10, H2/10, etc # warn Dumper \@cols; return \@cols; } sub _get_form_params { my $db = shift || 'core'; # optional, default to core return { check_existing => 1, coding_only => 1, regulatory => 1, data_src => 'data.txt', polyphen => 'b', sift => 'b', db => $db, } } sub _get_data_file { return { filename => 'data.txt', name => 'data_src', data => undef, # created in construct_request using .t $data, } } 1;