--- 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);