#
#===============================================================================
#
# DESCRIPTION: rfc442/443 changes to MLPA. No previous test for specific mlpa
# worklist
# Other worklists MLPA and MLPA Quantification
#===============================================================================
# test that the lab tests exist
# qw/myeloma pre_treatment_cll_p038 cd5_diagnostic_p037/;
use HMDS::Perl;
use Test::WWW::Mechanize::CGIApp;
use WWW::Mechanize::TreeBuilder;
use HTML::TreeBuilder::XPath; # findnodes()
use Test::Most; # tests => 6; # last test to print
use Data::Printer;
use Module::Find;
use LIMS::Local::LIMS;
BEGIN {
# set default to make script safe to run anywhere
$ENV{ROSEDB_DEVINIT} = 'config/rosedb_devinit_test.pl';
Module::Find::useall LIMS::DB;
}
require 't/test-lib.pl';
my $mech = get_mech();
WWW::Mechanize::TreeBuilder->meta->apply($mech);
my $cmyc_test_id; # keep track of test id so it can be removed in last test
do_login();
my $dbh;
lives_ok { $dbh = get_dbh() or die 'No database handle received from get_dbh'; }
'Database handle received';
#warn $@ if $@;
# setup database
# needs all the tests and lab_section adding to test database
my $section = LIMS::DB::LabSection->new(
section_name => 'Multiplex Ligation-dependent Probe Amplification',
has_result_summary => 'yes',
has_section_notes => 'no',
has_foreign_id => 'no',
has_results_import => 'no',
has_labels => 'no',
auto_expand => 'no',
is_active => 'no',
has_test_sign_out => 'yes'
);
$section->save;
die unless $section->db->database eq 'lims_test';
#insert panels
my @sample_types = (
{ specimen_type => 'biopsy - fixed' },
{ specimen_type => 'biopsy - unfixed' },
{ specimen_type => 'liquid' },
);
my $myeloma_panel = LIMS::DB::LabTest->new(
test_type => 'panel',
test_name => 'myeloma',
field_label => 'Myeloma',
lab_section => $section,
has_results => 'no',
is_active => 'yes',
);
$myeloma_panel->sample_types(@sample_types);
$myeloma_panel->save();
my $cll_panel = LIMS::DB::LabTest->new(
test_type => 'panel',
test_name => 'cd5_diagnostic_p037',
field_label => 'CD5+ diagnostic (P037)',
lab_section => $section,
has_results => 'no',
is_active => 'yes'
);
$cll_panel->sample_types(@sample_types);
$cll_panel->save();
my $cd5_panel = LIMS::DB::LabTest->new(
test_type => 'panel',
test_name => 'pre_treatment_cll_p038',
field_label => 'Pre-treatment CLL (P038)',
lab_section => $section,
has_results => 'no',
is_active => 'yes'
);
$cd5_panel->sample_types(@sample_types);
$cd5_panel->save();
# get lab_section
my $mol_section = (
LIMS::DB::LabSection::Manager->get_lab_sections(
query => [ section_name => 'Molecular', ]
)
)->[0]
or die "Can't find Molecular section?!?!?";
# rename test
my $quant_selected = LIMS::DB::LabTest->new(
test_type => 'test',
lab_section => $mol_section,
test_name => 'quantification_selected',
field_label => 'Quantification (selected)',
is_active => 'yes'
);
$quant_selected->save();
# get ref to DNA quantification test
my $quant_unselected = LIMS::DB::LabTest->new(
test_type => 'test',
lab_section => $mol_section,
field_label => 'DNA quantification',
test_name => 'dna_quantification',
is_active => 'yes'
);
$quant_unselected->save();
my $dna_ext = LIMS::DB::LabTest->new(
test_type => 'test',
lab_section => $mol_section,
field_label => 'DNA extraction',
test_name => 'dna_extraction',
is_active => 'yes'
);
$dna_ext->save();
my $cd138_dna = LIMS::DB::LabTest->new(
test_type => 'test',
lab_section => $mol_section,
field_label => 'CD138+ DNA',
test_name => 'cd138_dna',
is_active => 'yes'
);
$cd138_dna->save();
# $quant_unselected->save();
# RFC link the tests
my $link = LIMS::DB::LinkedLabTest->new(
parent_lab_test => $myeloma_panel,
linked_lab_test => $quant_selected,
);
$link = LIMS::DB::LinkedLabTest->new(
parent_lab_test => $cd5_panel,
linked_lab_test => $quant_unselected,
);
$link = LIMS::DB::LinkedLabTest->new(
parent_lab_test => $cll_panel,
linked_lab_test => $quant_unselected,
);
# then needs some requests with tests requested
my $requests = LIMS::DB::Request::Manager->get_requests();
for (@$requests) {
# panel
my $request_lab_test = LIMS::DB::RequestLabTestStatus->new(
request => $_,
lab_test => $myeloma_panel,
user_id => 1,
status_option_id => 1,
);
$request_lab_test->save();
# quantification
$request_lab_test = LIMS::DB::RequestLabTestStatus->new(
request => $_,
lab_test => $quant_selected,
user_id => 1,
status_option_id => 1,
);
$request_lab_test->save();
# extraction
$request_lab_test = LIMS::DB::RequestLabTestStatus->new(
request => $_,
lab_test => $cd138_dna,
user_id => 1,
status_option_id => 1,
);
$request_lab_test->save();
}
{
# test 1
# are there 3 requests, all disabled in mlpa worklist
$mech->get_ok( '/local_worklist?function_name=mlpa', 'get worksheet' )
; # print_and_exit;
$mech->content_contains( 'MLPA Worksheet Select',
'loaded mlpa worksheet select page' )
; # print_and_exit();
$mech->text_like( qr/QUANTIFICATION_SELECTED/,
'2 requests showing in worksheet' ); # print_and_exit();
$mech->content_like(
qr/request_specimen"\s+value="[^"]*"\s+disabled="disabled"/msx,
'disabled' ); # print_and_exit();
my $res = () = $mech->content =~
/request_specimen"\s+value="[^"]*"\s+disabled="disabled"/gmsx;
is( $res, 3, 'All 3 disabled' ); # print_and_exit();
}
{
# test 2 - worklist should show some selectable rows now
my $status =
LIMS::DB::LabTestStatusOption->new( description => 'complete' );
$status->load;
# get all the quant_selected tests from rlts
my $request_lab_test =
LIMS::DB::RequestLabTestStatus::Manager->get_request_lab_test_status(
query => [ 'lab_test.test_name' => 'quantification_selected' ],
require_objects => 'lab_test'
);
pop @$request_lab_test; # discard one entry so it remains disabled
# set the rest to complete so they show up in the worklist
for (@$request_lab_test) {
$_->status($status);
$_->save();
}
# are there 3 requests, 1 disabled in mlpa worklist
$mech->get_ok( '/local_worklist?function_name=mlpa', 'get worksheet' )
; # print_and_exit();
$mech->content_contains( 'MLPA Worksheet Select',
'loaded mlpa worksheet select page' )
; # print_and_exit();
$mech->text_like( qr/QUANTIFICATION_SELECTED/,
'2 requests showing in worksheet' ); # print_and_exit();
$mech->content_like(
qr/request_specimen"\s+value="[^"]*"\s+disabled="disabled"/msx,
'disabled' ); # print_and_exit();
my $res = () = $mech->content =~
/request_specimen"\s+value="[^"]*"\s+disabled="disabled"/gmsx;
is( $res, 1, 'just 1 disabled' ); # print_and_exit();
}
#TODO test next page
# select all then submit
# test that there are 2 rows in output
#[$mech->forms->[0]->inputs]->[0]->check;
for my $input ($mech->forms->[0]->inputs){
if ($input->type eq 'checkbox'){$input->check();}
}
$mech->submit; #print_and_exit();
{
# only the correct rows set the index column class to index
my @nodes = $mech->tree->findnodes( q!//table[@id='pcrWorksheet']/tbody/tr/td[@class='index']! ); # ddp @nodes;
is( @nodes, 2, 'two rows in output table' );
# my $expr = '\[0\]'; # naf method but works!
# my $c = () = $mech->text =~ /$expr/g;
# is( $c, 2, 'OK: expected delta values detected' );
} # print_and_exit();
done_testing();
__END__
# needs mlpa section and panels adding to test
#clone_and_reset?
my $dbix = get_dbix();
for my $request_id ( 1, 2 ) {
for my $lab_test_id ( 1 .. 5 ) {
my %args = (
request_id => $request_id,
lab_test_id => $lab_test_id,
user_id => 1,
status_option_id => 1,
);
$dbix->insert( 'request_lab_test_status', \%args );
}
}
my $fish_section_id;
{
# lab section fish
my %args = (
section_name => 'FISH',
has_result_summary => 'yes',
has_section_notes => 'yes',
has_test_sign_out => 'no',
has_foreign_id => 'yes',
has_results_import => 'no',
has_labels => 'no',
auto_expand => 'no',
is_active => 'yes',
);
$dbix->insert( 'lab_sections', \%args );
$fish_section_id = $dbh->last_insert_id( undef, undef, undef, undef );
}
{
# lab_tests
#+----+-----------+-------------+----------------+-----------+-------------+-----------+
#| id | test_name | field_label | lab_section_id | test_type | has_results | is_active |
#+----+-----------+-------------+----------------+-----------+-------------+-----------+
#| 1 | pnh | PNH | 1 | panel | no | yes |
#+----+-----------+-------------+----------------+-----------+-------------+-----------+
#MYELOMA WORKSHEET
#col#1
# cdkn2c
# cks1b
#col#5
# cmyc
#
foreach (qw/he cdkn2c cks1b cmyc/) {
my %args = (
test_name => $_,
field_label => uc,
lab_section_id => $fish_section_id,
test_type => 'test',
has_results => 'no',
is_active => 'yes',
);
$dbix->insert( 'lab_tests', \%args );
my $fish_test_id = $dbh->last_insert_id( undef, undef, undef, undef );
if ( $_ eq 'cmyc' ) {
$cmyc_test_id = $fish_test_id; # for later test
}
# request_lab_test_status fish
#+----+------------+-------------+------------------+---------+---------------------+
#| id | request_id | lab_test_id | status_option_id | user_id | time |
#+----+------------+-------------+------------------+---------+---------------------+
#| 1 | 1 | 1 | 1 | 1 | 2018-05-18 13:35:46 |
#+----+------------+-------------+------------------+---------+---------------------+
my %status_args = (
request_id => 1,
lab_test_id => $fish_test_id,
status_option_id => 1,
user_id => 1,
# time => '2018-05-18 13:35:46',
);
$dbix->insert( 'request_lab_test_status', \%status_args );
}
}
# test that the menu item is in local worklists section
# test that selecting it returns the first page
$mech->get_ok('/worklist'); # print_and_exit();
$mech->content_like( qr{Other worklists:}, 'Loaded worklists page', );
$mech->content_contains( q(fish_worksheets_custom),
'Worklists yml configured for fish_worksheets_custom',
);
# test worklist displays fish custom worklist:
{
ok $mech->form_name('others'), 'Others formname is in page';
ok $mech->select( function_name => 'fish_worksheets_custom' ),
'custom worksheet is listed';
# force error message by making it look like there are no templates in
# local/fish/templates/*.tt
# ok glob('/*'), 'glob doesnt returns empty list';
no warnings 'redefine';
local *CORE::GLOBAL::glob = sub { return (); };
my @testglob = glob q{/*};
is @testglob, 0, 'glob disabled for test';
$mech->get('/local_worklist?function_name=fish_worksheets_custom')
; #print_and_exit();
$mech->text_contains(
q(no FISH templates are installed),
'FISH function doesnt run when there are no templates',
);
}
{
# reset glob (out of scope) so we can check there are some templates installed
ok glob(q{/*}), 'glob function reenabled';
$mech->get('/local_worklist?function_name=fish_worksheets_custom')
; # print_and_exit();
# if there are no templates then the html should explain this and then give up
my @templates = glob 'templates/worklist/local/fish/templates/*';
ok( scalar @templates,
'templates available in templates/worklist/local/fish/templates' );
$mech->text_contains(
q(Print FISH custom worksheets),
'FISH custom worksheet page displays',
);
# get list of templates from filesystem
$mech->content_contains(
q(Select worksheet template),
'Template selector displayed',
);
my $template_form = $mech->form_name('fish_worksheets');
my @options = $template_form->find_input('^template');
# check the template options match the directory listing
# +1 because there is a dummy option '---' in select widget
is(
1 + scalar @templates,
scalar @{ $options[0]->{menu} },
'all templates displayed in form'
);
# loads basic template
# select option
# submit
# non existant template (validation error handling)
# $DB::single = 1;
$mech->submit_form(
form_name => 'fish_worksheets',
fields => { template => q{doesntexist}, request_id => 1234 },
); #print_and_exit();
$mech->content_contains(
#q{template doesn't exist},
q(Print FISH custom worksheets),
q{template doesn't exist so redisplay form}
); # should really use formvalidation
$mech->back;
$mech->submit_form(
form_name => 'fish_worksheets',
fields => { template => 'MYELOMA.tt', request_id => 1 }
);
$mech->content_contains( 'MYELOMA Worksheet',
'template contains header text' );
# print_and_exit();
my @mark_count = $mech->content =~ /✔/gms;
is( scalar @mark_count, 2, ' 2 probes ticked (✔)' );
$mech->content_like(
qr{
&\#10004; # MARK
(?!.*<tr>.*&\#10004;) # no MARK after <tr>
.* # stuff
&\#10004; # MARK
}msx,
'Both MARKS on same table row'
);
# cmyc test complete already
$dbix->update(
'request_lab_test_status',
{ status_option_id => 2 },
{ lab_test_id => $cmyc_test_id }
);
# $dbix->delete('request_lab_test_status', {lab_test_id => $cmyc_test_id});
$mech->back;
$mech->reload();
$mech->submit_form(
form_name => 'fish_worksheets',
fields => { template => 'MYELOMA.tt', request_id => 1 }
);
$mech->content_contains( 'MYELOMA Worksheet',
'template contains header text' );
@mark_count = $mech->content =~ /✔/gms;
is( scalar @mark_count, 1, ' 1 probe ticked (✔)' );
# print_and_exit();
}
{
# check all templates are valid
chomp( my @fish_tests = <DATA> );
close DATA;
# use Data::Printer;
# p \@fish_tests;
use Template;
my $tt = Template->new( POST_PROCESS => 't/lib/dumper.tt', STRICT => 1 );
foreach
my $template_file ( glob 'templates/worklist/local/fish/templates/*' )
{
subtest $template_file => sub {
return
if not ok $tt->process( $template_file, {}, \my $out ),
"Processed $template_file";
my $test_data = eval $out;
foreach my $col ( @{$test_data} ) {
# test basic syntax
ok exists $col->{label}, 'Has a label';
ok exists $col->{tests}, 'Has tests';
is scalar keys %{$col}, 2, 'Two keys per column';
# test all fishtests are valid
foreach my $test ( @{ $col->{tests} } ) {
ok grep( { $test eq $_ } @fish_tests ),
"$test is valid fish test";
}
}
}
}
}
=for comment
# if fish tests change then regen this list
~$ echo "select t.test_name from lab_tests t \
join lab_sections s on t.lab_section_id = s.id and \
s.section_name = 'FISH';" \
| mysql -h 127.0.0.1 -D hilis4_clone -u root -p \
>> ~/apps/HILIS4/t/local/worklist_fish_custom.t
=cut
__DATA__
