use strict;

# requires case to be reported, with diagnoses in lymphoid category
# also requires sql.lib file with 3 sql queries required by PrognosticIndicator

#------------------------------------------------------------------
package PrognosticIndicator; 
# provides necessary env for M::HMRN::PrognosticIndicator

use lib 'lib';
use LIMS::Local::QueryLibrary; # loads 'private' sql src file so can't use M::Roles::Query
use Moose;
with (
	'LIMS::Model::Roles::DBIxSimple', # provides lims_dbix() for M::HMRN::PrognosticIndicator
	'LIMS::Model::HMRN::PrognosticIndicator',
);
has _patient_id => ( is => 'rw', isa => 'Int'); 
has sql_lib     => ( is => 'ro', isa => 'LIMS::Local::QueryLibrary', lazy_build => 1 );

sub patient_id { return shift->_patient_id }

sub _build_sql_lib {
    my $sql_lib = new LIMS::Local::QueryLibrary( { lib => 't/local.sql' } );
    return $sql_lib;
}

1;
#------------------------------------------------------------------

package main;

use Test::Builder::Tester;

use Data::Dumper;

use strict;
use warnings;

use Test::More tests => 39;
# use Test::More 'no_plan';

BEGIN {
    require 't/test-lib.pl';
}

our ($result);

my $dbix = get_dbix(); 

my $o = PrognosticIndicator->new(); # warn Dumper $o;

# rebuild tables:
my $sql = $o->sql_lib->retr('hmrn_rebuild_tables'); # warn Dumper $sql;
$sql =~ s/\n//g; # remove new-lines
my @tbls = split ';', $sql;
$dbix->dbh->do($_) for @tbls; # warn Dumper $_ for (split ";\n", $sql);

my @site_opts = (
    [ 'mesenteric', 'lower_nodal' ], # 1
    [ 'spleen',     'lower_nodal' ], # 2
    [ 'mediastinal','upper_nodal' ], # 3
    [ 'waldeyer',   'upper_nodal' ], # 4
    [ 'thymus',     'upper_nodal' ], # 5
    [ 'cns',        'extranodal'  ], # 6
    [ 'git',        'extranodal'  ], # 7
    [ 'marrow',     'extranodal'  ], # 8
    [ 'bulky',      'flag'        ], # 9
);

# populate tables:
_populate_tables();

# some default data; tested params =
# ldh, ecog, ct(scan), sweats, wt_loss, fever, extramedullary (sites hashref)
# albumin, lymphs, wbc, hb, plts
my %data = (
	lymphoid => {
        wbc 	=> 10.2,
        ecog 	=> 1,
        plts 	=> 317,
        wt_loss => 'N',
        fever 	=> 'N',
        sweats 	=> 'Y',
        ct 		=> 'Y', # required by almost all
        albumin => 41,
        hb 		=> 12.7,
        ldh 	=> 'normal',
        lymphs 	=> 5.0,
    },
    site_opts => { 6 => 1 }, # just cns
	imaging_opts => { $dbix->select('imaging_options',
		[ qw(id description option_type) ])->map_hashes('id') },
); # warn Dumper \%data;

{ # Ann Arbour:
    _change_diagnosis('FCL'); # change request #1 diagnosis
 
    # default data
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ann_arbor}, 'IEB'); # warn Dumper $result;
    
    # remove B-symptoms:
    local $data{lymphoid}{sweats} = 'N'; 
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ann_arbor}, 'IE'); # warn Dumper $result;
    
    # remove all extramedullary involvement:
    local $data{site_opts} = {};
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ann_arbor}, 'I'); # warn Dumper $result;
    
    # add 2 upper-nodal groups:
    local $data{site_opts}{5} = 1; # thymus
    local $data{site_opts}{4} = 1; # waldeyer
    $result = _get_prognostic_indicators(\%data); # warn Dumper \%data;
    is($result->{ann_arbor}, 'II[2]'); # warn Dumper $result;

    # add lower-nodal group:
    local $data{site_opts}{1} = 1; # mesenteric 
    $result = _get_prognostic_indicators(\%data); # warn Dumper \%data; 
    is($result->{ann_arbor}, 'III'); # warn Dumper $result;

    # add marrow involvment:
    local $data{site_opts}{8} = 1; # marrow
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ann_arbor}, 'IV'); # warn Dumper $result;

    # add spleen:
    local $data{site_opts}{2} = 1; # spleen
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ann_arbor}, 'IVS'); # warn Dumper $result;

    # add bulky disease:
    local $data{site_opts}{9} = 1; # bulky
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ann_arbor}, 'IVSX'); # warn Dumper $result;
    
    # no ann_arbor:
    local $data{lymphoid}{ct} = 'N'; 
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ann_arbor}, undef); # warn Dumper $result;
}

