# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1325678320 -3600 # Node ID 3996e5b8789f3e2a4267ffbcbf7741fc5eebbf1f # Parent 7c3215a97e4b1713edb3d8f2385c84b2f7f5afd2 changed some parts, but do not know anymore what diff -r 7c3215a97e4b -r 3996e5b8789f lib/Message/2822.pm --- 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 Whenever we mention a I, 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(file => I) diff -r 7c3215a97e4b -r 3996e5b8789f t/.perltidyrc --- /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 diff -r 7c3215a97e4b -r 3996e5b8789f t/000-message.t --- 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);