227 lines
7.2 KiB
Perl
227 lines
7.2 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::SQL::Driver::MYSQL
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: MYSQL.pm,v 2.1 2005/04/14 00:56:30 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description: MySQL driver for GT::SQL
|
|
#
|
|
|
|
package GT::SQL::Driver::MYSQL;
|
|
# ====================================================================
|
|
use strict;
|
|
use vars qw/@ISA $ERROR_MESSAGE/;
|
|
use GT::SQL::Driver;
|
|
use DBD::mysql 1.19_03;
|
|
|
|
$ERROR_MESSAGE = 'GT::SQL';
|
|
@ISA = qw/GT::SQL::Driver/;
|
|
|
|
sub protocol_version { 2 }
|
|
|
|
sub dsn {
|
|
# -----------------------------------------------------------------------------
|
|
# Creates the data source name used by DBI to connect to the database.
|
|
#
|
|
my ($self, $connect) = @_;
|
|
my $dsn;
|
|
|
|
$connect->{driver} ||= 'mysql';
|
|
$connect->{host} ||= 'localhost';
|
|
$self->{driver} = $connect->{driver};
|
|
|
|
$dsn = "DBI:$connect->{driver}:";
|
|
$dsn .= join ';', map { $connect->{$_} ? "$_=$connect->{$_}" : () } qw/database host port/;
|
|
return $dsn;
|
|
}
|
|
|
|
sub _prepare_select {
|
|
# -----------------------------------------------------------------------------
|
|
# Prepares a query; rewrites PG-style LIMIT x OFFSET y into MySQL's confusing
|
|
# LIMIT y, n
|
|
#
|
|
my ($self, $query) = @_;
|
|
$query =~ s/\bLIMIT\s+(\d+)\s+OFFSET\s+(\d+)/LIMIT $2, $1/i
|
|
or $query =~ s/\bOFFSET\s+(\d+)\s+LIMIT\s+(\d+)/LIMIT $1, $2/i;
|
|
$query;
|
|
}
|
|
|
|
sub insert_multiple {
|
|
# -----------------------------------------------------------------------------
|
|
# Performs a multiple-insertion. We have to watch the maximum query length,
|
|
# performing multiple queries if necessary.
|
|
#
|
|
my ($self, $cols, $args) = @_;
|
|
|
|
my $has_ai;
|
|
$has_ai = grep $_ eq $self->{schema}->{ai}, @$cols if $self->{schema}->{ai};
|
|
|
|
my $names = join ",", @$cols;
|
|
$names .= ",$self->{schema}->{ai}" if $self->{schema}->{ai} and not $has_ai;
|
|
|
|
my $ret;
|
|
my $values = '';
|
|
for (@$args) {
|
|
my $new_val;
|
|
$new_val = "(" . join(",", map GT::SQL::Driver::quote($_), @$_);
|
|
$new_val .= ",NULL" if $self->{schema}->{ai} and not $has_ai;
|
|
$new_val .= ")";
|
|
|
|
if ($values and length($values) + length($new_val) > 1_000_000) {
|
|
++$ret if $self->do("INSERT INTO $self->{name} ($names) VALUES $values");
|
|
$values = '';
|
|
}
|
|
$values .= "," if $values;
|
|
$values .= $new_val;
|
|
}
|
|
if ($values) {
|
|
++$ret if $self->do("INSERT INTO $self->{name} ($names) VALUES $values");
|
|
}
|
|
$ret;
|
|
}
|
|
|
|
# If making a nullable TEXT column not null, make sure we update existing NULL
|
|
# columns to get the default value.
|
|
sub alter_column {
|
|
my ($self, $table, $column, $new_def, $old_col) = @_;
|
|
my %col = %{$self->{schema}->{cols}->{$column}};
|
|
if ($col{type} =~ /TEXT$/i
|
|
and $col{not_null}
|
|
and not $old_col->{not_null}
|
|
and defined $col{default}
|
|
and not defined $old_col->{default}) {
|
|
$self->{dbh}->do("UPDATE $table SET $column = ? WHERE $column IS NULL", undef, $col{default});
|
|
}
|
|
return $self->SUPER::alter_column(@_[1 .. $#_])
|
|
}
|
|
|
|
sub create_index {
|
|
my ($self, $table, $index_name, @index_cols) = @_;
|
|
$self->do("ALTER TABLE $table ADD INDEX $index_name (" . join(',', @index_cols) . ")");
|
|
}
|
|
|
|
sub create_unique {
|
|
my ($self, $table, $index_name, @index_cols) = @_;
|
|
$self->do("ALTER TABLE $table ADD UNIQUE $index_name (" . join(',', @index_cols) . ")");
|
|
}
|
|
|
|
sub drop_index {
|
|
my ($self, $table, $index_name) = @_;
|
|
$self->do("ALTER TABLE $table DROP INDEX $index_name");
|
|
}
|
|
|
|
package GT::SQL::Driver::MYSQL::sth;
|
|
# ====================================================================
|
|
use strict;
|
|
use vars qw/@ISA $ERROR_MESSAGE/;
|
|
use GT::SQL::Driver::sth;
|
|
|
|
$ERROR_MESSAGE = 'GT::SQL';
|
|
@ISA = qw/GT::SQL::Driver::sth/;
|
|
|
|
|
|
sub insert_id {
|
|
# -------------------------------------------------------------------
|
|
# Catch mysql's auto increment field.
|
|
#
|
|
my $self = shift;
|
|
return $self->{sth}->{mysql_insertid} || $self->{sth}->{insertid};
|
|
}
|
|
|
|
sub rows { shift->{sth}->rows }
|
|
|
|
sub _execute_show_index {
|
|
my $self = shift;
|
|
$self->{sth}->execute or return $self->warn(CANTEXECUTE => $self->{query}, $DBI::errstr);
|
|
|
|
my @results;
|
|
|
|
# Mysql columns are: Table Non_unique Key_name Seq_in_index Column_name Collation Cardinality Sub_part Packed Null Index_type Comment
|
|
my @names = @{$self->row_names};
|
|
# We need to add index_name, index_column, index_unique, index_primary (see GT::SQL::Driver)
|
|
push @names, qw/index_name index_column index_unique index_primary/ unless $self->{_names};
|
|
while (my $row = $self->{sth}->fetchrow_arrayref) {
|
|
my %h = map { $names[$_] => $row->[$_] } 0 .. $#$row;
|
|
push @results, [@$row, $h{Key_name}, $h{Column_name}, $h{Non_unique} ? 0 : 1, $h{Key_name} eq 'PRIMARY' ? 1 : 0];
|
|
}
|
|
|
|
$self->{rows} = @results;
|
|
$self->{_names} = \@names;
|
|
$self->{_results} = \@results;
|
|
}
|
|
|
|
package GT::SQL::Driver::MYSQL::Types;
|
|
use strict;
|
|
use GT::SQL::Driver::Types;
|
|
use vars qw/@ISA/;
|
|
@ISA = 'GT::SQL::Driver::Types';
|
|
|
|
# Integers. MySQL supports non-standard unsigned and zerofill properties;
|
|
# unsigned, though unportable, is supported here, however zerofill - whose
|
|
# usefulness is dubious at best - is not.
|
|
sub TINYINT { $_[0]->base($_[1], 'TINYINT', ['unsigned']) }
|
|
sub SMALLINT { $_[0]->base($_[1], 'SMALLINT', ['unsigned']) }
|
|
sub MEDIUMINT { $_[0]->base($_[1], 'MEDIUMINT', ['unsigned']) }
|
|
sub INT { $_[0]->base($_[1], 'INT', ['unsigned']) }
|
|
sub BIGINT { $_[0]->base($_[1], 'BIGINT', ['unsigned']) }
|
|
|
|
# Floats - MySQL's 'REAL' is really a 64-bit floating point number, while for
|
|
# everything else 'REAL' is a 32-bit floating point number, so we override the
|
|
# defaults here to FLOAT.
|
|
sub FLOAT { $_[0]->base($_[1], 'FLOAT') }
|
|
sub REAL { $_[0]->base($_[1], 'FLOAT') }
|
|
|
|
sub CHAR {
|
|
my ($class, $args, $out) = @_;
|
|
$args->{size} = 255 unless $args->{size} and $args->{size} <= 255;
|
|
|
|
$out ||= 'CHAR';
|
|
$out .= "($args->{size})";
|
|
$out .= ' BINARY' if $args->{binary}; # MySQL-only
|
|
|
|
$out .= ' DEFAULT ' . GT::SQL::Driver->quote($args->{default}) if defined $args->{default};
|
|
$out .= ' NOT NULL' if $args->{not_null};
|
|
return $out;
|
|
}
|
|
|
|
sub TEXT {
|
|
my ($class, $args) = @_;
|
|
my $type = 'LONGTEXT';
|
|
delete $args->{default}; # MySQL is the only driver that doesn't support defaults on TEXT's
|
|
if ($args->{size}) {
|
|
if ($args->{size} < 256) {
|
|
$type = 'TINYTEXT';
|
|
}
|
|
elsif ($args->{size} < 65536) {
|
|
$type = 'TEXT';
|
|
}
|
|
elsif ($args->{size} < 16777216) {
|
|
$type = 'MEDIUMTEXT';
|
|
}
|
|
}
|
|
|
|
$class->base($args, $type);
|
|
}
|
|
|
|
# MySQL supports ENUM; the generic ENUM is mapped to a VARCHAR
|
|
sub ENUM {
|
|
my ($class, $args) = @_;
|
|
@{$args->{'values'}} or return;
|
|
my $out = 'ENUM(' . join(",", map GT::SQL::Driver->quote($_), @{$args->{values}}) . ')';
|
|
$out .= ' DEFAULT ' . GT::SQL::Driver->quote($args->{default}) if defined $args->{default};
|
|
$out .= ' NOT NULL' if $args->{not_null};
|
|
$out;
|
|
}
|
|
|
|
sub BLOB {
|
|
my ($class, $attrib, $blob) = @_;
|
|
delete $attrib->{default};
|
|
$class->base($attrib, $blob || 'BLOB');
|
|
}
|
|
|
|
1;
|