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
   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),
  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) default 1,
  27     brewery integer default NULL
  28 );";
  29
  30 # correct column types and the ones we test
  31 %correct_types = (
  32     id                  =>      'int(11)', # mysql 4.1 stores this for 'integer'
  33         brewery         =>      'int(11)',
  34     style               =>      'mediumint(8)',
  35     name                =>      'char(30)',
  36     url                 =>  'varchar(120)',
  37     tasted              =>      'date',
  38     created     =>      'timestamp',
  39         modified        =>      'datetime',
  40     score               =>      'smallint(2)',
  41     price               =>      'decimal(3,2)',
  42     abv                 =>      'varchar(10)',
  43     notes               => 'text',
  44         image           =>      'blob',
  45 );
  46
  47 # Runs tests on column_* method of $class using %correct data hash
  48 # usage: run_method_tests ($class, $method, %correct);
  49 sub run_method_tests {
  50         ($class, $method,  %correct)  = @_;
  51         for $col (sort keys %correct) {
  52                 $val = $class->$method($col);
  53
  54                 # Hacks for various val types
  55                 $val = lc $val if $method eq 'column_type';
  56
  57                 is($val,  $correct{$col},"$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
  68 package main;
  69
  70 $DB_Class = 'BeerDB::BeerTestmysql';
  71 eval {$DB_Class->connection("dbi:mysql:$db", "$dbuser", "$dbpasswd"); };
  72 $err = $@;
  73 $skip_msg = "Could not connect to MySQL using database 'test', username 'test', and password ''. Check privelages and try again.";
  74 $skip_howmany = 13;
  75
  76 SKIP: {
  77         skip $skip_msg, $skip_howmany  if $err;
  78
  79         $DB_Class->db_Main->do("drop table if exists $table;");
  80         $DB_Class->db_Main->do($sql);
  81         $DB_Class->table($table);
  82         run_method_tests($DB_Class,'column_type', %correct_types);
  83         #run_method_tests($DB_Class,'column_default', %correct_defaults);
  84         #run_method_tests($DB_Class,'column_nullable', %correct_defaults);
  85 };
  86
  87 # SQLite  test
  88
  89 package BeerDB::BeerTestsqlite;
  90 use base Maypole::Model::CDBI;
  91 package main;
  92
  93 $DB_Class = 'BeerDB::BeerTestsqlite';
  94
  95 #unlink "t/test.db";
  96 if ( !-e "t/test.db" ) {
  97         eval {make_sqlite_db($sql)};
  98         $err = $@;
  99         if ($err) { print "Skipping sql tests because couldnt make sqlite test db
 100                 because of error $err"; exit; };
 101 }
 102
 103 my $driver = sqlite_driver();
 104 eval { $DB_Class->connection("dbi:$driver:dbname='t/test.db'");};
 105 $err = $@;
 106 if ($err) { die "CDBI connection error: $err"; }
 107 $skip_msg = "Could not connect to SQLite database 't/test.db'";
 108 $skip_howmany = 13;
 109
 110 SKIP: {
 111         skip $skip_msg, $skip_howmany  if $err;
 112         $DB_Class->table($table);
 113         run_method_tests($DB_Class,'column_type', %correct_types);
 114         #run_method_tests($DB_Class,'column_default', %correct_defaults);
 115         #run_method_tests($DB_Class,'column_nullable', %correct_defaults);
 116
 117 };
 118
 119
 120
 121
 122 # Helper methods, TODO -- put these somewhere where tests can use them.
 123
 124 # returns "best" available sqlite driver or dies
 125 sub sqlite_driver {
 126     my $driver = 'SQLite';
 127     eval { require DBD::SQLite } or do {
 128         print "Error loading DBD::SQLite, trying DBD::SQLite2\n";
 129         eval {require DBD::SQLite2} ? $driver = 'SQLite2'
 130             : die "DBD::SQLite2 is not installed";
 131    };
 132         return $driver;
 133 }
 134
 135
 136 # make_sqlite_db -- makes an sqlite database from params
 137 # usage -- make_sqlite_db($sql [, $dbname ]);
 138 sub make_sqlite_db {
 139         my ($sql, $dbname) = @_;
 140         die "Must provide SQL string" unless length $sql;
 141         $dbname ||= 't/test.db';
 142         print "Making SQLite DB $dbname\n";
 143     my $driver = sqlite_driver;
 144     require DBI;
 145     my $dbh = DBI->connect("dbi:$driver:dbname=$dbname");
 146
 147     for my $statement ( split /;/, $sql ) {
 148         $statement =~ s/\#.*$//mg;           # strip # comments
 149         $statement =~ s/auto_increment//g;
 150         next unless $statement =~ /\S/;
 151         eval { $dbh->do($statement) };
 152         die "$@: $statement" if $@;
 153     }
 154         $dbh->disconnect;
 155         print "Successfully made  SQLite DB $dbname\n";
 156         return 1;
 157 }