• Files
• Commits
• Log
• Graph
• Stats

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;