# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::SQL::Driver::Types
#   CVS Info : 087,071,086,086,085      
#   $Id: Types.pm,v 2.1 2004/09/07 20:56:59 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Implements subroutines for each type to convert into SQL string.
#   See GT::SQL::Types for documentation
#
# Supported types are:
#   TINYINT SMALLINT MEDIUMINT INT INTEGER BIGINT - 8, 16, 24, 32, 32, 64 bits
#   REAL FLOAT DOUBLE - 32, 32, 64 bits
#   DECIMAL - decimal precision
#   DATE DATETIME TIMESTAMP TIME YEAR - for storing dates/times/etc.
#   CHAR VARCHAR - 1-255 characters, CHAR typically takes a fixed amount of space
#   TEXT - up to 2GB-1 text data; takes a 'size' parameter which /may/ change to smaller type
#   TINYTEXT SMALLTEXT MEDIUMTEXT LONGTEXT - TEXT with 255, 64KB-1, 16MB-1, 2GB-1 size values, respectively
#   TINYBLOB BLOB MEDIUMBLOB LONGBLOB - Heavily deprecrated, somewhat-binary data types with 255, 65535, 16777215, 2GB sizes
#   ENUM - MySQL-only type, implemented as CHAR by everything else; discouraged for portability reasons.
#   FILE - GT::SQL pseudo-type

package GT::SQL::Driver::Types;
use vars qw/$VERSION @EXPORT_OK $ERROR_MESSAGE @ISA/;
use strict;
use Exporter();
use GT::Base();

*import = \&Exporter::import;
$ERROR_MESSAGE = 'GT::SQL';
@ISA = 'GT::Base';

$VERSION = sprintf "%d.%03d", q$Revision: 2.1 $ =~ /(\d+)\.(\d+)/;
@EXPORT_OK = qw/base/;

sub base {
# ------------------------------------------------------------------
# Base function takes care of most of the types that don't require
# much special formatting.
#
    my ($class, $args, $name, $attribs) = @_;
    $attribs ||= [];
    my $out = $name;
    for my $attrib (@$attribs) {
        $out .= ' ' . $attrib if $args->{$attrib};
    }
    $out .= ' DEFAULT ' . GT::SQL::Driver->quote($args->{default}) if defined $args->{default};
    $out .= ' NOT NULL' if $args->{not_null};
    $out;
}

# Integers.  None of the following are supported by Oracle, which can only
# define integer types by the number of digits supported (see
# GT/SQL/Driver/ORACLE.pm), and TINYINT and MEDIUMINT are only supported by
# MySQL (though MS SQL will use it's unsigned TINYINT type if the unsigned
# attribute is also passed in).  All int types are signed - an 'unsigned'
# column attribute can be used to /suggest/ that the integer type be unsigned -
# but it is only for some databases and/or INT types, and so not guaranteed.
sub TINYINT   { $_[0]->base($_[1], 'SMALLINT') } # 8-bit int
sub SMALLINT  { $_[0]->base($_[1], 'SMALLINT') } # 16-bit int
sub MEDIUMINT { $_[0]->base($_[1], 'INT') } # 24-bit int
sub INT       { $_[0]->base($_[1], 'INT') } # 32-bit int
sub BIGINT    { $_[0]->base($_[1], 'BIGINT') } # 64-bit int

sub INTEGER   { $_[0]->INT($_[1]) } # alias for INT, above

# Floating point numbers
sub DOUBLE { $_[0]->base($_[1], 'DOUBLE PRECISION') } # 64-bit float (52 bit precision)
sub REAL   { $_[0]->base($_[1], 'REAL') } # 32-bit float (23 bit precision), despite what MySQL thinks
sub FLOAT  { $_[0]->REAL($_[1]) } # alias for REAL

sub DECIMAL {
# ------------------------------------------------------------------
# Takes care of DECIMAL's precision.
#
    my ($class, $args, $out, $attribs) = @_;
    $out ||= 'DECIMAL';
    $attribs ||= [];

    # 'scale' and 'precision' are the proper names, but a prior version used
    # the unfortunate 'display' and 'decimal' names, which have no relevant
    # meaning in SQL.
    my $scale = defined $args->{scale} ? $args->{scale} : defined $args->{decimal} ? $args->{decimal} : undef;
    my $precision = defined $args->{precision} ? $args->{precision} : defined $args->{display} ? $args->{display} : undef;

    $scale ||= 0;
    $precision ||= 10;

    $out .= "($precision, $scale)";

    for my $attrib (@$attribs) {
        $out .= ' ' . $attrib if $args->{$attrib};
    }
    defined $args->{default}  and $out .= ' DEFAULT ' . GT::SQL::Driver->quote($args->{default});
    $args->{not_null} and $out .= ' NOT NULL';
    return $out;
}

