| Subject: | improve efficiency of ->dup on Mail::Internet |
As written, Mail::Internet's dup method will construct a new, blank body
and header object even if this is not needed. The attached patch will
avoid this. Tests included.
--
rjbs
| Subject: | dup-better.patch |
diff -Nur MailTools-1.74/MANIFEST MailTools-rjbs/MANIFEST
--- MailTools-1.74/MANIFEST 2004-12-21 04:30:37.000000000 -0500
+++ MailTools-rjbs/MANIFEST 2006-11-17 20:51:13.000000000 -0500
@@ -24,6 +24,7 @@
examples/rplyto_demo.PL example script to reply to a message
examples/send_demo.PL example script to send a message using sendmail
examples/mail-mailer.pl example script for Mail::Mailer
+t/dup.t
t/extract.t
t/header.t
t/internet.t
diff -Nur MailTools-1.74/Mail/Internet.pm MailTools-rjbs/Mail/Internet.pm
--- MailTools-1.74/Mail/Internet.pm 2006-01-21 04:16:10.000000000 -0500
+++ MailTools-rjbs/Mail/Internet.pm 2006-11-17 20:43:39.000000000 -0500
@@ -211,13 +211,13 @@
{
my $me = shift;
my $type = ref($me);
- my $dup = $type->new;
- $dup->{'mail_inet_body'} = [@{$me->body}]
- if exists $me->{'mail_inet_body'};
-
- $dup->{'mail_inet_head'} = $me->{'mail_inet_head'}->dup
- if exists $me->{'mail_inet_head'};
+ my $dup = $type->new(
+ (exists $me->{'mail_inet_body'} ? (Body => [@{$me->body}]) : ()),
+ (exists $me->{'mail_inet_head'}
+ ? (Header => $me->{'mail_inet_head'}->dup) : ()
+ ),
+ );
$dup;
}
diff -Nur MailTools-1.74/t/dup.t MailTools-rjbs/t/dup.t
--- MailTools-1.74/t/dup.t 1969-12-31 19:00:00.000000000 -0500
+++ MailTools-rjbs/t/dup.t 2006-11-17 20:51:06.000000000 -0500
@@ -0,0 +1,50 @@
+
+use strict;
+use Mail::Internet;
+
+print "1..5\n";
+
+my $mail = Mail::Internet->new([
+ "Subject: email\n",
+ "\n",
+ "This is the body\n",
+]);
+
+my $i = 1;
+sub ok {
+ my ($ok, $msg) = @_;
+ if ($ok) {
+ printf "ok %s - %s\n", $i++, $msg;
+ } else {
+ printf "not ok %s - %s\n", $i++, $msg;
+ }
+}
+
+ok(
+ eval { $mail->isa('Mail::Internet'); },
+ "constructed object isa Mail::Internet",
+);
+
+ok(
+ $mail->as_string =~ /This is the body/,
+ "as_string looks like what we expect",
+);
+
+my $dup = $mail->dup;
+
+ok(
+ $mail->as_string eq $dup->as_string,
+ "the dup'd mail stringifies to the same as the original"
+);
+
+ok(
+ $mail->head != $dup->head,
+ "the dup and original header are distinct objects",
+);
+
+$dup->body([ "New body!!\n" ]);
+
+ok(
+ $mail->as_string ne $dup->as_string,
+ "changing the dup doesn't change the original"
+);