t/db_colinfo.t

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