{ # FLIPI:    
    # default data (because age > 60):
    $result = _get_prognostic_indicators(\%data);
    is($result->{flipi}, 'good [1]'); # warn Dumper $result;

    { # local change to diagnosed date to take age < 60:
        _manipulate_diagnosis_date_by_years(15);
        $result = _get_prognostic_indicators(\%data);    
        is($result->{flipi}, 'good [0]'); # warn Dumper $result;
        _manipulate_diagnosis_date_by_years(0); # '0' to revert
    }

    # reduce Hb below 12:
    local $data{lymphoid}{hb} = 11;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{flipi}, 'intermediate [2]'); # warn Dumper $result;
    
    # increased ldh:
    local $data{lymphoid}{ldh} = 'raised';
    $result = _get_prognostic_indicators(\%data);    
    is($result->{flipi}, 'poor [3]'); # warn Dumper $result;
    
    # force Ann Arbour to stage IV:
    local $data{site_opts}{8} = 1; # marrow
    $result = _get_prognostic_indicators(\%data);        
    is($result->{flipi}, 'poor [4]'); # warn Dumper $result;
    
	# make upper_nodal + lower_nodal groups > 4:
	local $data{site_opts}{1} = 1; # mesenteric
    local $data{site_opts}{2} = 1; # spleen 
    local $data{site_opts}{3} = 1; # mediastinal
    local $data{site_opts}{4} = 1; # waldeyer
    local $data{site_opts}{5} = 1; # thymus 
    $result = _get_prognostic_indicators(\%data);        
    is($result->{flipi}, 'poor [5]'); # warn Dumper $result;   
    
    # no flipi:
    local $data{lymphoid}{ct} = 'N'; 
    $result = _get_prognostic_indicators(\%data);    
    is($result->{flipi}, undef); # warn Dumper $result;
}

{ # IPI:
    _change_diagnosis('DLBCL'); # change request #1 diagnosis
	local $data{site_opts} = {}; # clear nodal/extranodal involvement
	
    # default data
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ipi}, 'low [0]'); # warn Dumper $result;
    
    # increase ECOG score:
    local $data{lymphoid}{ecog} = 2; 
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ipi}, 'low-intermediate [1]'); # warn Dumper $result;
    
    # increased ldh:
    local $data{lymphoid}{ldh} = 'raised';
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ipi}, 'high-intermediate [2]'); # warn Dumper $result;

    # force Ann Arbour to stage IV:
    local $data{site_opts}{8} = 1; # marrow
    $result = _get_prognostic_indicators(\%data); # warn Dumper \%data;        
    is($result->{ipi}, 'high [3]'); 

    # $age > 60 && extranodal sites > 1:
    local $data{site_opts}{7} = 1; # git; 2nd extranodal site
    $result = _get_prognostic_indicators(\%data);        
    is($result->{ipi}, 'high [4]'); # warn Dumper $result;

    # decrease ECOG score to 0:
    local $data{lymphoid}{ecog} = 0; 
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ipi}, 'high [3]'); # warn Dumper $result;
    
    { # local change to diagnosed date to take age < 60:
        _manipulate_diagnosis_date_by_years(15);
        $result = _get_prognostic_indicators(\%data);    
        is($result->{ipi}, 'high-intermediate [2]'); # warn Dumper $result;
        _manipulate_diagnosis_date_by_years(0); # '0' to revert
    }

    # no ipi:
    local $data{lymphoid}{ecog} = undef; 
    $result = _get_prognostic_indicators(\%data);    
    is($result->{ipi}, undef); # warn Dumper $result;    
}

