• Files
• Commits
• Log
• Graph
• Stats

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' );

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;
}

no autovivification;

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

    my %h;

	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/ ) {
            $h{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
        }
        $h{participant_id} = $participant_id if length $participant_id != 9
            or ! _matches($participant_id, $expected);
    }
    # nhs number:
    unless ( $c->{Demographics}->{nhs_number} ) {
        $h{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 \%h;
    my @errs = map {
        ( $h{$_}
            ? qq!Illegal value '$h{$_}' !
            : q!Illegal NULL value ! )
        . "in element <$_>, does not match required definition";
    } keys %h;
    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 _matches { Local::Utils::matches(@_) }

1;