Merge branch 'devel'

lib/LIMS2/Model/Util/QCResults.pm

@@ -20,6 +20,7 @@ use Sub::Exporter -setup => {
 use Log::Log4perl qw( :easy );
 use Const::Fast;
 use Bio::SeqIO;
+use IO::String;
 use List::Util qw(sum);
 use List::MoreUtils qw(uniq);
 use LIMS2::Exception::Validation;
@@ -202,7 +203,7 @@ sub _validated_download_seq_params {
         $format =~ s/^\s+//;
         $format =~ s/\s+$//;
         $format = lc($format);
-        if ( $SUFFIX_FOR{$format} ) {
+        if ( exists $SUFFIX_FOR{$format} ) {
             $params{format} = $format;
         }
     }

lib/LIMS2/Test.pm

@@ -47,7 +47,15 @@ sub unauthenticated_mech {
 
 sub mech {
     my $mech = unauthenticated_mech();
-    $mech->credentials( $TEST_USER, $TEST_PASSWD );
+
+    $mech->get( '/login' );
+
+    $mech->submit_form(
+        form_name => 'login_form',
+        fields    => { username => $TEST_USER, password => $TEST_PASSWD },
+        button    => 'login'
+    );
+
     return $mech;
 }
 

lib/LIMS2/WebApp/Controller/API.pm

@@ -27,7 +27,11 @@ sub auto : Private {
     # further authentication, and provides an HTTP basic auth fallback
     # for programmatic access
     unless ( $c->user_exists ) {
-        $c->authenticate( { realm => 'LIMS2 API' }, 'basic' );
+        my $username = delete $c->req->parameters->{ 'username' };
+        my $password = delete $c->req->parameters->{ 'password' };
+        return 1 unless ( $username && $password );
+
+        $c->authenticate( { name => lc($username), password => $password, active => 1 } );
     }
 
     if ( ! $c->session->{selected_species} ) {

t/40-model-util-qcresults.t

@@ -0,0 +1,214 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings FATAL => 'all';
+
+BEGIN {
+    use Log::Log4perl qw( :easy );
+    Log::Log4perl->easy_init($FATAL);
+}
+
+use LIMS2::Test;
+use Test::Most;
+use Try::Tiny;
+use IO::File;
+
+BEGIN {
+    use_ok(
+        'LIMS2::Model::Util::QCResults', qw(
+            retrieve_qc_run_results
+            retrieve_qc_run_summary_results
+            retrieve_qc_run_seq_well_results
+            retrieve_qc_alignment_results
+            retrieve_qc_seq_read_sequences
+            retrieve_qc_eng_seq_sequence
+            build_qc_runs_search_params
+            )
+    );
+}
+
+note('Test retrieve_qc_run_results');
+{
+    ok my $qc_run = model->retrieve_qc_run( { id => '534EE22E-3DBF-22E4-5EF2-1234F5CB64C7' } ),
+        'retrieve qc run';
+
+    ok my $qc_run_results = retrieve_qc_run_results($qc_run), 'retrieve qc run results';
+
+    for my $result ( @{$qc_run_results} ) {
+        is $result->{LR_pass}, 1, 'result has correct LR pass value' if exists $result->{LR_pass};
+        is $result->{design_id}, 372441, 'result has correct design_id'
+            if exists $result->{design_id};
+        is $result->{plate_name}, 'PCS05036_A_1', 'result has correct plate name';
+    }
+
+}
+
+note('Test retrieve_qc_run_summary_results');
+{
+    ok my $qc_run = model->retrieve_qc_run( { id => '534EE22E-3DBF-22E4-5EF2-1234F5CB64C7' } ),
+        'retrieve qc run';
+
+    ok my $qc_run_summary_results = retrieve_qc_run_summary_results($qc_run),
+        'retrieve qc run summary results';
+    my $result = $qc_run_summary_results->[0];
+
+    is $result->{design_id},     372441, '.. correct design_id';
+    is $result->{valid_primers}, 'LR',   '.. correct valid primer';
+    is $result->{pass},          1,      '..correct pass level';
+
+}
+
+note('Test retrieve_qc_run_seq_well_results');
+{
+    ok my $seq_well = model->retrieve_qc_run_seq_well(
+        {   qc_run_id  => '534EE22E-3DBF-22E4-5EF2-1234F5CB64C7',
+            plate_name => 'PCS05036_A_1',
+            well_name  => 'B02',
+        }
+        ),
+        'retrieve qc run seq well';
+
+    ok my ( $seq_reads, $qc_seq_well_results ) = retrieve_qc_run_seq_well_results($seq_well),
+        'can retrieve qc run seq well results';
+
+    for my $seq_read ( @{$seq_reads} ) {
+        isa_ok $seq_read, 'LIMS2::Model::Schema::Result::QcSeqRead';
+    }
+
+    my $result = $qc_seq_well_results->[0];
+    is $result->{design_id}, 372441, '.. correct design id';
+    is $result->{score},     2605,   '.. correct score';
+    is $result->{pass},      0,      '.. correct pass value';
+
+    ok my $seq_well2 = model->retrieve_qc_run_seq_well(
+        {   qc_run_id  => '534EE22E-3DBF-22E4-5EF2-1234F5CB64C7',
+            plate_name => 'PCS05036_A_1',
+            well_name  => 'A01',
+        }
+        ),
+        'retrieve qc run seq well';
+
+    throws_ok {
+        retrieve_qc_run_seq_well_results($seq_well2);
+    }
+    'LIMS2::Exception::Validation', 'throws error if seq well has no seq reads';
+
+}
+
+note('Test retrieve_qc_alignment_results');
+{
+    ok my $qc_alignment = model->retrieve( 'QcAlignment' => { 'me.id' => 93 } ),
+        'retrieve qc alignment';
+
+    ok my $result = retrieve_qc_alignment_results( model->eng_seq_builder, $qc_alignment ),
+        'can retrieve qc alignment results';
+
+    is $result->{target}, '372441#L1L2_Bact_P#L3L4_pD223_DTA_T_spec', '.. correct target';
+    is $result->{query}, 'PCS05036_A_1b02.p1kLR', '.. correct query';
+
+}
+
+note('Test retrieve_qc_seq_read_sequences');
+{
+    ok my $seq_well = model->retrieve_qc_run_seq_well(
+        {   qc_run_id  => '534EE22E-3DBF-22E4-5EF2-1234F5CB64C7',
+            plate_name => 'PCS05036_A_1',
+            well_name  => 'B02',
+        }
+        ),
+        'retrieve qc run seq well';
+
+    ok my ( $filename, $seq ) = retrieve_qc_seq_read_sequences( $seq_well, 'fasta' ),
+        'can retrieve qc seq read sequences';
+
+    is $filename, 'seq_reads_PCS05036_A_1B02.fasta', '.. correct filename';
+    like $seq,    qr/>PCS05036_A_1b02\.p1kLR/,       '..seq looks correct';
+
+    ok my ( $other_filename, $other_seq ) = retrieve_qc_seq_read_sequences( $seq_well, 'blah' ),
+        'retrieve qc seq read sequences with invalid format';
+
+    is $other_filename, 'seq_reads_PCS05036_A_1B02.gbk', '.. defaults to genbank file';
+
+    ok my $seq_well2 = model->retrieve_qc_run_seq_well(
+        {   qc_run_id  => '534EE22E-3DBF-22E4-5EF2-1234F5CB64C7',
+            plate_name => 'PCS05036_A_1',
+            well_name  => 'A01',
+        }
+        ),
+        'retrieve qc run seq well';
+
+    throws_ok {
+        retrieve_qc_seq_read_sequences($seq_well2);
+    }
+    'LIMS2::Exception::Validation', 'throws error if seq well has no seq reads';
+}
+
+note('Test retrieve_qc_eng_seq_sequence');
+{
+    ok my $qc_test_result = model->retrieve( 'QcTestResult' => { id => 70 } ),
+        'can retrive qc test result';
+
+    ok my ( $filename, $seq )
+        = retrieve_qc_eng_seq_sequence( model->eng_seq_builder, $qc_test_result, 'fasta' ),
+        'can retrieve qc eng seq sequence';
+
+    is $filename, '372441#L1L2_Bact_P#L3L4_pD223_DTA_T_spec.fasta', '.. correct filename';
+    like $seq,    qr/>372441#L1L2_Bact_P#L3L4_pD223_DTA_T_spec/,    '..seq looks correct';
+
+    ok my ( $other_filename, $other_seq )
+        = retrieve_qc_eng_seq_sequence( model->eng_seq_builder, $qc_test_result ),
+        'retrieve qc seq read sequences with no format';
+
+    is $other_filename, '372441#L1L2_Bact_P#L3L4_pD223_DTA_T_spec.gbk',
+        '.. defaults to genbank file';
+}
+
+note('Test build_qc_runs_search_params');
+{
+
+    ok my $params_show_all
+        = build_qc_runs_search_params( { show_all => 1, species_id => 'Mouse' } ),
+        'can build qc runs search params';
+
+    is_deeply $params_show_all,
+        { 'me.upload_complete' => 't', 'qc_seq_project.species_id' => 'Mouse' },
+        '.. search params correct with show_all option set';
+
+    ok my $params_seq_project
+        = build_qc_runs_search_params( { sequencing_project => 1, species_id => 'Mouse' } ),
+        'can build qc runs search params';
+
+    is_deeply $params_seq_project,
+        {
+        'me.upload_complete'                    => 't',
+        'qc_seq_project.species_id'             => 'Mouse',
+        'qc_run_seq_projects.qc_seq_project_id' => 1
+        },
+        '.. search params correct with sequencing project specified';
+
+    ok my $params_template
+        = build_qc_runs_search_params( { template_plate => 'test', species_id => 'Mouse' } ),
+        'can build qc runs search params';
+
+    is_deeply $params_template,
+        {
+        'me.upload_complete'        => 't',
+        'qc_seq_project.species_id' => 'Mouse',
+        'qc_template.name'          => 'test'
+        },
+        '.. search params correct with template plate specified';
+
+    ok my $params_profile
+        = build_qc_runs_search_params( { profile => 'foo', species_id => 'Mouse' } ),
+        'can build qc runs search params';
+
+    is_deeply $params_profile,
+        {
+        'me.upload_complete'        => 't',
+        'qc_seq_project.species_id' => 'Mouse',
+        'me.profile'                => 'foo'
+        },
+        '.. search params correct with profile specified';
+}
+
+done_testing();

t/50-model-plugin-qc.t

@@ -158,4 +158,86 @@ throws_ok {
     model->delete_qc_template( { id => $id } )
 } qr/Template \d+ has been used in one or more QC runs, so cannot be deleted/;
 
+note( "Testing Qc Run Retrieval" );
+
+{
+    ok my ($qc_runs_data) = model->retrieve_qc_runs( { species => 'Mouse' } ),
+        'Can retrieve all qc runs';
+    is scalar( @{$qc_runs_data} ), 2, '.. we have 2 qc runs';
+
+    ok my ($qc_runs_profile_data)
+        = model->retrieve_qc_runs( { species => 'Mouse', profile => 'eucomm-post-cre' } ),
+        'Can retrieve all qc runs with specific profile';
+    is scalar( @{$qc_runs_profile_data} ), 1, '.. we have no qc runs with specfied profile';
+
+    ok my $qc_run = model->retrieve_qc_run( { id => '687EE35E-9DBF-11E1-8EF3-9484F3CB94C8'  } )
+        , 'can retrieve single Qc Run';
+}
+
+note ( 'Qc Run Seq Well Retrieval' );
+
+{
+    ok my $qc_seq_well = model->retrieve_qc_run_seq_well(
+        {   qc_run_id  => '687EE35E-9DBF-11E1-8EF3-9484F3CB94C8',
+            plate_name => 'PCS04026_A_1',
+            well_name  => 'B02'
+        }
+    ), 'can retrieve qc run seq well';
+
+    isa_ok $qc_seq_well, 'LIMS2::Model::Schema::Result::QcRunSeqWell';
+
+    is $qc_seq_well->qc_run_id, '687EE35E-9DBF-11E1-8EF3-9484F3CB94C8', '..seq well belongs to correct Qc Run';
+}
+
+note ( 'Qc Run Results Retrieval' );
+
+{
+    lives_ok {
+        model->qc_run_results( { qc_run_id => '687EE35E-9DBF-11E1-8EF3-9484F3CB94C8' } ),
+    } 'can retrieve Qc Run results';
+
+    lives_ok {
+        model->qc_run_summary_results( { qc_run_id => '687EE35E-9DBF-11E1-8EF3-9484F3CB94C8' } )
+    } 'can retrieve Qc Run summary results';
+
+    lives_ok {
+        model->qc_run_seq_well_results(
+            {   qc_run_id  => '687EE35E-9DBF-11E1-8EF3-9484F3CB94C8',
+                plate_name => 'PCS04026_A_1',
+                well_name  => 'B02'
+            }
+        )
+    } 'can retrieve qc run seq well results';
+
+    lives_ok {
+        model->qc_alignment_result( { qc_alignment_id => 93 } )
+    } 'can get qc alignment result';
+
+    lives_ok {
+        model->qc_seq_read_sequences(
+            {   qc_run_id  => '687EE35E-9DBF-11E1-8EF3-9484F3CB94C8',
+                plate_name => 'PCS04026_A_1',
+                well_name  => 'B02',
+                format     => 'fasta',
+            }
+        )
+    } 'can retrieve qc seq read sequences';
+
+    lives_ok {
+        model->qc_eng_seq_sequence(
+            {   format  => 'fasta',
+                qc_test_result_id => 70,
+            }
+        )
+    } 'can retrieve qc eng seq sequence';
+
+}
+
+note ( "Testing List Profiles" );
+
+{
+    ok my $profiles = model->list_profiles(), 'list_profiles ok';
+    is_deeply $profiles, [ 'eucomm-cre', 'eucomm-post-cre', 'test' ], '.. profile list is correct';
+}
+
 done_testing();

t/80-change_password.t

@@ -6,14 +6,7 @@ use warnings FATAL => 'all';
 use LIMS2::Test;
 use Test::Most;
 
-my $mech = unauthenticated_mech();
-
-$mech->get_ok( '/login' );
-ok $mech->submit_form(
-    form_name => 'login_form',
-    fields    => { username => 'test_user@example.org', password => 'ahdooS1e' },
-    button    => 'login'
-), 'Login with correct username and password';
+my $mech = mech();
 
 {
     note( "Don't specify new password" );

t/80-dna_status_upload.t

@@ -7,14 +7,7 @@ use LIMS2::Test;
 use Test::Most;
 use File::Temp ':seekable';
 
-my $mech = unauthenticated_mech();
-
-$mech->get_ok( '/login' );
-ok $mech->submit_form(
-    form_name => 'login_form',
-    fields    => { username => 'test_user@example.org', password => 'ahdooS1e' },
-    button    => 'login'
-), 'Login with correct username and password';
+my $mech = mech();
 
 {
     note( "No well data file set" );

t/80-plate_upload.t

@@ -7,14 +7,7 @@ use LIMS2::Test;
 use Test::Most;
 use File::Temp ':seekable';
 
-my $mech = unauthenticated_mech();
-
-$mech->get_ok( '/login' );
-ok $mech->submit_form(
-    form_name => 'login_form',
-    fields    => { username => 'test_user@example.org', password => 'ahdooS1e' },
-    button    => 'login'
-), 'Login with correct username and password';
+my $mech = mech();
 
 {
     note( "set undef process type" );