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