# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1320929641 -3600
# Node ID 5f6309f600538930bc061acbf7e2f8538eebb2d9
# Parent  caaa00b9165b039239425ef0fc012c0d001809d7
improved Message::2822.pm, find header by header name

diff -r caaa00b9165b -r 5f6309f60053 ex/mails/unsigned
--- a/ex/mails/unsigned	Wed Nov 09 16:50:16 2011 +0100
+++ b/ex/mails/unsigned	Thu Nov 10 13:54:01 2011 +0100
@@ -4,19 +4,24 @@
 Received: from heiko by jumper.schlittermann.de with local (Exim 4.72)
         (envelope-from <hs@schlittermann.de>)
         id 1RO7TQ-00023m-ES; Wed, 09 Nov 2011 13:41:48 +0100
+Received: from heiko by jumper.schlittermann.de some other proto
+        (envelope-from <hs@schlittermann.de>)
+        id 1RO7TQ-00023m-ES; Wed, 09 Nov 2011 10:41:48 +0100
 Date: Wed, 9 Nov 2011 13:41:48 +0100
 From: Heiko Schlittermann <hs@schlittermann.de>
 To: heiko@localhost
 Subject: unsigned
 Message-ID: <20111109124148.GW3429@jumper.schlittermann.de>
 MIME-Version: 1.0
-Content-Type: text/plain; charset=utf-8
 Content-Disposition: inline
 Content-Transfer-Encoding: 8bit
+Content-Length: 51
 Organization: schlittermann -- internet & unix support
 X-Phone: +49.172.7909055 / SMS welcome
 User-Agent: Mutt/1.5.20 (2009-06-14)
 Content-Length: 50
+Content-Type: text/plain; 
+    charset=utf-8
 
 Hallo ötzi,
 dies Mail ist unsigniert.
diff -r caaa00b9165b -r 5f6309f60053 lib/Message/2822.pm
--- a/lib/Message/2822.pm	Wed Nov 09 16:50:16 2011 +0100
+++ b/lib/Message/2822.pm	Thu Nov 10 13:54:01 2011 +0100
@@ -3,56 +3,128 @@
 use 5.010;
 use strict;
 use warnings;
+use Hash::Util qw(lock_keys);
 use IO::File;
 use if $ENV{DEBUG} => "Smart::Comments";
 
-my %DATA;
+my %DATA = (
+    fn => {},
+    fh => {},
+    header => {},
+    body_pos => {},
+);
+
+lock_keys %DATA;
+
 
 sub new {
     my $class = ref $_[0] ? ref shift : shift;
-    my $this = bless \(my $x) => $class;
+    my $self = bless \(my $x) => $class;
     my %arg = @_;
 
-    $DATA{$this}{file} = $arg{file};
-    $DATA{$this}{fh} = IO::File->new($DATA{$this}{file})
-	or die "Can't open $DATA{$this}{file}: $!\n";
+    $DATA{fn}{$self} = $arg{file};
+    $DATA{fh}{$self} = my $fh = IO::File->new($DATA{fn}{$self})
+	or die "Can't open $DATA{fn}{$self}: $!\n";
 
     local $/ = "";
-    my $_ = $DATA{$this}{fh}->getline();
+    $DATA{header}{$self} = <$fh>;
+    $DATA{body_pos}{$self} = tell($fh);
 
-    foreach (split /\n(?=\S)/, $_) {
-	my (undef, $k, $v) = split /(^(?:\S+:|(?i:from )))/, $_;
-	push @{$DATA{$this}{header_fields}}, $k;
-	$DATA{$this}{header}{$k} = $v;
-    }
-
-    return $this;
+    return $self;
 }
 
-sub header_fields {
-    my $this = shift;
-    return @{$DATA{$this}{header_fields}};
+sub __header_fields {
+    my $self = shift;
+    my %h;
+    @h{$DATA{header}{$self}
+	=~ /^(\S+?[: ])/mg} = ();
+    return keys %h;
 }
 
 sub header_content {
-    my $this = shift;
+    my $self = shift;
     my $field = shift;
 
-    my $_ = $DATA{$this}{header}{$field};
+    ### assert: $field =~ /[: ]$/
+
+    # FIXME: not sure if the space following the header field name
+    # is optional or required
+    return $DATA{header}{$self}
+	=~ /^$field\s+(.*?)(?=^\S)/imsg;
+}
 
-    if (not defined) {
-	($field) = grep /^$field$/i => $this->header_fields();
-	$_ = $DATA{$this}{header}{$field}
-    }
+sub orig_header {
+    my $self = shift;
+    my $fh = $DATA{fh}{$self};
+    seek($fh, 0, 0);
+    local $/ = "";
+    return <$fh>;
+}
 
-    /^\s*(.*?)\s*$/m;
-    return $1;
+sub orig_body {
+    my $self = shift;
+    my $fh = $DATA{fh}{$self};
+    seek($fh, $DATA{body_pos}{$self}, 0);
+    local $/ = undef;
+    return <$fh>;
 }
 
 sub DESTROY {
-    my $this = shift;
-    delete $DATA{$this};
+    my $self = shift;
+    foreach (keys %DATA) {
+	delete $DATA{$_}{$self}
+    }
 }
 
+1;
 
-1;
+__END__
+
+=head1 NAME
+
+  Message::2822 - simple parser for 2822 messages
+
+=head1 SYNOPSIS
+
+  use Message::2822;
+
+  my $msg = Message::2822->new(file => "mail.eml");
+
+  my @received = $msg->header_content("received:");
+  my @from_ = $msg->header_content("from ");
+  my @from = $msg->header_content("from:");
+
+=head1 DESCRIPTION
+
+This is a simple parser for RFC2822 messages. I'm sure, such parsers
+exists already about one million times. Here is yet another one.
+
+=head1 METHODS
+
+=over
+
+=item B<new>(file => I<file>)
+
+The construcor. The file is opened r/o and read. The file will not be
+closed until the object disappears.
+
+=item @list = B<header_content>(I<field>)
+
+Returns a list (*always* a list) with the contents of the specified
+header field. The I<field> has to include the colon ":" or space " ",
+since it is considered a part of the field name. I<field> is case
+insensitive!
+
+=item $scalar = $B<orig_header>()
+
+Returns the original header as it is.
+
+=item $body = B<orig_body>()
+
+Returns the original body as it is.
+
+=back
+
+=head1 AUTHOR 
+
+Heiko Schlittermann L<hs@schlittermann.de>
diff -r caaa00b9165b -r 5f6309f60053 scratch/sign
--- a/scratch/sign	Wed Nov 09 16:50:16 2011 +0100
+++ b/scratch/sign	Thu Nov 10 13:54:01 2011 +0100
@@ -7,6 +7,13 @@
 use lib "lib";
 use Message::2822;
 
-my $message = Message::2822->new(file => shift);
+my $message = Message::2822->new(file => shift//"ex/mails/unsigned");
+
+say $message->header_content("received:");
+say $message->header_content("to:");
 
-say join "\n", $message->header_content("content-type:");
+say $message->orig_header();
+say $message->orig_body();
+
+#say map { ">> '$_'\n" } $message->header_fields();
+