• Files
• Commits
• Log
• Graph
• Stats

BEGIN { # set test env otherwise get development config settings - unless explicitly
    # set at command-line: "export DANCER_ENVIRONMENT=development; prove -lv t/"
    $ENV{DANCER_ENVIRONMENT} ||= $ENV{PLACK_ENV} ||= 'test';
    $ENV{MY_EMAIL_SENDER_TRANSPORT} = 'Test';
}

use Test::More;
use Test::Most; # bail_on_fail

use Reporter::Class;
use Reporter::Routes;

require_ok('Reporter::Test'); # Data::Printer, Moo, etc
require_ok('Reporter::Routes');

use IO::All;
use Plack::Test;
use HTTP::Cookies;
use Reporter::Test;
use Data::Printer; # ddp \%ENV;
use HTTP::Request::Common; # GET

# create a testing object for app:
my $app = Reporter::Routes->to_app;
isa_ok( $app, 'CODE' );
my $test = Plack::Test->create($app);

# create a testing object for model:
my $model = Reporter::Test->new->app->model;
# get model dbix (using sqlite db):
my $dbix  = $model->db->dbix; # ddp $dbix->dbh->{Name};
my $now   = DateTime->now;

# check test scripts using sqlite in-memory db:
bail_on_fail;
like  ($dbix->dbh->{Name}, qr/:memory:/, 'sqlite db in use');
run_schema(); # create tables & add some data (users, requests, request_specimen, etc)

