• Files
• Commits
• Log
• Graph
• Stats

    #!/usr/bin/perl

use strict;
use warnings;

#use Test::More 'no_plan';
use Test::More tests => 486; # changes depending on col types
use Test::Exception;
use Data::Dumper;
use DateTime;

=begin
tests constraints on table cols eg if varchar(50) insert 51 chars, if date insert
invalid date & 'str', if enum insert 'foo'
doesn't test INT (max value 4_294_967_295 for unsigned) or timestamp fields
needs to generate a minimum insert dataset for each table honouring non-null cols
NB - requires "sql_mode = strict_all_tables" in mysqld section of my.cnf
=cut

BEGIN {
    require 't/test-lib.pl';
}

my ($dbh, $dbix);

eval {
    $dbh = get_dbh()  or die 'no database handle recieved from get_dbh';
    $dbix = get_dbix();
};

warn $@ if $@;

# supress error warnings to console:
local $dbh->{'RaiseError'} = 1; # default
local $dbh->{'PrintError'} = 0; # override

# remove prognostic_indicator tables if exist:
for my $tbl( qw/staging_sites patient_staging_site patient_chronologies/ ) {
    $dbh->do( qq!DROP TABLE IF EXISTS `$tbl`! );
}

my @tables = $dbix->query('show tables from lims_test')->flat;

foreach (@tables) {
    next if $_ =~ /^_|view$/; # skip underscore & view tables
    do_table($_);
}

sub do_table {
    my $table = shift; # warn $table;

    my $cols = $dbix->query("show columns from $table")->hashes;

    # hash of col name = field type for non-serial cols:
    my %col_map;
    foreach (@$cols) {
        # only skip auto-incrementing primary_keys:
        next if $_->{key} eq 'PRI' && $_->{extra} eq 'auto_increment';

        my $col = $_->{field};

        $col_map{$col} = {
            type => $_->{type},
            null => $_->{null},
        };
    }

    my %data = ();

    # populate %data with default entries for all non-null cols:
    COL:
    while ( my ($col, $attr) = each %col_map ) { # warn $col; warn Dumper $attr; next;
        # get cols that are required by non-null col attributes:
        next COL unless $attr->{null} eq 'NO';

        if ( my ($enum) = $attr->{type} =~ /enum\(\'(\w+)\'\,/ ) { # warn $enum;
            $data{$col} = $enum;
        }
        elsif ( $attr->{type} eq 'date' ) {
            $data{$col} = DateTime->today->ymd;
        }
        elsif ( $attr->{type} =~ /int\(\d+\)/ ) {
            $data{$col} = 1;
        }
        elsif ( $attr->{type} =~ /text|char/ ) {
            $data{$col} = 'foo';
        }
        # else { warn $attr->{type} }; # should be just timestamps
    } # warn $table; warn Dumper \%data; return;

    # cycle through col_map again setting each enum, (var)char or date col to invalid:
    COL:
    while ( my ($col, $attr) = each %col_map ) { # warn $col; warn Dumper $attr; next;
        my %cloned_data = %data;

        if ( $attr->{type} =~ /^enum/ ) { # warn $n;
            my $val = 'foo'; # warn $val;

            # override $col value if set to default:
            $cloned_data{$col} = $val;

            eval { $dbix->insert($table, \%cloned_data) }; # warn $@; # next COL;

            # test for 'data truncated' msg:
            ok(
                $@ =~ /data truncated/i,
                'OK: expected message received',
            ); # next COL;

            dies_ok {
                $dbix->insert($table, \%cloned_data);
            } "OK: died on insert ($table, $col, $attr->{type})";
        }
        elsif ( my ($n) = $attr->{type} =~ /char\((\d+)\)/ ) { # warn $n;
            my $val = 'a' x ($n + 1); # warn $val;

            # override $col value if set to default:
            $cloned_data{$col} = $val; # warn Dumper \%cloned_data;

            eval { $dbix->insert($table, \%cloned_data) }; # warn $@; # next COL;

            # test for 'data too long' msg:
            ok(
                $@ =~ /data too long/i,
                'OK: expected message received',
            ); # next COL;

            dies_ok {
                $dbix->insert($table, \%cloned_data);
            } "OK: died on insert ($table, $col, $attr->{type})";
        }
        elsif ( $attr->{type} eq 'date' ) {
            foreach ( qw/20-02-31 2000-02-31 str/ ) {
                my $date = $_;

                # override $col value if set to default:
                $cloned_data{$col} = $date;

                eval { $dbix->insert($table, \%cloned_data) }; # warn $@; # next COL;

                # test for 'incorrect date' msg:
                ok(
                    $@ =~ /incorrect date value/i,
                    'OK: expected message recieved',
                );

                dies_ok {
                    $dbix->insert($table, \%cloned_data);
                } "OK: died on insert ($table, $col, $attr->{type})";
            }
        }
    }
}