From 42d176c71218f2daac666ce3f254356b8798dc68 Mon Sep 17 00:00:00 2001 From: dakkar Date: Fri, 27 Dec 2019 17:18:10 +0000 Subject: Log::Timeline apparently reading from the socket is the slowest bit --- lib/MaildirIndexer/Email.pm6 | 17 +++++++--- lib/MaildirIndexer/Index/ByRef.pm6 | 34 ++++++++++++-------- lib/MaildirIndexer/LogTimelineSchema.pm6 | 20 ++++++++++++ lib/MaildirIndexer/Parser.pm6 | 54 +++++++++++++++++++++----------- lib/MaildirIndexer/Server.pm6 | 11 ++++--- lib/MaildirIndexer/Store.pm6 | 20 ++++++++---- 6 files changed, 109 insertions(+), 47 deletions(-) create mode 100644 lib/MaildirIndexer/LogTimelineSchema.pm6 diff --git a/lib/MaildirIndexer/Email.pm6 b/lib/MaildirIndexer/Email.pm6 index f3c04dd..0614c71 100644 --- a/lib/MaildirIndexer/Email.pm6 +++ b/lib/MaildirIndexer/Email.pm6 @@ -1,5 +1,6 @@ use v6.d.PREVIEW; unit class MaildirIndexer::Email; +use MaildirIndexer::LogTimelineSchema; has IO $.path; has %!headers; @@ -17,8 +18,11 @@ method refs(--> Iterable) { multi split-refs(Any --> Iterable) { return () } multi split-refs(Str:D $str --> Iterable) { - return $/».Str if $str ~~ m{'<' $ = (<-[<>]>+)+ % [ '>' .*? '<' ] '>' }; - return (); + my @result; + MaildirIndexer::LogTimelineSchema::Parse::Header.log: { + @result = $/».Str if $str ~~ m{'<' $ = (<-[<>]>+)+ % [ '>' .*? '<' ] '>' }; + } + return @result; } method addresses (--> Iterable) { @@ -54,8 +58,11 @@ my grammar Address { multi sub extract-addresses(Any --> Iterable) { return () } multi sub extract-addresses(Str:D $str --> Iterable) { - with Address.parse($str) { - return $_».Str; + my @result; + MaildirIndexer::LogTimelineSchema::Parse::Header.log: { + with Address.parse($str) { + @result = $_».Str; + } } - return (); + return @result; } diff --git a/lib/MaildirIndexer/Index/ByRef.pm6 b/lib/MaildirIndexer/Index/ByRef.pm6 index 5a9b53b..d044272 100644 --- a/lib/MaildirIndexer/Index/ByRef.pm6 +++ b/lib/MaildirIndexer/Index/ByRef.pm6 @@ -1,6 +1,7 @@ use v6.d; use MaildirIndexer::Index; unit class MaildirIndexer::Index::ByRef does MaildirIndexer::Index; +use MaildirIndexer::LogTimelineSchema; use MaildirIndexer::Email; has Str %!id-for-file; @@ -12,25 +13,32 @@ method dump() { } method add-mail(MaildirIndexer::Email:D $email, Str:D $mailbox --> Nil) { - my $id = $email.message-id or return; - %!id-for-file{ $email.path } = $id; - %!mailboxes-for-id{ $id }.push($mailbox); - return; + MaildirIndexer::LogTimelineSchema::Index::Add.log: :class('ByRef'),:$mailbox, -> { + my $id = $email.message-id or return; + %!id-for-file{ $email.path } = $id; + %!mailboxes-for-id{ $id }.push($mailbox); + return; + } } method del-path(IO:D $file, Str:D $mailbox --> Nil) { - my $id = %!id-for-file{ $file.path }:delete; - with %!mailboxes-for-id{ $id } { - with .grep($mailbox):k -> $pos { - .splice($pos,1); - } + MaildirIndexer::LogTimelineSchema::Index::Rm.log: :class('ByRef'),:$mailbox, -> { + my $id = %!id-for-file{ $file.path }:delete; + with %!mailboxes-for-id{ $id } { + with .grep($mailbox):k -> $pos { + .splice($pos,1); + } + } + return; } - return; } method mailbox-for-email(MaildirIndexer::Email:D $email --> Str) { - for |$email.refs() -> $ref { - with %!mailboxes-for-id{$ref} { return .[*-1] } + my Str $result; + MaildirIndexer::LogTimelineSchema::Index::Find.log: :class('ByRef'), -> { + for |$email.refs() -> $ref { + with %!mailboxes-for-id{$ref} { $result = .[*-1] } + } } - return Nil; + return $result; } diff --git a/lib/MaildirIndexer/LogTimelineSchema.pm6 b/lib/MaildirIndexer/LogTimelineSchema.pm6 new file mode 100644 index 0000000..1e1848f --- /dev/null +++ b/lib/MaildirIndexer/LogTimelineSchema.pm6 @@ -0,0 +1,20 @@ +use v6.d; +unit module MaildirIndexer::LogTimelineSchema; +use Log::Timeline; + +class Store::Add does Log::Timeline::Task['MaildirIndexer','Store','add file'] { }; +class Store::Rm does Log::Timeline::Task['MaildirIndexer','Store','rm file'] { }; +class Store::Find does Log::Timeline::Task['MaildirIndexer','Store','finding mailbox'] { }; + +class Parse::Email::Str does Log::Timeline::Task['MaildirIndexer','Parser','parsing a string'] { }; +class Parse::Email::File does Log::Timeline::Task['MaildirIndexer','Parser','parsing a file'] { }; +class Parse::Email::Socket does Log::Timeline::Task['MaildirIndexer','Parser','parsing a socket'] { }; + +class Parse::Header does Log::Timeline::Task['MaildirIndexer','Email','parsing a header'] { }; + +class Index::Add does Log::Timeline::Task['MaildirIndexer','Index','add email'] { }; +class Index::Rm does Log::Timeline::Task['MaildirIndexer','Index','rm path'] { }; + +class Index::Find does Log::Timeline::Task['MaildirIndexer','Index','finding mailbox'] { }; + +class Server::Serve does Log::Timeline::Task['MaildirIndexer','Server','serving a request'] { }; diff --git a/lib/MaildirIndexer/Parser.pm6 b/lib/MaildirIndexer/Parser.pm6 index a193f75..7780a62 100644 --- a/lib/MaildirIndexer/Parser.pm6 +++ b/lib/MaildirIndexer/Parser.pm6 @@ -1,5 +1,6 @@ use v6.d.PREVIEW; unit module MaildirIndexer::Parser; +use MaildirIndexer::LogTimelineSchema; use MaildirIndexer::Email; my @separators = ( @@ -58,35 +59,50 @@ my class Message-actions { } multi parse-email(IO::Path:D $p --> MaildirIndexer::Email) is export { - return parse-email($p.slurp(:enc), path => $p); + my MaildirIndexer::Email $result; + MaildirIndexer::LogTimelineSchema::Parse::Email::File.log: :file($p.path), -> { + $result = parse-email($p.slurp(:enc), path => $p); + } + return $result; } multi parse-email(IO::Path:D $p, :$headers-only! --> MaildirIndexer::Email) is export { - return parse-email( - $p.lines( - :enc, - :nl-in(@separators), - :!chomp, - )[0], - path => $p, - ); + my MaildirIndexer::Email $result; + MaildirIndexer::LogTimelineSchema::Parse::Email::File.log: :file($p.path), -> { + $result = parse-email( + $p.lines( + :enc, + :nl-in(@separators), + :!chomp, + )[0], + path => $p, + ); + } + return $result; } multi parse-email(IO::Socket::Async:D $s --> MaildirIndexer::Email) is export { - my $string; - react { - whenever $s.Supply(:enc) { - $string ~= $_; - done if $string ~~ /@separators/; + my MaildirIndexer::Email $result; + MaildirIndexer::LogTimelineSchema::Parse::Email::Socket.log: -> { + my $string; + react { + whenever $s.Supply(:enc) { + $string ~= $_; + done if $string ~~ /@separators/; + } } + $result = parse-email($string); } - return parse-email($string); + return $result; } multi parse-email(Str:D $email-str, :$path = IO --> MaildirIndexer::Email) is export { - CATCH { warn .perl; return Nil }; - with Message.parse($email-str,:actions(Message-actions.new(:$path))) { - return .made; + my MaildirIndexer::Email $result; + MaildirIndexer::LogTimelineSchema::Parse::Email::Str.log: -> { + CATCH { warn .perl; return Nil }; + with Message.parse($email-str,:actions(Message-actions.new(:$path))) { + $result = .made; + } } - return Nil; + return $result; } diff --git a/lib/MaildirIndexer/Server.pm6 b/lib/MaildirIndexer/Server.pm6 index 53f4ba9..0172cf8 100644 --- a/lib/MaildirIndexer/Server.pm6 +++ b/lib/MaildirIndexer/Server.pm6 @@ -1,5 +1,6 @@ use v6.d; unit class MaildirIndexer::Server; +use MaildirIndexer::LogTimelineSchema; use MaildirIndexer::Parser; use MaildirIndexer::Store; @@ -19,10 +20,12 @@ method serve() { $.store.dump(); } whenever $listener -> $conn { - LEAVE { $conn.close } - with parse-email($conn) -> $email { - with $.store.mailbox-for-email($email) -> $mailbox { - await $conn.print("$mailbox\x0d\x0a"); + MaildirIndexer::LogTimelineSchema::Server::Serve.log: { + LEAVE { $conn.close } + with parse-email($conn) -> $email { + with $.store.mailbox-for-email($email) -> $mailbox { + await $conn.print("$mailbox\x0d\x0a"); + } } } } diff --git a/lib/MaildirIndexer/Store.pm6 b/lib/MaildirIndexer/Store.pm6 index 41dc314..5339bf3 100644 --- a/lib/MaildirIndexer/Store.pm6 +++ b/lib/MaildirIndexer/Store.pm6 @@ -1,5 +1,6 @@ use v6.d; unit class MaildirIndexer::Store; +use MaildirIndexer::LogTimelineSchema; use MaildirIndexer::Index; use MaildirIndexer::Parser; @@ -20,10 +21,14 @@ method start(--> Nil) { CATCH { warn .perl }; whenever $.file-channel -> $file { if $file.e && $file.f { - self.add-file($file); + MaildirIndexer::LogTimelineSchema::Store::Add.log: :file($file.path), -> { + self.add-file($file); + } } elsif !$file.e { - self.del-file($file); + MaildirIndexer::LogTimelineSchema::Store::Rm.log: :file($file.path), -> { + self.del-file($file); + } } } } @@ -33,7 +38,7 @@ method start(--> Nil) { method add-file(IO:D $file --> Nil) { my $mailbox = mailbox-from-path($file.path) or return; my $email = parse-email($file,:headers-only) or return; - CATCH { warn .perl }; + CATCH { warn $_ }; $!lock.protect: { .add-mail($email,$mailbox) for @!indices; } @@ -49,10 +54,13 @@ method del-file(IO:D $file --> Nil) { } method mailbox-for-email(MaildirIndexer::Email:D $email --> Str) { - for @!indices -> $index { - with $index.mailbox-for-email($email) { return $_ }; + my Str $result; + MaildirIndexer::LogTimelineSchema::Store::Find.log: { + for @!indices -> $index { + with $index.mailbox-for-email($email) { $result = $_; last }; + } } - return Nil; + return $result; } sub mailbox-from-path(Str() $path --> Str) { -- cgit v1.2.3