r46788 - in /trunk/libemail-mime-perl: ./ debian/ lib/Email/ lib/Email/MIME/ t/ t/files/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Nov 5 15:10:17 UTC 2009
Author: jawnsy-guest
Date: Thu Nov 5 15:09:50 2009
New Revision: 46788
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46788
Log:
* New upstream release
* Standards-Version 3.8.3 (drop perl version dependency)
* Add myself to Uploaders and Copyright
* Use new short debhelper rules format
* Refresh copyright information
Added:
trunk/libemail-mime-perl/lib/Email/MIME/Creator.pm
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/lib/Email/MIME/Creator.pm
trunk/libemail-mime-perl/lib/Email/MIME/Modifier.pm
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/lib/Email/MIME/Modifier.pm
trunk/libemail-mime-perl/t/auto_create.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/auto_create.t
trunk/libemail-mime-perl/t/basic.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/basic.t
trunk/libemail-mime-perl/t/content_id.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/content_id.t
trunk/libemail-mime-perl/t/ct_attrs.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/ct_attrs.t
trunk/libemail-mime-perl/t/dispo.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/dispo.t
trunk/libemail-mime-perl/t/disposition.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/disposition.t
trunk/libemail-mime-perl/t/encoding.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/encoding.t
trunk/libemail-mime-perl/t/files/
- copied from r46787, branches/upstream/libemail-mime-perl/current/t/files/
trunk/libemail-mime-perl/t/multipart.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/multipart.t
trunk/libemail-mime-perl/t/part-encs.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/part-encs.t
trunk/libemail-mime-perl/t/parts.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/parts.t
trunk/libemail-mime-perl/t/perl-minver.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/perl-minver.t
trunk/libemail-mime-perl/t/read-nested.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/read-nested.t
trunk/libemail-mime-perl/t/singlepart.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/singlepart.t
trunk/libemail-mime-perl/t/unicode.t
- copied unchanged from r46787, branches/upstream/libemail-mime-perl/current/t/unicode.t
Removed:
trunk/libemail-mime-perl/t/1.t
trunk/libemail-mime-perl/t/2.t
trunk/libemail-mime-perl/t/3.t
Modified:
trunk/libemail-mime-perl/Changes
trunk/libemail-mime-perl/MANIFEST
trunk/libemail-mime-perl/META.yml
trunk/libemail-mime-perl/Makefile.PL
trunk/libemail-mime-perl/debian/changelog
trunk/libemail-mime-perl/debian/control
trunk/libemail-mime-perl/debian/copyright
trunk/libemail-mime-perl/debian/rules
trunk/libemail-mime-perl/lib/Email/MIME.pm
trunk/libemail-mime-perl/lib/Email/MIME/Header.pm
trunk/libemail-mime-perl/t/nested-parts.t
trunk/libemail-mime-perl/t/pod-coverage.t
Modified: trunk/libemail-mime-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/Changes?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/Changes (original)
+++ trunk/libemail-mime-perl/Changes Thu Nov 5 15:09:50 2009
@@ -1,4 +1,8 @@
Revision history for Perl extension Email::MIME.
+
+1.900 2009-11-0
+ merge in Email-MIME-Modifier and Email-MIME-Creator
+ add better support for Unicode with body_str, header_str_set, etc.
1.863 2009-01-30
no code changes
Modified: trunk/libemail-mime-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/MANIFEST?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/MANIFEST (original)
+++ trunk/libemail-mime-perl/MANIFEST Thu Nov 5 15:09:50 2009
@@ -1,19 +1,33 @@
Changes
lib/Email/MIME.pm
+lib/Email/MIME/Creator.pm
lib/Email/MIME/Header.pm
+lib/Email/MIME/Modifier.pm
+LICENSE
Makefile.PL
MANIFEST This list of files
README
-t/1.t
-t/2.t
-t/3.t
+t/auto_create.t
+t/basic.t
+t/content_id.t
+t/ct_attrs.t
+t/dispo.t
+t/disposition.t
+t/encoding.t
+t/files/readme.txt.gz
t/Mail/att-1.gif
t/Mail/joejob
t/Mail/mail-1
t/Mail/mail-2
t/Mail/nested-parts
+t/multipart.t
t/nested-parts.t
+t/part-encs.t
+t/parts.t
+t/perl-minver.t
t/pod-coverage.t
t/pod.t
-LICENSE
+t/read-nested.t
+t/singlepart.t
+t/unicode.t
META.yml Module meta-data (added by MakeMaker)
Modified: trunk/libemail-mime-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/META.yml?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/META.yml (original)
+++ trunk/libemail-mime-perl/META.yml Thu Nov 5 15:09:50 2009
@@ -1,26 +1,30 @@
--- #YAML:1.0
name: Email-MIME
-version: 1.863
+version: 1.900
abstract: ~
author: []
license: perl
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
requires:
+ Email::MessageID: 0
Email::MIME::ContentType: 1.011
Email::MIME::Encodings: 1.3
Email::Simple: 2.004
+ Email::Simple::Creator: 0
Encode: 1.9801
MIME::Types: 1.13
Test::More: 0.47
resources:
- Repository: http://github.com/rjbs/email-mime
+ repository: http://github.com/rjbs/email-mime
no_index:
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.48
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libemail-mime-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/Makefile.PL?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/Makefile.PL (original)
+++ trunk/libemail-mime-perl/Makefile.PL Thu Nov 5 15:09:50 2009
@@ -8,19 +8,22 @@
VERSION_FROM => 'lib/Email/MIME.pm',
(eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
PREREQ_PM => {
- 'Email::MIME::ContentType' => '1.011',
- 'Email::MIME::Encodings' => '1.3',
'Email::Simple' => '2.004', # default_header_class
'Encode' => '1.9801',
'MIME::Types' => '1.13',
'Test::More' => '0.47',
+ 'Email::MIME::ContentType' => '1.011',
+ 'Email::MIME::Encodings' => '1.3',
+ 'Email::Simple::Creator' => 0,
+ 'Email::MessageID', => 0,
},
(eval { ExtUtils::MakeMaker->VERSION(6.46) }
? (META_MERGE => {
resources => {
- Repository => 'http://github.com/rjbs/email-mime'
+ repository => 'http://github.com/rjbs/email-mime'
}
})
: ()
),
);
+
Modified: trunk/libemail-mime-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/debian/changelog?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/debian/changelog (original)
+++ trunk/libemail-mime-perl/debian/changelog Thu Nov 5 15:09:50 2009
@@ -1,8 +1,16 @@
-libemail-mime-perl (1.863-2) UNRELEASED; urgency=low
+libemail-mime-perl (1.900-1) UNRELEASED; urgency=low
+ [ Jonathan Yu ]
+ * New upstream release
+ * Standards-Version 3.8.3 (drop perl version dependency)
+ * Add myself to Uploaders and Copyright
+ * Use new short debhelper rules format
+ * Refresh copyright information
+
+ [ Nathan Handler ]
* debian/watch: Update to ignore development releases.
- -- Nathan Handler <nhandler at ubuntu.com> Sat, 06 Jun 2009 01:33:58 +0000
+ -- Jonathan Yu <jawnsy at cpan.org> Thu, 05 Nov 2009 06:17:36 -0500
libemail-mime-perl (1.863-1) unstable; urgency=low
Modified: trunk/libemail-mime-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/debian/control?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/debian/control (original)
+++ trunk/libemail-mime-perl/debian/control Thu Nov 5 15:09:50 2009
@@ -2,25 +2,26 @@
Section: perl
Priority: optional
Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl (>= 5.8.0), libemail-simple-perl (>= 2.004),
+Build-Depends-Indep: perl, libemail-simple-perl (>= 2.004),
libemail-mime-contenttype-perl, libemail-mime-encodings-perl,
- libmime-types-perl, libtest-pod-coverage-perl, libtest-pod-perl
+ libmime-types-perl, libtest-pod-coverage-perl, libtest-pod-perl,
+ libemail-simple-creator-perl, libemail-messageid-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Ernesto Hernández-Novich (USB) <emhn at usb.ve>,
Damyan Ivanov <dmn at debian.org>, Russ Allbery <rra at debian.org>,
- Brian Cassidy <brian.cassidy at gmail.com>
+ Brian Cassidy <brian.cassidy at gmail.com>, Jonathan Yu <jawnsy at cpan.org>
+Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/Email-MIME/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libemail-mime-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libemail-mime-perl/
-Standards-Version: 3.8.0
Package: libemail-mime-perl
Architecture: all
Depends: ${misc:Depends}, ${perl:Depends}, libemail-simple-perl (>= 2.004),
libemail-mime-contenttype-perl, libemail-mime-encodings-perl,
libmime-types-perl
-Description: Easy MIME message parsing
- This is an extension of the Email::Simple module, to handle MIME
- encoded messages. It takes a message as a string, splits it up into its
- constituent parts, and allows you access to various parts of the
- message. Headers are decoded from MIME encoding.
+Description: module for simple MIME message parsing
+ Email::MIME is an extension of the Email::Simple module for easily handling
+ MIME-encoded messages. It takes a message as a string, splits it up into its
+ constituent parts, and allows you access to various parts of the message.
+ Headers are decoded from MIME encoding.
Modified: trunk/libemail-mime-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/debian/copyright?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/debian/copyright (original)
+++ trunk/libemail-mime-perl/debian/copyright Thu Nov 5 15:09:50 2009
@@ -5,14 +5,16 @@
Upstream-Name: Email-MIME
Files: *
-Copyright: (c) 2004 by Simon Cozens
+Copyright: 2004, Simon Cozens <simon at cpan.org>
License-Alias: Perl
License: Artistic | GPL-1+
Files: debian/*
-Copyright:
+Copyright: 2009, Jonathan Yu <jawnsy at cpan.org>
+ 2009, Brian Cassidy <brian.cassidy at gmail.com>
+ 2007, Russ Allbery <rra at debian.org>
+ 2007, Damyan Ivanov <dmn at debian.org>
2005-2008, Ernesto Hernández-Novich (USB) <emhn at usb.ve>
- 2007-2009, other members of the Debian Perl Group, cf. debian/changelog
License: Artistic | GPL-1+
License: Artistic
Modified: trunk/libemail-mime-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/debian/rules?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/debian/rules (original)
+++ trunk/libemail-mime-perl/debian/rules Thu Nov 5 15:09:50 2009
@@ -1,23 +1,4 @@
#!/usr/bin/make -f
-build: build-stamp
-build-stamp:
- dh build
- touch $@
-
-clean:
+%:
dh $@
-
-install: install-stamp
-install-stamp: build-stamp
- dh install
- touch $@
-
-binary-arch:
-
-binary-indep: install
- dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build
Modified: trunk/libemail-mime-perl/lib/Email/MIME.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/lib/Email/MIME.pm?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/lib/Email/MIME.pm (original)
+++ trunk/libemail-mime-perl/lib/Email/MIME.pm Thu Nov 5 15:09:50 2009
@@ -6,10 +6,14 @@
use Email::Simple 2.004;
use base qw(Email::Simple);
+use Carp ();
+use Email::MessageID;
+use Email::MIME::Creator;
use Email::MIME::ContentType;
use Email::MIME::Encodings;
use Email::MIME::Header;
-use Carp;
+use Email::MIME::Modifier;
+use Encode ();
=head1 NAME
@@ -17,11 +21,100 @@
=head1 VERSION
-version 1.863
-
-=cut
-
-our $VERSION = '1.863';
+version 1.900
+
+=head1 SYNOPSIS
+
+ use Email::MIME;
+ my $parsed = Email::MIME->new($message);
+
+ my @parts = $parsed->parts; # These will be Email::MIME objects, too.
+ my $decoded = $parsed->body;
+ my $non_decoded = $parsed->body_raw;
+
+ my $content_type = $parsed->content_type;
+
+...or...
+
+ use Email::MIME::Creator;
+ use IO::All;
+
+ # multipart message
+ my @parts = (
+ Email::MIME->create(
+ attributes => {
+ filename => "report.pdf",
+ content_type => "application/pdf",
+ encoding => "quoted-printable",
+ name => "2004-financials.pdf",
+ },
+ body => io( "2004-financials.pdf" )->all,
+ ),
+ Email::MIME->create(
+ attributes => {
+ content_type => "text/plain",
+ disposition => "attachment",
+ charset => "US-ASCII",
+ },
+ body => "Hello there!",
+ ),
+ );
+
+ my $email = Email::MIME->create(
+ header => [ From => 'casey at geeknest.com' ],
+ parts => [ @parts ],
+ );
+
+ # nesting parts
+ $email->parts_set(
+ [
+ $email->parts,
+ Email::MIME->create( parts => [ @parts ] ),
+ ],
+ );
+
+ # standard modifications
+ $email->header_set( 'X-PoweredBy' => 'RT v3.0' );
+ $email->header_set( To => rcpts() );
+ $email->header_set( Cc => aux_rcpts() );
+ $email->header_set( Bcc => sekrit_rcpts() );
+
+ # more advanced
+ $_->encoding_set( 'base64' ) for $email->parts;
+
+ # Quick multipart creation
+ my $quicky = Email::MIME->create(
+ header => [
+ From => 'my at address',
+ To => 'your at address',
+ ],
+ parts => [
+ q[This is part one],
+ q[This is part two],
+ q[These could be binary too],
+ ],
+ );
+
+ print $email->as_string;
+
+=head1 DESCRIPTION
+
+This is an extension of the L<Email::Simple> module, to handle MIME
+encoded messages. It takes a message as a string, splits it up into its
+constituent parts, and allows you access to various parts of the
+message. Headers are decoded from MIME encoding.
+
+=head1 METHODS
+
+Please see L<Email::Simple> for the base set of methods. It won't take
+very long. Added to that, you have:
+
+=cut
+
+our $VERSION = '1.900';
+
+use vars qw[$CREATOR];
+$CREATOR = 'Email::MIME::Creator';
sub new {
my $self = shift->SUPER::new(@_);
@@ -30,6 +123,128 @@
return $self;
}
+=head2 create
+
+ my $single = Email::MIME->create(
+ header => [ ... ],
+ attributes => { ... },
+ body => '...',
+ );
+
+ my $multi = Email::MIME->create(
+ header => [ ... ],
+ attributes => { ... },
+ parts => [ ... ],
+ );
+
+This method creates a new MIME part. The C<header> parameter is a lis of
+headers to include in the message. C<attributes> is a hash of MIME
+attributes to assign to the part, and may override portions of the
+header set in the C<header> parameter.
+
+The C<parts> parameter is a list reference containing C<Email::MIME>
+objects. Elements of the C<parts> list can also be a non-reference
+string of data. In that case, an C<Email::MIME> object will be created
+for you. Simple checks will determine if the part is binary or not, and
+all parts created in this fashion are encoded with C<base64>, just in case.
+
+If C<body> is given instead of C<parts>, it specifies the body to be used for a
+flat (subpart-less) MIME message. It is assumed to be a sequence of octets.
+
+If C<body_str> is given instead of C<body> or C<parts>, it is assumed to be a
+character string to be used as the body. If you provide a C<body_str>
+parameter, you B<must> provide C<charset> and C<encoding> attributes.
+
+Back to C<attributes>. The hash keys correspond directly to methods or
+modifying a message from C<Email::MIME::Modifier>. The allowed keys are:
+content_type, charset, name, format, boundary, encoding, disposition,
+and filename. They will be mapped to C<"$attr\_set"> for message
+modification.
+
+=cut
+
+sub create {
+ my ($class, %args) = @_;
+
+ my $header = '';
+ my %headers;
+ if (exists $args{header}) {
+ my @headers = @{ $args{header} };
+ pop @headers if @headers % 2 == 1;
+ while (my ($key, $value) = splice @headers, 0, 2) {
+ $headers{$key} = 1;
+ $CREATOR->_add_to_header(\$header, $key, $value);
+ }
+ }
+
+ if (exists $args{header_str}) {
+ my @headers = @{ $args{header_str} };
+ pop @headers if @headers % 2 == 1;
+ while (my ($key, $value) = splice @headers, 0, 2) {
+ $headers{$key} = 1;
+
+ $value = Encode::encode('MIME-Q', $value, 1);
+ $CREATOR->_add_to_header(\$header, $key, $value);
+ }
+ }
+
+ $CREATOR->_add_to_header(\$header, Date => $CREATOR->_date_header)
+ unless exists $headers{Date};
+ $CREATOR->_add_to_header(\$header, 'MIME-Version' => '1.0',);
+
+ my %attrs = $args{attributes} ? %{ $args{attributes} } : ();
+
+ # XXX: This is awful... but if we don't do this, then Email::MIME->new will
+ # end up calling parse_content_type($self->content_type) which will mean
+ # parse_content_type(undef) which, for some reason, returns the default.
+ # It's really sort of mind-boggling. Anyway, the default ends up being
+ # q{text/plain; charset="us-ascii"} so that if content_type is in the
+ # attributes, but not charset, then charset isn't changedand you up with
+ # something that's q{image/jpeg; charset="us-ascii"} and you look like a
+ # moron. -- rjbs, 2009-01-20
+ if (
+ grep { exists $attrs{$_} } qw(content_type charset name format boundary)
+ ) {
+ $CREATOR->_add_to_header(\$header, 'Content-Type' => 'text/plain',);
+ }
+
+ my $email = $class->new($header);
+
+ foreach (qw(
+ content_type charset name format boundary
+ encoding
+ disposition filename
+ )) {
+ my $set = "$_\_set";
+ $email->$set($attrs{$_}) if exists $attrs{$_};
+ }
+
+ my $body_args = grep { defined $args{$_} } qw(parts body body_str);
+ Carp::confess("only one of parts, body, or body_str may be given")
+ if $body_args > 1;
+
+ if ($args{parts} && @{ $args{parts} }) {
+ foreach my $part (@{ $args{parts} }) {
+ $part = $CREATOR->_construct_part($part)
+ unless ref($part);
+ }
+ $email->parts_set($args{parts});
+ } elsif (defined $args{body}) {
+ $email->body_set($args{body});
+ } elsif (defined $args{body_str}) {
+ Carp::confess("body_str was given, but no charset is defined")
+ unless my $charset = $attrs{charset};
+
+ Carp::confess("body_str was given, but no encoding is defined")
+ unless $attrs{encoding};
+
+ my $body_octets = Encode::encode($attrs{charset}, $args{body_str}, 1);
+ $email->body_set($body_octets);
+ }
+
+ $email;
+}
+
sub as_string {
my $self = shift;
return $self->__head->as_string
@@ -57,13 +272,16 @@
sub fill_parts {
my $self = shift;
- if ( $self->{ct}{discrete} eq "multipart"
- or $self->{ct}{discrete} eq "message")
- {
+
+ if (
+ $self->{ct}{discrete} eq "multipart"
+ or $self->{ct}{discrete} eq "message"
+ ) {
$self->parts_multipart;
} else {
$self->parts_single_part;
}
+
return $self;
}
@@ -93,6 +311,27 @@
sub body_raw {
return $_[0]->{body_raw} || $_[0]->SUPER::body;
+}
+
+sub body_str {
+ my ($self) = @_;
+ my $encoding = $self->{ct}{attributes}{charset};
+
+ unless ($encoding) {
+ if ($self->{ct}{discrete} eq 'text'
+ and
+ ($self->{ct}{composite} eq 'plain' or $self->{ct}{composite} eq 'html')
+ ) {
+
+ # assume that plaintext or html without ANY charset is us-ascii
+ return $self->body;
+ }
+
+ Carp::confess("can't get body as a string for " . $self->content_type);
+ }
+
+ my $str = Encode::decode($encoding, $self->body, 1);
+ return $str;
}
sub parts_multipart {
@@ -157,7 +396,8 @@
return $gcache{$self} if exists $gcache{$self};
my $dis = $self->header("Content-Disposition") || '';
- my $attrs = $dis =~ s/^.*?;//
+ my $attrs
+ = $dis =~ s/^.*?;//
? Email::MIME::ContentType::_parse_attributes($dis)
: {};
my $name = $attrs->{filename}
@@ -180,39 +420,363 @@
sub default_header_class { 'Email::MIME::Header' }
+sub header_str_set {
+ my $self = shift;
+ $self->header_obj->header_str_set(@_);
+}
+
+=head2 content_type_set
+
+ $email->content_type_set( 'text/html' );
+
+Change the content type. All C<Content-Type> header attributes
+will remain in tact.
+
+=cut
+
+sub content_type_set {
+ my ($self, $ct) = @_;
+ my $ct_header = parse_content_type($self->header('Content-Type'));
+ @{$ct_header}{qw[discrete composite]} = split m[/], $ct;
+ $self->_compose_content_type($ct_header);
+ $self->_reset_cids;
+ return $ct;
+}
+
+=head2 charset_set
+
+=head2 name_set
+
+=head2 format_set
+
+=head2 boundary_set
+
+ $email->charset_set( 'utf8' );
+ $email->name_set( 'some_filename.txt' );
+ $email->format_set( 'flowed' );
+ $email->boundary_set( undef ); # remove the boundary
+
+These four methods modify common C<Content-Type> attributes. If set to
+C<undef>, the attribute is removed. All other C<Content-Type> header
+information is preserved when modifying an attribute.
+
+=cut
+
+BEGIN {
+ foreach my $attr (qw[charset name format]) {
+ my $code = sub {
+ my ($self, $value) = @_;
+ my $ct_header = parse_content_type($self->header('Content-Type'));
+ if ($value) {
+ $ct_header->{attributes}->{$attr} = $value;
+ } else {
+ delete $ct_header->{attributes}->{$attr};
+ }
+ $self->_compose_content_type($ct_header);
+ return $value;
+ };
+
+ no strict 'refs'; ## no critic strict
+ *{"$attr\_set"} = $code;
+ }
+}
+
+sub boundary_set {
+ my ($self, $value) = @_;
+ my $ct_header = parse_content_type($self->header('Content-Type'));
+
+ if ($value) {
+ $ct_header->{attributes}->{boundary} = $value;
+ } else {
+ delete $ct_header->{attributes}->{boundary};
+ }
+ $self->_compose_content_type($ct_header);
+
+ $self->parts_set([ $self->parts ]) if $self->parts > 1;
+}
+
+=head2 encoding_set
+
+ $email->encoding_set( 'base64' );
+ $email->encoding_set( 'quoted-printable' );
+ $email->encoding_set( '8bit' );
+
+Convert the message body and alter the C<Content-Transfer-Encoding>
+header using this method. Your message body, the output of the C<body()>
+method, will remain the same. The raw body, output with the C<body_raw()>
+method, will be changed to reflect the new encoding.
+
+=cut
+
+sub encoding_set {
+ my ($self, $enc) = @_;
+ $enc ||= '7bit';
+ my $body = $self->body;
+ $self->header_set('Content-Transfer-Encoding' => $enc);
+ $self->body_set($body);
+}
+
+=head2 body_set
+
+ $email->body_set( $unencoded_body_string );
+
+This method will encode the new body you send using the encoding
+specified in the C<Content-Transfer-Encoding> header, then set
+the body to the new encoded body.
+
+This method overrides the default C<body_set()> method.
+
+=cut
+
+sub body_set {
+ my ($self, $body) = @_;
+ my $body_ref;
+
+ if (ref $body) {
+ $body_ref = $body;
+ $body = $$body_ref;
+ } else {
+ $body_ref = \$body;
+ }
+ my $enc = $self->header('Content-Transfer-Encoding');
+
+ # XXX: This is a disgusting hack and needs to be fixed, probably by a
+ # clearer definition and reengineering of Simple construction. The bug
+ # this fixes is an indirect result of the previous behavior in which all
+ # Simple subclasses were free to alter the guts of the Email::Simple
+ # object. -- rjbs, 2007-07-16
+ unless (((caller(1))[3] || '') eq 'Email::Simple::new') {
+ $body = Email::MIME::Encodings::encode($enc, $body)
+ unless !$enc || $enc =~ /^(?:7bit|8bit|binary)$/i;
+ }
+
+ $self->{body_raw} = $body;
+ $self->SUPER::body_set($body_ref);
+}
+
+=head2 body_str_set
+
+ $email->body_str_set($unicode_str);
+
+This method behaves like C<body_set>, but assumes that the given value is a
+Unicode string that should be encoded into the message's charset before being
+set. If the charset can't be determined, an exception is thrown.
+
+=cut
+
+sub body_str_set {
+ my ($self, $body_str) = @_;
+
+ my $ct = parse_content_type($self->content_type);
+ Carp::confess("body_str was given, but no charset is defined")
+ unless my $charset = $ct->{attributse}{charset};
+
+ my $body_octets = Encode::encode($charset, $body_str, 1);
+ $self->body_set($body_octets);
+}
+
+=head2 disposition_set
+
+ $email->disposition_set( 'attachment' );
+
+Alter the C<Content-Disposition> of a message. All header attributes
+will remain in tact.
+
+=cut
+
+sub disposition_set {
+ my ($self, $dis) = @_;
+ $dis ||= 'inline';
+ my $dis_header = $self->header('Content-Disposition');
+ $dis_header
+ ? ($dis_header =~ s/^([^;]+)/$dis/)
+ : ($dis_header = $dis);
+ $self->header_set('Content-Disposition' => $dis_header);
+}
+
+=head2 filename_set
+
+ $email->filename_set( 'boo.pdf' );
+
+Sets the filename attribute in the C<Content-Disposition> header. All other
+header information is preserved when setting this attribute.
+
+=cut
+
+sub filename_set {
+ my ($self, $filename) = @_;
+ my $dis_header = $self->header('Content-Disposition');
+ my ($disposition, $attrs);
+ if ($dis_header) {
+ ($disposition) = ($dis_header =~ /^([^;]+)/);
+ $dis_header =~ s/^$disposition(?:;\s*)?//;
+ $attrs = Email::MIME::ContentType::_parse_attributes($dis_header) || {};
+ }
+ $filename ? $attrs->{filename} = $filename : delete $attrs->{filename};
+ $disposition ||= 'inline';
+
+ my $dis = $disposition;
+ while (my ($attr, $val) = each %{$attrs}) {
+ $dis .= qq[; $attr="$val"];
+ }
+
+ $self->header_set('Content-Disposition' => $dis);
+}
+
+=head2 parts_set
+
+ $email->parts_set( \@new_parts );
+
+Replaces the parts for an object. Accepts a reference to a list of
+C<Email::MIME> objects, representing the new parts. If this message was
+originally a single part, the C<Content-Type> header will be changed to
+C<multipart/mixed>, and given a new boundary attribute.
+
+=cut
+
+sub parts_set {
+ my ($self, $parts) = @_;
+ my $body = q{};
+
+ my $ct_header = parse_content_type($self->header('Content-Type'));
+
+ if (@{$parts} > 1 or $ct_header->{discrete} eq 'multipart') {
+
+ # setup multipart
+ $ct_header->{attributes}->{boundary} ||= Email::MessageID->new->user;
+ my $bound = $ct_header->{attributes}->{boundary};
+ foreach my $part (@{$parts}) {
+ $body .= "$self->{mycrlf}--$bound$self->{mycrlf}";
+ $body .= $part->as_string;
+ }
+ $body .= "$self->{mycrlf}--$bound--$self->{mycrlf}";
+ @{$ct_header}{qw[discrete composite]} = qw[multipart mixed]
+ unless grep { $ct_header->{discrete} eq $_ } qw[multipart message];
+ } elsif (@$parts == 1) { # setup singlepart
+ $body .= $parts->[0]->body;
+ @{$ct_header}{qw[discrete composite]}
+ = @{ parse_content_type($parts->[0]->header('Content-Type')) }
+ {qw[discrete composite]};
+ $self->encoding_set($parts->[0]->header('Content-Transfer-Encoding'));
+ delete $ct_header->{attributes}->{boundary};
+ }
+
+ $self->_compose_content_type($ct_header);
+ $self->body_set($body);
+ $self->fill_parts;
+ $self->_reset_cids;
+}
+
+=head2 parts_add
+
+ $email->parts_add( \@more_parts );
+
+Adds MIME parts onto the current MIME part. This is a simple extension
+of C<parts_set> to make our lives easier. It accepts an array reference
+of additional parts.
+
+=cut
+
+sub parts_add {
+ my ($self, $parts) = @_;
+ $self->parts_set([ $self->parts, @{$parts}, ]);
+}
+
+=head2 walk_parts
+
+ $email->walk_parts(sub {
+ my $part = @_;
+ return if $part->parts > 1; # multipart
+
+ if ( $part->content_type =~ m[text/html] ) {
+ my $body = $part->body;
+ $body =~ s/<link [^>]+>//; # simple filter example
+ $part->body_set( $body );
+ }
+ });
+
+Walks through all the MIME parts in a message and applies a callback to
+each. Accepts a code reference as its only argument. The code reference
+will be passed a single argument, the current MIME part within the
+top-level MIME object. All changes will be applied in place.
+
+=cut
+
+sub walk_parts {
+ my ($self, $callback) = @_;
+
+ my $walk;
+ $walk = sub {
+ my ($part) = @_;
+ $callback->($part);
+ if ($part->parts > 1) {
+ my @subparts;
+ for ($part->parts) {
+ push @subparts, $walk->($_);
+ }
+ $part->parts_set(\@subparts);
+ }
+ return $part;
+ };
+
+ $walk->($self);
+}
+
+sub _compose_content_type {
+ my ($self, $ct_header) = @_;
+ my $ct = join q{/}, @{$ct_header}{qw[discrete composite]};
+ for my $attr (sort keys %{ $ct_header->{attributes} }) {
+ $ct .= qq[; $attr="$ct_header->{attributes}{$attr}"];
+ }
+ $self->header_set('Content-Type' => $ct);
+ $self->{ct} = $ct_header;
+}
+
+sub _get_cid {
+ Email::MessageID->new->address;
+}
+
+sub _reset_cids {
+ my ($self) = @_;
+
+ my $ct_header = parse_content_type($self->header('Content-Type'));
+
+ if ($self->parts > 1) {
+ if ($ct_header->{composite} eq 'alternative') {
+ my %cids;
+ for my $part ($self->parts) {
+ my $cid
+ = defined $part->header('Content-ID')
+ ? $part->header('Content-ID')
+ : q{};
+ $cids{$cid}++;
+ }
+ return if keys(%cids) == 1;
+
+ my $cid = $self->_get_cid;
+ $_->header_set('Content-ID' => "<$cid>") for $self->parts;
+ } else {
+ foreach ($self->parts) {
+ my $cid = $self->_get_cid;
+ $_->header_set('Content-ID' => "<$cid>")
+ unless $_->header('Content-ID');
+ }
+ }
+ }
+}
+
1;
__END__
-=head1 SYNOPSIS
-
- use Email::MIME;
- my $parsed = Email::MIME->new($message);
-
- my @parts = $parsed->parts; # These will be Email::MIME objects, too.
- my $decoded = $parsed->body;
- my $non_decoded = $parsed->body_raw;
-
- my $content_type = $parsed->content_type;
-
-=head1 DESCRIPTION
-
-This is an extension of the L<Email::Simple> module, to handle MIME
-encoded messages. It takes a message as a string, splits it up into its
-constituent parts, and allows you access to various parts of the
-message. Headers are decoded from MIME encoding.
-
-=head1 NOTE
-
-This is an alpha release, designed to stimulate discussion on the API,
-which may change in future releases. Please send me comments about any
-features you think C<Email::MIME> should have. Note that I expect most
-things to be driven by subclassing and mix-ins.
-
-=head1 METHODS
-
-Please see L<Email::Simple> for the base set of methods. It won't take
-very long. Added to that, you have:
+
+=head2 header_str_set
+
+ $email->header_str_set($header_name => @value_strings);
+
+This behaves like C<header_set>, but expects Unicode (character) strings as the
+values to set, rather than pre-encoded byte strings. It will encode them as
+MIME encoded-words if they contain any control or 8-bit characters.
=head2 parts
@@ -230,14 +794,23 @@
=head2 body
-This decodes and returns the body of the object. For top-level objects
-in multi-part messages, this is highly likely to be something like "This
-is a multi-part message in MIME format."
+This decodes and returns the body of the object I<as a byte string>. For
+top-level objects in multi-part messages, this is highly likely to be something
+like "This is a multi-part message in MIME format."
+
+=head2 body_str
+
+This decodes both the Content-Transfer-Encoding layer of the body (like the
+C<body> method) as well as the charset encoding of the body (unlike the C<body>
+method), returning a Unicode string.
+
+If the charset is known, it is used. If there is no charset but the content
+type is either C<text/plain> or C<text/html>, us-ascii is assumed. Otherwise,
+an exception is thrown.
=head2 body_raw
-This returns the body of the object, but doesn't decode the transfer
-encoding.
+This returns the body of the object, but doesn't decode the transfer encoding.
=head2 decode_hook
Modified: trunk/libemail-mime-perl/lib/Email/MIME/Header.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/lib/Email/MIME/Header.pm?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/lib/Email/MIME/Header.pm (original)
+++ trunk/libemail-mime-perl/lib/Email/MIME/Header.pm Thu Nov 5 15:09:50 2009
@@ -3,7 +3,7 @@
package Email::MIME::Header;
use base 'Email::Simple::Header';
-our $VERSION = '1.863';
+our $VERSION = '1.900';
use Encode 1.9801;
@@ -26,6 +26,15 @@
=back
+Note that C<header_set> does not do encoding for you, and expects an
+encoded header. Thus, C<header_set> round-trips with C<header_raw>,
+not C<header>! Be sure to properly encode your headers with
+C<Encode::encode('MIME-Header', $value)> before passing them to
+C<header_set>.
+
+Alternately, if you have Unicode (character) strings to set in headers, use the
+C<header_str_set> method.
+
=cut
sub header {
@@ -43,6 +52,14 @@
Carp::croak "header_raw may not be used to set headers" if @_ > 2;
my ($self, $header) = @_;
return $self->SUPER::header($header);
+}
+
+sub header_str_set {
+ my ($self, $name, @vals) = @_;
+
+ my @values = map { Encode::encode('MIME-Q', $_, 1) } @vals;
+
+ $self->header_set($name => @values);
}
sub _header_decode_str {
Modified: trunk/libemail-mime-perl/t/nested-parts.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/t/nested-parts.t?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/t/nested-parts.t (original)
+++ trunk/libemail-mime-perl/t/nested-parts.t Thu Nov 5 15:09:50 2009
@@ -1,22 +1,66 @@
-use Test::More tests => 5;
+#!/usr/bin/perl
use strict;
use warnings;
-BEGIN {
- use_ok 'Email::MIME';
-}
+use Email::MIME::Creator;
+use Test::More tests => 5;
-open IN, 't/Mail/nested-parts' or die "Can't read mail";
-my $incoming = do { local $/; <IN>; };
+my @inner = (
+ Email::MIME->create(
+ attributes => {
+ content_type => "text/plain",
+ disposition => "attachment",
+ charset => "US-ASCII",
+ },
+ body => "HELLO THERE!",
+ ),
+ Email::MIME->create(
+ attributes => {
+ content_type => "text/plain",
+ disposition => "attachment",
+ charset => "US-ASCII",
+ },
+ body => "GOODBYE THERE!",
+ ),
+);
-my $msg = Email::MIME->new($incoming);
-isa_ok($msg => 'Email::MIME');
+my @outer = Email::MIME->create(
+ attributes => {
+ content_type => "multipart/alternative",
+ disposition => "attachment",
+ charset => "US-ASCII",
+ },
+ parts => [ @inner ],
+);
-is(scalar($msg->parts), 1,'outer part');
+my $parts = Email::MIME->create(
+ attributes => {
+ content_type => 'multipart/alternative',
+ disposition => 'attachment',
+ },
+ parts => [ @outer ],
+);
+;
+my $email = Email::MIME->create(
+ attributes => { content_type => 'multipart/related' },
+ header => [ From => 'example at example.example.com' ],
+ parts => [ $parts ],
+);
-my @outer_parts = $msg->parts;
-is(scalar($outer_parts[0]->parts), 1,'middle part');
+like(
+ $email->as_string,
+ qr/HELLO THERE/,
+ "deeply nested content still found in stringified message",
+);
-my @middle_parts = $outer_parts[0]->parts;
-cmp_ok(scalar($middle_parts[0]->parts), '>', 1,'inner part');
+like(
+ $email->as_string,
+ qr/GOODBYE THERE/,
+ "deeply nested content still found in stringified message",
+);
+
+is(scalar($email->parts),1,'main contains 1 part');
+is(scalar(($email->parts)[0]->parts),1,'outer contains 1 part');
+is(scalar((($email->parts)[0]->parts)[0]->parts),2,'inner contains 2 parts');
+
Modified: trunk/libemail-mime-perl/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/t/pod-coverage.t?rev=46788&op=diff
==============================================================================
--- trunk/libemail-mime-perl/t/pod-coverage.t (original)
+++ trunk/libemail-mime-perl/t/pod-coverage.t Thu Nov 5 15:09:50 2009
@@ -8,6 +8,7 @@
# XXX: Determine which of these must be _-ed or documented. -- rjbs, 2006-07-13
my $trustme = [ qw(
force_decode_hook
+ header_str_set
),
qw(
More information about the Pkg-perl-cvs-commits
mailing list