The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

BEGIN {push @ARGV, '--dbtest';}

use Test::More;
use Test::Exception;
use Test::Warn;
use lib qw(t);

my $dbh;
    use Test::MockObject;
    $dbh = Test::MockObject->new;
    $dbh->set_isa('DBI');
    $dbh->fake_module('DBI');
    $dbh->mock('prepare_cached', sub {return $dbh;});
    $dbh->set_false('execute');
    $dbh->set_always('errstr', 'Mock error');

plan tests => 1;

use strict;
use warnings;


{

    package TestAppDriverDBISimple;

    use base qw(TestAppDriver);

    __PACKAGE__->authen->config(
        DRIVER => [
            [
                'DBI',
                DBH         => $dbh,
                TABLE       => 'user',
                CONSTRAINTS => { 'user.name' => '__CREDENTIAL_1__', 'user.password' => '__CREDENTIAL_2__' },
            ],
        ],
        STORE => 'Store::Dummy',
    );

}

$ENV{CGI_APP_RETURN_ONLY} = 1;

my $params = {
    authen_username => 'user1',
    authen_password => '123',
    rm => 'protected',
};
my $query = CGI->new( $params );
my $cgiapp = TestAppDriverDBISimple->new( QUERY => $query );
throws_ok {$cgiapp->run;} qr/Error executing class callback in prerun stage: Mock error/, 'throws error correctly';

undef $dbh;