X-Git-Url: https://git.jankratochvil.net/?a=blobdiff_plain;f=My-Audit.pm;h=bd8de88f07bcf506884de27c28cc846088e310a0;hb=7e856e92b7199ad1d923b76b8f6a42c0660b67ae;hp=781288d4d2552651fd449ab0f2240e15b3ce69be;hpb=07dc23479fff656e8e8c715d2e9177e3eab2ad2a;p=PerlMail.git diff --git a/My-Audit.pm b/My-Audit.pm index 781288d..bd8de88 100644 --- a/My-Audit.pm +++ b/My-Audit.pm @@ -156,15 +156,31 @@ sub audit store "==","sms" if !did; } +sub audit_sms_address +{ +my($obj)=@_; + + my $address=$obj->address(); + if (my $alternates=muttrc_get("alternates")) { + return "I" if $address=~/$alternates/si; + } + my %aliases=muttrc_aliases(); + if (my $alias=$aliases{lc $address}) { + local $_=$alias; + s/\.cz$//i; + return $_; + } + local $_=$address; + s/\b(Bus)siness$/$1/i; + s/\.ident$//i; + return $_; +} + sub audit_sms { my(%args)=@_; - my $from=(@{$args{"from"}} ? join(",",map({ - s/\.cz$//i; - s/\b(Bus)siness$/$1/i; - $_; - } @{$args{"from"}})) : "?"); + my $from=(@{$args{"from"}} ? join(",",map({ audit_sms_address($_); } @{$args{"from"}})) : "?"); local $_; $_=$args{"subject"}; @@ -182,14 +198,15 @@ my(%args)=@_; # max. 9 lines of .sig s/\n-- (?:\n[^\n]*){0,9}$//gs; # "Original Message"/"Puvodni zprava" etc. up to empty line - s/(^|\n)[\s^\n]*-----[\w\s]*-----[\s^\n]*(?:\n[^\n]+)*\n{2,}(?:\s*[^>\s].*$)?/\n/gs; + # "- - - Original message: - - -" is by "Lotus Notes Release 5.0.5 September 22, 2000" + s/(^|\n)[\s^\n]*(?:-----[\w\s]*-----|- - - Original message: - - -)[\s^\n]*(?:\n[^\n]+)*\n{2,}(?:\s*[^>\s].*$)?/\n/gs; # Remove "..." lines (is it used by anyone except me?) s/^\Q...\E$/*/gm; # quoting "> " - s/^\s*[>][>\s]*.*$/*/gm; + s/^(?:\s*[[:upper:]]{0,3}>)+.*$/*/gm; s/(?:^|\n)(?:\*\n+)+/\n*\n/gs; # attributions - s/^.*\b(?:wrote|writes):\s*$//gm; + s/^.*\b(?:wrote|writes|napsal jste):\s*$//gm; my $body=$_; return [$from,"($subject)$body"];