-*- perl -*- An example for working with the new DBI attributes and HTML::EP: Editing a generic SQL table. The general idea is as follows: We read out the complete table contents and store the old values in a parameter array. Then we create an editable line for any row. Once this is done we do an UPDATE table SET WHERE The HTML::EP system helps us greatly in reading input. Author: Jochen Wiedmann Am Eisteich 9 72555 Metzingen Germany Phone: +49 7123 14887 Email: joe@ispsoft.de { my $self = $_; my $cgi = $self->{'cgi'}; my $accept_nulls = $self->{'accept_nulls'} = $cgi->param("accept_nulls"); my $show_delete = $cgi->param('show_delete') ? 1 : 0; if ($cgi->param('source')) { local $/ = undef; my $contents; my $fh = Symbol::gensym(); if (!open($fh, "<" . $ENV{'PATH_TRANSLATED'}) || !defined($contents = <$fh>) && !close($fh)) { die "Error while reading " . $ENV{'PATH_TRANSLATED'} . "$!"; } $self->print("content-type: text/plain\n\n"); $self->print($contents); $self->Stop(); $self->_ep_exit({}); } my $errors = ''; my $table = $cgi->param('table'); my $dbh; my $debug = $self->{'debug'}; if (my $dsn = $cgi->param('dsn')) { if ($debug) { $self->print("DSN = $dsn\n"); } $self->_ep_database({'dsn' => $dsn, 'user' => $cgi->param("user"), 'password' => $cgi->param("pass")}); $dbh = $self->{'dbh'}; $dbh->{'RaiseError'} = $dbh->{'PrintError'} = $dbh->{'Warn'} = 0; print "dbh = $dbh\n"; } $self->{'modifiedRows'} = 0; $self->{'deletedRows'} = 0; $self->{'insertedRows'} = 0; my $startat = $cgi->param("startat") || 0; $cgi->param("startat", $startat); my $limit = $cgi->param("limit"); if (!defined($limit)) { $limit = 20; } elsif (!$limit) { $limit = 0; } $cgi->param("limit", $limit); if ($dbh && defined($table)) { if ($cgi->param('edit')) { my (@set, $type); my $num_fields = $cgi->param("num_of_fields"); my($names, $types); for (my $i = 0; $i < $num_fields; $i++) { push(@$names, $cgi->param("names_$i")); push(@$types, $cgi->param("types_$i")); } # Look at the values to guess whether they want to insert # a record. my $insert_me; for (my $i = 0; $i < $num_fields; $i++) { my $val = $cgi->param("insert_$i"); if (defined($val) && $val ne '') { $insert_me = 1; } push(@set, $dbh->quote($val, $types->[$i])); } if ((!$show_delete && $insert_me) || ($show_delete && $cgi->param("insert_me"))) { my $query = sprintf("INSERT INTO $table (%s) VALUES (%s)", join(", ", @$names), join(", ", @set)); if ($self->{'debug'}) { $self->print("INSERT query: $query"); } if (!$dbh->do($query)) { $errors .= "Error while inserting row: " . $dbh->errstr() . ".\n"; $errors .= "Query was: $query\n"; } else { ++$self->{'insertedRows'}; } } for (my $i = 0; $cgi->param("rows_${i}_0"); $i++) { my(@set, @where, $modified); for (my $j = 0; $j < $num_fields; $j++) { my $old = $cgi->param("oldrows_${i}_$j"); if ($accept_nulls && $old && $old eq 'NULL') { $old = undef; } my $new = $cgi->param("rows_${i}_$j"); if ($accept_nulls && $new && $new eq 'NULL') { $new = undef; } if ((!defined($old) && defined($new)) || (defined($old) && (!defined($new) || (defined($new) && $old ne $new)))) { $modified = 1; } if ($debug) { $self->print("Quoting $old, type $types->[$j], result " . $dbh->quote($old, $types->[$j]) . "\n"); } push(@where, $names->[$j] . " = " . $dbh->quote($old, $types->[$j])); if ($debug) { $self->print("Quoting $new, type $types->[$j], result " . $dbh->quote($new, $types->[$j]) . "\n"); } push(@set, $names->[$j] . " = " . $dbh->quote($new, $types->[$j])); } my($query, $delete); if ($delete = $cgi->param("rows_${i}_delete")) { $query = "DELETE FROM $table WHERE "; } elsif ($modified) { $query = "UPDATE $table SET " . join(", ", @set) . " WHERE "; } if ($query) { $query .= join(" AND ", @where); if ($debug) { $self->print("UPDATE query: $query\n"); } if (!$dbh->do($query)) { $errors .= "Error while modifiying row $i: " . $dbh->errstr() . ".\n"; $errors .= "Query was: $query\n"; } else { if ($delete) { $self->{'deletedRows'}++; } else { $self->{'modifiedRows'}++; } } } } } my $query = "SELECT * FROM $table"; if (defined(my $where = $cgi->param("where"))) { if ($where !~ /^\s*$/ && $where !~ /^\s+order\s+by/i) { $where = "WHERE $where"; } $query .= " $where"; } $self->{'query'} = $query; $self->{'next'} = $limit ? ($startat + $limit) : 0; if ($self->{'debug'}) { $self->print("Setting next to " . $self->{'next'} . "\n"); } $self->{'prev'} = $startat ? ($startat - $limit) : 0; if ($dbh->{'ImplementorClass'} eq "DBD::mysql::db" && ($startat || $limit)) { $query .= " LIMIT $startat"; $startat = 0; if ($limit) { $query .= ", " . ($limit+1); } } if ($debug) { $self->print("SELECT query is: $query\n"); } my $sth = $dbh->prepare($query); if (!$sth) { $errors .= "Error while preparing SELECT: " . $dbh->errstr() . "\n"; $errors .= "Query is $query\n"; } else { if (!$sth->execute()) { $errors .= "Error while executing SELECT: " . $sth->errstr() . "\n"; $errors .= "Query is $query\n"; } else { my($ref, $done, @rows); $self->{'names'} = $sth->{'NAME'}; $self->{'types'} = $sth->{'TYPE'}; $self->{'num_of_fields'} = $sth->{'NUM_OF_FIELDS'}; my @sizes; for (my $i = 0; $i < $self->{'num_of_fields'}; $i++) { push(@sizes, 1); } if ($debug) { $self->print("Query returned " . $sth->rows() . " rows.\n"); } while (!$done && $startat--) { $ref = $sth->fetchrow_arrayref(); if ($self->{'debug'}) { $self->print("Skipping: " . ($ref || "undef") . "\n"); } if (!$ref) { $done = 1; last; } } if (!$limit) { $limit = -1; } while (!$done && $limit--) { $ref = $sth->fetchrow_arrayref(); if ($self->{'debug'}) { $self->print("Fetching: " . ($ref || "undef") . "\n"); } if (!$ref) { $done = 1; last; } else { push(@rows, [@$ref]); for (my $i = 0; $i < $self->{'num_of_fields'}; $i++) { my $len = length($ref->[$i]); if ($len > 20) { $len = 20 } if ($len > $sizes[$i]) { $sizes[$i] = $len; } } } } if ($done || !($ref = $sth->fetchrow_arrayref())) { if ($self->{'debug'}) { $self->print("Setting next to 0\n"); } $self->{'next'} = 0; } $self->{'rows'} = \@rows; my $template = ""; my $itemplate = ""; if ($show_delete) { $template .= qq{\n}; $itemplate .= qq{}; } for (my $i = 0; $i < @{$self->{'names'}}; $i++) { $template .= qq{\n} . qq{\n}; $itemplate .= qq{}; } $self->{'itemplate'} = $itemplate . ""; $self->{'template'} = $template . ""; } } } else { if (!defined($cgi->param("dsn"))) { $cgi->param("dsn", "DBI:CSV:"); } if (!defined($table)) { $cgi->param("table", "addresses"); } } $self->{'errors'} = $errors; package HTML::EP; sub _format_NULL { my $self = shift; my $str = shift; if (!defined($str)) { $str = $self->{'accept_nulls'} ? "NULL" : ""; } else { $str = $self->escapeHTML($str); } $str; }; ''; } <ep-language en="The Table Editor" de="Der Tabelleneditor">

Your last query returned the following errors: Ihre letzte Query ergab die folgenden Fehlermeldungen:
$errors$
  

Your last query was executed and $modifiedRows$ row(s) have been updated, $deletedRows$ have been deleted and $insertedRows$ have been inserted. Ihre letzte Query wurde ausgeführt und $modifiedRows$ Reihe(n) wurde(n) geändert, $deletedRows$ Reihe(n) wurde(n) gelöscht und $insertedRows$ Reihe(n) wurde(n) eingefügt.

Intro

This is a nice application for the new methods and attributes of DBI 1.xy: If your driver supports $dbh->quote($str, $val), you can use this form for editing your database tables.

Start with filling the form fields below and then hit the "Show me"-Button.

Dies ist eine nette, kleine Anwendung der neuen Methoden und Attribute von DBI 1.xy: Wenn Ihr Datenbanktreiber die Methode $dbh->quote($str, $val) unterstützt, dann können Sie dieses Formular für die Bearbeitung Ihrer Tabellen benützen.

Füllen Sie einfach mal die unten stehenden Felder aus und dann betätigen Sie den "Anzeigen"-Knopf.

DBI DSN: Login: :
: :
: :
Treat "NULL" string
as NULL value:
Wort "NULL"
gilt als NULL-Wert:
Create "DELETE" boxes Erzeuge "Löschen"-Felder

$@itemplate$
$n$
$n$