Hi Anonymous Monk,
I've taken your advice and switched to CGI->param and scrapped the uploader sub.
My attachments are still all coming through corrupted though and I'm not sure how to fix this.
My script now looks like this...
#!/xxx/perl
use strict;
use warnings;
use MIME::Lite::TT::HTML;
use CGI qw/:standard :html3 :cgi-lib *div/;
use File::Basename;
use Data::Dumper;
use LWP::UserAgent;
use CGI;
my %file_types =(
asp => 'text/asp',
asx => 'application/x-mplayer2',
au => 'audio/basic',
avi => 'video/avi',
bin => 'application/mac-binary',
bm => 'image/bmp',
bmp => 'image/bmp',
boo => 'application/book',
book => 'application/book',
c => 'text/plain',
cat => 'application/vndms-pkiseccat',
conf => 'text/plain',
doc => 'application/msword',
docx => 'application/vnd.openxmlformats-officedocument.wordpr
+ocessingml.document',
dot => 'application/msword',
exe => 'application/octet-stream',
gif => 'image/gif',
gtar => 'application/x-gtar',
gz => 'application/x-compressed',
gzip => 'application/x-gzip',
help => 'application/x-helpfile',
htaccess => 'text/plain',
htm => 'text/html',
html => 'text/html',
htmls => 'text/html',
htt => 'text/webviewhtml',
ico => 'image/x-icon',
java => 'text/plain',
jpe => 'image/jpeg',
jpeg => 'image/jpeg',
jpg => 'image/jpeg',
jps => 'image/x-jps',
js => 'application/x-javascript',
log => 'text/plain',
lsp => 'application/x-lisp',
midi => 'application/x-midi',
mime => 'message/rfc822',
mjpg => 'video/x-motion-jpeg',
moov => 'video/quicktime',
mov => 'video/quicktime',
movie => 'video/x-sgi-movie',
mp2 => 'audio/mpeg',
mp3 => 'audio/mpeg3',
mpa => 'audio/mpeg',
mpe => 'video/mpeg',
mpeg => 'video/mpeg',
mpg => 'audio/mpeg',
mpga => 'audio/mpeg',
png => 'image/png',
pps => 'application/mspowerpoint',
ppt => 'application/mspowerpoint',
pptx => 'application/vnd.openxmlformats-officedocument.presen
+tationml.presentation',
ppz => 'application/mspowerpoint',
pdf => 'application/pdf',
qif => 'image/x-quicktime',
qt => 'video/quicktime',
qtc => 'video/x-qtc',
qti => 'image/x-quicktime',
qtif => 'image/x-quicktime',
ra => 'audio/x-pn-realaudio',
ram => 'audio/x-pn-realaudio',
ras => 'application/x-cmu-raster',
rt => 'text/richtext',
rtf => 'text/richtext',
rtx => 'application/rtf',
shtml => 'text/html',
talk => 'text/x-speech',
tar => 'application/x-tar',
text => 'text/plain',
tgz => 'application/x-compressed',
tif => 'image/tiff',
tiff => 'image/tiff',
txt => 'text/plain',
wav => 'audio/wav',
web => 'application/vndxara',
word => 'application/msword',
wp => 'application/wordperfect',
wp5 => 'application/wordperfect',
wp5 => 'application/wordperfect60',
wp6 => 'application/wordperfect',
wpd => 'application/wordperfect',
xl => 'application/excel',
xla => 'application/excel',
xlb => 'application/excel',
xlc => 'application/excel',
xld => 'application/excel',
xlk => 'application/excel',
xll => 'application/excel',
xlm => 'application/excel',
xls => 'application/excel',
xlsx => 'application/vnd.openxmlformats-officedocument.spread
+sheetml.sheet',
xlt => 'application/excel',
xlv => 'application/excel',
xlw => 'application/excel',
xml => 'application/xml',
);
my $query = CGI->new;
$CGI::POST_MAX = 1024 * 5000;
my $safe_filename_characters = "a-zA-Z0-9_.-";
my @keys = $query->param;
my %params;
my %filehandle_filenames;
fileparse_set_fstype('MSWin32') if $ENV{'HTTP_USER_AGENT'} =~ /MSIE/;
for my $key (@keys){
if ($key =~ /p_scnt_.*/){
my ( $name, $path, $extension ) = fileparse ( $query->param($k
+ey), qr/\.[^.]*/ );
$extension = lc $extension;
if ($extension eq '.htaccess'){
$params{$key} = 'rename_me' . $extension ;
}else{
$params{$key} = $name . $extension;
}
$params{$key} =~ tr/ /_/;
$params{$key} =~ s/[^$safe_filename_characters]//g;
if ( $params{$key} =~ /^([$safe_filename_characters]+)$/ ){
my @filehandle_extension;
my $file_name = $1; #$name made safe
$extension =~ s/.//;
push @filehandle_extension, $extension;
my $lightweight_fh = $query->upload($key);
push @filehandle_extension, \$lightweight_fh;
$filehandle_filenames{$file_name} = \@filehandle_extension
+;
}else{
die "Filename contains invalid characters";
}
}else{
$params{$key} = $query->param($key);
}
}
my %options;
$options{INCLUDE_PATH} = '../0/update/';
my $msg = MIME::Lite::TT::HTML->new(
From => 'xxx',
To => 'xxx',
Bcc => 'xxx',
Subject => "xxx - $params{Form}",
Template => {
text => 'mail.txt.tt',
html => 'mail.html.tt',
},
TmplOptions => \%options,
TmplParams => \%params,
);
# Set our content type properly
$msg->attr("content-type" => "multipart/mixed");
# Attach a attachment to the message
my @attachments;
for my $keys (%filehandle_filenames ){
my %hash = (Type => "$file_types{$filehandle_filenames{$ke
+ys}[0]}",
FH => "$filehandle_filenames{$keys}[1]",
Filename => "$keys",
Disposition => 'attachment');
push (@attachments,\%hash);
}
for my $attachment ( @attachments ) {
$msg->attach( %$attachment ) or die "Error adding $attachment->{Fi
+lename}: $!\n";
}
if ($msg->send){
my $url = "http://xxx/response/";
print "Location: $url\n\n";
exit;
}else{
my $url = "http://xxx/error.shtml";
print "Location: $url\n\n";
exit;
}
Ive dumped the contents of %filehandle_filenames,%hash, and @attachments after sending my script one file called parking_application.pdf and got...
%filehandle_filenames = { 'parking_application.pdf' => [ 'pdf', \bless
+( \*{'Fh::fh00001parking application.pdf'}, 'Fh' ) ] };
%hash = { 'Disposition' => 'attachment', 'Type' => 'application/pdf',
+'Filename' => 'parking_application.pdf', 'FH' => 'REF(0x1590330)' };
%hash = { 'Disposition' => 'attachment', 'Type' => '', 'Filename' => '
+ARRAY(0x1590310)', 'FH' => '' };
@attachments = [ { 'Disposition' => 'attachment', 'Type' => 'applicati
+on/pdf', 'Filename' => 'parking_application.pdf', 'FH' => 'REF(0x1590
+330)' }, { 'Disposition' => 'attachment', 'Type' => '', 'Filename' =>
+ 'ARRAY(0x1590310)', 'FH' => '' } ];
I'm not sure why I get a second %hash and also why the filehandle changes from \bless( \*{'Fh::fh00001parking application.pdf'}, 'Fh' ) in %filehandle_filenames to REF(0x1590330) in %hash.
Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
Read Where should I post X? if you're not absolutely sure you're posting in the right place.
Please read these before you post! —
Posts may use any of the Perl Monks Approved HTML tags:
- a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
| |
For: |
|
Use: |
| & | | & |
| < | | < |
| > | | > |
| [ | | [ |
| ] | | ] |
Link using PerlMonks shortcuts! What shortcuts can I use for linking?
See Writeup Formatting Tips and other pages linked from there for more info.