# #=============================================================================== # # DESCRIPTION: rfc440L # A custom fish worklist based on test selection with a set of templates for # corresponding tests # TODO add a test for fgfr3_igh and fgfr3 to check they are not both selected # #=============================================================================== 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'; # 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 (?!.*.*&\#10004;) # no MARK after .* # 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 = ); 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'; # 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