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 $err = undef;
  96 #unlink "t/test.db";
  97 if ( !-e "t/test.db" ) {
  98         eval {make_sqlite_db($sql)};
  99         $err = $@;
 100         if ($err) { print "Skipping sql tests because couldnt make sqlite test db
 101                 because of error: $err";};
 102 }
 103 unless ($err) {
 104         my $driver = sqlite_driver();
 105         eval { $DB_Class->connection("dbi:$driver:dbname='t/test.db'");};
 106         $err = $@;
 107 }
 108
 109 $skip_msg = "Could not connect to SQLite database 't/test.db'";
 110 $skip_howmany = 13;
 111
 112 SKIP: {
 113         skip $skip_msg, $skip_howmany  if $err;
 114         $DB_Class->table($table);
 115         run_method_tests($DB_Class,'column_type', %correct_types);
 116         #run_method_tests($DB_Class,'column_default', %correct_defaults);
 117         #run_method_tests($DB_Class,'column_nullable', %correct_defaults);
 118
 119 };
 120
 121
 122
 123
 124 # Helper methods, TODO -- put these somewhere where tests can use them.
 125
 126 # returns "best" available sqlite driver or dies
 127 sub sqlite_driver {
 128     my $driver = 'SQLite';
 129     eval { require DBD::SQLite } or do {
 130         print "Error loading DBD::SQLite, trying DBD::SQLite2\n";
 131         eval {require DBD::SQLite2} ? $driver = 'SQLite2'
 132             : die "DBD::SQLite2 is not installed";
 133    };
 134         return $driver;
 135 }
 136
 137
 138 # make_sqlite_db -- makes an sqlite database from params
 139 # usage -- make_sqlite_db($sql [, $dbname ]);
 140 sub make_sqlite_db {
 141         my ($sql, $dbname) = @_;
 142         die "Must provide SQL string" unless length $sql;
 143         $dbname ||= 't/test.db';
 144         print "Making SQLite DB $dbname\n";
 145     my $driver = sqlite_driver;
 146     require DBI;
 147     my $dbh = DBI->connect("dbi:$driver:dbname=$dbname");
 148
 149     for my $statement ( split /;/, $sql ) {
 150         $statement =~ s/\#.*$//mg;           # strip # comments
 151         $statement =~ s/auto_increment//g;
 152         next unless $statement =~ /\S/;
 153         eval { $dbh->do($statement) };
 154         die "$@: $statement" if $@;
 155     }
 156         $dbh->disconnect;
 157         print "Successfully made  SQLite DB $dbname\n";
 158         return 1;
 159 }