use v6.d;
unit module MaildirIndexer::Parser;
use MaildirIndexer::LogTimelineSchema;
use MaildirIndexer::Email;
my @separators = (
"\n\r\n\r",
"\r\n\r\n",
"\n\n",
"\r\r",
);
my grammar Message {
regex TOP {
<headers>
<separator>
<body>
}
regex newline { \r\n | \n\r | \n | \r }
regex separator { @separators }
token body { .* }
regex headers {
<header>+ % <newline>
}
regex header {
<name> \: \h* <value>
|| <junk>
}
token name {
<-[:\s]>+
}
regex value {
<line>+ % [<newline> \h+]
}
token line { \N* }
token junk { \N+ }
}
my class Message-actions {
has $.path = IO;
method TOP($/) {
make MaildirIndexer::Email.new(
headers => $/<headers>.made,
body => $/<body>.Str,
path => $.path,
);
}
method headers($/) {
make %( flat |$/<header>».made );
}
method header($/) {
make $/<junk> ?? () !! ( $/<name>.Str.lc => $/<value>.made );
}
method value($/) {
make $/<line>.join(' ')
}
}
multi parse-email(IO::Path:D $p --> MaildirIndexer::Email) is export {
MaildirIndexer::LogTimelineSchema::Parse::Email::File.log: :file($p.path), {
return parse-email($p.slurp(:enc<utf8-c8>), path => $p);
}
}
multi parse-email(IO::Path:D $p, :$headers-only! --> MaildirIndexer::Email) is export {
my IO::Handle $h; LEAVE { .close with $h };
MaildirIndexer::LogTimelineSchema::Parse::Email::File.log: :file($p.path), {
$h = $p.open(
:enc<utf8-c8>,
:nl-in(@separators),
:!chomp,
);
return parse-email(
$h.lines()[0],
path => $p,
);
}
}
multi parse-email(IO::Socket::Async:D $s --> MaildirIndexer::Email) is export {
MaildirIndexer::LogTimelineSchema::Parse::Email::Socket.log: {
my MaildirIndexer::Email $result;
my $string;
react {
whenever $s.Supply(:enc<utf8-c8>) {
$string ~= $_;
$result = parse-email($string) and done;
QUIT { done };
}
}
return $result;
}
}
multi parse-email(Str:D $email-str, :$path = IO --> MaildirIndexer::Email) is export {
MaildirIndexer::LogTimelineSchema::Parse::Email::Str.log: {
CATCH { return .fail };
with Message.parse($email-str,:actions(Message-actions.new(:$path))) {
return .made;
}
else {
return Nil;
}
}
}