[interchange-cvs] interchange - heins modified
code/UserTag/email.tag
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Sun Aug 28 10:31:30 EDT 2005
User: heins
Date: 2005-08-28 14:31:30 GMT
Modified: code/UserTag email.tag
Log:
* Enhance [email ...] tag to handle attachments. Requires MIME::Lite module,
which I have added to Bundle::Interchange[KitchenSink].
* To do the common request of HTML messages, you simply add an html parameter
thusly:
[email
from=foo at bar.com
to=bar at foo.com
subject=test
html="[scratch some_big_hairy_mess]"
]This is the plain text part.[/email]
This sets the main message type as multipart/alternative, automatically
sets the content-type and disposition of the two parts, and creates a
valid text-and-HTML message.
* To add a single file as an attachment, you just do:
[email
from=foo at bar.com
to=bar at foo.com
subject=test
attach=foo.gif
] Here is the gif file I promised. [/email]
It automatically picks up the MIME type, and handles many if you
have the optional MIME::Types module installed.
* To add multiple files, or for more control over the attachments,
the attach option accepts hashes.
[email
from=foo at bar.com
to=bar at foo.com
subject=test
attach.0=`{
type => 'image/gif',
path => 'images/foo.gif',
}`
attach.1=`{
type => 'image/jpeg',
path => 'images/foo.jpg',
}`
] Here are the files I promised. [/email]
This would be the same as:
[email
from=foo at bar.com
to=bar at foo.com
subject=test
attach=`[
{
type => 'image/gif',
path => 'images/foo.gif',
filename => 'PrettyName.gif',
},
{
type => 'image/jpeg',
data => $Tag->file('tmp/foo.jpeg')
|| $Tag->file('images/broken.jpg'),
filename => 'PrettyName.jpg',
},
]`
] Here are the files I promised. [/email]
Revision Changes Path
1.7 +131 -8 interchange/code/UserTag/email.tag
rev 1.7, prev_rev 1.6
Index: email.tag
===================================================================
RCS file: /var/cvs/interchange/code/UserTag/email.tag,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- email.tag 19 Aug 2005 04:54:05 -0000 1.6
+++ email.tag 28 Aug 2005 14:31:30 -0000 1.7
@@ -1,18 +1,26 @@
-# Copyright 2002-2005 Interchange Development Group (http://www.icdevgroup.org/)
+# Copyright 2002 Interchange Development Group (http://www.icdevgroup.org/)
# Licensed under the GNU GPL v2. See file LICENSE for details.
-# $Id: email.tag,v 1.6 2005/08/19 04:54:05 jon Exp $
+# $Id: email.tag,v 1.7 2005/08/28 14:31:30 mheins Exp $
-UserTag email Order to subject reply from extra
+UserTag email Order to subject reply from extra
UserTag email hasEndTag
UserTag email addAttr
UserTag email Interpolate
-UserTag email Version $Revision: 1.6 $
-UserTag email Routine <<EOR
+UserTag email Routine <<EOR
+
+my $Have_mime_lite;
+BEGIN {
+ require MIME::Lite;
+ $Have_mime_lite = 1;
+}
+
sub {
my ($to, $subject, $reply, $from, $extra, $opt, $body) = @_;
my $ok = 0;
my @extra;
+ use vars qw/ $Tag /;
+
$subject = '<no subject>' unless defined $subject && $subject;
$reply = '' unless defined $reply;
@@ -22,13 +30,127 @@
$from =~ s/,.*//;
}
$extra =~ s/\s*$/\n/ if $extra;
- $extra .= "From: $from\n" if $from;
+ $extra .= "From: $from\n" if $from;
@extra = grep /\S/, split(/\n/, $extra);
- $ok = send_mail($to, $subject, $body, $reply, 0, @extra);
+ ATTACH: {
+#::logDebug("Checking for attachment");
+ last ATTACH unless $opt->{attach} || $opt->{html};
+
+ my $att1_format;
+ if($opt->{html}) {
+ $opt->{mimetype} ||= 'multipart/alternative';
+ $att1_format = 'flowed';
+ }
+ else {
+ $opt->{mimetype} ||= 'multipart/mixed';
+ }
+
+ if(! $Have_mime_lite) {
+ ::logError("email tag: attachment without MIME::Lite installed.");
+ last ATTACH;
+ }
+ my $att = $opt->{attach};
+ my @attach;
+ my @extra_headers;
+
+ for(@extra) {
+ m{(.*?):\s+(.*)};
+ my $name = $1 or next;
+ my $content = $2 or next;
+ $name =~ s/[-_]+/-/g;
+ $name =~ s/\b(\w)/\U$1/g;
+ push @extra_headers, "$name:", $content;
+ }
+
+ my $msg = new MIME::Lite
+ To => $to,
+ From => $from,
+ Subject => $subject,
+ Type => $opt->{mimetype},
+ Cc => $opt->{cc},
+ @extra_headers,
+ ;
+ $opt->{body_mime} ||= 'text/plain';
+ $opt->{body_encoding} ||= '8bit';
+ $msg->attach(
+ Type => $opt->{body_mime},
+ Encoding => $opt->{body_encoding},
+ Data => $body,
+ Disposition => $opt->{body_disposition} || 'inline',
+ Format => $opt->{body_format} || $att1_format,
+ );
+
+ if(! ref($att) ) {
+ my $fn = $att;
+ $att = [ { path => $fn } ];
+ }
+ elsif(ref($att) eq 'HASH') {
+ $att = [ $att ];
+ }
+
+ $att ||= [];
+
+ if($opt->{html}) {
+ unshift @$att, {
+ type => 'text/html',
+ data => $opt->{html},
+ disposition => 'inline',
+ };
+ }
+
+ my %encoding_types = (
+ 'text/plain' => '8bit',
+ 'text/html' => 'quoted-printable',
+ );
+
+ for my $ref (@$att) {
+ next unless $ref;
+ next unless $ref->{path} || $ref->{data};
+ unless ($ref->{filename}) {
+ my $fn = $ref->{path};
+ $fn =~ s:.*[\\/]::;
+ $ref->{filename} = $fn;
+ }
+
+ $ref->{type} ||= 'AUTO';
+ $ref->{disposition} ||= 'attachment';
+
+ if(! $ref->{encoding}) {
+ $ref->{encoding} = $encoding_types{$ref->{type}};
+ }
+ eval {
+ $msg->attach(
+ Type => $ref->{type},
+ Path => $ref->{path},
+ Data => $ref->{data},
+ Filename => $ref->{filename},
+ Encoding => $ref->{encoding},
+ Disposition => $ref->{disposition},
+ );
+ };
+ if($@) {
+ ::logError("email tag: failed to attach %s: %s", $ref->{path}, $@);
+ next;
+ }
+ }
+
+ my $body = $msg->as_string;
+#::logDebug("Mail body: \n$body");
+ if($opt->{test}) {
+ return $body;
+ }
+ else {
+ return $Tag->email_raw({}, $body);
+ }
+ }
+
+ SEND: {
+ $ok = send_mail($to, $subject, $body, $reply, 0, @extra);
+ }
if (!$ok) {
- logError("Unable to send mail using $Vend::Cfg->{SendMailProgram}\n" .
+ logError("Unable to send mail using $Vend::Cfg->{'SendMailProgram'}\n" .
"To '$to'\n" .
"From '$from'\n" .
"With extra headers '$extra'\n" .
@@ -40,3 +162,4 @@
return $opt->{hide} ? '' : $ok;
}
EOR
+
More information about the interchange-cvs
mailing list