[Rt-commit] r4779 - in Email-MIME-Alternative: lib lib/Email
lib/Email/MIME
jesse at bestpractical.com
jesse at bestpractical.com
Mon Mar 20 13:33:31 EST 2006
Author: jesse
Date: Mon Mar 20 13:33:29 2006
New Revision: 4779
Added:
Email-MIME-Alternative/email.html (contents, props changed)
Email-MIME-Alternative/email.txt
Email-MIME-Alternative/lib/
Email-MIME-Alternative/lib/Email/
Email-MIME-Alternative/lib/Email/MIME/
Email-MIME-Alternative/lib/Email/MIME/Alternative.pm
Email-MIME-Alternative/pony.png (contents, props changed)
Email-MIME-Alternative/test.pl
Modified:
Email-MIME-Alternative/ (props changed)
Log:
r25537 at truegrounds (orig r2): (no author) | 2006-03-04 21:14:37 -0500
r9766 at zoq-fot-pik: chmrr | 2006-03-04 16:03:48 -0800
* First pass at MIME alternatives
Added: Email-MIME-Alternative/email.html
==============================================================================
--- (empty file)
+++ Email-MIME-Alternative/email.html Mon Mar 20 13:33:29 2006
@@ -0,0 +1,8 @@
+<html><body>
+<p>Hi, this is some mail. It'd be nice if you could see my <i>pretty</i>
+picture of a pony:<p>
+
+<img src="pony.png" alt="My picture of a pony. Not yours!" />
+
+<p>Ain't it <i>pretty</i>?</p>
+</body></html>
Added: Email-MIME-Alternative/email.txt
==============================================================================
--- (empty file)
+++ Email-MIME-Alternative/email.txt Mon Mar 20 13:33:29 2006
@@ -0,0 +1,5 @@
+Hi, this is some email. It'd be nice if you could see my pretty picture of a pony:
+
+ [ think hard about ponies ]
+
+Ain't it pretty?
Added: Email-MIME-Alternative/lib/Email/MIME/Alternative.pm
==============================================================================
--- (empty file)
+++ Email-MIME-Alternative/lib/Email/MIME/Alternative.pm Mon Mar 20 13:33:29 2006
@@ -0,0 +1,73 @@
+package Email::MIME::Alternative;
+
+use vars qw[$VERSION];
+$VERSION = '1.00';
+
+use Email::MIME;
+
+package Email::MIME;
+use strict;
+use warnings;
+
+use Email::MIME::Creator;
+use Email::MessageID;
+use HTML::TreeBuilder;
+
+sub alternative {
+ my ($class, %args) = @_;
+
+ my @parts = @{$args{parts} || []};
+ my %resources = %{$args{resources} || {}};
+
+ for my $html (grep {$_->content_type =~ m|^text/html|} @parts) {
+ my $tree = HTML::TreeBuilder->new;
+ $tree->parse( $html->body );
+ for my $elem ( $tree->look_down('_tag' => 'img') ) {
+ my $src = $elem->attr('src');
+
+ unless ($resources{$src}) {
+ die "Can't find resource $src";
+ require IO::All;
+ require File::MimeInfo;
+ $resources{$src} = Email::MIME->create(
+ attributes => {
+ content_type => File::MimeInfo::mimetype( $src ),
+ encoding => "base64",
+ disposition => "inline",
+ },
+ body => IO::All::io( $src )->all,
+ );
+ }
+
+ $resources{$src}->header_set( 'Content-ID' => "<".Email::MessageID->new->address.">" )
+ unless $resources{$src}->header('Content-ID');
+
+ my $cid = $resources{$src}->header('Content-ID');
+ $cid =~ s/^<//; $cid =~ s/>$//;
+
+ $elem->attr('src', "cid:$cid");
+ }
+ $html->body_set( $tree->as_HTML );
+ }
+
+
+ my $email = Email::MIME->create(
+ %args,
+ parts => [
+ Email::MIME->create(
+ attributes => {
+ content_type => "multipart/alternative",
+ },
+ parts => [ @parts ],
+ ),
+ values %resources,
+ ],
+ attributes => {
+ content_type => 'multipart/related',
+ },
+ );
+ $email->attribute_set(type => "multipart/alternative");
+
+ return $email;
+}
+
Added: Email-MIME-Alternative/pony.png
==============================================================================
Binary file. No diff available.
Added: Email-MIME-Alternative/test.pl
==============================================================================
--- (empty file)
+++ Email-MIME-Alternative/test.pl Mon Mar 20 13:33:29 2006
@@ -0,0 +1,40 @@
+use Email::Send;
+use Email::MIME::Creator;
+use Email::MIME::Alternative;
+use IO::All;
+
+my $email = Email::MIME->alternative(
+ header => [
+ To => 'alexmv at mit.edu',
+ From => 'alexmv at mit.edu',
+ ],
+ parts => [
+ Email::MIME->create(
+ attributes => {
+ content_type => "text/plain",
+ encoding => "quoted-printable",
+ },
+ body => io( "email.txt" )->all,
+ ),
+ Email::MIME->create(
+ attributes => {
+ content_type => "text/html",
+ encoding => "quoted-printable",
+ },
+ body => io( "email.html" )->all,
+ ),
+ ],
+ resources => {
+ "pony.png" => Email::MIME->create(
+ attributes => {
+ content_type => "image/png",
+ encoding => "base64",
+ },
+ body => io( "pony.png" )->all,
+ ),
+ },
+);
+
+my $sender = Email::Send->new({mailer => 'SMTP'});
+$sender->mailer_args([Host => 'outgoing.mit.edu']);
+$sender->send($email->as_string);
More information about the Rt-commit
mailing list