use XML::SAX::ParserFactory; use XML::Validator::Schema; use XML::Simple qw(:strict); use Data::Printer; use Data::Dumper; use Config::Auto; use Modern::Perl; # say use Test::More; use IO::All; =begin # tests: tests the genomics_xml.pl script - generates dummy data in lims_test and provides overrides for location/name of archive & prevents ftp transfer of file =cut # NOTE requires a genomics database so need to load setup/schema/genomics.sql # genomics is a centre so needs setting up properly with genomics.txt and # also needs all the .genomics config copying from a working version BEGIN { require 't/test-lib.pl' } my $dbix = get_dbix(); my $cfg = get_config(); # p $cfg; my $db = 'lims_test'; # for validation: my $xsd = 'genomics.xsd'; # current xsd - synlinked to most recent file my $xsd_src = $cfg->{path_to_app_root} . '/setup/schema/xsd/' . $xsd; # p $xsd_src; create_genomics_data(); # drop & recreate tables/data { # execute genomics_xml.pl script: my $script = '/script/crons/multi/genomics_xml.pl'; my @args = ( -d => $db, -s => 10 ); # override dbname, set duration 10 seconds system ( $cfg->{path_to_app_root} . $script, @args ); } # for validation tests: my $xml_src = io("/tmp/${db}.xml")->slurp; # p $xml_src; # unzip archive and extract to $xml (not using gzip any more): # gunzip "/tmp/${db}.gz" => \my $xml or die "gunzip failed: $GunzipError\n"; # p $xml; my $genomics_uat = do { my $cfg_file = $cfg->{path_to_app_root} . '/script/crons/lib/settings.cfg'; # p $cfg_file; Config::Auto::parse($cfg_file)->{genomics}->{uat}; }; # p $genomics_uat; { # compare src data and parsed xml hashrefs: my $ref = XMLin("/tmp/${db}.xml", ForceArray => 0, KeyAttr => []); # p $ref->{Record}; # read Data::Dumper txt back into hashref format: my $src = do "/tmp/${db}.txt"; # p $src; # http://www.perlmonks.org/?node_id=304068 # if Consent / Files exist, convert hashref element in $ref to an arrayref to match $src: if ( my $r = $ref->{Record}->{Consent}->{Files} ) { # p $ref; my $str = $r->{file}; # p $str; # scalar value - should be arrayref to match $src $ref->{Record}->{Consent}->{Files}->{file} = [ $str ]; # scalar value to arrayref } is_deeply($src, $ref->{Record}, 'data structures identical'); { # check Rare disease has expected participant/GeL ID: my $allocated_id = $ref->{Record}->{Demographics}->{participant_id}; my $expected_id = $genomics_uat->{rare_disease} + 1; is($allocated_id, $expected_id, 'expected GeL ID for rare disease type'); } } # change some xml params and check validation failure: { # decimal on xs:short: validate('edta1_fluidx_vol', 175.5); # string on xs:int: validate('family_id', 'string'); # invalid date: validate('consent_date', '2/4/2016'); # invalid datetime: validate('edta1_qc_date', '2/4/2016 10.00'); # exceed max value for xs:int (2147483647): validate('family_id', 2_147_483_647 + 1); # exceed max value for xs:short (32767): validate('volume_stored', 32_767 + 1); # exceed max value for xs:byte (127): validate('total_samples', 127 + 1); } # delete temp files: io("/tmp/${db}.$_")->unlink for qw(txt xml); done_testing(9); sub create_genomics_data { # create new genomics data: my $dbh = $dbix->dbh; # drop lab_tests & lab_sections, re-create from genomics db: for ( qw/lab_tests lab_sections screens screen_category/ ) { $dbh->do(qq!TRUNCATE TABLE `$_`!) ; $dbh->do(qq!INSERT INTO `$_` SELECT * FROM `genomics`.`$_`!); } $dbh->do(qq!TRUNCATE TABLE `$_`!) for qw(request_lab_test_results storage_racks request_initial_screen request_history request_storage); { # test/results: my $lab_tests = $dbix->select('lab_tests', [qw(test_name id)])->map; # p $lab_tests; my @data = grep chomp $_, ; # p @data; exit; # only grep lab_tests with a result (comma followed by 1 or more chars): my %results = map { split ',' } grep /.+,.+/, @data; # p %results; exit; $dbix->insert('request_lab_test_results', { lab_test_id => $lab_tests->{$_}, request_id => 1, result => $results{$_}, } ) for keys %results; } $dbix->select('screens', 'id', { description => 'Rare disease' })->into(my $id); $dbix->insert('request_initial_screen', { request_id => 1, screen_id => $id }); $dbix->insert('request_lab_test_history', { request_id => 1, user_id => 1, action => 'auto-set Consent given status to complete', } ); $dbix->insert('request_lab_test_history', { request_id => 1, action => 'screened', user_id => 1 }); $dbix->insert('storage_racks', { plateId => 'SR12345' }); for (1..2) { $dbix->insert('request_storage', { vial_location => 'C'.$_, part_number => '123456789'.$_, request_id => 1, vialId => 'FR1122334'.$_, sample => 'tissue', source => 'PST', rack_id => 1, } ); } { # new crontab user for participant id event history: my %h = ( user_location_id => 1, designation => 'crontab', first_name => 'cron', last_name => 'tab', password => 'not_required', username => 'crontab', group_id => 2, email => 'cron@nowhere.com', ); $dbix->insert('users', \%h); } # revert unit number to UNKNOWN to test participant id generation: $dbix->update('patient_case', { unit_number => 'UNKNOWN'}, { id => 1 }); # delete 2nd request - gets included in query, only able to handle 1 request: $dbix->delete('requests', { id => 2}); } sub validate { my ($param, $val) = @_; # warn $param; my $xml = $xml_src; # clone it so text substitution localised $xml =~ s!<$param>(.*)!<$param>$val!; my $result = validate_xml_against_xsd($xml); # p $result; my $msg = join ' ', $param, 'validated OK'; like ( $result, qr/Illegal value '$val' in element <$param>/, $msg ); } sub validate_xml_against_xsd { my $xml = shift; # switch debug on to show data structure: my $validator = XML::Validator::Schema->new(file => $xsd_src, debug => 0); my $parser = XML::SAX::ParserFactory->parser(Handler => $validator); eval { $parser->parse_string($xml); }; return $@; } __DATA__ appointment_date,2016-06-15 approach_date,2016-05-15 approach_followup_date, approach_method,Letter biopsy_gauge, ccft_dna, clinic_sample_type, consent_date,2016-06-15 consent_form_version,R1/R2 consent_given,yes consent_q1,yes consent_q10,yes consent_q11,yes consent_q12,yes consent_q13,yes consent_q14,yes consent_q2,yes consent_q3,yes consent_q4,yes consent_q5,yes consent_q6,yes consent_q7,yes consent_q8,yes consent_q9,yes dna_arrived_ccp,2016-10-21 13:20:12 dna_consignment_number,RR813-21-43-16-1 dna_dispatched,2016-10-19 10:00:12 dna_extraction_protocol, dna_lab_number,16.06016 dna_sent_ccp,2016-10-20 10:22:12 edta1_fluidx_rack_id,SA00165521 edta1_fluidx_rack_well,A5 edta1_fluidx_vol,200 edta1_fluidx,1023912430 edta1_qc_date,2016-10-12 14:20:38 edta1_qc_result,309 edta1_qc_source, edta1_qc_type,Qubit edta1,122000059.1 edta2_qc_source, edta2,122000059.2 excision_margin, family_id,122000058 ffpe_dissection_details, ffpe_macrodissected, first_outcome,Interested fixation_comments, fixation_end, fixation_start, fixative_type, formalin_duration, frozen_dissection_details, frozen_macrodissected, handling_protocol,v2 info_sheet_version,R2 local_lab_identifier, number_of_biopsies, number_of_blocks, number_of_sections, omics_arrived_ccp, omics_consignment_number, omics_dispatched,2016-10-21 10:08:12 omics_sent_ccp, patient_info_given, paxgene_rna,122000059.5 pre_invasive_elements, processing_schedule, prolonged_storage_method, pst,122000059.4 received_by_cytogenetics, sample_taken,2016-06-15 13:30:25 second_outcome, section_thickness, sent_from_histopathology, snap_freezing_start, sst,122000059.3 tissue_source, total_samples,3 tracking_number, tumour_fluidx, tumour_fluidx_rack_id, tumour_fluidx_rack_well, tumour_fluidx_vol, tumour_lab_number, tumour_qc_date, tumour_qc_result, tumour_qc_type, tumour_sample_id, tumour_sample_taken, tumour_sample_type, tumour_size, tumour_type, tumour_volume_stored, unsent_sample_reason, volume_stored,267 withdrawal_date, withdrawal_form, withdrawal_option,