DBIx-HTMLinterface
view release on metacpan or search on metacpan
HTMLinterface.pm view on Meta::CPAN
my ($name, $value) = split(/=/, $pair);
$extrahash{$name} = $value;
}
# Load hidden array
$hashInfo = $entry->{"Hidden"};
@hidden = split(/&/, $hashInfo);
# Load exclude array
$hashInfo = $entry->{"Exclude"};
@exclude = split(/&/, $hashInfo);
# Load table name
$additionalwhere = $entry->{"AdditionalWhere"};
}
$cursor->finish;
return ($table_name, \%namehash, \%labelhash, \%lookuphash, \%extrahash, \@hidden, \@exclude, $additionalwhere);
}
# Internal function to return a hash of just the extra data from the info table
sub _getTableExtraHash {
my $self = shift;
my $table = shift;
my $cursor = $self->_execSql ('select ExtraHash from ' . $self->{ITABLE} . ' where TableID = ' . $self->_sqlQuote($table));
my ($entry, %hash);
# Don't die on fail - simply return an empty hash and default everything
# TODO: Protect against undefined tables for this
if ($entry = $cursor->fetchrow_hashref) {
my $hashInfo = $entry->{"ExtraHash"};
my @pairs = split(/&/, $hashInfo);
my $pair;
foreach $pair (@pairs) {
my ($name, $value) = split(/=/, $pair);
$hash{$name} = $value;
}
}
$cursor->finish;
return \%hash;
}
# Internal function to execute a SQL modify
sub _modifyRecord {
my $self = shift;
my $table = shift;
# Run the SQL
my $sql = $self->_updateSql ($table);
my $cursor = $self->_execSql ($sql);
$cursor->finish;
# Tell the people what we did
$self->_printHeader('Modification Successful', 'Record modified successfully.');
print "<UL>";
print "<LI><A HREF=\"" . $self->_backLink . "\">Main Menu</A>";
print "</UL>";
$self->_printFooter;
# Log it, if logging is enabled
$self->_logEvent("Record modified from $table", $sql);
}
# Internal function to execute a SQL delete
sub _deleteRecord {
my $self = shift;
my $table = shift;
# Require confirmation of the delete
if ($self->{CGI}->param('confirm')) {
# Run the SQL
my $sql = $self->_deleteSql($table);
my $cursor = $self->_execSql ($sql);
$cursor->finish;
# Tell the people what we did
$self->_printHeader('Deletion Successful', 'Record deleted successfully.');
print "<UL>";
print "<LI><A HREF=\"" . $self->_backLink . "\">Main Menu</A>";
print "</UL>";
$self->_printFooter;
# Log it, if logging is enabled
$self->_logEvent("Record deleted from $table", $sql);
} else {
# Ask them to confirm their action
$self->_printHeader('Confirm Delete', 'Confirm Delete');
print $self->{CGI}->b('Press back to cancel. Press Confirm to delete.');
print $self->{CGI}->startform;
$self->_printHidden; # Print any hidden elements necessary
# Print all the form params as hidden fields
my @form = $self->{CGI}->param;
my $name;
while ($name = shift @form) {
print $self->{CGI}->hidden (-name=>$name, -value=>$self->{CGI}->param ($name) );
}
print $self->{CGI}->hidden(-name=>'confirm',-value =>'true');
print $self->{CGI}->submit('Confirm');
print " ";
print $self->_backLink;
print $self->{CGI}->endform;
$self->_printFooter;
}
}
# Internal function to execute a SQL insert
sub _insertRecord {
my $self = shift;
my $table = shift;
# Run the SQL
my $sql = $self->_insertSql ($table);
my $cursor = $self->_execSql ($sql);
$cursor->finish;
# Tell the people what we did
$self->_printHeader('Addition Successful', 'Record added successfully.');
print "<UL>";
print "<LI><A HREF=\"" . $self->_repeatLink . "\">Add Another</A>";
print "<LI><A HREF=\"" . $self->_backLink . "\">Main Menu</A>";
print "</UL>";
$self->_printFooter;
# Log it, if logging is enabled
$self->_logEvent("Record added to $table", $sql);
}
# _insertSql - internal function to generate insert statements for $table, inserting all values in
# $self->{CGI}->param which match the table column names.
sub _insertSql {
my $self = shift;
my $table = shift;
# Use a DESCRIBE statement to get the field default values
my $desc_cursor = $self->_execSql ("describe $table");
my (@fields, @fielddefaults, @fieldextra, @fielddesc);
# TODO: Lousy hack?
my $fieldextra2 = _getTableExtraHash($self,$table); # Get extra info from the infotable
while (@fielddesc = $desc_cursor->fetchrow) {
push @fields, $fielddesc[0];
push @fielddefaults, $fielddesc[4];
push @fieldextra, $fielddesc[5];
}
$desc_cursor->finish;
my $first_time = 1;
my ($field, $default, $extra);
# Start the SQL statement
my $sql = "insert into $table values (";
# Step through the fields and add a section to the statement for each
while ($field = shift @fields) {
$default = shift @fielddefaults;
$extra = shift @fieldextra;
# Convert NULL fields to "" unless they are auto incrementing in which case
# leave them as NULL to allow the auto increment to function
$default = $default eq "NULL" ? "" : $default;
if ($extra eq "auto_increment") {
$default = "NULL";
}
# Get the value if we have a CGI-specified value, else use the default
my $val = $self->{CGI}->param("$field") || $default;
# Add commas between statements
if ($first_time != 1) {
$sql .= ', ';
}
# Encrypt passwords if required, then add the value to the statement
if ($$fieldextra2{$field} eq "encryptpassword") {
$sql .= "PASSWORD(" . $self->_sqlQuote($val) . ")";
} else {
$sql .= $self->_sqlQuote($val);
}
$first_time = 0;
}
( run in 0.882 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )