cvsuser 02/01/04 08:41:05
Added: P5EEx/Blue/P5EEx/Blue/Repository DBI.pm SOAP.pm Sample.pm
Log:
added more missing files
Revision Changes Path
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Repository/DBI.pm
Index: DBI.pm
===================================================================
######################################################################
## File: $Id: DBI.pm,v 1.1 2002/01/04 16:41:05 spadkins Exp $
######################################################################
use Repository;
package Repository::DBI;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use Repository::Base;
@ISA = ( "Repository::Base" );
use strict;
=head1 NAME
Repository::DBI - a repository which relies on a DBI interface to a relational
database
=head1 SYNOPSIS
use Repository::DBI;
(see man page for Repository::Base for additional methods)
$rep = Repository::DBI->new(); # looks for %ENV, then config file
$rep = Repository::DBI->new("mysql","mydb","user001","pass001");
$rep = Repository::DBI->new("mysql","mydb","user001","pass001","port=3307");
$rep =
Repository::DBI->new("mysql","mydb","user001","pass001","port=3307","user001");
###################################################################
# methods not defined in the Repository::Base interface
###################################################################
# UTILITY FUNCTIONS: to support the next level of functionality
$select_sql = $rep->mk_select_rows_sql($table, \@cols, \@params,
\%paramvalues, \@ordercols);
$insert_sql = $rep->mk_insert_row_sql ($table, \@cols, \@colvalues);
$update_sql = $rep->mk_update_row_sql ($table, \@cols, \@colvalues, \@keycolidx);
$update_sql = $rep->mk_update_rows_sql($table, \@cols, \@colvalues, \@params,
\%paramvalues);
$delete_sql = $rep->mk_delete_row_sql ($table, \@cols, \@colvalues, \@keycolidx);
$delete_sql = $rep->mk_delete_rows_sql($table, \@params,
\%paramvalues);
###################################################################
# defined in the Repository::Base interface, implemented here
###################################################################
$ok = $rep->connect(); # initialize repository (will happen automatically
in constructor)
$ok = $rep->disconnect(); # cleanup repository (will happen automatically in
destructor)
$rep->is_connected(); # returns 1 if connected (ready for use), 0 if not
$errmsg = $rep->error(); # returns the error string for prev op ("" if no
error)
$numrows = $rep->numrows(); # returns the number of rows affected by prev op
print $rep->error(), "\n" if (!$rep->connect());
print $rep->error(), "\n" if ($rep->connect() != $rep->OK);
# META-DATA: (about the tables)
$rep->load_rep_metadata_auto();
$rep->load_table_metadata_auto($tablename);
# MEDIUM-LEVEL: reads and writes rows, no caching
$row = $rep->select_row ($table, \@cols, \@params,
\%paramvalues);
$rows = $rep->select_rows($table, \@cols, \@params,
\%paramvalues, \@ordercols, $startrow, $endrow);
$ok = $rep->insert_row ($table, \@cols, \@colvalues);
$ok = $rep->insert_rows($table, \@cols, \@rows);
$ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
$ok = $rep->update_rows($table, \@cols, \@colvalues, \@params,
\%paramvalues);
$ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx,
$update_first);
$ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx,
$update_first);
$ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
$ok = $rep->delete_rows($table, \@params,
\%paramvalues);
=cut
######################################################################
# CONSTANTS
######################################################################
######################################################################
# ATTRIBUTES
######################################################################
# CONNECTION ATTRIBUTES
# $self->{dbidriver} # standard DBI driver name ("mysql", "Oracle", etc.)
# $self->{dbname} # the name of the database
# $self->{dbuser} # database user name
# $self->{dbpass} # database password
# $self->{dbschema} # name of the schema within the database
# $self->{dbioptions} # additional dbi options to tack onto the dsn
# $self->{dsn} # DBI connect string
# $self->{attr} # attributes of a connection
# $self->{dbh} # open DBI database handle
######################################################################
# INHERITED ATTRIBUTES
######################################################################
# BASIC
# $self->{name} # name of this repository (often "db")
# $self->{config} # hash of config file data
# CURRENT STATE
# $self->{error} # most recent error generated from this module
# $self->{numrows}
# METADATA - Database Types
# $self->{types}
# $self->{type}{$type}{name}
# $self->{type}{$type}{num}
# $self->{type}{$type}{type}
# $self->{type}{$type}{column_size}
# $self->{type}{$type}{literal_prefix}
# $self->{type}{$type}{literal_suffix}
# $self->{type}{$type}{unsigned_attribute}
# $self->{type}{$type}{auto_unique_value}
# $self->{type}{$type}{quoted}
# METADATA - Tables and Columns
# $self->{table_names}
# $self->{table}{$table}{readonly}
# $self->{table}{$table}{columns}
# $self->{table}{$table}{column}{$column}
# $self->{table}{$table}{column}{$column}{name}
# $self->{table}{$table}{column}{$column}{type_name}
# $self->{table}{$table}{column}{$column}{type}
# $self->{table}{$table}{column}{$column}{notnull}
# $self->{table}{$table}{column}{$column}{quoted}
=head1 DESCRIPTION
The Repository::DBI class encapsulates all access to the database,
changing SQL statements into get(), save(), and delete() methods.
=cut
######################################################################
# INITIALIZATION
######################################################################
sub init {
my $self = shift;
my ($name, $repconf);
$name = $self->{name};
$repconf = $self->{repconfig};
if (defined $repconf->{dbh}) {
$self->{dbh} = $repconf->{dbh};
$self->{preconnected} = 1;
}
}
######################################################################
# CONFIG METHODS
######################################################################
# take positional args and turn them into a %config structure
sub make_config {
my ($self, $dbidriver, $dbname, $dbuser, $dbpass, $dbioptions, $dbschema) = @_;
my ($conf, $repconf);
$repconf = {};
$repconf->{dbidriver} = $dbidriver;
$repconf->{dbname} = $dbname;
$repconf->{dbuser} = $dbuser;
$repconf->{dbpass} = $dbpass;
$repconf->{dbioptions} = $dbioptions;
$repconf->{dbschema} = $dbschema;
$conf = {
'repository' => {
'db' => $repconf,
},
};
$conf;
}
sub read_config {
my $self = shift;
if ($ENV{DBIDRIVER} && $ENV{DBNAME}) {
return $self->make_config(
$ENV{DBIDRIVER},
$ENV{DBNAME},
$ENV{DBUSER},
$ENV{DBPASS},
$ENV{DBIOPTIONS},
$ENV{DBSCHEMA}
);
}
else {
return ($self->SUPER::read_config());
}
}
######################################################################
# CONNECTION METHODS
######################################################################
sub connect {
my $self = shift;
my ($repname, $repconf);
$repname = $self->{name};
$repconf = $self->{config}{repository}{$repname};
if (!defined $self->{dbh}) {
if (!defined $self->{dsn}) {
my ($dbidriver, $dbname, $dbuser, $dbpass, $dbioptions, $dbschema);
$dbidriver = $repconf->{dbidriver};
$dbname = $repconf->{dbname};
$dbuser = $repconf->{dbuser};
$dbpass = $repconf->{dbpass};
$dbioptions = $repconf->{dbioptions};
$dbschema = $repconf->{dbschema};
print STDERR "ERROR: missing DBI driver and/or db name
[$dbidriver,$dbname] in configuration.\n"
if (!$dbidriver || !$dbname);
$self->{dbidriver} = $dbidriver;
$self->{dbname} = $dbname;
$self->{dbuser} = $dbuser;
$self->{dbpass} = $dbpass;
$self->{dbioptions} = $dbioptions;
$self->{dbschema} = $dbschema;
$self->{dsn} = "dbi:${dbidriver}:database=${dbname}";
# enforce driver-specific rules here
if ($dbidriver eq "mysql") {
# force an update of a row to report that is was found (even if the
values didn't change)
$self->{dsn} .= ";mysql_client_found_rows=true";
$self->{attr} = { "PrintError" => 0, "AutoCommit" => 1 };
}
else {
$self->{attr} = { "PrintError" => 0, "AutoCommit" => 0 };
}
}
$self->{dbh} = DBI->connect($self->{dsn}, $self->{dbuser}, $self->{dbpass},
$self->{attr});
}
return(defined $self->{dbh});
}
sub disconnect {
my $self = shift;
if (defined $self->{dbh} && !($self->{preconnected})) {
my $dbh = $self->{dbh};
$dbh->disconnect;
delete $self->{dbh};
}
1;
}
sub is_connected {
my $self = shift;
if (defined $self->{dbh}) { return 1; }
return 0;
}
sub error {
my $err = $_[0]->{dbh}->errstr || $_[0]->{error};
$err ? $err : "";
}
######################################################################
# SQL EXECUTE METHODS (new methods not defined in Repository::Base)
######################################################################
# $colvararr = $rep->exec_select_row($sql);
sub exec_select_row {
my ($self, $sql) = @_;
my (@row, $dbh, $sth, $rc);
if (!defined $self->{dbh}) {
$self->{error} = "Not connected to database";
return ()
}
$dbh = $self->{dbh};
delete $self->{error};
$self->{sql} = $sql;
$sth = $dbh->prepare($sql);
if ($DBI::err) {
return();
}
$rc = $sth->execute;
if ($DBI::err) {
return();
}
@row = $sth->fetchrow;
if ($DBI::err) {
return();
}
$sth->finish;
if ($DBI::err) {
return();
}
\@row;
}
# @colvararr = $rep->exec_select($sql);
sub exec_select {
my ($self, $sql, $startrow, $endrow) = @_;
my (@rows, @row, $dbh, $sth, $rc, $rownum);
if (!defined $self->{dbh}) {
$self->{error} = "Not connected to database";
return ()
}
$dbh = $self->{dbh};
delete $self->{error};
$self->{sql} = $sql;
$sth = $dbh->prepare($sql);
if ($DBI::err) {
return();
}
$rc = $sth->execute;
if ($DBI::err) {
return();
}
$rownum = 0;
while (1) {
@row = $sth->fetchrow;
$rownum++;
if ($DBI::err) {
return();
}
if ($#row < 0 || ($endrow > 0 && $rownum > $endrow)) {
$sth->finish;
if ($DBI::err) {
return();
}
last;
}
if ($rownum >= $startrow) {
push(@rows, [@row]);
}
}
\@rows;
}
# $ok = $rep->exec_sql($sql);
sub exec_sql {
my ($self, $sql) = @_;
my (@data, @row, $dbh, $sth, $rc);
if (!defined $self->{dbh}) {
$self->{error} = "Not connected to database";
return 0
}
$dbh = $self->{dbh};
delete $self->{error};
$self->{numrows} = 0;
$self->{sql} = $sql;
$sth = $dbh->prepare($sql);
if ($DBI::err) {
return(0);
}
$rc = $sth->execute;
$self->{numrows} = $rc;
if ($DBI::err) {
return(0);
}
$sth->finish;
if ($DBI::err) {
return(0);
}
1;
}
######################################################################
# SQL CREATE METHODS (new methods not defined in Repository::Base)
######################################################################
sub mk_where_clause {
my ($self, $table, $paramref, $paramvaluehashref) = @_;
my ($where, $column, $colstr, $value, $colnum, $sqlop, $column_def);
my $tabcolref = $self->{table}{$table}{column};
my %op = (
'contains' => 'like',
'eq' => '=',
'ne' => '!=',
'le' => '<=',
'lt' => '<',
'ge' => '>=',
'gt' => '>',
'in' => 'in',
);
$where = "";
if (!defined $paramref && ref($paramvaluehashref) eq "HASH") {
$paramref = [ (keys %$paramvaluehashref) ];
}
if (defined $paramref && $#$paramref > -1) {
for ($colnum = 0; $colnum <= $#$paramref; $colnum++) {
$colstr = $paramref->[$colnum];
$column = $colstr;
$sqlop = "=";
# check if $column contains an embedded operation, i.e. "name.eq",
"name.contains"
if ($colstr =~ /^(.*)\.([^.]+)$/) {
if ($op{$2}) {
$column = $1;
$sqlop = $op{$2};
}
}
$column_def = $tabcolref->{$column};
next if (!defined $column_def); # skip if the column is unknown
if (! defined $paramvaluehashref->{$colstr}) {
$value = "?"; # TODO: make this work with the "contains" operator
}
else {
$value = $paramvaluehashref->{$colstr};
if ($tabcolref->{$column}{quoted}) {
$value =~ s/'/\\'/g;
$value = ($sqlop eq "like") ? "'%$value%'" : "'$value'";
}
}
$where .= ($colnum == 0) ? "where $column $sqlop $value\n" : " and
$column $sqlop $value\n";
}
}
$where;
}
# $select_sql = $rep->mk_select_rows_sql($table, \@cols, \@params, \%paramvalues,
\@ordercols);
sub mk_select_rows_sql {
my ($self, $table, $colref, $paramref, $paramvaluehashref, $ordercolref) = @_;
$self->load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql, $col, $colnum);
if ($#$colref == -1) {
$self->{error} = "Database->mk_select_rows_sql(): no columns specified";
return();
}
$sql = "select\n " . join(",\n ", @$colref) . "\nfrom $table\n";
$sql .= $self->mk_where_clause($table, $paramref, $paramvaluehashref);
if (defined $ordercolref && $#$ordercolref > -1) {
for ($colnum = 0; $colnum <= $#$ordercolref; $colnum++) {
$col = $ordercolref->[$colnum];
$sql .= ($colnum == 0) ? "order by\n $col" : ",\n $col";
}
$sql .= "\n";
}
$sql;
}
# $sql = $rep->mk_select_joined_rows_sql($table, \@columns,
# \@params, \%paramvalues, \@ordercols,
# $startrow, $endrow,
# \@sortdircols, \@keycolidx, \@writeable, \@columntype,
\@summarykeys);
sub mk_select_joined_rows_sql {
my ($self, $table, $columnref, $paramref, $paramvaluehref, $ordercolref,
$startrow, $endrow,
$sortdircolref, $keycolidxref, $writeref, $reptyperef, $summarykeyref) = @_;
if ($Repository::DEBUG &&
Repository->dbg(ref($self),"mk_select_joined_rows_sql")) {
Repository->dbgprint("mk_select_joined_rows_sql($table, col=$columnref,
p=$paramref, pv=$paramvaluehref, oc=$ordercolref start=$startrow end=$endrow
dir=$sortdircolref, key=$keycolidxref, w=$writeref, typ=$reptyperef,
sum=$summarykeyref)");
Repository->dbgprint(" columnref=[", join(",",@$columnref), "]")
if ($columnref);
Repository->dbgprint(" paramref=[", join(",",@$paramref), "]")
if ($paramref);
Repository->dbgprint(" paramvaluehref=[",join(",",%$paramvaluehref),"]")
if ($paramvaluehref);
Repository->dbgprint(" ordercolref=[", join(",",@$ordercolref), "]")
if ($ordercolref);
Repository->dbgprint(" sortdircolref=[", join(",",@$sortdircolref), "]")
if ($sortdircolref);
Repository->dbgprint(" keycolidxref=[", join(",",@$keycolidxref), "]")
if ($keycolidxref);
Repository->dbgprint(" writeref=[", join(",",@$writeref), "]")
if ($writeref);
Repository->dbgprint(" reptyperef=[", join(",",@$reptyperef), "]")
if ($reptyperef);
Repository->dbgprint(" summarykeyref=[", join(",",@$summarykeyref), "]")
if ($summarykeyref);
}
my ($table_def, $tablealiases, $tablealiashref);
$table_def = $self->{table}{$table};
return undef if (!$table_def);
$self->load_table_metadata($table) if (!defined $table_def->{loaded});
$tablealiases = $table_def->{tablealiases};
$tablealiashref = $table_def->{tablealias};
############################################################
# Record indexes of all requested columns
############################################################
my ($idx, $column, %columnidx, @write, @reptype);
for ($idx = 0; $idx <= $#$columnref; $idx++) {
$column = $columnref->[$idx];
if (! defined $columnidx{$column}) {
$columnidx{$column} = $idx;
}
$write[$idx] = 1; # assume every field writable
$reptype[$idx] = "string"; # assume every field a string (most general
type)
}
############################################################
# ensure that the primary key and sort keys are included
############################################################
my ($dbexpr, $columnalias, $columntype, $column_def);
my (%dbexpr, @select_phrase, $group_reqd, @group_dbexpr, %reqd_tables);
my (@keycolidx, $prikey, $pritab);
my ($is_summary, %is_summary_key, $summaryexpr, @group_summarykeys);
$is_summary = (defined $summarykeyref && $#$summarykeyref >= 0);
$pritab = "";
if ($is_summary) {
foreach $column (@$summarykeyref) { # primary key is list of summary
keys
$is_summary_key{$column} = 1;
if (! defined $columnidx{$column}) {
push(@$columnref, $column); # add the column to the list
$columnidx{$column} = $#$columnref;
}
push(@keycolidx, $columnidx{$column});
$write[$columnidx{$column}] = 0; # keys aren't editable
}
}
else { # non-summary (detail) table rows
$prikey = $table_def->{prikey}; # primary key is in the metadata
if ($prikey) {
foreach $column (@$prikey) {
if (! defined $columnidx{$column}) {
push(@$columnref, $column); # add the column to the list
$columnidx{$column} = $#$columnref;
}
push(@keycolidx, $columnidx{$column});
$write[$columnidx{$column}] = 0; # keys aren't editable
$dbexpr = $table_def->{column}{$column}{dbexpr}; # take note of
table the key is on
if ($dbexpr && $dbexpr =~
/^([a-zA-Z][a-zA-Z0-9_]*)\.[a-zA-Z_][a-zA-Z_0-9]*$/) {
$pritab = $1;
}
}
}
}
if (defined $ordercolref && ref($ordercolref) eq "ARRAY") {
foreach $column (@$ordercolref) { # foreach sort key
if ($column && ! defined $columnidx{$column}) {
push(@$columnref, $column); # add the column to the list
$columnidx{$column} = $#$columnref;
}
}
}
for ($idx = 0; $idx <= $#$columnref; $idx++) {
$column = $columnref->[$idx];
$column_def = $table_def->{column}{$column};
if (!defined $column_def) {
push(@select_phrase, "NULL u$idx");
next;
}
$columnalias = $column_def->{alias};
$dbexpr = $column_def->{dbexpr};
$reptype[$idx] = $column_def->{type};
# if the field is not defined, or it is not a simple field on the primary
table...
if (!defined $dbexpr || $dbexpr !~ /^$pritab\.[a-zA-Z_][a-zA-Z0-9_]*$/) {
$write[$idx] = 0; # consider it *not* writable
}
############################################################
# accumulate select expressions and their aliases
############################################################
if ($is_summary) {
if ($is_summary_key{$column}) {
if (defined $dbexpr) {
push(@select_phrase, "$dbexpr $columnalias");
push(@group_summarykeys, $columnalias);
}
}
else {
$summaryexpr = $column_def->{summary};
if (!defined $summaryexpr || $summaryexpr eq "") {
$columntype = $column_def->{type};
if ($columntype eq "integer" || $columntype eq "number") {
$summaryexpr = "avg(\$)";
}
else {
$summaryexpr = "count(distinct(\$))";
}
}
if (defined $dbexpr) {
$summaryexpr =~ s#\$#$dbexpr#g; # substitute the dbexpr into
the summaryexpr
}
else {
$summaryexpr = "NULL";
}
push(@select_phrase, "$summaryexpr $columnalias") if ($summaryexpr);
}
}
else {
push(@select_phrase, (defined $dbexpr) ? "$dbexpr $columnalias" : "NULL
$columnalias");
}
############################################################
# get the expression from the config info
############################################################
if (!defined $dbexpr || $dbexpr eq "") {
$dbexpr{$column} = "NULL";
}
else {
############################################################
# save selected columns for reference
############################################################
$dbexpr{$column} = $dbexpr;
############################################################
# accumulate group-by columns and whether grouping reqd
############################################################
if (($dbexpr =~ /sum *\(/i) ||
($dbexpr =~ /min *\(/i) ||
($dbexpr =~ /max *\(/i) ||
($dbexpr =~ /avg *\(/i) ||
($dbexpr =~ /std *\(/i) ||
($dbexpr =~ /stddev *\(/i) || # Oracle extension (supported by MySQL)
($dbexpr =~ /count *\(/i)) {
$group_reqd = 1;
}
else {
push(@group_dbexpr, $columnalias);
}
############################################################
# For each table, mentioned in the select expression...
############################################################
$self->require_tables($dbexpr, \%reqd_tables, $tablealiashref, 1);
}
}
############################################################
# copy data out if a reference is given
############################################################
if (defined $keycolidxref && ref($keycolidxref) eq "ARRAY") {
@$keycolidxref = @keycolidx;
}
if (defined $writeref && ref($writeref) eq "ARRAY") {
@$writeref = @write;
}
if (defined $reptyperef && ref($reptyperef) eq "ARRAY") {
@$reptyperef = @reptype;
}
############################################################
# create order-by columns
############################################################
my (@order_by_dbexpr, $order_by_dbexpr);
if (defined $ordercolref && ref($ordercolref) eq "ARRAY") {
for ($idx = 0; $idx <= $#$ordercolref; $idx++) {
$column = $ordercolref->[$idx];
$column_def = $table_def->{column}{$column};
next if (!defined $column_def);
$order_by_dbexpr = $dbexpr{$column};
if (!$order_by_dbexpr) {
$order_by_dbexpr = $column_def->{dbexpr};
$self->require_tables($order_by_dbexpr, \%reqd_tables,
$tablealiashref, 1);
}
$columnalias = $column_def->{alias};
$order_by_dbexpr = $columnalias if ($columnalias);
if ($order_by_dbexpr) {
if (defined $sortdircolref && ref($sortdircolref) eq "ARRAY" &&
$sortdircolref->[$idx]) {
if ($sortdircolref->[$idx] eq "UP") {
$order_by_dbexpr .= " asc";
}
elsif ($sortdircolref->[$idx] eq "DOWN") {
$order_by_dbexpr .= " desc";
}
}
push(@order_by_dbexpr, $order_by_dbexpr);
}
}
}
############################################################
# create initial where conditions for the selected rows
############################################################
my %op = (
'contains' => 'like',
'eq' => '=',
'ne' => '!=',
'le' => '<=',
'lt' => '<',
'ge' => '>=',
'gt' => '>',
'in' => 'in',
);
my ($where_condition, @join_conditions, @criteria_conditions, $param, $sqlop,
$paramvalue);
if (!defined $paramref && ref($paramvaluehref) eq "HASH") {
$paramref = [ keys %$paramvaluehref ];
}
for ($idx = 0; $idx <= $#$paramref; $idx++) {
$param = $paramref->[$idx];
next if (!defined $param || $param eq "");
next if (!defined $paramvaluehref || $paramvaluehref->{$param} eq "");
$column = $param;
if ($param eq "_key") {
# o TODO: enable multi-field primary keys (this assumes one-field only)
# o TODO: enable non-integer primary key fields (this assumes integer,
no quotes)
$column = $table_def->{prikey}; # assumes one column primary key
$dbexpr = $table_def->{column}{$column}{dbexpr};
if ($paramvalue =~ /,/) {
$where_condition = "$dbexpr in ($paramvalue)"; # assumes one
column, non-quoted primary key
}
else {
$where_condition = "$dbexpr = $paramvalue"; # assumes one
column, non-quoted primary key
}
push(@criteria_conditions, $where_condition);
next;
}
$sqlop = "=";
# check if $param contains an embedded operation, i.e. "name.eq",
"name.contains"
if ($param =~ /^(.*)\.([^.]+)$/) {
if ($op{$2}) {
$column = $1;
$sqlop = $op{$2};
}
}
$column_def = $table_def->{column}{$column};
if (!defined $column_def) {
if ($param =~ /^begin_(.*)/) {
$column = $1;
$sqlop = ">=";
}
elsif ($param =~ /^end_(.*)/) {
$column = $1;
$sqlop = "<=";
}
$column_def = $table_def->{column}{$column};
}
next if (!defined $column_def); # skip if the column is unknown
if (! defined $paramvaluehref->{$param}) {
$paramvalue = "?"; # TODO: make this work with the "contains" operator
}
else {
$paramvalue = $paramvaluehref->{$param};
if ($sqlop eq "like") {
$paramvalue =~ s/'/\\'/g;
$paramvalue = "'%$paramvalue%'";
}
elsif ($sqlop eq "in" || $sqlop eq "=") {
if ($column_def->{quoted}) {
$paramvalue =~ s/'/\\'/g;
if ($paramvalue =~ /,/) {
$paramvalue =~ s/,/','/g;
$paramvalue = "('$paramvalue')";
$sqlop = "in";
}
else {
$paramvalue = "'$paramvalue'";
$sqlop = "=";
}
}
else {
if ($paramvalue =~ /,/) {
$paramvalue = "($paramvalue)";
$sqlop = "in";
}
else {
$sqlop = "=";
}
}
}
elsif (!defined $column_def->{quoted} || $column_def->{quoted}) {
$paramvalue =~ s/'/\\'/g;
$paramvalue = "'$paramvalue'";
}
}
$dbexpr = $column_def->{dbexpr};
if (defined $dbexpr && $dbexpr ne "") {
$self->require_tables($dbexpr, \%reqd_tables, $tablealiashref, 2);
push(@criteria_conditions, "$dbexpr $sqlop $paramvalue");
}
}
# THIS IS DEAD CODE.
# I NEED TO FIGURE OUT WHAT IT USED TO DO SO I CAN FIGURE WHETHER I NEED
# TO REWRITE IT AND REINSTATE IT IN THE CURRENT CODE BASE.
# {
# my ($paramsql_alias_table, %param_used, @params_to_be_used);
# my ($cond1, $cond2, $expr, $p1, $p2, $p1val, $p2val, @pval);
# my ($crit_lines);
#
# $paramsql_alias_table = $self->{table}{aliases}{$table}{parametersql};
# $paramsql_alias_table = $table if (!$dep_alias_table);
# $crit_lines = $self->{table}{criterialines}{$dep_alias_table}
#
# CRIT: foreach $expr (@crit_lines) {
# @params_to_be_used = ();
# if ($expr =~ /^ *([^ ].*[^ ]) *\? *([^ ].*[^ ]) *$/) {
# $cond1 = $1;
# $expr = $2;
#
# if ($cond1 =~ /^#(.+)/) {
# $p = $1;
# @pval = $query->param($p);
# next if ($#pval <= 0);
# }
# elsif ($cond1 =~ /^([a-zA-Z0-9]+) *== *\*([a-zA-Z0-9]+) *$/) {
# $p1 = $1;
# $p2 = $2;
# next CRIT if (defined $param_used{$p1} || defined
$param_used{$p2});
# $p1val = $query->param($p1);
# $p2val = $query->param($p2);
# next CRIT if (!defined $p1val || !defined $p2val || $p1val ne
$p2val);
# push(@params_to_be_used, $p2);
# }
# }
#
# $cond2 = $expr;
# while ($cond2 =~ s/{([a-zA-Z0-9]+)}//) {
# $p = $1;
# @pval = $query->param($p);
# next CRIT if (!defined @pval || $#pval < 0 || $pval[0] eq "");
# next CRIT if (defined $param_used{$p});
# push(@params_to_be_used, $p);
# if ($expr =~ /'{$p}'/) {
# $p1val = "'" . join("','",@pval) . "'";
# $expr =~ s/'{$p}'/$p1val/;
# }
# else {
# $p1val = join(",",@pval);
# $expr =~ s/{$p}/$p1val/;
# }
# }
# foreach (@params_to_be_used) {
# $param_used{$_} = 1;
# }
# push(@criteria_conditions, $expr);
# $self->require_tables($expr, \%reqd_tables, $table_aliases, 2);
# }
# }
############################################################
# put tables in table list in the standard order
# and build the join criteria
############################################################
my ($dbtable, $tablealias, @from_tables);
foreach $tablealias (@$tablealiases) {
if ($reqd_tables{$tablealias}) {
$dbtable = $tablealiashref->{$tablealias}{table};
if ($dbtable) {
push(@from_tables,"$dbtable $tablealias");
}
else {
push(@from_tables,$tablealias);
}
$where_condition = $tablealiashref->{$tablealias}{joincriteria};
push(@join_conditions, split(/ +and +/,$where_condition)) if
($where_condition);
}
}
if ($#from_tables == -1 && $#$tablealiases > -1) {
$tablealias = $tablealiases->[0];
$table = $tablealiashref->{$tablealias}{table};
if ($table) {
push(@from_tables,"$table $tablealias");
}
else {
push(@from_tables,$tablealias);
}
}
############################################################
# create the SQL statement
############################################################
my ($sql, $critsense);
if ($#select_phrase >= 0) {
$sql = "select\n " .
join(",\n ",@select_phrase) . "\n" .
"from\n " .
join(",\n ",@from_tables) . "\n";
}
if ($#join_conditions >= 0) {
$sql .= "where " . join("\n and ",@join_conditions) . "\n";
}
$critsense = "AND";
$critsense = $paramvaluehref->{"_query.critsense"} if (defined $paramvaluehref);
$critsense = "AND" if (!defined $critsense);
if ($#criteria_conditions >= 0) {
$sql .= ($#join_conditions == -1 ? "where " : " and ");
if ($critsense eq "NOT_AND") {
$sql .= "not (" . join("\n and ",@criteria_conditions) . ")\n";
}
elsif ($critsense eq "NOT_OR") {
$sql .= "not (" . join("\n or ",@criteria_conditions) . ")\n";
}
elsif ($critsense eq "OR") {
$sql .= "(" . join("\n or ",@criteria_conditions) . ")\n";
}
else {
$sql .= join("\n and ",@criteria_conditions) . "\n";
}
}
if ($#group_summarykeys >= 0) {
$sql .= "group by\n " . join(",\n ",@group_summarykeys) . "\n";
}
elsif ($group_reqd && $#group_dbexpr >= 0) {
$sql .= "group by\n " . join(",\n ",@group_dbexpr) . "\n";
}
if ($#order_by_dbexpr >= 0) {
$sql .= "order by\n " . join(",\n ",@order_by_dbexpr) . "\n";
}
############################################################
# return the SQL statement
############################################################
$sql;
}
sub require_tables {
my ($self, $dbexpr, $reqd_tables, $tablealiashref, $require_type) = @_;
my ($tablealias, $tablealias2, @tablealias, %tableseen, $dependencies);
while ($dbexpr =~ s/([a-zA-Z_][a-zA-Z_0-9]*)\.[a-zA-Z_][a-zA-Z_0-9]*//) {
if (defined $tablealiashref->{$1} && !$tableseen{$1}) {
push(@tablealias, $1);
$tableseen{$1} = 1;
}
while ($tablealias = pop(@tablealias)) {
if (! defined $reqd_tables->{$tablealias}) {
$reqd_tables->{$tablealias} = $require_type;
$dependencies = $tablealiashref->{$tablealias}{dependencies};
push(@tablealias, @$dependencies)
if (defined $dependencies && ref($dependencies) eq "ARRAY");
}
elsif ($reqd_tables->{$tablealias} < $require_type) {
$reqd_tables->{$tablealias} = $require_type;
}
}
}
}
# $insert_sql = $rep->mk_insert_row_sql ($table, \@cols, \@colvalueref);
sub mk_insert_row_sql {
my ($self, $table, $colref, $colvalueref) = @_;
$self->load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql, $values, $col, $value, $colnum);
if ($#$colref == -1) {
$self->{error} = "Database->mk_insert_row_sql(): no columns specified";
return();
}
my $tabcolref = $self->{table}{$table}{column};
$sql = "insert into $table\n";
$values = "values\n";
for ($colnum = 0; $colnum <= $#$colref; $colnum++) {
$col = $colref->[$colnum];
if ($#$colvalueref == -1) {
$value = "?";
}
else {
$value = $colvalueref->[$colnum];
if ($tabcolref->{$col}{quoted}) {
$value =~ s/'/\\'/g;
$value = "'$value'";
}
}
$sql .= ($colnum == 0) ? " ($col" : ",\n $col";
$values .= ($colnum == 0) ? " ($value" : ",\n $value";
}
$sql .= ")\n";
$values .= ")\n";
$sql . $values;
}
# $update_sql = $rep->mk_update_row_sql ($table, \@cols, \@colvalueref, \@keycolidx);
sub mk_update_row_sql {
my ($self, $table, $colref, $colvalueref, $keycolidxref) = @_;
$self->load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql, $where, @colused, $col, $value, $colnum, $i, $nonkeycolnum);
if ($#$colref == -1) {
$self->{error} = "Database->mk_update_row_sql(): no columns specified";
return();
}
my $tabcolref = $self->{table}{$table}{column};
$colused[$#$colref] = 0; # pre-extend the array
$sql = "update $table set\n";
$where = "";
if (defined $keycolidxref && $#$keycolidxref > -1) {
for ($i = 0; $i <= $#$keycolidxref; $i++) {
$colnum = $keycolidxref->[$i];
$col = $colref->[$colnum];
if ($#$colvalueref == -1) {
$value = "?";
}
else {
$value = $colvalueref->[$colnum];
if ($tabcolref->{$col}{quoted}) {
$value =~ s/'/\\'/g;
$value = "'$value'";
}
}
$where .= ($i == 0) ? "where $col = $value" : "\n and $col = $value";
$colused[$colnum] = 1;
}
$where .= "\n";
}
$nonkeycolnum = 0;
for ($colnum = 0; $colnum <= $#$colref; $colnum++) {
if (!$colused[$colnum]) {
$col = $colref->[$colnum];
if ($#$colvalueref == -1) {
$value = "?";
}
else {
$value = $colvalueref->[$colnum];
if ($tabcolref->{$col}{quoted}) {
$value =~ s/'/\\'/g;
$value = "'$value'";
}
}
$sql .= ($nonkeycolnum++ == 0) ? " $col = $value" : ",\n $col =
$value";
}
}
"$sql\n$where";
}
# $update_sql = $rep->mk_update_rows_sql($table, \@cols, \@colvalueref, \@params,
\%paramvalues);
sub mk_update_rows_sql {
my ($self, $table, $colref, $colvalueref, $paramref, $paramvaluehashref) = @_;
$self->load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql, $col, $value, $colnum);
if ($#$colref == -1) {
$self->{error} = "Database->mk_update_rows_sql(): no columns specified";
return();
}
my $tabcolref = $self->{table}{$table}{column};
$sql = "update $table set";
for ($colnum = 0; $colnum <= $#$colref; $colnum++) {
$col = $colref->[$colnum];
if ($#$colvalueref == -1) {
$value = "?";
}
else {
$value = $colvalueref->[$colnum];
if ($tabcolref->{$col}{quoted}) {
$value =~ s/'/\\'/g;
$value = "'$value'";
}
}
$sql .= ($colnum == 0) ? "\n $col = $value" : ",\n $col = $value";
}
$sql .= "\n";
$sql .= $self->mk_where_clause($table, $paramref, $paramvaluehashref);
$sql;
}
# $delete_sql = $rep->mk_delete_row_sql ($table, \@cols, \@colvalueref, \@keycolidx);
sub mk_delete_row_sql {
my ($self, $table, $colref, $colvalueref, $keycolidxref) = @_;
$self->load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql, $where, @colused, $col, $value, $colnum, $i, $nonkeycolnum);
if ($#$colref == -1) {
$self->{error} = "Database->mk_delete_row_sql(): no columns specified";
return();
}
my $tabcolref = $self->{table}{$table}{column};
$colused[$#$colref] = 0; # pre-extend the array
$sql = "delete from $table\n";
if (defined $keycolidxref && $#$keycolidxref > -1) {
for ($i = 0; $i <= $#$keycolidxref; $i++) {
$colnum = $keycolidxref->[$i];
$col = $colref->[$colnum];
if ($#$colvalueref == -1) {
$value = "?";
}
else {
$value = $colvalueref->[$colnum];
if ($tabcolref->{$col}{quoted}) {
$value =~ s/'/\\'/g;
$value = "'$value'";
}
}
$where .= ($i == 0) ? "where $col = $value" : "\n and $col = $value";
$colused[$colnum] = 1;
}
$where .= "\n";
}
"$sql$where";
}
# $delete_sql = $rep->mk_delete_rows_sql($table, \@params, \%paramvalues);
sub mk_delete_rows_sql {
my ($self, $table, $paramref, $paramvaluehashref) = @_;
$self->load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql, $col, $colnum);
$sql = "delete from $table\n";
$sql .= $self->mk_where_clause($table, $paramref, $paramvaluehashref);
$sql;
}
######################################################################
# REPOSITORY METHODS (implements methods from Repository::Base)
######################################################################
# $colvalues = $rep->select_row ($table, \@cols, \@params, \%paramvalues);
sub select_row {
my $self = shift;
my ($table, $sql);
$table = $_[0];
if ($self->{table}{$table}{rawaccess}) {
$sql = $self->mk_select_rows_sql(@_);
}
else {
$sql = $self->mk_select_joined_rows_sql(@_);
}
$self->exec_select_row($sql);
}
# NOTE: everything after the first line is optional
# @rows = $rep->select_rows($table, \@cols,
# \@params, \%paramvalues, \@ordercols,
# $startrow, $endrow,
# \@sortdircol, \@keycolidx, \@writeable, \@columntype, \@summarykeys);
# TODO: get the $startrow/$endrow working when one/both/neither work in the SQL
portion
# TODO: rethink $startrow/$endrow vs. $numrows/$skiprows
sub select_rows {
my $self = shift;
my ($table, $startrow, $endrow, $sql);
($table, $startrow, $endrow) = @_[(0,5,6)];
if ($self->{table}{$table}{rawaccess}) {
$sql = $self->mk_select_rows_sql(@_);
}
else {
$sql = $self->mk_select_joined_rows_sql(@_);
}
$self->exec_select($sql, $startrow, $endrow);
}
# $ok = $rep->insert_row ($table, \@cols, \@colvalues);
sub insert_row {
my ($self, $table, $colref, $colvalueref) = @_;
my $sql = $self->mk_insert_row_sql($table, $colref, $colvalueref);
$self->exec_sql($sql);
}
# $ok = $rep->insert_rows ($table, \@cols, \@rows);
sub insert_rows {
my ($self, $table, $cols, $rows) = @_;
my ($row, $sql, $nrows, $ok);
$ok = 1;
foreach $row (@$rows) {
$sql = $self->mk_insert_row_sql($table, $cols, $row);
$nrows += $self->{numrows};
if (!$self->exec_sql($sql)) {
$self->{numrows} = $nrows;
$ok = 0;
last;
}
}
$self->{numrows} = $nrows;
return($ok);
}
# $ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
sub update_row {
my ($self, $table, $colref, $colvalueref, $keycolidxref) = @_;
my $sql = $self->mk_update_row_sql($table, $colref, $colvalueref, $keycolidxref);
$self->exec_sql($sql);
}
# $ok = $rep->update_rows($table, \@cols, \@colvalues, \@params, \%paramvalues);
sub update_rows {
my ($self, $table, $colref, $colvalueref, $paramref, $paramvaluehashref) = @_;
my $sql = $self->mk_update_rows_sql($table, $colref, $colvalueref, $paramref,
$paramvaluehashref);
$self->exec_sql($sql);
}
# $ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx, $update_first);
sub store_row {
my ($self, $table, $colref, $colvalueref, $keycolidxref, $update_first) = @_;
my ($update_sql, $insert_sql, $success);
$success = 0;
if ($update_first) {
$update_sql =
$self->mk_update_row_sql($table,$colref,$colvalueref,$keycolidxref);
$success = $self->exec_sql($update_sql);
$success = 0 if ($self->{numrows} == 0); # SQL succeeded but found no
rows to update
if (!$success) {
$insert_sql = $self->mk_insert_row_sql($table,$colref,$colvalueref);
$success = $self->exec_sql($insert_sql);
}
}
else {
$insert_sql = $self->mk_insert_row_sql($table,$colref,$colvalueref);
$success = $self->exec_sql($insert_sql);
if (!$success) {
$update_sql =
$self->mk_update_row_sql($table,$colref,$colvalueref,$keycolidxref);
$success = $self->exec_sql($update_sql);
$success = 0 if ($self->{numrows} == 0); # SQL succeeded but found
no rows to update
}
}
$success;
}
# $ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx, $update_first);
sub store_rows {
my ($self, $table, $colref, $rowref, $keycolidxref, $update_first) = @_;
my ($colvalueref, $ok, $allok);
$allok = 1;
foreach $colvalueref (@$rowref) {
$ok = $self->store_row ($table, $colref, $colvalueref, $keycolidxref,
$update_first);
$allok = 0 if (!$ok);
}
$allok;
}
# $ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
sub delete_row {
my $self = shift;
my $sql = $self->mk_delete_row_sql(@_);
$self->exec_sql($sql);
}
# $ok = $rep->delete_rows($table, \@params, \%paramvalues);
sub delete_rows {
my $self = shift;
my $sql = $self->mk_delete_rows_sql(@_);
$self->exec_sql($sql);
}
######################################################################
# METADATA REPOSITORY METHODS (implements methods from Repository::Base)
######################################################################
use DBIx::Compat;
sub load_rep_metadata_auto {
my ($self) = @_;
my ($dbidriver, $dbh);
$dbidriver = $self->{dbidriver};
$dbh = $self->{dbh};
#####################################################
# TABLE DATA
#####################################################
my ($table, @tables, $func);
# if we are not hiding the physical tables, go get them
if (! $self->{hide_physical}) {
# get a list of the physical tables from the database
@tables = $dbh->tables;
# if the DBI method doesn't work, try the DBIx method...
if ($#tables == -1) {
$func = DBIx::Compat::GetItem($dbidriver, "ListTables");
@tables = &{$func}($dbh);
}
# go through the list of native tables from the database
foreach $table (@tables) {
# if it has never been defined, then define it
if (!defined $self->{table}{$table}) {
$self->{table}{$table} = {
"name" => $table,
};
}
# if it has not been added to the list and it is not explicitly hidden,
add to list
if (!defined $self->{table}{$table}{idx} && !
$self->{table}{$table}{hide}) {
push(@{$self->{tables}}, $table); # add to list
$self->{table}{$table}{idx} = $#{$self->{tables}}; # take note of
the index
}
}
}
#########################################################
# TYPE DATA
# note: these are native database types, whereas a Repository "type" is a
standard
#########################################################
my ($ntype_attribute_idx, @ntype_attribute_values);
($ntype_attribute_idx, @ntype_attribute_values) = @{$dbh->type_info_all};
# Contents of $type_attribute_idx for MySQL:
# $ntype_attribute_idx = {
# "TYPE_NAME" => 0,
# "DATA_TYPE" => 1,
# "COLUMN_SIZE" => 2,
# "LITERAL_PREFIX" => 3,
# "LITERAL_SUFFIX" => 4,
# "CREATE_PARAMS" => 5,
# "NULLABLE" => 6,
# "CASE_SENSITIVE" => 7,
# "SEARCHABLE" => 8,
# "UNSIGNED_ATTRIBUTE" => 9,
# "FIXED_PREC_SCALE" => 10,
# "AUTO_UNIQUE_VALUE" => 11,
# "LOCAL_TYPE_NAME" => 12,
# "MINIMUM_SCALE" => 13,
# "MAXIMUM_SCALE" => 14,
# "NUM_PREC_RADIX" => 15,
# "mysql_native_type" => 16,
# "mysql_is_num" => 17,
# };
# Contents of @ntype_attribute_values for MySQL:
# TYPE_NAME DATA_TYPE COLUMN_SIZE PRE SUF CREATEPARAMETERS NUL CASE SRCH UNS
FIX AUTO LTYPE MINS MAXS RDX
# varchar 12 255 ' ' max length 1 0 1 0
0 0 0 0 0 0
# decimal 3 15 precision,scale 1 0 1 0
0 0 0 0 6 2
# tinyint -6 3 1 0 1 0
0 0 0 0 0 10
# smallint 5 5 1 0 1 0
0 0 0 0 0 10
# integer 4 10 1 0 1 0
0 0 0 0 0 10
# float 7 7 1 0 0 0
0 0 0 0 2 2
# double 8 15 1 0 1 0
0 0 0 0 4 2
# timestamp 11 14 ' ' 0 0 1 0
0 0 0 0 0 0
# bigint -5 20 1 0 1 0
0 0 0 0 0 10
# middleint 4 8 1 0 1 0
0 0 0 0 0 10
# date 9 10 ' ' 1 0 1 0
0 0 0 0 0 0
# time 10 6 ' ' 1 0 1 0
0 0 0 0 0 0
# datetime 11 21 ' ' 1 0 1 0
0 0 0 0 0 0
# year 5 4 1 0 1 0
0 0 0 0 0 0
# date 9 10 ' ' 1 0 1 0
0 0 0 0 0 0
# enum 12 255 ' ' 1 0 1 0
0 0 0 0 0 0
# set 12 255 ' ' 1 0 1 0
0 0 0 0 0 0
# blob -1 65535 ' ' 1 0 1 0
0 0 0 0 0 0
# tinyblob -1 255 ' ' 1 0 1 0
0 0 0 0 0 0
# mediumblob -1 16777215 ' ' 1 0 1 0
0 0 0 0 0 0
# longblob -1 2147483647 ' ' 1 0 1 0
0 0 0 0 0 0
# char 1 255 ' ' max length 1 0 1 0
0 0 0 0 0 0
# decimal 2 15 precision,scale 1 0 1 0
0 0 0 0 6 2
# tinyint unsigned -6 3 1 0 1 1
0 0 0 0 0 10
# smallint unsigned 5 5 1 0 1 1
0 0 0 0 0 10
# middleint unsigned 4 8 1 0 1 1
0 0 0 0 0 10
# int unsigned 4 10 1 0 1 1
0 0 0 0 0 10
# int 4 10 1 0 1 0
0 0 0 0 0 10
# integer unsigned 4 10 1 0 1 1
0 0 0 0 0 10
# bigint unsigned -5 20 1 0 1 1
0 0 0 0 0 10
# text -1 65535 ' ' 1 0 1 0
0 0 0 0 0 0
# mediumtext -1 16777215 ' ' 1 0 1 0
0 0 0 0 0 0
my ($ntype_name, @ntype_names, $ntype_num, $ntype_attribute_values, $ntype_def);
my ($ntype_name_idx, $ntype_num_idx, $column_size_idx, $literal_prefix_idx,
$literal_suffix_idx);
my ($unsigned_attribute_idx, $auto_unique_value_idx, $column);
$ntype_name_idx = $ntype_attribute_idx->{"TYPE_NAME"};
$ntype_num_idx = $ntype_attribute_idx->{"DATA_TYPE"};
$column_size_idx = $ntype_attribute_idx->{"COLUMN_SIZE"};
$literal_prefix_idx = $ntype_attribute_idx->{"LITERAL_PREFIX"};
$literal_suffix_idx = $ntype_attribute_idx->{"LITERAL_SUFFIX"};
$unsigned_attribute_idx = $ntype_attribute_idx->{"UNSIGNED_ATTRIBUTE"};
$auto_unique_value_idx = $ntype_attribute_idx->{"AUTO_UNIQUE_VALUE"};
# go through the list of native type info from the DBI handle
foreach $ntype_attribute_values (@ntype_attribute_values) {
$ntype_name = $ntype_attribute_values->[$ntype_name_idx];
$ntype_num = $ntype_attribute_values->[$ntype_num_idx];
$ntype_def = {};
push(@ntype_names, $ntype_name);
$self->{native}{type}{$ntype_name} = $ntype_def;
if (!defined $self->{native}{type}{$ntype_num}) {
$self->{native}{type}{$ntype_num} = $ntype_def;
}
# save all the info worth saving in a native type definition
$ntype_def->{name} = $ntype_name; # a real type name
$ntype_def->{num} = $ntype_num; # an internal data type
number
$ntype_def->{column_size} =
$ntype_attribute_values->[$column_size_idx];
$ntype_def->{literal_prefix} =
$ntype_attribute_values->[$literal_prefix_idx];
$ntype_def->{literal_suffix} =
$ntype_attribute_values->[$literal_suffix_idx];
$ntype_def->{unsigned_attribute} =
$ntype_attribute_values->[$unsigned_attribute_idx];
$ntype_def->{auto_unique_value} =
$ntype_attribute_values->[$auto_unique_value_idx];
$ntype_def->{literal_prefix} = "" if (! defined
$ntype_def->{literal_prefix});
$ntype_def->{literal_suffix} = "" if (! defined
$ntype_def->{literal_suffix});
$ntype_def->{quoted} = ($ntype_def->{literal_prefix} ne "" ||
$ntype_def->{literal_suffix} ne "");
# translate a native type into a repository type
if ($ntype_name =~ /char/ || $ntype_name eq "enum" || $ntype_name eq "set") {
$ntype_def->{type} = "string";
}
elsif ($ntype_name =~ /text/) {
$ntype_def->{type} = "text";
}
elsif ($ntype_name =~ /int/ || $ntype_name eq "year") {
$ntype_def->{type} = "integer";
}
elsif ($ntype_name =~ /decimal/ || $ntype_name =~ /float/ || $ntype_name =~
/double/) {
$ntype_def->{type} = "float";
}
elsif ($ntype_name =~ /datetime/ || $ntype_name =~ /timestamp/) {
$ntype_def->{type} = "datetime";
}
elsif ($ntype_name =~ /time/) {
$ntype_def->{type} = "time";
}
elsif ($ntype_name =~ /date/) {
$ntype_def->{type} = "date";
}
elsif ($ntype_name =~ /blob/ || $ntype_name =~ /binary/) {
$ntype_def->{type} = "binary";
}
}
$self->{native}{types} = \@ntype_names;
#########################################################
# DATABASE ATTRIBUTES
#########################################################
$self->{native}{support_join} = DBIx::Compat::GetItem($dbidriver,
"SupportJoin");
$self->{native}{inner_join_syntax} = DBIx::Compat::GetItem($dbidriver,
"SupportSQLJoin");
$self->{native}{inner_join_only2tables} = DBIx::Compat::GetItem($dbidriver,
"SQLJoinOnly2Tabs");
$self->{native}{have_types} = DBIx::Compat::GetItem($dbidriver,
"HaveTypes");
$self->{native}{null_operator} = DBIx::Compat::GetItem($dbidriver,
"NullOperator");
$self->{native}{need_null_in_create} = DBIx::Compat::GetItem($dbidriver,
"NeedNullInCreate");
$self->{native}{empty_is_null} = DBIx::Compat::GetItem($dbidriver,
"EmptyIsNull");
}
sub load_table_metadata_auto {
my ($self, $table) = @_;
return if (! $table);
my ($dbidriver, $dbh, $sth, $native_table, $table_def);
my (@tables, $column, $func, $tablealias);
$dbidriver = $self->{dbidriver};
$dbh = $self->{dbh};
$table_def = $self->{table}{$table};
return if (!defined $table_def);
$native_table = $table; # assume the table name is a physical one
$native_table = $table_def->{native_table} if ($table_def->{native_table});
$table_def->{name} = $table;
$tablealias = $table_def->{alias};
if (! defined $tablealias) {
$tablealias = "t" . Repository->serial("table");
$table_def->{alias} = $tablealias;
}
$table_def->{tablealiases} = [ $tablealias ]
if (!defined $table_def->{tablealiases});
$table_def->{tablealias} = {}
if (!defined $table_def->{tablealias});
$table_def->{tablealias}{$tablealias} = {}
if (!defined $table_def->{tablealias}{$tablealias});
$table_def->{tablealias}{$tablealias}{table} = $table
if (!defined $table_def->{tablealias}{$tablealias}{table});
#########################################################
# COLUMN DATA
#########################################################
my ($colnum, $data_types, $columns, $column_def, $phys_columns);
my ($native_type_num, $native_type_def);
$func = DBIx::Compat::GetItem($dbidriver, "ListFields");
$sth = &{$func}($dbh, $table);
$phys_columns = $sth->{NAME}; # array of fieldnames
$data_types = $sth->{TYPE}; # array of fieldtypes
$columns = $table_def->{columns};
# if we got a list of columns for the table from the database
if (defined $phys_columns && ref($phys_columns) eq "ARRAY") {
for ($colnum = 0; $colnum <= $#$phys_columns; $colnum++) {
$column = $phys_columns->[$colnum];
$column_def = $table_def->{column}{$column};
if (!defined $column_def) {
$column_def = {};
$table_def->{column}{$column} = $column_def;
}
next if ($column_def->{hide});
$native_type_num = $data_types->[$colnum];
$native_type_def = $self->{native}{type}{$native_type_num};
if (! $self->{hide_physical} && ! defined $column_def->{idx}) {
push(@$columns, $column);
$column_def->{idx} = $#$columns;
}
$column_def->{name} = $column;
$column_def->{type} = $native_type_def->{type};
$column_def->{quoted} = $native_type_def->{quoted};
$column_def->{alias} = "cn$colnum" if (!defined $column_def->{alias});
$column_def->{dbexpr} = $table_def->{alias} . "." . $column
if (!defined $column_def->{dbexpr});
}
}
######################################################################
# tables that are related via tablealiases can be "import"-ed
# this copies all of the column definitions from the imported table to this table
# TODO: allow for role modifiers in related tables
# TODO: rethink "import=1" to "multiplicity=1"
# TODO: think about chained imports
# TODO: think about import on demand rather than in advance
######################################################################
my ($tablealiases, $alias, $alias_def, $related_table, $related_table_def);
my ($tablealias_defs, $tablealias_def, $idx);
$tablealiases = $table_def->{tablealiases};
if (defined $tablealiases && ref($tablealiases) eq "ARRAY") {
foreach $alias (@$tablealiases) {
$alias_def = $table_def->{tablealias}{$alias};
if ($alias_def->{import}) {
$related_table = $alias_def->{table};
if (! $self->{table}{$related_table}{loaded}) {
$self->load_table_metadata($related_table);
}
$related_table_def = $self->{table}{$related_table};
foreach $column (@{$related_table_def->{columns}}) {
if (! defined $table_def->{column}{$column} &&
defined $related_table_def->{column}{$column}) {
$table_def->{column}{$column} =
$related_table_def->{column}{$column};
}
}
}
}
}
# for each tablealias named in the configuration, give it a number up front
$tablealias_defs = $table_def->{tablealias};
for ($idx = 0; $idx <= $#$tablealiases; $idx++) {
$tablealias = $tablealiases->[$idx];
$tablealias_defs->{$tablealias}{idx} = $idx;
}
# for each tablealias in the hash (random order), add them to the end
foreach $tablealias (keys %$tablealias_defs) {
$tablealias_def = $tablealias_defs->{$tablealias};
# table has not been added to the list and it's not explicitly "hidden", so
add it
if (!defined $tablealias_def->{idx}) {
push(@$tablealiases, $tablealias);
$tablealias_def->{idx} = $#$tablealiases;
}
}
if ($Repository::DEBUG >= 2 &&
Repository->dbg("Repository::DBI","load_table_metadata_auto",2)) {
print "Table Metadata: $table\n";
Repository->dump($table_def);
}
}
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Repository/SOAP.pm
Index: SOAP.pm
===================================================================
######################################################################
## File: $Id: SOAP.pm,v 1.1 2002/01/04 16:41:05 spadkins Exp $
######################################################################
use Repository;
package Repository::SOAP;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use Repository::Base;
@ISA = ( "Repository::Base" );
use strict;
=head1 NAME
Repository::SOAP - a repository implementation which actually gets data from a
remote source by making a SOAP (simple object access protocol) call
=head1 SYNOPSIS
use Repository::SOAP;
(see man page for Repository::Base for additional methods)
###################################################################
# constructors
###################################################################
$rep = Repository::SOAP->new();
###################################################################
# methods not defined in the Repository::Base interface
###################################################################
# ...
###################################################################
# defined in the Repository::Base interface, implemented here
###################################################################
$ok = $rep->connect(); # initialize repository (will happen automatically
in constructor)
$ok = $rep->disconnect(); # cleanup repository (will happen automatically in
destructor)
$rep->is_connected(); # returns 1 if connected (ready for use), 0 if not
$errmsg = $rep->error(); # returns the error string for prev op ("" if no
error)
$numrows = $rep->numrows(); # returns the number of rows affected by prev op
print $rep->error(), "\n" if (!$rep->connect());
print $rep->error(), "\n" if ($rep->connect() != $rep->OK);
# META-DATA: (about the tables)
$rep->load_rep_metadata_init();
$rep->load_table_metadata_init($tablename);
# MEDIUM-LEVEL: reads and writes rows, no caching
$row = $rep->select_row ($table, \@cols, \@wherecols,
\%wherevalues);
$rows = $rep->select_rows($table, \@cols, \@wherecols,
\%wherevalues, \@ordercols, $startrow, $endrow);
$ok = $rep->insert_row ($table, \@cols, \@colvalues);
$ok = $rep->insert_rows($table, \@cols, \@rows);
$ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
$ok = $rep->update_rows($table, \@cols, \@colvalues, \@wherecols,
\%wherevalues);
$ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx,
$update_first);
$ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx,
$update_first);
$ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
$ok = $rep->delete_rows($table, \@wherecols,
\%wherevalues);
=cut
######################################################################
# CONSTANTS
######################################################################
######################################################################
# ATTRIBUTES
######################################################################
######################################################################
# INHERITED ATTRIBUTES
######################################################################
# BASIC
# $self->{name} # name of this repository (often "default")
# $self->{config} # hash of config file data
# CURRENT STATE
# $self->{error} # most recent error generated from this module
# $self->{numrows}
# METADATA - Data Types
# $self->{types}
# $self->{type}{$type}
# $self->{type}{$type}{name}
# $self->{type}{$type}{type}
# METADATA - Tables and Columns
# $self->{tables}
# $self->{table}{$table}{readonly}
# $self->{table}{$table}{columns}
# $self->{table}{$table}{column}{$column}
# $self->{table}{$table}{column}{$column}{name}
# $self->{table}{$table}{column}{$column}{type}
# $self->{table}{$table}{column}{$column}{notnull}
=head1 DESCRIPTION
The Repository::SOAP class implements a logical repository which
is actually an interface to a remote source of data.
The local interface translates the parameters of the methods
into XML and issues a SOAP (simple object access protocol)
request to a remote machine to fulfill the method.
Details of the actual SOAP request and the remote repository
are controlled by the configuration information.
=cut
######################################################################
# INITIALIZATION
######################################################################
sub init {
my $self = shift;
}
######################################################################
# CONFIG METHODS
######################################################################
# take positional args and turn them into a %config structure
sub make_config {
my $self = shift;
my $conf = {
'repository' => {
'db' => {
},
},
};
$conf;
}
#sub read_config {
# my $self = shift;
# return ($self->SUPER::read_config());
#}
######################################################################
# CONNECTION METHODS
######################################################################
sub connect {
1; # no connection initialization required (HTTP is connectionless)
}
sub disconnect {
1; # no connection de-initialization required (HTTP is connectionless)
}
sub is_connected {
my $self = shift;
return 1; # TODO: might issue a "ping" of some sort to verify contact with
web server
}
sub error {
my ($self) = @_;
return $self->{error};
}
sub numrows {
my ($self) = @_;
return $self->{numrows};
}
######################################################################
# REPOSITORY METHODS (implements methods from Repository::Base)
######################################################################
# $colvalues = $rep->select_row ($table, \@cols, \@wherecols, \%wherevalues);
sub select_row {
my ($self, $table, $colref, $wherecolref, $wherevaluehashref) = @_;
my $row = [];
$colvalues;
}
# $rows = $rep->select_rows($table, \@cols, \@wherecols, \%wherevalues, \@ordercols,
$startrow, $endrow);
sub select_rows {
my ($self, $table, $colref, $wherecolref, $wherevaluehashref, $ordercolref,
$startrow, $endrow) = @_;
my $rows = [];
$rows;
}
# $ok = $rep->insert_row ($table, \@cols, \@colvalues);
sub insert_row {
my ($self, $table, $colref, $colvalueref) = @_;
my $success = 1;
$success;
}
# $ok = $rep->insert_rows ($table, \@cols, \@rows);
sub insert_rows {
my ($self, $table, $cols, $rows) = @_;
my $success = 1;
$success;
}
# $ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
sub update_row {
my ($self, $table, $colref, $colvalueref, $keycolidxref) = @_;
my $success = 1;
$success;
}
# $ok = $rep->update_rows($table, \@cols, \@colvalues, \@wherecols, \%wherevalues);
sub update_rows {
my ($self, $table, $colref, $colvalueref, $wherecolref, $wherevaluehashref) = @_;
my $success = 1;
$success;
}
# $ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx, $update_first);
sub store_row {
my ($self, $table, $colref, $colvalueref, $keycolidxref, $update_first) = @_;
my $success = 1;
$success;
}
# $ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx, $update_first);
sub store_rows {
my ($self, $table, $colref, $rowref, $keycolidxref, $update_first) = @_;
my $success = 1;
$success;
}
# $ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
sub delete_row {
my $self = shift;
my $success = 1;
$success;
}
# $ok = $rep->delete_rows($table, \@wherecols, \%wherevalues);
sub delete_rows {
my $self = shift;
my $success = 1;
$success;
}
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Repository/Sample.pm
Index: Sample.pm
===================================================================
######################################################################
## File: $Id: Sample.pm,v 1.1 2002/01/04 16:41:05 spadkins Exp $
######################################################################
use Repository;
package Repository::Sample;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use Repository::Base;
@ISA = ( "Repository::Base" );
use strict;
=head1 NAME
Repository::Sample - a set of stubs for a repository implementation which can be
copied and modified
=head1 SYNOPSIS
use Repository::Sample;
(see man page for Repository::Base for additional methods)
###################################################################
# constructors
###################################################################
$rep = Repository::Sample->new();
###################################################################
# methods not defined in the Repository::Base interface
###################################################################
# ...
###################################################################
# defined in the Repository::Base interface, implemented here
###################################################################
$ok = $rep->connect(); # initialize repository (will happen automatically
in constructor)
$ok = $rep->disconnect(); # cleanup repository (will happen automatically in
destructor)
$rep->is_connected(); # returns 1 if connected (ready for use), 0 if not
$errmsg = $rep->error(); # returns the error string for prev op ("" if no
error)
$numrows = $rep->numrows(); # returns the number of rows affected by prev op
print $rep->error(), "\n" if (!$rep->connect());
print $rep->error(), "\n" if ($rep->connect() != $rep->OK);
# META-DATA: (about the tables)
$rep->load_rep_metadata_init();
$rep->load_table_metadata_init($tablename);
# MEDIUM-LEVEL: reads and writes rows, no caching
$row = $rep->select_row ($table, \@cols, \@wherecols,
\%wherevalues);
$rows = $rep->select_rows($table, \@cols, \@wherecols,
\%wherevalues, \@ordercols, $startrow, $endrow);
$ok = $rep->insert_row ($table, \@cols, \@colvalues);
$ok = $rep->insert_rows($table, \@cols, \@rows);
$ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
$ok = $rep->update_rows($table, \@cols, \@colvalues, \@wherecols,
\%wherevalues);
$ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx,
$update_first);
$ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx,
$update_first);
$ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
$ok = $rep->delete_rows($table, \@wherecols,
\%wherevalues);
=cut
######################################################################
# CONSTANTS
######################################################################
######################################################################
# ATTRIBUTES
######################################################################
######################################################################
# INHERITED ATTRIBUTES
######################################################################
# BASIC
# $self->{name} # name of this repository (often "default")
# $self->{config} # hash of config file data
# CURRENT STATE
# $self->{error} # most recent error generated from this module
# $self->{numrows}
# METADATA - Data Types
# $self->{types}
# $self->{type}{$type}
# $self->{type}{$type}{name}
# $self->{type}{$type}{type}
# METADATA - Tables and Columns
# $self->{tables}
# $self->{table}{$table}{readonly}
# $self->{table}{$table}{columns}
# $self->{table}{$table}{column}{$column}
# $self->{table}{$table}{column}{$column}{name}
# $self->{table}{$table}{column}{$column}{type}
# $self->{table}{$table}{column}{$column}{notnull}
=head1 DESCRIPTION
The Repository::Sample class is a file to be copied and modified
in order to create a new implementation of a repository class.
The methods defined below are stubs that need to be filled out.
=cut
######################################################################
# INITIALIZATION
######################################################################
sub init {
my $self = shift;
}
######################################################################
# CONFIG METHODS
######################################################################
# take positional args and turn them into a %config structure
sub make_config {
my $self = shift;
my $conf = {
'repository' => {
'db' => {
},
},
};
$conf;
}
#sub read_config {
# my $self = shift;
# return ($self->SUPER::read_config());
#}
######################################################################
# CONNECTION METHODS
######################################################################
sub connect {
my $self = shift;
my $success = 1;
return $success;
}
sub disconnect {
my $self = shift;
1;
}
sub is_connected {
my $self = shift;
return 1;
}
sub error {
my ($self) = @_;
return $self->{error};
}
sub numrows {
my ($self) = @_;
return $self->{numrows};
}
######################################################################
# REPOSITORY METHODS (implements methods from Repository::Base)
######################################################################
# $colvalues = $rep->select_row ($table, \@cols, \@wherecols, \%wherevalues);
sub select_row {
my ($self, $table, $colref, $wherecolref, $wherevaluehashref) = @_;
my $colvalues = [];
$colvalues;
}
# $rows = $rep->select_rows($table, \@cols, \@wherecols, \%wherevalues, \@ordercols,
$startrow, $endrow);
sub select_rows {
my ($self, $table, $colref, $wherecolref, $wherevaluehashref, $ordercolref,
$startrow, $endrow) = @_;
my $rows = [];
$rows;
}
# $ok = $rep->insert_row ($table, \@cols, \@colvalues);
sub insert_row {
my ($self, $table, $colref, $colvalueref) = @_;
my $success = 1;
$success;
}
# $ok = $rep->insert_rows ($table, \@cols, \@rows);
sub insert_rows {
my ($self, $table, $cols, $rows) = @_;
my $success = 1;
$success;
}
# $ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
sub update_row {
my ($self, $table, $colref, $colvalueref, $keycolidxref) = @_;
my $success = 1;
$success;
}
# $ok = $rep->update_rows($table, \@cols, \@colvalues, \@wherecols, \%wherevalues);
sub update_rows {
my ($self, $table, $colref, $colvalueref, $wherecolref, $wherevaluehashref) = @_;
my $success = 1;
$success;
}
# $ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx, $update_first);
sub store_row {
my ($self, $table, $colref, $colvalueref, $keycolidxref, $update_first) = @_;
my $success = 1;
$success;
}
# $ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx, $update_first);
sub store_rows {
my ($self, $table, $colref, $rowref, $keycolidxref, $update_first) = @_;
my $success = 1;
$success;
}
# $ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
sub delete_row {
my $self = shift;
my $success = 1;
$success;
}
# $ok = $rep->delete_rows($table, \@wherecols, \%wherevalues);
sub delete_rows {
my $self = shift;
my $success = 1;
$success;
}
######################################################################
# METADATA REPOSITORY METHODS (implements methods from Repository::Base)
# (implement if desired. needed only if metadata already exists.)
######################################################################
#sub load_rep_metadata_init {
# my ($self) = @_;
#
# # repeat calls will get no farther than this.
# return if (defined $self->{tables});
#
# #########################################################
# # TABLE LIST
# #########################################################
#
# $self->{tables} = [ "table1", "table2", "table3" ];
#
# #########################################################
# # TYPE DATA
# #########################################################
#
# my ($type, @types);
# @types = ( "string", "number", "date", "time", "datetime" );
#
# foreach $type (@types) {
# $self->{type}{$type}{name} = $type;
# }
#
# $self->{types} = \@types;
#
#}
#sub load_table_metadata_init {
# my ($self, $table) = @_;
#
# return if ($table eq "");
# return if (defined $self->{table}{$table}{loaded});
#
# $self->{table}{$table}{name} = $table;
# $self->{table}{$table}{readonly} = 0;
# $self->{table}{$table}{loaded} = 1;
#
# #########################################################
# # COLUMN DATA
# #########################################################
# my ($col, @data_types, @columns, $coldata, $column);
#
# @columns = ("key1", "col1", "col2");
# @data_types = ("integer", "string", "date");
#
# $self->{table}{$table}{columns} = [ @columns ];
#
# for ($col = 0; $col <= $#columns; $col++) {
# $column = $columns[$col];
# $coldata = $self->{table}{$table}{column}{$column} = {};
# $coldata->{name} = $column;
# $coldata->{type} = $data_types[$col];
# $coldata->{notnull} = 0;
# }
#}
1;
