#
#===============================================================================
#
#  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 cytocell_myc cytocell_cen8/) {
        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 'cytocell_myc' ) {
            $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:
SKIP: {
    skip 'Test only works on older perls' , 5 unless ($] <= 5.014001);
    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 =~ /&#10004;/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 =~ /&#10004;/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';

                # 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
abbott_bcl2
abbott_bcl6
abbott_fgfr3_igh
abbott_maf_igh
alpha11
alpha12
alpha17
alpha18
alpha3
alpha5
alpha6
alpha7
alpha8
atm
bcl1
bcl1_igh
bcl2
bcl2_igh
bcl3
bcl6
bcr_abl
ccnd2
cd274_pdcd1lg2
cdkn2c
cell_selection_quality
cks1b
cmyc
cmyc_igh
cytocell_12cen_cll
cytocell_2q11
cytocell_3q29
cytocell_5p15
cytocell_5q31_2
cytocell_5q32_q33_1
cytocell_7q22
cytocell_7q36
cytocell_atm
cytocell_bcl2
cytocell_bcl2_igh
cytocell_bcl6
cytocell_bcr_abl
cytocell_ccnd1
cytocell_ccnd1_igh
cytocell_cen11
cytocell_cen18
cytocell_cen6
cytocell_cen7
cytocell_cen8
cytocell_cen9
cytocell_e2a
cytocell_e2a_pbx1
cytocell_fgfr1
cytocell_jak2
cytocell_kmt2a
cytocell_malt1
cytocell_myc
cytocell_myc_igh
cytocell_myc_igk_igl
cytocell_pdgfra_fip1l1
cytocell_pdgfrb
cytocell_rel
dako_igh
dusp22_irf4
ebv_ish
etv6_runx1
fgfr3
fgfr3_igh
fish_abl1
fish_abl2
foxp1
h_and_e_fish
igh
igh_mafb
ig_kappa
ig_lambda
maf_igh
malt1
mecom
metasystems_myc
mll
p53
pax5
pdgfra_fip1l1
pml_rar_alpha
tcl1
tp63_3q28
11q
9p
alk_alcl
all_25_or_under
all_abl_fusions
all_over_25
christie_cll
christie_myeloma_fusion_1
christie_myeloma_fusion_2
christie_myeloma_screen
cll
cll_high_risk
cll_trial
dlbcl_burkitt
dlbcl_burkitt_fresh
dlbcl_cell_extended
dlbcl_cell_screen
dlbcl_extended_fresh
dlbcl_fl
dlbcl_fl_fresh
dlbcl_screen_fresh
emzl_pres
failed_mlpa
fish
hd_pmbl
mantle_cell
myeloma_138
myeloma_smears_only
myeloma_trial
plasma_cell_extended
plasma_cell_screen
pnh_myeloid