view release on metacpan or  search on metacpan

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

        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',
            9 => 'blasttable',
        };
        my $format = $format_num_to_name->{$c->stash->{report_format}} || '';

        my $in = Bio::SearchIO->new(
                -format => $format,
                -file   => "$output_file",
        );

        die "Bio::SearchIO->new could not read $output_file" unless $in;

        my $hit_link = sub {
            my ($self, $hit) = @_;
            my $name = $hit->name;
            if (@ss_ids > 1) {
                my $sha1  = $c->stash->{composite_sha1};
                return qq{<a href="/api/sequence/sha1/$sha1/$name.fasta">$name</a>};
            } else {
                my $id = $ss_ids[0] || 1;
                return qq{<a href="/api/sequence/id/$id/$name.fasta">$name</a>};
            }
        };
        my $writer = Bio::SearchIO::Writer::HTMLResultWriter->new;
        $writer->start_report(sub {''});
        $writer->end_report(sub {''});
        $writer->hit_link_desc( $hit_link );
        $writer->hit_link_align( $hit_link );

        my $report = '';
        my $out = Bio::SearchIO->new(
            -writer => $writer,
            -fh     => IO::String->new( \$report ),
        );
        $out->write_result($in->next_result);

        # TODO: Fix this stuff upstream
        $report =~ s!\Q<CENTER><H1><a href="http://bioperl.org">Bioperl</a> Reformatted HTML of BLASTN Search Report<br> for </H1></CENTER>\E!!g;
        $report =~ s!<p><p><hr><h5>Produced by Bioperl .*\$</h5>!!gs;

        my $cached_report_file = $self->_temp_file( $c->stash->{job_id}.'.html' );
        my $report_html;

        mkdir $self->_app->config->{tmp_dir} unless -e $self->_app->config->{tmp_dir};

        # Bio::GMOD::Blast::Graph can only deal with plain blast reports
        if( $format eq 'blast' && $report =~ m/Sbjct: / ){
            my $graph_html = '';
            my $graph = Bio::GMOD::Blast::Graph->new(
                                            -outputfile => "$output_file",
                                            -format     => $format,
                                            -fh         => IO::String->new( \$graph_html ),
                                            -dstDir     => $self->_app->config->{tmp_dir} || "/tmp/mimosa",
                                            -dstURL     => "/graphics/",
                                            -imgName    => $c->stash->{job_id} . '.png',
                                            );
            $graph->showGraph;

            $report_html        = $graph_html . $report;
            $c->stash->{report} = $report_html;
        } elsif ($format eq 'blast') {
            # Don't show a report if there were no hits.
            # The user can always download the raw report if they want.
            # This is why we don't assign to $c->stash->{report}

            $report_html  = $report;
        } else {
            # The report format is not a plain blast, so just render
            # the HTML report with no images
            $report_html        = $report;
            $c->stash->{report} = $report_html;

        }
        $c->stash->{template} = 'report.mason';

        write_file( $cached_report_file, $report_html );
    }

}

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

    my $cached_report_file = $self->_temp_file( $c->stash->{job_id} . '.html' );
    if (-e $cached_report_file) {
        my $cached_report     = slurp($cached_report_file);
        $c->stash->{report}   = $cached_report;
        $c->stash->{template} = 'report.mason';
    } else {
            $c->stash->{error} = <<ERROR;
Could not find cached report file $cached_report_file !
ERROR
        $c->detach('/error');
    }

}

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

    my $sha1 =  sha1_hex freeze {
        params  => $c->req->parameters,
        uploads => $c->req->uploads,
        #TODO: add the user - user   => $c->user,
    };

    my $rs = $c->model('BCS')->resultset('Mimosa::Job');
    my $jobs = $rs->search( { sha1 => $sha1 } );
    if ($jobs->count == 0) { # not a duplicate job, proceed
        my $job = $rs->create({
            sha1       => $sha1,
            user       => $c->user_exists ? $c->user->get('username') : 'anonymous',
            start_time => DateTime->now(),
        });
        $c->stash->{job_id} = $job->mimosa_job_id();