Here is the same code simplified, with no delete option for the user. See if this works for you, then changes can be made from that baseline...
add.cgi
# -------------
# Links
# -------------
# Links Manager
#
# File: add.cgi
# Description: Adds a record marked unvalidated to the database and
# optionally emails someone.
# Author: Alex Krohn
# Email: alex@gossamer-threads.com
# Web: http://www.gossamer-threads.com/
# Version: 2.01
#
# (c) 1998 Gossamer Threads Inc.
#
# This script is not freeware! Please read the README for full details
# on registration and terms of use.
# ======================================================================
#
# Setup Notes:
# Make sure the require statement below points to the config file.
# Required Librariers
# --------------------------------------------------------
eval {
($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX /
($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \
require "admin/links.cfg"; # Change this to full path to links.cfg if you have problems.
require "$db_lib_path/db_utils.pl";
require "$db_lib_path/links.def";
$build_use_templates ?
require "$db_lib_path/site_html_templates.pl" :
require "$db_lib_path/site_html.pl";
};
if ($@) {
print "Content-type: text/plain\n\n";
print "Error including libraries: $@\n[/url]";
print "Make sure they exist, permissions are set properly, and paths are set correctly.";
exit;
}
# ========================================================
eval { &main; }; # Trap any fatal errors so the program hopefully
if ($@) { &cgierr("fatal error: $@"); } # never produces that nasty 500 server error page.
exit; # There are only two exit calls in the script, here and in in &cgierr.
sub main {
# --------------------------------------------------------
# Check the referer.
if (@db_referers and $ENV{'HTTP_REFERER'}) { $found = 0;
foreach (@db_referers) {
$ENV{'HTTP_REFERER'} =~ /$_/i and $found++ and last;
}
if (!$found) {
print "Content-type: text/html\n\n";
print qq|<center> <font size="5" color="#FF0000"><b><u>NOTICE</u>:</b></font> <p> <b>You are attempting to execute this script from an unauthorized domain. <br>This script may only be executed from the '<font color="#FF0000">yournamehere.com</font>' domain.</b> </center>|;
exit;
}
}
# change next two lines for upload mod >
# local (%in) = &parse_form;
local (%in) = &parse_me_and_upload;
# We are processing the form.
if (keys %in != 0) {
&process_form;
}
# Otherwise we are displaying the form (in site_html.pl).
else {
if ($db_single_category) {
my %is_valid = map { $_ => 1 } &category_list;
$ENV{'HTTP_REFERER'} =~ s,/[^/]+\.[^/]+$,,;
$ENV{'HTTP_REFERER'} =~ m,$build_root_url/(.+?)/?$,;
$is_valid{$1} ? &site_html_add_form ($1) : &site_html_add_form ();
}
else {
&site_html_add_form ();
}
}
}
sub process_form {
# --------------------------------------------------------
# This will set system fields like Validated to their proper values.
foreach $key (keys %add_system_fields) {
$in{$key} = $add_system_fields{$key};
}
# Set date variable to today's date.
$in{$db_cols[$db_modified]} = &get_date;
open (ID, "<$db_links_id_file_name") or &cgierr("error in process_form. unable to open id file: $db_links_id_file_name. Reason: $!");
$in{$db_key} = <ID> + 1; # Get next ID number
close ID;
# Validate the form input..
$status = &validate_record(%in);
if ($status eq "ok") {
# Update the counter.
open (ID, ">$db_links_id_file_name") or &cgierr("error in get_defaults. unable to open id file: $db_links_id_file_name. Reason: $!");
flock(ID, 2) unless (!$db_use_flock);
print ID $in{$db_key}; # update counter.
close ID; # automatically removes file lock
# Print out the validate input to a "validation database" where it is stored until
# the admin decides to add it into the real database.
open (VAL, ">>$db_valid_name") or &cgierr("error in add_record. unable to open validate file: $db_valid_name. Reason: $!");
flock(VAL, 2) unless (!$db_use_flock);
print VAL &join_encode(%in);
close VAL; # automatically removes file lock
# Send the admin an email message notifying of new addition.
&send_email;
# Send the visitor to the success page.
&site_html_add_success;
}
else {
# upload mod >
unlink "$upload_path/$_" foreach @uploads;
# < upload mod
&site_html_add_failure($status);
}
}
sub send_email {
# --------------------------------------------------------
# Sends an email to the admin, letting him know that there is
# a new link waiting to be validated. No error checking as we don't
# want users to see the informative &cgierr output.
# Check to make sure that there is an admin email address defined.
$db_admin_email or &cgierr("Admin Email Address Not Defined in config file!");
my $to = $db_admin_email;
my $from = $in{$db_cols[$db_contact_email]};
my $subject = "Addition to Database: $in{'Title'}\n";
my $msg = qq|
The following link is awaiting validation:
Title: $in{'Title'}
URL: $in{'URL'}
Category: $in{'Category'}
Description: $in{'Description'}
Contact Name: $in{'Contact Name'}
Contact Email: $in{'Contact Email'}
Remote Host: $ENV{'REMOTE_HOST'}
Referer: $ENV{'HTTP_REFERER'}
To validate, please go to:
$db_script_url
Sincerely,
Links Manager.
|;
# Then mail it away!
require "$db_lib_path/Mailer.pm";
my $mailer = new Mailer ( { smtp => $db_smtp_server,
sendmail => $db_mail_path,
from => $from,
subject => $subject,
to => $to,
msg => $msg,
log => $db_mailer_log
} ) or return;
$mailer->send or return;
}
# upload mod >
sub parse_me_and_upload {
#-------------------------------------
use CGI qw(:standard);
my (%in);
my ($fnum,$file_field,$file_name,$ext,$bytes_count,$size,$buff);
my ($num)=1;
my ($IN) = new CGI;
# create a hash for all input - name => value
for ($IN->param) { $in{$_} = $IN->param($_) }
# loop through the input
for (keys %in) {
# if the field name matches File(DIGIT) this is a file upload field...
if (/^(Image_\d*)$/i) {
# establish and number associative files in array
# $in{$file_field} = name of file being uploaded from form.
# $1 = Form element name ie. File1
# Increment the form element counter
$fnum = $num++;
# do some stuff that I've yet to understand.
$file_field = $1;
$in{$file_field} =~ /([^\/\\]+)$/ and $file_name = $1;
# If the File(X) field is empty
if (length($in{$file_field}) < 1 ) {
# just to copy the value of File(X)Transfer
# into $in{$file_field}. This will either be an empty string or
# the previously uploaded filename.
$in{$file_field} = "$in{'File' . $fnum . 'Transfer'}";
# Other wise the File(x) form upload element has something in it.
}
else{
# So first remove any previously uploaded files in that file(x) position
if (length($in{'File' . $fnum . 'Transfer'}) > 1) {
unlink "$upload_path/$in{'File' . $fnum . 'Transfer'}";
}
# Now let's go ahead and upload that new file
# Append Link ID instead of random number >
$file_name = $in{$db_key} . _ . $file_name; # Prevent files being overwritten by appending Link ID
# < changed to append Link ID
$filename =~ tr/ /_/; #replace space with underscore
open U, ">$upload_path/$file_name" or &cgierr("Can't open $upload_path/$file_name : $!");
binmode U; # needed for Windows servers
while ($bytes_count = read($in{$file_field},$buff,2096)) {
$size += $bytes_count;
print U $buff;
}
close U;
$in{$file_field} = $file_name;
# create an array of upload fields so we can unlink if there's a booboo
push @uploads, $in{$file_field}
}
}
}
# return the %in hash as normal
return %in
}
# < upload mod
Links.def
(change field numbers as required)
Image_1 => [33, 'alpha', 0, 150, 0, '', '^[^\.]+\.(gif|GIF|jpg|JPG)$'],
# Field Number of some important fields. The number is from %db_def above
# where the first field equals 0.
$db_image_1 = 33;
add.html template
<dt>Photo:</dt><dd><input name="Image_1" type="file" value="" size="30" /><input type="hidden" name="Image_1" value="<%Image_1%>" /></dd>
detailed.html template (or could be link.html template)
<img src="$image" height="$height" width="$width" alt="<%Title%>" />
<%endif%>
links.cfg
# --------------------------------------------------------
# PATH and URL of Upload (image) Folder
$build_upload_path = "$build_root_path/pics";
$build_upload_url = "$build_root_url/pics";
# -------------------------------------------------------------
# Extra Paths -- unless you feel the need to rename files, you
# can leave this as is.
# -------------------------------------------------------------
# image upload mod >
# Upload
$upload_path = "$build_root_path/pics";
$upload_url = "$build_root_url/pics";
# < image upload mod
Leonard
aka PerlFlunkie
add.cgi
Code:
#!/usr/local/bin/perl # -------------
# Links
# -------------
# Links Manager
#
# File: add.cgi
# Description: Adds a record marked unvalidated to the database and
# optionally emails someone.
# Author: Alex Krohn
# Email: alex@gossamer-threads.com
# Web: http://www.gossamer-threads.com/
# Version: 2.01
#
# (c) 1998 Gossamer Threads Inc.
#
# This script is not freeware! Please read the README for full details
# on registration and terms of use.
# ======================================================================
#
# Setup Notes:
# Make sure the require statement below points to the config file.
# Required Librariers
# --------------------------------------------------------
eval {
($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX /
($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \
require "admin/links.cfg"; # Change this to full path to links.cfg if you have problems.
require "$db_lib_path/db_utils.pl";
require "$db_lib_path/links.def";
$build_use_templates ?
require "$db_lib_path/site_html_templates.pl" :
require "$db_lib_path/site_html.pl";
};
if ($@) {
print "Content-type: text/plain\n\n";
print "Error including libraries: $@\n[/url]";
print "Make sure they exist, permissions are set properly, and paths are set correctly.";
exit;
}
# ========================================================
eval { &main; }; # Trap any fatal errors so the program hopefully
if ($@) { &cgierr("fatal error: $@"); } # never produces that nasty 500 server error page.
exit; # There are only two exit calls in the script, here and in in &cgierr.
sub main {
# --------------------------------------------------------
# Check the referer.
if (@db_referers and $ENV{'HTTP_REFERER'}) { $found = 0;
foreach (@db_referers) {
$ENV{'HTTP_REFERER'} =~ /$_/i and $found++ and last;
}
if (!$found) {
print "Content-type: text/html\n\n";
print qq|<center> <font size="5" color="#FF0000"><b><u>NOTICE</u>:</b></font> <p> <b>You are attempting to execute this script from an unauthorized domain. <br>This script may only be executed from the '<font color="#FF0000">yournamehere.com</font>' domain.</b> </center>|;
exit;
}
}
# change next two lines for upload mod >
# local (%in) = &parse_form;
local (%in) = &parse_me_and_upload;
# We are processing the form.
if (keys %in != 0) {
&process_form;
}
# Otherwise we are displaying the form (in site_html.pl).
else {
if ($db_single_category) {
my %is_valid = map { $_ => 1 } &category_list;
$ENV{'HTTP_REFERER'} =~ s,/[^/]+\.[^/]+$,,;
$ENV{'HTTP_REFERER'} =~ m,$build_root_url/(.+?)/?$,;
$is_valid{$1} ? &site_html_add_form ($1) : &site_html_add_form ();
}
else {
&site_html_add_form ();
}
}
}
sub process_form {
# --------------------------------------------------------
# This will set system fields like Validated to their proper values.
foreach $key (keys %add_system_fields) {
$in{$key} = $add_system_fields{$key};
}
# Set date variable to today's date.
$in{$db_cols[$db_modified]} = &get_date;
open (ID, "<$db_links_id_file_name") or &cgierr("error in process_form. unable to open id file: $db_links_id_file_name. Reason: $!");
$in{$db_key} = <ID> + 1; # Get next ID number
close ID;
# Validate the form input..
$status = &validate_record(%in);
if ($status eq "ok") {
# Update the counter.
open (ID, ">$db_links_id_file_name") or &cgierr("error in get_defaults. unable to open id file: $db_links_id_file_name. Reason: $!");
flock(ID, 2) unless (!$db_use_flock);
print ID $in{$db_key}; # update counter.
close ID; # automatically removes file lock
# Print out the validate input to a "validation database" where it is stored until
# the admin decides to add it into the real database.
open (VAL, ">>$db_valid_name") or &cgierr("error in add_record. unable to open validate file: $db_valid_name. Reason: $!");
flock(VAL, 2) unless (!$db_use_flock);
print VAL &join_encode(%in);
close VAL; # automatically removes file lock
# Send the admin an email message notifying of new addition.
&send_email;
# Send the visitor to the success page.
&site_html_add_success;
}
else {
# upload mod >
unlink "$upload_path/$_" foreach @uploads;
# < upload mod
&site_html_add_failure($status);
}
}
sub send_email {
# --------------------------------------------------------
# Sends an email to the admin, letting him know that there is
# a new link waiting to be validated. No error checking as we don't
# want users to see the informative &cgierr output.
# Check to make sure that there is an admin email address defined.
$db_admin_email or &cgierr("Admin Email Address Not Defined in config file!");
my $to = $db_admin_email;
my $from = $in{$db_cols[$db_contact_email]};
my $subject = "Addition to Database: $in{'Title'}\n";
my $msg = qq|
The following link is awaiting validation:
Title: $in{'Title'}
URL: $in{'URL'}
Category: $in{'Category'}
Description: $in{'Description'}
Contact Name: $in{'Contact Name'}
Contact Email: $in{'Contact Email'}
Remote Host: $ENV{'REMOTE_HOST'}
Referer: $ENV{'HTTP_REFERER'}
To validate, please go to:
$db_script_url
Sincerely,
Links Manager.
|;
# Then mail it away!
require "$db_lib_path/Mailer.pm";
my $mailer = new Mailer ( { smtp => $db_smtp_server,
sendmail => $db_mail_path,
from => $from,
subject => $subject,
to => $to,
msg => $msg,
log => $db_mailer_log
} ) or return;
$mailer->send or return;
}
# upload mod >
sub parse_me_and_upload {
#-------------------------------------
use CGI qw(:standard);
my (%in);
my ($fnum,$file_field,$file_name,$ext,$bytes_count,$size,$buff);
my ($num)=1;
my ($IN) = new CGI;
# create a hash for all input - name => value
for ($IN->param) { $in{$_} = $IN->param($_) }
# loop through the input
for (keys %in) {
# if the field name matches File(DIGIT) this is a file upload field...
if (/^(Image_\d*)$/i) {
# establish and number associative files in array
# $in{$file_field} = name of file being uploaded from form.
# $1 = Form element name ie. File1
# Increment the form element counter
$fnum = $num++;
# do some stuff that I've yet to understand.
$file_field = $1;
$in{$file_field} =~ /([^\/\\]+)$/ and $file_name = $1;
# If the File(X) field is empty
if (length($in{$file_field}) < 1 ) {
# just to copy the value of File(X)Transfer
# into $in{$file_field}. This will either be an empty string or
# the previously uploaded filename.
$in{$file_field} = "$in{'File' . $fnum . 'Transfer'}";
# Other wise the File(x) form upload element has something in it.
}
else{
# So first remove any previously uploaded files in that file(x) position
if (length($in{'File' . $fnum . 'Transfer'}) > 1) {
unlink "$upload_path/$in{'File' . $fnum . 'Transfer'}";
}
# Now let's go ahead and upload that new file
# Append Link ID instead of random number >
$file_name = $in{$db_key} . _ . $file_name; # Prevent files being overwritten by appending Link ID
# < changed to append Link ID
$filename =~ tr/ /_/; #replace space with underscore
open U, ">$upload_path/$file_name" or &cgierr("Can't open $upload_path/$file_name : $!");
binmode U; # needed for Windows servers
while ($bytes_count = read($in{$file_field},$buff,2096)) {
$size += $bytes_count;
print U $buff;
}
close U;
$in{$file_field} = $file_name;
# create an array of upload fields so we can unlink if there's a booboo
push @uploads, $in{$file_field}
}
}
}
# return the %in hash as normal
return %in
}
# < upload mod
Links.def
(change field numbers as required)
Code:
Image_1 => [33, 'alpha', 0, 150, 0, '', '^[^\.]+\.(gif|GIF|jpg|JPG)$'],
# Field Number of some important fields. The number is from %db_def above
# where the first field equals 0.
$db_image_1 = 33;
add.html template
Code:
<dt>Photo:</dt><dd><input name="Image_1" type="file" value="" size="30" /><input type="hidden" name="Image_1" value="<%Image_1%>" /></dd>
detailed.html template (or could be link.html template)
Code:
<%if Image_1%><br/> <img src="$image" height="$height" width="$width" alt="<%Title%>" />
<%endif%>
links.cfg
Code:
# Paths and URL's to Important Stuff # --------------------------------------------------------
# PATH and URL of Upload (image) Folder
$build_upload_path = "$build_root_path/pics";
$build_upload_url = "$build_root_url/pics";
# -------------------------------------------------------------
# Extra Paths -- unless you feel the need to rename files, you
# can leave this as is.
# -------------------------------------------------------------
# image upload mod >
# Upload
$upload_path = "$build_root_path/pics";
$upload_url = "$build_root_url/pics";
# < image upload mod
Leonard
aka PerlFlunkie