package LIMS::Local::GalliumTrial;

use Moose;

has data => (
    is  => 'ro',
    isa => 'HashRef',
    required => 1,    
);

has test_codes => (
    is => 'ro',
    isa => 'HashRef',
    lazy_build => 1,
);

__PACKAGE__->meta->make_immutable;

use Data::Dumper;
use LIMS::Local::Utils;
my $trim = sub { LIMS::Local::Utils::trim(@_) };

#===============================================================================
# regex's:
my $words_re = qr{\s?(\b\w+\b( \b\w+\b)?)}; # matches 1 or 2 words

my $igh_aso_re = qr{\s?(not evaluable|(mono|oligo|poly)clonal)}i;

my $biopsy_re = qr/
	biopsy\:\s*(.*?)\.
/ix; # capture all between ':' and 1st full-stop

my $grade_re = qr{\b(grade\s\d\w?)\b}i; # lymphoma grade 1,2,3[ab]
#===============================================================================

sub get_lab_role {
    my $self = shift;
    
    my $clinical_details = $self->data->{clinical_details} || return 0;
    my $result = $clinical_details =~ /referred from Kiel/i
		? 'Adjudicator' : 'First Time Reviewer';
    return $result;
}

# extract block ref + number of slides & blocks from external_ref:
sub get_external_reference {
    my $self = shift;
    
    my $exref = $self->data->{external_reference} or return 0;

    # just capture 1st item of block_ref eg (125-16696) x20uss
    my ($block_ref) = split /\sx(:?\d+)[spu]/, $exref; # warn $block_ref; 

    my ($unstained_slides) = $exref =~ /x(\d+)uss/; # warn $unstained_slides 
    my ($stained_slides)   = $exref =~ /x(\d+)ss/; # warn $stained_slides
    my ($blocks)           = $exref =~ /x(\d+)p/; # warn $blocks;
        
    my $slides = do {
        no warnings 'uninitialized';
        $unstained_slides + $stained_slides;
    }; # warn Dumper [$block_ref, $slides, $blocks];
        
    my %h = (
        block_id => &$trim($block_ref),
        slides   => $slides || 0,
        blocks   => $blocks || 0, 
    );
    return \%h;
}

sub get_rna_results {
    my $self = shift;
    
    my $result = $self->data->{molecular_summary} || return 0;
    
    my %h = ();
	if ( $result =~ /RNA volume\:(.*)ul/ ) { # warn $1
		$h{rna_volume} = &$trim($1);
	}
	if ( $result =~ /RNA concentration\:(.*)ng/ ) { # warn $1;
		$h{rna_concentration} = &$trim($1);
	}
	if ( $result =~ /OD260\/280\:\s?(\d*\.\d+)/ ) { # warn $1;
		$h{rna_purity} = $1;
	}
	if ( $result =~ /RNA sections\:(.*)micron/ ) { # warn $1
		$h{rna_sections} = &$trim($1);
	} # warn Dumper [@{$vars}{qw(rna_volume rna_concentration rna_purity rna_sections)}];
    return \%h;
}

sub get_igh_pcr {
    my $self = shift;
    
    my $result = $self->data->{molecular_summary} || return 0;
   
    my %h = ();
    if ( $result =~ /IgH-ASO assay\:$words_re/ ) { # warn $1;
        $h{igh_pcr_assay} = &$trim($1);
	}
	if ( $result =~ /IgH-ASO result\:$igh_aso_re/ ) { # warn $1;
        $h{igh_pcr_result} = lc &$trim($1);
    }
	if ( $result =~ /IgH-ASO bp length\:\s?(\d+)/ ) { # warn $1;
        $h{igh_pcr_bp_length} = $1;
    }
	if ( $result =~ /IgH-ASO comment\:(.*)/ ) { # warn $1;
        $h{igh_pcr_comment} = &$trim($1);
    }
    return \%h;
}

sub get_fish_break_apart_result {
    my $self = shift;
    my $col  = shift;
    
    my $val = $self->data->{$col} || return 0;
    
    my $result = $val =~ /rearranged/
		? 'Positive'
		: $val eq 'failed'
			? 'Not Evaluable' : 'Negative';
    return $result;
}