my $user_id = 1;
{ # userid = username, incorrect password:
    my %params = ( userid => 'queenie', password => 'queenie' );
    my $res = $model->authenticate_user(\%params); # ddp $res;
    is($res, 0, 'incorrect password');
}
{ # userid = username, correct password:
    my %params = ( userid => 'queenie', password => 'Queenie' );
    my $res = $model->authenticate_user(\%params); # ddp $res;
    is( ref $res, 'HASH', 'authenticate returned hashref' );
    is( $res->{username}, 'queenie', 'username matches for userid = username' );
    is( $res->{id}, $user_id, 'user id matches' );
}
{ # userid = email, correct password:
    my %params = ( userid => 'queenie@mail.com', password => 'Queenie' );
    my $res = $model->authenticate_user(\%params); # ddp $res;
    is( ref $res, 'HASH', 'authenticate returned hashref' );
    is( $res->{username}, 'queenie', 'username matches for userid = email' );
}
{ # get reports for user #1:
    my $n = get_reports_for_user($user_id);
    is( $n, 0, "no reports for user id $user_id" );
}
{ # add some draft_reports:
    my %h = (
        user_id      => $user_id,
        request_id   => 1, # will auto-increment in loop
        diagnosis_id => 1,
    );
    $dbix->insert('request_draft_report', \%h) && $h{request_id}++ for (1..5);
        # my $ref = $dbix->select('request_draft_report', '*')->hashes; p $ref;
        # my $n = $dbix->count('request_draft_report'); p $n;
}
{ # get reports for user #1:
    my $n = get_reports_for_user($user_id);
    is( $n, 5, "5 reports for user id $user_id" );
}
{ # user reports:
    my $res = $model->user_reports_list($user_id); # p $res;
    is ( ref $res, 'HASH', 'user reports returned hashref' );
    is ( ref $res->{reports}, 'ARRAY', 'reports is in list format' );
    is ( @{ $res->{reports} }, 5, '5 reports returned' );
    is( ref $res->{specimen}, 'ARRAY', 'specimen is in list format' );
    # contains 5 PB's:
    is ( $res->{specimen}->[0]->{id}, 'PB', 'expected sample type' );
    is ( $res->{specimen}->[0]->{n}, 5, 'expected sample number' );
}
{ # new report:
    my %h = (
        biopsy_site              => 'biopsy site',
        clinical_details         => 'clinical details',
        comment                  => 'comment',
        created_at               => $now,
        diagnosis_id             => 1,
        gross_description        => 'gross description',
        morphology               => 'morphology',
        request_id               => 6,
        request_notes            => 'request notes',
        secondary_diagnosis_id   => undef,
        specimen_quality         => 'specimen quality',
        status                   => 'new',
        user_id                  => $user_id,
    );
    my $res = $model->save_report(\%h); # p $res;
    is ( ref $res, 'HASH', 'save report returned hashref' );
    is ( $res->{success}, 1, 'new record created successfully');
    my $ref = $dbix->select('request_draft_report','*', { request_id => 6 })->hash; # p $ref;
    is_deeply( $ref, \%h, 'data structures identical' );
}
{ # user roles:
    my $response = $test->request( POST '/login',
        [ userid => 'queenie', password => 'Queenie' ] ); # p $response;

    # handle cookies for next request:
    my $cookie_jar = HTTP::Cookies->new;
    $cookie_jar->extract_cookies($response);
        # my @cookies;
        # $cookie_jar->scan( sub { @cookies = @_ }); p \@cookies;
    # create HTTP::Request object and add cookies to it:
    my $request = GET 'http://localhost/'; # full url to match cookie expectation
    $cookie_jar->add_cookie_header( $request ); # p $request->dump;
    # resubmit, should get search page:
    my $content = $test->request( $request ); # p $content;
    like( $content->as_string, qr/Miranda(\s+)RICHARDSON/, 'logged in user displayed' );
    unlike( $content->as_string, qr/register/, 'register link not present' );
    # error if requested directly:
    $request = GET 'http://localhost/register'; # full url to match cookie expectation
    $cookie_jar->add_cookie_header( $request ); # p $request->dump;
    # resubmit, should get search page:
    $content = $test->request( $request ); # p $content;
    is( $content->code, 403, 'forbidden request' );

    { # register admin user role:
        my %h = (
            user_id => $user_id,
            function_id   => 1,
            function_name => 'admin',
        );
        $dbix->insert('user_permission_view', \%h);
        # login again:
        $response = $test->request( POST 'http://localhost/login',
            [ userid => 'queenie', password => 'Queenie' ] ); # p $response;
        my $cookie_jar = HTTP::Cookies->new;
        $cookie_jar->extract_cookies($response);
        # request register link:
        $request = GET 'http://localhost/register'; # full url to match cookie expectation
        $cookie_jar->add_cookie_header( $request ); # p $request->dump;
        $content = $test->request( $request ); # p $content;
        is( $content->code, 200, 'allowed request' );
        like( $content->as_string, qr/register/, 'register link now present' );
    }
}
{ # register new user:
    # login:
    my $response = $test->request( POST '/login',
        [ userid => 'queenie', password => 'Queenie' ] ); # p $response;
    # handle cookies for next request:
    my $cookie_jar = HTTP::Cookies->new;
    $cookie_jar->extract_cookies($response);
    # create HTTP::Request object and add cookies to it:
    my $request = GET 'http://localhost/register'; # full url to match cookie expectation
    $cookie_jar->add_cookie_header( $request ); # p $request->dump;
    # resubmit, should get registration page:
    my $content = $test->request( $request ); # p $content->as_string;
    my %user = (
        first_name  => 'tony',
        last_name   => 'robinson',
        email       => 'baldrick@email.com',
        username    => 'baldrick',
        password    => 'Imbecile',
    );
    $request = POST 'http://localhost/register', \%user; # full url to match cookie expectation
    $cookie_jar->add_cookie_header( $request ); # p $request->dump;
    $content = $test->request( $request ); # p $content->as_string;
    is( $content->code, 200, 'request OK' );
    like( $content->as_string, qr/email failed: test delivery failure/,
         'expected test email response' );
    # examine /tmp/draft_reporter_test_email.txt:
    my $email_text = io('/tmp/draft_reporter_test_email.txt')->slurp; # p $email_text;
    like( $email_text, qr/to: $user{email}/, 'expected user email' );
    like( $email_text, qr/from: no-reply\@hmds.info/, 'expected from address' );
    like( $email_text, qr/reply-to: hmds.lth\@nhs.net/, 'expected reply-to address' );
    like( $email_text, qr/cc: hmds.lth\@nhs.net/, 'expected copy-to address' );
    like( $email_text, qr/subject: HMDS draft reporter registration/,
         'expected subject line' );
    like( $email_text, qr/Your HMDS draft reporter registration details/,
         'expected text body' );
    like( $email_text, qr/username: $user{email}/, 'expected username' ); # email NOT username
    like( $email_text, qr/password: $user{password}/, 'expected password' );
    io('/tmp/draft_reporter_test_email.txt')->unlink;
}

