[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