changed some parts, but do not know anymore what
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Wed, 04 Jan 2012 12:58:40 +0100
changeset 16 3996e5b8789f
parent 15 7c3215a97e4b
child 17 e65ad1481966
changed some parts, but do not know anymore what
lib/Message/2822.pm
t/.perltidyrc
t/000-message.t
--- a/lib/Message/2822.pm	Fri Nov 25 15:44:37 2011 +0100
+++ b/lib/Message/2822.pm	Wed Jan 04 12:58:40 2012 +0100
@@ -26,7 +26,7 @@
       or die "Can't open $DATA{fn}{$self}: $!\n";
 
     local $/ = "";
-    chomp($DATA{header}{$self}   = <$fh>);
+    chomp($DATA{header}{$self} = <$fh>);
     $DATA{body_pos}{$self} = tell($fh);
 
     return $self;
@@ -41,7 +41,9 @@
 sub header_lines {
     my $self = shift;
     my $field = shift // qr/.*/;
-    my @r = grep /$field/i => $DATA{header}{$self} =~ /(^\S+?[: ]\s*.*?\n)(?=^\S|\Z)/imsg;
+    my @r =
+      grep /$field/i => $DATA{header}{$self} =~
+      /(^\S+?[: ]\s*.*?\n)(?=^\S|\Z)/imsg;
     return @r if wantarray;
 
     foreach (@r) { s/\s*?\n\s+/ /mg; }
@@ -55,14 +57,14 @@
 #}
 
 #sub add_header_line {
-    #my $self = shift;
-    #my $_ = shift;
-    #$_ .= "\n" unless /\n$/;
-    #$DATA{header}{$self} .= $_;
+#my $self = shift;
+#my $_ = shift;
+#$_ .= "\n" unless /\n$/;
+#$DATA{header}{$self} .= $_;
 #}
 
 sub header_contents {
-    my $self  = shift;
+    my $self = shift;
     my $field = shift // qr/.*/;
 
     my @r = map { (split /[: ]/, $_, 2)[1] } $self->header_lines($field);
@@ -72,7 +74,6 @@
     return join "" => @r;
 }
 
-
 sub orig_header {
     my $self = shift;
     my $fh   = $DATA{fh}{$self};
@@ -121,6 +122,11 @@
 
 =head1 METHODS
 
+B<Note:> Whenever we mention a I<pattern>, you may pass the pattern 
+as "qr/pattern/", giving you any freedom in choosing modifiers and so on, or
+you may pass the pattern simply as a string "pattern", this well then
+silently converted to "qr/pattern/i".
+
 =over
 
 =item B<new>(file => I<file>)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/.perltidyrc	Wed Jan 04 12:58:40 2012 +0100
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
--- a/t/000-message.t	Fri Nov 25 15:44:37 2011 +0100
+++ b/t/000-message.t	Wed Jan 04 12:58:40 2012 +0100
@@ -3,9 +3,46 @@
 use Test::More;
 
 use_ok "Message::2822"
-    or BAIL_OUT "Can't load the Message::2822 module";
+  or BAIL_OUT "Can't load the Message::2822 module";
+
+my @files = glob("ex/mails/*");
+cmp_ok(@files, ">", 1, "more then 1 test message");
+can_ok("Message::2822", qw(new));
+
+my %message;
+foreach my $file (@files) {
+    my $msg = Message::2822->new(file => $file);
+    isa_ok($msg, "Message::2822", "object is Message::2822 ($file)");
+    $message{$file} = $msg;
+}
+
+# check if we really get all header fields
+foreach my $file (keys %message) {
 
-my $file = "ex/mails/unsigned";
+    # get a sorted list of header fields
+    open(my $f, $file) or die "Can't open $file: $!\n";
+    $/ = "";
+    $_ = <$f>;
+    my @h = sort /^(\S+?[ :])/mg;
+
+    is_deeply([sort $message{$file}->header_fields()], \@h,
+        "all header fields");
+
+    is_deeply(
+        [sort $message{$file}->header_fields('^f')],
+        [grep /^f/i => @h],
+        "partial header fields '^f'"
+    );
+
+    is_deeply(
+        [sort $message{$file}->header_fields(qr/^f/i)],
+        [grep /^f/i => @h],
+        "partial header fields qr/^f/i"
+    );
+}
+
+done_testing;
+__END__
 
 # the object itself
 my $message = Message::2822->new(file => $file);