r9293 - in /branches/upstream/libemail-mime-modifier-perl: ./ current/ current/lib/ current/lib/Email/ current/lib/Email/MIME/ current/t/
emhn-guest at users.alioth.debian.org
emhn-guest at users.alioth.debian.org
Wed Nov 14 23:50:58 UTC 2007
Author: emhn-guest
Date: Wed Nov 14 23:50:58 2007
New Revision: 9293
URL: http://svn.debian.org/wsvn/?sc=1&rev=9293
Log:
[svn-inject] Installing original source of libemail-mime-modifier-perl
Added:
branches/upstream/libemail-mime-modifier-perl/
branches/upstream/libemail-mime-modifier-perl/current/
branches/upstream/libemail-mime-modifier-perl/current/Changes
branches/upstream/libemail-mime-modifier-perl/current/MANIFEST
branches/upstream/libemail-mime-modifier-perl/current/META.yml
branches/upstream/libemail-mime-modifier-perl/current/Makefile.PL
branches/upstream/libemail-mime-modifier-perl/current/README
branches/upstream/libemail-mime-modifier-perl/current/lib/
branches/upstream/libemail-mime-modifier-perl/current/lib/Email/
branches/upstream/libemail-mime-modifier-perl/current/lib/Email/MIME/
branches/upstream/libemail-mime-modifier-perl/current/lib/Email/MIME/Modifier.pm
branches/upstream/libemail-mime-modifier-perl/current/t/
branches/upstream/libemail-mime-modifier-perl/current/t/content_id.t
branches/upstream/libemail-mime-modifier-perl/current/t/ct_attrs.t
branches/upstream/libemail-mime-modifier-perl/current/t/disposition.t
branches/upstream/libemail-mime-modifier-perl/current/t/encoding.t
branches/upstream/libemail-mime-modifier-perl/current/t/parts.t
branches/upstream/libemail-mime-modifier-perl/current/t/pod-coverage.t
branches/upstream/libemail-mime-modifier-perl/current/t/pod.t
Added: branches/upstream/libemail-mime-modifier-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/Changes?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/Changes (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/Changes Wed Nov 14 23:50:58 2007
@@ -1,0 +1,36 @@
+1.442 2006-08-04
+ correct body_set behavior to handle refs
+ reformat changelog to standard PEP format
+ completely horrible fix to prevent re-encoding of encoded text during
+ creation
+
+1.441 2006-11-28
+ avoid warnings on part counting
+
+1.440 2006-08-04
+ don't make a singepart message if told to make a multipart
+
+1.43 2006-07-13
+ reliable ordering of content-type attributes (bug 9206)
+ improve handling of one-part messages
+ plan all tests
+
+1.42 2004-12-23
+ Automatically create Content-ID headers where they don't already
+ exist, for part children. This helps people tasked with the
+ horrible affliction of sending HTML email with embedded images.
+
+1.41 2004-12-23
+ Enhanced detection for converting from single to multipart, and
+ back.
+
+1.3 2004-10-04
+ New methods parts_add() and walk_parts().
+ No prereq on Test::Deep for testing (ADAMK).
+
+1.2 2004-07-09
+ boundary_set() now repackages children MIME parts so the object
+ stays in sync.
+
+1.1 2004-07-05
+ Initial version.
Added: branches/upstream/libemail-mime-modifier-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/MANIFEST?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/MANIFEST (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/MANIFEST Wed Nov 14 23:50:58 2007
@@ -1,0 +1,13 @@
+Changes
+lib/Email/MIME/Modifier.pm
+Makefile.PL
+MANIFEST This list of files
+README
+t/content_id.t
+t/ct_attrs.t
+t/disposition.t
+t/encoding.t
+t/parts.t
+t/pod.t
+t/pod-coverage.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libemail-mime-modifier-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/META.yml?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/META.yml (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/META.yml Wed Nov 14 23:50:58 2007
@@ -1,0 +1,19 @@
+--- #YAML:1.0
+name: Email-MIME-Modifier
+version: 1.442
+abstract: Modify Email::MIME Objects Easily
+license: perl
+generated_by: ExtUtils::MakeMaker version 6.32
+distribution_type: module
+requires:
+ Email::MessageID: 1.2
+ Email::MIME: 1.82
+ Email::MIME::ContentType: 1.0
+ Email::MIME::Encodings: 1.3
+ Email::Simple: 1.92
+ Test::More: 0.47
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Casey West <casey at geeknest.com>
Added: branches/upstream/libemail-mime-modifier-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/Makefile.PL?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/Makefile.PL (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/Makefile.PL Wed Nov 14 23:50:58 2007
@@ -1,0 +1,18 @@
+use strict;
+use ExtUtils::MakeMaker;
+
+WriteMakefile (
+ AUTHOR => 'Casey West <casey at geeknest.com>',
+ ABSTRACT => "Modify Email::MIME Objects Easily",
+ NAME => 'Email::MIME::Modifier',
+ (eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
+ PREREQ_PM => {
+ 'Email::MIME' => '1.82',
+ 'Email::MessageID' => '1.2',
+ 'Email::Simple' => '1.92',
+ 'Test::More' => '0.47',
+ 'Email::MIME::ContentType' => '1.0',
+ 'Email::MIME::Encodings' => '1.3',
+ },
+ VERSION_FROM => 'lib/Email/MIME/Modifier.pm',
+);
Added: branches/upstream/libemail-mime-modifier-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/README?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/README (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/README Wed Nov 14 23:50:58 2007
@@ -1,0 +1,124 @@
+NAME
+ Email::MIME::Modifier - Modify Email::MIME Objects Easily
+
+SYNOPSIS
+ use Email::MIME;
+ use Email::MIME::Modifier;
+ my $email = Email::MIME->new( join "", <> );
+
+ remove_attachments($email);
+
+ sub remove_attachments {
+ my $email = shift;
+ my @keep;
+ foreach my $part ( $email->parts ) {
+ push @keep, $part
+ unless $part->header('Content-Disposition') =~ /^attachment/;
+ remove_attachments($part)
+ if $part->content_type =~ /^(?:multipart|message)/;
+ }
+ $email->parts_set( \@keep );
+ }
+
+DESCRIPTION
+ Provides a number of useful methods for manipulating MIME messages.
+
+ These method are declared in the "Email::MIME" namespace, and are used
+ with "Email::MIME" objects.
+
+ Methods
+ content_type_set
+ $email->content_type_set( 'text/html' );
+
+ Change the content type. All "Content-Type" header attributes will
+ remain in tact.
+
+ charset_set
+ name_set
+ format_set
+ 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 "Content-Type" attributes. If set
+ to "undef", the attribute is removed. All other "Content-Type"
+ header information is preserved when modifying an attribute.
+
+ encoding_set
+ $email->encoding_set( 'base64' );
+ $email->encoding_set( 'quoted-printable' );
+ $email->encoding_set( '8bit' );
+
+ Convert the message body and alter the "Content-Transfer-Encoding"
+ header using this method. Your message body, the output of the
+ "body()" method, will remain the same. The raw body, output with the
+ "body_raw()" method, will be changed to reflect the new encoding.
+
+ body_set
+ $email->body_set( $unencoded_body_string );
+
+ This method will encode the new body you send using the encoding
+ specified in the "Content-Transfer-Encoding" header, then set the
+ body to the new encoded body.
+
+ This method overrides the default "body_set()" method.
+
+ disposition_set
+ $email->disposition_set( 'attachment' );
+
+ Alter the "Content-Disposition" of a message. All header attributes
+ will remain in tact.
+
+ filename_set
+ $email->filename_set( 'boo.pdf' );
+
+ Sets the filename attribute in the "Content-Disposition" header. All
+ other header information is preserved when setting this attribute.
+
+ parts_set
+ $email->parts_set( \@new_parts );
+
+ Replaces the parts for an object. Accepts a reference to a list of
+ "Email::MIME" objects, representing the new parts. If this message
+ was originally a single part, the "Content-Type" header will be
+ changed to "multipart/mixed", and given a new boundary attribute.
+
+ parts_add
+ $email->parts_add( \@more_parts );
+
+ Adds MIME parts onto the current MIME part. This is a simple
+ extension of "parts_set" to make our lives easier. It accepts an
+ array reference of additional parts.
+
+ 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.
+
+SEE ALSO
+ Email::Simple, Email::MIME, Email::MIME::Encodings,
+ Email::MIME::ContentType, perl.
+
+AUTHOR
+ Casey West, <casey at geeknest.com>.
+
+COPYRIGHT
+ Copyright (c) 2004 Casey West. All rights reserved.
+ This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
Added: branches/upstream/libemail-mime-modifier-perl/current/lib/Email/MIME/Modifier.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/lib/Email/MIME/Modifier.pm?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/lib/Email/MIME/Modifier.pm (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/lib/Email/MIME/Modifier.pm Wed Nov 14 23:50:58 2007
@@ -1,0 +1,419 @@
+use strict;
+## no critic warnings
+
+package Email::MIME::Modifier;
+
+use vars qw[$VERSION];
+$VERSION = '1.442';
+
+use Email::MIME;
+
+package Email::MIME;
+
+use Email::MIME::ContentType;
+use Email::MIME::Encodings;
+use Email::MessageID;
+
+=head1 NAME
+
+Email::MIME::Modifier - Modify Email::MIME Objects Easily
+
+=head1 VERSION
+
+version 1.442
+
+ $Id: /my/pep/Email-MIME-Modifier/trunk/lib/Email/MIME/Modifier.pm 28539 2006-11-28T01:49:38.991940Z rjbs $
+
+=head1 SYNOPSIS
+
+ use Email::MIME::Modifier;
+ my $email = Email::MIME->new( join "", <> );
+
+ remove_attachments($email);
+
+ sub remove_attachments {
+ my $email = shift;
+ my @keep;
+ foreach my $part ( $email->parts ) {
+ push @keep, $part
+ unless $part->header('Content-Disposition') =~ /^attachment/;
+ remove_attachments($part)
+ if $part->content_type =~ /^(?:multipart|message)/;
+ }
+ $email->parts_set( \@keep );
+ }
+
+=head1 DESCRIPTION
+
+Provides a number of useful methods for manipulating MIME messages.
+
+These method are declared in the C<Email::MIME> namespace, and are
+used with C<Email::MIME> objects.
+
+=head2 Methods
+
+=over 4
+
+=item 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;
+}
+
+=pod
+
+=item charset_set
+
+=item name_set
+
+=item format_set
+
+=item 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;
+}
+
+=pod
+
+=item 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 );
+}
+
+=item 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 );
+}
+
+=pod
+
+=item 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);
+}
+
+=pod
+
+=item 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);
+}
+
+=pod
+
+=item 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;
+}
+
+=item 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},
+ ]);
+}
+
+=item 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__
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Email::Simple>, L<Email::MIME>, L<Email::MIME::Encodings>,
+L<Email::MIME::ContentType>, L<perl>.
+
+=head1 PERL EMAIL PROJECT
+
+This module is maintained by the Perl Email Project
+
+L<http://emailproject.perl.org/wiki/Email::MIME>
+
+=head1 AUTHOR
+
+Casey West, <F<casey at geeknest.com>>.
+
+=head1 COPYRIGHT
+
+ Copyright (c) 2004 Casey West. All rights reserved.
+ This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libemail-mime-modifier-perl/current/t/content_id.t
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/t/content_id.t?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/t/content_id.t (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/t/content_id.t Wed Nov 14 23:50:58 2007
@@ -1,0 +1,52 @@
+use Test::More tests => 15;
+use strict;
+$^W = 1;
+
+use_ok 'Email::MIME::Modifier';
+
+my $email = Email::MIME->new(<<'__MESSAGE__');
+From: me at example.com
+To: you at example.com
+__MESSAGE__
+
+isa_ok $email, 'Email::MIME';
+my $email2 = Email::MIME->new($email->as_string);
+isa_ok $email2, 'Email::MIME';
+
+my @parts = ( q[Part one], q[Part two] );
+
+$email->content_type_set('multipart/mixed');
+$email->parts_set([map Email::MIME->new("Header: Foo\n\n$_"), @parts]);
+
+is scalar($email->parts), 2, 'two parts';
+like $email->content_type, qr[multipart/mixed], 'proper content_type';
+
+my @email_cids;
+$email->walk_parts(sub{
+ return if $_[0] == $email;
+ push @email_cids, shift->header('Content-ID');
+});
+
+is scalar(@email_cids), 2, 'two content ids';
+ok $_, "$_ defined" for @email_cids;
+isnt $email_cids[0], $email_cids[1], 'not the same';
+
+
+
+
+$email2->parts_set([map Email::MIME->new("Header: Foo\n\n$_"), @parts]);
+$email2->content_type_set('multipart/alternative');
+
+is scalar($email2->parts), 2, 'two parts';
+like $email2->content_type, qr[multipart/alternative], 'proper content_type';
+
+my @email2_cids;
+$email2->walk_parts(sub{
+ return if $_[0] == $email2;
+ push @email2_cids, shift->header('Content-ID');
+});
+
+is scalar(@email2_cids), 2, 'two content ids';
+ok $_, "$_ defined" for @email2_cids;
+is $email2_cids[0], $email2_cids[1], 'the same';
+
Added: branches/upstream/libemail-mime-modifier-perl/current/t/ct_attrs.t
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/t/ct_attrs.t?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/t/ct_attrs.t (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/t/ct_attrs.t Wed Nov 14 23:50:58 2007
@@ -1,0 +1,74 @@
+use Test::More tests => 10;
+
+use_ok 'Email::MIME';
+use_ok 'Email::MIME::Modifier';
+use_ok 'Email::MIME::ContentType';
+
+my $email = Email::MIME->new(<<__MESSAGE__);
+Content-Type: text/plain; charset="us-ascii"
+__MESSAGE__
+
+is_deeply( parse_content_type($email->header('Content-Type')), {
+ discrete => 'text',
+ composite => 'plain',
+ attributes => {
+ charset => 'us-ascii',
+ },
+}, 'default ct worked' );
+
+$email->charset_set( 'utf8' );
+
+is_deeply( parse_content_type($email->header('Content-Type')), {
+ discrete => 'text',
+ composite => 'plain',
+ attributes => {
+ charset => 'utf8',
+ },
+}, 'ct with new charset worked' );
+
+$email->charset_set( undef );
+
+is_deeply( parse_content_type($email->header('Content-Type')), {
+ discrete => 'text',
+ composite => 'plain',
+ attributes => {
+ },
+}, 'ct with no charset worked' );
+
+$email->format_set( 'flowed' );
+
+is_deeply( parse_content_type($email->header('Content-Type')), {
+ discrete => 'text',
+ composite => 'plain',
+ attributes => {
+ format => 'flowed',
+ },
+}, 'ct with format worked' );
+
+$email->name_set( 'foo.txt' );
+
+is_deeply( parse_content_type($email->header('Content-Type')), {
+ discrete => 'text',
+ composite => 'plain',
+ attributes => {
+ format => 'flowed',
+ name => 'foo.txt',
+ },
+}, 'ct with name worked' );
+
+is $email->header('Content-Type'),
+ 'text/plain; format="flowed"; name="foo.txt"',
+ 'ct format is correct';
+
+$email->boundary_set( 'marker' );
+
+is_deeply( parse_content_type($email->header('Content-Type')), {
+ discrete => 'text',
+ composite => 'plain',
+ attributes => {
+ boundary => 'marker',
+ format => 'flowed',
+ name => 'foo.txt',
+ },
+}, 'ct with boundary worked' );
+
Added: branches/upstream/libemail-mime-modifier-perl/current/t/disposition.t
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/t/disposition.t?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/t/disposition.t (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/t/disposition.t Wed Nov 14 23:50:58 2007
@@ -1,0 +1,30 @@
+use Test::More tests => 7;
+
+use_ok 'Email::MIME';
+use_ok 'Email::MIME::Modifier';
+
+my $email = Email::MIME->new(<<__MESSAGE__);
+Content-Disposition: inline
+
+Engine Engine number nine.
+__MESSAGE__
+
+isa_ok $email, 'Email::MIME';
+
+
+$email->disposition_set('attachment');
+
+is $email->header('Content-Disposition'), 'attachment', 'reset worked';
+
+$email->filename_set( 'loco.pdf' );
+
+is $email->header('Content-Disposition'), 'attachment; filename="loco.pdf"', 'filename_set worked';
+
+$email->disposition_set('inline');
+
+is $email->header('Content-Disposition'), 'inline; filename="loco.pdf"', 're-reset worked';
+
+$email->filename_set(undef);
+
+is $email->header('Content-Disposition'), 'inline', 'filename_set(undef) worked';
+
Added: branches/upstream/libemail-mime-modifier-perl/current/t/encoding.t
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/t/encoding.t?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/t/encoding.t (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/t/encoding.t Wed Nov 14 23:50:58 2007
@@ -1,0 +1,55 @@
+use Test::More tests => 14;
+
+use_ok 'Email::MIME';
+use_ok 'Email::MIME::Modifier';
+
+my $email = Email::MIME->new(<<__MESSAGE__);
+Content-Transfer-Encoding: 7bit
+Content-Type: text/plain
+
+Hello World!
+I like you!
+__MESSAGE__
+
+is $email->body, qq[Hello World!\nI like you!\n], 'plain works';
+is $email->body_raw, qq[Hello World!\nI like you!\n], 'plain raw works';
+is $email->header('Content-Transfer-Encoding'), '7bit', 'plain encoding works';
+
+$email->encoding_set('base64');
+
+is $email->body, qq[Hello World!\nI like you!\n], 'base64 works';
+is $email->body_raw, qq[SGVsbG8gV29ybGQhCkkgbGlrZSB5b3UhCg==\n], 'base64 raw works';
+is $email->header('Content-Transfer-Encoding'), 'base64', 'base64 encoding works';
+
+$email->encoding_set('binary');
+
+is $email->body, qq[Hello World!\nI like you!\n], 'binary works';
+is $email->body_raw, qq[Hello World!\nI like you!\n], 'binary raw works';
+is $email->header('Content-Transfer-Encoding'), 'binary', 'binary encoding works';
+
+my $long_line = 'Long line! ' x 100;
+
+$email->encoding_set('quoted-printable');
+$email->body_set(<<__MESSAGE__);
+$long_line
+__MESSAGE__
+
+is $email->body, qq[$long_line\n], 'quoted-printable + body_set works';
+is $email->body_raw, <<__RAW__, 'quoted-printable + body_set raw works';
+Long line! Long line! Long line! Long line! Long line! Long line! Long line=
+! Long line! Long line! Long line! Long line! Long line! Long line! Long li=
+ne! Long line! Long line! Long line! Long line! Long line! Long line! Long =
+line! Long line! Long line! Long line! Long line! Long line! Long line! Lon=
+g line! Long line! Long line! Long line! Long line! Long line! Long line! L=
+ong line! Long line! Long line! Long line! Long line! Long line! Long line!=
+ Long line! Long line! Long line! Long line! Long line! Long line! Long lin=
+e! Long line! Long line! Long line! Long line! Long line! Long line! Long l=
+ine! Long line! Long line! Long line! Long line! Long line! Long line! Long=
+ line! Long line! Long line! Long line! Long line! Long line! Long line! Lo=
+ng line! Long line! Long line! Long line! Long line! Long line! Long line! =
+Long line! Long line! Long line! Long line! Long line! Long line! Long line=
+! Long line! Long line! Long line! Long line! Long line! Long line! Long li=
+ne! Long line! Long line! Long line! Long line! Long line! Long line! Long =
+line! Long line! Long line! Long line! Long line!=20
+__RAW__
+is $email->header('Content-Transfer-Encoding'), 'quoted-printable', 'quoted-printble + body_set encoding works';
Added: branches/upstream/libemail-mime-modifier-perl/current/t/parts.t
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/t/parts.t?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/t/parts.t (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/t/parts.t Wed Nov 14 23:50:58 2007
@@ -1,0 +1,50 @@
+use Test::More tests => 22;
+
+use_ok 'Email::MIME';
+use_ok 'Email::MIME::Modifier';
+
+my $email = Email::MIME->new(<<__MESSAGE__);
+Content-Disposition: inline
+
+Engine Engine number nine.
+__MESSAGE__
+
+isa_ok $email, 'Email::MIME';
+
+is scalar($email->parts), 1, 'only one part';
+
+$email->parts_set([ Email::MIME->new(<<__MESSAGE__), Email::MIME->new(<<__MESSAGE2__) ]);
+Content-Type: text/plain
+
+Part one, part one!
+__MESSAGE__
+Content-Transfer-Encoding: base64
+
+UGFydCB0d28sIHBhcnQgdHdvIQo=
+__MESSAGE2__
+
+
+is scalar($email->parts), 2, 'two parts';
+is +($email->parts)[1]->body, qq[Part two, part two!\n], 'part two decoded';
+
+$email->parts_add([ $email->parts ]);
+
+is scalar($email->parts), 4, 'four parts';
+is +($email->parts)[1]->body, qq[Part two, part two!\n], 'part two decoded again';
+is +($email->parts)[3]->body, qq[Part two, part two!\n], 'part four decoded';
+
+$email->walk_parts(sub {
+ my $part = shift;
+ isa_ok $part, 'Email::MIME';
+
+ $part->encoding_set('base64') if $part->parts <= 1;
+ $part->body_set( "foo\nbar" ) if $part->parts <= 1;
+});
+
+$email->walk_parts(sub {
+ my $part = shift;
+ if ( $part->parts <= 1 ) {
+ is $part->header('Content-Transfer-Encoding'), 'base64', 'walkdown encoding worked';
+ is $part->body, "foo\nbar", 'walkdown body_set worked';
+ }
+});
Added: branches/upstream/libemail-mime-modifier-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/t/pod-coverage.t?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/t/pod-coverage.t Wed Nov 14 23:50:58 2007
@@ -1,0 +1,10 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.08";
+plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage"
+ if $@;
+
+all_pod_coverage_ok({
+ coverage_class => 'Pod::Coverage::CountParents'
+});
Added: branches/upstream/libemail-mime-modifier-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libemail-mime-modifier-perl/current/t/pod.t?rev=9293&op=file
==============================================================================
--- branches/upstream/libemail-mime-modifier-perl/current/t/pod.t (added)
+++ branches/upstream/libemail-mime-modifier-perl/current/t/pod.t Wed Nov 14 23:50:58 2007
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list