Gossamer Forum
Home : Products : Links 2.0 : Customization :

Here's a working image upload mod!

Quote Reply
Here's a working image upload mod!
There are many pieces of code in these forums for an image upload mod, but most are incomplete or hard to understand. I have pieced this together, and it works great for me! A few features:
  • Upload from modify form so only pre-approved sites can upload. Can be changed to add form if desired.
  • Every image has the link ID attached to it as a prefix, making management easier. So, picture.gif becomes 47-picture.gif.
  • Uploading a new image to replace an existing one will delete the old one. A checkbox in the modify form must be checked in order to successfully replace a previous upload, to prevent mistakes.
  • If an image has been uploaded before, it will be shown in the modify form. It is not necessary to re-upload it in order to make a modification.
  • Images can also be deleted by the admin from the admin screen.


First, keep in mind that you will need to add the new fields to your links.db file. If you have a lot of links, this can be difficult, but there is a script available that simplifies the operation.

The changes to make are in red, and the code is also in the attached text file.

1. Make a new file in your admin directory, named upload_delete.pl (chmod 755):


usr/bin/perl
# Script to delete images via Links admin screen.
# Highly modified, but based on code Copyright (C) 2000 - 2001 Sierra Kempster <darkmoon@lunamorena.net>
# http://www.lunamorena.net/perl/
# Required Librariers
# --------------------------------------------------------
require "links.cfg";
&parse_form;
# Admin delete
if($ENV{QUERY_STRING} =~ /admindel/)
{
($action,$image) = split(/\+/,$ENV{QUERY_STRING},2);
unlink"$imagedir/$image";
&view; # View Archive list
}
elsif ($ENV{QUERY_STRING} =~ /view/){
($action,$image) = split(/\+/,$ENV{QUERY_STRING},2);
&view2; # View individual image
}
else
{
print"$invalid";
&view;
}

# Subroutines
sub parse_form {
# --------------------------------------------------------
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/~!/ ~!/g;
if($FORM{$name})
{
$FORM{$name} = "$FORM{$name};$value";
}
else
{
$FORM{$name} = $value;
}
}
}
sub view {
# --------------------------------------------------------
opendir(IMAGE, "$imagedir");
@images = grep /(\.jpe?g)$/i||/(\.gif)$/i||/(\.png)$/i, readdir IMAGE;
closedir(IMAGE);
@sorted = sort(@images);
$x = 0;
$y = 0;
print"\n";
print"Click the \'View Image\' link next to the image you want to delete; you will be shown the image with a \'Delete Image\' option.<br><hr>\n";
foreach $image (@sorted)
{
# print"<img src=\"$imageurl/$image\" width=\"$width\" height=\"$height\">";
print"$image";
print"\n\&#160;<a href=\"$script?view+$image\">View Image</a><br>";
print"<br>\n";
$x = $x + 1;
if($x eq "$perrow")
{
print"\n";
$x = 0;
}
}
}
sub view2 {
# --------------------------------------------------------
opendir(IMAGE, "$imagedir");
@images = grep /(\.jpe?g)$/i||/(\.gif)$/i||/(\.png)$/i, readdir IMAGE;
closedir(IMAGE);
@sorted = sort(@images);
$x = 0;
$y = 0;
print"\n";
print"Clicking \'Delete Image\' will remove the image from the server: this action cannot be undone. Be sure to also update the corresponding information in the links.db, via the\'Modify\' option in your Links Admin interface.<br><hr>\n";
{
print"<img src=\"$imageurl/$image\">";
print"<br><br>$image";
print"&#160;&#160;<a href=\"$script?admindel+$image\">Delete Image</a>";
print"<br>\n";
$x = $x + 1;
if($x eq "$perrow")
{
print"\n";
$x = 0;
}
}
}


2. To use the above file, add the following to your admin_html.pl:

