[Rt-commit] r4780 - in Email-MIME-Alternative: lib/Email/MIME
jesse at bestpractical.com
jesse at bestpractical.com
Mon Mar 20 13:33:36 EST 2006
Author: jesse
Date: Mon Mar 20 13:33:35 2006
New Revision: 4780
Modified:
Email-MIME-Alternative/ (props changed)
Email-MIME-Alternative/lib/Email/MIME/Alternative.pm
Email-MIME-Alternative/test.pl
Log:
r25677 at truegrounds (orig r3): (no author) | 2006-03-04 21:50:34 -0500
r9790 at zoq-fot-pik: chmrr | 2006-03-04 16:39:51 -0800
* Docs
* Automagic creation of resources if possible
Modified: Email-MIME-Alternative/lib/Email/MIME/Alternative.pm
==============================================================================
--- Email-MIME-Alternative/lib/Email/MIME/Alternative.pm (original)
+++ Email-MIME-Alternative/lib/Email/MIME/Alternative.pm Mon Mar 20 13:33:35 2006
@@ -9,24 +9,127 @@
use strict;
use warnings;
+use Email::MIME::ContentType;
use Email::MIME::Creator;
use Email::MessageID;
use HTML::TreeBuilder;
+=head1 NAME
+
+Email::MIME::Alternative - Email::MIME constructor for creating
+multipart/alternative attachments
+
+=head1 SYNOPSIS
+
+ 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" => "image/png",
+ },
+ );
+
+=head1 DESCRIPTION
+
+=head2 Methods
+
+=over
+
+=item 5
+
+=item alternative
+
+ my $email = Email::MIME->alternative(
+ header => [ ... ],
+ parts => [ ... ],
+ resources => [ ... ],
+ ...
+ );
+
+This method creates a MIME message with a C<multipart/alternative>
+section, suitible for
+
+The C<parts> parameter is a list of alternative parts to offer the
+client. This should be ordered from least complex to most complex;
+clients should display the last such that they are capable of.
+
+Any C<text/html> parts are grovelled for C<< <img> >> tags. These
+tags are then rewritten to point to the appropriate resource, if
+possible.
+
+The C<resources> parameter is a hash of other resources to attach to
+the MIME message. The key is the filename that it is referred to as
+inside the C<parts>, the value is either a L<Email::MIME> object, or a
+string specifying the content type of the resource. In the latter
+case, the C<Email::MIME::Alternative> will attempt to load the file
+from disc using the key as a the path to the file.
+
+All other parameters, including C<header> and C<attributes>, are
+passed to L<Email::MIME::Creator/create>.
+
+=back
+
+=cut
+
sub alternative {
my ($class, %args) = @_;
my @parts = @{$args{parts} || []};
my %resources = %{$args{resources} || {}};
- for my $html (grep {$_->content_type =~ m|^text/html|} @parts) {
+ # Make real the reousrces which just speicifed mime-types
+ for my $resource (keys %resources) {
+ next if UNIVERSAL::isa($resources{$resource}, "Email::MIME");
+ $resources{$resource} = Email::MIME->create(
+ attributes => {
+ content_type => $resources{$src},
+ encoding => "base64",
+ disposition => "inline",
+ },
+ body => IO::All::io( $src )->all,
+ );
+ }
+
+ for my $part (@parts) {
+ my $ct = parse_content_type($part->content_type);
+ next unless $ct->{discrete} eq "text" and $ct->{composite} eq "html";
+
+ # Go hunting for image tags
my $tree = HTML::TreeBuilder->new;
- $tree->parse( $html->body );
+ $tree->parse( $part->body );
for my $elem ( $tree->look_down('_tag' => 'img') ) {
my $src = $elem->attr('src');
+ next if $src =~ /^\w+:/;
- unless ($resources{$src}) {
- die "Can't find resource $src";
+ if (not $resources{$src}) {
+ warn "Can't find resource $src";
+ next;
+
+ # Or, we could try to guess the mime-type and import
+ # the resource automagically. But guessing mime-types
+ # correctly is Hard.
require IO::All;
require File::MimeInfo;
$resources{$src} = Email::MIME->create(
@@ -39,18 +142,23 @@
);
}
+ # Add a Content-ID if they don't have one already
$resources{$src}->header_set( 'Content-ID' => "<".Email::MessageID->new->address.">" )
unless $resources{$src}->header('Content-ID');
+ # Pull off the brackets when we insert into the HTML
my $cid = $resources{$src}->header('Content-ID');
$cid =~ s/^<//; $cid =~ s/>$//;
+ # Update 'src' attribute with the CID
$elem->attr('src', "cid:$cid");
}
- $html->body_set( $tree->as_HTML );
+
+ # Push in the updated body
+ $part->body_set( $tree->as_HTML );
}
-
+ # Put it all together
my $email = Email::MIME->create(
%args,
parts => [
@@ -71,3 +179,25 @@
return $email;
}
+=head1 SEE ALSO
+
+L<Email::MIME>,
+L<Email::MIME::Modifier>,
+L<Email::MIME::Creator>,
+C<IO::All> or C<File::Slurp> (for file slurping to create parts from strings),
+L<perl>.
+
+=cut
+
+=head1 AUTHOR
+
+Alex Vandiver, <F<alexmv at mit.edu>>.
+
+=head1 COPYRIGHT
+
+ This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+=cut
+
+1;
Modified: Email-MIME-Alternative/test.pl
==============================================================================
--- Email-MIME-Alternative/test.pl (original)
+++ Email-MIME-Alternative/test.pl Mon Mar 20 13:33:35 2006
@@ -25,16 +25,14 @@
),
],
resources => {
- "pony.png" => Email::MIME->create(
- attributes => {
- content_type => "image/png",
- encoding => "base64",
- },
- body => io( "pony.png" )->all,
- ),
+ "pony.png" => "image/png",
},
);
+print $email->as_string;
+exit;
+
+
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