#!/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 presents a simple HTML forms interface to any database configured to work with B. The database B have the appropriate catalog entries in the catalog database before it will work with this script (see L.) =head2 Query string arguments The following arguments are supported in the query string. Mandatory arguments are shown in B. =over 4 =item B The name of the database. =item B The portion of the DBI DSN after 'DBI:' to be used to connect to the database e.g. 'mysql:database=foo'. =item B 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 The host on which the database is located (default = 'localhost'.) =back =head1 SEE ALSO L. =head1 AUTHOR Paul Sharpe Epaul@miraclefish.comE =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 "ERROR!

$message\n"; } print $cgi->header; print < $db: $table

db: $db

Tables

    EOF for ( @{$dm->collects_table_l} ) { my $table = $_->name; print "
  • $table\n"; } print <
\n"; print $template->fill($values_hashref); for ( 'select','insert' ) { print "\n"; } print < EOF } print < 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 "\n"; for ( qw(host driver db db_dsn c_dsn table form) ) { print "\n"; } print $thing->table->is_identified_by->as_hidden_html($values_hashref); print "",$template->fill($thing->table_qualified_attribute_hashref),"\n"; print "\n"; print "\n"; print "\n"; } } else { print "\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 <

$table
EOF if ( $form eq 'input' ) { my $self_url = $cgi->self_url; print "
\n"; for ( qw(host driver db db_dsn c_dsn table form) ) { print "\n"; } my $values_hashref = $thing->table_qualified_attribute_hashref; print $thing->table->as_html_heading,"\n
$_
' : '',"update",($action eq 'delete') ? ' checked' : '',"delete
No rows matched your query
EOF