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 => 26;
   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),
  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) 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 # Runs tests on column_* method of $class using %correct data hash
  47 # usage: run_method_tests ($class, $method, %correct);
  48 sub run_method_tests {
  49   ($class, $method,  %correct)  = @_;
  50   for $col (sort keys %correct) {
  51     $val = $class->$method($col);
  52
  53     # Hacks for various val types
  54     $val = lc $val if $method eq 'column_type';
  55
  56     my $correct = $correct{$col};
  57     like($val, qr/$correct/,"$method $col is $val");
  58   }
  59 }
  60
  61
  62 # mysql test
  63
  64 # Make test class
  65 package BeerDB::BeerTestmysql;
  66 use base Maypole::Model::CDBI;
  67 package main;
  68
  69 $DB_Class = 'BeerDB::BeerTestmysql';
  70
  71 my $drh = DBI->install_driver("mysql");
  72 my %databases = map { $_ => 1 } $drh->func('localhost', 3306, '_ListDBs');
  73
  74 unless ($databases{test}) {
  75   my $rc = $drh->func("createdb", 'test', 'admin');
  76 }
  77
  78 %databases = map { $_ => 1 } $drh->func('localhost', 3306, '_ListDBs');
  79
  80 if ($databases{test}) {
  81   eval {$DB_Class->connection("dbi:mysql:$db", "$dbuser", "$dbpasswd"); };
  82   $err = $@;
  83   $skip_msg = "Could not connect to MySQL using database 'test', username 'test', and password ''. Check privileges and try again.";
  84 } else {
  85   $err = 'no test db';
  86   $skip_msg = "Could not connect to MySQL using database 'test' as it doesn't exist, sorry";
  87 }
  88
  89 $skip_howmany = 13;
  90
  91 SKIP: {
  92         skip $skip_msg, $skip_howmany  if $err;
  93         $DB_Class->db_Main->do("drop table if exists $table;");
  94         $DB_Class->db_Main->do($sql);
  95         $DB_Class->table($table);
  96         run_method_tests($DB_Class,'column_type', %correct_types);
  97         #run_method_tests($DB_Class,'column_default', %correct_defaults);
  98         #run_method_tests($DB_Class,'column_nullable', %correct_defaults);
  99 };
 100
 101 # SQLite  test
 102
 103 package BeerDB::BeerTestsqlite;
 104 use base Maypole::Model::CDBI;
 105 package main;
 106
 107 $DB_Class = 'BeerDB::BeerTestsqlite';
 108
 109 $err = undef;
 110 #unlink "t/test.db";
 111 if ( !-e "t/test.db" ) {
 112         eval {make_sqlite_db($sql)};
 113         $err = $@;
 114         if ($err) { print "Skipping sql tests because couldnt make sqlite test db
 115                 because of error: $err";};
 116 }
 117 unless ($err) {
 118         my $driver = sqlite_driver();
 119         eval { $DB_Class->connection("dbi:$driver:dbname='t/test.db'");};
 120         $err = $@;
 121 }
 122
 123 $skip_msg = "Could not connect to SQLite database 't/test.db'";
 124 $skip_howmany = 13;
 125
 126 SKIP: {
 127         skip $skip_msg, $skip_howmany  if $err;
 128         $DB_Class->table($table);
 129         run_method_tests($DB_Class,'column_type', %correct_types);
 130         #run_method_tests($DB_Class,'column_default', %correct_defaults);
 131         #run_method_tests($DB_Class,'column_nullable', %correct_defaults);
 132
 133 };
 134
 135
 136
 137
 138 # Helper methods, TODO -- put these somewhere where tests can use them.
 139
 140 # returns "best" available sqlite driver or dies
 141 sub sqlite_driver {
 142     my $driver = 'SQLite';
 143     eval { require DBD::SQLite } or do {
 144         print "Error loading DBD::SQLite, trying DBD::SQLite2\n";
 145         eval {require DBD::SQLite2} ? $driver = 'SQLite2'
 146             : die "DBD::SQLite2 is not installed";
 147    };
 148         return $driver;
 149 }
 150
 151
 152 # make_sqlite_db -- makes an sqlite database from params
 153 # usage -- make_sqlite_db($sql [, $dbname ]);
 154 sub make_sqlite_db {
 155         my ($sql, $dbname) = @_;
 156         die "Must provide SQL string" unless length $sql;
 157         $dbname ||= 't/test.db';
 158         print "Making SQLite DB $dbname\n";
 159     my $driver = sqlite_driver;
 160     require DBI;
 161     my $dbh = DBI->connect("dbi:$driver:dbname=$dbname");
 162
 163     for my $statement ( split /;/, $sql ) {
 164         $statement =~ s/\#.*$//mg;           # strip # comments
 165         $statement =~ s/auto_increment//g;
 166         next unless $statement =~ /\S/;
 167         eval { $dbh->do($statement) };
 168         die "$@: $statement" if $@;
 169     }
 170         $dbh->disconnect;
 171         print "Successfully made  SQLite DB $dbname\n";
 172         return 1;
 173 }