view release on metacpan or  search on metacpan

lib/App/Mimosa/Controller/Root.pm  view on Meta::CPAN

    $c->forward('login');

    my $jobs = $c->model('BCS')->resultset('Mimosa::Job');
    my $rs   = $jobs->search({ mimosa_job_id => $job_id });
    if ($rs->count) {
        my $job = $rs->single;
        $c->stash->{job} = $job;
        my $output_file = $self->_temp_file( "$job_id.out.blast" );
        $c->serve_static_file( $output_file );
    } else {
        $c->stash->{error} = 'Sorry, that raw report does not exist';
        $c->detach('/input_error');
    }
}

sub download_report :Path("/api/report/html") :Args(1) {
    my ( $self, $c, $job_id ) = @_;

    $c->forward('login');

    my $jobs = $c->model('BCS')->resultset('Mimosa::Job');
    my $rs   = $jobs->search({ mimosa_job_id => $job_id });
    if ($rs->count) {
        my $job = $rs->single;
        $c->stash->{job} = $job;
        my $cached_report = $self->_temp_file( "$job_id.html" );
        if ( !-e $cached_report ) {
            warn "Cached file not found!";
        }
        $c->stash->{job_id} = $job_id;
        $c->stash->{report} = slurp($cached_report);
        $c->stash->{template} = 'report.mason';
    } else {
        $c->stash->{error} = 'Sorry, that HTML report does not exist';
        $c->detach('/input_error');
    }
}

sub graphics :Path("/graphics") :Args(1) {
    my ($self, $c, $filename) = @_;

    my $graphic = catfile($self->_app->config->{tmp_dir},$filename);
    if (-e $graphic) {
        $c->serve_static_file($graphic);
    } else {
        $c->stash->{error} = 'That graphic does not exist';
        $c->detach('/input_error');
    }
}

sub _temp_file {
    my $self = shift;
    my $tmp_base = dir( $self->_app->config->{tmp_dir} );
    $tmp_base->mkpath unless -d $tmp_base;
    my $file = $tmp_base->file( @_ );

    return "$file";
}

sub validate : Private {
    my ( $self, $c ) = @_;

    if( $c->req->param('program') eq 'none' ) {
        $c->stash->{error} = "You must select a BLAST program to generate your report with.";
        $c->detach('/input_error');
    }

    my $min_length = $self->_app->config->{min_sequence_input_length};
    my $program    = $c->req->param('program');

    my $cwd               = getcwd;
    my $seq_root          = $self->_app->config->{sequence_data_dir} || catdir(qw/examples data/);
    # TODO: this only works on unixy systems
    $c->stash->{seq_root} = ($seq_root =~ m!^/! ? $seq_root : catfile($cwd, $seq_root) );
    $c->log->debug("Setting sequence root to " . $c->stash->{seq_root});

    my $i = Bio::SeqIO->new(
        -format   => 'fasta',
        -file     => $c->stash->{input_file},
    );
    while ( my $s = $i->next_seq ) {
        unless (length($s->seq()) >= $min_length) {
            $c->stash->{error} = "Sequence input too short. Must have a length of at least $min_length";
            $c->detach('/input_error');
        }
        $c->stash->{sequence} = $s;
        $c->stash->{program}  = $program;
        $c->forward('validate_sequence');
    }
}

sub validate_sequence : Private {
    my ($self, $c) = @_;
    my $sequence = $c->stash->{sequence};
    my $program  = $c->stash->{program};

    try {
        $sequence->validate_seq();
    } catch {
        $c->stash->{error} = "Sequence is not a valid BioPerl sequence";
        $c->detach('/input_error');
    };

    unless ($program) {
        $c->stash->{error} = "Invalid program";
        $c->detach('/input_error');
    }

    my %validate   = (
        blastn  => qr/^([ACGTURYKMSWBDHVN]+)$/i,
        tblastx => qr/^([GAVLIPFYCMHKRWSTDENQBZ\.X\*]+)$/i,
        tblastn => qr/^([GAVLIPFYCMHKRWSTDENQBZ\.X\*]+)$/i,
    );
    my $seq = $sequence->seq();
    unless ($seq =~ $validate{$program}){
        my $encseq = encode_entities($seq);
        $c->stash->{error} = "Sequence $encseq contains illegal characters for $program";
        $c->detach('/input_error');
    }

}

