# ================================================================== # Gossamer Threads Module Library - http://gossamer-threads.com/ # # GT::SQL::Admin # Author : Scott Beck # $Id: Admin.pm,v 1.133 2002/09/20 19:29:50 aki Exp $ # # Copyright (c) 2000 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.133 $ =~ /(\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; } ## # 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, $msg) = @_; 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'); if ( not ( $table_name and $id and $cn ) ) { print $in->header(); print $self->_start_html( { title => 'Error Downloading' } ); print $self->_header ( "Unknown Document Refence", $@ ); print $self->_end_html; return; } require GT::SQL::File; my $tbl = $self->{table}; my ( $fh, $size ); if ( $src eq 'db' ) { eval { $fh = $tbl->file_info( $cn, $id ); }; if ($fh) { $fname = $fh->File_Name(); $size = $fh->File_Size(); } } else { require GT::SQL::File; require GT::MIMETypes; eval { $fh = GT::SQL::File->open($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 file file pointed to by ID: $id and Column: $cn"); print $self->_end_html; } else { print $self->{in}->header( '-type' => 'application/download', '-Content-Length' => $size, '-Content-Transfer-Encoding' => 'binary', '-Content-Disposition' => \"attachment; filename=$fname" ); $fh->File_Binary() and binmode STDOUT; while (read ($fh, my $buffer, 4096)) { print $buffer; } } } END_OF_SUB $COMPILE{view_file} = __LINE__ . <<'END_OF_SUB'; sub view_file { my ($self, $msg) = @_; 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'); if ( not ( $table_name and $id and $cn ) ) { print $in->header(); print $self->_start_html( { title => 'Error Downloading' } ); print qq~Unknown document reference~; print $self->_end_html; return; } my $tbl = $self->{table}; my ( $fh, $mimetype, $size ); 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; require GT::MIMETypes; eval { $fh = GT::SQL::File->open($fname) }; $mimetype = GT::MIMETypes->guess_type($fname); $fname = GT::SQL::File::get_filename($fname); } if (!$fh) { print $in->header(); print $self->_start_html( { title => 'Error Viewing' } ); print $self->_header ( "Error Viewing File", $@ || "Cannot file file pointed to by ID: $id and Column: $cn"); print $self->_end_html; } else { print $self->{in}->header( '-type' => $mimetype, '-Content-Length' => $size, '-Content-Disposition' => \"inline; filename=$fname" ); $fh->File_Binary() and binmode STDOUT; while (read ($fh, my $buffer, 4096)) { print $buffer; } } } END_OF_SUB # ================================================================================ # # 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!

!; print "", $self->{html}->display_row_cols({ mode => 'search_results' }), ""; my $i = 0; while (my $result = $sth->fetchrow_hashref) { print "", $self->{html}->display_row ( { mode => 'search_results', values => $result }), ""; } print "
"; } else { while (my $result = $sth->fetchrow_hashref) { print "

