diff --git a/lib/LIMS2/AlleleRequest.pm b/lib/LIMS2/AlleleRequest.pm index f046810298..c11b0501ee 100644 --- a/lib/LIMS2/AlleleRequest.pm +++ b/lib/LIMS2/AlleleRequest.pm @@ -112,6 +112,21 @@ sub electroporation_wells { return @electroporation_wells; } +sub pick_wells { + my ( $self, $electroporation_wells, $plate_type ) = @_; + + my @pick_wells; + for my $ep_well ( @{$electroporation_wells} ) { + my $it = $ep_well->descendants->depth_first_traversal($ep_well, 'out'); + while ( my $well = $it->next ) { + push @pick_wells, $well + if $well->plate->type_id eq $plate_type; + } + } + + return @pick_wells; +} + __PACKAGE__->meta->make_immutable; 1; diff --git a/lib/LIMS2/AlleleRequest/DoubleTargeted.pm b/lib/LIMS2/AlleleRequest/DoubleTargeted.pm index b89df3df95..b3291c765b 100644 --- a/lib/LIMS2/AlleleRequest/DoubleTargeted.pm +++ b/lib/LIMS2/AlleleRequest/DoubleTargeted.pm @@ -41,6 +41,7 @@ has [ first_allele_vector_wells second_allele_vector_wells first_electroporation_wells second_electroporation_wells first_allele_dna_wells second_allele_dna_wells + first_allele_pick_wells second_allele_pick_wells ) ] => ( is => 'ro', @@ -107,6 +108,16 @@ sub _build_second_electroporation_wells { return \@intersection; } +sub _build_first_allele_pick_wells { + my $self = shift; + return [ $self->pick_wells( $self->first_electroporation_wells, 'EP_PICK' ) ]; +} + +sub _build_second_allele_pick_wells { + my $self = shift; + return [ $self->pick_wells( $self->second_electroporation_wells, 'SEP_PICK' ) ]; +} + __PACKAGE__->meta->make_immutable; 1; diff --git a/lib/LIMS2/AlleleRequest/SingleTargeted.pm b/lib/LIMS2/AlleleRequest/SingleTargeted.pm index 6754bff8c1..ba8de22d05 100644 --- a/lib/LIMS2/AlleleRequest/SingleTargeted.pm +++ b/lib/LIMS2/AlleleRequest/SingleTargeted.pm @@ -31,7 +31,12 @@ sub _build_gene_designs { return $self->_build_designs( $self->mutation_type ); } -has [ qw( allele_design_wells allele_vector_wells allele_electroporation_wells ) ] => ( +has [ + qw( allele_design_wells allele_vector_wells + allele_dna_wells allele_electroporation_wells + allele_pick_wells + ) +] => ( is => 'ro', isa => 'ArrayRef[LIMS2::Model::Schema::Result::Well]', init_arg => undef, @@ -48,6 +53,11 @@ sub _build_allele_vector_wells { return [ $self->final_vector_wells( $self->gene_design_wells, $self->cassette_function ) ]; } +sub _build_allele_dna_wells { + my $self = shift; + return [ $self->dna_wells( $self->allele_vector_wells ) ]; +} + sub _build_allele_electroporation_wells { my $self = shift; return [ $self->electroporation_wells( $self->gene_vector_wells, 'EP' ) ]; @@ -58,6 +68,12 @@ sub all_vector_wells { return [ @{$self->allele_vector_wells} ]; } +sub _build_allele_pick_wells { + my $self = shift; + return [ $self->pick_wells( $self->allele_electroporation_wells, 'EP_PICK' ) ]; +} + + __PACKAGE__->meta->make_immutable; 1; diff --git a/lib/LIMS2/Report/SponsorProgress.pm b/lib/LIMS2/Report/SponsorProgress.pm new file mode 100644 index 0000000000..32dbf10de9 --- /dev/null +++ b/lib/LIMS2/Report/SponsorProgress.pm @@ -0,0 +1,240 @@ +package LIMS2::Report::SponsorProgress; + +use Moose; +use DateTime; +use LIMS2::AlleleRequestFactory; +use JSON qw( decode_json ); +use Readonly; +use namespace::autoclean; + +extends qw( LIMS2::ReportGenerator ); + +Readonly my %REPORT_CATAGORIES => ( + genes => { + name => 'Targetted Genes', + order => 1, + validation => \&has_genes, + }, + vectors =>{ + name => 'Vectors', + order => 2, + well_type => 'allele_vector_wells' + }, + first_vectors => { + name => '1st Allele Vectors', + order => 3, + well_type => 'first_allele_vector_wells', + }, + second_vectors => { + name => '2nd Allele Vectors', + order => 4, + well_type => 'second_allele_vector_wells', + }, + dna => { + name => 'Valid DNA', + order => 5, + well_type => 'allele_dna_wells', + validation => \&has_valid_dna_wells, + }, + first_dna => { + name => '1st Allele Valid DNA', + order => 6, + well_type => 'first_allele_dna_wells', + validation => \&has_valid_dna_wells, + }, + second_dna => { + name => '2nd Allele Valid DNA', + order => 7, + well_type => 'second_allele_dna_wells', + validation => \&has_valid_dna_wells, + }, + ep => { + name => 'Electroporations', + order => 8, + well_type => 'allele_electroporation_wells', + }, + first_ep => { + name => '1st Allele Electroporations', + order => 9, + well_type => 'first_electroporation_wells', + }, + second_ep => { + name => '2nd Allele Electroporations', + order => 10, + well_type => 'second_electroporation_wells', + }, + clones => { + name => 'Clones', + order => 11, + well_type => 'allele_pick_wells', + validation => \&has_accepted_pick_wells, + }, + first_clones => { + name => '1st Allele Accepted Clones', + order => 12, + well_type => 'first_allele_pick_wells', + validation => \&has_accepted_pick_wells, + }, + second_clones => { + name => '2nd Allele Accepted Clones', + order => 13, + well_type => 'second_allele_pick_wells', + validation => \&has_accepted_pick_wells, + }, +); + +has species => ( + is => 'ro', + isa => 'Str', + required => 1 +); + +has '+param_names' => ( + default => sub { [ 'species' ] } +); + +has sponsors => ( + is => 'ro', + isa => 'ArrayRef', + lazy_build => 1, +); + +sub _build_sponsors { + my $self = shift; + + my @sponsors = $self->model->schema->resultset('Sponsor')->search( + { }, { order_by => { -asc => 'description' } } + ); + + return [ map{ $_->id } @sponsors ]; +} + +has sponsor_data => ( + is => 'ro', + isa => 'HashRef', + lazy_build => 1, +); + +sub _build_sponsor_data { + my $self = shift; + my %sponsor_data; + + my $arf = LIMS2::AlleleRequestFactory->new( model => $self->model, species => $self->species ); + + my $project_rs = $self->model->schema->resultset('Project')->search( {} ); + + while ( my $project = $project_rs->next ) { + $self->_find_project_wells( $project, $arf, \%sponsor_data ); + } + + return \%sponsor_data; +} + +sub _find_project_wells { + my ( $self, $project, $arf, $sponsor_data ) = @_; + + my $sponsor = $project->sponsor_id; + my $ar = $arf->allele_request( decode_json( $project->allele_request ) ); + + while ( my( $name, $catagory ) = each %REPORT_CATAGORIES ) { + my $well_type = $catagory->{well_type} || ''; + + if ( exists $catagory->{validation} ) { + $sponsor_data->{$name}{$sponsor}++ + if $catagory->{validation}->( $ar, $well_type ); + } + else { + $sponsor_data->{$name}{$sponsor}++ + if has_wells_of_type( $ar, $well_type ); + } + } + + return; +} + +override _build_name => sub { + my $self = shift; + + my $dt = DateTime->now(); + + return 'Sponsor Progress Report ' . $dt->ymd; +}; + +override _build_columns => sub { + my $self = shift; + + return [ + 'Stage', + @{ $self->sponsors } + ]; +}; + +override iterator => sub { + my ($self) = @_; + + my @sponsor_data; + + for my $catagory ( sort { $REPORT_CATAGORIES{$a}->{order} <=> $REPORT_CATAGORIES{$b}->{order} } + keys %REPORT_CATAGORIES ) + { + my $data = $self->sponsor_data->{$catagory}; + $data->{catagory} = $catagory; + push @sponsor_data, $data; + } + + my $result = shift @sponsor_data; + + return Iterator::Simple::iter( + sub { + return unless $result; + my @data = map{ $result->{$_} } @{ $self->sponsors }; + unshift @data, $REPORT_CATAGORIES{ $result->{catagory} }{name}; + + $result = shift @sponsor_data; + return \@data; + } + ); +}; + +sub has_genes { + my ( $ar ) = @_; + return $ar->gene_id ? 1 : 0; +} + +sub has_wells_of_type { + my ( $ar, $type ) = @_; + + return 0 unless $ar->can( $type ); + + return @{ $ar->$type } ? 1 : 0; +} + +sub has_valid_dna_wells{ + my ( $ar, $type ) = @_; + + return 0 unless $ar->can( $type ); + + for my $well ( @{ $ar->$type } ) { + return 1 if $well->well_dna_status; + } + + return 0; +} + +sub has_accepted_pick_wells { + my( $ar, $type ) = @_; + + return 0 unless $ar->can( $type ); + + for my $well ( @{ $ar->$type } ) { + return 1 if $well->accepted; + } + + return 0; +} + +__PACKAGE__->meta->make_immutable; + +1; + +__END__ diff --git a/lib/LIMS2/ReportGenerator.pm b/lib/LIMS2/ReportGenerator.pm index 43e52a957d..3f34a6133c 100644 --- a/lib/LIMS2/ReportGenerator.pm +++ b/lib/LIMS2/ReportGenerator.pm @@ -31,7 +31,7 @@ has model => ( has cache_ttl => ( is => 'ro', isa => 'Str', - default => '8 hours' + default => '22 hours' ); has param_names => ( diff --git a/lib/LIMS2/ReportGenerator/Plate.pm b/lib/LIMS2/ReportGenerator/Plate.pm index 420bf5286d..7fee573143 100644 --- a/lib/LIMS2/ReportGenerator/Plate.pm +++ b/lib/LIMS2/ReportGenerator/Plate.pm @@ -8,6 +8,7 @@ use MooseX::ClassAttribute; use LIMS2::Exception::Implementation; use Module::Pluggable::Object; use List::MoreUtils qw( uniq ); +use Try::Tiny; use namespace::autoclean; extends qw( LIMS2::ReportGenerator ); @@ -106,9 +107,13 @@ sub design_and_gene_cols { my $design = $well->design; my @gene_ids = uniq map { $_->gene_id } $design->genes; - my @gene_symbols = uniq map { - $self->model->retrieve_gene( { species => $self->species, search_term => $_ } )->{gene_symbol} - } @gene_ids; + my @gene_symbols; + try { + @gene_symbols = uniq map { + $self->model->retrieve_gene( { species => $self->species, search_term => $_ } )->{gene_symbol} + } @gene_ids; + }; + return ( $design->id, join( q{/}, @gene_ids ), join( q{/}, @gene_symbols ) ); } diff --git a/lib/LIMS2/ReportGenerator/ProductionDetail.pm b/lib/LIMS2/ReportGenerator/ProductionDetail.pm index 6877fa3bd3..5e4e4b3450 100644 --- a/lib/LIMS2/ReportGenerator/ProductionDetail.pm +++ b/lib/LIMS2/ReportGenerator/ProductionDetail.pm @@ -4,6 +4,7 @@ use Moose; use Iterator::Simple qw( iflatten imap iter igrep ); use LIMS2::Exception::Implementation; use LIMS2::AlleleRequestFactory; +use LIMS2::ReportGenerator::Plate; use JSON qw( decode_json ); use namespace::autoclean; diff --git a/lib/LIMS2/WebApp/Controller/User.pm b/lib/LIMS2/WebApp/Controller/User.pm index 669648193d..a3d7f43a07 100644 --- a/lib/LIMS2/WebApp/Controller/User.pm +++ b/lib/LIMS2/WebApp/Controller/User.pm @@ -1,5 +1,7 @@ package LIMS2::WebApp::Controller::User; use Moose; +use LIMS2::Report; +use Text::CSV; use namespace::autoclean; BEGIN {extends 'Catalyst::Controller'; } @@ -70,6 +72,31 @@ sub index :Path :Args(0) { $c->assert_user_roles( 'read' ); + my $species = $c->session->{selected_species}; + + my $report_id = LIMS2::Report::cached_report( + model => $c->model( 'Golgi' ), + report => 'SponsorProgress', + params => { species => $c->session->{selected_species} }, + ); + + my $status = LIMS2::Report::get_report_status( $report_id ); + + if ( $status eq 'DONE' ) { + my ( $report_name, $report_fh ) = LIMS2::Report::read_report_from_disk( $report_id ); + + my $csv = Text::CSV->new; + my $columns = $csv->getline( $report_fh ); + my $data = $csv->getline_all( $report_fh ); + + $c->stash( + report_id => $report_id, + title => $report_name, + columns => $columns, + data => $data, + ); + } + return; } diff --git a/root/site/user/index.tt b/root/site/user/index.tt index 126f309c23..459fe95d6b 100644 --- a/root/site/user/index.tt +++ b/root/site/user/index.tt @@ -9,60 +9,27 @@ tracking system.

-

Browse

+[% IF report_id %] - +

Pipeline Summary

-

View Reports

+ + + + [%- FOR col IN columns %] + + [%- END %] + + + + [%- FOR datum IN data %] + + [%- FOR val IN datum %] + + [%- END %] + + [%- END %] + +
[% col %]
[% val | none %]
- +[% END %]