r3348 - in /packages/libemail-abstract-perl/trunk: Changes MANIFEST
META.yml Makefile.PL README debian/changelog lib/Email/Abstract.pm
lib/Email/Abstract/EmailSimple.pm t/1.t t/abs-object.t t/classy.t t/lib/
t/subclass.t
ntyni-guest at users.alioth.debian.org
ntyni-guest at users.alioth.debian.org
Thu Jul 27 20:40:30 UTC 2006
Author: ntyni-guest
Date: Thu Jul 27 20:40:29 2006
New Revision: 3348
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3348
Log:
svn-upgrade to 2.13
Added:
packages/libemail-abstract-perl/trunk/t/abs-object.t
- copied unchanged from r3347, packages/libemail-abstract-perl/branches/upstream/current/t/abs-object.t
packages/libemail-abstract-perl/trunk/t/classy.t
- copied unchanged from r3347, packages/libemail-abstract-perl/branches/upstream/current/t/classy.t
packages/libemail-abstract-perl/trunk/t/lib/
- copied from r3347, packages/libemail-abstract-perl/branches/upstream/current/t/lib/
Removed:
packages/libemail-abstract-perl/trunk/t/1.t
Modified:
packages/libemail-abstract-perl/trunk/Changes
packages/libemail-abstract-perl/trunk/MANIFEST
packages/libemail-abstract-perl/trunk/META.yml
packages/libemail-abstract-perl/trunk/Makefile.PL
packages/libemail-abstract-perl/trunk/README
packages/libemail-abstract-perl/trunk/debian/changelog
packages/libemail-abstract-perl/trunk/lib/Email/Abstract.pm
packages/libemail-abstract-perl/trunk/lib/Email/Abstract/EmailSimple.pm
packages/libemail-abstract-perl/trunk/t/subclass.t
Modified: packages/libemail-abstract-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/Changes?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/Changes (original)
+++ packages/libemail-abstract-perl/trunk/Changes Thu Jul 27 20:40:29 2006
@@ -1,14 +1,39 @@
Revision history for Perl extension Email::Abstract.
-2.01 2004-11-04
+2.12 2006-07-24
+
+ - test for and permit passing Email::Abstract objects to Email::Abstract
+ class methods
+
+2.12 2006-07-24
+
+ - don't use MIME::Entity in test if it's not available
+
+2.11 2006-07-22
+
+ - better test planning
+
+2.10 2006-07-21
+
+ - add a new method to create wrapper objects
+ - handle subclasses /properly/ (correct ISA order)
+ - improved tests and test coverage
+ - miscellaneous refactoring
+ - update PEP URL
+ - update documentation
+
+2.01 2004-11-04
- Minor Documentation Fix
- Author Change
- PEP Contact Added
-2.0 Wed Aug 25 12:12:37 BST 2004
- - Handle subclasses
-0.01 Wed May 26 16:47:20 2004
+2.0 2004-08-25 12:12:37 BST
+
+ - Handle subclasses
+
+0.01 2004-05-26 16:47 20
+
- original version; created by h2xs 1.22 with options
-AX -b 5.6.0 -n Email::Abstract
Modified: packages/libemail-abstract-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/MANIFEST?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/MANIFEST (original)
+++ packages/libemail-abstract-perl/trunk/MANIFEST Thu Jul 27 20:40:29 2006
@@ -7,7 +7,9 @@
lib/Email/Abstract/MIMEEntity.pm
Makefile.PL
MANIFEST This list of files
-META.yml
README
-t/1.t
+t/abs-object.t
+t/classy.t
+t/lib/Test/EmailAbstract.pm
t/subclass.t
+META.yml Module meta-data (added by MakeMaker)
Modified: packages/libemail-abstract-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/META.yml?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/META.yml (original)
+++ packages/libemail-abstract-perl/trunk/META.yml Thu Jul 27 20:40:29 2006
@@ -1,13 +1,14 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Email-Abstract
-version: 2.01
+version: 2.13
version_from: lib/Email/Abstract.pm
installdirs: site
requires:
+ Class::ISA: 0.20
Email::Simple: 1.91
Module::Pluggable: 1.5
Test::More: 0.47
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30
Modified: packages/libemail-abstract-perl/trunk/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/Makefile.PL?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/Makefile.PL (original)
+++ packages/libemail-abstract-perl/trunk/Makefile.PL Thu Jul 27 20:40:29 2006
@@ -5,9 +5,10 @@
WriteMakefile(
NAME => 'Email::Abstract',
VERSION_FROM => 'lib/Email/Abstract.pm', # finds $VERSION
- PREREQ_PM => {
- 'Email::Simple' => '1.91',
- 'Module::Pluggable' => '1.5',
- 'Test::More' => '0.47',
- },
+ PREREQ_PM => {
+ 'Class::ISA' => '0.20', # first release
+ 'Email::Simple' => '1.91', # avoid undef body
+ 'Module::Pluggable' => '1.5',
+ 'Test::More' => '0.47',
+ },
);
Modified: packages/libemail-abstract-perl/trunk/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/README?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/README (original)
+++ packages/libemail-abstract-perl/trunk/README Thu Jul 27 20:40:29 2006
@@ -62,5 +62,5 @@
under the same terms as Perl itself.
SEE ALSO
- http://pep.kwiki.org
+ http://emailproject.perl.org/wiki/Email::Abstract
Modified: packages/libemail-abstract-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/debian/changelog?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/debian/changelog (original)
+++ packages/libemail-abstract-perl/trunk/debian/changelog Thu Jul 27 20:40:29 2006
@@ -1,3 +1,9 @@
+libemail-abstract-perl (2.13-1) UNRELEASED; urgency=low
+
+ * (NOT RELEASED YET) New upstream release
+
+ -- Niko Tyni <ntyni at iki.fi> Thu, 27 Jul 2006 23:38:36 +0300
+
libemail-abstract-perl (2.01-3) unstable; urgency=low
* New Maintainer: Debian Perl Group (closes: #358895).
Modified: packages/libemail-abstract-perl/trunk/lib/Email/Abstract.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/lib/Email/Abstract.pm?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/lib/Email/Abstract.pm (original)
+++ packages/libemail-abstract-perl/trunk/lib/Email/Abstract.pm Thu Jul 27 20:40:29 2006
@@ -4,75 +4,118 @@
use 5.006;
use strict;
use warnings;
-our $VERSION = '2.01';
+our $VERSION = '2.13';
use Module::Pluggable search_path => [ __PACKAGE__ ], require => 1;
+
my @plugins = __PACKAGE__->plugins(); # Requires them.
-for my $func (qw(get_header get_body
- set_header set_body
- as_string)) {
+my %adapter_for = map { $_->target => $_ } @plugins;
+
+sub object {
+ my ($self) = @_;
+ return unless ref $self;
+ return $$self;
+}
+
+sub new {
+ my ($class, $foreign) = @_;
+
+ return $foreign if eval { $foreign->isa($class) };
+
+ $class = ref($class) || $class;
+
+ $foreign = Email::Simple->new($foreign) unless ref $foreign;
+
+ if (
+ $adapter_for{ref $foreign} or grep { $foreign->isa($_) } keys %adapter_for
+ ) {
+ return bless \$foreign => $class;
+ }
+
+ croak "Don't know how to handle " . ref $foreign;
+}
+
+sub __class_for {
+ my ($self, $foreign, $method) = @_;
+
+ my $f_class = ref($foreign) || $foreign;
+
+ return $adapter_for{ $f_class } if exists $adapter_for{ $f_class };
+
+ require Class::ISA;
+ for my $base (Class::ISA::super_path($f_class)) {
+ return $adapter_for{ $base } if exists $adapter_for{ $base }
+ }
+
+ croak "Don't know how to handle " . $f_class;
+}
+
+sub _obj_and_args {
+ my $self = shift;
+
+ return @_ unless my $thing = $self->object;
+ return ($thing, @_);
+}
+
+for my $func (qw(get_header get_body set_header set_body as_string)) {
no strict 'refs';
*$func = sub {
- my ($class, $thing, @args) = @_;
- $thing = Email::Simple->new($thing) unless ref $thing;
- my $target = ref $thing;
- $target =~ s/:://g;
- $class .= "::".$target;
- if ($class->can($func)) {
- $class->$func($thing, @args);
- } else {
- for my $class (@plugins) {
- if ($class->can("target") and $thing->isa($class->target)) {
- return $class->$func($thing, @args);
- }
- }
- croak "Don't know how to handle ".ref($thing);
+ my $self = shift;
+ my ($thing, @args) = $self->_obj_and_args(@_);
+
+ # In the event of Email::Abstract->get_body($email_abstract), convert
+ # it into an object method call.
+ $thing = $thing->object if eval { $thing->isa($self) };
+
+ unless (ref $thing) {
+ croak "can't alter string in place" if substr($func, 0, 3) eq 'set';
+ $thing = Email::Simple->new($thing)
}
+
+ my $class = $self->__class_for($thing, $func);
+ return $class->$func($thing, @args);
};
}
sub cast {
- my ($class, $thing, $target) = @_;
- $thing = $class->as_string($thing) if ref $thing;
- $target =~ s/:://g;
- $class .= "::".$target;
- if ($class->can("construct")) {
- $class->construct($thing);
- } else {
- for my $class (@plugins) {
- if ($class->can("target") and $thing->isa($class->target)) {
- return $class->construct($thing);
- }
- }
- croak "Don't know how to handle $class";
- }
+ my $self = shift;
+ my ($from, $to) = $self->_obj_and_args(@_);
+
+ croak "Don't know how to construct $to objects"
+ unless $adapter_for{ $to } and $adapter_for{ $to }->can('construct');
+
+ my $from_string = ref($from) ? $self->as_string($from) : $from;
+
+ return $adapter_for{ $to }->construct($from_string);
}
# Preloaded methods go here.
1;
__END__
-# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
-Email::Abstract - Unified interface to mail representations
+Email::Abstract - unified interface to mail representations
=head1 SYNOPSIS
my $message = Mail::Message->read($rfc822)
- || Email::Simple->new($rfc822)
- || Mail::Internet->new([split /\n/, $rfc822])
- || ...;
-
- my $subject = Email::Abstract->get_header($message, "Subject");
- Email::Abstract->set_header($message, "Subject", "My new subject");
-
- my $body = Email::Abstract->get_body($message);
- Email::Abstract->set_body($message, "Hello\nTest message\n");
-
- $rfc822 = Email::Abstract->as_string($message);
-
- my $mail_message = Email::Abstract->cast($message, "Mail::Message");
+ || Email::Simple->new($rfc822)
+ || Mail::Internet->new([split /\n/, $rfc822])
+ || ...
+ || $rfc822;
+
+ my $email = Email::Abstract->new($message);
+
+ my $subject = $email->get_header("Subject");
+ $email->set_header(Subject => "My new subject");
+
+ my $body = $email->get_body;
+ $email->set_body("Hello\nTest message\n");
+
+ $rfc822 = $email->as_string;
+
+ my $mail_message = $email->cast("Mail::Message");
=head1 DESCRIPTION
@@ -94,31 +137,95 @@
=head1 METHODS
-=head2 get_header($obj, $header)
+All of these methods may be called either as object methods or as class
+methods. When called as class methods, the email object (of any class
+supported by Email::Abstract) must be prepended to the list of arguments.
+
+=head2 new
+
+ my $email = Email::Abstract->new($message);
+
+Given a message, either as a string or as an object for which an adapter is
+installed, this method will return a Email::Abstract object wrapping the
+message.
+
+If the message is given as a string, it will be used to construct an object,
+which will then be wrapped.
+
+=head2 get_header
+
+ my $header = $email->get_header($header_name);
+ my $header = Email::Abstract->get_header($message, $header_name);
+
+ my @headers = $email->get_header($header_name);
+ my @headers = Email::Abstract->get_header($message, $header_name);
This returns the value or list of values of the given header.
-=head2 set_header($obj, $header, @lines)
+=head2 set_header
+
+ $email->set_header($header => @lines);
+ Email::Abstract->set_header($message, $header => @lines);
This sets the C<$header> header to the given one or more values.
-=head2 get_body($obj)
+=head2 get_body
+
+ my $body = $email->get_body;
+
+ my $body = Email::Abstract->get_body($message);
This returns the body as a string.
-=head2 set_body($obj, $string)
+=head2 set_body
+
+ $email->set_body($string);
+
+ Email::Abstract->set_body($message, $string);
This changes the body of the email to the given string.
-=head2 as_string($obj)
+=head2 as_string
+
+ my $string = $email->as_string;
+
+ my $string = Email::Abstract->as_string($message);
This returns the whole email as a string.
+=head2 cast
+
+ my $mime_entity = $email->cast('MIME::Entity');
+ my $mime_entity = Email::Abstract->cast($message, 'MIME::Entity');
+
+This method will convert a message from one message class to another. It will
+throw an exception if no adapter for the target class is known, or if the
+adapter does not provide a C<construct> method.
+
+=head2 object
+
+ my $message = $email->object;
+
+This method returns the message object wrapped by Email::Abstract. If called
+as a class method, it returns false.
+
+Note that, because strings are converted to message objects before wrapping,
+this method will return an object when the Email::Abstract was constructed from
+a string.
+
+=head1 PERL EMAIL PROJECT
+
+This module is maintained by the Perl Email Project
+
+ L<http://emailproject.perl.org/wiki/Email::Abstract>
+
=head1 AUTHOR
Casey West, <F<casey at geeknest.com>>
Simon Cozens, <F<simon at cpan.org>>
+
+Ricardo SIGNES, <F<rjbs at cpan.org>>
=head1 COPYRIGHT AND LICENSE
@@ -127,8 +234,4 @@
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-=head1 SEE ALSO
-
-http://pep.kwiki.org
-
=cut
Modified: packages/libemail-abstract-perl/trunk/lib/Email/Abstract/EmailSimple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/lib/Email/Abstract/EmailSimple.pm?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/lib/Email/Abstract/EmailSimple.pm (original)
+++ packages/libemail-abstract-perl/trunk/lib/Email/Abstract/EmailSimple.pm Thu Jul 27 20:40:29 2006
@@ -7,12 +7,13 @@
my ($class, $rfc822) = @_;
Email::Simple->new($rfc822);
}
+
sub get_header {
my ($class, $obj, $header) = @_;
$obj->header($header);
}
-sub get_body {
+sub get_body {
my ($class, $obj) = @_;
$obj->body();
}
Modified: packages/libemail-abstract-perl/trunk/t/subclass.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-abstract-perl/trunk/t/subclass.t?rev=3348&op=diff
==============================================================================
--- packages/libemail-abstract-perl/trunk/t/subclass.t (original)
+++ packages/libemail-abstract-perl/trunk/t/subclass.t Thu Jul 27 20:40:29 2006
@@ -1,13 +1,37 @@
-package MyMail;
-use base "Email::Simple";
-1;
+{
+ package MyMail;
+ use base "Email::Simple";
+}
package main;
-use Test::More tests => 1;
+use Test::More tests => 4;
use Email::Abstract;
my $message = do { local $/; <DATA>; };
my $x = MyMail->new($message);
-like (Email::Abstract->as_string($x), qr/Farley's/, "Round trip with subclass");
+like(Email::Abstract->as_string($x), qr/Farley's/, "Round trip with subclass");
+
+my $y = Email::Abstract->new($x);
+isa_ok($y, 'Email::Abstract');
+like($y->as_string, qr/Farley's/, "Round trip subclass via object wrapped");
+
+SKIP: {
+ skip "this test requires MIME::Entity", 1
+ unless eval { require MIME::Entity; 1 };
+ { # should always adapt as if it's MIME::Entity, the nearest class
+ package MultiHopMail;
+ require MIME::Entity;
+ @MultiHopMail::ISA = qw(MIME::Entity);
+ }
+
+ # We're digging deep into the guts, here. Wear gloves.
+ # In previous versions, this could return Email::Abstract::MailInternet,
+ # because inheritance order was not respected.
+ is(
+ Email::Abstract->__class_for('MultiHopMail'),
+ 'Email::Abstract::MIMEEntity',
+ "we get the nearest path in inheritance order",
+ );
+}
__DATA__
Received: from mailman.opengroup.org ([192.153.166.9])
More information about the Pkg-perl-cvs-commits
mailing list