#!/usr/bin/perl

# $Id: test_dbd_driver.pl,v 3.0 2002/08/28 01:16:31 lachoy Exp $

# test_dbd_driver.pl

# See whether a DBD driver will support SPOPS. Currently this is
# pretty rudimentary :-)

# Edit the file 'test_dbd_driver.dat' with configuration information
# for your driver and connection.

use strict;
use DBI  qw( :sql_types );

use constant CONFIG_FILE => 'test_dbd_driver.dat';
use constant DEFAULT_SQL => 'SELECT * FROM %s WHERE 1 = 0';

my $VERSION = '0.01';

{
    # Read in the config and ensure we have the right info

    my $conf = read_config();
    if ( my $required = test_config( $conf ) ) {
        die "Please specify the required fields in the configuration. ",
            "Errors found:\n$required\n";
    }

    # Make the connection

    my $full_dsn = "DBI:$conf->{dbd}:$conf->{dsn}";
    my $dbh = DBI->connect( $full_dsn, $conf->{username}, $conf->{password} );
    unless ( $dbh ) {
        die "Cannot connect with the information given.\nDBI DSN: $full_dsn\n",
            "Username: $conf->{username}\nPassword: $conf->{password}\n",
            "Please modify the file (", CONFIG_FILE, ") and rerun.\n";
    }
    $dbh->{RaiseError} => 1;
    $dbh->{PrintError} => 0;

    # Create the SQL and run

    my $sql = $conf->{sql} || sprintf( DEFAULT_SQL, $conf->{table} );
    my ( $sth );
    my $sth = eval { $dbh->prepare( $sql ) };
    die "Cannot prepare SQL:\n$sql\nError: $\n@"  if ( $@ );
    die "Statement handle not created!\n"         unless ( $sth );

    my $rv = eval { $sth->execute };
    die "Cannot execute SQL:\nError: $@\n"        if ( $@ );
    die "False value returned from execute!\n"    unless ( $rv ) ;

    my $fields = $sth->{NAME};
    my $types  = $sth->{TYPE};
    my ( @field_info );
    my ( $longest_field, $longest_type, $cannot_quote );
    for ( my $i = 0; $i < scalar @{ $fields }; $i++ ) {
        my ( $english, $val ) = english_sql_type( $types->[ $i ] );
        my $quoted = eval { $dbh->quote( $val, $types->[ $i ] ) };
        if ( $@ ) { $quoted = 'n/a'; $cannot_quote++; }

        my $null = eval { $dbh->quote( undef, $types->[ $i ] ) };
        if ( $@ ) { $null = 'n/a' }

        my $item = { field        => $fields->[ $i ],
                     dbi_type     => $types->[ $i ],
                     english_type => $english,
                     quoted       => $quoted,
                     null         => $null };
        $longest_field = ( $longest_field < length $item->{field} )
                           ? length $item->{field} : $longest_field;
        $longest_type  = ( $longest_type < length $item->{english_type} )
                           ? length $item->{english_type} : $longest_type;
        push @field_info, $item;
    }

    my $fmt = "%-${longest_field}s   %-${longest_type}s   %8s   %-8s   %s\n";

    print "\nInfo for Driver: $conf->{dbd}\n",
          "Date:            ", scalar localtime, "\n",
          "Script version:  $VERSION\n\n";
    printf( $fmt, "Field", "Type", "DBI Type", "Quoted", "Null" );
    print '=' x 60, "\n";
    foreach my $inf ( @field_info ) {
        printf( $fmt, $inf->{field}, $inf->{english_type}, $inf->{dbi_type}, $inf->{quoted}, $inf->{null} );
    }

    if ( $cannot_quote ) {
        print "\nType discovery ok, but the two-argument 'quote( \$val, ",
              "\$dbi_type )' does not work properly\n";
    }
    else {
        print "\nThis driver seems capable of being used for SPOPS.\n";
    }

    print "\n\nAll done!\n";

    $sth->finish;
    $dbh->disconnect;
}


# If you're interested to know where this list came from, do:
#
#  find /usr/lib/perl5 -name "dbi_sql.h" -print
#
# And check out the contents.

