use 5.34.0; # say
# run: carmel exec prove -lv t/dpw.t
BEGIN { # set test env otherwise development config settings loaded - unless explicitly
# set at command-line: "export DANCER_ENVIRONMENT=development; prove -lv t/"
$ENV{DANCER_ENVIRONMENT} ||= $ENV{PLACK_ENV} ||= 'test';
}
use File::Path 'remove_tree'; # say "$_: $INC{$_}" for sort keys %INC;
use File::Spec::Functions; # catfile
use Test::WWW::Mechanize;
use LWP::Protocol::PSGI;
use Data::Printer;
use Data::Dumper;
use Test::More;
use_ok('DocsLib');
open my $fh, '>' . $FindBin::Bin . '/mech.htm' or die $!;
my $psgi_app = DocsLib::runner()->psgi_app;
LWP::Protocol::PSGI->register($psgi_app);
my $mech = Test::WWW::Mechanize->new;
my $cfg = DocsLib->dancer_app->settings; # p $cfg; exit;
my $tbl = 'dpw';
# check we have test env config, or die:
die "####### incorrect config loaded ########" unless $cfg->{environment} eq 'test';
{ # clear test-files dir 1st:
my $docs_path = $cfg->{documents_path}; # say $docs_path;
die '####### '.$docs_path.' upload path does not exist' unless -e $docs_path;
die "####### incorrect docs-path ########" unless $docs_path =~ m!t/file-tree!;
remove_tree( catfile($docs_path,'household'), { keep_root => 1, error => \my $err } );
die Dumper $err if @$err;
}
my $test_file = $cfg->{appdir} . 't/src/Uniden_Bearcat_scanner.jpg'; # appdir has trailing '/'
my ($filename) = $test_file =~ m!/src/(.*)!;
# my $model = get_app_model($cfg); # p $model; # not using
my $url = 'http://localhost/dpw';
do_login(); # print_and_exit();
my %entry = (
description => 'Unident Bearcat scanner', # deliberate spelling error, corrected later
filename => $test_file,
category => 'Domestic',
retained => 'n',
comment => 'E-bay via PayPal',
date => '2011-03-06',
);
SKIP: {
skip( q!these tests require adapting for htmx inputs!, 1 );
{ # upload test file:
$mech->get_ok($url); # debug($mech);
$mech->form_number(2);
$mech->field($_, $entry{$_}) for keys %entry;
$mech->submit;
$mech->has_tag_like( 'div', qr/Input success/, 'OK: input success'); # debug($mech);
$mech->text_contains('Total records 1', 'OK: expected number of records');
my $path = catfile($cfg->{documents_path},'household', 'domestic', $filename); #p $path;
is( -e $path, 1, 'OK: expected path to uploaded file');
}
{ # search for description
$mech->get_ok($url);
$mech->form_number(1);
$mech->field(search => 'uniden');
$mech->submit; # print_and_exit();
$mech->text_contains('Total records: 1', 'OK: search successful');
}
{ # re-upload test file, get duplicate file error:
$mech->get_ok($url); # debug($mech);
$mech->form_number(2);
$mech->field($_, $entry{$_}) for keys %entry;
$mech->submit; # debug($mech);
my $msg = qw/file "$test_file" already exists/;
$mech->has_tag_like( 'div', $msg, 'OK: duplicate file input failed'); # print_and_exit();
# still contains only 1 entry:
$mech->text_contains('Total records 1', 'OK: still has expected number of records');
}
{ # edit entry, correct spelling error in description:
$mech->get_ok($url.'/edit/1'); # print_and_exit();
$mech->content_like( qr{/dpw/update/1}, 'OK: edit form loaded' );
# correct spelling error (global):
$entry{description} = 'Uniden Bearcat scanner';
local $entry{filename} = $filename; # needs filename not file
$mech->form_number(2);
$mech->field($_, $entry{$_}) for keys %entry;
$mech->submit; # print_and_exit();
$mech->content_like( qr/$entry{description}/, 'OK: description updated');
$mech->content_unlike( qr/$entry{description}t/, 'OK: original description not found');
}
{ # search for old description with spelling error:
$mech->get_ok($url);
$mech->form_number(1);
$mech->field(search => 'unident');
$mech->submit; # print $mech->text;
$mech->text_contains(q!No records found matching "unident"!,
'OK: search failed to find mis-spelled description');
}
{ # edit entry, change category:
$mech->get_ok($url.'/edit/1'); # print_and_exit();
$mech->content_like( qr{/dpw/update/1}, 'OK: edit form loaded' );
# change category:
$entry{category} = 'photography';
local $entry{filename} = $filename; # needs filename not file
$mech->form_number(2);
$mech->field($_, $entry{$_}) for keys %entry;
$mech->submit; # print_and_exit();
$mech->content_like( qr/option value="photography" selected/,
'OK: new category accepted');
my @links = $mech->find_all_links( url_regex => qr/$filename/ ); # p @links;
is( scalar @links, 1, 'OK: have expected link'); # can't follow link http not available
like( $links[0]->url, qr{/photography/$filename}, 'OK: expected category in link');
# is uploaded file in expected location
my $path = catfile($cfg->{documents_path},'household', 'photography', $filename); #p $path;
is( -e $path, 1, 'OK: expected path to uploaded file');
# is uploaded file in original location
my $old_path = catfile($cfg->{documents_path},'household', 'domestic', $filename); #p $path;
is( -e $old_path, undef, 'OK: uploaded file not in original location');
}
{ # invalid date #1
$mech->get_ok($url); # debug($mech);
$mech->form_number(2);
# change category back to original (OK because file was moved above)
$entry{category} = 'domestic';
# change date:
local $entry{date} = '2000-02-99'; #
$mech->field($_, $entry{$_}) for keys %entry;
$mech->submit; # print_and_exit();
$mech->text_contains('CHECK constraint failed: date(date) IS NOT NULL',
'OK: date failed sqlite3 date validation');
$mech->text_contains('Total records 1', 'OK: still only 1 record');
}
{ # invalid date #2 - this passes - TODO: get date validator
$mech->get_ok($url); # debug($mech);
$mech->form_number(2);
# change date:
local $entry{date} = '2000-02-31';
$mech->field($_, $entry{$_}) for keys %entry;
$mech->submit; # print_and_exit();
# record is accepted, date adjusted to 2nd March 2000 by javascript in tt and file
# accepted since category is different to existing filename
$mech->has_tag_like( 'div', qr/Input success/, 'OK: input success'); # debug($mech);
$mech->text_contains('Total records 2', 'OK: has 2 records');
# check both files present:
for my $category (qw/photography domestic/ ) {
my $path = catfile($cfg->{documents_path},'household', $category, $filename); #p $path;
is( -e $path, 1, "OK: expected path to uploaded file for $category category");
}
}
}
# sub get_row_count { $model->total_count($tbl) } # doesn't work, always zero !!!
sub print_and_exit {
print $fh $mech->content; done_testing(); exit;
}
sub do_login {
my $userid = $cfg->{user}->{name};
my $passwd = $cfg->{user}->{plain_text_pwd}
|| die qq!require 'plain_text_pwd' setting in test_local.yml file!;
my $response = $mech->get_ok($url); # print_and_exit();
# ok($response->header('Set-Cookie'), 'has cookie header');
like( $mech->cookie_jar->as_string(), qr/dancer.session/, 'cookie was accepted' );
# confirm login box loaded:
$mech->content_contains( 'Login', 'login box loaded' );
### select 1st form:
# $mech->form_name('login_form');
# login:
$mech->submit_form(
fields => {
username => $userid,
password => $passwd,
}
);
# confirm logged in:
$mech->has_tag( 'h1', 'DPW Filing Cabinet', 'OK: expected page title after login');
}
sub debug {
my $response = shift; say $response->content;
print_output($response);
}
sub print_output {
my $response = shift;
print $fh $response->content;
}
sub get_app_model { # not used
my $cfg = shift;
my %h = (
cfg => $cfg,
db => App::DB->new( cfg => $cfg )
);
my $model = Model::Core->new(%h);
return $model;
}
done_testing();
