";
############
# START FORM
############
# write a form to get a user input
print $query->startform();
# NOTE:
# here is a default for the date (bad thing, is, as written it can not be overridden
# by the user on the web form
# get the date from the unix system - may differ from system to system
$date = `/usr/bin/date/`;
# set the value of date in the query object
$query ->param ('date', $date);
# open a file and read in the information to create customized menus
# THE MINE_PREFERENCES file is defined by these rules:
# all entries separated by || (record separator)
# the first entry on each line is a variable and can have no spaces, other entries can
# value of button || descriptive line to go on menu
undef(@prefs);
# open the MINE_Preferences file first: this is the one that might be edited
# if it can't be found, open the default file MINE_Preferences.default
&check_pref_default();
print $message; # returned from CGI-MINE.pl
open (IN, "$pref_file") || die "Sorry, can't open the file $pref_file for reading: $!";
LINE: while ($line = See the preferences for creating this menu in the preferences file: $source";
foreach $prefs (@prefs) {
@button_value = split(/\|\|/, $prefs);
$menu_desc = @button_value[1];
$button_value = @button_value[0];
print " $menu_desc: ";
# by default pref file should have two fields
# by default a textfield is printed to screen
# if any third field is specified, a text area
# is made instead which allows a larger text
# entry to be made
# in the future this third entry could be used
# to allow real customization of the form
if ($button_value[2]) {
print $query->textarea(-name=>$button_value,
-rows=>20,
-columns=>100);
} else {
print $query->textfield(-name=>$button_value,
-size=>50,
-maxlength=>500);
}
}
# put a paragraph break between pieces of the form
print " ";
# get the sequence from user
print "Sequence: ";
# NOTE:
# For the file to be appear in the database log (in other scripts)
# it should have a unique extension to the file name
# for instance you should think about appending ".db" to
# each file so later you can pick up all the file with
# the following line of code @files = <*.db>;
# Here's where to ask for the file name to save the submission in
# note the use of a default file name SBW00 - this can be changed to anything and overridden
# by the user from the web form - better way of doing defaults than the way above!
print " Filename for submission: ",$query->textfield('savefile'),"\n";
print " .db (extension will be added automatically) ";
print $query->submit('action','submit');
# print a 'clear' button at end of form: script self-calls
print $query->defaults('Clear');
&table_bottom();
print $query->endform();
#################
# END FORM
#################
#################
# PROCESS FORM
################
# get the values
# check if an input sequence has been submitted (if not, undef $seq)
$seq = $query ->param(seq) || undef;
# check if the action button is 'submit'
$action = $query->param('action');
########
# IF BUTTON CLICKED is SUBMIT
########
if ($action eq "submit") {
# run a check on the sequence - allow no spaces, and no non-alphanumeric characters in
&table_top();
if (!$write_permission) {
print "Sorry you do not have permission to write the database. File was not created ";
} else {
$seq =~ tr/a-z/A-Z/;
# take out all spaces, allow only the letters A-Z
$seq =~ tr/A-Z//cd;
# put the $seq back into the $query object so it can be written to file
$query ->param('seq', '$seq');
# delete any parameters from the $query we don't want to be written to the file
$query->param(-name=>'action', -value=>'');
# put the $seq back into the $query object so it can be written to file
$query ->param('seq', $seq);
# and save the query (new entry) to file
&save_parameters($query);
$savefile = $query->param('savefile');
# print out the actual file that has been written! so the user can check it
open (IN, "$savefile.db") || die "can't reopen the database file $savefile.db: $!";
print "
";
print $query->textarea(-name=>'seq',
-rows=>10,
-columns=>60
);
# put a paragraph break between pieces of the form
print "";
while (
";
} # end if write permission save file
&table_bottom();
} # end if submit
#################
# END PROCESS FORM
################
# PRINT BOTTOM OF EACH WEB PAGE
# if $show_source is set to 1 show a link
# at the bottom of each script to the source
# code - pass the name of this script to the
# function in CGI-MINE.pl
if ($show_source) {
$script_name = $query->script_name();
&source ($script_name);
}
# ATTACH the MINE copywrite
&mine_cp;
print $query->end_html;
#################
# END WEBPAGE
#################
#####################
# FUNCTIONS
#####################
sub save_parameters {
local($query) = @_;
local($filename) = &clean_name($query->param('savefile'));
if (open(FILE,">$filename.db")) {
$query->save(FILE);
close FILE;
print "The file $filename.db has been submitted to the database\n";
} else {
print "Error: couldn't write to file $filename: $!\n";
}
}
# not used in this script, allows restoration of any saved file if you make a button
# that send the value edit down (if edit then the function is called (see above)
sub restore_parameters {
local($query) = @_;
local($filename) = &clean_name($query->param('savefile'));
if (open(FILE,$filename)) {
$query = new CGI(FILE); # Throw out the old query, replace it with a new one
close FILE;
print "Information for editing has been restored from file $filename\n";
} else {
print "Error: couldn't restore file $filename: $!\n";
}
return $query;
}
# Very important subroutine -- get rid of all the naughty
# metacharacters from the file name. If there are, we
# complain bitterly and die.
sub clean_name {
local($name) = @_;
unless ($name=~/^[\w\._-]+$/) {
print "$name has naughty characters. Only ";
print "alphanumerics are allowed. You can't use absolute names.";
die "Attempt to use naughty characters";
}
return $name;
}