{ # HIPI:
    _change_diagnosis('Hodgkin'); # change request #1 diagnosis
    
    # default data ($age >= 45 & Gender = M):
    $result = _get_prognostic_indicators(\%data);    
    is($result->{hipi}, 'low-risk [2]'); # warn Dumper $result; exit;

    { # local change to diagnosed date to take age < 45:
        _manipulate_diagnosis_date_by_years(30);
        $result = _get_prognostic_indicators(\%data);    
        is($result->{hipi}, 'low-risk [1]'); # warn Dumper $result;
        _manipulate_diagnosis_date_by_years(0); # '0' to revert
    }
    
    # reduce Hb below 10.5:
    local $data{lymphoid}{hb} = 10;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{hipi}, 'mod/high risk [3]'); # warn Dumper $result;
    
    # increase wbc above 15:
    local $data{lymphoid}{wbc} = 16;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{hipi}, 'mod/high risk [4]'); # warn Dumper $result;

    # reduce albumin below 40:
    local $data{lymphoid}{albumin} = 30;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{hipi}, 'mod/high risk [5]'); # warn Dumper $result;
    
    # reduce lymphs below 0.6:
    local $data{lymphoid}{lymphs} = 0.5;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{hipi}, 'mod/high risk [6]'); # warn Dumper $result;

    # force Ann Arbour to stage IV:
    local $data{site_opts}{8} = 1; # marrow
    $result = _get_prognostic_indicators(\%data);        
    is($result->{hipi}, 'mod/high risk [7]'); # warn Dumper $result;
    
    # no hipi:
    local $data{lymphoid}{albumin} = undef; # warn Dumper \%data;
    $result = _get_prognostic_indicators(\%data);        
    is($result->{hipi}, undef); # warn Dumper $result;    
}

{ # Binet:
    _change_diagnosis('B-LPD'); # change request #1 diagnosis
    
    # default data
    $result = _get_prognostic_indicators(\%data);    
    is($result->{binet}, 'A'); # warn Dumper $result;
    
    # add upper nodal (stays at 'A'):
    local $data{site_opts}{5} = 1; # thymus
    $result = _get_prognostic_indicators(\%data);    
    is($result->{binet}, 'A'); # warn Dumper $result;
    
    # add lower nodal:
    local $data{site_opts}{1} = 1; # mesenteric
    $result = _get_prognostic_indicators(\%data);    
    is($result->{binet}, 'A'); # warn Dumper $result;

    # add another upper nodal:
    local $data{site_opts}{4} = 1; # waldeyer
    $result = _get_prognostic_indicators(\%data);    
    is($result->{binet}, 'B'); # warn Dumper $result;
    
    # reduce Hb < 10: || $plts < 100) { $binet = 'C' }
    local $data{lymphoid}{hb} = 9;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{binet}, 'C'); # warn Dumper $result;
    
    # restore Hb  & reduce $plts < 100:
    local $data{lymphoid}{hb} = 11;
    local $data{lymphoid}{plts} = 80;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{binet}, 'C'); # warn Dumper $result;
    
    # no Binet:
    local $data{lymphoid}{plts} = undef;
    $result = _get_prognostic_indicators(\%data);    
    is($result->{binet}, undef); # warn Dumper $result;    
}

sub _get_prognostic_indicators {
    my $data = shift; # warn Dumper $data;
    
    # create new PrognosticIndicator object to force diagnostic_categories_map change:
    my $o = PrognosticIndicator->new(
        lims_dbix => $dbix,
        _patient_id => 1,
    ); # warn Dumper $o;
	
	# LIMS::Model::HMRN::PrognosticIndicator requires:
		# params_data - HoH containing 'lymphoid' accessor
		# initial_scan - HoH containing 'site_opts' accessor
		# option_maps - {imaging_options}->{map}
	my %params = ( lymphoid => $data->{lymphoid} );
	my %i_scan = ( site_opts => $data->{site_opts} );
	my %o_maps = ( imaging_options => { map => $data->{imaging_opts} } );
	
    my %h = (
        params_data  => \%params,
        initial_scan => \%i_scan,
        option_maps  => \%o_maps,
    ); # warn Dumper \%h;

    my $result = $o->prognostic_indicators(\%h);
    return $result;
}

