#
#===============================================================================
#
# DESCRIPTION: rfc440L
# A custom fish worklist based on test selection with a set of templates for
# corresponding tests
#===============================================================================
use HMDS::Perl;
use Test::WWW::Mechanize::CGIApp;
use Test::Most; # tests => 6; # last test to print
use Data::Printer;
require 't/test-lib.pl';
my $mech = get_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'; } 'Dataase handle recieved';
#warn $@ if $@;
# setup database
# need requests-lab_tests to satisfy get_outstanding_nivestigations
# e.g. FISH section and not complete
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';
# 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";
}
}
}
}
}
done_testing();
=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__
11q23
11q24
13q14
13q14_dleu7
13q14_rb
13q34
5q31
6q21
7q31
alpha11
alpha12
alpha17
alpha18
alpha3
alpha5
alpha6
alpha7
alpha8
atm
bcl1
bcl1_igh
bcl2
bcl2_igh
bcl3
bcl6
bcr_abl
ccnd2
cdkn2c
cell_selection_quality
cks1b
cmyc
cmyc_igh
dusp22_irf4
ebv_ish
fgfr3
fgfr3_igh
foxp1
h_and_e_fish
igh
igh_mafb
ig_kappa
ig_lambda
maf_igh
malt1
mecom
mll
p53
pax5
pdgfra_fip1l1
pml_rar_alpha
tcl1
tp63_6p25
11q
alk_alcl
christie_cll
christie_myeloma_fusion_1
christie_myeloma_fusion_2
christie_myeloma_screen
cll
cll_high_risk
cll_trial
dlbcl_burkitt
dlbcl_cell_extended
dlbcl_cell_screen
dlbcl_fl
emzl_pres
failed_mlpa
fish
mantle_cell
myeloma_138
myeloma_smears_only
myeloma_trial
plasma_cell_extended
plasma_cell_screen
pnh_myeloid
