use WWW::Mechanize::TreeBuilder; # look_down() use Test::WWW::Mechanize; use LWP::Protocol::PSGI; use Test::More; use Data::Printer alias => 'ddp'; # 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 $app = RequestForm::app; # ddp $app->session; my $config = RequestForm::app->settings; # ddp $config; exit; my @required_fields = get_required_fields($config); # ddp @required_fields; 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(56);