Merge branch 'devel' into submit_qc

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;

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;

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;

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__

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 => (

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 ) );
 }

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;