sub english_sql_type {
    my ( $type ) = @_;
    return ( "SQL_CHAR", "blah" )         if ( $type == SQL_CHAR );
    return ( "SQL_NUMERIC", 42.87 )       if ( $type == SQL_NUMERIC );
    return ( "SQL_DECIMAL", 42.87 )       if ( $type == SQL_DECIMAL );
    return ( "SQL_INTEGER", 4287 )        if ( $type == SQL_INTEGER );
    return ( "SQL_SMALLINT", 42 )         if ( $type == SQL_SMALLINT );
    return ( "SQL_FLOAT", 42.87891 )      if ( $type == SQL_FLOAT );
    return ( "SQL_REAL", 42.87891 )       if ( $type == SQL_REAL );
    return ( "SQL_DOUBLE", 42.87891 )     if ( $type == SQL_DOUBLE );
    return ( "SQL_DATE", "2001-02-14" )   if ( $type == SQL_DATE );
    return ( "SQL_TIME", "09:52:01" )     if ( $type == SQL_TIME );
    return ( "SQL_TIMESTAMP", "2001-02-14 09:52:01" )    if ( $type == SQL_TIMESTAMP );
    return ( "SQL_VARCHAR", "blah" )      if ( $type == SQL_VARCHAR );
    return ( "SQL_LONGVARCHAR", "blah" )  if ( $type == SQL_LONGVARCHAR );
    return ( "SQL_BINARY", "blah" )       if ( $type == SQL_BINARY );
    return ( "SQL_VARBINARY", "blah" )    if ( $type == SQL_VARBINARY );
    return ( "SQL_LONGVARBINARY", "blah" ) if ( $type == SQL_LONGVARBINARY );
    return ( "SQL_BIGINT", 4287 )         if ( $type == SQL_BIGINT );
    return ( "SQL_TINYINT", 42 )          if ( $type == SQL_TINYINT );
    return ( "SQL_BIT", 1 )               if ( $type == SQL_BIT );
    return ( "SQL_WCHAR", "wblah" )       if ( $type == SQL_WCHAR );
    return ( "SQL_WVARCHAR", "wblah" )    if ( $type == SQL_WVARCHAR );
    return ( "SQL_WLONGVARCHAR", "wblah" ) if ( $type == SQL_WLONGVARCHAR );
    return ( "(unknown type! <$type>)", undef );
}

sub read_config {
    my ( $config_file ) = @_;
    $config_file ||= CONFIG_FILE;
    open( CONF, $config_file ) || die "Cannot open file ($config_file): $!";
    my %conf = ();
    while ( <CONF> ) {
        next if ( /^\s*$/ );
        next if ( /^\s*\#/ );
        s/^\s+//;
        s/\s+$//;
        my ( $key, $value ) = split /\s+/;
        $conf{ $key } = $value;
    }
    return \%conf;
}

sub test_config {
    my ( $conf ) = @_;
    my ( @msg );
    unless ( $conf->{dbd} )   { push @msg, "DBD driver not defined (key: dbd)" }
    unless ( $conf->{table} ) { push @msg, "Table name not defined (key: table)" }
    unless ( $conf->{dsn} )   { push @msg, "DSN not defined (key: dsn)" }
    return undef unless ( scalar @msg );
    return join( "\n", @msg );
}

=pod

=head1 NAME

test_dbd_driver.pl - Perform tests on a DBD driver to see if it may work with SPOPS

=head1 SYNOPSIS

 # Create a table to test -- test_dbd_driver.sql has a sample. (This
 # is database-specific.)

 # Mysql

 mysql --user=root --password=password test < test_dbd_driver.sql

 # Sybase/MS SQL

 isql -Usa -Dmaster -Ppassword -i test_dbd_driver.sql

 # Postgres

 psql -U postgres test < test_dbd_driver.sql

 # Edit the file 'test_dbd_driver.dat' with connection info

 dbd         mysql
 dsn         test
 usename     nobody
 password    nobody
 table       spopstest

 # Run the test

 perl test_dbd_driver.pl

=head1 DESCRIPTION

To come...

=head1 AUTHORS

Chris Winters <chris@cwinters.com>

=cut