package LIMS::Local::GenomicsValidation;

use Moo;
use Local::Utils;
use Clone qw(clone);
use Data::Printer alias => 'p';

use XML::SAX::ParserFactory;
use XML::Validator::Schema;

has xsd_src => ( is => 'ro', required => 1 );
has dbix    => ( is => 'ro', required => 1 );
has cfg     => ( is => 'ro', required => 1 );

has rare_disease_base => ( is => 'lazy' );
has family_id_prefix  => ( is => 'lazy' );
has cancer_increment  => ( is => 'lazy' );
has lab_tests_map     => ( is => 'lazy' );

sub _build_cancer_increment  { shift->cfg->{genomics}->{uat}->{cancer_incr} }
sub _build_rare_disease_base { shift->cfg->{genomics}->{uat}->{rare_disease} }
sub _build_family_id_prefix {
    my $self = shift;
    # family_id_prefix = 1st 3 digits of rare_disease participant id base:
    my ($family_id_prefix) = $self->rare_disease_base =~ /^(\d{3})/; # p $family_id_prefix;
    return $family_id_prefix;
}
sub _build_lab_tests_map { # warn '=' x 30;
    my $self = shift;

    my $sql = q!SELECT lt.test_name, lt.field_label, ls.section_name
        FROM lab_tests lt JOIN lab_sections ls on lt.lab_section_id = ls.id!;
    $self->dbix->query($sql)->hash_map('test_name');
}
no autovivification;

sub validate_params {
    my ($self, $data) = @_; # p $data; # hashref

    my %errors;

	my $c = clone $data; # to prevent auto-vivification
    # family ID (is RD-specific) is 9 digits & begins with 1st 3 digits of
    # rare_disease participant id base (122xxxxxx):
    if ( my $family_id = $c->{Approach}->{family_id} ) { # warn $family_id;
=begin # family_id should be participant_id + max 9 individuals, but doesn't
        # work in practice as family_id just has to match a participant_id which
        # could be any number of requests different
        my $participant_id = $c->{Demographics}->{participant_id};
        unless ( $participant_id - $family_id ~~ [0..9] ) {
           # p [ $participant_id, $family_id ];
           $h{family_id} = $family_id;
        }
=cut
        # check family_id belongs to an existing participant_id (unit_number):
        $self->dbix->query('select 1 from patient_case where unit_number = ?',
            $family_id)->into(my $pid_match_ok);
        # family_id_prefix is 1st 3 digits of rare_disease participant id base:
        my $family_id_prefix = $self->family_id_prefix;
            # p $pid_match_ok; p $family_id; p $family_id_prefix;
        unless ( $pid_match_ok && $family_id =~ /^$family_id_prefix/ ) {
            $errors{family_id} = $family_id;
        }
    }
    # participant ID is 9 digits and matches allocated RD or Cancer block:
    if ( my $participant_id = $c->{Demographics}->{participant_id} ) { # p $participant_id;
        my $request_id = $c->{Demographics}->{request_id};
        my $expected   = $self->rare_disease_base + $request_id;
        if ( my $arm = $c->{Demographics}->{arm} ) {
            $expected += $self->cancer_increment if lc $arm eq 'cancer';
        } # p $expected;
        else { # not screened:
            $expected = 0; # ensures failure even if length = 9
        }
        $errors{participant_id} = $participant_id if length $participant_id != 9
            or ! _matches($participant_id, $expected);
    }
    # nhs number:
    unless ( $c->{Demographics}->{nhs_number} ) {
        $errors{nhs_number} = undef;
    }
=begin # validated in validate_xml_against_xsd() using XML libs now
    # DNA/volume_stored is xs:small (integer):
    if ( my $val = $data->{DNA}->{volume_stored} ) {
        unless ($val =~ /^\d+$/) { # warn 'here';
            $data->{DNA}->{volume_stored} = int($val);
        }
    }
    # DNA/edta1_fluidx_vol is xs:small (integer):
    if ( my $val = $data->{DNA}->{edta1_fluidx_vol} ) {
        unless ($val =~ /^\d+$/) { # warn 'here';
            $data->{DNA}->{edta1_fluidx_vol} = int($val);
        }
    }
=cut
    # p \%errors;
    my $map  = $self->lab_tests_map; # p $map;
    my @errs = map { # same format as genomics_xml.pl notify_admin msg:
        ( $errors{$_}
            ? ( sprintf qq!Illegal value '%s' !, $errors{$_} )
            : 'Illegal NULL value ' )
        # . "in element <$_>, does not match required definition"; # changed to:
      . sprintf q!for '%s' in '%s' section, does not match required definition.!,
            $map->{$_}{field_label}, $map->{$_}{section_name}
    } keys %errors;
    return @errs ? \@errs : 0; # don't return empty arrayref (evals 'true' for caller)
}

#-------------------------------------------------------------------------------
sub validate_xml_against_xsd {
    my ($self, $xml) = @_; # warn $xml;

    my $xsd_src = $self->xsd_src;
	# switch debug on to show data structure:
    my $validator = XML::Validator::Schema->new(file => $xsd_src, debug => 0); # p $validator;
    my $parser    = XML::SAX::ParserFactory->parser(Handler => $validator);
    eval { $parser->parse_string($xml); };
    return $@;
}

#-------------------------------------------------------------------------------
sub reformat_error {
    my ($self, $error) = @_;

    my ($lab_test) = $error =~ m!element <(.*)>!; # p $lab_test;
    my $lab_tests_map = $self->lab_tests_map; # p $lab_tests_map;

    if ( my $ref = $lab_tests_map->{$lab_test} ) { # get field label & section
        my $section = $ref->{section_name};
        my $label   = $ref->{field_label};

        $error =~ s/in element <$lab_test>/for '$label' in '$section' section/; # p $error;
    }
    return $error;
}

sub _matches { Local::Utils::matches(@_) }

1;