sub get_fish_fusion_assay_result {
    my $self = shift;
    my $col  = shift;
    
    my $val = $self->data->{$col} || return 0;
    
    my $result = $val =~ /translocation/
		? 'Positive'
		: $val eq 'failed'
			? 'Not Evaluable' : 'Negative';
    return $result;
}

sub get_biopsy_site {
    my $self = shift; return 0; # pending
    
    my ($site) = $self->data->{comment} =~ /$biopsy_re/;
    return $site;
}

sub get_involvement_pattern {
    my $self = shift;
    return 0; # can't extract pattern of involvment from comment yet
}

sub get_lymphoma_grade {
    my $self = shift;
    
    my $icdo3 = $self->data->{icdo3} || return 0;
    
    # extract grade - only if FL:
    if ( $icdo3 =~ 9690 && $self->data->{comment} =~ /$grade_re/ ) {
        return lc $1; # captures content of $grade_re
    }
    return 0;
}

sub get_sample_quality {
    my $self = shift;
    
	my $result = $self->data->{specimen_quality} || return 0;
	$result =~ s/adequate/good/; # only using adequate & poor
    return ucfirst $result;
}

sub get_morphology_comment {
    my $self = shift;
    
    my $comment = $self->data->{comment} || return 0;
    $comment =~ s/[\n\r]/ /g; # replace new-lines with spaces
	return $comment;
}

sub get_fish_summary {
    my $self = shift;    
    return $self->data->{fish_summary} || 0;
}

sub is_retest_required {
    my $self = shift;
    
    my $diagnosis = $self->get_diagnosis || return 0;
    return $diagnosis eq 'Inadequate sample' ? 'Yes' : 'No'; # inadequate needs re-test
}

sub get_diagnosis {
    my $self = shift;    
    return $self->data->{diagnosis} || 0;
}

sub get_icdo3 {
    my $self = shift;
    return $self->data->{icdo3} || 0;
}

sub get_lymphoma_involvment {
    my $self = shift;    
    return 100;  # temp assessment
}

sub get_test_results {
    my $self = shift;
    
    my %SDL = %{ $self->test_codes }; # warn Dumper \%SDL;
    
    my %h = ();
	TEST: while ( my ($marker, $test_code) = each %SDL ) {
		my $result = $self->data->{$marker} || next TEST;
        $h{$test_code} = $result;
    }; # warn Dumper \%h;
    return \%h;
}

sub is_discrepant_diagnosis {
    my $self = shift;
    return 0; # pending
}

sub is_urgent_report {
    my $self = shift;
    return 0; # pending
}

sub is_urgent_block_return {
    my $self = shift;
    return 0; # pending
}

sub test_decodes { # reverses $self->test_codes
    my $self = shift;
    
    my $codes = $self->test_codes;
    my %decodes = reverse %$codes;
    return \%decodes;
}

# Quintiles test codes => HMDS test_name map:
sub _build_test_codes {
    my $self = shift;
    
    return {
        cd3 	  => 'SDL2110',
        cd5 	  => 'SDL2099',
        cd10	  => 'SDL2100',
        cd20	  => 'SDL2101',
        cd23	  => 'SDL2102',
        cd79	  => 'SDL2105',
        bcl2	  => 'SDL2103',
        bcl6 	  => 'SDL2108',
        irf4	  => 'SDL2106',
        ki67 	  => 'SDL2109',
        foxp1	  => 'SDL2107',
        kappa     => 'SDL2123',
        lambda    => 'SDL2134',
        cyclin_d1 => 'SDL2104', # = bcl1
		
#        BCL2     => 'SDL2115', # FISH - handled by get_fish_break_apart_result()
#        BCL6     => 'SDL2116', # FISH - handled by get_fish_break_apart_result()
#        BCL2_IgH => 'SDL2117', # FISH - handled by get_fish_fusion_assay_result()
    };
}

1;