#
#===============================================================================
#
# DESCRIPTION: rfc440L
# A custom fish worklist based on test selection with a set of templates for
# corresponding tests
#===============================================================================
use Modern::Perl;
use utf8;
use Test::WWW::Mechanize::CGIApp;
use Test::More; # tests => 6; # last test to print
use Data::Printer;
use List::Util 'first';
BEGIN {
require 't/test-lib.pl';
}
my $mech = get_mech();
do_login();
my $dbh;
eval { $dbh = get_dbh() or die 'no database handle recieved from get_dbh'; };
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 );
}
}
{
# 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 );
}
{
# lab_tests
#+----+-----------+-------------+----------------+-----------+-------------+-----------+
#| id | test_name | field_label | lab_section_id | test_type | has_results | is_active |
#+----+-----------+-------------+----------------+-----------+-------------+-----------+
#| 1 | pnh | PNH | 1 | panel | no | yes |
#+----+-----------+-------------+----------------+-----------+-------------+-----------+
my %args = (
test_name => 'he',
field_label => 'HE',
lab_section_id => 4,
test_type => 'test',
has_results => 'no',
is_active => 'yes',
);
$dbix->insert( 'lab_tests', \%args );
}
{
# 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 %args = (
request_id => 1,
lab_test_id => 10,
status_option_id => 1,
user_id => 1,
time => '2018-05-18 13:35:46',
);
$dbix->insert( 'request_lab_test_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 display:
{
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('/*');
is @testglob, 0, 'glob returns empty list';
$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 so we can check there are some templates installed
ok glob('/*'), 'glob function reenabled';
$mech->get('/local_worklist?function_name=fish_worksheets_custom')
; # print_and_exit();
SKIP: {
# if there are no templates then the html should explain this and then give up
my @templates = glob "templates/worklist/local/fish/templates/*";
if ( not @templates ) {
$mech->text_contains(
q(no FISH templates are installed),
'No templates warning displayed',
);
skip "no templates available to test";
}
#else do the rest of the tests
$mech->text_contains(
q(Print FISH custom worksheets),
'FISH function runs',
);
# 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'
);
TODO: {
local $TODO = 'things to do before it is fully tested';
# loads basic template
# select option
# submit
# non existant template (validation error handling)
$mech->submit_form(
form_name => 'fish_worksheets',
fields => { template => q{doesn't exist} },
);
$mech->content_contains( q{template doesn't exist},
q{template doesn't exist error displayed} );
$mech->back;
$mech->submit_form(
form_name => 'fish_worksheets',
fields => { template => 'myeloma_worksheet.tt' }
);
$mech->content_contains( 'Myeloma Worksheet',
'template contains header text' );
# contains header
# loads template adn includes labtests
# lab tests are in rows
# ticks match test columns
# test the lab_tests are put in the correct columns (more data required)
}
}
}
{
# 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/*')){
next 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
