r26198 - in /trunk/libemail-mime-perl: Changes MANIFEST META.yml Makefile.PL debian/changelog lib/Email/MIME.pm lib/Email/MIME/ lib/Email/MIME/Header.pm t/3.t
emhn-guest at users.alioth.debian.org
emhn-guest at users.alioth.debian.org
Wed Oct 22 13:21:38 UTC 2008
Author: emhn-guest
Date: Wed Oct 22 13:21:34 2008
New Revision: 26198
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26198
Log:
* New upstream release.
* Latest upstream release version is 1.861_01, changed it to
1.861.01 instead.
Added:
trunk/libemail-mime-perl/lib/Email/MIME/
trunk/libemail-mime-perl/lib/Email/MIME/Header.pm
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/lib/Email/MIME.pm
trunk/libemail-mime-perl/t/3.t
Modified: trunk/libemail-mime-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/Changes?rev=26198&op=diff
==============================================================================
--- trunk/libemail-mime-perl/Changes (original)
+++ trunk/libemail-mime-perl/Changes Wed Oct 22 13:21:34 2008
@@ -1,4 +1,10 @@
Revision history for Perl extension Email::MIME.
+
+1.862 2008-09-08
+ always require Encode, never MIME::Words; this means that using
+ Email::MIME on pre-5.008 will be difficult, if not impossible
+ if a header can't be decoded, fall back to the raw header
+ move decoding methods to Email::MIME::Header, add header_raw
1.861 2007-11-05
added perl-minver.t -- Email::MIME requires perl >= 5.006
Modified: trunk/libemail-mime-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/MANIFEST?rev=26198&op=diff
==============================================================================
--- trunk/libemail-mime-perl/MANIFEST (original)
+++ trunk/libemail-mime-perl/MANIFEST Wed Oct 22 13:21:34 2008
@@ -1,5 +1,6 @@
Changes
lib/Email/MIME.pm
+lib/Email/MIME/Header.pm
Makefile.PL
MANIFEST This list of files
README
Modified: trunk/libemail-mime-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/META.yml?rev=26198&op=diff
==============================================================================
--- trunk/libemail-mime-perl/META.yml (original)
+++ trunk/libemail-mime-perl/META.yml Wed Oct 22 13:21:34 2008
@@ -1,17 +1,18 @@
--- #YAML:1.0
name: Email-MIME
-version: 1.861
+version: 1.861_01
abstract: ~
license: perl
-generated_by: ExtUtils::MakeMaker version 6.36_01
+author: ~
+generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
Email::MIME::ContentType: 1.011
Email::MIME::Encodings: 1.3
- Email::Simple: 2.003
+ Email::Simple: 2.004
Encode: 1.9801
MIME::Types: 1.13
Test::More: 0.47
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: trunk/libemail-mime-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/Makefile.PL?rev=26198&op=diff
==============================================================================
--- trunk/libemail-mime-perl/Makefile.PL (original)
+++ trunk/libemail-mime-perl/Makefile.PL Wed Oct 22 13:21:34 2008
@@ -1,17 +1,7 @@
+use 5.006; # see t/perl-minver.t
+use strict;
+use warnings;
use ExtUtils::MakeMaker;
-
-# see t/perl-minver.t
-use 5.006;
-
-my @encode_deps;
-if ($]< 5.00703) {
- print "Email::MIME requires either Encode or MIME::Words to decode
-MIME headers. You've not got Perl 5.7.3, so for you, we depend on
-MIME::Words.\n\n";
- push @encode_deps, ('MIME::Words' => '5.404');
-} else {
- push @encode_deps, (Encode => '1.9801');
-}
WriteMakefile(
NAME => 'Email::MIME',
@@ -20,9 +10,9 @@
PREREQ_PM => {
'Email::MIME::ContentType' => '1.011',
'Email::MIME::Encodings' => '1.3',
- 'Email::Simple' => '2.003',
+ 'Email::Simple' => '2.004', # default_header_class
+ 'Encode' => '1.9801',
'MIME::Types' => '1.13',
'Test::More' => '0.47',
- @encode_deps,
},
);
Modified: trunk/libemail-mime-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/debian/changelog?rev=26198&op=diff
==============================================================================
--- trunk/libemail-mime-perl/debian/changelog (original)
+++ trunk/libemail-mime-perl/debian/changelog Wed Oct 22 13:21:34 2008
@@ -1,3 +1,11 @@
+libemail-mime-perl (1.861.01-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+ * Latest upstream release version is 1.861_01, changed it to
+ 1.861.01 instead.
+
+ -- Ernesto Hernández-Novich (USB) <emhn at usb.ve> Wed, 22 Oct 2008 08:54:34 -0430
+
libemail-mime-perl (1.861-4) UNRELEASED; urgency=low
* debian/watch: use dist-based URL.
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=26198&op=diff
==============================================================================
--- trunk/libemail-mime-perl/lib/Email/MIME.pm (original)
+++ trunk/libemail-mime-perl/lib/Email/MIME.pm Wed Oct 22 13:21:34 2008
@@ -3,10 +3,12 @@
use warnings;
package Email::MIME;
+use Email::Simple 2.004;
use base qw(Email::Simple);
use Email::MIME::ContentType;
use Email::MIME::Encodings;
+use Email::MIME::Header;
use Carp;
=head1 NAME
@@ -15,13 +17,13 @@
=head1 VERSION
-version 1.861
-
- $Id: MIME.pm 780 2007-07-20 03:22:05Z rjbs at cpan.org $
+version 1.861_01
+
+ $Id: MIME.pm 967 2008-09-08 22:21:59Z rjbs at cpan.org $
=cut
-our $VERSION = '1.861';
+our $VERSION = '1.861_01';
sub new {
my $self = shift->SUPER::new(@_);
@@ -98,7 +100,14 @@
sub parts_multipart {
my $self = shift;
my $boundary = $self->{ct}->{attributes}->{boundary};
- return $self->parts_single_part unless $boundary;
+
+ # Take a message, join all its lines together. Now try to Email::MIME->new
+ # it with 1.861 or earlier. Death! It tries to recurse endlessly on the
+ # body, because every time it splits on boundary it gets itself. Obviously
+ # that means it's a bogus message, but a mangled result (or exception) is
+ # better than endless recursion. -- rjbs, 2008-01-07
+ return $self->parts_single_part
+ unless $boundary and $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;
$self->{body_raw} = $self->SUPER::body;
@@ -109,8 +118,10 @@
$self->SUPER::body_set(undef);
- # This is a horrible hack, although it's debateable whether it was better
- # or worse when it was $self->{body} = shift @bits ... -- rjbs, 2006-11-27
+ # If there are no headers in the potential MIME part, it's just part of the
+ # body. This is a horrible hack, although it's debateable whether it was
+ # better or worse when it was $self->{body} = shift @bits ... -- rjbs,
+ # 2006-11-27
$self->SUPER::body_set(shift @bits) if ($bits[0] || '') !~ /.*:.*/;
my $bits = @bits;
@@ -130,26 +141,6 @@
sub force_decode_hook { 0 }
sub decode_hook { return $_[1] }
sub content_type { scalar shift->header("Content-type"); }
-
-sub header {
- my $self = shift;
- my @header = $self->SUPER::header(@_);
- foreach my $header (@header) {
- next unless $header =~ /=\?/;
- $header = $self->_header_decode($header);
- }
- return wantarray ? (@header) : $header[0];
-}
-*_header_decode =
- eval { require Encode }
- ? \&_header_decode_encode
- : do {
- require MIME::Words;
- \&_header_decode_mimewords;
- };
-
-sub _header_decode_encode { Encode::decode("MIME-Header", $_[1]) }
-sub _header_decode_mimewords { MIME::Words::decode_mimewords($_[1]) }
sub debug_structure {
my ($self, $level) = @_;
@@ -189,6 +180,8 @@
return "attachment-$$-" . $gname++ . ".$ext";
}
+sub default_header_class { 'Email::MIME::Header' }
+
1;
__END__
@@ -295,7 +288,7 @@
=head1 SEE ALSO
-L<Email::Simple>, L<Email::MIME::Modifier>, L<Email::MIME:Creator>.
+L<Email::Simple>, L<Email::MIME::Modifier>, L<Email::MIME::Creator>.
=head1 PERL EMAIL PROJECT
Added: 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=26198&op=file
==============================================================================
--- trunk/libemail-mime-perl/lib/Email/MIME/Header.pm (added)
+++ trunk/libemail-mime-perl/lib/Email/MIME/Header.pm Wed Oct 22 13:21:34 2008
@@ -1,0 +1,54 @@
+use strict;
+use warnings;
+package Email::MIME::Header;
+use base 'Email::Simple::Header';
+
+use Encode 1.9801;
+
+=head1 NAME
+
+Email::MIME::Header - the header of a MIME message
+
+=head1 DESCRIPTION
+
+This object behaves like a standard Email::Simple header, with the following
+changes:
+
+=over 4
+
+=item * the C<header> method automatically decodes encoded headers if possible
+
+=item * the C<header_raw> method returns the raw header; (read only for now)
+
+=item * stringification uses C<header_raw> rather than C<header>
+
+=back
+
+=cut
+
+sub header {
+ my $self = shift;
+ my @header = $self->SUPER::header(@_);
+ local $@;
+ foreach my $header (@header) {
+ next unless $header =~ /=\?/;
+ $header = $self->_header_decode_str($header);
+ }
+ return wantarray ? (@header) : $header[0];
+}
+
+sub header_raw {
+ Carp::croak "header_raw may not be used to set headers" if @_ > 2;
+ my ($self, $header) = @_;
+ return $self->SUPER::header($header);
+}
+
+sub _header_decode_str {
+ my ($self, $str) = @_;
+ my $new_str;
+ $new_str = $str
+ unless eval { $new_str = Encode::decode("MIME-Header", $str); 1 };
+ return $new_str;
+}
+
+1;
Modified: trunk/libemail-mime-perl/t/3.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libemail-mime-perl/t/3.t?rev=26198&op=diff
==============================================================================
--- trunk/libemail-mime-perl/t/3.t (original)
+++ trunk/libemail-mime-perl/t/3.t Wed Oct 22 13:21:34 2008
@@ -1,8 +1,4 @@
-use Test::More;
-
-if (eval {require Encode}) {
- plan tests => 3;
-} else {Test::More->import(skip_all =>"Unicode support not there on this platform"); }
+use Test::More tests => 3;
# Header decoding tests.
use Email::MIME;
@@ -13,7 +9,20 @@
sub printable ($) {join ("", map {/[\x20-\xff]/i?$_:'\\x'.sprintf("%x",ord$_) } split //, shift) }
-is(printable $obj->header("From"), '\\x963f\\x7f8e.. <simon at oreillynet.com>', "Decoded header");
-is(printable $obj->header("To"), '\\x8cfa1000\\x5143 <gcatey at hoosierlottery.com>', "Decoded header");
-is(printable $obj->header("Subject"),
-'15.\\x570b\\x7acb\\x5927\\x5b78\\x5bc4\\x4f86\\x7684??', "Decoded header");
+is(
+ printable $obj->header("From"),
+ '\\x963f\\x7f8e.. <simon at oreillynet.com>',
+ "Decoded header",
+);
+
+is(
+ printable $obj->header("To"),
+ '\\x8cfa1000\\x5143 <gcatey at hoosierlottery.com>',
+ "Decoded header",
+);
+
+is(
+ printable $obj->header("Subject"),
+ '15.\\x570b\\x7acb\\x5927\\x5b78\\x5bc4\\x4f86\\x7684??',
+ "Decoded header",
+);
More information about the Pkg-perl-cvs-commits
mailing list