sub html_navigation {
# --------------------------------------------------------
# Prints the navigation links.
#
&html_print_headers();
print qq|
<html>
<head>
<title>$html_title: Main Menu.</title>
<base target="cgimain">
</head>
<body bgcolor="#DDDDDD">
<p><$font><b>Links<br></b></font>
<$font>
<a href="$db_script_url?db=links&view_search=1">View</a><br>
<a href="$db_script_url?db=links&add_form=1">Add</a><br>
<a href="$db_script_url?db=links&delete_search=1">Delete</a><br>
<a href="$db_script_url?db=links&modify_search=1">Modify</a><br>
<a href="$db_script_url?db=links&validate_form=1">Validate</a><br>
<a href="$db_script_url?db=links&check_duplicates=1">Check Dup.</a><br>
<a href="$db_dir_url/upload_delete.pl">Image Delete</a>
</font>
</p>

3. Add these changes to your modify.cgi:

sub main {
# --------------------------------------------------------
# change for upload mod >
# local (%in) = &parse_form;
local (%in) = &parse_me_and_upload;

...edited...

sub process_form {
# --------------------------------------------------------
my ($key, $status, @values, $found);
local (%original);

# Make sure we have a link to modify.
!$in{'Current URL'} and &site_html_modify_failure ("You did not specify link to modify") and return;

# Let's check to make sure the link we want to update is actually
# in the database.
open (DB, "<$db_file_name") or &cgierr("Error in validate_records. unable to open db file: $db_file_name. Reason: $!");
$found = 0;
LINE: while (<DB>) {
(/^#/) and next LINE;
(/^\s*$/) and next LINE;
chomp;
@data = &split_decode($_);
if ($data[$db_url] eq $in{'Current URL'}) {
$in{$db_key} = $data[0];
$found = 1;
%original = &array_to_hash (0, @data);
last LINE;
}
}
close DB;
!$found and &site_html_modify_failure ("Link was not found in the database") and return;

# Since we have a valid link, let's make sure the system fields are set to their
# proper values. We will simply copy over the original field values. This is to stop
# people from trying to modify system fields like number of hits, etc.
foreach $key (keys %add_system_fields) {
$in{$key} = $original{$key};
}
# Set date variable to today's date.
$in{$db_cols[$db_modified]} = &get_date;

# Validate the form input..
$status = &validate_record(%in);
if ($status eq "ok") {
# First make sure the link isn't already in there.
open (MOD, "<$db_modified_name") or &cgierr ("error opening modified database: $db_modified_name. Reason: $!");
while (<MOD>) {
chomp;
@values = split /\|/;
if ($values[0] eq $in{$db_key}) {
close MOD;
&site_html_modify_failure("A request to modify this record has already been received. Please try again later.");
# Upload mod >
# Remove any new uploads.
unlink "$upload_path/$_" foreach @uploads;
# < Upload mod
return;
}
}
close MOD;
# Print out the modified record to a "modified database" where it is stored until
# the admin decides to add it into the real database.
open (MOD, ">>$db_modified_name") or &cgierr("error in modify.cgi. unable to open modification database: $db_modified_name. Reason: $!");
flock(MOD, $LOCK_EX) unless (!$db_use_flock);
print MOD &join_encode(%in);
close MOD; # 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_modify_success;
}
else {
# upload mod >
unlink "$upload_path/$_" foreach @uploads;
# < upload mod

# Let's change that error message from a comma delimted list to an html
# bulleted list.
&site_html_modify_failure($status);
}
}
sub send_email {
# --------------------------------------------------------
# Sends an email to the admin, letting him know that there is
# a new link waiting to be validated.
# 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 = "Modification to Database: $in{'Title'}";
my $msg = qq|
The following link was modified and is awaiting validation:
ORIGINAL LINK:
===============================================
Title: $original{'Title'}
URL: $original{'URL'}
Description: $original{'Description'}
Contact Name: $original{'Contact Name'}
Contact Email: $original{'Contact Email'}
Category: $original{'Category'}
Image_1: $original{'Image_1'}
Caption_1: $original{'Caption_1'}
Image_2: $original{'Image_2'}
Caption_2: $original{'Caption_2'}


NEW LINK:
===============================================
Title: $in{'Title'}
URL: $in{'URL'}
Description: $in{'Description'}
Contact Name: $in{'Contact Name'}
Contact Email: $in{'Contact Email'}
Category: $in{'Category'}
Image_1: $original{'Image_1'}
Caption_1: $original{'Caption_1'}
Image_2: $original{'Image_2'}
Caption_2: $original{'Caption_2'}

Remote Host: $ENV{'REMOTE_HOST'}
Referer: $ENV{'HTTP_REFERER'}

To update, 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 undef;
$mailer->send or return undef;
}
# upload mod >
sub parse_me_and_upload {
#-------------------------------------
use CGI qw(:standard);

my (@pairs, %in);##
my ($buffer, $pair, $name, $value);##
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{'Image_' . $fnum . '_Transfer'}";
# Other wise the File(x) form upload element has something in it.
}
else{
## LT added 'if delete_image' here...
if (($in{'image_' . $fnum . '_delete'} eq "yes") &&
(length($in{'Image_' . $fnum . '_Transfer'}) > 1)) {
# So first remove any previously uploaded files in that file(x) position
unlink "$upload_path/$in{'Image_' . $fnum . '_Transfer'}";

} # close LT 'if delete_image'
else { #LT
&site_html_modify_failure("To replace an existing image you need to check the \'delete image\' box.") and return;
} # close LT 'else'

# Now let's go ahead and upload that new file
# changed to 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


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



4. Add these fields to your links.def file:

# Database Definition: LINKS
# --------------------------------------------------------
# Definition of your database file.
%db_def = (
ID => [0, 'numer', 5, 8, 1, '', ''],
Title => [1, 'alpha', 40, 75, 1, '', ''],
URL => [2, 'alpha', 40, 75, 1, 'http://', '^http|news|mailto|ftp'],
Date => [3, 'date', 15, 15, 1, \&get_date, ''],
Category => [4, 'alpha', 0, 150, 1, '', ''],
Description => [5, 'alpha', '40x3', 500, 0, '', ''],
'Contact Name' => [6, 'alpha', 40, 75, 0, '', ''],
'Contact Email' => [7, 'alpha', 40, 75, 0, '', '.+@.+\..+'],
Hits => [8, 'numer', 10, 10, 1, '0', '\d+'],
isNew => [9, 'alpha', 0, 5, 0, 'No', 'No|Yes'],
isPopular => [10, 'alpha', 0, 5, 0, 'No', 'No|Yes'],
Rating => [11, 'numer', 10, 10, 1, 0, '^[\d\.]+$'],
Votes => [12, 'numer', 10, 10, 1, 0, '^\d+$'],
ReceiveMail => [13, 'alpha', 10, 10, 1, 'Yes', 'No|Yes'],
Image_1 => [14, 'alpha', 0, 150, 0, '', '^[^\.]+\.(gif|GIF|jpg|JPG)$'],
Caption_1 => [15, 'alpha', 40, 75, 0, '', ''],
Image_2 => [16, 'alpha', 0, 150, 0, '', '^[^\.]+\.(gif|GIF|jpg|JPG)$'],
Caption_2 => [17, 'alpha', 40, 75, 0, '', '']
);

# Field Number of some important fields. The number is from %db_def above
# where the first field equals 0.
$db_title = 1; $db_url = 2; $db_modified = 3;
$db_category = 4;
$db_desc = 5;
$db_contact_name = 6; $db_contact_email = 7;
$db_hits = 8; $db_isnew = 9;
$db_ispop = 10; $db_rating = 11; $db_votes = 12;
$db_mail = 13;
$db_image_1 = 14; $db_caption_1 = 15; $db_image_2 = 16;
$db_caption_2 = 17;



5. Make these additions to the following subs in site_html_templates.pl:

sub site_html_modify_form {
# --------------------------------------------------------
# This routine determines how the modify form page will look like.
my $category = &build_select_field ("Category", "$in{'Category'}");
&html_print_headers;
print &load_template ('modify.html', {
Category => $category,
Image_1 => $image_1,
Caption_1 => $caption_1,
Image_2 => $image_2,
Caption_2 => $caption_2,
%globals
});
}

sub site_html_confirm_modify {
# --------------------------------------------------------
# This routine is used to display what a modify confirm page should look like.
&html_print_headers;

print &load_template ('modify_confirm.html', {
Category => $category,
Image_1 => $image_1,
Caption_1 => $caption_1,
Image_2 => $image_2,
Caption_2 => $caption_2,
%in,
%globals
});
}

sub site_html_modify_success {
# --------------------------------------------------------
# This routine determines how the modify success page will look like.
&html_print_headers;
print &load_template ('modify_success.html', {
Category => $category,
Image_1 => $image_1,
Caption_1 => $caption_1,
Image_2 => $image_2,
Caption_2 => $caption_2,
%in,
%globals
});
}

6. Add this code to your template files. Note that you can (need to) remove my site-specific html code, such as <dt> and <div=...>.

modify.html

<%if Image_1%>
<dt>Current Image 1:</dt><dd><img src="<%build_upload_url%>/<%Image_1%>" /><div class="formhelp">[<%Image_1%>]</div></dd>
<dt>Delete Image 1?</dt><dd><input type="checkbox" name="image_1_delete" value="yes"></dd>
<%endif%>
<dt>Image 1</dt><dd><input name="Image_1" type="file" value="" /><input type="hidden" name="Image_1_Transfer" value="<%Image_1%>" /></dd>
<dt>Caption 1:</dt><dd><textarea wrap="virtual" input name="Caption_1" value="" rows="3" cols="42"><%Caption_1%></textarea></dd>

<%if Image_2%>
<dt>Current Image 2:</dt><dd><img src="<%build_upload_url%>/<%Image_2%>" /><div class="formhelp">[<%Image_2%>]</div></dd>
<dt>Delete Image 2?</dt><dd><input type="checkbox" name="image_2_delete" value="yes"></dd>
<%endif%>
<dt>Image 2</dt><dd><input name="Image_2" type="file" value="" /><input type="hidden" name="Image_2_Transfer" value="<%Image_2%>" /></dd>
<dt>Caption 2:</dt><dd><textarea wrap="virtual" input name="Caption_2" value="" rows="3" cols="42"><%Caption_2%></textarea></dd>


modify_success.html template

<dt>Image 1:</dt><dd><%Image_1%></dd>
<dt>Caption 1:</dt><dd><%Caption_1%></dd>
<dt>Image 2:</dt><dd><%Image_2%></dd>
<dt>Caption 2:</dt><dd><%Caption_2%></dd>


detailed.html template

<div class="float_container">
<div class="float_left">

<%if Image_1%>
<center>
<img
alt="image"
src="<%build_upload_url%>/<%Image_1%>" />
<br />
<%Caption_1%>
</center>
<%endif%>
</div>
<div class="float_right">
<%if Image_2%>
<center>
<img
alt="image"
src="<%build_upload_url%>/<%Image_2%>" />
<br />
<%Caption_2%>
</center>
<%endif%>
</div>
<div class="spacer"> </div>
</div> <!-- /float_conatiner -->


I have this set up so that the images only show in the detailed page. You can add the same or similar code to your link.html template if you want the images with the normal link listings.

I also have it set to just have two images, but you can easily change it to have more, or to specify one (thumbnail) to go with the link.html. To do that, you should specify a size in the html.

Actually, a size would be great for every image, but I have not figured out how to use image::size yet...

I think I posted all the changes required. If you try this, and run into a problem, post it here, I'll do my best to help.


Leonard
aka PerlFlunkie

Last edited by:

PerlFlunkie: Feb 17, 2005, 10:40 PM
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
Argh, the edit time ran out while I was editing! Mad

OK, a bit more...

6. Make a directory under your www/links directory named upload.

7. Add this in links.cfg:

# PATH and URL of Upload (image) Folder
$build_upload_path = "$build_root_path/upload";
$build_upload_url = "$build_root_url/upload";


and at the bottom of the file, under Extra Paths

# image upload mod >
# Upload
$upload_path = "$build_root_path/upload";
$upload_url = "$build_root_url/upload";
# Uploaded Image Delete
$html = "$build_root_path"; # path to html pages
$imagedir = "$html/upload"; #dir containing archive
$image = "$html/"; #current image
$script = "upload_delete.pl"; #filename of script
$imageurl = "$upload_url"; #URL of $imagedir
# < image upload mod



Leonard
aka PerlFlunkie
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
Hi, thank you fro this mod!

i installed but i want it to work from the add link page (add.cgi), so i made some modifications, i copied the
sub parse_me_and_upload in add.cgi and modified it with the image upload forms for the pictures, the result is that the pictures do not get puloaded but the path to the images are in the links database (the path: C:/My Images/pic.jpg)

i just can't get the image to be uploaded to the server....

Any help would b really appreciated!

Thank you
Quote Reply
Re: [jayman] Here's a working image upload mod! In reply to
Did you change this in add.cgi?

sub main {
# --------------------------------------------------------
local (%in) = &parse_form;

to:

sub main {
# --------------------------------------------------------
local (%in) = &parse_me_and_upload;




Leonard
aka PerlFlunkie
Quote Reply
Re: Here's a working image upload mod! In reply to
I am trying to get it to work on add.cgi, but I get Unknow tag Title when I try to upload an image. Everything works fine when I don't try to upload an image. here's the code for site html add form:

sub site_html_add_form {
# --------------------------------------------------------
# This routine determines how the add form page will look like.
#
&html_print_headers;
my $category = shift;
$category ?
($category = qq~$category <input type=hidden name="Category" value="$category">~) :
($category = &build_select_field ("Category", "$in{'Category'}"));

print &load_template ('add.html', {
Category => $category,
Key => $Key,
Receivemail => $Receivemail,
street_address_url => &encode_map_url ($rec{'Street Address url'}),
city_url => &encode_map_url ($rec{'City url'}),
state => &encode_map_url ($rec{'State'}),
zip => ($rec{'ZIP'}),
phone_number => ($rec{'Phone Number'}),
Image_1 => $image_1,
Caption_1 => $caption_1,
Image_2 => $image_2,
Caption_2 => $caption_2,
%in,
%globals
});
}

here is the add.html code

<form action="<%db_cgi_url%>/add.cgi" method="POST">
<p>Please fill out the form completely, and we'll add your resource as soon as possible.</p>
<div class="margin">
<table border ="0" cellspacing="0" cellpadding="0">
<tr><td align="right" valign="top">Title:</td>
<td><input name="Title" size="50"></td></tr>
<tr><td align="right" valign="top">URL:</td>
<td><input name="URL" size="50"></td></tr>
<tr><td align="right" valign="top">Street Address (if applicable):</td>
<td><input name="Street Address url" value="" size="40"></td></tr>
<tr><td align="right" valign="top">City (if applicable):</td>
<td><input name="City url" value="" size="40"></td></tr>
<tr><td align="right" valign="top">State (if applicable):</td>
<td><input name="State" value="CA" size="40"></td></tr>
<tr><td align="right" valign="top">ZIP Code (if applicable):</td>
<td><input name="ZIP" value="" size="40"></td></tr>
<tr><td align="right" valign="top">Phone Number (if applicable):</td>
<td><input name="Phone Number" value="" size="40"></td></tr>
<tr><td align="right" valign="top">Category:</td>
<td><%Category%></td></tr>
<tr><td align="right" valign="top">Description:</td>
<td><textarea wrap="virtual" name="Description" value="" rows="3" cols="42"></textarea></td></tr>
<TD align="right" valign="top"><FONT face="Verdana, Helvetica, Arial" size="2" color="006699"><strong>Keywords: </STRONG><%Key%></TD>
<TD><INPUT TYPE="Key" NAME="Key" VALUE="NO"></TD></TR>
<tr><td align="right" valign="top">Contact Name:</td>
<td><input name="Contact Name" value="" size="40"></td></tr>
<tr><td align="right" valign="top">Contact Email:</td>
<td><input name="Contact Email" value="" size="40"></td></tr>
<tr><td align=right valign="top">Comments:</td>
<td><textarea wrap="virtual" name="Comments" value="$in{'Comments'}" rows="3" cols="42"></textarea></td></tr>
<tr><td align="right" valign="top">Username:</td>
<td><input name="Username" value="" size="20"></td></tr>
<tr><td align="right" valign="top">Password:</td>
<td><input name="Password" value="" size="20"></td></tr>
<tr><td align="right" valign="top">Image 1</td>
<td><input name="Image_1" type="file" value="" /><input type="hidden" name="Image_1_Transfer" value="<%Image_1%>" /></td></tr>

<tr><td align="right" valign="top">Caption 1:</td>
<td><textarea wrap="virtual" input name="Caption_1" value="" rows="3" cols="42"><%Caption_1%></textarea></td></tr>

<tr><td align="right" valign="top">Image 2</td>
<td><input name="Image_2" type="file" value="" /><input type="hidden" name="Image_2_Transfer" value="<%Image_2%>" /></td></tr>
<tr><td align="right" valign="top">Caption 2:</td>
<td><textarea wrap="virtual" input name="Caption_2" value="" rows="3" cols="42"><%Caption_2%></textarea></td></tr>


<tr><td></td><td><input type="SUBMIT" value="Add Resource"></td></tr>
</table>
</div>
</form>
and here is the add.cgi

sub main {
# --------------------------------------------------------
# change 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 {
# --------------------------------------------------------
my ($key, $status, $line, $output);
# 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) {
&site_html_add_failure ("Auto submission is not allowed in this directory. Please visit the site to add your entry.");
return;
}
}
# This will set system fields like Validated to their proper values.
foreach $key (keys %add_system_fields) {
$in{$key} = $add_system_fields{$key};
}

# Set modified and added date variables to today's date.
$in{$db_cols[$db_dateadded]} = $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") {
open (DB, "<$db_file_name") or &cgierr("Error : unable to open db file: $db_file_name. Reason: $!");
$found = 0;
LINE: while (<DB>) {
(/^#/) and next LINE;
(/^\s*$/) and next LINE;
chomp;
@data = &split_decode($_);
if ($data[$db_user] eq $in{'Username'}) {
$found = 1;
last LINE;
}
}
close DB;
$found and &site_html_add_failure("Username already exists.") and return;
# 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
$pass = $in{'Password'};
$in{'Password'} = reverse $pass;
# 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.
use CGI qw(:standard);
if ($in{'Contact Name'} =~ /\w+\s\w+/) {
split /\s/, $in{'Contact Name'};
$name = $_[0];
} else {
$name = $in{'Contact Name'};
}
$ck = cookie( -name => "WelcMSG",
-value => $name,
-expires => '+5yr',
-domain => ''
);
print header ( -cookie => $ck );
&site_html_add_success;
}
else {
&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'}
Comments: $in{'Comments'}
Address: $in{'Street Address url'}
City: $in{'City url'}
State: $in{'State'}
ZIP: $in{'ZIP'}
Phone Number: $in{'Phone Number'}
Image_1: $original{'Image_1'}
Caption_1: $original{'Caption_1'}
Image_2: $original{'Image_2'}
Caption_2: $original{'Caption_2'}

Remote Host: $ENV{'REMOTE_HOST'}
Referer: $ENV{'HTTP_REFERER'}
Remote Addr: $ENV{'REMOTE_ADDR'}

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 (@pairs, %in);##
my ($buffer, $pair, $name, $value);##
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{'Image_' . $fnum . '_Transfer'}";
# Other wise the File(x) form upload element has something in it.
}
else{
## LT added 'if delete_image' here...
if (($in{'image_' . $fnum . '_delete'} eq "yes") &&
(length($in{'Image_' . $fnum . '_Transfer'}) > 1)) {
# So first remove any previously uploaded files in that file(x) position
unlink "$upload_path/$in{'Image_' . $fnum . '_Transfer'}";
} # close LT 'if delete_image'
else { #LT
&site_html_add_failure("To replace an existing image you need to check the \'delete image\' box.") and return;
} # close LT 'else'
# Now let's go ahead and upload that new file
# changed to 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
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
I haven't tried the modify part yet, Somebody please help.
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
it's wierd. I played with this line and did what i did below and the image uploaded

else { #LT
#&site_html_add_failure("To replace an existing image you need to check the \'delete image\' box.") and return;

I guess I'll find out when the program actually puts the id number on it.Whistle
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
Wow, a thread from wayback!
First thing to try is something along the lines of adding Title => Title to sub site_html_add_form


Leonard
aka PerlFlunkie
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
Ok Well I thought it was working and all it was doing is uploading empty picture files so now I am back at square one.
I uncommented the previous statement and put Title => $Title, in site_html_templates under add_form and still receive unknown tag Title.
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
Ok, I recommented the line in the previous post. What I had to do is add off the add fields was to the add_failure in site_html_templates. What I received was the error message in the commented out line #&site_html_add_failure("To replace an existing image you need to check the \'delete image\' box.") and return; before I commented it out. And the upload file was empty. So now since I commented it out, It loads up an empty picture. Any help to get this fixed would be greatly appreciated.
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
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
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
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
I still have One problem. I am building this site on my computer, before I load it up to a web server, and when I try to load it up from add.cgi it loads an empty picture with a_ in front of it. Also when I try to modify it and I click or don't click the delete button, to replace the picture, I get the delete check box error needs to be checked in order to replace the picture. Any ideas, Perlflunkie?
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
I was working on this last night on a fresh install, testing functions. I have it uploading the pictures fine, but so far not adding the link ID to the upload, which is supposed to go infront of the underscore. Have ideas for that, working on it...

Using the code I posted recently, these changes/additions need to be made:


  • Create the pics directory in you html/www directory, where the photos are uploaded to.
  • Add a field to any existing entries in links.db, by adding a pipe | to the end of each entry.
  • Change the form action in add.html template to <form action="<%db_cgi_url%>/add.cgi" enctype="multipart/form-data" method="post">
  • Replace template.pm with updated version so you can use conditional statement in your template.
  • Put this in link.html template to call the picture: <%if Image_1%><br/><img src="<%upload_url%>/<%Image_1%>" alt="<%Title%>" />
    <%endif%>
  • Add this to globals in site_html_template.pl: upload_url => $upload_url,
  • Add ths to site_html_link in same file: Image_1 => $image_1,

That's all I can think of right now. Do all that, see if you get the uploader to work for you at all. I'll look at adding the ID to the file (makes it easy to know which pic goes with which link), and if this works for you, there will be more changes in success/error pages, etc to make it all flow. Can work on the delete option, too, but remove it for now, it just complicates things.

Note, copy the large code chunk added to add.cgi from the attachement, as it will be formatted correctly, copying it from the thread results in a mess... Make sure no comments # are blocking needed code...


Leonard
aka PerlFlunkie
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
I have a folder in my pages folder called upload.

Deleted the few links that I had from my directory and readded them.

Changed the add.cgi and modify.cgi to <form action="<%db_cgi_url%>/add.cgi" enctype="multipart/form-data" method="post">

I do not know where I can get an updated Template.pm. According to the template.pm I have it is version 2.01

I have the link in detailed.html not link so I did not do thie link.html change.

I added upload_url change to add and modfy form in site html template.pl

I added Image_1 and the others to add and modify globals.

Under modify I still receive this error To replace an existing image you need to check the 'delete image' box.

when I add a fresh link from add.cgi it works. picture loads up. and it show up on the detailed page.

thanks for helping me on the add. part

And on the add part it does not have the ID number.

So now any ideas on the modify part? I'll post all the code that I am using in the next post. I originally thought it was because I did not modify the links in the links.db, but since I deleted them all and readded, and still receiving the same error I am lost. Like I said I will post all the code that your modification is attached too. Thanks in advanced for your help. I am almost done modifying the Links Directory, then I can start adding the real links.
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
here's the code, I hope I didn't miss anything. Again thanks for all your help, because I am really green when it comes to perl programming.

modify html form

<form action="<%db_cgi_url%>/modify.cgi" enctype="multipart/form-data" method="post">

<table border="0" cellspacing="0" cellpadding="0">
<input type="hidden" name="Current URL" value="<%URL%>">
<tr><td align="right" valign="top">Title:</td>
<td><input name="Title" value="<%Title%>" size="50"></td></tr>
<tr><td align="right" valign="top">URL:</td>
<td><input name="URL" value="<%URL%>" size="50"></td></tr>
<tr><td align="right" valign="top">Street Address (if applicable):</td>
<td><input name="Street Address" value="<%Street Address url%>" size="40"></td></tr>
<tr><td align="right" valign="top">City (if applicable):</td>
<td><input name="City" value="<%City url%>" size="40"></td></tr>
<tr><td align="right" valign="top">State (if applicable):</td>
<td><input name="State" value="<%State%>" size="40"></td></tr>
<tr><td align="right" valign="top">ZIP Code (if applicable):</td>
<td><input name="ZIP" value="<%ZIP%>" size="40"></td></tr>
<tr><td align="right" valign="top">Phone Number (if applicable):</td>
<td><input name="Phone Number" value="<%Phone Number%>" size="40"></td></tr>
<tr><td align="right" valign="top">Category:</td>
<td><%Cat%></td></tr>
<tr><td align="right" valign="top">Description:</td>
<td><textarea wrap="virtual" name="Description" value="" rows="3" cols="42"><%Description%></textarea></td></tr>
<tr><td align="right" valign="top">Contact Name:</td>
<td><input name="Contact Name" value="<%Contact Name%>" size="40"></td></tr>
<tr><td align="right" valign="top">Contact Email:</td>
<td><input name="Contact Email" value="<%Contact Email%>" size="40"></td></tr>
<tr><td align="right" valign="top">Username:</td>
<td><input name="Username" value="<%Username%>" size="20"></td></tr>
<tr><td align="right" valign="top">Password:</td>
<td><input type="password" name="Password" value="<%Password%>" size="20"></td></tr>
<%if Image_1%>
<tr><td align="right" valign="top">Current Image 1:</td>
<td><img src="<%build_upload_url%>/<%Image_1%>" /><div class="formhelp">[<%Image_1%>]</div></td></tr>

<%endif%>
<tr><td align="right" valign="top">Delete Image 1? <input type="checkbox" name="image_1_delete" value="yes"></td></tr>
<tr><td align="right" valign="top">Image 1</td>
<td><input name="Image_1" type="file" value="" /><input type="hidden" name="Image_1_Transfer" value="<%Image_1%>" /></td></tr>
<tr><td align="right" valign="top">Caption 1:</td>
<td><textarea wrap="virtual" input name="Caption_1" value="" rows="3" cols="42"><%Caption_1%></textarea></td></tr>


<%if Image_2%>
<tr><td align="right" valign="top">Current Image 2:</td>
<td><img src="<%build_upload_url%>/<%Image_2%>" /><div class="formhelp">[<%Image_2%>]</div></td></tr>
<%endif%>
<tr><td align="right" valign="top">Delete Image 2?</td>
<td><input type="checkbox" name="image_2_delete" value="yes"></td></tr>

<tr><td align="right" valign="top">Image 2</td>
<td><input name="Image_2" type="file" value="" /><input type="hidden" name="Image_2_Transfer" value="<%Image_2%>" /></td></tr>
<tr><td align="right" valign="top">Caption 2:</td>
<td><textarea wrap="virtual" input name="Caption_2" value="" rows="3" cols="42"><%Caption_2%></textarea></td></tr>

<tr><td align="right" valign="top"> Receive Email: </td><td> If you do not want to receive email about changes<br>that may affect this resource, select "No"<br> <input type="radio" name="ReceiveMail" value="Yes" checked> Yes <input type="radio" name="ReceiveMail" value="No"> No </td></tr>
<tr><td></td><td><input type="SUBMIT" value="Modify Resource"></td></tr>

</table>
</div>
</form>


modify cgi

#!/usr/local/bin/perl
# -------------
# Links
# -------------
# Links Manager
#
# File: modify.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 {
# --------------------------------------------------------
# local (%in) = &parse_form;
# We are processing the form..
# if (keys %in != 0) {
# &process_form;
# }
# Otherwise we are displaying the form (in site_html.pl).
# else {
# &site_html_modify_form;
# }
#}
sub main {
# --------------------------------------------------------
# change for upload mod >
# local (%in) = &parse_form;
local (%in) = &parse_me_and_upload;
# We are processing the form..
if ($in{'do'} eq "check") {
&check();
}
elsif (!$in{'do'} && keys %in != 0) {
&process_form;
}
# Otherwise we are displaying the form (in site_html.pl).
else {
&site_html_modify_form_up;
}
}
sub process_form {
# --------------------------------------------------------
my ($key, $status, @values, $found);
local (%original);

# Make sure we have an ID, URL, and Email address for the resource to modify.
# If any are missing, return an error message to the submitter.
((!$in{'Current URL'}) or
(!$in{'LinkID'}) or
(!$in{'LinkContact'})) and &site_html_modify_failure (qq|<ul>
<li>Missing the ID, URL, or Contact Email address of the resource to modify
</ul>|) and return;

# Let's check to make sure the link we want to update is actually in the
# database and that the link ID and Contact Email address match what is
# specified in the submission form.
open (DB, "<$db_file_name") or
&cgierr("Error in validate_records. Unable to open $db_file_name. Reason: $!");
$found = 0;
LINE: while (<DB>) {
(/^#/) and next LINE;
(/^\s*$/) and next LINE;
chomp;
@data = &split_decode($_);
# Check for matching record ID, URL, and Contact Email address.
# If everything matches, get the record, stop searching.
if (($data[0] eq $in{'LinkID'}) and
($data[$db_url] eq $in{'Current URL'}) and
($data[$db_contact_email] eq $in{'LinkContact'})) {
$in{$db_key} = $data[0];
$found = 1;
%original = &array_to_hash (0, @data);
last LINE;
}
}
close DB;
# If no matching record found, display error message to user
!$found and &site_html_modify_failure (qq|<ol>
<li>The specified Link URL was not found in the database.
<li>The specified Link URL does not match the database URL for the specified Link ID.
<li>The specified Link Contact Email address does not match the database Contact Email
address for the specified Link ID.
</ol>|) and return;

# Since we have a valid link, let's make sure the system fields are set to their
# proper values. We will simply copy over the original field values. This is to stop
# people from trying to modify system fields like number of hits, etc.
foreach $key (keys %add_system_fields) {
$in{$key} = $original{$key};
}
# Set date variable to today's date.
$in{$db_cols[$db_modified]} = &get_date;

# Validate the form input..
$status = &validate_record(%in);
if ($status eq "ok") {
# First make sure the link isn't already in there.
open (MOD, "<$db_modified_name") or &cgierr ("error opening modified database: $db_modified_name. Reason: $!");
while (<MOD>) {
chomp;
@values = split /\|/;
if ($values[0] eq $in{$db_key}) {
close MOD;
&site_html_modify_failure("A request to modify this record has already been received. Please try again later.");
# Upload mod >
# Remove any new uploads.
unlink "$upload_path/$_" foreach @uploads;
# < Upload mod
return;
}
}
close MOD;
# Print out the modified record to a "modified database" where it is stored until
# the admin decides to add it into the real database. Ensure we retain the original
# date the record was added.
$in{$db_cols[$db_dateadded]} = $original{'DateAdded'};
open (MOD, ">>$db_modified_name") or &cgierr("error in modify.cgi. unable to open modification database: $db_modified_name. Reason: $!");
flock(MOD, $LOCK_EX) unless (!$db_use_flock);
print MOD &join_encode(%in);
close MOD; # 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_modify_success;
}
else {
# upload mod >
unlink "$upload_path/$_" foreach @uploads;
# < upload mod

# Let's change that error message from a comma delimted list to an html
# bulleted list.
&site_html_modify_failure($status);
}
}
sub send_email {
# --------------------------------------------------------
# Sends an email to the admin, letting him know that there is
# a new link waiting to be validated.
# 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 = "Modification to Database: $in{'Title'}";
my $msg = qq|
The following link was modified and is awaiting validation:
ORIGINAL LINK:
#===============================================
Title: $original{'Title'}
URL: $original{'URL'}
Description: $original{'Description'}
Country: $original{'Country'}
Type: $original{'Type'}
Contact Name: $original{'Contact Name'}
Contact Email: $original{'Contact Email'}
Category: $original{'Category'}
Address: $original{'Street Address url'}
City: $original{'City url'}
State: $original{'State'}
ZIP: $original{'ZIP'}
Phone Number: $original{'Phone Number'}
Image_1: $original{'Image_1'}
Caption_1: $original{'Caption_1'}
Image_2: $original{'Image_2'}
Caption_2: $original{'Caption_2'}


NEW LINK:
#===============================================
Title: $in{'Title'}
URL: $in{'URL'}
Description: $in{'Description'}
Country: $in{'Country'}
Type: $in{'Type'}
Contact Name: $in{'Contact Name'}
Contact Email: $in{'Contact Email'}
Category: $in{'Category'}
Address: $in{'Street Address url'}
City: $in{'City url'}
State: $in{'State'}
ZIP: $in{'ZIP'}
Phone Number: $in{'Phone Number'}
Image_1: $original{'Image_1'} Just a question, shouldn't this be $in instead of $original ?
Caption_1: $original{'Caption_1'}
Image_2: $original{'Image_2'}
Caption_2: $original{'Caption_2'}

Remote Host: $ENV{'REMOTE_HOST'}
Referer: $ENV{'HTTP_REFERER'}

To update, 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 undef;
$mailer->send or return undef;
}
# upload mod >
sub parse_me_and_upload {
#-------------------------------------
use CGI qw(:standard);
my (@pairs, %in);##
my ($buffer, $pair, $name, $value);##
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{'Image_' . $fnum . '_Transfer'}";
# Other wise the File(x) form upload element has something in it.
}
else{
## LT added 'if delete_image' here...
if (($in{'image_' . $fnum . '_delete'} eq "yes") &&
(length($in{'Image_' . $fnum . '_Transfer'}) > 1)) {
# So first remove any previously uploaded files in that file(x) position
unlink "$upload_path/$in{'Image_' . $fnum . '_Transfer'}";
} # close LT 'if delete_image'
else { #LT
&site_html_modify_failure("To replace an existing image you need to check the \'delete image\' box.") and return;
} # close LT 'else'
# Now let's go ahead and upload that new file
# changed to 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
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

sub check {
&site_html_modify_up_failure("Please enter a valid username, only letters and numbers allowed."), return if ($in{'Username'} !~ /[\w\d]+/);
&site_html_modify_up_failure("Please enter a valid password, only letters and numbers allowed."), return if ($in{'Password'} !~ /[\w\d]+/);
my $reversed = reverse $in{'Password'};
open (DB, "<$db_file_name") or &cgierr("error in validate_records. unable to open db file: $db_file_name. Reason: $!");
$found = 0;
LINE: while (<DB>) {
(/^#/) and next LINE;
(/^\s*$/) and next LINE;
chomp;
@data = &split_decode($_);
if (($data[$db_user] eq $in{'Username'}) and ($data[$db_pw] eq $reversed)) {
$id = $data[0];
$found = 1;
last LINE;
}
}
close DB;
!$found and &site_html_modify_up_failure("Invalid username or password. Record not found") and return;
my (%record) = &get_record($id);
&site_html_modify_form(%record) and return;
}

all the modify sections in site_html_templates.pl


sub site_html_modify_form {
# --------------------------------------------------------
# This routine determines how the modify form page will look like.
my (%record) = @_;
my $cat ?
($record{'Category'} = qq~<input type=hidden name="Category" value="$record{'Category'}">$record{'Category'}~) :
($record{'Category'} = &build_select_field ("Category"));
&html_print_headers;
print &load_template ('modify.html', {
Cat => $cat,
street_address_url => &encode_map_url ($rec{'Street Address url'}),
city_url => &encode_map_url ($rec{'City url'}),
state => &encode_map_url ($rec{'State'}),
zip => ($rec{'ZIP'}),
phone_number => ($rec{'Phone Number'}),
%record,
Image_1 => $image_1,
Caption_1 => $caption_1,
Image_2 => $image_2,
Caption_2 => $caption_2,
upload_url => $upload_url,
%globals
});
}


sub site_html_modify_success {
# --------------------------------------------------------
# This routine determines how the modify success page will look like.
&html_print_headers;
print &load_template ('modify_success.html', {
%in,
Image_1 => $image_1,
Caption_1 => $caption_1,
Image_2 => $image_2,
Caption_2 => $caption_2,
%globals
});
}
sub site_html_modify_form_up {
# --------------------------------------------------------
# This routine determines how the modify form page will look like.
&html_print_headers;
print &load_template ('modify_up.html', {
%globals
});
}
sub site_html_modify_up_failure {
# --------------------------------------------------------
# This routine determines how the modify form page will look like.
my ($error) = shift;
&html_print_headers;
print &load_template ('modify_up_failure.html', {
error => $error,
radio_button => $radio_button,
%in,
%globals
});
}

sub site_html_modify_up_ret {
# --------------------------------------------------------
# This routine determines how the modify form page will look like.
&html_print_headers;
print &load_template ('modify_up_ret.html', {
%globals
});
}
sub site_html_modify_up_ret_failure {
# --------------------------------------------------------
# This routine determines how the modify form page will look like.
my ($error) = shift;
&html_print_headers;
print &load_template ('modify_up_ret_fail.html', {
error => $error,
%in,
%globals
});
}
sub site_html_modify_up_ret_success {
# --------------------------------------------------------
# This routine determines how the modify form page will look like.
&html_print_headers;
print &load_template ('modify_up_ret_suc.html', {
%in,
%globals
});
}

sub site_html_modify_success {
# --------------------------------------------------------
# This routine determines how the modify success page will look like.
&html_print_headers;
print &load_template ('modify_success.html', {
%in,
%globals
});
}
sub site_html_modify_failure {
# --------------------------------------------------------
# This routine determines how the modify failure page will look like.
my $errormsg = shift;
my $radio_button;
if ($in{'ReceiveMail'} eq "Yes") {
$radio_button = qq|<input type="radio" name="ReceiveMail" value="Yes" checked> <b>Yes</b>
<input type="radio" name="ReceiveMail" value="No"> <b>No</b>|;
}
else {
$radio_button = qq|<input type="radio" name="ReceiveMail" value="Yes"> <b>Yes</b>
<input type="radio" name="ReceiveMail" value="No" checked> <b>No</b>|;
}
$in{'Category'} = &build_select_field ("Category", $in{'Category'});
&html_print_headers;
print &load_template ('modify_error.html', {
error => $errormsg,
Title => ($rec{'Title'}),
URL => ($rec{'URL'}),
Category => $category,
Key => $Key,
Receivemail => $Receivemail,
'Street Address url' => &encode_map_url ($rec{'Street Address url'}),
'City url' => &encode_map_url ($rec{'City url'}),
State => &encode_map_url ($rec{'State'}),
ZIP => ($rec{'ZIP'}),
'Phone Number' => ($rec{'Phone Number'}),
Description => ($rec{'Description'}),
'Contact Name' => ($rec{'Contact Name'}),
'Contact Email' => ($rec{'Contact Email'}),
Comments => $Comments,
Username => ($rec{'Username'}),
Password => ($rec{'Password'}),
radio_button => $radio_button,
%in,
%globals
});
}

If you need to look at any other code, please let me know. Since the add portion works, I figured the links.def is good, and since it is erroring out before it modify's it, that the modify-success would not matter.

Thanks again for your help Perlflunkie.

Oh I noticed the error did not com up on the last post but it's the one that the delete box was not checked. This happen's regardless if it is a new post for picture uder modify or replacing it whether the box is checked or not checked.

Last edited by:

LILHOMIE: Nov 11, 2009, 4:20 PM
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
LILHOMIE wrote:
I have a folder in my pages folder called upload.

Deleted the few links that I had from my directory and readded them.

Changed the add.cgi and modify.cgi to <form action="<%db_cgi_url%>/add.cgi" enctype="multipart/form-data" method="post">

I do not know where I can get an updated Template.pm. According to the template.pm I have it is version 2.01

I have the link in detailed.html not link so I did not do thie link.html change.

I added upload_url change to add and modfy form in site html template.pl

I added Image_1 and the others to add and modify globals.

Under modify I still receive this error To replace an existing image you need to check the 'delete image' box.

when I add a fresh link from add.cgi it works. picture loads up. and it show up on the detailed page.

thanks for helping me on the add. part

And on the add part it does not have the ID number.

So now any ideas on the modify part? I'll post all the code that I am using in the next post. I originally thought it was because I did not modify the links in the links.db, but since I deleted them all and readded, and still receiving the same error I am lost. Like I said I will post all the code that your modification is attached too. Thanks in advanced for your help. I am almost done modifying the Links Directory, then I can start adding the real links.

Ok, when I don't do anything with modifying the pictures, I get this error Missing the ID, URL, or Contact Email address of the resource to modify.huh?
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
It's been several years since I did all that, it's kinda of fuzzy, but I do have all the files I worked with so I should be able to figure out what's happening. Let's simplify, and just have one upload and no checkbox for now...

Change this...
Code:
<%if Image_1%>
<tr><td align="right" valign="top">Current Image 1:</td>
<td><img src="<%build_upload_url%>/<%Image_1%>" /><div class="formhelp">[<%Image_1%>]</div></td></tr>

<%endif%>
<tr><td align="right" valign="top">Delete Image 1? <input type="checkbox" name="image_1_delete" value="yes"></td></tr>
<tr><td align="right" valign="top">Image 1</td>
<td><input name="Image_1" type="file" value="" /><input type="hidden" name="Image_1_Transfer" value="<%Image_1%>" /></td></tr>
<tr><td align="right" valign="top">Caption 1:</td>
<td><textarea wrap="virtual" input name="Caption_1" value="" rows="3" cols="42"><%Caption_1%></textarea></td></tr>


<%if Image_2%>
<tr><td align="right" valign="top">Current Image 2:</td>
<td><img src="<%build_upload_url%>/<%Image_2%>" /><div class="formhelp">[<%Image_2%>]</div></td></tr>
<%endif%>
<tr><td align="right" valign="top">Delete Image 2?</td>
<td><input type="checkbox" name="image_2_delete" value="yes"></td></tr>

<tr><td align="right" valign="top">Image 2</td>
<td><input name="Image_2" type="file" value="" /><input type="hidden" name="Image_2_Transfer" value="<%Image_2%>" /></td></tr>
<tr><td align="right" valign="top">Caption 2:</td>
<td><textarea wrap="virtual" input name="Caption_2" value="" rows="3" cols="42"><%Caption_2%></textarea></td></tr>

To this...
Code:

<%if Image_1%>
<tr><td align="right" valign="top">Current Image 1:</td>
<td><img src="<%build_upload_url%>/<%Image_1%>" /> </td></tr>

<%endif%>
<tr><td align="right" valign="top">Image 1</td>
<td><input name="Image_1" type="file" value="" /><input type="hidden" name="Image_1_Transfer" value="<%Image_1%>" /></td></tr>
<tr><td align="right" valign="top">Caption 1:</td>
<td><textarea wrap="virtual" input name="Caption_1" value="" rows="3" cols="42"><%Caption_1%></textarea></td></tr>

Don't worry about changing links.def or the data files.
Image_1: $original{'Image_1'} Just a question, shouldn't this be $in instead of $original ? Probably...

Change this...
Code:
## LT added 'if delete_image' here...
if (($in{'image_' . $fnum . '_delete'} eq "yes") &&
(length($in{'Image_' . $fnum . '_Transfer'}) > 1)) {
# So first remove any previously uploaded files in that file(x) position
unlink "$upload_path/$in{'Image_' . $fnum . '_Transfer'}";
} # close LT 'if delete_image'
else { #LT
&site_html_modify_failure("To replace an existing image you need to check the \'delete image\' box.") and return;
} # close LT 'else'
# Now let's go ahead and upload that new file
# changed to 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

to this:
Code:
# Now let's go ahead and upload that new file

I'm having trouble getting the link ID in add.cgi, as the file is names before the form is parsed, so ID does not work. Works in modify, since the link is already numbered.

For the security mod,it's much simpler to kill the reversal thing; remove this: my $reversed = reverse $in{'Password'};
and change this: if (($data[$db_user] eq $in{'Username'}) and ($data[$db_pw] eq $reversed)) {
to: if (($data[$db_user] eq $in{'Username'}) and ($data[$db_pw] eq $in('Password'))) {

Usually try only one mod at a time, or you'll bury yourself in confusing code changes!

Gotta run right now, see what these changes do for you...


Leonard
aka PerlFlunkie
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
Ok, the modify works now. Thanks for your help on the security mod too. it kinda confused me when I was testing it out and the password was not the same as I typed it in when I was testing it out when I installed it. I guess in the modiffied the ID is not attached to the picture? But at least it loaded up the picture.

I have a thought about attaching the ID to the picture. instead of the ID, how about the Title of the site, or when the ID is assigned to the link attach it to the picture then, or when the link is approved, do a modification to the picture name to include the ID then. Just some ideas that I had, didn't know if you thought of them yet.

Also, you said you had other changes to this modification? Please let me know if you do. It seems everything is working, now. Again, Thanks for your help.Smile
Quote Reply
Re: [LILHOMIE] Here's a working image upload mod! In reply to
As the mod is written now, ID (or any other fileds) can not be part of the upload name.When I originally got this upload working, I used it only with modify.cgi, as a way of minimizing uploads; only people who made it past the add stage would be able to use it. There is another upload mod out there, by Phoenix, but it has problems, too. However, it does put the uploading action within the normal code, and uses ID as the upload name. I am experimenting with it, to see if I can make it work right.

The other change would be to have the delete checkbox back in place. Glad it's working for ya!


Leonard
aka PerlFlunkie
Quote Reply
Re: [PerlFlunkie] Here's a working image upload mod! In reply to
I have developed a much better Image Upload Mod, available here: http://www.gossamer-threads.com/...?post=307597#p307597


Leonard
aka PerlFlunkie