Perl Guru Forums: Perl Programming Help: Advanced: Recieving Attachments in email

CGI/Perl Guide | Learning Center | Forums | Advertise | Login

Site Search: in


	MAIN INDEX	SEARCH POSTS	WHO'S ONLINE	LOG IN

Home: Perl Programming Help: Advanced:
Recieving Attachments in email

patk
Deleted

Sep 1, 2000, 10:46 PM

Post #1 of 2 (1798 views)

Recieving Attachments in email	Can't Post

I have built a simple webmail script that can
send attachments, and recieve messages
but can't recieve attachments. There is a subroutine in a program called AtDot
(www.atdot.org) but it's rathing tangled
with additional stuff that was made for
that program. I have MIME Tools installed
but I don't know to use it to read attachments :-). Below is the subroutine
for AtDot's read message.
============================
#!/bin/perl

use strict;
use vars qw(%conf %lang %cgi $dbh);
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use POSIX;

sub read_message
{
my $mess = shift;
my $attachment = shift if ($webmail::cgi{A} eq 'VIEW');

$mess =~ s/</&lt\;/g;
$mess =~ s/>/&gt\;/g;
foreach (qw(http ftp nntp news gopher telnet))
{
$mess =~ s/($_:[\d|\w|\/|\.|\-|?|&|=|~]*[\d|\w|\/])([\b|\n| ]*)/<A HREF=\"$1\">$1<\/A>$2/gs;
}
$mess =~ s/(\w[\w|\d|\.|\-|\+]*\@[\w|\d|\.|\-]*)([\b|\n| ])/<A HREF=\"$webmail::conf{url}?S=$webmail::cgi{S}&A=COMPOSE&TO=$1\">$1<\/A>$2/gs;
$mess =~ s/(&lt\ Wink

(\w[\w|\d|\.|\-|\+]*\@[\w|\d|\.|\-]*)(&gt\ Wink

/$1<A HREF=\"$webmail::conf{url}?S=$webmail::cgi{S}&A=COMPOSE&TO=$2\">$2<\/A>$3/gs;

my ($header, $body) = split(/\n\n/, $mess, 2);
my @attachments = ();
my $from = &webmail::header ('FROM', $mess);
my $subject = &webmail::header ('SUBJECT', $mess);
my $date = &webmail::header ('DATE', $mess);
my $to = &webmail::header ('TO', $mess);
my $cc = &webmail::header ('CC', $mess);
my $type = &webmail::header ('CONTENT-TYPE', $mess);

if ($type =~ /multipart/i)
{
my $bound = $type;
$bound =~ s/.*boundary="(.*)".*/$1/igs;
$body =~ s/($bound)\-\-.*/$1/s;
@attachments = split (/\-\-$bound/, $body);
shift (@attachments);
}

if ($webmail::cgi{A} eq 'READ')
{
$header = "";
$header .= "$webmail::lang{from}: $from\n" if $from;
$header .= "$webmail::lang{subject}: $subject\n" if $subject;
$header .= "$webmail::lang{date}: $date\n" if $date;
$header .= "$webmail::lang{to}: $to\n" if $to;
$header .= "$webmail::lang{cc}: $cc\n" if $cc;

my $form = qq(
<TABLE WIDTH="100%" BORDER="0" CELLSPACING="0"
WIDTH="100%" HEIGHT="100%"
BGCOLOR="$webmail::conf{header_color}">
<TR>
<TD WIDTH="100%" BGCOLOR="$webmail::conf{header_color}">
<PRE WIDTH="80">$header</PRE>
</TD>
</TR>
<TR>
<TD WIDTH="100%" HEIGHT="100%"
BGCOLOR="$webmail::conf{body_color}">
<PRE WIDTH="80"> );

if ($#attachments > 0)
{
my @list = ();
my @names = ();
my $num = 0;

foreach (0 .. $#attachments)
{
my ($h, $c) = split (/\n\n/, $attachments[$_]);
if ($h =~ /content-type: text\/plain/i or
$h !~ /content-transfer-encoding/i)
{
$form .= $c;
}
else
{
$list[$num] = $_;
if ($h =~ /name=.*/i)
{
$h = &webmail::header ('content-type', $h);
$h =~ s/.*name=(.*)/$1/i;
$h =~ s/\n/ /gs;
$h =~ s/\"//g;
$h =~ s/ /_/g;
$names[$num] = $h;
}
$names[$num] | |= "$webmail::lang{attachment} " . ($num+1);
$num++;
}
}

$form .= qq (
</PRE></TD></TR>
<TR>
<TD WIDTH="100%" HEIGHT="1%"
BGCOLOR="$webmail::conf{header_color}">
$webmail::lang{attachments}:
);
foreach (0 .. $#list) {
$form .= "<A HREF=\"$webmail::conf{url}?S=$webmail::cgi{S}&A=VIEW&M=$webmail::cgi{M}&N=$webmail::cgi{N}&ATT=$list[$_]&NAME=/$names[$_]\">$names[$_]</A> ";
}
$form .= "</TD></TR>";
}
else {
$form .= qq(
<TR>
<TD WIDTH="100%" HEIGHT="100%" VALIGN="TOP"
BGCOLOR="$webmail::conf{body_color}">
<PRE WIDTH="80">$body</PRE>
</TD>
</TR> );
}

$form .= qq(
<TR>
<TD WIDTH="100%" HEIGHT="1%"
BGCOLOR="$webmail::conf{header_color}">
<TABLE WIDTH="100%" BORDER="0">
<TR>
<TD ALIGN="CENTER"><A HREF="$webmail::conf{url}?S=$webmail::cgi{S}&A=REPLY&M=$webmail::cgi{M}&N=$webmail::cgi{N}">$webmail::lang{reply}</A></TD>
<TD ALIGN="CENTER"><A HREF="$webmail::conf{url}?S=$webmail::cgi{S}&A=FORWARD&M=$webmail::cgi{M}&N=$webmail::cgi{N}">$webmail::lang{forward}</A></TD>
<TD ALIGN="CENTER"><A HREF="$webmail::conf{url}?S=$webmail::cgi{S}&A=BOUNCE&M=$webmail::cgi{M}&N=$webmail::cgi{N}">$webmail::lang{bounce}</A></TD>
<TD ALIGN="CENTER"><B>FIXME: Move code</B></TD>
</TR>
</TABLE>
</TD>
</TR>
</TABLE> );
return $form;
}
else
{
# decode and return the attachment
my ($header, $code) = (split (/\n\n/, $attachments[$attachment]));
if ($header =~ /content-transfer-encoding:\s*base64/i)
{
my $type = &webmail::header('Content-type', $header);
$type .= "\n\n";
$type .= &webmail::decode_base64 ($code);
return "Content-type: $type";
}
elsif ($header =~ /content-transfer-encoding:\s*quoted-printable/i)
{
my $type = &webmail::header('Content-type', $header);
$type .= "\n\n";
$type .= &webmail::decode_qp ($code);
return "Content-type: $type";
}
else
{
return "$header\n\n$code";
}
}
}

Cure
User

Dec 3, 2000, 8:13 PM

Post #2 of 2 (1798 views)

Re: Recieving Attachments in email [In reply to]	Can't Post

perldoc MIME::Lite

Cure

Search for (options)

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives