r5795 - in /packages/libemail-simple-perl/branches/upstream/current: Changes MANIFEST META.yml Makefile.PL lib/Email/Simple.pm lib/Email/Simple/Header.pm lib/Email/Simple/Headers.pm t/header-new.t t/header-space.t t/perl-minver.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sat Jul 14 21:31:02 UTC 2007
Author: gregoa-guest
Date: Sat Jul 14 21:31:01 2007
New Revision: 5795
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5795
Log:
[svn-upgrade] Integrating new upstream version, libemail-simple-perl (2.002)
Added:
packages/libemail-simple-perl/branches/upstream/current/t/perl-minver.t
Modified:
packages/libemail-simple-perl/branches/upstream/current/Changes
packages/libemail-simple-perl/branches/upstream/current/MANIFEST
packages/libemail-simple-perl/branches/upstream/current/META.yml
packages/libemail-simple-perl/branches/upstream/current/Makefile.PL
packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm
packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Header.pm
packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Headers.pm
packages/libemail-simple-perl/branches/upstream/current/t/header-new.t
packages/libemail-simple-perl/branches/upstream/current/t/header-space.t
Modified: packages/libemail-simple-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/Changes?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/Changes (original)
+++ packages/libemail-simple-perl/branches/upstream/current/Changes Sat Jul 14 21:31:01 2007
@@ -1,4 +1,19 @@
Revision history for Perl extension Email::Simple.
+
+2.002 2007-07-14
+ change initialization order to unbreak Email::MIME
+ do not return ->body from ->body_set to simplify subclass behavior
+
+2.001 2007-07-13
+ fix t/perl-minver.t to properly skip if T::MV not installed
+ retroactively set 2.000 release date!
+
+2.000 2007-07-13
+ huge improvement to speed of bodyless message parsing
+ pointed out by Dan Dascalescu; thanks!
+ more documentation of header class
+ new Header crlf defaults to real CRLF
+ fix tests to avoid requiring 5.6
1.999 2007-03-20
fix bug 25496: deletion of headers affected the wrong range,
Modified: packages/libemail-simple-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/MANIFEST?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libemail-simple-perl/branches/upstream/current/MANIFEST Sat Jul 14 21:31:01 2007
@@ -20,6 +20,7 @@
t/long-msgid.t
t/many-repeats.t
t/no-body.t
+t/perl-minver.t
t/pod-coverage.t
t/pod.t
t/preserve-linefeed.t
Modified: packages/libemail-simple-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/META.yml?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/META.yml (original)
+++ packages/libemail-simple-perl/branches/upstream/current/META.yml Sat Jul 14 21:31:01 2007
@@ -1,9 +1,9 @@
--- #YAML:1.0
name: Email-Simple
-version: 1.999
+version: 2.002
abstract: ~
license: perl
-generated_by: ExtUtils::MakeMaker version 6.31
+generated_by: ExtUtils::MakeMaker version 6.32
distribution_type: module
requires:
Test::More: 0.47
Modified: packages/libemail-simple-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/Makefile.PL?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/Makefile.PL (original)
+++ packages/libemail-simple-perl/branches/upstream/current/Makefile.PL Sat Jul 14 21:31:01 2007
@@ -1,5 +1,7 @@
use strict;
use ExtUtils::MakeMaker;
+
+use 5.00503;
# This is so stupid! We need to make sure that Email::MIME, a downstream
# module, is running a version that doesn't screw around with the guts of
Modified: packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm (original)
+++ packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm Sat Jul 14 21:31:01 2007
@@ -1,19 +1,20 @@
package Email::Simple;
-use 5.00503;
+use 5.00503; # why? -- rjbs, 2007-04-01
use strict;
use Carp ();
use Email::Simple::Header;
-$Email::Simple::VERSION = '1.999';
+$Email::Simple::VERSION = '2.002';
$Email::Simple::GROUCHY = 0;
-my $crlf = qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; # We are liberal in what we accept.
+# We are liberal in what we accept.
+sub __crlf_re { qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; }
=head1 NAME
-Email::Simple - Simple parsing of RFC2822 message format and headers
+Email::Simple - simple parsing of RFC2822 message format and headers
=head1 SYNOPSIS
@@ -41,15 +42,28 @@
=head2 new
-Parse an email from a scalar containing an RFC2822 formatted message,
-and return an object.
+ my $email = Email::Simple->new($message, \%arg);
+
+This method parses an email from a scalar containing an RFC2822 formatted
+message, and return an object. C<$message> may be a reference to a message
+string, in which case the string will be altered in place. This can result in
+significant memory savings.
+
+If you want to create a message from scratch, you should use the plugin
+L<Email::Simple::Creator>.
+
+Valid arguments are:
+
+ header_class - the class used to create new header objects
+ The named module is not 'require'-ed by Email::Simple!
=cut
sub new {
- my ($class, $text) = @_;
-
- Carp::croak 'Unable to parse undefined message' if !defined $text;
+ my ($class, $text, $arg) = @_;
+ $arg ||= {};
+
+ Carp::croak 'Unable to parse undefined message' if ! defined $text;
my $text_ref = ref $text ? $text : \$text;
@@ -66,11 +80,13 @@
$text_ref = \'';
}
- $self->{body} = $text_ref;
+ my $header_class = $arg->{header_class} || $self->_default_header_class;
$self->header_obj_set(
- Email::Simple::Header->new($head, { crlf => $self->crlf })
+ $header_class->new(\$head, { crlf => $self->crlf })
);
+
+ $self->body_set($text_ref);
return $self;
}
@@ -82,8 +98,10 @@
my ($self, $text_ref) = @_;
# For body/header division, see RFC 2822, section 2.1
- if ($$text_ref =~ /(.*?($crlf))\2/gsm) {
- return (pos($$text_ref), $2);
+ my $crlf = $self->__crlf_re;
+
+ if ($$text_ref =~ /(?:.*?($crlf))\1/gsm) {
+ return (pos($$text_ref), $1);
} else {
# The body is, of course, optional.
@@ -95,19 +113,10 @@
my $header = $email->header_obj;
-This method returns the object representing the email's header, and at present
-exists primarily for internal consumption.
-
-=cut
-
-# Header fields are lines composed of a field name, followed by a colon (":"),
-# followed by a field body, and terminated by CRLF. A field name MUST be
-# composed of printable US-ASCII characters (i.e., characters that have values
-# between 33 and 126, inclusive), except colon. A field body may be composed
-# of any US-ASCII characters, except for CR and LF.
-
-# However, a field body may contain CRLF when used in header "folding" and
-# "unfolding" as described in section 2.2.3.
+This method returns the object representing the email's header. For the
+interface for this object, see L<Email::Simple::Header>.
+
+=cut
sub header_obj {
my ($self) = @_;
@@ -141,20 +150,12 @@
In list context, this returns every value for the named header. In scalar
context, it returns the I<first> value for the named header.
-=cut
-
-sub header { $_[0]->header_obj->header($_[1]); }
-
=head2 header_set
$email->header_set($field, $line1, $line2, ...);
Sets the header to contain the given data. If you pass multiple lines
in, you get multiple headers, and order is retained.
-
-=cut
-
-sub header_set { (shift)->header_obj->header_set(@_); }
=head2 header_names
@@ -167,11 +168,6 @@
For backwards compatibility, this method can also be called as B<headers>.
-=cut
-
-sub header_names { $_[0]->header_obj->header_names }
-BEGIN { *headers = \&header_names; }
-
=head2 header_pairs
my @headers = $email->header_pairs;
@@ -182,7 +178,13 @@
=cut
-sub header_pairs { $_[0]->header_obj->header_pairs }
+BEGIN {
+ no strict 'refs';
+ for my $method (qw(header header_set header_names header_pairs)) {
+ *$method = sub { (shift)->header_obj->$method(@_) };
+ }
+ *headers = \&header_names;
+}
=head2 body
@@ -205,7 +207,7 @@
my ($self, $text) = @_;
my $text_ref = ref $text ? $text : \$text;
$self->{body} = $text_ref;
- $self->body;
+ return;
}
=head2 as_string
@@ -228,18 +230,27 @@
sub crlf { $_[0]->{mycrlf} }
+#=head2 default_header_class
+#
+#This returns the class used, by default, for header objects, and is provided
+#for subclassing. The default default is Email::Simple::Header.
+#
+#=cut
+
+sub _default_header_class { 'Email::Simple::Header' }
+
1;
__END__
=head1 CAVEATS
-Email::Simple handles only RFC2822 formatted messages. This means you
-cannot expect it to cope well as the only parser between you and the
-outside world, say for example when writing a mail filter for
-invocation from a .forward file (for this we recommend you use
-L<Email::Filter> anyway). For more information on this issue please
-consult RT issue 2478, L<http://rt.cpan.org/NoAuth/Bug.html?id=2478>.
+Email::Simple handles only RFC2822 formatted messages. This means you cannot
+expect it to cope well as the only parser between you and the outside world,
+say for example when writing a mail filter for invocation from a .forward file
+(for this we recommend you use L<Email::Filter> anyway). For more information
+on this issue please consult RT issue 2478,
+L<http://rt.cpan.org/NoAuth/Bug.html?id=2478>.
=head1 PERL EMAIL PROJECT
Modified: packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Header.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Header.pm?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Header.pm (original)
+++ packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Header.pm Sat Jul 14 21:31:01 2007
@@ -3,10 +3,9 @@
use strict;
use Carp ();
-$Email::Simple::Header::VERSION = '1.999';
-
-# We are liberal in what we accept.
-my $crlf = qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/;
+require Email::Simple;
+
+$Email::Simple::Header::VERSION = '2.000';
=head1 NAME
@@ -31,11 +30,11 @@
my $header = Email::Simple::Header->new($head, \%arg);
C<$head> is a string containing a valid email header, or a reference to such a
-string.
+string. If a reference is passed in, don't expect that it won't be altered.
Valid arguments are:
- crlf - the header's newline; defaults to "\n"
+ crlf - the header's newline; defaults to CRLF
=cut
@@ -48,7 +47,7 @@
my $head_ref = ref $head ? $head : \$head;
- my $self = { mycrlf => $arg->{crlf} || "\n", };
+ my $self = { mycrlf => $arg->{crlf} || "\x0d\x0a", };
my $headers = $class->_header_to_list($head_ref, $self->{mycrlf});
@@ -68,6 +67,8 @@
my @headers;
+ my $crlf = Email::Simple->__crlf_re;
+
while ($$head =~ m/\G(.+?)$crlf/go) {
local $_ = $1;
if (s/^\s+// or not /^([^:]+):\s*(.*)/) {
@@ -84,11 +85,11 @@
return \@headers;
}
-=head2 from_string
-
=head2 as_string
-This returns the stringified header.
+ my $string = $header->as_string(\%arg);
+
+This returns a stringified version of the header.
=cut
@@ -99,51 +100,29 @@
# kept in blocks prepended to the message.
sub as_string {
- my ($self) = @_;
+ my ($self, $arg) = @_;
+ $arg ||= {};
my $header_str = '';
my $headers = $self->{headers};
+ my $fold_arg = {
+ # at => (exists $arg->{fold_at} ? $arg->{fold_at} : $self->default_fold_at),
+ # indent => (exists $arg->{fold_indent} ? $arg->{fold_indent} : $self->default_fold_indent),
+ at => $self->_default_fold_at,
+ indent => $self->_default_fold_indent,
+ };
+
for (my $i = 0; $i < @$headers; $i += 2) {
- $header_str .= $self->_header_as_string(@$headers[ $i, $i + 1 ]);
+ my $header = "$headers->[$i]: $headers->[$i + 1]";
+
+ $header_str .= lc $headers->[$i] eq 'content-type'
+ ? $header . $self->crlf
+ : $self->_fold($header, $fold_arg);
}
return $header_str;
-}
-
-sub _header_as_string {
- my ($self, $field, $data) = @_;
-
- # Ignore "empty" headers; this should not be allowed to happen!
- return '' unless defined $data;
-
- my $string = "$field: $data";
-
- return ((length $string > 78) and (lc $field ne 'content-type'))
- ? $self->_fold($string)
- : ($string . $self->crlf);
-}
-
-sub _fold {
- my $self = shift;
- my $line = shift;
-
- # We know it will not contain any new lines at present
- my $folded = "";
- while ($line) {
- $line =~ s/^\s+//;
- if ($line =~ s/^(.{0,77})(\s|\z)//) {
- $folded .= $1 . $self->crlf;
- $folded .= " " if $line;
- } else {
-
- # Basically nothing we can do. :(
- $folded .= $line . $self->crlf;
- last;
- }
- }
- return $folded;
}
=head2 header_names
@@ -209,6 +188,15 @@
values set in place. Additional headers are added at the end.
=cut
+
+# Header fields are lines composed of a field name, followed by a colon (":"),
+# followed by a field body, and terminated by CRLF. A field name MUST be
+# composed of printable US-ASCII characters (i.e., characters that have values
+# between 33 and 126, inclusive), except colon. A field body may be composed
+# of any US-ASCII characters, except for CR and LF.
+
+# However, a field body may contain CRLF when used in header "folding" and
+# "unfolding" as described in section 2.2.3.
sub header_set {
my ($self, $field, @data) = @_;
@@ -254,9 +242,70 @@
sub crlf { $_[0]->{mycrlf} }
-1;
-
-__END__
+# =head2 fold
+#
+# my $folded = $header->fold($line, \%arg);
+#
+# Given a header string, this method returns a folded version, if the string is
+# long enough to warrant folding. This method is used internally.
+#
+# Valid arguments are:
+#
+# at - fold lines to be no longer than this length, if possible
+# if given and false, never fold headers
+# indent - indent lines with this string
+#
+# =cut
+
+sub _fold {
+ my ($self, $line, $arg) = @_;
+ $arg ||= {};
+
+ $arg->{at} = $self->_default_fold_at unless exists $arg->{at};
+
+ return $line . $self->crlf unless $arg->{at} and $arg->{at} > 0;
+
+ my $limit = ($arg->{at} || $self->_default_fold_at) - 1;
+
+ return $line . $self->crlf if length $line <= $limit;
+
+ $arg->{indent} = $self->_default_fold_indent unless exists $arg->{indent};
+
+ my $indent = $arg->{indent} || $self->_default_fold_indent;
+
+ # We know it will not contain any new lines at present
+ my $folded = "";
+ while ($line) {
+ if ($line =~ s/^(.{0,$limit})(\s|\z)//) {
+ $folded .= $1 . $self->crlf;
+ $folded .= $indent if $line;
+ } else {
+ # Basically nothing we can do. :(
+ $folded .= $line . $self->crlf;
+ last;
+ }
+ }
+
+ return $folded;
+}
+
+# =head2 default_fold_at
+#
+# This method (provided for subclassing) returns the default length at which to
+# try to fold header lines. The default default is 78.
+#
+# =cut
+
+sub _default_fold_at { 78 }
+
+# =head2 default_fold_indent
+#
+# This method (provided for subclassing) returns the default string used to
+# indent folded headers. The default default is a single space.
+#
+# =cut
+
+sub _default_fold_indent { " " }
=head1 PERL EMAIL PROJECT
@@ -265,6 +314,8 @@
L<http://emailproject.perl.org/wiki/Email::Simple::Header>
=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2007 by Ricardo SIGNES
Copyright 2004 by Casey West
@@ -274,3 +325,5 @@
it under the same terms as Perl itself.
=cut
+
+1;
Modified: packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Headers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Headers.pm?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Headers.pm (original)
+++ packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Headers.pm Sat Jul 14 21:31:01 2007
@@ -2,10 +2,10 @@
use strict;
use vars qw[$VERSION];
-$VERSION = '1.970';
+$VERSION = '1.971';
use Carp ();
-Carp::carp 'Email::Simple::Headers is deprecated; using it does nothing'
+Carp::cluck 'Email::Simple::Headers is deprecated; using it does nothing'
unless $ENV{HARNESS_ACTIVE};
1;
@@ -14,28 +14,16 @@
=head1 NAME
-Email::Simple::Headers - a deprecated module that does nothing!
+Email::Simple::Headers - a deprecated module that you shouldn't use!
-=head1 SYNOPSIS
-
- use Email::Simple;
- # use Email::Simple::Headers; # no longer needed as of 2006-08-17
-
- my $email = Email::Simple->new($string);
-
- print $email->header($_), "\n" for $email->headers;
-
=head1 DESCRIPTION
This module used to provide the method C<headers> for Email::Simple objects.
-That method is now part of the Email::Simple module.
+That method is now part of the Email::Simple module. Loading this module will
+emit a verbose diagnostic warning using C<Carp::cluck>.
=head1 SEE ALSO
-L<Email::Simple>
-
-=head1 AUTHOR
-
-Casey West, <F<casey at geeknest.com>>
+L<Email::Simple>, L<Email::Simple::Header>
=cut
Modified: packages/libemail-simple-perl/branches/upstream/current/t/header-new.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/t/header-new.t?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/t/header-new.t (original)
+++ packages/libemail-simple-perl/branches/upstream/current/t/header-new.t Sat Jul 14 21:31:01 2007
@@ -1,5 +1,4 @@
use strict;
-use warnings;
use Test::More tests => 7;
Modified: packages/libemail-simple-perl/branches/upstream/current/t/header-space.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/t/header-space.t?rev=5795&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/t/header-space.t (original)
+++ packages/libemail-simple-perl/branches/upstream/current/t/header-space.t Sat Jul 14 21:31:01 2007
@@ -1,6 +1,5 @@
#!perl -T
use strict;
-use warnings;
use Test::More tests => 8;
use Email::Simple;
Added: packages/libemail-simple-perl/branches/upstream/current/t/perl-minver.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/t/perl-minver.t?rev=5795&op=file
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/t/perl-minver.t (added)
+++ packages/libemail-simple-perl/branches/upstream/current/t/perl-minver.t Sat Jul 14 21:31:01 2007
@@ -1,0 +1,13 @@
+#!perl
+use strict;
+use Test::More;
+
+eval {
+ require Test::MinimumVersion;
+ Test::MinimumVersion->VERSION(0.003);
+ Test::MinimumVersion->import;
+};
+
+plan skip_all => "this test requires Test::MinimumVersion" if $@;
+
+all_minimum_version_ok(5.00503);
More information about the Pkg-perl-cvs-commits
mailing list