version 1.4, 2002/08/05 12:43:18
|
version 1.8, 2003/03/10 21:22:36
|
Line 327 sub connect_to_db {
|
Line 327 sub connect_to_db {
|
$Apache::lonnet::perlvar{'lonSqlAccess'}, |
$Apache::lonnet::perlvar{'lonSqlAccess'}, |
{ 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 424 sub get_debug {
|
Line 427 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 484 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 504 sub update_table_info {
|
Line 507 sub update_table_info {
|
|
|
=pod |
=pod |
|
|
=item &create_table |
=item &create_table() |
|
|
Inputs: |
Inputs: |
table description |
table description |
Line 513 Input formats:
|
Line 516 Input formats:
|
|
|
table description = { |
table description = { |
permanent => 'yes' or 'no', |
permanent => 'yes' or 'no', |
columns => { |
columns => [ |
colA => { |
{ name => 'colA', |
type => mysql type, |
type => mysql type, |
restrictions => 'NOT NULL' or empty, |
restrictions => 'NOT NULL' or empty, |
primary_key => 'yes' or empty, |
primary_key => 'yes' or empty, |
auto_inc => 'yes' or empty, |
auto_inc => 'yes' or empty, |
} |
}, |
colB => { .. } |
{ name => 'colB', |
colZ => { .. } |
... |
}, |
}, |
column_order => [ colA, colB, ..., colZ], |
{ name => 'colC', |
|
... |
|
}, |
|
], |
} |
} |
|
|
Returns: |
Returns: |
Line 543 sub create_table {
|
Line 549 sub create_table {
|
my $table_id = &get_new_table_id(); |
my $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 600 sub create_table {
|
Line 607 sub create_table {
|
|
|
=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 616 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 629 sub get_new_table_id {
|
|
|
=pod |
=pod |
|
|
=item &get_rows |
=item &get_rows() |
|
|
Inputs: $table_id,$condition |
Inputs: $table_id,$condition |
|
|
Line 657 sub get_rows {
|
Line 663 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 670 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 712 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 728 sub store_row {
|
Line 729 sub store_row {
|
|
|
=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 739 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) { |
if ($sth->err) { |
$errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'. |
$errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'. |
Line 758 sub tables_in_db {
|
Line 759 sub tables_in_db {
|
|
|
=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 782 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 808 sub check_table {
|
Line 811 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 '.$dbh->quote($column). |
|
" LIKE BINARY ".$dbh->quote($value); |
|
my $sth = $dbh->prepare($command); |
|
$sth->execute(); |
|
if ($sth->err) { |
|
$errorstring = "ERROR on execution of ".$command."\n".$sth->errstr; |
|
return undef; |
|
} |
|
my $rows = $sth->rows; |
|
return $rows; |
|
} |
|
|
|
|
1; |
1; |
|
|
__END__; |
__END__; |
|
|
|
=pod |
|
|
|
=back |
|
|
|
=cut |