# Dates - just about every database seems to do things differently here.
sub DATE      { $_[0]->base($_[1], 'DATE') }
sub DATETIME  { $_[0]->base($_[1], 'DATETIME') }
sub TIMESTAMP { $_[0]->base($_[1], 'TIMESTAMP') }
sub TIME      { $_[0]->base($_[1], 'TIME') }
sub YEAR      { $_[0]->base($_[1], 'YEAR') }

# Everything (even Oracle) supports CHAR for sizes from 1 to at least 255.
# Everything except Oracle handles VARCHAR's - Oracle, having deprecated
# VARCHAR's, uses VARCHAR2's.  However, only MySQL supports the 'BINARY'
# attribute to turn this into a "binary" char (meaning, really,
# case-insensitive, not binary) - for everything else, a "binary" argument is
# simply ignored.
sub CHAR {
    my ($class, $args, $out) = @_;
    # Important the set the size before calling BINARY, because BINARY's
    # behaviour is different for sizes <= 255.
    $args->{size} = 255 unless $args->{size} and $args->{size} <= 255;

# See the CHAR notes in GT::SQL::Types regarding why we default to VARCHAR
    $out ||= 'VARCHAR';
    $out .= "($args->{size})";

    $out .= ' DEFAULT ' . GT::SQL::Driver->quote($args->{default}) if defined $args->{default};
    $out .= ' NOT NULL' if $args->{not_null};
    return $out;
}
sub VARCHAR { $_[0]->CHAR($_[1], 'VARCHAR') }

# By default, all TEXT types are mapped to 'TEXT'; drivers can override this to
# provide different types based on the 'size' attribute.
sub TEXT {
    my ($class, $attrib) = @_;
    $class->base($attrib, 'TEXT')
}

# .+TEXT is for compatibility with old code, and should be considered
# deprecated.  Takes the args hash and the size desired.
sub _OLD_TEXT {
    my ($class, $args, $size) = @_;
    $args = {$args ? %$args : ()};
    $args->{size} = $size unless $args->{size} and $args->{size} < $size;
    $class->TEXT($args);
}
sub TINYTEXT   { $_[0]->_OLD_TEXT($_[1] => 255) }
sub SMALLTEXT  { $_[0]->_OLD_TEXT($_[1] => 65535) }
sub MEDIUMTEXT { $_[0]->_OLD_TEXT($_[1] => 16777215) }
sub LONGTEXT   { $_[0]->_OLD_TEXT($_[1] => 2147483647) }

# The BLOB* columns below are heavily deprecated - they're still here just in
# case someone is still using them.  Storing binary data inside an SQL row is
# generally a poor idea; a much better approach is to store a pointer to the
# data (such as a filename) in the database, and the actual data in a file.
#
# As such, the default behaviour is to fatal if BLOB's are used - only drivers
# that supported BLOB's prior to protocol v2 should override this.  Should a
# binary type be desired in the future, a 'BINARY' pseudo-type is recommended.
sub BLOB {
    my ($driver) = $_[0] =~ /([^:]+)$/;
    $driver = $driver eq 'PG' ? 'Postgres' : $driver eq 'ORACLE' ? 'Oracle' : $driver eq 'MYSQL' ? 'MySQL' : $driver;
    $_[0]->fatal(DRIVERTYPE => $driver => 'BLOB')
}
sub TINYBLOB   { $_[0]->BLOB($_[1], 'TINYBLOB') }
sub MEDIUMBLOB { $_[0]->BLOB($_[1], 'MEDIUMBLOB') }
sub LONGBLOB   { $_[0]->BLOB($_[1], 'LONGBLOB') }

# Enums - a non-standard SQL type implemented only by MySQL - the default
# implementation is to implement it as a CHAR (or TEXT if the longest value is
# more than 255 characters - but in that case, are you really sure you want to
# use this type?)
sub ENUM {
    my ($class, $args) = @_;
    my $max = 0;
    @{$args->{'values'}} or return;
    for my $val (@{$args->{'values'}}) {
        my $len = length $val;
        $max = $len if $len > $max;
    }
    my $meth = $max > 255 ? 'TEXT' : 'CHAR';
    $class->$meth({ size => $max, default => $args->{default}, not_null => $args->{not_null} });
}

# File handling
sub FILE {
    my ($class, $args) = @_;
    $class->VARCHAR({ binary => 1, size => $args->{size}, not_null => $args->{not_null} });
}

1;
