Gossamer Forum
Home : Products : Links 2.0 : Customization :

Re: [LILHOMIE] Here's a working image upload mod!

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
Subject Author Views Date
Thread Here's a working image upload mod! PerlFlunkie 22246 Feb 17, 2005, 9:55 PM
Thread Re: [PerlFlunkie] Here's a working image upload mod!
PerlFlunkie 21885 Feb 17, 2005, 11:11 PM
Thread Re: [PerlFlunkie] Here's a working image upload mod!
jayman 21616 Nov 4, 2005, 5:57 AM
Thread Re: [jayman] Here's a working image upload mod!
PerlFlunkie 21626 Nov 4, 2005, 2:40 PM
Thread Re: Here's a working image upload mod!
LILHOMIE 20956 Nov 8, 2009, 4:50 PM
Post Re: [LILHOMIE] Here's a working image upload mod!
LILHOMIE 20951 Nov 8, 2009, 7:50 PM
Thread Re: [LILHOMIE] Here's a working image upload mod!
PerlFlunkie 20972 Nov 8, 2009, 8:01 PM
Post Re: [PerlFlunkie] Here's a working image upload mod!
LILHOMIE 20978 Nov 8, 2009, 9:13 PM
Thread Re: [PerlFlunkie] Here's a working image upload mod!
LILHOMIE 21007 Nov 8, 2009, 10:16 PM
Thread Re: [LILHOMIE] Here's a working image upload mod!
PerlFlunkie 20942 Nov 9, 2009, 9:50 AM
Thread Re: [PerlFlunkie] Here's a working image upload mod!
LILHOMIE 20887 Nov 11, 2009, 6:53 AM
Thread Re: [LILHOMIE] Here's a working image upload mod!
PerlFlunkie 20876 Nov 11, 2009, 8:58 AM
Thread Re: [PerlFlunkie] Here's a working image upload mod!
LILHOMIE 20908 Nov 11, 2009, 3:40 PM
Thread Re: [LILHOMIE] Here's a working image upload mod!
LILHOMIE 20864 Nov 11, 2009, 3:53 PM
Thread Re: [LILHOMIE] Here's a working image upload mod!
PerlFlunkie 20848 Nov 11, 2009, 5:15 PM
Thread Re: [PerlFlunkie] Here's a working image upload mod!
LILHOMIE 20813 Nov 12, 2009, 9:13 PM
Thread Re: [LILHOMIE] Here's a working image upload mod!
PerlFlunkie 20745 Nov 14, 2009, 3:06 PM
Post Re: [PerlFlunkie] Here's a working image upload mod!
PerlFlunkie 20450 Nov 24, 2009, 5:38 PM
Post Re: [LILHOMIE] Here's a working image upload mod!
LILHOMIE 20901 Nov 11, 2009, 5:12 PM