", $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

  • /g; $self->add_form (""); } } END_OF_SUB ## # $obj->add_success; # ------------------ # This will print the success page after adding a # record. ## $COMPILE{add_success} = __LINE__ . <<'END_OF_SUB'; sub add_success { my ($self, $id) = @_; print $self->{in}->header; my $hsh; if ($self->{table}->ai) { $hsh = $self->{table}->get ($id, 'HASH'); } else { my $lookup = {}; my $pk = $self->{table}->pk; foreach (@$pk) { $lookup->{$_} = $self->{cgi}->{$_}; } $hsh = $self->{table}->get ($lookup, 'HASH'); } print $self->_start_html ( { title => "Record Added" }); print $self->_header ("Record Added", "The following record was successfully added:"); print "

    "; 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') eq 'rows' ) { print qq!

    !; print "", $self->{html}->display_row_cols({ mode => 'search_results' }), ""; while (my $result = $sth->fetchrow_hashref) { foreach my $key (@pk) { if ($self->{table}->can ('_complete_name')) { my $new = {}; for (keys %{$result}) { $new->{$self->{table}->_complete_name ($_)} = $result->{$_}; } $result = $new; } my $val = $result->{$key}; $self->{html}->escape(\$val); print qq~~; } print ""; print qq~~; print $self->{html}->display_row ( { mode => 'search_results', values => $result }), ""; print qq~~; $i++; } print "
    Delete
    \n"; } else { while (my $result = $sth->fetchrow_hashref) { foreach my $key (@pk) { if ($self->{table}->can('_complete_name')) { my $new = {}; for (keys %{$result}) { $new->{$self->{table}->_complete_name($_)} = $result->{$_}; } $result = $new; } my $val = $result->{$key}; $self->{html}->escape(\$val); print qq~~; } print qq~

    ~; print $self->{html}->display ( { mode => 'delete_search_results', values => $result } ); print "
    \n"; $i++; } } print $speedbar if ($speedbar); print < 2; # Only print the Check All box if there is more than one thing to check

    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_row_cols({ mode => 'search_results' }), ""; while (my $result = $sth->fetchrow_hashref) { foreach my $key (@pk) { if ($self->{table}->can('_complete_name')) { my $new = {}; for (keys %{$result}) { $new->{$self->{table}->_complete_name($_)} = $result->{$_}; } $result = $new; } my $val = $result->{$key}; $self->{html}->escape(\$val); print qq~~; } print ""; print qq~~; print $self->{html}->display_row ( { mode => 'modify_search_results', values => $result } ); print "\n"; $i++; } print "
    Modify
    \n"; } else { while (my $result = $sth->fetchrow_hashref) { foreach my $key (@pk) { if ($self->{table}->can('_complete_name')) { my $new = {}; for (keys %{$result}) { $new->{$self->{table}->_complete_name($_)} = $result->{$_}; } $result = $new; } my $val = $result->{$key}; $self->{html}->escape(\$val); print qq~~; } print qq~

    ~; print $self->{html}->display ( { mode => 'modify_search_results', values => $result } ); print "
    \n"; $i++; } }; print $speedbar if ($speedbar); 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 = {}; my $pk = $self->{table}->pk; foreach (@$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(

    ); print $self->_start_form ( { do => "delete_records", db => $self->{cgi}->{db} }, { name => 'admin_delete' } ); print qq(
    ); for (@pk) { print qq(); } print qq( ); print qq(
    ); print $self->_end_form; print "

    ", $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 = {}; foreach ($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

  • /g; return $self->modify_form (""); } } END_OF_SUB ## # $obj->modify_success; # --------------------- # Returns the success form after someone modifies # a record. ## $COMPILE{modify_success} = __LINE__ . <<'END_OF_SUB'; sub modify_success { my $self = shift; print $self->{in}->header; my $lookup = {}; 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; } foreach (@pk) { $lookup->{$_} = $self->{cgi}->{$_} if (exists $self->{cgi}->{$_}); } my $rec = $self->{table}->get($lookup, 'HASH'); if (! $rec) { return $self->modify_error ("The record you attempted to modify could not be found."); } print $self->_start_html ( { title => "Record Modified" }); print $self->_header ("Record Modified", "The following record was successfully updated:"); print "

    "; 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; my $pk = $self->{table}->pk; 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 "
    \n"; $i++; } print $speedbar if ($speedbar); 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

  • /g; $errors->{$rec_num} = "
  • $error"; } $errcode->{$rec_num} = $GT::SQL::errcode if ($GT::SQL::errcode); } } # Return the results page with the proper arguments depending on if we got an error or not. return (keys %{$errors}) ? $self->modify_multi_results ($rec_modified, $errors, $errcode) : $self->modify_multi_results ($rec_modified); } END_OF_SUB ## # $obj->modify_multi_results ($num_modified); # ------------------------------------------- # This will return the results page after the user modifies # the record from the modify_multi_form. $num_modified is the # number of records that were modified. # # $obj->modify_multi_results ($num_modified, \%not_modified, \%error_codes); # ----------------------------------------------------------- # This is how you handle errors. The first argument is the number # of records that were modified. The second is a hash ref of primary # keys to reasons the message was not modified. If there is more than # one column that makes up the primary key they should be flatened # to a comma separated list of keys in the proper order. ## $COMPILE{modify_multi_results} = __LINE__ . <<'END_OF_SUB'; sub modify_multi_results { my ($self, $num_modified, $errors, $errcodes) = @_; my ($ok_out, $error_out) = ('', ''); $errcodes ||= {}; # Lets get our error records if we messed up. if ($errors) { my @cond = (); $error_out = $self->_header ("Modify Failed", "The following record(s) were not modified successfully. Please correct the errors and submit again."); $error_out .= $self->_start_form ( { do => 'modify_multi_records', db => $self->{cgi}->{db} }); my $cols = $self->{table}->cols; foreach my $rec (keys %$errors) { my $values = {}; if ($errcodes->{$rec} eq 'NORECMOD') { foreach my $col (keys %$cols) { $values->{$col} = $self->{cgi}->{"$rec-$col"}; } $error_out .= qq~

    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~
    \n~; } elsif ($errcodes->{$rec} eq 'ALREADYCHANGED') { my $lookup = {}; foreach ($self->{table}->pk) { $lookup->{$_} = $self->{cgi}->{"$rec-$_"}; } my $result = $self->{table}->get($lookup, 'HASH'); foreach (keys %$result) { $values->{$_} = $result->{$_}; } $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~
    \n~; } else { $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~
    \n~; } } $error_out .= "

    " . $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}->{$_} = ''; } next unless (ref ($self->{cgi}->{$_}) eq 'ARRAY'); $self->{cgi}->{$_} = join ($GT::SQL::Display::HTML::INPUT_SEPARATOR, sort (@{$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; # 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 Maintenace: $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}) ? "Index Weight" : ''; if ($show_weight_h) { $show_weight_h = qq~Search
    Weight
    ~; } else { $show_weight_h = ''; } print qq~

    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.

    $show_weight_h ~; my %cols = %{$self->{table}->cols}; foreach my $column ($self->{table}->ordered_columns) { my %attribs = %{$cols{$column}}; $attribs{pos} ||= ' '; $attribs{type} ||= ' '; $attribs{not_null} ||= ' '; $attribs{default} ||= ' '; $attribs{form_display} ||= ' '; $attribs{form_type} ||= 'TEXT'; $attribs{regex} ||= ' '; if ($show_weight_h) { $attribs{weight} ||= ' '; $show_weight_h = qq~~; } ($attribs{not_null} eq '1') ? ($attribs{not_null} = "Yes") : ($attribs{not_null} = "No"); print qq~ ~; if ($attribs{protect}) { print qq~~; } else { print qq~~; } print qq~ $show_weight_h ~; } print qq~
    Position Column
    Name
    Column
    Type
    Not
    Null
    Default Form
    Display
    Form
    Type
    Form
    Regex
    $attribs{weight}
    $attribs{pos}$column$column$attribs{type}~; print "($attribs{size})" if ($attribs{size}); print "(" . join (", " => @{$attribs{values}}) . ")" if ($attribs{values} and (ref $attribs{values})); print qq~ $attribs{not_null} $attribs{default} $attribs{form_display} $attribs{form_type} $attribs{regex}

    Database Information
    Indexing Scheme


    ~; print $self->_prop_navbar; print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB $COMPILE{edit_table_def} = __LINE__ . <<'END_OF_SUB'; sub edit_table_def { # ------------------------------------------------------------------- my $self = shift; my $in = $self->{in}; # handle the indexing scheme my $e = $self->{db}->editor( $in->param('db') ); $e->change_search_driver( $in->param('search_driver') ) or return $GT::SQL::error; return; } END_OF_SUB $COMPILE{editor_columns} = __LINE__ . <<'END_OF_SUB'; sub editor_columns { # ------------------------------------------------------------------- # Form to modify a selected column. # my ($self, $msg) = @_; print $self->{in}->header; $msg &&= qq|$msg|; my $table = $self->{record}; my $column = $self->{cgi}->{modify}; my %cols = $self->{table}->cols; my %attribs = %{$cols{$column}}; my $url = GT::CGI->url ({ query_string => 0 }); exists $cols{$column} or return $self->editor_table_form ("Column ($column) does not exist in table" . $self->{table}->name); # Print the intro. print $self->_start_html ( { title => "Edit $column Column Definition" }); print $self->_header ("Table Editor", $msg || "Edit $column Column Definition"); print $self->_start_form ( { do => 'editor_modify_columns', db => $self->{cgi}->{db}, modify => $column }); print qq~

    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 /(?:\n|\r)+/, $self->{cgi}->{form_names}]; $attribs{form_values} = [split /(?:\n|\r)+/, $self->{cgi}->{form_values}]; $attribs{values} = [split /(?:\n|\r)+/, $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 .= "

  • This table already has a primary key."; } $errors and return $self->editor_columns (""); # Add/Drop indexes. my $index_type = $self->_index_type($column); if ($index_type ne $self->{cgi}->{index}) { if ($index_type eq 'none') { if ($self->{cgi}->{index} eq 'regular') { $editor->add_index ( $column . "_idx" => [$column] ); } else { $editor->add_unique ( $column . "_idx" => [$column] ); } } elsif ($self->{cgi}->{index} eq 'none') { if ($index_type eq 'regular') { my $index = $self->{table}->index; INDEX: foreach my $index_name (keys %$index) { foreach my $col_name (@{$index->{$index_name}}) { next unless ($col_name eq $column); $editor->drop_index ($index_name) or return $self->editor_columns ($GT::SQL::error); last INDEX; } } } else { my $unique = $self->{table}->unique; INDEX: foreach my $unique_name (keys %$unique) { foreach my $col_name (@{$unique->{$unique_name}}) { next unless ($col_name eq $column); $editor->drop_unique ($unique_name) or return $self->editor_columns ($GT::SQL::error); last INDEX; } } } } } # Make the changes delete $attribs{column}; $editor->alter_col ($column, \%attribs) or return $self->editor_columns ($editor->error); return $self->editor_table_form ("$column has been updated!"); } END_OF_SUB $COMPILE{editor_column_form} = __LINE__ . <<'END_OF_SUB'; sub editor_column_form { # ------------------------------------------------------------------- # Displays an Add/Modify column form. # my ($self, $attribs, $index_list, $mode) = @_; my $output = qq~
    ~; if ($mode eq 'add') { $output .= qq~ ~; } else { $output .= qq~ ~; }; my $match = 0; foreach (qw/INT CHAR TEXT DATE ENUM/) { if ($attribs->{type} eq $_) { $match = 1; last; } } my $extra = ''; if (! $match) { $extra = " ~; # Only display Search Weight form if this table has a search weight set. my %weights = $self->{table}->weight; my $show_weight = 0; foreach (keys %weights) { $weights{$_} and $show_weight++; } if ($show_weight) { $output .= qq~~; } $output .= qq~
    Database Information
    Column Name
    Database Information
    WARNING: If you change a field's type, data in that field may be lost. Also, if you alter one of the system fields, it may render your system inoperable.
    Column Name$attribs->{column}
    Column Type
    Column Index
    Column Size
    (Only for CHAR types)
    Column Values
    (Only for ENUM types)
    Not Null Yes{not_null}); $output .= qq~> No{not_null}); $output .= qq~>
    Default
    Form Information
    Form Display
    Form Type
    Form Size
    Form Names
    (Stored in Database)
    Only for checkbox, multi-select or radio forms.
    Form Values
    (Displayed on Form)
    Only for checkbox, multi-select or radio forms.
    File Save Location
    (Only for FILE types. Stored on disk)
    File Save URL
    (Only for FILE types)
    File Save Method
    (Only for FILE types)
    File Maximum Size
    (Only for FILE types.)
    Form Regex
    Search Weight

    ~; return $output; } END_OF_SUB $COMPILE{editor_column_checks} = __LINE__ . <<'END_OF_SUB'; sub editor_column_checks { # ------------------------------------------------------------------- # Check to make sure a column add/change is valid. # my ($self, $column, $attribs) = @_; my $errors = ''; # Remove attributes that don't make sense. ($attribs->{type} eq 'CHAR' or $attribs->{type} eq 'VARCHAR') or (delete $attribs->{size}); ($attribs->{type} eq 'ENUM') or (delete $attribs->{values}); ($attribs->{form_type} =~ /^(SELECT|MULTIPLE|CHECKBOX|RADIO)$/) or (delete $attribs->{form_names}); ($attribs->{form_type} =~ /^(SELECT|MULTIPLE|CHECKBOX|RADIO)$/) or (delete $attribs->{form_values}); ($attribs->{form_type} =~ /^(CHECKBOX|RADIO)$/) and (delete $attribs->{form_size}); ($attribs->{default} =~ /^\s*$/) and (delete $attribs->{default}); # Go through and weed out problem cases. if ($column !~ /^(\w+)$/) { $errors .= "
  • Column name '$column' is invalid. The column name can only contain letters, numbers and an underscore."; } if ($column =~ /^[\d_]/) { $errors .= "
  • Column name '$column' is invalid. Column names can not start with a number or an underscore."; } if (($attribs->{type} eq 'CHAR' or $attribs->{type} eq 'VARCHAR') and ($attribs->{size} > 255 or $attribs->{size} < 1)) { $errors .= "
  • Size '$attribs->{size}' is invalid. It must be between 1 and 255."; } if ($attribs->{type} eq 'ENUM') { unless (ref $attribs->{values} eq 'ARRAY' and @{$attribs->{values}} >= 1) { $errors .= "
  • You must specify the ENUM values in the 'Column Value' text area. Enter the value one perl line.
  • \n"; } if ($attribs->{default}) { my $ok = 0; foreach my $value(@{$attribs->{values}}) { $value eq $attribs->{default} and $ok++; } if (! $ok) { $errors .= "
  • Your default must match one of the listed ENUM values."; } } } if ($attribs->{form_type} =~ /^(SELECT|MULTIPLE|CHECKBOX|RADIO)$/) { if (! (@{$attribs->{form_names}} or @{$attribs->{form_values}}) ) { $errors .= "
  • For radio, checkbox and select forms, you must specify the names and the values in the two textarea boxes one per line. The names are what is stored in the database, and the values is what is displayed in the browser."; } else { if (@{$attribs->{form_names}} ne @{$attribs->{form_values}}) { $errors .= "
  • Make sure you have the same number of lines for Form Names as you do for Form Values."; } } } if ($attribs->{form_type} eq 'TEXTAREA') { if ($attribs->{form_size} =~ /^\s*(\d+)\s*,\s*(\d+)\s*$/) { $attribs->{form_size} = [$1, $2]; } else { $errors .= "
  • For TEXTAREA forms, please specify the size of the textarea as COLS,ROWS. For example, to have a 50 column, by 6 rows textarea box, you would enter 50,6 in the Form Size box."; } } if ($attribs->{form_type} eq 'FILE') { if ( $attribs->{file_save_in} ) { ( -e $attribs->{file_save_in} and -w $attribs->{file_save_in} ) or $errors .= "
  • File Save Location does not exist or is not writeable."; } else { $errors .= "
  • File Save Location must be set."; } if ( $attribs->{type} ne 'CHAR' ) { $errors .= "
  • Database column must be of CHAR type"; } } if (($attribs->{not_null} == 0) and ($self->{cgi}->{index} ne 'none')) { $errors .= "
  • A column must be defined as not null if you want to index it."; } if (($self->{cgi}->{index} ne 'none') and ($attribs->{type} eq 'TEXT')) { $errors .= "
  • You can not have an index on TEXT columns."; } return $errors; } END_OF_SUB $COMPILE{editor_add_field_form} = __LINE__ . <<'END_OF_SUB'; sub editor_add_field_form { # ------------------------------------------------------------------- # Displays a form to add a new column. # my ($self, $msg) = @_; print $self->{in}->header; $msg &&= qq|$msg|; my $table = $self->{record}; print $self->_start_html ( { title => "Table Editor: $table" }); # Set up defaults for the fields my %attribs = (); foreach my $def (qw/ column type not_null default form_display form_type form_size regex weight size form_names form_values values file_save_in file_save_scheme file_save_url file_max_size /) { $attribs{$def} = defined $self->{cgi}->{$def} ? $self->{cgi}->{$def} : ''; } $attribs{form_type} ||= 'TEXT'; my $url = GT::CGI->url ({ query_string => 0 }); print $self->_header ("Table Editor", $msg || "Add a New Field to $table"); print $self->_start_form ( { do => 'editor_add_field', db => $self->{cgi}->{db} }); print qq~

    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 /(?:\n|\r)+/, $self->{cgi}->{form_names}]; $attribs{form_values} = [split /(?:\n|\r)+/, $self->{cgi}->{form_values}]; $attribs{values} = [split /(?:\n|\r)+/, $self->{cgi}->{values}]; $attribs{pos} = keys (%cols) + 1; # Error checking my $errors = $self->editor_column_checks ($column, \%attribs, 'add'); if (exists $cols{$column}) { $errors .= "

  • Column '$column' already exists, please choose another name."; } if ($self->{cgi}->{index} eq 'primary') { $errors .= "
  • You can not add a primary key to an existing table."; } $errors and return $self->editor_add_field_form ("
      $errors
    "); # Add the column. delete $attribs{column}; $editor->add_col ($column, \%attribs) or return $self->editor_add_field_form ("Unable to add column '$column'. Reason: $GT::SQL::error"); # Add the indexes. if ($self->{cgi}->{index} eq 'regular') { $editor->add_index ($column . '_idx' => [$column]) or return $self->editor_add_field_form ("Unable to add index. Reason: $GT::SQL::error"); } if ($self->{cgi}->{index} eq 'unique') { $editor->add_unique ($column . '_udx' => [$column]) or return $self->editor_add_field_form ("Unable to add unique index. Reason: $GT::SQL::error"); } $self->{table}->reload; return $self->editor_table_form ("The database has been succesfully updated."); } END_OF_SUB $COMPILE{editor_delete_field_form} = __LINE__ . <<'END_OF_SUB'; sub editor_delete_field_form { # ------------------------------------------------------------------- # Displays a form to delete a column. # 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 || "Delete a Field from $table."); print $self->_start_form ( { do => 'editor_delete_field', db => $self->{cgi}->{db} }); print qq~

    WARNING: If you remove a field, all data in that field will be lost. Also, if you remove one of the system fields, certain functions may not work any more!

    ~; my @cols = grep !exists $self->{table}->{schema}->{cols}->{$_}->{protect}, $self->{table}->ordered_columns; if (@cols) { print qq~ Delete the following field:

    ~; } else { print qq<

    No columns can be deleted.

    >; } print qq~

    ~; print $self->_prop_navbar; print $self->_end_form; print $self->_footer; print $self->_end_html; } END_OF_SUB $COMPILE{editor_delete_field} = __LINE__ . <<'END_OF_SUB'; sub editor_delete_field { # ------------------------------------------------------------------- # Remove a field from the table. # 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 $table = $self->{cgi}->{db}; my $field = $self->{cgi}->{'delete-field'} || return $self->editor_delete_field_form ("Please select a field to delete!"); ($field eq 'ID') and return $self->editor_delete_field_form ("You can't remove the ID field."); # Drop the column from the database. $editor->drop_col ($field) or return $self->editor_delete_field_form ($GT::SQL::error); return $self->editor_delete_field_form ("The database has been successfully updated."); } END_OF_SUB $COMPILE{editor_update_def} = __LINE__ . <<'END_OF_SUB'; sub editor_update_def { # ------------------------------------------------------------------- # Re-sync the def file with what's in Mysql. # my $self = shift; # We need a creator for this. my $c = $self->{db}->creator($self->{table}->name); $c->load_table or return $self->editor_table_form ("Could not update def files reason $GT::SQL::error"); # Re Load our table object. $self->{table}->reload; return $self->editor_table_form ("The .def file has been re-synced."); } END_OF_SUB $COMPILE{editor_column_help} = __LINE__ . <<'END_OF_SUB'; sub editor_column_help { # -------------------------------------------------------- # Displays a help page for the editor. # my ($self, $msg) = @_; my $table = $self->{cgi}->{db}; print $self->{in}->header; print $self->_start_html; print $self->_header ("Table Editor", $msg || "Add/Edit Columns Help."); print $self->_start_form ( { do => 'editor_add_field', db => $self->{cgi}->{db} }); print qq~

    From here you can add a new column to your table $table. When creating your column, you should set the following options:

    • Column Name: This is the name of your column. It must be a valid SQL name, which is just letters, numbers and the underscore character. Also, try to avoid reserved words like FROM, SELECT, WHERE, JOIN, etc.
    • Column Type: This is the type of column you want to create. Your choices are:
      • INT: This stores integer numbers, i.e. 1, 2, 3. Whole numbers without decimal points.
      • CHAR: This stores any string up to a maxium size of 255. If you set a CHAR, you must set the maximum size in Column Size.
      • TEXT: This stores a (virtually) unlimited amount of text. Use this for storing very large amounts of texts.
      • DATE: This stores a date defaulting to yyyy-mm-dd format.
      • ENUM: This stores an enumerated list. This is useful when you want a field that can be one of several values. For example, you could create a Status column that can contain the values: 'Not Registered', 'Registered', 'Moderator', 'SuperUser'. The entries in this column must be one of the listed values. You specify what values you want using one line per entry in the Column Values field.
    • Column Index: This determins what sort of index the SQL server should use to speed up queries. If you use an index, you must set Not Null to Yes.
    • Column Size: This is only useful for CHAR types. It stores the maximum size a field can be and should range anywhere from 1 to 255.
    • Column Values: This is only useful for ENUM types. It stores the list of possible values, one per line.
    • Not Null: If you set this to Yes, then a value must be entered for this column. If you set this to No, then when you add a record, this column can be left blank.
    • Default: This is the default value that will be displayed when adding a record.
    • Form Type: This is the type of form to use when adding or modifying a record. Your choices are:
      • Hidden: This column will be hidden on the add and modify forms.
      • Select: A select list will be generated. For select lists, Form Size determines the size of the select list (set to 0 for a single select list, higher for multiple select lists). You should enter the values of the select list (what will be displayed to the user) in the Form Values textarea, and the data of the select list (what will be stored in the database) in the Form Names textarea.
      • Checkbox: This generates a set of checkboxes. You need to enter into Form Values a list of all the checkbox values (what will be displayed to the user), and in Form Names, a list of what will be stored in the database. The data is stored in the database joined on a new line.
      • Radio: This generates a radio option list. You must enter into Form Names the value that will be stored in the database, and in Form Values, the value that will be displayed.
      • Text: This generates a simple text box. You can set the size of text box using Form Size.
      • Textarea: This generates a textarea field. You can set the rows and columns to use in the Form Size by entering rows,cols (for example: 30,4).
      • Password: This generates a password box. You can set the size of password box using Form Size.
      • File: This creates a standard file field. You must set the File Save Location and set the database type to CHAR.
    • Form Size: This is only useful for select, text or textarea form types. For selects, set this to 0 to be a single select field, set it to a postive number to be a multi select field. For Text fields, set this to the size of the text box, for textarea types, set this to rows,cols to specify the size.
    • Form Names: This is only useful for Select, Checkbox or Radio types. This is what will be stored in the database. You should enter one value per line.
    • Form Values: This is only useful for Select, Checkbox or Radio types. This is what will be displayed to the user. You should enter one value per line.
    • File Save Location: Specifies in which directory where the the files are saved. Once you have set this, please try not to change the save path. If you must, do not move the existing files unless you are prepared to prepared to update your "@{[$self->{table}->name()]}_Files" table to reflect the move.
    • File Save URL: If this directory is accessibly by URL, specjfiy the base url here. This will allow retrieval of the full URL path to the file should you want to display the file for viewing or download.
    • File Save Method: Once this has been set, please do not change unless there are no files being handled by the system. This option sets how the files are to be stored in the directory. If you expect many files to be uploaded, the system will use a collection of different directories to store the files. This allows faster lookups for by the OS and experienced users will be able to "symlink" some of the directories to other harddrives to distribute the load.
    • File Maximum Size: Caps the maximum number of bytes of files users can upload.
    • Form Regex: This is a perl regular expression that data must match before being inserted or updated.
    • Search Weight: If this is set to a positive value, this field will be included in the search index. Note: you must rebuild the search index after changing/adding a search weight.

    ~; print "

    "; 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', enctype => 'multipart/form-data' }); 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:

    Use as delimiter. Delete old data first
     

    ~; print $self->_buttons ("Import Data into"); print "

    "; 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 = (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 eq '\t') and ($delim = "\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'. Reason: $!"); local $/; @lines = split /(?:\n|\r)+/, ; close FILE; } else { @lines = split /(?:\n|\r)+/, $text; } # Remove old data if requested. my $table = $self->{cgi}->{db}; if ($self->{cgi}->{'import-delete'}) { $self->{table}->delete_all; } # Do the import. $good_cnt = $err_cnt = 0; LINE: for my $line_num (0 .. $#lines) { ($err_cnt > 10) and last LINE; $line = $lines[$line_num]; @data = split /\Q$delim\E/, $line, -1; if ($#data != $#header) { $error .= "

  • " . ($line_num+2) . ": Row count: " . ($#data+1) . " does not match header count: (@data) (@header)" . ($#header+1) . "\n"; $err_cnt++; next LINE; } $i = 0; %record = map { $header[$i] => $data[$i++] } @data; if (!$self->{table}->add (\%record, 1)) { $error .= "
  • " . ($line_num+2) . ": Failed validation. Error:
      $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', enctype => 'multipart/form-data'}); print qq~

    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.
     

    Fields to Export
    ~; my @cols = $self->{table}->ordered_columns; print qq|

    ~; print qq|

     
    Export data to: filename:
    Use as delimiter.
    ~; print $self->_buttons ("Export Data from"); print "

    "; 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 = (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~
    $self->{record}: $head

    $self->{record}: $head

    $msg

    ~; } } END_OF_SUB ## # $self->_footer; # --------------- # Returns the footer to set for each form. ## $COMPILE{_footer} = __LINE__ . <<'END_OF_SUB'; sub _footer { my $self = shift; 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}: Add | Modify | Delete | Search ~; if (!exists $self->{table}->{tables}) { $ret .= qq~ | Properties ~; } $ret .= qq~
    ~; return $ret; } END_OF_SUB $COMPILE{_prop_navbar} = __LINE__ . <<'END_OF_SUB'; sub _prop_navbar { my $self = shift; 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~
    Properties: Add Column | Delete Column | Import Data | Export Data | Resync Database
    ~; } 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~
    ~; if ( ( () = $self->{in}->param('db') ) == 1 ) { $out .= qq~ ~; } if (exists $opts->{modify_mult} and $opts->{modify_mult}) { $out .= qq~ ~; } $out .= qq~
    Maximum Hits: Match Any:
    Keyword Search:
    Indexed Search:
    Sort By: $sb Using: $so
    Display Records: $dr
    Modify Multiple:
    ~; 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}; } } 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~

    $out\n~; } END_OF_SUB ## # $self->_end_form; # ------------------------- # Display the opening form tag. ## $COMPILE{_end_form} = __LINE__ . <<'END_OF_SUB'; sub _end_form { my $self = shift; if (defined $self->{end_form} and $self->{end_form}) { if (ref ($self->{end_form}) eq 'CODE') { return $self->{end_form}->($self); } else { return $self->{end_form}; } } return "
    \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$title: $self->{record}\n~; } END_OF_SUB ## # $self->_end_html; # ------------------------- # Display the opening form tag. ## $COMPILE{_end_html} = __LINE__ . <<'END_OF_SUB'; sub _end_html { my $self = shift; if ($self->{end_html}) { if (ref ($self->{end_html}) eq 'CODE') { return $self->{end_html}->($self); } else { return $self->{end_html}; } } return "\n\n"; } END_OF_SUB ## # $self->_buttons; # ------------------------- # Display closing table with form buttons. ## $COMPILE{_buttons} = __LINE__ . <<'END_OF_SUB'; sub _buttons { my $self = shift; my $name = shift; return qq~
    ~; } END_OF_SUB $COMPILE{_index_list} = __LINE__ . <<'END_OF_SUB'; sub _index_list { my ($self, $column) = @_; my $output = ''; my $indexed = $self->{cgi}->{index} || 'none'; if ($column and ! $self->{cgi}->{index}) { $self->{table}->_is_indexed($column) and ($indexed = 'regular'); $self->{table}->_is_unique($column) and ($indexed = 'unique'); $self->{table}->_is_pk($column) and ($indexed = 'primary'); } $output .= qq~