RSS Git Download  Clone
Raw Blame History
# use Modern::Perl qw(2012); # not supported in perl 5.10
# use autodie;

package NGS;

use Dancer2 ':syntax';
use Dancer2::Core::Error;
# use Dancer::Plugin::Database; # doesn't work in D2
 
use Time::HiRes qw(gettimeofday tv_interval);
use Data::Dump qw(dump);
use Carp qw(croak);
use Template;
use IO::All;

use NGS::VEP;

our $VERSION = '0.1';

# --- Globals
my $source_filename = 'data_src';

get '/' => sub {
    template 'index';
};

get '/upload' => sub {
    debug 'GET upload page';
    template 'upload.tt', { title => 'Upload DataFile' };
};

post '/upload' => sub {
    debug 'POST upload page';
    debug "Params are : " . dump( request->params );
    
    my %allparams = params;
    
    my $validation_results = {
        data_file => upload($source_filename),
        form_opts => \%allparams,
    };
 
    _validate_user_input($validation_results);
    debug 'Validation results: ' . dump($validation_results);

#-- display any errors
    if ( exists $validation_results->{upload_error} ) {
        debug 'have upload error';
        return template 'upload.tt', {
            title => 'Upload Data Error',
            %$validation_results,
            warning_message => 'You must upload the file again!',
        };
    }
    
#-- passed validation
    debug 'OK passed the error checks.';
    my $src  = $validation_results->{data_file}->content; # debug $data;
    my $opts = $validation_results->{form_opts};

    my $t0 = [gettimeofday]; # set t0
    my $data = _parse({ src => $src, opts => $opts });
    $data->{runtime} = tv_interval $t0, [gettimeofday]; # VEP script runtime

    # delete temp file (if exists):
    my $tmp_file = $validation_results->{data_file}->tempname;
    io($tmp_file)->unlink if -e $tmp_file;
    
    return template 'result.tt', { results => $data };
};

sub _parse {
    my $args = shift;
    
    my @args = (
        form_opts => $args->{opts},
        src_data  => $args->{src},
    );
    
    my $parser = NGS::VEP->new(@args);
    return $parser->result;    
}

sub _validate_user_input {
    my $validation_report = shift;
 
    if ( defined $validation_report->{data_file} ) {
        debug 'At least there is a file uploaded.';
 
        #------ Check that the file is a valid data file
        $validation_report->{upload_error} = 'Not a valid data file!'
            unless _validate_file( $validation_report->{data_file} );
    }
    else {
        $validation_report->{upload_error} = 'No data file uploaded!';
    }
}

sub _validate_file {
    my $in_file = shift;
    
    my $cfg = config->{InputFile};

    my $max_file_size = $cfg->{max_file_size} * 1024 * 1024; # MB
    my $file_suffix   = $cfg->{file_suffix};

    return (
        $in_file
        && ( lc $in_file->basename =~ /$file_suffix\Z/ )
        && ( $in_file->size <= $max_file_size )
    );
}

true;