sub _manipulate_diagnosis_date_by_years {
    my $years = shift;
    
    $dbix->update('patient_event', 
        { date => DateTime->today->subtract( years => $years )->ymd },
        { patient_id => 1, event_id => 1 }
    );
}

sub _populate_tables {
    my $dbh = $dbix->dbh;
    
    { # imaging site options (just need a selection):
        for (@site_opts) {
            $dbh->do(
                q!INSERT INTO imaging_options (description,option_type) VALUES (?,?)!,
                undef, @$_
            );
        }
        for (1 .. scalar @site_opts) {
            $dbh->do( q!INSERT INTO patient_imaging_option VALUES (?,?)!, undef, 1, $_ );        
        }
    }
    { # events 
        $dbh->do(
                qq!INSERT INTO events (id, description) VALUES (?,?)!,
                undef, 1, 'diagnosis' );
    }
    { # diagnostic categories:
        my $categories = _get_diagnostic_categories();
        for (@$categories) {
            $dbh->do(
                qq!INSERT INTO diagnostic_categories (description,category_type)
                    VALUES (?,?)!, undef, $_, 'sub'
            );
        }
    }
    { # diagnoses:
        my $diagnoses = _get_diagnoses();
        my $sql = 'select id from diagnostic_categories where description = ?';
        while ( my($name,$icdo3) = each %$diagnoses ) { # warn Dumper [$name,$icdo3];
            # get diagnostic_category_id:
            my $category = $name; # except:
            $category =~ s/B-LPD/CLL/; 
            $category =~ s/FCL/FL/;
            
            $dbix->query($sql, $category)->into(my $id);
            $dbix->insert('diagnoses', {
                name => $name, icdo3 => $icdo3, diagnostic_category_id => $id,
            });
        }
    }
    { # icdo3_category (simplified version of hilis4):
        $dbix->dbh->do(
            q!insert into icdo_category(diagnostic_category_id,icdo3)
                select diagnostic_category_id,icdo3 from diagnoses!
        );
    }
    { # patient imaging event:        
        my %h = (
            patient_id => 1, dataset => 1, scan_type => 'ct',
            stage => 'initial', date => DateTime->today->ymd,
        );
        $dbix->insert('patient_imaging_event', \%h);
    }
    { # patient event:
        $dbix->insert('patient_event',
            { patient_id => 1, event_id => 1, date => DateTime->today->ymd }
        );
    }
}

sub _change_diagnosis {
    my $diagnosis = shift;
    
    $dbix->query('select id from diagnoses where name = ?', $diagnosis)->into(my $id);
    
    $dbix->delete('request_report', { request_id => 1 });
    $dbix->insert('request_report', { request_id => 1, diagnosis_id => $id });    
}

sub _get_diagnoses {
    return {
        'B-LPD' => '9823/3', # already have CLL as Lymphoproliferative
        FCL     => '9690/3',
        MZL     => '9689/3', # SMZL
        Hodgkin => '9652/3',
        DLBCL   => '9680/3',
        MCL     => '9673/3',
    }
}

sub _get_diagnostic_categories {
    return [ qw(CLL FL MZL Hodgkin DLBCL MCL) ];
}

# perlfaq 4 - How do I find the first array element for which a condition is true?
sub _get_array_position_for {
    my ($term, $array) = @_; # warn Dumper [$term, $array];
    
    my $index = -1; 
	for ( my $i = 0; $i < @$array; $i++ ) {
		if ( $array->[$i] eq $term ) { # want exact match in this case
			$index = $i; # warn $index;
			last;  
		}
	}
    return $index;
}