sub compose_sequence_sets : Private {
    my ( $self, $c) = @_;
    my (@ss_ids)       = sort @{ $c->stash->{sequence_set_ids} };
    my $rs             = $c->model('BCS')->resultset('Mimosa::SequenceSet');
    my $seq_root       = $c->stash->{seq_root};
    my $composite_sha1 = "";
    my $composite_fasta= '';
    my $alphabet;

    for my $ss_id (grep { $_ } @ss_ids) {
        my $search = $rs->search({ 'mimosa_sequence_set_id' =>  $ss_id });

        # we are guaranteed by unique constraints to only get one
        my $ss = $search->single;
        unless ($ss) {
            $c->stash->{error} = "Invalid mimosa_sequence_set_id";
            $c->detach('/input_error');
        }
        my $ss_name     = $ss->shortname();
        $alphabet       = $ss->alphabet();

        # SHA1's are null until the first time we are asked to align against
        # the sequence set.
        my $cached_sha1 = $ss->sha1;

        if ($cached_sha1) {
            $c->log->debug("Found cached sha1 $cached_sha1");
        }

        die "Can't read sequence set FASTA $seq_root/$ss_name : $!" unless -e "$seq_root/$ss_name";
        $c->log->debug("reading in $seq_root/$ss_name");

        my $fasta = slurp("$seq_root/$ss_name");

        $composite_fasta  .= $fasta;
        my $sha1           = sha1_hex($fasta);

        $c->log->debug("found $ss_id with sha1 $sha1");

        # Make sure our cached sha1 is up-to-date
        if ($sha1 ne $cached_sha1) {
            $c->log->debug("updating stale sha1 value for $seq_root/$ss_name to $sha1 from $cached_sha1");
            $search->update({ sha1 => $sha1 });
        }
        $c->log->debug("sha1 of $ss_name = $sha1");

        $composite_sha1   .= $sha1;
        $c->log->debug("updating $ss_id to $sha1");
        $search->update({ sha1 => $sha1 });

    }
    $composite_sha1 = sha1_hex($composite_sha1);
    $c->log->debug("computed composite sha1 $composite_sha1");

lib/App/Mimosa/Controller/Root.pm  view on Meta::CPAN

        print $fh $composite_fasta;
        close $fh;

        $c->log->debug("creating mimosa db with db_basename=$db_basename");
        App::Mimosa::Database->new(
            context     => $c,
            alphabet    => $alphabet,
            db_basename => $db_basename,
        )->index;
    }
    $c->stash->{composite_sha1}    = $composite_sha1;
    $c->stash->{composite_db_name} = ".mimosa_cache_$composite_sha1";
    $c->stash->{alphabet}          = $alphabet;
}

sub submit :Path('/submit') :Args(0) {
    my ( $self, $c ) = @_;

    $c->forward('login');

    my $ids            = $c->req->param('mimosa_sequence_set_ids') || '';
    my $alignment_view = $c->req->param('alignment_view') || '0';

    unless( $ids ) {
        $c->stash->{error} = "You must select at least one Mimosa sequence set.";
        $c->detach('/input_error');
    }

    $c->forward('make_job_id');

    my $input_file  = $self->_temp_file( $c->stash->{job_id}.'.in.fasta'  );
    my $output_file = $self->_temp_file( $c->stash->{job_id}.'.out.blast' );

    $c->stash->{input_file} = $input_file;

    # If we accepted a POSTed sequence as input, it will be HTML encoded
    my $sequence = decode_entities($c->req->param('sequence'));

    # if the user specified a file as their sequence input, read it in
    if( $c->req->param('sequence_input_file') ) {
        my ($upload) = $c->req->upload('sequence_input_file');
        $sequence  = $upload->slurp if $upload;
    }

    # if there is no defline, create one
    unless ($sequence =~ m/^>/) {
        $sequence = ">web user sequence\n$sequence";
    }
    $c->stash->{sequence} = $sequence;

    write_file $input_file, $sequence;

    # we create a file to keep track of what kind raw report format is being generated,
    # so later on we can tell Bio::SearchIO which format to parse

    $c->stash->{report_format} = $alignment_view;

    # prevent race conditions
    stat $input_file;

    $c->forward('validate');

    my @ss_ids;

    if ($ids =~ m/,/){
        (@ss_ids) = split /,/, $ids;
    } else {
        @ss_ids = ($ids);
    }
    $c->stash->{sequence_set_ids} = [ @ss_ids ];
    my $db_basename;

    if( @ss_ids > 1 ) {
        $c->forward('compose_sequence_sets');
        $db_basename = catfile($c->stash->{seq_root}, $c->stash->{composite_db_name});
    } elsif( @ss_ids == 1) {
        my $rs       = $c->model('BCS')->resultset('Mimosa::SequenceSet');
        my ($ss)     = $rs->search({ 'mimosa_sequence_set_id' =>  $ss_ids[0] })->single;
        $db_basename = catfile($c->stash->{seq_root}, $ss->shortname);
    } else {
        $c->stash->{error} = "The value " . encode_entities($ids) . " does not match any sequence sets";
        $c->detach('/input_error');
    }

    my $j = App::Mimosa::Job->new(
        context                => $c,
        timeout                => $self->_app->config->{job_runtime_max} || 5,
        job_id                 => $c->stash->{job_id},
        config                 => $self->_app->config,
        # force stringification to avoid arcane broken magic at a distance
        db_basename            => "$db_basename",
        # TODO: fix this properly
        alphabet               => $c->stash->{alphabet} || 'nucleotide',
        output_file            => "$output_file",
        input_file             => "$input_file",
        alignment_view         => $alignment_view,
            map { $_ => $c->req->param($_) || '' }
            qw/ program maxhits output_graphs evalue matrix /,
    );

    # Regardless of it working, the job is now complete
    my $rs   = $c->model('BCS')->resultset('Mimosa::Job');
    $rs->search( { mimosa_job_id => $j->job_id } )->update( { end_time => DateTime->now } );

    my $error = $j->run;
    if ($error) {
        ( $c->stash->{error} = $error ) =~ s!\n!<br />!g;
        $c->detach( $error =~ /Could not calculate ungapped/i ? '/input_error' : '/error' );
    } else {

        # stat the output file before opening it in hopes of avoiding
        # some kind of bizarre race condition i've been seeing in
        # which the file doesn't appear to be visible yet to the web
        # process after blast exits.
        stat $output_file;

        # these are the only formats we can parse and generate an HTML report for
        my $format_num_to_name = {
            0 => 'blast',
            7 => 'blastxml',
            8 => 'blasttable',