The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;

use Test::More tests => 26;

BEGIN {
    use_ok('DBD::Mock');  
    use_ok('DBI');
}

{
    my $dbh = DBI->connect('DBI:Mock:', '', '', { RaiseError => 1, PrintError => 0 });
    isa_ok($dbh, "DBI::db");
    # check to be sure this is set, otherwise 
    # the test wont be set up right
    cmp_ok($dbh->{RaiseError}, '==', 1, '... make sure RaiseError is set correctly');
    
    # check parse sub-refs
    
    my $parser = sub {
        my ($sql) = @_;
        die "incorrect use of '*'\n" if $sql =~ /^SELECT \*/;
    };
    
    eval { 
        $dbh->{mock_add_parser} = $parser; 
    };
    ok(!$@, '... parser successfully added to dbh');
    
    is($dbh->{mock_parser}->[0], $parser, '... the same parser is stored');
    
    my $sth1 = eval { $dbh->prepare('SELECT myfield FROM mytable') };
    isa_ok($sth1, "DBI::st");
                        
    my $sth2 = eval { $dbh->prepare( 'SELECT * FROM mytable' ) };
    ok(!defined($sth2), '... we should get nothing back from here');
    
    like($@, 
        qr/Failed to parse statement\. Error\: incorrect use of \'\*\'\. Statement\: SELECT \* FROM mytable/, 
        '... parser failure generated correct error');
        
    $dbh->disconnect();
}

# parser class
{
    package MyParser;
    
    sub new { return bless {} }
    sub parse { 
        my ($self, $sql) = @_;
        die "incorrect use of '*'\n" if $sql =~ /^SELECT \*/;        
    }
}

{
    my $dbh = DBI->connect('DBI:Mock:', '', '', { PrintError => 1 });
    isa_ok($dbh, "DBI::db");
    # check to be sure this is set, otherwise 
    # the test wont be set up right
    cmp_ok($dbh->{PrintError}, '==', 1, '... make sure PrintError is set correctly'); 
    
    # check parse objects
    
    my $parser = MyParser->new();
    
    eval { 
        $dbh->{mock_add_parser} = $parser; 
    };
    ok(!$@, '... parser successfully added to dbh');
    
    is($dbh->{mock_parser}->[0], $parser, '... the same parser is stored');
    
    my $sth1 = eval { $dbh->prepare('SELECT myfield FROM mytable') };
    isa_ok($sth1, "DBI::st");
     
    { # isolate the warn handler 
        local $SIG{__WARN__} = sub {
            my $msg = shift;
            like($msg, 
                 qr/incorrect use of \'\*\'\. Statement\: SELECT \* FROM mytable/,  #'
                 '...got the expected warning');
        };                        
                                                              
        my $sth2 = eval { $dbh->prepare( 'SELECT * FROM mytable' ) };
        ok(!defined($sth2), '... we should get nothing back from here');
    }
    
    $dbh->disconnect();    
}


{ # pass in a bad parser
    my $dbh = DBI->connect('DBI:Mock:', '', '', { RaiseError => 1, PrintError => 0 });
    isa_ok($dbh, "DBI::db");
    # check to be sure this is set, otherwise 
    # the test wont be set up right
    cmp_ok($dbh->{RaiseError}, '==', 1, '... make sure RaiseError is set correctly');
    
    eval { 
        $dbh->{mock_add_parser} = "Fail"; 
    };
    like($@, qr/Parser must be a code reference or /, '... bad parser successfully not added to dbh');
    
    eval { 
        $dbh->{mock_add_parser} = []; 
    };
    like($@, qr/Parser must be a code reference or /, '... bad parser successfully not added to dbh');

}

{
    # check it with PrintError too
 
    my $dbh = DBI->connect('DBI:Mock:', '', '');
    isa_ok($dbh, "DBI::db");
    # check to be sure this is set, otherwise 
    # the test wont be set up right
    cmp_ok($dbh->{PrintError}, '==', 1, '... make sure PrintError is set correctly');
    
    { # isolate the warn handler 
        local $SIG{__WARN__} = sub {
            my $msg = shift;
            like($msg, 
                 qr/Parser must be a code reference or /, 
                 '... bad parser successfully not added to dbh');
        };                        

        ok(!defined($dbh->{mock_add_parser} = {}), '... this returns undef too'); 

        my $test = "Fail";
        
        ok(!defined($dbh->{mock_add_parser} = \$test), '... this returns undef too'); 

    }    
    
}