717 lines
24 KiB
Perl
717 lines
24 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::SQL
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: SQL.pm,v 1.112 2007/08/30 00:14:38 brewt Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description: A general purpose perl interface to a RDBMS.
|
|
#
|
|
|
|
package GT::SQL;
|
|
# ==================================================================
|
|
use GT::Base;
|
|
use GT::AutoLoader;
|
|
use GT::Config;
|
|
use GT::SQL::Base;
|
|
use GT::SQL::Table;
|
|
use GT::SQL::Driver;
|
|
use strict;
|
|
use vars qw(@ISA $DEBUG $ERRORS $VERSION %OBJ_CACHE $error $errcode);
|
|
|
|
@ISA = qw(GT::SQL::Base);
|
|
$DEBUG = 0;
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.112 $ =~ /(\d+)\.(\d+)/;
|
|
$ERRORS = {
|
|
# Common Errors
|
|
UNIQUE => "The column '%s' must be unique, and already has an entry '%s'",
|
|
NOTABLE => 'No table defined -- call $db->table($table) before accessing',
|
|
CANTOPEN => "Cannot open file '%s': %s",
|
|
CANTOPENDIR => "Cannot read directory '%s': %s",
|
|
FILENOEXISTS => "File '%s' does not exist or the permissions are set incorrectly",
|
|
# GT::SQL Errors
|
|
NODRIVER => "Database driver %s is not installed. Available drivers: %s",
|
|
CANTLOAD => "Unable to load driver '%s': %s",
|
|
BADPREFIX => "Invalid prefix: '%s'",
|
|
NODATABASE => 'No database def file -- create def file with ->set_connect before calling $obj->%s',
|
|
CANTCONNECT => "Could not connect to database: %s",
|
|
CANTPREPARE => "Failed to prepare query: '%s': %s",
|
|
CANTEXECUTE => "Failed to execute query: '%s': %s",
|
|
BADSUBCLASS => "Unable to load subclass: '%s': %s",
|
|
NEEDDEBUG => "You must turn on debug in order to access query logs",
|
|
NOORACLEHOME => "The environment variable ORACLE_HOME is not defined. It must be defined for the script to connect properly",
|
|
NONLSDATE => "Unable to set NLS_DATE_FORMAT: %s",
|
|
# Table Errors
|
|
BADNAME => "Invalid table name '%s'",
|
|
NOTNULL => "Column %s cannot be left blank",
|
|
NORECMOD => "The record you are attempting to modify no longer exists in the current table",
|
|
NOVALUES => "You did not pass any valid column names to %s",
|
|
BADMULTVALUES => "One or more of the value groups passed to %s contained an incorrect number of values",
|
|
NOPKTOMOD => "Cannot modify record, no primary key specified",
|
|
DEPENDENCY => "Table %s has dependencies. Aborting",
|
|
ILLEGALVAL => "%s cannot contain the value '%s'",
|
|
ALREADYCHANGED => "The record you are attempting to modify has changed since you last accessed it",
|
|
REGEXFAIL => "The regular expressions %s for this column is not properly formed",
|
|
FKNOTABLE => "A foreign key is referencing a non existant table: %s. GT::SQL load error: %s",
|
|
FKNOEXISTS => "You attempted to remove non-existent foreign key '%s' from table '%s'",
|
|
FKMISSING => "The '%s' table has a relationship with the '%s' table, but the foreign key information from the '%s' table is missing.",
|
|
CIRCULAR => "Circular reference detected in the foreign key schema. Already seen column: %s",
|
|
CIRCULARLIMIT => "Loop detected in circular reference check, hit maximum recursion depth of 100",
|
|
# Relation Errors
|
|
BADCOLS => "Bad columns / column clash: columns named '%s' have been found in current relation, please qualify your expression",
|
|
# Creator Errors
|
|
BADTYPE => "%s is not a supported type",
|
|
AINOTPK => "Column %s defined as auto_increment but is not an INT",
|
|
TBLEXISTS => "Could not create table '%s': It already exists",
|
|
NOTABLEDEFS => "You must define your table before creating it",
|
|
NOPOS => "No position column was found in definition for column: %s",
|
|
# Editor Errors
|
|
NOCOL => "There is no column %s in this table",
|
|
REFCOL => "You cannot alter column %s, as table %s still has references to it. Remove those references first",
|
|
NOPK => "There is no primary key for this table",
|
|
COLREF => "You cannot alter column %s, as it is a foreign key. Remove the foreign key first",
|
|
NOINDEX => "You are trying to modify an index that does not exist",
|
|
NOUNIQUE => "You are trying to drop a unique column '%s', but it is not unique",
|
|
INDXQTEXT => "Cannot create index on '%s' as it is a text/blob field",
|
|
COLEXISTS => "Unable to add column '%s' - already exists",
|
|
NOTUNIQUE => "Cannot create unique index on '%s', data is not unique",
|
|
INDXEXISTS => "Unable to add index '%s' - already exists",
|
|
PKTEXT => "Column %s specified as a primary key but is a text or a blob type",
|
|
UNIQTEXT => "Column %s specified as a unique but is a text or blob column type",
|
|
TABLEREFD => "%s cannot be dropped as table still has references to it",
|
|
NOFILESAVEIN => "Column %s must have file_save_in set if is to be File type",
|
|
NODIRPRIV => "Privileges on directory %s do not allow write or directory does not exist",
|
|
SAMEDRIVER => "Search Driver '%s' is unchanged",
|
|
NOTNULLDEFAULT => "Column %s was specified as not null, but has no default value",
|
|
# Admin Error
|
|
NOACTION => "The CGI object passed in did not contain a valid action. %s",
|
|
# Tree errors
|
|
NOTREE => "No tree object exists for table '%s'. Create a tree first with \$editor->add_tree",
|
|
NOTREEOBJ => "You attempted to call '%s' without a valid tree object. Call \$table->tree() first",
|
|
TREEEXISTS => "A tree already exists for table '%s'",
|
|
TREENOCANDO => "You attempted to call '%s' on table '%s', but that table has a tree attached and does not support the command",
|
|
TREENOIDS => "You did not pass any ID's to %s",
|
|
TREEBADPK => "You tried to create a tree on table '%s', but that table doesn't have a primary key, or has multiple primary keys",
|
|
TREEBADJOIN => "Joining more than 2 tables with a tree is not supported. You attempted to join: %s",
|
|
TREEFATHER => "Unable to update a tree record to a descendant of itself",
|
|
# Driver errors
|
|
DRIVERPROTOCOL => "Driver implements wrong protocol: protocol v%d required, driver is v%d",
|
|
};
|
|
|
|
use constant DEF_HEADER => <<'HEADER';
|
|
# Database access & configuration file
|
|
# Last updated: [localtime]
|
|
# Created by GT::SQL $Revision: 1.112 $
|
|
HEADER
|
|
|
|
sub new {
|
|
# -------------------------------------------------------------------
|
|
# GT::SQL constructor. Takes:
|
|
# my $db = new GT::SQL '/path/to/def';
|
|
# my $db = new GT::SQL { def_path => '/defpath', debug => 1 };
|
|
#
|
|
my $this = shift;
|
|
my $class = ref $this || $this;
|
|
my $self = bless { _err_pkg => __PACKAGE__, _debug => $DEBUG }, $class;
|
|
|
|
# Get our arguments into a hash ref
|
|
my $opts = {};
|
|
if (@_ == 0) { $opts = {}; }
|
|
elsif (@_ == 1 and ref $_[0] eq 'HASH') { $opts = shift; }
|
|
elsif (@_ > 1 and !(@_ % 2)) { $opts = {@_}; }
|
|
else {
|
|
$opts->{def_path} = shift;
|
|
}
|
|
|
|
# Set debugging level, caching options and whether to allow subclassing.
|
|
$self->{_debug} = exists $opts->{debug} ? $opts->{debug} : $DEBUG;
|
|
$self->{cache} = exists $opts->{cache} ? $opts->{cache} : 1;
|
|
$self->{subclass} = exists $opts->{subclass} ? $opts->{subclass} : 1;
|
|
|
|
# Def path must exist and be a directory
|
|
exists $opts->{def_path} or return $self->fatal(BADARGS => "$class->new(HASH_REF). def_path must be defined and a directory path in the hash");
|
|
-d $opts->{def_path} or return $self->fatal(BADARGS => "The defs directory '$opts->{def_path}' does not exist, or is not a directory");
|
|
|
|
# Load the database def file if it exists
|
|
|
|
# Some old programs would sometimes erroneously leave an invalid blank
|
|
# database.def file in the def_path; if such a file exists, make GT::Config
|
|
# ignore it.
|
|
my $empty = (-f "$opts->{def_path}/database.def" and !-s _);
|
|
|
|
$self->{connect} = GT::Config->load(
|
|
"$opts->{def_path}/database.def" => {
|
|
create_ok => 1,
|
|
chmod => 0666,
|
|
debug => $self->{_debug},
|
|
header => DEF_HEADER,
|
|
($empty ? (empty => 1) : ()),
|
|
}
|
|
);
|
|
|
|
$self->{connect}->{PREFIX} = '' unless defined $self->{connect}->{PREFIX};
|
|
# Heavily deprecated. Not guaranteed to always be correct:
|
|
$GT::SQL::PREFIX = $self->{connect}->{PREFIX};
|
|
$self->{connect}->{def_path} = $opts->{def_path};
|
|
$self->{connect}->{obj_cache} = $self->{cache};
|
|
|
|
$self->debug("OBJECT CREATED") if $self->{_debug} and $self->{_debug} > 2;
|
|
return $self;
|
|
}
|
|
|
|
$COMPILE{set_connect} = __LINE__ . <<'END_OF_SUB';
|
|
sub set_connect {
|
|
# -------------------------------------------------------------------
|
|
# Sets the connection info, only needed to setup the database.def file.
|
|
# $db->set_connect({
|
|
# driver => 'mysql',
|
|
# host => 'localhost',
|
|
# port => 2323,
|
|
# database => 'mydatabase',
|
|
# login => 'user',
|
|
# password => 'foo',
|
|
# }) or die "Can't connect: $GT::SQL::error";
|
|
#
|
|
my $self = shift;
|
|
my $connect = $self->{connect};
|
|
my %old_connect = %$connect;
|
|
# Parse our arguments.
|
|
if (!@_) { return $self->fatal(BADARGS => '$obj->set_connect(HASH_REF)') }
|
|
elsif (@_ == 1 and ref $_[0] eq 'HASH') { %$connect = %{+shift} }
|
|
elsif (@_ % 2 == 0) { %$connect = @_ }
|
|
else { return $self->fatal(BADARGS => '$obj->set_connect(HASH_REF)') }
|
|
|
|
if (keys %old_connect) {
|
|
for (keys %old_connect) {
|
|
$connect->{$_} = $old_connect{$_} unless exists $connect->{$_};
|
|
}
|
|
}
|
|
$connect->{PREFIX} = '' unless defined $connect->{PREFIX};
|
|
|
|
# Fix the connect string for test connecting
|
|
$connect->{driver} ||= 'mysql';
|
|
|
|
# Make sure DBI has been loaded
|
|
eval { require DBI };
|
|
$@ and return $self->warn(CANTCONNECT => "DBI module not installed. You must install the perl database module DBI from: http://www.perl.com/CPAN/modules/by-module/DBI");
|
|
|
|
# Make sure the requested driver exists
|
|
my @drivers = GT::SQL::Driver->available_drivers;
|
|
unless (grep $_ eq uc $connect->{driver}, @drivers, 'ODBC') {
|
|
return $self->warn(NODRIVER => $connect->{driver}, join ", ", @drivers);
|
|
}
|
|
|
|
my $raiseerror = delete $connect->{RaiseError};
|
|
my $printerror = delete $connect->{PrintError};
|
|
$connect->{RaiseError} = 0;
|
|
$connect->{PrintError} = 0;
|
|
|
|
# Get our driver.
|
|
my $table = GT::SQL::Table->new(connect => $connect, debug => $self->{_debug});
|
|
$table->connect or return;
|
|
|
|
# Put things back the way they were.
|
|
$connect->{RaiseError} = defined $raiseerror ? $raiseerror : 1;
|
|
$connect->{PrintError} = defined $printerror ? $printerror : 0;
|
|
|
|
$self->{connect} = $connect;
|
|
|
|
# Use this connect string from now on.
|
|
$self->write_db_config;
|
|
|
|
return 1;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{write_db_config} = __LINE__ . <<'END_OF_SUB';
|
|
sub write_db_config {
|
|
# -------------------------------------------------------------------
|
|
# Saves the database.def file. Takes no arguments.
|
|
#
|
|
my $self = shift;
|
|
$self->{connect}->save;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ============================================================================ #
|
|
# DATABASE INFO ACCESSORS #
|
|
# ============================================================================ #
|
|
$COMPILE{driver} = __LINE__ . <<'END_OF_SUB';
|
|
sub driver {
|
|
# -------------------------------------------------------------------
|
|
# Returns the name of the driver being used.
|
|
#
|
|
my $self = shift;
|
|
return $self->{connect}->{driver};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{host} = __LINE__ . <<'END_OF_SUB';
|
|
sub host {
|
|
# -------------------------------------------------------------------
|
|
# Returns the name of the host being used.
|
|
#
|
|
my $self = shift;
|
|
return $self->{connect}->{host};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{port} = __LINE__ . <<'END_OF_SUB';
|
|
sub port {
|
|
# -------------------------------------------------------------------
|
|
# Returns the port currently being used, undef if default.
|
|
#
|
|
my $self = shift;
|
|
return $self->{connect}->{port};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{database} = __LINE__ . <<'END_OF_SUB';
|
|
sub database {
|
|
# -------------------------------------------------------------------
|
|
# Returns the name of the database being used.
|
|
#
|
|
my $self = shift;
|
|
return $self->{connect}->{database};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{login} = __LINE__ . <<'END_OF_SUB';
|
|
sub login {
|
|
# -------------------------------------------------------------------
|
|
# Returns the login username for the current connection.
|
|
#
|
|
my $self = shift;
|
|
return $self->{connect}->{login};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{password} = __LINE__ . <<'END_OF_SUB';
|
|
sub password {
|
|
# -------------------------------------------------------------------
|
|
# Returns the login password for the current connection.
|
|
#
|
|
my $self = shift;
|
|
return $self->{connect}->{password};
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ============================================================================ #
|
|
# HTML ACCESSSOR #
|
|
# ============================================================================ #
|
|
|
|
$COMPILE{html} = __LINE__ . <<'END_OF_SUB';
|
|
sub html {
|
|
# -------------------------------------------------------------------
|
|
# Return an html object. Takes an array ref of table names, or a, and a cgi
|
|
# object.
|
|
# my $html = $db->html(['Links'], $in);
|
|
# or
|
|
# my $html = $db->html($table_obj, $in);
|
|
#
|
|
my ($self, $tables, $cgi) = @_;
|
|
ref $tables or return $self->fatal(BADARGS => 'Error: no table array ref passed to html');
|
|
ref $cgi or return $self->fatal(BADARGS => 'Error: no cgi object/hash ref passed to html');
|
|
|
|
# If already passed a table object, use it, otherwise create a new one
|
|
my ($table);
|
|
if (ref $tables eq 'ARRAY') {
|
|
$table = $self->table(@$tables);
|
|
}
|
|
elsif (UNIVERSAL::isa($tables, 'GT::SQL::Table') or UNIVERSAL::isa($tables, 'GT::SQL::Relation')) {
|
|
$table = $tables;
|
|
}
|
|
else {
|
|
return $self->fatal(BADARGS => "Error: '$tables' must be either an array ref or a table object");
|
|
}
|
|
|
|
my $meth = @{[$table->name]} > 1 ? "_html_relation" : "_html_table";
|
|
$self->$meth($table, $cgi);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_html_relation} = __LINE__ . <<'END_OF_SUB';
|
|
sub _html_relation {
|
|
my ($self, $rel, $cgi) = @_;
|
|
|
|
my $class;
|
|
my $key = join "\0", map { s/^$self->{connect}->{PREFIX}//; $_ } sort keys %{$rel->{tables}};
|
|
foreach my $table (values %{$rel->{tables}}) {
|
|
my $subclass = $table->subclass;
|
|
if ($self->{subclass} and exists $subclass->{html}->{$self->{connect}->{PREFIX} . $key}) {
|
|
$class = $subclass->{html}->{$self->{connect}->{PREFIX} . $key};
|
|
$self->_load_module($class) or return;
|
|
last;
|
|
}
|
|
}
|
|
|
|
if (!$class) {
|
|
require GT::SQL::Display::HTML::Relation;
|
|
$class = 'GT::SQL::Display::HTML::Relation';
|
|
}
|
|
return $class->new(
|
|
db => $rel,
|
|
input => $cgi
|
|
);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_html_table} = __LINE__ . <<'END_OF_SUB';
|
|
sub _html_table {
|
|
my ($self, $table, $cgi) = @_;
|
|
my $class;
|
|
if ($self->{subclass} and $table->{schema}->{subclass}->{html}->{$table->name}) {
|
|
$class = $table->{schema}->{subclass}->{html}->{$table->name};
|
|
$self->_load_module($class) or return;
|
|
}
|
|
if (!$class) {
|
|
require GT::SQL::Display::HTML::Table;
|
|
$class = 'GT::SQL::Display::HTML::Table';
|
|
}
|
|
return $class->new(
|
|
db => $table,
|
|
input => $cgi
|
|
);
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub query_stack {
|
|
# -------------------------------------------------------------------
|
|
# Returns raw query stack (as array/array ref).
|
|
#
|
|
return wantarray ? @GT::SQL::Driver::debug::QUERY_STACK : \@GT::SQL::Driver::debug::QUERY_STACK;
|
|
}
|
|
|
|
sub query_stack_disp {
|
|
# -------------------------------------------------------------------
|
|
# Returns formatted query stack (handled in Driver.pm).
|
|
#
|
|
my ($out, $i) = ('', 0);
|
|
foreach (reverse 0 .. $#GT::SQL::Driver::debug::QUERY_STACK) {
|
|
my $query = $GT::SQL::Driver::debug::QUERY_STACK[$_];
|
|
my $stack = $GT::SQL::Driver::debug::STACK_TRACE[$_] || '';
|
|
$i++;
|
|
chomp $query;
|
|
$query =~ s/^[\s]*(.*?)[\s]*$/$1/mg;
|
|
$query =~ s/\n/\n /mg;
|
|
$out .= "$i: $query\n$stack";
|
|
}
|
|
return $out;
|
|
}
|
|
|
|
|
|
$COMPILE{prefix} = __LINE__ . <<'END_OF_SUB';
|
|
sub prefix {
|
|
# -------------------------------------------------------------------
|
|
# Set/Get the database prefix to be attached to all tables. Calling this as a
|
|
# class accessor method is extremely deprecated (it returns $GT::SQL::PREFIX,
|
|
# which is itself extremely deprecated); calling this to *set* a prefix is not
|
|
# permitted.
|
|
#
|
|
|
|
my $self = shift;
|
|
|
|
if (@_) {
|
|
ref $self or $self->fatal(BADARGS => 'Usage: $obj->prefix(...) not CLASS->prefix(...)');
|
|
my $prefix = shift;
|
|
if ($prefix =~ /\W/) {
|
|
return $self->fatal(BADPREFIX => $prefix);
|
|
}
|
|
$self->{connect}->{PREFIX} = $prefix;
|
|
}
|
|
else {
|
|
return ref $self ? $self->{connect}->{PREFIX} : $GT::SQL::PREFIX;
|
|
}
|
|
return 1;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{reset_env} = __LINE__ . <<'END_OF_SUB';
|
|
sub reset_env {
|
|
# -------------------------------------------------------------------
|
|
# Reset globals.
|
|
#
|
|
GT::SQL::Driver->reset_env(); # Shut down database connections.
|
|
%OBJ_CACHE = ();
|
|
$error = '';
|
|
$errcode = '';
|
|
}
|
|
END_OF_SUB
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::SQL - A database independent perl interface
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use GT::SQL;
|
|
|
|
my $db = GT::SQL->new('/path/to/def');
|
|
my $table = $db->table('Links');
|
|
my $editor = $db->editor('Links');
|
|
my $creator = $db->creator('NewTable');
|
|
my $html = $db->html('Links', new CGI);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
GT::SQL is a perl database abstraction layer to relational databases, providing
|
|
a native Perl interface rather than a query-based interface.
|
|
|
|
A GT::SQL object provides the interface to the entire database by providing
|
|
objects that are able to perform the work needed.
|
|
|
|
=head2 Creating a new GT::SQL object
|
|
|
|
There are two ways to get a GT::SQL object. First, you can simply provide the
|
|
path to the def file directory where GT::SQL stores all it's information:
|
|
|
|
$db = GT::SQL->new('/path/to/def');
|
|
|
|
or you can pass in a hash or hash ref and specify options:
|
|
|
|
$db = GT::SQL->new(
|
|
def_path => '/path/to/def',
|
|
cache => 1,
|
|
debug => 1,
|
|
subclass => 1
|
|
);
|
|
|
|
You must specify def_path. Setting C<cache =E<gt> 1> will result in all table
|
|
and relation objects being cached, which provides a performance improvement in
|
|
any situation where the same table or relation is used again.
|
|
|
|
Specifying C<subclass =E<gt> 0> or C<subclass =E<gt> 1> will enable or disable
|
|
the ability to subclass any of the objects GT::SQL creates. The default
|
|
value is C<1>, and should not normally be changed.
|
|
|
|
GT::SQL has significant amounts of debugging output that can be enabled by
|
|
specifying a value of C<1> to the C<debug> option. Larger values can be
|
|
specified for more detailed debugging output, however a level of C<1> is almost
|
|
always more than sufficient. The accepted values are as follows:
|
|
|
|
=over 4
|
|
|
|
=item Level 0
|
|
|
|
This is the default, no debugging information is printed to stderr. All errors
|
|
can be obtained in $GT::SQL::error.
|
|
|
|
=item Level 1
|
|
|
|
All queries will be displayed to stderr. This is the recommended value if
|
|
query debugging is desired.
|
|
|
|
=item Level 2
|
|
|
|
Same as level 1, but includes more detailed information. Also, when calling
|
|
query_stack you get a stack trace on what generated each query. Not
|
|
recommended except when working directly on GT::SQL.
|
|
|
|
=item Level 3
|
|
|
|
Very detailed debug logs including creation and destruction of objects.
|
|
query_stack generates a javascript page with query, stack trace, and data dump
|
|
of arguments, but can be extremely large. Not recommended except for debugging
|
|
GT::SQL internals.
|
|
|
|
=back
|
|
|
|
B<Pass in a def path>
|
|
|
|
$obj = GT::SQL->new('/path/to/def/directory');
|
|
|
|
This method of calling new is also supported, however has the drawback that
|
|
none of the above options can be provided.
|
|
|
|
=head2 Getting Connected
|
|
|
|
GT::SQL loads the database connection info from database.def which is located
|
|
in the defs directory.
|
|
|
|
To create this file, you call set_connect() as follows:
|
|
|
|
$obj->set_connect({
|
|
driver => 'mysql',
|
|
host => 'localhost',
|
|
port => 3243,
|
|
database => 'databasename',
|
|
login => 'username',
|
|
password => 'password',
|
|
PREFIX => 'prefix_'
|
|
});
|
|
|
|
This will test the database information, and save it to the def file. All
|
|
future connections will automatically use this connection information.
|
|
|
|
Not all of the arguments in this hash are necessary; some have reasonable
|
|
defaults for the connection.
|
|
|
|
=over 4
|
|
|
|
=item driver
|
|
|
|
This needs to be the driver that is being used for the connection. The default
|
|
for this is C<mysql>. Driver names are case-insensitive. Available drivers
|
|
are:
|
|
|
|
=over 4
|
|
|
|
=item MySQL
|
|
|
|
Driver for MySQL databases. Requires that the DBD::mysql module be installed.
|
|
|
|
=item Pg
|
|
|
|
Driver for PostgreSQL databases. Requires that the DBD::Pg module be
|
|
installed.
|
|
|
|
=item MSSQL
|
|
|
|
Driver for MSSQL 7.0 and above. Requires that the DBD::ODBC module be
|
|
installed.
|
|
|
|
=item Oracle
|
|
|
|
Driver for Oracle 8 and above. Requires the DBD::Oracle module.
|
|
|
|
=back
|
|
|
|
=item host
|
|
|
|
This will specify the host to connect to. The default, which is acceptable for
|
|
most installations, is C<localhost>.
|
|
|
|
=item port
|
|
|
|
This is the port on which to connect to the SQL server. The default for this
|
|
is to allow the DBI driver to choose the default, which is almost always the
|
|
appropriate choice.
|
|
|
|
=item database
|
|
|
|
This is the database name to use on the SQL server. This is required to
|
|
connect. For MSSQL, this is the I<Data Source> name.
|
|
|
|
=item PREFIX
|
|
|
|
This specifies a prefix to use for table names. See the L</"Table Prefixes">
|
|
section below for more information.
|
|
|
|
=back
|
|
|
|
=head2 Supported Objects
|
|
|
|
The following objects can be obtained through a GT::SQL object:
|
|
|
|
=over 4
|
|
|
|
=item Table/Relation
|
|
|
|
To get a table or relation object for working with SQL tables, you should call:
|
|
|
|
my $table = $db->table('table_name');
|
|
|
|
or for a table join:
|
|
|
|
my $relation = $db->table('table_name', 'other_table');
|
|
|
|
See L<GT::SQL::Table> for more information on how to use a table object.
|
|
|
|
=item Creator
|
|
|
|
To create new tables, you need to use a creator. You can get one by calling:
|
|
|
|
my $creator = $db->creator('new_table');
|
|
|
|
where C<new_table> is the name of the table you wish to create. See
|
|
L<GT::SQL::Creator> for more information on how to use a creator object.
|
|
|
|
=item Editor
|
|
|
|
To edit existing tables (i.e. add/drop/change columns, add/drop indexes, etc.)
|
|
you need an editor object:
|
|
|
|
my $editor = $db->editor('existing_table');
|
|
|
|
where C<existing_table> is the name of the table you wish the modify. See
|
|
L<GT::SQL::Editor> for more information on how to use an editor object.
|
|
|
|
=item HTML
|
|
|
|
To get an html object for generating forms and html output, you need to pass in
|
|
the table/relation object you want to work with, and a cgi object:
|
|
|
|
my $html = $db->html($table, $cgi);
|
|
|
|
The html object uses information found in CGI to set values, etc. See
|
|
L<GT::SQL::Display::HTML> for more information on how to use a html object.
|
|
|
|
=back
|
|
|
|
=head2 Table Prefixes
|
|
|
|
GT::SQL supports the concept of table prefixes. If you specify a prefix using
|
|
the accessor, it is saved in the database.def file and will be used in all
|
|
future calls to table(), editor() and creator().
|
|
|
|
To set a prefix:
|
|
|
|
$db->prefix("foo");
|
|
|
|
to get the current prefix:
|
|
|
|
my $prefix = $db->prefix;
|
|
|
|
What this will do is transparently prepend C<foo> to the beginning of every
|
|
table name. This means anywhere you access the table C<bar>, the actual table
|
|
stored on the SQL server will be C<foobar>. Note that the prefix should B<not>
|
|
be included when getting table/creator/editor/etc. objects - the prefix is
|
|
handled completely transparently to all public GT::SQL functionality.
|
|
|
|
=head2 Query Stack
|
|
|
|
To display a list of all raw SQL queries sent to the database you can use:
|
|
|
|
my @queries = $db->query_stack;
|
|
|
|
or to have them formatted try
|
|
|
|
print $db->query_stack_disp;
|
|
|
|
which will join them up, displayed nicely. This is also available as a class
|
|
method:
|
|
|
|
print GT::SQL->query_stack_disp;
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<GT::SQL::Table>
|
|
|
|
L<GT::SQL::Editor>
|
|
|
|
L<GT::SQL::Creator>
|
|
|
|
L<GT::SQL::Types>
|
|
|
|
L<GT::SQL::Admin>
|
|
|
|
L<GT::SQL::Display::HTML>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: SQL.pm,v 1.112 2007/08/30 00:14:38 brewt Exp $
|
|
|
|
=cut
|