274 lines
6.9 KiB
Plaintext
274 lines
6.9 KiB
Plaintext
|
#!/usr/local/bin/perl -I../..
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
dbforms.cgi - Forms interface to DbFramework databases
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
http://foo/cgi_bin/dbforms.cgi?db=foo&db_dsn=mysql:database=foo&c_dsn=mysql:database=dbframework_catalog
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
B<dbforms.cgi> presents a simple HTML forms interface to any database
|
||
|
|
configured to work with B<DbFramework>. The database B<must> have the
|
||
|
|
appropriate catalog entries in the catalog database before it will
|
||
|
|
work with this script (see L<DbFramework::Catalog/"The Catalog">.)
|
||
|
|
|
||
|
|
=head2 Query string arguments
|
||
|
|
|
||
|
|
The following arguments are supported in the query string. Mandatory
|
||
|
|
arguments are shown in B<bold>.
|
||
|
|
|
||
|
|
=over 4
|
||
|
|
|
||
|
|
=item B<db>
|
||
|
|
|
||
|
|
The name of the database.
|
||
|
|
|
||
|
|
=item B<db_dsn>
|
||
|
|
|
||
|
|
The portion of the DBI DSN after 'DBI:' to be used to connect to the
|
||
|
|
database e.g. 'mysql:database=foo'.
|
||
|
|
|
||
|
|
=item B<c_dsn>
|
||
|
|
|
||
|
|
The portion of the DBI DSN after 'DBI:' to be used to connect to the
|
||
|
|
catalog database e.g. 'mysql:database=dbframework_catalog'.
|
||
|
|
|
||
|
|
=item B<host>
|
||
|
|
|
||
|
|
The host on which the database is located (default = 'localhost'.)
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=head1 SEE ALSO
|
||
|
|
|
||
|
|
L<DbFramework::Catalog>.
|
||
|
|
|
||
|
|
=head1 AUTHOR
|
||
|
|
|
||
|
|
Paul Sharpe E<lt>paul@miraclefish.comE<gt>
|
||
|
|
|
||
|
|
=head1 COPYRIGHT
|
||
|
|
|
||
|
|
Copyright (c) 1999 Paul Sharpe. England. All rights reserved. This
|
||
|
|
program is free software; you can redistribute it and/or modify it
|
||
|
|
under the same terms as Perl itself.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
use lib '../..';
|
||
|
|
use DbFramework::Util;
|
||
|
|
use DbFramework::Persistent;
|
||
|
|
use DbFramework::DataModel;
|
||
|
|
use DbFramework::Template;
|
||
|
|
use DbFramework::Catalog;
|
||
|
|
use CGI qw/:standard/;
|
||
|
|
use URI::Escape;
|
||
|
|
|
||
|
|
$cgi = new CGI;
|
||
|
|
$db = $cgi->param('db') || die "No database specified";
|
||
|
|
$db_dsn = $cgi->param('db_dsn') || die "No database DBI string specified";
|
||
|
|
$c_dsn = $cgi->param('c_dsn') || die "No catalog DBI string specified";
|
||
|
|
$host = $cgi->param('host') || undef;
|
||
|
|
$form = $cgi->param('form') || 'input';
|
||
|
|
$action = $cgi->param('action') || 'select';
|
||
|
|
$dsn = "DBI:$db_dsn";
|
||
|
|
$dsn = "$dsn;host=$host" if $host;
|
||
|
|
$dm = new DbFramework::DataModel($db,$dsn);
|
||
|
|
$dm->dbh->{PrintError} = 0; # ePerl chokes on STDERR
|
||
|
|
$dbh = $dm->dbh; $dbh->{PrintError} = 0;
|
||
|
|
$dm->init_db_metadata("DBI:$c_dsn");
|
||
|
|
|
||
|
|
@tables = @{$dm->collects_table_l};
|
||
|
|
$class = $table = $cgi->param('table') || $tables[0]->name;
|
||
|
|
$template = new DbFramework::Template(undef,\@tables);
|
||
|
|
$template->default($table);
|
||
|
|
|
||
|
|
$code = DbFramework::Persistent->make_class($class);
|
||
|
|
eval $code;
|
||
|
|
|
||
|
|
package main;
|
||
|
|
($t) = $dm->collects_table_h_byname($table);
|
||
|
|
$catalog = new DbFramework::Catalog("DBI:$c_dsn");
|
||
|
|
$thing = new $class($t,$dbh,$catalog);
|
||
|
|
cgi_set_attributes($thing);
|
||
|
|
|
||
|
|
# unless ( $form eq 'input' ) {
|
||
|
|
# $thing->init_pk;
|
||
|
|
# $thing->table->read_form($form);
|
||
|
|
# }
|
||
|
|
|
||
|
|
# unpack composite column name parameters
|
||
|
|
for my $param ( $cgi->param ) {
|
||
|
|
if ( $param =~ /,/ ) {
|
||
|
|
my @columns = split /,/,$param;
|
||
|
|
my @values = split /,/,$cgi->param($param);
|
||
|
|
for ( my $i = 0; $i <= $#columns; $i++ ) {
|
||
|
|
$cgi->param($columns[$i],$values[$i]);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cgi_set_attributes {
|
||
|
|
my $thing = shift;
|
||
|
|
my %attributes;
|
||
|
|
for ( $thing->table->attribute_names ) {
|
||
|
|
$attributes{$_} = $cgi->param($_) ne '' ? $cgi->param($_) : undef;
|
||
|
|
}
|
||
|
|
$thing->attributes_h([%attributes]);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub error {
|
||
|
|
my $message = shift;
|
||
|
|
print "<font color=#ff0000><strong>ERROR!</strong><p>$message</font>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
print $cgi->header;
|
||
|
|
print <<EOF;
|
||
|
|
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||
|
|
<html>
|
||
|
|
<head>
|
||
|
|
<title>$db: $table</title>
|
||
|
|
</head>
|
||
|
|
|
||
|
|
<body>
|
||
|
|
<table border=1>
|
||
|
|
<tr>
|
||
|
|
<td valign=top>
|
||
|
|
<table>
|
||
|
|
<tr>
|
||
|
|
<td valign=top>
|
||
|
|
<h1>db: $db</h1>
|
||
|
|
</td>
|
||
|
|
</tr>
|
||
|
|
<tr>
|
||
|
|
<td>
|
||
|
|
<h4>Tables</h4>
|
||
|
|
<ul>
|
||
|
|
EOF
|
||
|
|
|
||
|
|
for ( @{$dm->collects_table_l} ) {
|
||
|
|
my $table = $_->name;
|
||
|
|
print "<li><a href=",$cgi->url,"?db=$db&driver=$driver&db_dsn=$db_dsn&c_dsn=$c_dsn&host=$host&table=$table>$table</a>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
print <<EOF;
|
||
|
|
</ul>
|
||
|
|
</td>
|
||
|
|
</tr>
|
||
|
|
</table>
|
||
|
|
</td>
|
||
|
|
<td valign=top>
|
||
|
|
<table border=0>
|
||
|
|
<tr>
|
||
|
|
<td colspan=2 align=middle>
|
||
|
|
<h1>$table</h1>
|
||
|
|
</td>
|
||
|
|
</tr>
|
||
|
|
<tr>
|
||
|
|
<td>
|
||
|
|
EOF
|
||
|
|
|
||
|
|
if ( $form eq 'input' ) {
|
||
|
|
my $self_url = $cgi->self_url;
|
||
|
|
print "<form method=post action=$self_url>\n";
|
||
|
|
for ( qw(host driver db db_dsn c_dsn table form) ) {
|
||
|
|
print "<input type=hidden name=$_ value=",$$_,">\n";
|
||
|
|
}
|
||
|
|
my $values_hashref = $thing->table_qualified_attribute_hashref;
|
||
|
|
print $thing->table->as_html_heading,"\n<tr>\n";
|
||
|
|
print $template->fill($values_hashref);
|
||
|
|
for ( 'select','insert' ) {
|
||
|
|
print "<td><input type=radio name=action value=$_";
|
||
|
|
print ' checked' if /^$action$/;
|
||
|
|
print "> $_</td>\n";
|
||
|
|
}
|
||
|
|
print <<EOF;
|
||
|
|
<td><input type=submit value="Submit"></td>
|
||
|
|
</form>
|
||
|
|
EOF
|
||
|
|
}
|
||
|
|
print <<EOF;
|
||
|
|
</tr>
|
||
|
|
</td>
|
||
|
|
</tr>
|
||
|
|
EOF
|
||
|
|
|
||
|
|
my $action = $cgi->param('action') || '';
|
||
|
|
|
||
|
|
SWITCH: {
|
||
|
|
$action eq 'select' &&
|
||
|
|
do {
|
||
|
|
my @names = $thing->table->attribute_names;
|
||
|
|
my $conditions;
|
||
|
|
for ( @names ) {
|
||
|
|
if ( $cgi->param($_) ) {
|
||
|
|
$conditions .= " AND " if $conditions;
|
||
|
|
if ( $thing->table->in_foreign_key($thing->table->contains_h_byname($_)) ) {
|
||
|
|
$conditions .= "$_ = " . $cgi->param($_);
|
||
|
|
} else {
|
||
|
|
$conditions .= "$_ " . $cgi->param($_);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
my @things = eval { $thing->select($conditions) };
|
||
|
|
if ( $@ ) {
|
||
|
|
error($@);
|
||
|
|
} else {
|
||
|
|
if ( @things ) {
|
||
|
|
for my $thing ( @things ) {
|
||
|
|
my %attributes = %{$thing->attributes_h};
|
||
|
|
my $url = $cgi->url . "?db=$db&db_dsn=$db_dsn&c_dsn=$c_dsn&host=$host&table=$table&form=$form&action=update";
|
||
|
|
for ( keys(%attributes) ) {
|
||
|
|
$url .= uri_escape("&$_=$attributes{$_}");
|
||
|
|
}
|
||
|
|
# fill template
|
||
|
|
my $values_hashref = $thing->attributes_h;
|
||
|
|
print "<form method=post action=",$cgi->self_url,">\n";
|
||
|
|
for ( qw(host driver db db_dsn c_dsn table form) ) {
|
||
|
|
print "<input type=hidden name=$_ value=",$$_,">\n";
|
||
|
|
}
|
||
|
|
print $thing->table->is_identified_by->as_hidden_html($values_hashref);
|
||
|
|
print "<TR>",$template->fill($thing->table_qualified_attribute_hashref),"\n";
|
||
|
|
print "<td><input type=radio name=action value=update",($action eq 'select') ? ' checked>' : '',"update</td>\n";
|
||
|
|
print "<td><input type=radio name=action value=delete>",($action eq 'delete') ? ' checked' : '',"delete</td>\n";
|
||
|
|
print "<td><input type=submit value='Submit'></td></tr></form>\n";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
print "<TR><TD><strong>No rows matched your query</strong></TD></TR>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
last SWITCH;
|
||
|
|
};
|
||
|
|
$action =~ /^(insert|update|delete)$/ &&
|
||
|
|
do {
|
||
|
|
my %attributes;
|
||
|
|
if ( $action =~ /update/ ) {
|
||
|
|
# make update condition from current pk
|
||
|
|
for my $param ( $cgi->param ) {
|
||
|
|
if ( my($pk_column) = $param =~ /^pk_(\w+)$/ ) {
|
||
|
|
$attributes{$pk_column} = $cgi->param($param);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
cgi_set_attributes($thing);
|
||
|
|
eval { $thing->$action(\%attributes); };
|
||
|
|
error($@) if $@;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$dm->dbh->disconnect;
|
||
|
|
$dbh->disconnect;
|
||
|
|
|
||
|
|
print <<EOF;
|
||
|
|
</table>
|
||
|
|
</td>
|
||
|
|
</tr>
|
||
|
|
</table>
|
||
|
|
</body>
|
||
|
|
</html>
|
||
|
|
EOF
|