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 => 35;
   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 #    warn "class : $class\n";
  71 #    warn "ISA : ", join(', ',@BeerDB::BeerTestmysql::ISA);
  72     $val = $class->$method($col);
  73
  74     # Hacks for various val types
  75     $val = lc $val if $method eq 'column_type';
  76
  77     my $correct = $correct{$col};
  78     like($val, qr/$correct/,"$method $col is $val");
  79   }
  80
  81 }
  82
  83
  84 # mysql test
  85
  86 # Make test class
  87 package BeerDB::BeerTestmysql;
  88 use base qw(Maypole::Model::CDBI Class::DBI);
  89 package main;
  90
  91 $DB_Class = 'BeerDB::BeerTestmysql';
  92
  93 my $drh = eval { DBI->install_driver("mysql"); };
  94 $err = $@;
  95 if ($err) {
  96   $skip_msg = "no driver for MySQL";
  97 } else {
  98   my %databases = map { $_ => 1 } $drh->func('localhost', 3306, '_ListDBs');
  99
 100   unless ($databases{test}) {
 101     my $rc = $drh->func("createdb", 'test', 'admin');
 102   }
 103
 104   %databases = map { $_ => 1 } $drh->func('localhost', 3306, '_ListDBs');
 105
 106   if ($databases{test}) {
 107     eval {$DB_Class->connection("dbi:mysql:$db", "$dbuser", "$dbpasswd"); };
 108     $err = $@;
 109     $skip_msg = "Could not connect to MySQL using database 'test', username 'test', and password ''. Check privileges and try again.";
 110   } else {
 111     $err = 'no test db';
 112     $skip_msg = "Could not connect to MySQL using database 'test' as it doesn't exist, sorry";
 113   }
 114 }
 115 $skip_howmany = 22;
 116
 117 SKIP: {
 118         skip $skip_msg, $skip_howmany  if $err;
 119         $DB_Class->db_Main->do("drop table if exists $table;");
 120         $DB_Class->db_Main->do($sql);
 121         $DB_Class->table($table);
 122         $DB_Class->columns(All => keys %correct_types);
 123         $DB_Class->columns(Primary => 'id');
 124         run_method_tests($DB_Class,'column_type', %correct_types);
 125         run_method_tests($DB_Class,'column_default', %correct_defaults);
 126         run_method_tests($DB_Class,'column_nullable', %correct_nullables);
 127 };
 128
 129 # SQLite  test
 130
 131 package BeerDB::BeerTestsqlite;
 132 use base qw(Maypole::Model::CDBI Class::DBI);
 133 package main;
 134 use Cwd;
 135
 136 $DB_Class = 'BeerDB::BeerTestsqlite';
 137
 138 $err = undef;
 139 if ( !-e "t/test.db" ) {
 140         eval {make_sqlite_db($sql)};
 141         $err = $@;
 142         if ($err) { print "Skipping sql tests because couldnt make sqlite test db
 143                 because of error: $err";};
 144 }
 145 unless ($err) {
 146         my $driver = sqlite_driver();
 147         warn "using driver : $driver";
 148         my $cwd = cwd;
 149         eval { $DB_Class->connection("dbi:$driver:dbname=$cwd/t/test.db");};
 150         $err = $@;
 151 }
 152
 153 $skip_msg = "Could not connect to SQLite database 't/test.db'";
 154 $skip_howmany = 13;
 155
 156 SKIP: {
 157         skip $skip_msg, $skip_howmany  if $err;
 158         $DB_Class->table($table);
 159         $DB_Class->columns(All => keys %correct_types);
 160         $DB_Class->columns(Primary => 'id');
 161 #use Data::Dumper;
 162         run_method_tests($DB_Class,'column_type', %correct_types);
 163         # No support default
 164         #run_method_tests($DB_Class,'column_default', %correct_defaults);
 165         # I think sqlite driver allows everything to be nullable.
 166         #run_method_tests($DB_Class,'column_nullable', %correct_nullables);
 167
 168 };
 169
 170
 171 # Helper methods, TODO -- put these somewhere where tests can use them.
 172
 173 # returns "best" available sqlite driver or dies
 174 sub sqlite_driver {
 175     my $driver = 'SQLite';
 176     eval { require DBD::SQLite } or do {
 177         print "Error loading DBD::SQLite, trying DBD::SQLite2\n";
 178         eval {require DBD::SQLite2} ? $driver = 'SQLite2'
 179             : die "DBD::SQLite2 is not installed";
 180    };
 181         return $driver;
 182 }
 183
 184
 185 # make_sqlite_db -- makes an sqlite database from params
 186 # usage -- make_sqlite_db($sql [, $dbname ]);
 187 sub make_sqlite_db {
 188         my ($sql, $dbname) = @_;
 189         die "Must provide SQL string" unless length $sql;
 190         $dbname ||= 't/test.db';
 191         print "Making SQLite DB $dbname\n";
 192     my $driver = sqlite_driver;
 193     require DBI;
 194     my $dbh = DBI->connect("dbi:$driver:dbname=$dbname");
 195
 196     for my $statement ( split /;/, $sql ) {
 197         $statement =~ s/\#.*$//mg;           # strip # comments
 198         $statement =~ s/auto_increment//g;
 199         next unless $statement =~ /\S/;
 200         eval { $dbh->do($statement) };
 201         die "$@: $statement" if $@;
 202     }
 203         $dbh->disconnect;
 204         print "Successfully made  SQLite DB $dbname\n";
 205         return 1;
 206 }