# ================================================================== # Gossamer Threads Module Library - http://gossamer-threads.com/ # # GT::SQL::Admin # Author : Scott Beck # CVS Info : 087,071,086,086,085 # $Id: Admin.pm,v 1.161 2009/05/11 22:57:15 brewt Exp $ # # Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved. # ================================================================== # # Description: # Used to create a basic admin area for the most common admin # setup. For anything more complex use the Display modules # individually. This also proves an excelent example of # how to use the HTML module. # package GT::SQL::Admin; # =================================================================== use strict; use GT::Base; use GT::AutoLoader; use GT::CGI; use GT::SQL; use GT::SQL::Display::HTML; use vars qw/ @ISA $DEBUG $VERSION $ERROR_MESSAGE $ATTRIBS $BAR_COLOR $BAR_FONT $TITLE_FONT $FONT $BODY $ROW_COLOR1 $ROW_COLOR2 %ACTION /; # Possible arguments to new $ATTRIBS = { header => undef, footer => undef, start_form => undef, end_form => undef, start_html => undef, end_html => undef, record => undef }; # Error messages are stored in GT::SQL. @ISA = qw/GT::Base/; $ERROR_MESSAGE = 'GT::SQL'; $DEBUG = 0; $VERSION = sprintf "%d.%03d", q$Revision: 1.161 $ =~ /(\d+)\.(\d+)/; # Some default HTML attributes. $BODY = 'bgcolor="#FFFFFF"'; $BAR_COLOR = 'navy'; $BAR_FONT = "face='Arial' size='2' color='#FFFFFF'"; $TITLE_FONT = "face='Arial' size='2' color='#000000'"; $FONT = "face='Tahoma,Arial,Helvetica' size='2' color='#000000'"; $ROW_COLOR1 = 'bgcolor="#dddddd"'; $ROW_COLOR2 = 'bgcolor="#eeeeee"'; %ACTION = ( add_form => 1, add_record => 1, add_success => 1, delete_records => 1, delete_results => 1, delete_search_form => 1, delete_search_results => 1, download_file => 1, edit_table_def => 1, editor_add_field => 1, editor_add_field_form => 1, editor_column_checks => 1, editor_column_form => 1, editor_column_help => 1, editor_columns => 1, editor_delete_field => 1, editor_delete_field_form => 1, editor_export_data => 1, editor_export_data_form => 1, editor_import_data => 1, editor_import_data_form => 1, editor_modify_columns => 1, editor_table_form => 1, editor_update_def => 1, modify_error => 1, modify_form => 1, modify_multi_records => 1, modify_multi_results => 1, modify_multi_search_results => 1, modify_record => 1, modify_search_form => 1, modify_search_results => 1, modify_success => 1, search_form => 1, search_results => 1, view_file => 1 ); # ================================================================================ # # SIMPLE INTERFACE # # ================================================================================ # ## # $obj->process($defs, $in); # -------------------- # $defs must be the full path to the directory # the definition file GT::SQL created. # $in is a cgi object. This will process # the cgi object from the forms it created. # The proper changes will then be made and the # results shown to the user. # You should call this after testing to see if # the input from the cgi is for_me. ## sub process { my $self = shift; $self->initialize(@_) or return; # Find out what we are doing. my $action = $self->{cgi}->{do}; if (exists $ACTION{$action}) { $self->$action(); # print "
QUERY STACK: ", GT::SQL->query_stack_disp, ""; # if ($self->{_debug}); } else { # ERROR they should have called for_me to see if there was an action for me :) return $self->error('NOACTION', 'FATAL', $action); } } sub initialize { my ($self, @in) = @_; # Find out what we have, and store the CGI values in self->{cgi}. my $opt = $self->common_param(@in) or return $self->error("BADARGS", 'FATAL', '$obj->process($in) where $in is a CGI object'); $self->{in} = $opt->{cgi}; $self->{cgi} = $self->common_param($opt->{cgi}) or return $self->error("BADARGS", 'FATAL', "You must pass in a cgi object"); my $tbl_names = ($self->{cgi}->{db}) || ($opt->{tables}) || (return $self->error('BADARGS', 'FATAL', 'No table passed in via CGI or tables method')); ref($tbl_names) || ($tbl_names = [ $tbl_names ]); if ($opt->{def_path}) { return $self->error(BADARGS => FATAL => "The 'def_path' argument to \$admin->process is deprecated. You should pass in a GT::SQL object using 'db' instead."); } $self->{db} = $opt->{db} or return $self->error('BADARGS', 'FATAL', 'Error: You must pass in a GT::SQL object.'); $self->{table} = $self->{db}->table(@$tbl_names) or return; # Get the name of this table. my $prefix = $self->{db}->prefix; if (length $prefix) { $self->{record} ||= join(',', map { s/^$prefix//; $_; } $self->{table}->name); } else { $self->{record} ||= join(',', $self->{table}->name); } # Get the Display object. if ($opt->{display}) { $self->{html} = $opt->{display}; } else { $self->{html} = $self->{db}->html($self->{table}, $self->{cgi}); } $self->{html}->{url} = GT::CGI->url(remove_empty => 1); # Set any attributes the user passed in to process. foreach my $option (keys %{$ATTRIBS}) { $self->{$option} = $opt->{$option} if (exists $opt->{$option}); } return 1; } sub preserve { my $self = shift; if (@_) { my $preserve = shift; $self->{preserve} = $preserve; } return $self->{preserve}; } ## # GT::SQL::Admin->for_me($in); # ---------------------------- # $in is a cgi object. You should call this in # an if to see if the cgi object is from a form # this module produced. ## sub for_me { my ($self, @in) = @_; # Get options my $opt = $self->common_param(@in) or return $self->error("BADARGS", 'FATAL', 'GT::SQL::Admin->for_me($in) where $in is a CGI object'); # There is no action so return false $opt->{do} or return 0; $opt->{db} or return 0; # Check to see if there is a routine in this module. return exists $ACTION{$opt->{do}}; } # Make sure AUTOLOAD does not catch destroyed objects. sub DESTROY {} # ================================================================================ # # FILE HANDLING # # ================================================================================ # $COMPILE{download_file} = __LINE__ . <<'END_OF_SUB'; sub download_file { my ($self, $inline) = @_; my $in = $self->{in}; my $table_name = $in->param('db'); my $id = $in->param('id'); my $cn = $in->param('cn'); my $src = $in->param('src') || 'db'; my $fname = $in->param('fname'); unless ($table_name and $id and $cn) { print $in->header(); print $self->_start_html({ title => 'Error Downloading' }); print $self->_header("Unknown Document Reference", $@); print $self->_end_html; return; } my $tbl = $self->{table}; my ($fh, $size, $mimetype); if ($src eq 'db') { eval { $fh = $tbl->file_info($cn, $id) }; if ($fh) { $fname = $fh->File_Name(); $mimetype = $fh->File_MimeType(); $size = $fh->File_Size(); } } else { require GT::SQL::File; eval { $fh = GT::SQL::File->open($fname) }; $size = -s $fname; $fname = GT::SQL::File->get_filename($fname); } if (!$fh) { print $in->header(); print $self->_start_html({ title => 'Error Downloading' }); print $self->_header("Error Downloading File", $@ || "Cannot find file pointed to by ID: $id and Column: $cn"); print $self->_end_html; } else { print $self->{in}->header( $self->{in}->file_headers( filename => $fname, size => $size, $inline ? () : (inline => 0) ) ); $fh->File_Binary() and binmode STDOUT; while (read($fh, my $buffer, 4096)) { print $buffer; } } } END_OF_SUB sub view_file { my $self = shift; $self->download_file(1); } # ================================================================================ # # SEARCHING RECORDS # # ================================================================================ # $COMPILE{search_form} = __LINE__ . <<'END_OF_SUB'; sub search_form { my ($self, $msg) = @_; $msg &&= qq|$msg|; print $self->{in}->header; print $self->_start_html({ title => "Search Form" }); print $self->_header("Search Form", $msg || "Search the database to view records."); print $self->_start_form({ do => "search_results", db => $self->{cgi}->{db}, method => 'POST' }); print $self->{html}->form({ mode => 'search_form', search_opts => 1, file_browse => 1 }); print "
", $self->_search_options; print "
", $self->_buttons("Search"); print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB ## # $obj->search_results; # --------------------- # Produces the search results for the user to view. ## $COMPILE{search_results} = __LINE__ . <<'END_OF_SUB'; sub search_results { my $self = shift; print $self->{in}->header; # Make sure the user passed in some values to search on $self->_check_opts or return $self->search_form("You must specify at least one search term."); # Format the cgi for searching $self->format_search_cgi; # Do the search and count the results. my $sth = $self->{table}->query_sth($self->{cgi}); my $hits = $self->{table}->hits(); if ($hits == 0) { return $self->search_form("Your search did not match any records."); } print $self->_start_html({ title => "Search Results" }); print $self->_header("Search Results", "Your search returned $hits result(s)."); my $speedbar = ''; my $name = GT::CGI->url(remove_empty => 1); if ($hits > ($self->{cgi}->{mh} || 25)) { $speedbar = "
Pages: "; $speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name); $speedbar .= "
\n"; print $speedbar; } if ($self->{in}->param('dr') and $self->{in}->param('dr') eq 'rows') { print qq!", $self->{html}->display({ mode => 'search_results', values => $result }); } } print $speedbar if ($speedbar); print "
", $self->_footer; print $self->_end_html; } END_OF_SUB # ================================================================================ # # ADD RECORDS # # ================================================================================ # ## # $obj->add_form; # --------------- # This will print the add form for the current # tables that we are working with. All the # options that were set in settings will apply # to the html that is printed here. ## $COMPILE{add_form} = __LINE__ . <<'END_OF_SUB'; sub add_form { my ($self, $msg) = @_; print $self->{in}->header; my $hk = [$self->{table}->ai]; $msg &&= qq|$msg|; print $self->_start_html({ title => $msg ? "Add Record Failed" : "Add Record" }); print $self->_header($msg ? "Add Record Failed" : "Add Record", $msg || "Add a record to the database"); print $self->_start_form({ do => "add_record", db => $self->{cgi}->{db} }); print $self->{html}->form({ mode => 'add_form', defaults => 1, hide => $hk, hide_timestamp => 1, search_opts => 0, file_field => 1 }); print "
", $self->_buttons("Add");
print $self->_end_form;
print $self->_footer;
print $self->_end_html;
return 1;
}
END_OF_SUB
##
# $obj->add_record;
# -----------------------
# This will add the record to the database and
# return the record ID on success undef on failure.
##
$COMPILE{add_record} = __LINE__ . <<'END_OF_SUB';
sub add_record {
my $self = shift;
# Turn arrays into delimited fields
$self->format_insert_cgi;
if (defined(my $ret = $self->{table}->add($self->{cgi}))) {
$self->add_success($ret);
}
else {
local $^W;
my $error = $GT::SQL::error;
$error =~ s/\n/
\n
"; print $self->{html}->display({ mode => 'add_success', values => $hsh }); print "
", $self->_footer; print $self->_end_html; } END_OF_SUB # ================================================================================ # # DELETE RECORDS # # ================================================================================ # ## # $obj->delete_search_form; # ------------------------- # Produces the search form to search to delete records. # # $obj->delete_search_form($message); # ------------------------------------ # Same thing as above but puts the message at the top in # red and bold. Great for errors or not search results. ## $COMPILE{delete_search_form} = __LINE__ . <<'END_OF_SUB'; sub delete_search_form { my ($self, $msg) = @_; print $self->{in}->header; $msg &&= qq|$msg|; print $self->_start_html({ title => "Delete Records" }); print $self->_header("Delete Records", $msg || "Search to delete records."); print $self->_start_form({ do => "delete_search_results", db => $self->{cgi}->{db}, method => 'POST' }); print $self->{html}->form({ mode => 'delete_search_form', search_opts => 1 }); print "
", $self->_search_options; print "
", $self->_buttons("Search"); print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB ## # $obj->delete_search_results; # ---------------------------- # Performs the search and returns the result forms # to delete records. ## $COMPILE{delete_search_results} = __LINE__ . <<'END_OF_SUB'; sub delete_search_results { my $self = shift; print $self->{in}->header; # Make sure the user passed in some values to search on $self->_check_opts or return $self->delete_search_form("You must specify at least one search term."); # Format the cgi for searching $self->format_search_cgi; # Do the search and count the results. my $sth = $self->{table}->query_sth($self->{cgi}); my $hits = $self->{table}->hits(); # Return if we haven't found anything. if ($hits == 0) { return $self->delete_search_form("Your search returned no results."); } print $self->_start_html({ title => "Search Results" }); print $self->_start_form({ do => 'delete_records', db => $self->{cgi}->{db} }); print $self->_header("Search Results", "Your search returned $hits result(s)."); my $speedbar = ''; if ($hits > ($self->{cgi}->{mh} || 25)) { my $name = GT::CGI->url(remove_empty => 1); $speedbar = "
Pages: "; $speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name); $speedbar .= "
\n"; print $speedbar; } my $i = 1; my @pk; # If we have a relation if (exists $self->{table}->{tables}) { for my $t (values %{$self->{table}->{tables}}) { push @pk, map { $t->name . '.' . $_ } $t->pk; } } else { @pk = $self->{table}->pk; } if ($self->{in}->param('dr') and $self->{in}->param('dr') eq 'rows') { print qq!
|
~; print $self->{html}->display({ mode => 'delete_search_results', values => $result }); print " |
Check All
END_OF_HTML print "", $self->_buttons("Delete"); print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB ## # $obj->delete_records; # --------------------- # Performs the delete and returns the success page. ## $COMPILE{delete_records} = __LINE__ . <<'END_OF_SUB'; sub delete_records { my $self = shift; # Make sure we have something to delete. $self->{cgi}->{delete} or return $self->delete_results(0); # If they selected only one record to delete we still need an array ref ref $self->{cgi}->{delete} eq 'ARRAY' or $self->{cgi}->{delete} = [$self->{cgi}->{delete}]; # Need to know the names of the columns for this Table. my @columns = keys %{$self->{table}->cols}; # Need to know the number of records modified my $rec_modified = 0; # For through the record numbers. These are the values of the # check boxes foreach my $rec_num (@{$self->{cgi}->{delete}}) { my $change = {}; foreach my $column (@columns) { $change->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"}; } next unless (keys %$change); my $ret = $self->{table}->delete($change); if (defined $ret and ($ret != 0)) { $rec_modified++; } } # Return the results page with the proper arguments depending on if we got an error or not. return $self->delete_results($rec_modified); } END_OF_SUB $COMPILE{delete_results} = __LINE__ . <<'END_OF_SUB'; sub delete_results { my ($self, $num_modified) = @_; print $self->{in}->header; print $self->_start_html({ title => "Records Deleted" }); print $self->_header("Records Deleted", "$num_modified record(s) were deleted."); print "
", $self->_footer; print $self->_end_html; } END_OF_SUB # ================================================================================ # # MODIFY RECORDS # # ================================================================================ # ## # $obj->modify_search_form; # ------------------------- # Returns the html form to search to modify a # record. # # $obj->modify_search_form($message); # ---------------------------------- # The same thing just puts the message at the top of the # field. Great for errors. ## $COMPILE{modify_search_form} = __LINE__ . <<'END_OF_SUB'; sub modify_search_form { my ($self, $msg) = @_; print $self->{in}->header; $msg &&= qq|$msg|; print $self->_start_html({ title => "Modify Record" }); print $self->_header("Modify Record", $msg || "Search to modify a record."); print $self->_start_form({ do => "modify_search_results", db => $self->{cgi}->{db}, method => 'POST' }); print $self->{html}->form({ mode => 'modify_search_form', search_opts => 1 }); print "
", $self->_search_options({ modify_mult => 1 }); print "
", $self->_buttons("Search"); print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB ## # $obj->modify_search_results; # ---------------------------- # Returns the form that displays the results of a # search to modify a record. ## $COMPILE{modify_search_results} = __LINE__ . <<'END_OF_SUB'; sub modify_search_results { my $self = shift; print $self->{in}->header; # If they are modifying multiple records. if ($self->{cgi}->{modify_multi_form}) { return $self->modify_multi_search_results(@_); } # Make sure the user passed in some values to search on $self->_check_opts or return $self->modify_search_form("You must specify at least one search term"); # Format the cgi for searching $self->format_search_cgi; # Do the search and count the results. my $sth = $self->{table}->query_sth($self->{cgi}) or return $self->modify_search_form($GT::SQL::error); my $hits = $self->{table}->hits(); # Return if we haven't found anything. if ($hits == 0) { return $self->modify_search_form("Your search returned no results."); } # Go straight to the modify form if we only have on result. if ($hits == 1) { $self->{cgi}->{modify} = 0; my $row = $sth->fetchrow_hashref; foreach (keys %$row) { $self->{cgi}->{$_} = $row->{$_}; } return $self->modify_form(); } print $self->_start_html({ title => "Search Results" }); print $self->_start_form({ do => 'modify_form', db => $self->{cgi}->{db} }); print $self->_header("Search Results", "Your search returned $hits result(s)."); my $speedbar = ''; if ($hits > ($self->{cgi}->{mh} || 25)) { my $name = GT::CGI->url(remove_empty => 1); $speedbar = "
Pages: "; $speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name); $speedbar .= "
\n"; print $speedbar; } my $i = 1; my @pk; if (exists $self->{table}->{tables}) { for my $t (values %{$self->{table}->{tables}}) { push @pk, map { $t->name . '.' . $_ } $t->pk; } } else { @pk = $self->{table}->pk; } if ($self->{in}->param('dr') eq 'rows') { print qq!
|
~; print $self->{html}->display({ mode => 'modify_search_results', values => $result }); print " |
", $self->_buttons("Modify"); print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB ## # $obj->modify_form($message); # ------------------ # Returns the form to modify a single record. # $message is optional. It will be at the top of the form. ## $COMPILE{modify_form} = __LINE__ . <<'END_OF_SUB'; sub modify_form { my ($self, $msg) = @_; print $self->{in}->header; $msg &&= qq|$msg|; my $values; my $mod = $self->{cgi}->{modify}; if (! exists $self->{cgi}->{modify}) { return $self->modify_error("Please select a record to modify before continuing."); } if ($self->{cgi}->{modify} == 0) { $values = $self->{cgi}; } else { my $lookup = {}; for ($self->{table}->pk) { $lookup->{$_} = $self->{cgi}->{"$mod-$_"}; } $values = $self->{table}->get($lookup, 'HASH'); } print $self->_start_html({ title => "Modify Record" }); print $self->_header("Modify Record", $msg || "Modify a record."); print $self->_start_form({ do => "modify_record", db => $self->{cgi}->{db} }); print $self->{html}->form({ mode => 'modify_form', values => $values, view_key => 1, file_field => 1, file_delete => 1 }); my @pk; if (exists $self->{table}->{tables}) { for my $t (values %{$self->{table}->{tables}}) { push @pk, map { $t->name . '.' . $_ } $t->pk; } } else { @pk = $self->{table}->pk; } print qq(
|
", $self->_footer;
print $self->_end_html;
}
END_OF_SUB
##
# $obj->modify_record;
# --------------------
# Makes the modifications to the record. Returns the
# failure page on error (which is the modify form with a message)
# and the success page on success.
##
$COMPILE{modify_record} = __LINE__ . <<'END_OF_SUB';
sub modify_record {
my $self = shift;
# Format arrays for insertion
$self->format_insert_cgi;
if ($self->{table}->modify($self->{cgi})) {
return $self->modify_success;
}
else {
$self->{cgi}->{modify} = 0;
if ($GT::SQL::errcode eq 'ALREADYCHANGED') {
my $lookup = {};
for ($self->{table}->pk) {
$lookup->{$_} = $self->{cgi}->{$_};
}
my $rec = $self->{table}->get($lookup, 'HASH');
if ($rec) {
foreach (keys %$rec) {
$self->{cgi}->{$_} = $rec->{$_};
}
return $self->modify_form("The record you are attempting to modify has changed since you last accessed it, please make your changes again and resubmit.");
}
else {
return $self->modify_error("The record you attempted to modify could not be found.");
}
}
my $error = $GT::SQL::error;
$error =~ s/\n/
\n
"; print $self->{html}->display({ mode => 'modify_success', values => $rec }); print "
", $self->_footer; print $self->_end_html; } END_OF_SUB ## # $obj->modify_error; # --------------------- # Modify error which doesn't/can't display the record. ## $COMPILE{modify_error} = __LINE__ . <<'END_OF_SUB'; sub modify_error { my $self = shift; my $msg = shift; print $self->{in}->header; print $self->_start_html({ title => "Modify Error" }); print $self->_header("Modify Error", $msg); print "
", $self->_footer; print $self->_end_html; } END_OF_SUB # ================================================================================ # # MODIFY MULTIPLE RECORDS # # ================================================================================ # ## # $obj->modify_multi_search_results; # ------------------------ # Returns the forms to modify records. ## $COMPILE{modify_multi_search_results} = __LINE__ . <<'END_OF_SUB'; sub modify_multi_search_results { my $self = shift; print $self->{in}->header; # Make sure the user passed in some values to search on $self->_check_opts or return $self->modify_search_form("You must specify at least one search term"); # Format the cgi for searching $self->format_search_cgi; # Do the search and count the results. my $sth = $self->{table}->query_sth($self->{cgi}) or return $self->modify_search_form($GT::SQL::error); my $hits = $self->{table}->hits(); # Return if we haven't found anything. if ($hits == 0) { return $self->modify_search_form("Your search returned no results."); } # Go straight to the modify form if we only have on result. if ($hits == 1) { $self->{cgi}->{modify} = 0; my $row = $sth->fetchrow_hashref; foreach (keys %$row) { $self->{cgi}->{$_} = $row->{$_}; } return $self->modify_form(); } print $self->_start_html({ title => "Modify Search Results" }); print $self->_start_form({ do => 'modify_multi_records', db => $self->{cgi}->{db} }); print $self->_header("Modify Search Results", "Your search returned $hits result(s)."); my $speedbar = ''; if ($hits > ($self->{cgi}->{mh} || 25)) { my $name = GT::CGI->url(remove_empty => 1); $speedbar = "
Pages: "; $speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name); $speedbar .= "
\n"; print $speedbar; } my $i = 1; while (my $result = $sth->fetchrow_hashref) { print qq~~; print $self->{html}->form({ mode => 'modify_multi_search_results', values => $result, multiple => $i, view_key => 1, file_field => 1, file_delete => 1 }); print " |
", $self->_buttons("Modify");
print $self->_end_form;
print $self->_footer;
print $self->_end_html;
}
END_OF_SUB
##
# $obj->modify_multi_records;
# ---------------------------
# This performs the modify on the multiple records. This returns
# the success page on error and the modify form on failure. It should
# call the modify form in a way that it can reproduce the records that
# were not successfully modified. See the comments above to see how
# modify_multi_form is called.
##
$COMPILE{modify_multi_records} = __LINE__ . <<'END_OF_SUB';
sub modify_multi_records {
my $self = shift;
if (! exists $self->{cgi}->{modify}) {
return $self->modify_error("Please select a record to modify before continuing.");
}
# If they selected only one record to modify we still need an array ref
ref $self->{cgi}->{modify} eq 'ARRAY' or $self->{cgi}->{modify} = [$self->{cgi}->{modify}];
# Format the cgi for inserting
$self->format_insert_cgi;
# Hash to handle errors if there are any errors.
my $errors = {};
my $errcode = {};
# Need to know the names of the columns for this Table.
my @columns = keys %{$self->{table}->cols};
# Need to know the number of records modified
my $rec_modified = 0;
# For through the record numbers. These are the values of the
# check boxes
foreach my $rec_num (@{$self->{cgi}->{modify}}) {
# The hash ref, we need, to modify a record.
my $change = {};
# For through the column names to build our modification hash
foreach my $column (@columns) {
$change->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"};
}
# Make the changes and capture any errors.
my $ret = $self->{table}->modify($change);
if (defined $ret) {
$rec_modified++;
}
else {
if ($GT::SQL::error){
my $error = $GT::SQL::error;
$error =~ s/\n/
\n
The record could not be found in the database~;
$error_out .= qq~
~; $error_out .= $self->{html}->display({ mode => 'modify_multi_results_norec', values => $values }); $error_out .= qq~ |
The record you are attempting to modify has changed since you last accessed it, please make your changes again and resubmit.~;
$error_out .= qq~
~; $error_out .= $self->{html}->form({ mode => 'modify_multi_result_changed', values => $values, multiple => $rec }); $error_out .= qq~ |
$errors->{$rec}
~; foreach my $col (keys %$cols) { $values->{$col} = $self->{cgi}->{"$rec-$col"}; } $error_out .= $self->{html}->form({ values => $values, multiple => $rec, mode => 'modify_multi_results_err' }); $error_out .= qq~ |
" . $self->_buttons("Modify"); $error_out .= $self->_end_form; } # If there were successfull modifications. if ($num_modified) { $ok_out = $self->_header("Modify Success", "$num_modified record(s) were successfully updated."); $ok_out .= "
"; } # Print the HTML print $self->{in}->header; print $self->_start_html({ title => "Record Modified" }); print $ok_out; print $error_out; print $self->_end_html; } END_OF_SUB $COMPILE{format_insert_cgi} = __LINE__ . <<'END_OF_SUB'; sub format_insert_cgi { my $self = shift; my $cols = $self->{table}->cols; foreach (keys % $cols) { if (! exists $self->{cgi}->{$_} and uc($cols->{$_}->{form_type}) eq 'CHECKBOX') { $self->{cgi}->{$_} = ''; } } } END_OF_SUB $COMPILE{format_search_cgi} = __LINE__ . <<'END_OF_SUB'; sub format_search_cgi { my $self = shift; foreach (keys %{$self->{table}->cols}) { next unless (ref $self->{cgi}->{$_} eq 'ARRAY'); if (exists $self->{cgi}->{"$_-opt"} and $self->{cgi}->{"$_-opt"} eq 'LIKE') { $self->{cgi}->{$_} = join("$GT::SQL::Display::HTML::INPUT_SEPARATOR%", sort @{$self->{cgi}->{$_}}); } else { $self->{cgi}->{$_} = join($GT::SQL::Display::HTML::INPUT_SEPARATOR, sort @{$self->{cgi}->{$_}}); } } } END_OF_SUB # ================================================================================ # # EDIT TABLES # # ================================================================================ # $COMPILE{editor_table_form} = __LINE__ . <<'END_OF_SUB'; sub editor_table_form { # ------------------------------------------------------------------- # $obj->editor_table_form; # ------------------------ # Prints the form to edit the table # definitions. # my ($self, $msg) = @_; print $self->{in}->header; # Get the variables that need to be preserved and generate urls for them. my $preserve_hash = $self->preserve(); my $preserve = ''; foreach my $p (keys %$preserve_hash) { $preserve .= qq|&$p=$preserve_hash->{$p}|; } # Update the table if required $self->{in}->param('update_def') and $msg .= $self->edit_table_def || "Table Definition Update Successful"; $msg &&= qq|$msg|; my $table = $self->{record}; print $self->_start_html({ title => "Table Editor: $table" }); print $self->_header("Table Editor", $msg || "Table Maintenance: $table"); print $self->_start_form({ do => 'editor_table_form', db => $self->{cgi}->{db}, update_def => 1 }); my $url = GT::CGI->url({ query_string => 0 }); my $show_weight_h = (keys %{$self->{table}->weight}) ? "
Edit $table Table Definition
Below is all the columns in your $table table. By clicking on one of the column names, you can view more details
as well as alter the column definition.
|
|
|
For information on what each column means, click here.
~; # Set up defaults for the fields foreach my $col (qw/column type not_null file_save_in file_save_url file_max_size file_save_scheme default form_display form_type form_size form_names form_values regex weight values size/) { $attribs{$col} = $self->{cgi}->{$col} if (defined $self->{cgi}->{$col}); } $attribs{column} ||= $column; $attribs{form_type} ||= 'TEXT'; $attribs{form_size} ||= ($attribs{form_type} eq 'SELECT') ? 0 : ''; ref $attribs{form_size} and ($attribs{form_size} = join (",", @{$attribs{form_size}})); ref $attribs{form_names} and ($attribs{form_names} = join ("\n", @{$attribs{form_names}})); ref $attribs{form_values} and ($attribs{form_values} = join ("\n", @{$attribs{form_values}})); ref $attribs{values} and ($attribs{values} = join ("\n", @{$attribs{values}})); # Display the form. my $index_list = $self->_index_list($column); print $self->editor_column_form(\%attribs, $index_list, 'modify'); print $self->_buttons("Update Table"); print ""; print $self->_prop_navbar; print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB $COMPILE{editor_modify_columns} = __LINE__ . <<'END_OF_SUB'; sub editor_modify_columns { # -------------------------------------------------------- # Modifies a column definition. # my $self = shift; ref $self->{cgi}->{db} and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation."); my $editor = $self->{db}->editor($self->{cgi}->{db}); my %attribs; my $column = $self->{cgi}->{modify} || return $self->editor_columns("You must enter a column name."); foreach my $def (qw/column type not_null default form_display form_type form_size file_save_in file_save_url file_max_size file_save_scheme regex weight size/) { $attribs{$def} = $self->{cgi}->{$def} if (defined $self->{cgi}->{$def}); } $attribs{form_type} ||= 'TEXT'; $attribs{form_names} = [split /[\r\n]+/, $self->{cgi}->{form_names}]; $attribs{form_values} = [split /[\r\n]+/, $self->{cgi}->{form_values}]; $attribs{values} = [split /[\r\n]+/, $self->{cgi}->{values}]; # Keep any values that where there before my $old_def = $self->{table}->cols->{$column}; for my $val (keys %$old_def) { $attribs{$val} = $old_def->{$val} unless exists $attribs{$val}; } # Error checking my $errors = $self->editor_column_checks($column, \%attribs, 'modify'); if ($self->{cgi}->{index} eq 'primary' and ($column ne $self->{table}->{schema}->{pk})) { $errors .= "
|
For information on what each column means, click here.
~; my $index_list = $self->_index_list(); print $self->editor_column_form(\%attribs, $index_list, 'add'); print $self->_buttons("Add Field to"); print ""; print $self->_prop_navbar; print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB $COMPILE{editor_add_field} = __LINE__ . <<'END_OF_SUB'; sub editor_add_field { # ------------------------------------------------------------------- # Add a new column to the database. # my $self = shift; ref $self->{cgi}->{db} and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation."); my $editor = $self->{db}->editor($self->{cgi}->{db}); my %attribs; my $table = $self->{cgi}->{db}; my $column = $self->{cgi}->{column} || return $self->editor_add_field_form("You must enter a column name."); my %cols = $self->{table}->cols; $attribs{type} = $self->{cgi}->{type} || return $self->editor_add_field_form("You must enter a column type."); $attribs{size} = $self->{cgi}->{size}; $attribs{form_display} = $self->{cgi}->{form_display} || $self->{cgi}->{column}; $attribs{not_null} = $self->{cgi}->{not_null} || 0; $attribs{default} = $self->{cgi}->{default}; $attribs{form_type} = $self->{cgi}->{form_type} || 'TEXT'; $attribs{form_size} = $self->{cgi}->{form_size} || ''; $attribs{regex} = $self->{cgi}->{regex} || ''; $attribs{weight} = $self->{cgi}->{weight} || ''; $attribs{file_save_in} = $self->{cgi}->{file_save_in} || ''; $attribs{file_save_url} = $self->{cgi}->{file_save_url} || ''; $attribs{file_max_size} = $self->{cgi}->{file_max_size} || ''; $attribs{file_save_scheme} = $self->{cgi}->{file_save_scheme} || ''; $attribs{form_names} = [split /[\r\n]+/, $self->{cgi}->{form_names}]; $attribs{form_values} = [split /[\r\n]+/, $self->{cgi}->{form_values}]; $attribs{values} = [split /[\r\n]+/, $self->{cgi}->{values}]; $attribs{pos} = keys(%cols) + 1; # Error checking my $errors = $self->editor_column_checks($column, \%attribs, 'add'); if (exists $cols{$column}) { $errors .= "
|
|
"; print $self->_prop_navbar; print $self->_end_form; print $self->_footer; print $self->_end_html; return; } END_OF_SUB ## # $self->editor_import_data_form; # ------------------------------- # Prints the page to import data. ## $COMPILE{editor_import_data_form} = __LINE__ . <<'END_OF_SUB'; sub editor_import_data_form { my ($self, $msg) = @_; print $self->{in}->header; $msg &&= qq|$msg|; my $table = $self->{record}; print $self->_start_html({ title => "Table Editor: $table" }); print $self->_header("Table Editor", $msg || "Import Data to $table."); print $self->_start_form({ do => 'editor_import_data', db => $self->{cgi}->{db} }, { name => 'ImportForm'}); print qq~ ~; print qq~
You can either import from a file or you can cut and paste the contents into a textarea box. If you
have a large number of records, you should really import from a file. If you use quick mode, the file must contain the same
number of fields as the current table, and in the same order. If you don't use quick mode, the first line of either the file
or the text box must be a list of column names! |
Fields to Import | ||
~; my @cols = $self->{table}->ordered_columns; print qq| |
| ~; print qq| |
Import data from file: or from textarea box: |
"; print $self->_end_form; print $self->_prop_navbar; print "
";
print $self->_footer;
print $self->_end_html;
}
END_OF_SUB
$COMPILE{editor_import_data} = __LINE__ . <<'END_OF_SUB';
sub editor_import_data {
# --------------------------------------------------------
# Import data from textarea box or file.
#
my $self = shift;
my ($delim, $file, $text, $res, @header);
$delim = $self->{cgi}->{'import-delim'} || return $self->editor_import_data_form("No import delimiter specified!");
$file = $self->{cgi}->{'import-file'};
$text = $self->{cgi}->{'import-text'};
# Make sure they have picked the fields to import
$self->{cgi}->{'ImportRight'} or return $self->editor_import_data_form("No fields selected to import");
@header = reverse ((ref ($self->{cgi}->{'ImportRight'}) eq 'ARRAY') ? @{$self->{cgi}->{'ImportRight'}} : $self->{cgi}->{'ImportRight'});
my $todo = 0;
for (@header) {
unless (/^$/) {
$todo = 1;
last;
}
}
unless ($todo) { return $self->editor_import_data_form("No fields selected to import") }
# Make sure there is some data to import
$file or $text or return $self->editor_import_data_form("You must enter at least a filename or data in the textarea box.");
$file and $text and return $self->editor_import_data_form("Please only enter either a filename or data in the textarea box, not both.");
$delim = "\t" if $delim eq '\t';
# Store the lines to import in @lines and the header in $header.
my ($good_cnt, $err_cnt, $line, $line_num, @lines, @data, $error, %record, $i);
if ($file) {
open (FILE, "<$file") or return $self->editor_import_data_form("Unable to open file '$file': $!");
local $/;
@lines = split /[\r\n]+/, You can either export your data from $table table to the screen or to a file.
If you have a large amount of
data it is recommended to export the contents to a file. Quick mode should be
used when exporting to a file as it
uses the SQL server to do the exporting and is considerably faster. ";
print $self->_end_form;
print $self->_prop_navbar;
print " ";
print $self->_footer;
print $self->_end_html;
}
END_OF_SUB
$COMPILE{editor_export_data} = __LINE__ . <<'END_OF_SUB';
sub editor_export_data {
# --------------------------------------------------------
# Export data to text file/screen.
#
my $self = shift;
ref $self->{cgi}->{db}
and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation.");
my $editor = $self->{db}->editor($self->{cgi}->{db});
my ($delim, $quick, $res);
$self->{cgi}->{'ExportRight'} or return $self->editor_export_data_form("No fields selected to export.");
my @order = reverse(ref $self->{cgi}->{'ExportRight'} eq 'ARRAY' ? @{$self->{cgi}->{'ExportRight'}} : $self->{cgi}->{'ExportRight'});
my $todo = 0;
for (@order) {
unless (/^$/) {
$todo = 1;
last;
}
}
unless ($todo) { return $self->editor_export_data_form("No fields selected to Export.") }
$delim = $self->{cgi}->{'export-delim'};
($delim eq '\t') and ($delim = "\t");
if ($self->{cgi}->{'export-mode'} eq 'file') {
$self->{cgi}->{'export-file'} or return $self->editor_export_data_form("Please enter a file name!");
$editor->export_data(
{
file => $self->{cgi}->{'export-file'},
delim => $delim,
header => 1,
order => \@order
}
) or return $self->editor_export_data_form($GT::SQL::error);
return $self->editor_export_data_form("Data has been exported to: $self->{cgi}->{'export-file'}");
}
else {
print $self->{in}->header;
$editor->export_data(
{
delim => $delim,
header => 1,
order => \@order
}
) or return $self->editor_export_data_form($GT::SQL::error);
return;
}
}
END_OF_SUB
# ================================================================================ #
# PRIVATE/INTERNAL METHODS #
# ================================================================================ #
##
# $self->_check_opts;
# -------------------
# This checks to make sure the user specified at least one
# column to search on.
##
$COMPILE{_check_opts} = __LINE__ . <<'END_OF_SUB';
sub _check_opts {
my $self = shift;
my $sel = 0;
# Relation does not play fare :(
my $cols = $self->{table}->cols;
for (keys %{$self->{cgi}}) { $sel = 1 if (($self->{cgi}->{$_} =~ /\S/) and exists $cols->{$_}) }
if ((exists $self->{cgi}->{query} and $self->{cgi}->{query} =~ /\S/) or
(exists $self->{cgi}->{keyword} and $self->{cgi}->{keyword} =~ /\S/)) {
$sel = 1;
}
$sel or return;
return 1;
}
END_OF_SUB
##
# $self->_header;
# ---------------
# Returns the header to be used with the forms, error pages, etc...
##
$COMPILE{_header} = __LINE__ . <<'END_OF_SUB';
sub _header {
my ($self, $head, $msg) = @_;
if ($self->{header}) {
if (ref $self->{header} eq 'CODE') {
return $self->{header}->($self, $head, $msg);
}
else {
return $self->{header};
}
}
else {
my $out = qq~
$msg$GT::SQL::error
\n";
$err_cnt++;
next LINE;
}
$good_cnt++;
}
# Return the results.
if ($error) {
return $self->editor_import_data_form(($err_cnt >= 10) ?
"Aborting, too many errors!
Rows imported: $good_cnt
Errors with the following rows:
$error
" :
"Rows imported: $good_cnt
Errors with the following rows: $error
");
}
return $self->editor_import_data_form("Rows imported: $good_cnt.");
}
END_OF_SUB
##
# $self->editor_export_data_form;
# -------------------------------
# Prints the page to export data.
##
$COMPILE{editor_export_data_form} = __LINE__ . <<'END_OF_SUB';
sub editor_export_data_form {
my ($self, $msg) = @_;
print $self->{in}->header;
$msg &&= qq|$msg|;
my $table = $self->{record};
print $self->_start_html({ title => "Table Editor: $table" });
print $self->_header("Table Editor", $msg || "Export Data from $table.");
print qq~
~;
print $self->_start_form({ do => 'editor_export_data', db => $self->{cgi}->{db} }, {name => 'ExportForm'});
print qq~
Fields to Export
~;
my @cols = $self->{table}->ordered_columns;
print qq|
~;
print qq|
~;
print $self->_buttons("Export Data from");
print "
Export data to:
filename:
Use as delimiter.
~;
}
}
END_OF_SUB
##
# $self->_footer;
# ---------------
# Returns the footer to set for each form.
##
$COMPILE{_footer} = __LINE__ . <<'END_OF_SUB';
sub _footer {
my $self = shift;
# Get the variables that need to be preserved and generate urls for them.
my $preserve_hash = $self->preserve();
my $preserve = '';
foreach my $p (keys %$preserve_hash) {
$preserve .= qq|&$p=$preserve_hash->{$p}|;
}
if ($self->{footer}) {
if (ref $self->{footer} eq 'CODE') {
my $ret = $self->{footer}->($self);
return $ret if (defined $ret);
}
else {
return $self->{footer};
}
}
my $url = GT::CGI->url({ query_string => 0 }) . "?";
my @vals = GT::CGI->param('db');
foreach my $val (@vals) {
$url .= "db=" . GT::CGI->escape($val) . "&";
}
chop $url;
my $ret = qq~
$self->{record}: $head
~;
return $ret;
}
END_OF_SUB
$COMPILE{_prop_navbar} = __LINE__ . <<'END_OF_SUB';
sub _prop_navbar {
my $self = shift;
# Get the variables that need to be preserved and generate urls for them.
my $preserve_hash = $self->preserve();
my $preserve = '';
foreach my $p (keys %$preserve_hash) {
$preserve .= qq|&$p=$preserve_hash->{$p}|;
}
my @vals = GT::CGI->param('db');
my $url = GT::CGI->url({ query_string => 0 }) . "?";
foreach my $val (@vals) {
$url .= "db=" . GT::CGI->escape($val) . "&";
}
chop $url;
return qq~
~;
}
END_OF_SUB
##
# $self->_search_options;
# ---------------
# Returns the search options.
##
$COMPILE{_search_options} = __LINE__ . <<'END_OF_SUB';
sub _search_options {
my $self = shift;
my $opts = shift;
if ($self->{search_options}) {
if (ref $self->{search_options} eq 'CODE') {
return $self->{search_options}->($self, $opts);
}
else {
return $self->{search_options};
}
}
# First, figure out the sort by columns.
my $c = $self->{table}->cols;
my ($hash, $order) = ({}, []);
foreach my $col (sort {
defined $c->{$a}->{pos} or warn "No pos for $a\n";
defined $c->{$b}->{pos} or warn "No pos for $b\n";
$c->{$a}->{'pos'} <=> $c->{$b}->{'pos'}
} keys %$c) {
$hash->{$col} = $c->{$col}->{form_display} || $col;
push @$order, $col;
}
my $sb = $self->{html}->select(
{
name => "sb",
values => $hash,
sort_order => $order,
default => $self->{cgi}->{sb},
blank => 1
}
);
my $so = $self->{html}->select(
{
name => "so",
values => {
'ASC' => 'Ascending',
'DESC' => 'Descending'
},
default => $self->{cgi}->{sb},
blank => 1
}
);
my $dr = $self->{html}->select(
{
name => "dr",
values => {
'' => 'As Elements',
'rows' => 'As Rows'
},
default => $self->{cgi}->{dr},
blank => 1
}
);
# Then set the rest of the form options.
my $ma = exists $self->{cgi}->{ma} ? 'CHECKED' : '';
my $mh = exists $self->{cgi}->{mh} ? $self->{cgi}->{mh} : 25;
my $kw = exists $self->{cgi}->{keyword} ? $self->{cgi}->{keyword} : '';
my $idx = exists $self->{cgi}->{indexed} ? $self->{cgi}->{indexed} : '';
my $out = qq~
~;
return $out;
}
END_OF_SUB
##
# $self->_start_form;
# -------------------------
# Display the opening form tag.
##
$COMPILE{_start_form} = __LINE__ . <<'END_OF_SUB';
sub _start_form {
my $self = shift;
my $opts = shift || {};
my $meth = exists $opts->{method} ? $opts->{method} : 'POST';
my $attrib = shift || {};
# If a code ref was specified execute it and return the output to be printed
if ($self->{start_form}) {
if (ref $self->{start_form} eq 'CODE') {
return $self->{start_form}->($self, $opts, $meth);
}
else {
return $self->{start_form};
}
}
# Get the variables that need to be preserved and generate hidden tags for them.
my $preserve = $self->preserve();
my $hidden_tags = '';
foreach my $p (keys %$preserve) {
$hidden_tags .= qq||;
}
my $out = ''; my @vals;
my $url = GT::CGI->url({ query_string => 0 });
my $att = ' ';
$attrib->{name} ||= 'admin';
foreach (keys %{$attrib}) { $att .= qq|$_="$attrib->{$_}" | }
foreach my $key (keys %$opts) {
next if ($key eq 'method');
my $val = $opts->{$key};
(ref $val eq 'ARRAY') ? (@vals = @$val) : (@vals = ($val));
foreach my $val2 (@vals) {
$self->{html}->escape(\$val2);
$out .= qq~~;
}
}
my $mimeenc = $self->{table}->_file_cols() ? 'enctype="multipart/form-data"' : '';
return qq~\n";
}
END_OF_SUB
##
# $self->_start_html;
# -------------------------
# Display the opening form tag.
##
$COMPILE{_start_html} = __LINE__ . <<'END_OF_SUB';
sub _start_html {
my $self = shift;
my $opts = shift || {};
if ($self->{start_html}) {
if (ref $self->{start_html} eq 'CODE') {
return $self->{start_html}->($self, $opts);
}
else {
return $self->{start_html};
}
}
my $title = exists $opts->{title} ? $opts->{title} : '';
my $body = exists $opts->{body} ? $opts->{body} : $BODY;
return qq~\n
Maximum Hits:
Match Any:
Keyword Search:
Indexed Search:
~;
if ( ( () = $self->{in}->param('db') ) == 1 ) {
$out .= qq~
Sort By:
$sb
Using:
$so
~;
}
if (exists $opts->{modify_mult} and $opts->{modify_mult}) {
$out .= qq~
Display Records:
$dr
~;
}
$out .= qq~
Modify Multiple:
~;
}
END_OF_SUB
$COMPILE{_index_list} = __LINE__ . <<'END_OF_SUB';
sub _index_list {
my ($self, $column) = @_;
my $indexed = $self->{cgi}->{index} || 'none';
if ($column and ! $self->{cgi}->{index}) {
$indexed =
$self->{table}->_is_indexed($column) ? 'regular' :
$self->{table}->_is_unique($column) ? 'unique' :
$self->{table}->_is_pk($column) ? 'primary' :
'none';
}
if ($column and $indexed eq 'primary') {
return "Primary Key";
}
my $output = '";
return $output;
}
END_OF_SUB
$COMPILE{_index_type} = __LINE__ . <<'END_OF_SUB';
sub _index_type {
my ($self, $column) = @_;
my $indexed = 'none';
if ($column) {
$self->{table}->_is_indexed($column) and ($indexed = 'regular');
$self->{table}->_is_unique($column) and ($indexed = 'unique');
$self->{table}->_is_pk($column) and ($indexed = 'primary');
}
return $indexed;
}
END_OF_SUB
1;
__END__
=head1 NAME
GT::SQL::Admin - instant admin for any sql table.
=head1 SYNOPSIS
my $cgi = new GT::CGI;
my $db = new GT::SQL '/path/to/def';
my $admin = new GT::SQL::Admin;
if ($admin->for_me($cgi)) {
$admin->process(db => $db, cgi => $cgi);
}
=head1 DESCRIPTION
GT::SQL::Admin provides an easy way to build a table/relation
management application. It provides all the HTML and code to
easily:
1. Add records
2. Delete records
3. Modify records
4. Search records
5. Add columns
6. Drop columns
7. Alter table properties
8. Import data
9. Export data
all in about 6 lines of code.
=head2 Usage
To use GT::SQL::Admin you need to pass in an existing
L