test for various column info stuff.

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@501 48953598-375a-da11-a14b-00016c27c3ee

diff --git a/t/db_colinfo.t b/t/db_colinfo.t
new file mode 100755 (executable)
index 0000000..ed54fd7
--- /dev/null
+++ b/t/db_colinfo.t
@@ -0,0 +1,157 @@
+#!/usr/bin/perl -w
+use Test::More;
+use lib 'ex'; # Where BeerDB should live
+BEGIN {
+   plan tests => 26;
+    
+}
+
+$db            = 'test';
+$dbuser        = 'test'; 
+$dbpasswd   = '';
+$table = "beer_test";
+$sql = "
+create table $table (
+    id integer auto_increment primary key,
+    name char(30),
+    url varchar(120),
+    score smallint(2),
+    price decimal(3,2),
+    abv varchar(10),
+       image blob, 
+    notes text,
+    tasted date  NOT NULL,
+    created timestamp default CURRENT_TIMESTAMP,
+       modified datetime  default NULL,
+    style mediumint(8) default 1,
+    brewery integer default NULL
+);";
+
+# correct column types and the ones we test
+%correct_types = (
+    id                         =>      'int(11)', # mysql 4.1 stores this for 'integer' 
+       brewery         =>      'int(11)',
+    style              =>      'mediumint(8)',
+    name               =>      'char(30)',
+    url                =>  'varchar(120)',
+    tasted             =>      'date',
+    created    =>      'timestamp',
+       modified        =>      'datetime',
+    score              =>      'smallint(2)',
+    price              =>      'decimal(3,2)',
+    abv                =>      'varchar(10)',
+    notes              => 'text',
+       image           =>      'blob',
+);
+
+# Runs tests on column_* method of $class using %correct data hash  
+# usage: run_method_tests ($class, $method, %correct);
+sub run_method_tests { 
+       ($class, $method,  %correct)  = @_;
+       for $col (sort keys %correct) {
+               $val = $class->$method($col);
+
+               # Hacks for various val types
+               $val = lc $val if $method eq 'column_type';                             
+
+               is($val,  $correct{$col},"$method $col is $val"); 
+       }
+}
+
+                
+# mysql test
+
+# Make test class 
+package BeerDB::BeerTestmysql;
+use base Maypole::Model::CDBI;
+
+package main;
+
+$DB_Class = 'BeerDB::BeerTestmysql';
+eval {$DB_Class->connection("dbi:mysql:$db", "$dbuser", "$dbpasswd"); };
+$err = $@;
+$skip_msg = "Could not connect to MySQL using database 'test', username 'test', and password ''. Check privelages and try again.";
+$skip_howmany = 13;
+
+SKIP: {
+       skip $skip_msg, $skip_howmany  if $err; 
+ 
+       $DB_Class->db_Main->do("drop table if exists $table;");
+       $DB_Class->db_Main->do($sql);
+       $DB_Class->table($table); 
+       run_method_tests($DB_Class,'column_type', %correct_types);
+       #run_method_tests($DB_Class,'column_default', %correct_defaults);
+       #run_method_tests($DB_Class,'column_nullable', %correct_defaults);
+};
+
+# SQLite  test
+
+package BeerDB::BeerTestsqlite;
+use base Maypole::Model::CDBI;
+package main;
+
+$DB_Class = 'BeerDB::BeerTestsqlite';
+
+#unlink "t/test.db";
+if ( !-e "t/test.db" ) {
+       eval {make_sqlite_db($sql)};
+       $err = $@;
+       if ($err) { print "Skipping sql tests because couldnt make sqlite test db
+               because of error $err"; exit; };
+}
+
+my $driver = sqlite_driver();
+eval { $DB_Class->connection("dbi:$driver:dbname='t/test.db'");};
+$err = $@;
+if ($err) { die "CDBI connection error: $err"; }
+$skip_msg = "Could not connect to SQLite database 't/test.db'";
+$skip_howmany = 13;
+
+SKIP: {
+       skip $skip_msg, $skip_howmany  if $err; 
+       $DB_Class->table($table); 
+       run_method_tests($DB_Class,'column_type', %correct_types);
+       #run_method_tests($DB_Class,'column_default', %correct_defaults);
+       #run_method_tests($DB_Class,'column_nullable', %correct_defaults);
+
+};
+
+
+
+
+# Helper methods, TODO -- put these somewhere where tests can use them.
+
+# returns "best" available sqlite driver or dies
+sub sqlite_driver { 
+    my $driver = 'SQLite';
+    eval { require DBD::SQLite } or do {
+        print "Error loading DBD::SQLite, trying DBD::SQLite2\n";
+        eval {require DBD::SQLite2} ? $driver = 'SQLite2'
+            : die "DBD::SQLite2 is not installed";
+   };
+       return $driver;
+}
+
+
+# make_sqlite_db -- makes an sqlite database from params
+# usage -- make_sqlite_db($sql [, $dbname ]);   
+sub make_sqlite_db {
+       my ($sql, $dbname) = @_;
+       die "Must provide SQL string" unless length $sql;
+       $dbname ||= 't/test.db';
+       print "Making SQLite DB $dbname\n";
+    my $driver = sqlite_driver; 
+    require DBI;
+    my $dbh = DBI->connect("dbi:$driver:dbname=$dbname");
+
+    for my $statement ( split /;/, $sql ) {
+        $statement =~ s/\#.*$//mg;           # strip # comments
+        $statement =~ s/auto_increment//g;
+        next unless $statement =~ /\S/;
+        eval { $dbh->do($statement) };
+        die "$@: $statement" if $@;
+    }
+       $dbh->disconnect;
+       print "Successfully made  SQLite DB $dbname\n";
+       return 1;
+}