t/db_colinfo.t

   1 #!/usr/bin/perl -w
   2 use Test::More;
   3 use Data::Dumper;
   4 use DBI;
   5 use lib 'examples'; # Where BeerDB should live
   6 BEGIN {
   7         my $drh = eval { DBI->install_driver("mysql"); };
   8         my $testcount = ($@) ? 45 : 65 ;
   9         plan tests => $testcount;
  10 }
  11
  12 $db             = 'test';
  13 $dbuser         = 'test';
  14 $dbpasswd   = '';
  15 $table = "beer_test";
  16 $sql = "
  17 create table $table (
  18     id integer auto_increment primary key,
  19     name char(30) NOT NULL default 'noname',
  20     url varchar(120),
  21     score smallint(2),
  22     price decimal(3,2),
  23     abv varchar(10),
  24     image blob,
  25     notes text,
  26     tasted date NOT NULL,
  27     created timestamp default CURRENT_TIMESTAMP,
  28     modified datetime  default NULL,
  29     style mediumint(8) NOT NULL default 1,
  30     brewery integer default NULL
  31 );";
  32
  33 # correct column types and the ones we test
  34 %correct_types = (
  35                   id            =>      'int', # mysql 4.1 stores this for 'integer'
  36                   brewery       =>      'int',
  37                   style         =>      'int',
  38                   name          =>      'char',
  39                   url           =>  'varchar',
  40                   tasted        =>      'date',
  41                   created       =>      '(time|time)',
  42                   modified      =>      '(date|time)',
  43                   score         =>      'smallint',
  44                   price         =>      'decimal',
  45                   abv           =>      'varchar',
  46                   notes         =>  '(text|blob)',
  47                   image         =>      'blob',
  48 );
  49
  50 # correct defaults
  51 %correct_defaults = (
  52                   created       =>      'CURRENT_TIMESTAMP',
  53                   modified      =>      undef,
  54                   style         => 1,
  55                   name      => 'noname',
  56 );
  57
  58 # correct nullables
  59 %correct_nullables = (
  60                   brewery   => 1,
  61                   modified      => 1,
  62                   style         => 0,
  63                   name      => 0,
  64                   tasted    => 0,
  65 );
  66
  67
  68 # Runs tests on column_* method of $class using %correct data hash
  69 # usage: run_method_tests ($class, $method, %correct);
  70 sub run_method_tests {
  71   ($class, $method,  %correct)  = @_;
  72   for $col (sort keys %correct) {
  73
  74     $val = $class->$method($col);
  75
  76     # Hacks for various val types
  77     $val = lc $val if $method eq 'column_type';
  78
  79     my $correct = $correct{$col};
  80     like($val, qr/$correct/,"$method $col is $val");
  81   }
  82
  83 }
  84
  85
  86 # mysql test
  87
  88 # Make test class
  89 package BeerDB::BeerTestmysql;
  90 use base qw(Maypole::Model::CDBI Class::DBI);
  91 package main;
  92
  93 $DB_Class = 'BeerDB::BeerTestmysql';
  94
  95 my $drh = eval { DBI->install_driver("mysql"); };
  96 $err = $@;
  97 if ($err) {
  98   $skip_msg = "no driver for MySQL";
  99 } else {
 100   my %databases = map { $_ => 1 } $drh->func('localhost', 3306, '_ListDBs');
 101
 102   unless ($databases{test}) {
 103     my $rc = $drh->func("createdb", 'test', 'admin');
 104   }
 105
 106   %databases = map { $_ => 1 } $drh->func('localhost', 3306, '_ListDBs');
 107
 108   if ($databases{test}) {
 109     eval {$DB_Class->connection("dbi:mysql:$db", "$dbuser", "$dbpasswd"); };
 110     $err = $@;
 111     $skip_msg = "Could not connect to MySQL using database 'test', username 'test', and password ''. Check privileges and try again.";
 112   } else {
 113     $err = 'no test db';
 114     $skip_msg = "Could not connect to MySQL using database 'test' as it doesn't exist, sorry";
 115   }
 116 }
 117 $skip_howmany = 22;
 118
 119 SKIP: {
 120         skip $skip_msg, $skip_howmany  if $err;
 121         $DB_Class->db_Main->do("drop table if exists $table;");
 122         $DB_Class->db_Main->do($sql);
 123         $DB_Class->table($table);
 124         $DB_Class->columns(All => keys %correct_types);
 125         $DB_Class->columns(Primary => 'id');
 126         run_method_tests($DB_Class,'column_type', %correct_types);
 127         run_method_tests($DB_Class,'column_default', %correct_defaults);
 128         run_method_tests($DB_Class,'column_nullable', %correct_nullables);
 129
 130
 131         foreach my $colname ( @{$DB_Class->required_columns()} ) {
 132             ok($correct_nullables{$colname} == 0,"nullable column $colname is required (via required_columns)");
 133         }
 134
 135         foreach my $colname (keys %correct_nullables) {
 136             ok( $DB_Class->column_required($colname) == !$correct_nullables{$colname}, "nullable column $colname is required (via column_required)" )
 137         }
 138
 139         ok($DB_Class->required_columns([qw/score/]), 'set required column(s)');
 140
 141         foreach my $colname ( @{$DB_Class->required_columns()} ) {
 142             ok($correct_nullables{$colname} == 0 || $colname eq 'score',"nullable or required column $colname is required (via required_columns)" );
 143         }
 144
 145         foreach my $colname (keys %correct_nullables) {
 146             if ($colname eq 'score') {
 147                 ok( $DB_Class->column_required($colname) == 0, "nullable column $colname is required (via column_required)");
 148             } else {
 149                 ok( $DB_Class->column_required($colname) == !$correct_nullables{$colname}, "nullable column $colname is required (via column_required)");
 150             }
 151         }
 152 };
 153
 154 # SQLite  test
 155
 156 package BeerDB::BeerTestsqlite;
 157 use base qw(Maypole::Model::CDBI Class::DBI);
 158 package main;
 159 use Cwd;
 160
 161 $DB_Class = 'BeerDB::BeerTestsqlite';
 162
 163 $err = undef;
 164 if ( !-e "t/test.db" ) {
 165         eval {make_sqlite_db($sql)};
 166         $err = $@;
 167         if ($err) { print "Skipping sql tests because couldnt make sqlite test db
 168                 because of error: $err";};
 169 }
 170 unless ($err) {
 171         my $driver = sqlite_driver();
 172         warn "using driver : $driver";
 173         my $cwd = cwd;
 174         eval { $DB_Class->connection("dbi:$driver:dbname=$cwd/t/test.db");};
 175         $err = $@;
 176 }
 177
 178 $skip_msg = "Could not connect to SQLite database 't/test.db'";
 179 $skip_howmany = 13;
 180
 181 SKIP: {
 182         skip $skip_msg, $skip_howmany  if $err;
 183         $DB_Class->table($table);
 184         $DB_Class->columns(All => keys %correct_types);
 185         $DB_Class->columns(Primary => 'id');
 186 #use Data::Dumper;
 187         run_method_tests($DB_Class,'column_type', %correct_types);
 188         # No support default
 189         #run_method_tests($DB_Class,'column_default', %correct_defaults);
 190         # I think sqlite driver allows everything to be nullable.
 191         #run_method_tests($DB_Class,'column_nullable', %correct_nullables);
 192
 193         ok($DB_Class->required_columns([qw/score style name tasted/]), 'set required column(s)');
 194
 195
 196         foreach my $colname ( @{$DB_Class->required_columns()} ) {
 197             ok($correct_nullables{$colname} == 0 || $colname eq 'score',"nullable or required column $colname is required (via required_columns)" );
 198         }
 199
 200         foreach my $colname (keys %correct_nullables) {
 201             if ($colname eq 'score') {
 202                 ok( $DB_Class->column_required($colname) == 0, "nullable column $colname is required (via column_required)");
 203             } else {
 204                 ok( $DB_Class->column_required($colname) == !$correct_nullables{$colname}, "nullable column $colname is required (via column_required)");
 205             }
 206         }
 207
 208 };
 209
 210
 211 # Helper methods, TODO -- put these somewhere where tests can use them.
 212
 213 # returns "best" available sqlite driver or dies
 214 sub sqlite_driver {
 215     my $driver = 'SQLite';
 216     eval { require DBD::SQLite } or do {
 217         print "Error loading DBD::SQLite, trying DBD::SQLite2\n";
 218         eval {require DBD::SQLite2} ? $driver = 'SQLite2'
 219             : die "DBD::SQLite2 is not installed";
 220    };
 221         return $driver;
 222 }
 223
 224
 225 # make_sqlite_db -- makes an sqlite database from params
 226 # usage -- make_sqlite_db($sql [, $dbname ]);
 227 sub make_sqlite_db {
 228         my ($sql, $dbname) = @_;
 229         die "Must provide SQL string" unless length $sql;
 230         $dbname ||= 't/test.db';
 231         print "Making SQLite DB $dbname\n";
 232     my $driver = sqlite_driver;
 233     require DBI;
 234     my $dbh = DBI->connect("dbi:$driver:dbname=$dbname");
 235
 236     for my $statement ( split /;/, $sql ) {
 237         $statement =~ s/\#.*$//mg;           # strip # comments
 238         $statement =~ s/auto_increment//g;
 239         next unless $statement =~ /\S/;
 240         eval { $dbh->do($statement) };
 241         die "$@: $statement" if $@;
 242     }
 243         $dbh->disconnect;
 244         print "Successfully made  SQLite DB $dbname\n";
 245         return 1;
 246 }