Home : Products : Links 2.0 : Customization :

Products: Links 2.0: Customization: Re: [LILHOMIE] Here's a working image upload mod!: Edit Log

Here is the list of edits for this post
Re: [LILHOMIE] Here's a working image upload mod!
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

Edit Log: