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