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