# https://github.com/PerlDancer/Dancer2/blob/docs/doc-rewrite-grant/lib/Dancer2/Manual/Tutorial.pod
# run: carmel exec prove -lv t/household.t
use 5.34.0; # say
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 Path::Tiny qw(tempfile);
use HTTP::Request::Common;
use Data::Printer;
use HTTP::Cookies;
use Plack::Test;
use HTML::Form;
use Test::More;
use App::Test; # get_next_location, process_request & initialise
use_ok('DocsLib');
my $test = Plack::Test->create( DocsLib->to_app ); # p $test->app; exit;
my $jar = HTTP::Cookies->new();
my $cfg = DocsLib->dancer_app->settings; # p $cfg; exit;
my $url = 'http://localhost/dpw';
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 %hx_request_headers = (
HX_Target => 'content-div', # ← optional: element id to swap
HX_Trigger => 'save-button', # ← optional: id/name of the triggering element
HX_Request => 'true', # ← required by htmx
HX_Current_URL => '/', # necessary for correct url in record.tt using hx-current-url header
);
App::Test::initialise( $jar, $test );
# 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/(.*)!;
# use 'our' to allow temporary dynamic block substitution
our %entry = (
description => 'Unident Bearcat scanner', # deliberate spelling error, corrected later
filename => $filename,
category => 'domestic',
retained => 'n',
comment => 'E-bay via PayPal',
date => '2011-03-06',
);
subtest 'Landing page' => sub {
my $res = $test->request( GET '/dpw/' );
ok( $res->is_redirect, '[GET /] redirect' );
};
subtest 'Login' => sub {
my @fields = (
username => $userid,
password => $passwd,
);
my $request = POST '/login', \@fields ;
my $response = $test->request( $request );
ok( $response->is_redirect, '[POST /login] redirect' );
# handle cookies for next request:
$jar->extract_cookies($response);
};
subtest 'Home page' => sub {
# create HTTP::Request object and add cookies to it:
my $req = GET $url . '/', %hx_request_headers;
$jar->add_cookie_header( $req ); # p $req->dump;
# resubmit GET '/', should get 'new_document' link:
my $res = $test->request( $req ); # p $res;
like( $res->as_string, qr{/dpw/new_document}, 'have link for new document' );
};
subtest 'Create document' => sub {
# need to temporarily substitute $entry{filename} with array including content-type:
my $req = do {
local $entry{filename} = [ $test_file, $filename, 'image/jpeg' ];
POST $url . '/create', Content_Type => 'form-data',
Content => \%entry, %hx_request_headers;
};
my $res = process_request($req);
# successful input gets redirect
ok( $res->is_redirect, '[POST /create] redirect' ); # p %entry;
# have to retrieve update manually due to redirect:
my $next = get_next_location($res); # say $next->as_string;
like( $next->as_string, qr/Input success/, 'has input success' );
like( $next->as_string, qr/$entry{$_}/,
"have expected content [$_ => $entry{$_}]" ) for keys %entry;
my $txt = App::Test::html2txt($next);
like( $txt, qr/Total records 1/, 'expected number of records' );
my $path = catfile($cfg->{documents_path},'household', 'domestic', $filename); # say $path;
ok( -e $path, 'OK: expected path to uploaded file');
};
subtest 'Edit document' => sub {
my $req = GET $url . '/edit/1', # full url to match cookie expectation
%hx_request_headers; # p $req;
$jar->add_cookie_header( $req );
my $res = $test->request( $req ); # p $res;
like( $res->as_string, qr{/update/1}, 'contains update link' );
like( $res->as_string, qr/Unident/, 'has expected content [Unident]' );
};
subtest 'Update document' => sub {
$entry{description} = 'Uniden Bearcat scanner';
my $req = POST $url . '/update/1', \%entry, %hx_request_headers; # p %entry;
my $res = process_request($req);
# successful input gets redirect
ok( $res->is_redirect, '[POST /update] redirect' );
# have to retrieve update manually due to redirect:
my $next = get_next_location($res);
like( $next->as_string, qr/Update success/, 'has update success' );
like( $next->as_string, qr/$entry{$_}/,
"have expected content [$_ => $entry{$_}]" ) for keys %entry;
# original text not found:
unlike( $next->as_string, qr/Unident/, 'lacks original content [Unident]' );
};
subtest 'Edit file' => sub {
note "STEP 1 — fetch the edit form";
my $edit_form_res = do {
my $req = GET $url . '/edit/1?replace_file=1', %hx_request_headers;
process_request($req);
};
ok($edit_form_res->is_success, 'Fetched edit form');
note "STEP 2 — parse the form";
my $form = HTML::Form->parse($edit_form_res); # p $form;
isa_ok( $form, 'HTML::Form' );
# note "Form action: " . $form->action;
# note "Form method: " . $form->method;
note "STEP 3 — modify the values you want";
# create temp file:
my $temp = tempfile();
$temp->spew("Test file content\n"); # Path::Tiny
{
local $entry{filename} = [ $temp->stringify, 'test.txt', 'text/plain' ]; # p %entry;
$form->value( $_ => $entry{$_} ) for keys %entry;
}
note "STEP 4 — submit to the hx-post endpoint (or form action)";
$form->method('POST'); # force POST for submission
my $update_form_req = $form->make_request;
# --- IMPORTANT: detect hx-post & override URL if hx-post exists ---
my $hx_post = $form->attr('hx-post');
note "Detected hx-post: $hx_post";
$update_form_req->uri($url.$hx_post) if $hx_post; # or get 404 not found
note "STEP 5 — attach htmx headers";
$update_form_req->header(%hx_request_headers);
note "STEP 6 — attach cookies + send request";
my $update_form_res = process_request($update_form_req); # p $update_form_req;
ok( $update_form_res->is_redirect, '[POST /create] redirect' );
# have to retrieve update manually due to redirect:
my $next = get_next_location($update_form_res); # say $next->as_string;
like( $next->as_string, qr/Update success/, 'has update success' );
{
local $entry{filename} = 'test.txt';
like( $next->as_string, qr/$entry{$_}/,
"have expected content [$_ => $entry{$_}]" ) for keys %entry;
}
unlike( $next->as_string, qr/$filename/, 'lacks original filename' );
my $txt = App::Test::html2txt($next);
like( $txt, qr/Total records 1/, 'expected number of records' );
my $path = catfile($cfg->{documents_path},'household', 'domestic', 'test.txt'); # say $path;
ok( -e $path, 'OK: expected path to new file');
};
subtest 'Search' => sub {
my $req = POST $url . '/search' , [ search => 'scanner' ], %hx_request_headers;
# don't need to add cookies here as route isn't protected by login
my $res = $test->request( $req ); # p $res;
like( $res->as_string, qr/scanner/,
'search by free-text returned search term' );
};
subtest 'Test error' => sub {
my %data = (title => 'title', content => 'content', test_err => 'test error');
my $req = POST $url . '/create', \%data, %hx_request_headers;
$jar->add_cookie_header( $req );
my $res = $test->request( $req ); # p $res;
like( $res->as_string, qr/test error/, 'has error string' );
};
subtest 'Invalid Download' => sub {
my @tests = (
# { id => '', error => 'Invalid file name' }, # no matching route
{ id => '', error => 'Page not found' }, # custom 404 page
{ id => '.', error => 'Invalid file name' },
{ id => '..', error => 'Invalid file name' },
# { id => '../etc/passwd', error => 'Access denied' }, # no matching route
{ id => '../etc/passwd', error => 'Page not found' }, # custom 404 page
{ id => 'nonexist.txt', error => 'Access denied' },
);
for my $t (@tests) {
my $req = GET $url . '/download/domestic/'.$t->{id}, %hx_request_headers;
$jar->add_cookie_header( $req );
my $res = $test->request( $req ); # p $res;
like( $res->as_string, qr/$t->{error}/, qq!has expected error for "$t->{id}"! );
}
};
done_testing(11);
