version 1.4, 2002/08/05 12:43:18
|
version 1.23, 2004/07/26 19:36:21
|
Line 31 package Apache::lonmysql;
|
Line 31 package Apache::lonmysql;
|
|
|
use strict; |
use strict; |
use DBI; |
use DBI; |
use Apache::lonnet(); |
use POSIX qw(strftime mktime); |
|
|
|
my $mysqluser; |
|
my $mysqlpassword; |
|
|
|
sub set_mysql_user_and_password { |
|
# If we are running under Apache and LONCAPA, use the LON-CAPA |
|
# user and password. Otherwise...? ? ? ? |
|
($mysqluser,$mysqlpassword) = @_; |
|
if (! defined($mysqluser) || ! defined($mysqlpassword)) { |
|
if (! eval 'require Apache::lonnet();') { |
|
$mysqluser = 'www'; |
|
$mysqlpassword = $Apache::lonnet::perlvar{'lonSqlAccess'}; |
|
} else { |
|
$mysqluser = ''; |
|
$mysqlpassword = ''; |
|
} |
|
} |
|
} |
|
|
###################################################################### |
###################################################################### |
###################################################################### |
###################################################################### |
Line 71 To create a table, you need a descriptio
|
Line 89 To create a table, you need a descriptio
|
for &create_table for a description of what is needed. |
for &create_table for a description of what is needed. |
|
|
$table_id = &create_table({ |
$table_id = &create_table({ |
columns => { |
id => 'tableid', # usually you will use the returned id |
id => { |
columns => ( |
type => 'INT', |
{ name => 'id', |
restrictions => 'NOT NULL', |
type => 'INT', |
primary_key => 'yes', |
restrictions => 'NOT NULL', |
auto_inc => 'yes' |
primary_key => 'yes', |
} |
auto_inc => 'yes' |
verbage => { type => 'TEXT' }, |
}, |
}, |
{ name => 'verbage', |
column_order => [qw/id verbage idx_verbage/], |
type => 'TEXT' }, |
fulltext => [qw/verbage/], |
), |
|
fulltext => [qw/verbage/], |
}); |
}); |
|
|
The above command will create a table with two columns, 'id' and 'verbage'. |
The above command will create a table with two columns, 'id' and 'verbage'. |
Line 230 an array reference which holds the order
|
Line 249 an array reference which holds the order
|
|
|
The statement handler for row inserts. |
The statement handler for row inserts. |
|
|
|
=item row_replace_sth |
|
|
|
The statement handler for row inserts. |
|
|
=back |
=back |
|
|
Col_order and row_insert_sth are kept internally by lonmysql and are not |
Col_order and row_insert_sth are kept internally by lonmysql and are not |
Line 323 connection is established.
|
Line 346 connection is established.
|
############################### |
############################### |
sub connect_to_db { |
sub connect_to_db { |
return 1 if ($dbh); |
return 1 if ($dbh); |
if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www", |
if (! defined($mysqluser) || ! defined($mysqlpassword)) { |
$Apache::lonnet::perlvar{'lonSqlAccess'}, |
&set_mysql_user_and_password(); |
|
} |
|
if (! ($dbh = DBI->connect("DBI:mysql:loncapa",$mysqluser,$mysqlpassword, |
{ RaiseError=>0,PrintError=>0}))) { |
{ RaiseError=>0,PrintError=>0}))) { |
$debugstring = "Unable to connect to loncapa database."; |
$debugstring = "Unable to connect to loncapa database."; |
if ($dbh->err) { |
if (! defined($dbh)) { |
|
$debugstring = "Unable to connect to loncapa database."; |
|
$errorstring = "dbh was undefined."; |
|
} elsif ($dbh->err) { |
$errorstring = "Connection error: ".$dbh->errstr; |
$errorstring = "Connection error: ".$dbh->errstr; |
} |
} |
return undef; |
return undef; |
Line 340 sub connect_to_db {
|
Line 368 sub connect_to_db {
|
|
|
=pod |
=pod |
|
|
|
=item &verify_sql_connection() |
|
|
|
Inputs: none. |
|
|
|
Returns: 0 (failure) or 1 (success) |
|
|
|
Checks to make sure the database can be connected to. It does not |
|
initialize anything in the lonmysql package. |
|
|
|
=cut |
|
|
|
############################### |
|
sub verify_sql_connection { |
|
if (! defined($mysqluser) || ! defined($mysqlpassword)) { |
|
&set_mysql_user_and_password(); |
|
} |
|
my $connection; |
|
if (! ($connection = DBI->connect("DBI:mysql:loncapa", |
|
$mysqluser,$mysqlpassword, |
|
{ RaiseError=>0,PrintError=>0}))) { |
|
return 0; |
|
} |
|
undef($connection); |
|
return 1; |
|
} |
|
|
|
############################### |
|
|
|
=pod |
|
|
=item &disconnect_from_db() |
=item &disconnect_from_db() |
|
|
Inputs: none. |
Inputs: none. |
Line 359 sub disconnect_from_db {
|
Line 417 sub disconnect_from_db {
|
if (exists($Tables{$_}->{'row_insert_sth'})) { |
if (exists($Tables{$_}->{'row_insert_sth'})) { |
delete($Tables{$_}->{'row_insert_sth'}); |
delete($Tables{$_}->{'row_insert_sth'}); |
} |
} |
|
if (exists($Tables{$_}->{'row_replace_sth'})) { |
|
delete($Tables{$_}->{'row_replace_sth'}); |
|
} |
} |
} |
$dbh->disconnect if ($dbh); |
$dbh->disconnect if ($dbh); |
$debugstring = "Disconnected from database."; |
$debugstring = "Disconnected from database."; |
Line 385 sub number_of_rows {
|
Line 446 sub number_of_rows {
|
return undef if (! defined(&update_table_info($table_id))); |
return undef if (! defined(&update_table_info($table_id))); |
return $Tables{&translate_id($table_id)}->{'Rows'}; |
return $Tables{&translate_id($table_id)}->{'Rows'}; |
} |
} |
|
############################### |
|
|
|
=pod |
|
|
|
=item &get_dbh() |
|
|
|
Input: nothing |
|
|
|
Returns: the database handler, or undef on error. |
|
|
|
This routine allows the programmer to gain access to the database handler. |
|
Be careful. |
|
|
|
=cut |
|
|
|
############################### |
|
sub get_dbh { |
|
return undef if (! defined(&connect_to_db())); |
|
return $dbh; |
|
} |
|
|
############################### |
############################### |
|
|
Line 424 sub get_debug {
|
Line 505 sub get_debug {
|
|
|
=pod |
=pod |
|
|
=item &update_table_info($table_id) |
=item &update_table_info() |
|
|
Inputs: table id |
Inputs: table id |
|
|
Line 481 sub update_table_info {
|
Line 562 sub update_table_info {
|
# Determine the column order |
# Determine the column order |
# |
# |
$db_command = "DESCRIBE $tablename"; |
$db_command = "DESCRIBE $tablename"; |
my $sth = $dbh->prepare($db_command); |
$sth = $dbh->prepare($db_command); |
$sth->execute(); |
$sth->execute(); |
if ($sth->err) { |
if ($sth->err) { |
$errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n". |
$errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n". |
Line 499 sub update_table_info {
|
Line 580 sub update_table_info {
|
$debugstring = "Retrieved table info for $tablename"; |
$debugstring = "Retrieved table info for $tablename"; |
return 1; |
return 1; |
} |
} |
|
|
############################### |
############################### |
|
|
=pod |
=pod |
|
|
=item &create_table |
=item &col_order() |
|
|
Inputs: |
Inputs: table id |
table description |
|
|
|
Input formats: |
Returns: array with column order |
|
|
table description = { |
=cut |
permanent => 'yes' or 'no', |
|
columns => { |
|
colA => { |
sub col_order { |
type => mysql type, |
my $table_id=shift; |
restrictions => 'NOT NULL' or empty, |
if (&update_table_info($table_id)) { |
primary_key => 'yes' or empty, |
return @{$Tables{$table_id}->{'Col_order'}}; |
auto_inc => 'yes' or empty, |
} else { |
} |
return (); |
colB => { .. } |
|
colZ => { .. } |
|
}, |
|
column_order => [ colA, colB, ..., colZ], |
|
} |
} |
|
} |
|
|
|
############################### |
|
|
|
=pod |
|
|
|
=item &create_table() |
|
|
|
Inputs: |
|
table description, see &build_table_creation_request |
Returns: |
Returns: |
undef on error, table id on success. |
undef on error, table id on success. |
|
|
Line 535 Returns:
|
Line 619 Returns:
|
sub create_table { |
sub create_table { |
return undef if (!defined(&connect_to_db($dbh))); |
return undef if (!defined(&connect_to_db($dbh))); |
my ($table_des)=@_; |
my ($table_des)=@_; |
|
my $request = &build_table_creation_request($table_des); |
|
# |
|
# Execute the request to create the table |
|
############################################# |
|
my $count = $dbh->do($request); |
|
if (! defined($count)) { |
|
$errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n". |
|
$dbh->errstr(); |
|
return undef; |
|
} |
|
# |
|
# Set up the internal bookkeeping |
|
############################################# |
|
my $table_id; |
|
if (exists($table_des->{'id'})) { |
|
$table_id = $table_des->{'id'}; |
|
} else { |
|
$table_id = &get_new_table_id(); |
|
} |
|
my $tablename = &translate_id($table_id); |
|
delete($Tables{$tablename}) if (exists($Tables{$tablename})); |
|
return undef if (! defined(&update_table_info($table_id))); |
|
$debugstring = "Created table $tablename at time ".time. |
|
" with request\n$request"; |
|
return $table_id; |
|
} |
|
|
|
############################### |
|
|
|
=pod |
|
|
|
=item build_table_creation_request |
|
|
|
Input: table description |
|
|
|
table description = { |
|
permanent => 'yes' or 'no', |
|
columns => [ |
|
{ name => 'colA', |
|
type => mysql type, |
|
restrictions => 'NOT NULL' or empty, |
|
primary_key => 'yes' or empty, |
|
auto_inc => 'yes' or empty, |
|
}, |
|
{ name => 'colB', |
|
... |
|
}, |
|
{ name => 'colC', |
|
... |
|
}, |
|
], |
|
'PRIMARY KEY' => (index_col_name,...), |
|
KEY => [{ name => 'idx_name', |
|
columns => (col1,col2,..),},], |
|
INDEX => [{ name => 'idx_name', |
|
columns => (col1,col2,..),},], |
|
UNIQUE => [{ index => 'yes', |
|
name => 'idx_name', |
|
columns => (col1,col2,..),},], |
|
FULLTEXT => [{ index => 'yes', |
|
name => 'idx_name', |
|
columns => (col1,col2,..),},], |
|
|
|
} |
|
|
|
Returns: scalar string containing mysql commands to create the table |
|
|
|
=cut |
|
|
|
############################### |
|
sub build_table_creation_request { |
|
my ($table_des)=@_; |
# |
# |
# Build request to create table |
# Build request to create table |
################################## |
################################## |
my @Columns; |
my @Columns; |
my $col_des; |
my $col_des; |
my $table_id = &get_new_table_id(); |
my $table_id; |
|
if (exists($table_des->{'id'})) { |
|
$table_id = $table_des->{'id'}; |
|
} else { |
|
$table_id = &get_new_table_id(); |
|
} |
my $tablename = &translate_id($table_id); |
my $tablename = &translate_id($table_id); |
my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." "; |
my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." "; |
foreach my $column (@{$table_des->{'column_order'}}) { |
foreach my $coldata (@{$table_des->{'columns'}}) { |
|
my $column = $coldata->{'name'}; |
|
next if (! defined($column)); |
$col_des = ''; |
$col_des = ''; |
my $coldata = $table_des->{'columns'}->{$column}; |
|
if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set' |
if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set' |
$col_des.=$column." ".$coldata->{'type'}."('". |
$col_des.=$column." ".$coldata->{'type'}."('". |
join("', '",@{$coldata->{'values'}})."')"; |
join("', '",@{$coldata->{'values'}})."')"; |
Line 570 sub create_table {
|
Line 732 sub create_table {
|
# skip blank items. |
# skip blank items. |
push (@Columns,$col_des) if ($col_des ne ''); |
push (@Columns,$col_des) if ($col_des ne ''); |
} |
} |
if (exists($table_des->{'fulltext'}) && (@{$table_des->{'fulltext'}})) { |
if (exists($table_des->{'PRIMARY KEY'})) { |
push (@Columns,'FULLTEXT ('.join(',',@{$table_des->{'fulltext'}}).')'); |
push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}}) |
|
.')'); |
|
} |
|
# |
|
foreach my $indextype ('KEY','INDEX') { |
|
next if (!exists($table_des->{$indextype})); |
|
foreach my $indexdescription (@{$table_des->{$indextype}}) { |
|
my $text = $indextype.' '; |
|
if (exists($indexdescription->{'name'})) { |
|
$text .=$indexdescription->{'name'}; |
|
} |
|
$text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')'; |
|
push (@Columns,$text); |
|
} |
} |
} |
|
# |
|
foreach my $indextype ('UNIQUE','FULLTEXT') { |
|
next if (! exists($table_des->{$indextype})); |
|
foreach my $indexdescription (@{$table_des->{$indextype}}) { |
|
my $text = $indextype.' '; |
|
if (exists($indexdescription->{'index'}) && |
|
$indexdescription->{'index'} eq 'yes') { |
|
$text .= 'INDEX '; |
|
} |
|
if (exists($indexdescription->{'name'})) { |
|
$text .=$indexdescription->{'name'}; |
|
} |
|
$text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')'; |
|
push (@Columns,$text); |
|
} |
|
} |
|
# |
$request .= "(".join(", ",@Columns).") "; |
$request .= "(".join(", ",@Columns).") "; |
unless($table_des->{'permanent'} eq 'yes') { |
unless($table_des->{'permanent'} eq 'yes') { |
$request.="COMMENT = 'temporary' "; |
$request.="COMMENT = 'temporary' "; |
} |
} |
$request .= "TYPE=MYISAM"; |
$request .= "TYPE=MYISAM"; |
# |
return $request; |
# Execute the request to create the table |
|
############################################# |
|
my $count = $dbh->do($request); |
|
if (! defined($count)) { |
|
$errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n"; |
|
return undef; |
|
} |
|
# |
|
# Set up the internal bookkeeping |
|
############################################# |
|
delete($Tables{$tablename}) if (exists($Tables{$tablename})); |
|
return undef if (! defined(&update_table_info($table_id))); |
|
$debugstring = "Created table $tablename at time ".time. |
|
" with request\n$request"; |
|
return $table_id; |
|
} |
} |
|
|
############################### |
############################### |
|
|
=pod |
=pod |
|
|
=item &get_new_table_id |
=item &get_new_table_id() |
|
|
Used internally to prevent table name collisions. |
Used internally to prevent table name collisions. |
|
|
Line 609 Used internally to prevent table name co
|
Line 786 Used internally to prevent table name co
|
############################### |
############################### |
sub get_new_table_id { |
sub get_new_table_id { |
my $newid = 0; |
my $newid = 0; |
my $name_regex = '^'.$ENV{'user.name'}.'_'.$ENV{'user.domain'}."_(\d+)\$"; |
|
my @tables = &tables_in_db(); |
my @tables = &tables_in_db(); |
foreach (@tables) { |
foreach (@tables) { |
if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) { |
if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) { |
Line 623 sub get_new_table_id {
|
Line 799 sub get_new_table_id {
|
|
|
=pod |
=pod |
|
|
=item &get_rows |
=item &get_rows() |
|
|
Inputs: $table_id,$condition |
Inputs: $table_id,$condition |
|
|
Line 646 sub get_rows {
|
Line 822 sub get_rows {
|
return undef; |
return undef; |
} |
} |
my $tablename = &translate_id($table_id); |
my $tablename = &translate_id($table_id); |
my $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition; |
my $request; |
|
if (defined($condition) && $condition ne '') { |
|
$request = 'SELECT * FROM '.$tablename.' WHERE '.$condition; |
|
} else { |
|
$request = 'SELECT * FROM '.$tablename; |
|
$condition = 'no condition'; |
|
} |
my $sth=$dbh->prepare($request); |
my $sth=$dbh->prepare($request); |
$sth->execute(); |
$sth->execute(); |
if ($sth->err) { |
if ($sth->err) { |
Line 657 sub get_rows {
|
Line 839 sub get_rows {
|
} |
} |
$debugstring = "Got rows matching $condition"; |
$debugstring = "Got rows matching $condition"; |
my @Results = @{$sth->fetchall_arrayref}; |
my @Results = @{$sth->fetchall_arrayref}; |
foreach my $row (@Results) { |
|
for(my $i=0;$i<@$row;$i++) { |
|
$row->[$i]=&Apache::lonnet::unescape($row->[$i]); |
|
} |
|
} |
|
return @Results; |
return @Results; |
} |
} |
|
|
Line 669 sub get_rows {
|
Line 846 sub get_rows {
|
|
|
=pod |
=pod |
|
|
=item &store_row |
=item &store_row() |
|
|
Inputs: table id, row data |
Inputs: table id, row data |
|
|
Line 711 sub store_row {
|
Line 888 sub store_row {
|
@Parameters = @$rowdata; |
@Parameters = @$rowdata; |
} elsif (ref($rowdata) eq 'HASH') { |
} elsif (ref($rowdata) eq 'HASH') { |
foreach (@{$Tables{$tablename}->{'Col_order'}}) { |
foreach (@{$Tables{$tablename}->{'Col_order'}}) { |
push(@Parameters,&Apache::lonnet::escape($rowdata->{$_})); |
push(@Parameters,$rowdata->{$_}); |
} |
} |
} |
} |
$sth->execute(@Parameters); |
$sth->execute(@Parameters); |
Line 724 sub store_row {
|
Line 901 sub store_row {
|
return 1; |
return 1; |
} |
} |
|
|
|
|
|
############################### |
|
|
|
=pod |
|
|
|
=item &bulk_store_rows() |
|
|
|
Inputs: table id, [columns],[[row data1].[row data2],...] |
|
|
|
returns undef on error, 1 on success. |
|
|
|
=cut |
|
|
|
############################### |
|
sub bulk_store_rows { |
|
my ($table_id,$columns,$rows) = @_; |
|
# |
|
return undef if (! defined(&connect_to_db())); |
|
my $dbh = &get_dbh(); |
|
return undef if (! defined($dbh)); |
|
my $table_status = &check_table($table_id); |
|
return undef if (! defined($table_status)); |
|
if (! $table_status) { |
|
$errorstring = "table $table_id does not exist."; |
|
return undef; |
|
} |
|
# |
|
my $tablename = &translate_id($table_id); |
|
# |
|
my $request = 'INSERT IGNORE INTO '.$tablename.' '; |
|
if (defined($columns) && ref($columns) eq 'ARRAY') { |
|
$request .= join(',',@$columns).' '; |
|
} |
|
if (! defined($rows) || ref($rows) ne 'ARRAY') { |
|
$errorstring = "no input rows given."; |
|
return undef; |
|
} |
|
$request .= 'VALUES '; |
|
foreach my $row (@$rows) { |
|
# avoid doing row stuff here... |
|
$request .= '('.join(',',@$row).'),'; |
|
} |
|
$request =~ s/,$//; |
|
$dbh->do($request); |
|
if ($dbh->err) { |
|
$errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr(); |
|
return undef; |
|
} |
|
return 1; |
|
} |
|
|
|
|
|
############################### |
|
|
|
=pod |
|
|
|
=item &replace_row() |
|
|
|
Inputs: table id, row data |
|
|
|
returns undef on error, 1 on success. |
|
|
|
Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'. |
|
|
|
=cut |
|
|
|
############################### |
|
sub replace_row { |
|
my ($table_id,$rowdata) = @_; |
|
# |
|
return undef if (! defined(&connect_to_db())); |
|
my $table_status = &check_table($table_id); |
|
return undef if (! defined($table_status)); |
|
if (! $table_status) { |
|
$errorstring = "table $table_id does not exist."; |
|
return undef; |
|
} |
|
# |
|
my $tablename = &translate_id($table_id); |
|
# |
|
my $sth; |
|
if (exists($Tables{$tablename}->{'row_replace_sth'})) { |
|
$sth = $Tables{$tablename}->{'row_replace_sth'}; |
|
} else { |
|
# Build the insert statement handler |
|
return undef if (! defined(&update_table_info($table_id))); |
|
my $replace_request = 'REPLACE INTO '.$tablename.' VALUES('; |
|
foreach (@{$Tables{$tablename}->{'Col_order'}}) { |
|
$replace_request.="?,"; |
|
} |
|
chop $replace_request; |
|
$replace_request.=")"; |
|
$sth=$dbh->prepare($replace_request); |
|
$Tables{$tablename}->{'row_replace_sth'}=$sth; |
|
} |
|
my @Parameters; |
|
if (ref($rowdata) eq 'ARRAY') { |
|
@Parameters = @$rowdata; |
|
} elsif (ref($rowdata) eq 'HASH') { |
|
foreach (@{$Tables{$tablename}->{'Col_order'}}) { |
|
push(@Parameters,$rowdata->{$_}); |
|
} |
|
} |
|
$sth->execute(@Parameters); |
|
if ($sth->err) { |
|
$errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n". |
|
$sth->errstr; |
|
return undef; |
|
} |
|
$debugstring = "Stored row."; |
|
return 1; |
|
} |
|
|
########################################### |
########################################### |
|
|
=pod |
=pod |
|
|
=item tables_in_db |
=item &tables_in_db() |
|
|
Returns a list containing the names of all the tables in the database. |
Returns a list containing the names of all the tables in the database. |
Returns undef on error. |
Returns undef on error. |
Line 738 Returns undef on error.
|
Line 1028 Returns undef on error.
|
########################################### |
########################################### |
sub tables_in_db { |
sub tables_in_db { |
return undef if (!defined(&connect_to_db())); |
return undef if (!defined(&connect_to_db())); |
my $sth=$dbh->prepare('SHOW TABLES;'); |
my $sth=$dbh->prepare('SHOW TABLES'); |
$sth->execute(); |
$sth->execute(); |
if ($sth->err) { |
$sth->execute(); |
$errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'. |
my $aref = $sth->fetchall_arrayref; |
|
if ($sth->err()) { |
|
$errorstring = |
|
"$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'. |
"\nRESULTING ERROR:\n".$sth->errstr; |
"\nRESULTING ERROR:\n".$sth->errstr; |
return undef; |
return undef; |
} |
} |
my $aref = $sth->fetchall_arrayref; |
my @table_list; |
my @table_list=(); |
|
foreach (@$aref) { |
foreach (@$aref) { |
push @table_list,$_->[0]; |
push(@table_list,$_->[0]); |
} |
} |
$debugstring = "Got list of tables in DB: @table_list"; |
$debugstring = "Got list of tables in DB: ".join(',',@table_list); |
return @table_list; |
return(@table_list); |
} |
} |
|
|
########################################### |
########################################### |
|
|
=pod |
=pod |
|
|
=item &translate_id |
=item &translate_id() |
|
|
Used internally to translate a numeric table id into a MySQL table name. |
Used internally to translate a numeric table id into a MySQL table name. |
If the input $id contains non-numeric characters it is assumed to have |
If the input $id contains non-numeric characters it is assumed to have |
Line 781 sub translate_id {
|
Line 1073 sub translate_id {
|
|
|
=pod |
=pod |
|
|
=item &check_table($id) |
=item &check_table() |
|
|
|
Input: table id |
|
|
Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or |
Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or |
undef (error). |
undef (error). |
Line 797 sub check_table {
|
Line 1091 sub check_table {
|
my @Table_list = &tables_in_db(); |
my @Table_list = &tables_in_db(); |
my $result = 0; |
my $result = 0; |
foreach (@Table_list) { |
foreach (@Table_list) { |
if (/^$table_id$/) { |
if ($_ eq $table_id) { |
$result = 1; |
$result = 1; |
last; |
last; |
} |
} |
Line 808 sub check_table {
|
Line 1102 sub check_table {
|
return $result; |
return $result; |
} |
} |
|
|
|
########################################### |
|
|
|
=pod |
|
|
|
=item &remove_from_table() |
|
|
|
Input: $table_id, $column, $value |
|
|
|
Returns: the number of rows deleted. undef on error. |
|
|
|
Executes a "delete from $tableid where $column like binary '$value'". |
|
|
|
=cut |
|
|
|
########################################### |
|
sub remove_from_table { |
|
my ($table_id,$column,$value) = @_; |
|
return undef if (!defined(&connect_to_db())); |
|
# |
|
$table_id = &translate_id($table_id); |
|
my $command = 'DELETE FROM '.$table_id.' WHERE '.$column. |
|
" LIKE BINARY ".$dbh->quote($value); |
|
my $sth = $dbh->prepare($command); |
|
unless ($sth->execute()) { |
|
$errorstring = "ERROR on execution of ".$command."\n".$sth->errstr; |
|
return undef; |
|
} |
|
$debugstring = $command; |
|
my $rows = $sth->rows; |
|
return $rows; |
|
} |
|
|
|
########################################### |
|
|
|
=pod |
|
|
|
=item drop_table($table_id) |
|
|
|
Issues a 'drop table if exists' command |
|
|
|
=cut |
|
|
|
########################################### |
|
|
|
sub drop_table { |
|
my ($table_id) = @_; |
|
return undef if (!defined(&connect_to_db())); |
|
# |
|
$table_id = &translate_id($table_id); |
|
my $command = 'DROP TABLE IF EXISTS '.$table_id; |
|
my $sth = $dbh->prepare($command); |
|
$sth->execute(); |
|
if ($sth->err) { |
|
$errorstring = "ERROR on execution of ".$command."\n".$sth->errstr; |
|
return undef; |
|
} |
|
$debugstring = $command; |
|
delete($Tables{$table_id}); # remove any knowledge of the table |
|
return 1; # if we got here there was no error, so return a 'true' value |
|
} |
|
|
|
|
|
|
|
|
|
# ---------------------------- convert 'time' format into a datetime sql format |
|
sub sqltime { |
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
|
localtime(&unsqltime($_[0])); |
|
$mon++; $year+=1900; |
|
return "$year-$mon-$mday $hour:$min:$sec"; |
|
} |
|
|
|
sub maketime { |
|
my %th=@_; |
|
return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'}, |
|
$th{'day'},$th{'month'}-1, |
|
$th{'year'}-1900,0,0,$th{'dlsav'})); |
|
} |
|
|
|
|
|
######################################### |
|
# |
|
# Retro-fixing of un-backward-compatible time format |
|
|
|
sub unsqltime { |
|
my $timestamp=shift; |
|
if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) { |
|
$timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3, |
|
'hours'=>$4,'minutes'=>$5,'seconds'=>$6); |
|
} |
|
return $timestamp; |
|
} |
|
|
|
|
1; |
1; |
|
|
__END__; |
__END__; |
|
|
|
=pod |
|
|
|
=back |
|
|
|
=cut |