done_testing(36);

sub get_reports_for_user {
    my $user_id = shift;
    my %h = (
        user_id => $user_id,
        page    => 1,
        uri     => '/',
    );
    my $res = $model->get_reports_for_user(\%h); # ddp $res;
    my $n = @{ $res->{reports} };
    return $n;
}

sub run_schema {
    my @schema = _schema();
    do { $dbix->dbh->do($_) || die $dbix->error } foreach @schema; # $dbix->error doesn't work here
    { # draft_report_users & users table:
        my %h = (
            username   => 'queenie',
            first_name => 'miranda',
            last_name  => 'richardson',
            password   => 'WdQRFOH9t2KmvPpjgHCjTunkDpM', # sha1 Queenie
            email      => 'queenie@mail.com',
        );
        $dbix->insert($_, \%h) for qw(draft_report_users users);
    }
    { # requests (5):
        my %h = (
            request_number   => 1, # will auto-increment in loop
            year             => $now->year,
            patient_case_id  => 1,
            status_option_id => 1,
            referrer_department_id => 1,
        );
        $dbix->insert('requests', \%h) && $h{request_number}++ for (1..5);
    }
    { # request_specimen (5) & specimen:
        my $i = 1;
        $dbix->insert('specimens',
            { sample_code => 'PB', description => 'blood' });
        $dbix->insert('request_specimen',
            { request_id => $i++, specimen_id => 1}) for (1..5);
    }
    { # diagnoses:
        my %h = (
            name  => 'CLL',
            icdo3 => '9823/3'
        );
        $dbix->insert('diagnoses', \%h);
    }
}

sub _schema {
    return (
        q{
            CREATE TABLE draft_report_users (
                id INTEGER PRIMARY KEY AUTOINCREMENT,
                username VARCHAR,
                first_name VARCHAR,
                last_name VARCHAR,
                password VARCHAR,
                email VARCHAR
            )
        },
        q{
            CREATE TABLE users (
                id INTEGER PRIMARY KEY AUTOINCREMENT,
                username VARCHAR,
                first_name VARCHAR,
                last_name VARCHAR,
                password VARCHAR,
                email VARCHAR,
                active VARCHAR NOT NULL DEFAULT 'yes'
            )
        },
        q{
            CREATE TABLE request_draft_report (
                user_id INTEGER,
                request_id INTEGER,
                request_notes VARCHAR,
                clinical_details VARCHAR,
                biopsy_site VARCHAR,
                gross_description VARCHAR,
                morphology VARCHAR,
                comment VARCHAR,
                status VARCHAR,
                diagnosis_id INTEGER,
                secondary_diagnosis_id INTEGER,
                specimen_quality INTEGER,
                created_at DATETIME,
                updated_at DATETIME
            )
        },
        q{
            CREATE TABLE requests (
                id INTEGER PRIMARY KEY AUTOINCREMENT,
                request_number INTEGER,
                year INTEGER,
                patient_case_id INTEGER,
                referrer_department_id INTEGER,
                status_option_id INTEGER,
                created_at DATETIME,
                updated_at DATETIME
            )
        },
        q{
            CREATE TABLE request_specimen (
                request_id INTEGER,
                specimen_id INTEGER
            )
        },
        q{
            CREATE TABLE specimens (
                id INTEGER PRIMARY KEY AUTOINCREMENT,
                sample_code TEXT,
                description TEXT,
                active TEXT
            )
        },
        q{
            CREATE TABLE diagnoses (
                id INTEGER PRIMARY KEY AUTOINCREMENT,
                name TEXT,
                icdo3 TEXT,
                diagnostic_category_id INTEGER,
                active TEXT
            )
        },
        q{
            CREATE TABLE user_permission_view (
                user_id INTEGER,
                function_id INTEGER,
                function_name VARCHAR
            )
        }
    );
}