t/db_colinfo.t

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