test tool to check dup_header(). show which key is differet or not

1 files changed, 43 insertions, 0 deletions

diff --git a/regress/message/dup_header.pl b/regress/message/dup_header.pl
new file mode 100755
index 00000000..22c31a83
--- /dev/null
+++ b/regress/message/dup_header.pl
@@ -0,0 +1,43 @@
+#!/usr/local/bin/perl
+#-*- perl -*-
+#
+#  Copyright (C) 2001 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $FML: basic_io.pl,v 1.1.1.1 2001/04/07 12:47:01 fukachan Exp $
+#
+
+use strict;
+use Carp;
+use lib qw(../../cpan/lib);
+use Mail::Message;
+
+my $tmp = "/tmp/buf$$";
+
+for my $f (@ARGV) {
+    my $fh  = new FileHandle $f;
+    my $wh  = new FileHandle "> $tmp";
+    my $obj = Mail::Message->parse( { fd => $fh } );
+
+    $wh->autoflush(1);
+    $obj->print($wh);
+
+    print "\n<< $f\n";
+
+    my $newobj = $obj->dup_header;
+
+    for my $k (sort keys %$obj ) {
+	if ( $obj->{ $k } ne $newobj->{ $k } ) {
+	    printf "%-15s is different.\n", $k;
+	    print "     $obj->{ $k } != $newobj->{ $k }\n";
+	}
+	else {
+	    printf "%-15s is same.\n", $k;
+	}
+    }
+}
+
+unlink $tmp;
+
+exit 0;