use WWW::Mechanize::TreeBuilder; # look_down()
use Test::WWW::Mechanize;
use LWP::Protocol::PSGI;
use Test::More;
use Data::Printer alias => 'ddp';
use YAML::Tiny;
# use IO::All; # for debug use
use RequestForm::Test;
use RequestForm;
use Data::Dumper;
my $psgi_app = RequestForm::runner()->psgi_app;
LWP::Protocol::PSGI->register($psgi_app);
my $mech = Test::WWW::Mechanize->new;
WWW::Mechanize::TreeBuilder->meta->apply($mech);
my $args = form_tokens(); # warn $args;
my $config = YAML::Tiny->read( 'config.yml' ) or die $!; # ddp $config;
my $required_fields = $config->[0]->{validation}->{required};
my $src = patient_data(); # ddp $patient;
my $patient_1 = $src->[0]; # dpp $patient_1;
my $patient_2 = $src->[1]; # dpp $patient_2;
my $dbix = get_dbix();
{ # initialise patients table with patient #2 from patients.conf:
my $info = $dbix->query("PRAGMA table_info(patients)")->hashes; # warn Dumper $info;
my @cols = grep { $_ ne 'id' } map $_->{name}, @$info; # warn Dumper \@cols;
my %h;
$h{$_} = $patient_2->{$_} for @cols; # warn Dumper \%data;
# dob from components:
$h{dob} = join '-', @{$patient_2}{qw(year month day)}; # warn Dumper \%h;
$dbix->insert('patients', \%h);
}
# initialise session with form tokens:
$mech->get_ok("http://localhost/?$args"); # print_output($mech);
# submit invalid nhs_number:
$mech->get('http://localhost/'); # print_output($mech);
$mech->field(nhs_number => $patient_1->{nhs_number} + 1);
$mech->submit_form(); # print_output($mech);
# p $mech->content( format => 'text' ); # span inside div:
$mech->text_contains('NHS number: invalid', 'OK: invalid nhs number detected');
# submit valid nhs_number:
$mech->get('http://localhost/'); # print_output($mech);
$mech->field(nhs_number => $patient_1->{nhs_number});
$mech->submit_form(); # print_output($mech);
$mech->has_tag(
p => 'No matching patient details found',
'OK: nhs number submitted, no matching details found',
);
{ # submit invalid data set:
# for each required field, clone data, delete key & test for validation failure:
for my $field (@$required_fields) { # warn $field; # next;
next if $field eq 'location_name'; # tt uses location_id not name (ajax function)
my $clone = clone($patient_1); # dpp $clone;
delete $clone->{$field}; # dpp $clone;
$mech->post('http://localhost/', $clone);
# io($FindBin::Bin . '/'.$field.'.htm')->print($mech->{content});
$mech->has_tag(
div => 'Missing',
"OK: $field field missing",
);
}
}
{ # submit valid dataset:
$mech->post('http://localhost/', $patient_1); # print_output($mech);
$mech->has_tag_like(
p => qr/Form passed validation/,
'OK: validation passed',
);
# put _skip_pds back in (not retained in form):
$mech->field( _skip_pds => 1 );
# submit form to generate pdf (or HTML for non-deployment env):
$mech->submit_form(); # print_output($mech);
ok( # barcode class table:
$mech->look_down(_tag => 'table', class => 'hbc'), # table class="hbc"
'OK: has barcode table element',
);
{ # look for unique ref (eg 1428054818SILVERO):
my $ref = uc( $patient_1->{last_name}
. substr($patient_1->{first_name}, 0, 1) ); # ddp $ref;
$mech->has_tag_like(
td => qr/\d+$ref/,
'OK: unique ref id found',
);
}
# look for each required field (except special format fields):
for my $field (@$required_fields) { # warn Dumper [$field, $patient_1->{$field}]; # next;
# defer testing fields with special formatting (tested below):
next if grep $field eq $_, # location_id not present at pdf generation stage:
qw(last_name nhs_number day month year location_id);
$mech->has_tag( span => $patient_1->{$field}, "OK: $field field found" );
}
{ # look for special format fields (dob, last_name, nhs_number):
my $nhs_number = join ' ', # amazingly, this works:
( $patient_1->{nhs_number} =~ /(\d{3})(\d{3})(\d{4})/ ); # ddp $nhs_number;
my $last_name = uc $patient_1->{last_name};
my $dob = sprintf '%02d-%02d-%s', @{$patient_1}{ qw(day month year) };
my %formatted = (
nhs_number => $nhs_number,
last_name => $last_name,
dob => $dob,
);
while ( my ($key, $val) = each %formatted ) {
$mech->has_tag( span => $val, "OK: $key field found" );
}
}
}
{ # patient #2:
$mech->get('http://localhost/'); # print_output($mech);
$mech->field(nhs_number => $patient_2->{nhs_number});
$mech->submit_form(); # print_output($mech);
$mech->text_contains(
'Matching patient details found',
'OK: nhs number submitted, matching details found',
);
# check loaded fields:
my %formatted = (
nhs_number => $patient_2->{nhs_number},
last_name => uc $patient_2->{last_name},
first_name => $patient_2->{first_name},
previous => $patient_2->{previous},
gender => $patient_2->{gender},
day => $patient_2->{day},
month => $patient_2->{month},
year => $patient_2->{year},
);
while ( my ($key, $val) = each %formatted ) {
is( $mech->field($key), $val, "OK: $key field set" );
}
}
{ # apostrophe in surname:
my $patient = clone($patient_2); # warn Dumper $patient;
my $last_name = q!o'soddit-brown!;
$patient->{last_name} = $last_name; # warn Dumper $patient;#
$mech->post('http://localhost/', $patient); # print_output($mech);
$mech->has_tag_like(
p => qr/Form passed validation/,
'OK: validation passed',
);
# put _skip_pds back in (not retained in form):
$mech->field( _skip_pds => 1 );
# submit form to generate pdf (or HTML for non-deployment env):
$mech->submit_form(); # print_output($mech);
$mech->has_tag( span => uc $patient->{last_name}, "OK: last_name field found" );
{ # unique ref should have no non-alphanumeric chars:
my $ref = uc( $patient->{last_name}
. substr($patient->{first_name}, 0, 1) ); # ddp $ref;
$ref =~ s/\W//g;
$mech->has_tag_like(
td => qr/\d+$ref/,
'OK: expected unique ref format found',
);
}
}
done_testing(54);
