--- /dev/null
+use strict;
+use Irssi;
+
+use Encode qw(decode);
+use IO::Handle;
+use Log::Procmail;
+use MIME::Words qw(decode_mimewords);
+use Time::HiRes qw(usleep);
+
+our $VERSION = '2.02';
+our %IRSSI = (
+ authors => 'Cyprien Debu',
+ contact => 'frey@notk.org',
+ name => 'procmaillog',
+ description => 'Gets new mails from procmail.log file',
+ license => 'Public Domain',
+ url => '',
+ changed => '06-2014'
+);
+
+my $sn = $IRSSI{name};
+
+Irssi::settings_add_level $sn, $sn.'_default_level', 'MSGS';
+Irssi::settings_add_int $sn, $sn.'_folder_pad', 15;
+Irssi::settings_add_str $sn, $sn.'_folders_color', '4,^error$';
+Irssi::settings_add_str $sn, $sn.'_folders_level', '';
+Irssi::settings_add_str $sn, $sn.'_folders_silent', 'spam';
+Irssi::settings_add_str $sn, $sn.'_logfile', '~/.procmail.log';
+Irssi::settings_add_int $sn, $sn.'_max_length', 90;
+Irssi::settings_add_str $sn, $sn.'_split_chars', ',;';
+Irssi::settings_add_str $sn, $sn.'_window', '(status)';
+
+Irssi::theme_register([
+ $sn.'_mail', '$0',
+ $sn.'_crap', '{line_start}{hilight '.$sn.':} $0'
+]);
+
+sub print_help
+{
+ print( <<EOF
+
+This script reads your procmail.log file and prints it in the form:
+| folder-name | subject
+
+Many options are available, see /set ${sn}:
+- default_level: default level of printed messages
+- folder_pad: padding added to the folder name if length(folder name) < folder_pad
+- folders_color: semicolon-separated list of pairs of <color, regex>: the folders that match the regex will be colorized following the codes listed here: http://irssi.org/documentation/formats (mIRC colors)
+ Example: 5,foo;8,bar -> colorize foo in red and bar in yellow
+- folders_level: same behaviour as folders_color but with levels instead of color numbers. NOTICES,foo will print folders matching foo with a NOTICES level
+- folders_silent: regex, folders you don't want to print
+- logfile: path to your procmail.log (default: ~/.procmail.log)
+- max_length: max length of the line
+- split_chars: ,; by default, split characters used in folders_color and folders_level strings
+ Change them if you use these characters in your folders names
+- window: the target window name
+
+Available subcommands: help, start, stop.
+
+The script may fail at first launch if it doesn't find your procmail.log file, just set the option and do /${sn} start.
+EOF
+ );
+}
+
+my $child;
+
+sub print_crap
+{
+ Irssi::printformat MSGLEVEL_CLIENTCRAP, $sn.'_crap', $_
+ foreach @_;
+}
+
+sub print_error
+{
+ print_crap "\x034Error:\x03 ".shift, @_;
+}
+
+# Utility function to parse folders_color and folders_level options.
+sub parse_option
+{
+ my $setting = shift;
+ my ($s2, $s1) = split '', Irssi::settings_get_str($sn.'_split_chars');
+ my %hash;
+
+ foreach (split $s1, Irssi::settings_get_str($setting)) {
+ my ($key, $rx) = split $s2;
+ $hash{$key} = $rx if $rx;
+ }
+
+ return %hash;
+}
+
+sub colorize_folder
+{
+ my $folder = shift;
+ my $border = "\x03";
+ my %folders = parse_option $sn.'_folders_color';
+
+ foreach (keys %folders) {
+ return $border.$_.$folder.$border if ($folder =~ /$folders{$_}/);
+ }
+
+ $border = "\x02";
+ return $border.$folder.$border;
+}
+
+sub format_folder
+{
+ my $folder = shift;
+ my $folder_pad = Irssi::settings_get_int $sn.'_folder_pad';
+ my $pad = $folder_pad - length $folder;
+ my $padding = $pad > 0 ? ' ' x $pad : '';
+ return colorize_folder($folder).$padding;
+}
+
+# Used in format_subject
+sub decode_mime
+{
+ my $str = shift;
+ my $decoded;
+
+ foreach (decode_mimewords $str) {
+ $decoded .= decode $_->[1] || 'US-ASCII', $_->[0];
+ }
+
+ return $decoded;
+}
+
+sub format_subject
+{
+ my $str = shift;
+
+ if (index($str, '=?') == -1)
+ { # If no MIME encoding, choose between utf8 and latin-1
+ my $utf8 = 0;
+
+ foreach (split '', $str) {
+ $utf8 = 1 if (ord == 0xc2 or ord == 0xc3);
+ }
+
+ $str = decode('ISO-8859-1', $str) unless $utf8;
+
+ return $str;
+ }
+
+ my $tmp = substr $str, rindex($str, '=?');
+
+ if (index($tmp, '?=') == -1)
+ {
+ if (not $tmp =~ /=\?[a-z0-9_-]+\?[bq]\?/i)
+ { # Encoding pattern not complete
+ $str = substr $str, 0, rindex($str, '=?');
+ }
+ elsif (my ($c) = ($tmp =~ /=\?\S+\?([bq])\?/i))
+ { # Encoding complete, lacks '?=' or just '='
+ if ($c =~ /q/i and index($str, '=', length($str)-2) != -1)
+ { # Remove trailing '=' (beginning of new special character)
+ $str = substr $str, 0, index($str, '=', length($str)-2)
+ }
+ $str .= ($str =~ /\?$/) ? '=' : '?=';
+ }
+ }
+
+ eval { $str = decode_mime $str };
+
+ if ($@) {
+ chomp $@;
+ print_error "Error while decoding subject: $@";
+ $str = "\x034(error)\x03 " . $str;
+ }
+
+ return $str;
+}
+
+# Get the print level from folder name
+sub get_level
+{
+ my $folder = shift;
+
+ my $level = Irssi::settings_get_level $sn.'_default_level';
+ return $level unless $folder;
+
+ my %levels = parse_option $sn.'_folders_level';
+
+ foreach (keys %levels) {
+ $level = Irssi::level2bits $_ if ($folder =~ /$levels{$_}/);
+ }
+
+ return $level;
+}
+
+# Find the right window, build and print the line
+sub printfmt
+{
+ my ($raw_folder, $raw_subject) = @_;
+
+ my $level = get_level $raw_folder;
+ my $folder = format_folder $raw_folder;
+ my $subject = format_subject $raw_subject;
+
+ my $line = "| $folder | $subject";
+ my $max_length = Irssi::settings_get_int $sn.'_max_length';
+ $line = substr($line, 0, $max_length) if ($max_length > 0);
+
+ my $win_name = Irssi::settings_get_str $sn.'_window';
+ my $window = Irssi::window_find_item $win_name;
+
+ unless ($window) {
+ print_error "Could not find window '$win_name'. Stopping.", "Please set ${sn}_window.";
+ do_stop();
+ return;
+ }
+
+ $window->printformat($level, $sn.'_mail', $line);
+}
+
+# Main loop
+sub read_log
+{
+ my $args = shift;
+ my ($log, $tagref) = @$args;
+
+ my $rec = $log->next;
+
+ unless ($rec) {
+ if (defined $child) {
+ # If $child is still running, we just got called too early
+ # (the record is not fully written)
+ return if (system("kill -0 $child &>/dev/null") == 0);
+
+ # Our child was killed by something external
+ print_error "Child killed. Stopping.";
+ undef $child;
+ }
+ # Child killed, close the pipe
+ Irssi::input_remove $$tagref;
+ return;
+ }
+
+ my $folders_silent = Irssi::settings_get_str $sn.'_folders_silent';
+
+ # We can get several mails in a row
+ # Double braces to use next in a do-while loop
+ do {{
+ unless (ref $rec) {
+ # If $rec is not a ref it is an error string
+ printfmt "error", $rec;
+ next;
+ }
+ next if ($folders_silent and $rec->folder =~ /$folders_silent/);
+ printfmt $rec->folder, $rec->subject;
+ }} while ($rec = $log->next);
+}
+
+sub do_start
+{
+ my $filename = Irssi::settings_get_str $sn.'_logfile';
+ my ($logfile, @rest) = glob $filename;
+
+ if ($#rest != -1) {
+ print_crap "I found several files with the given filename ($filename).",
+ "I will use $logfile.";
+ }
+
+ unless (-f $logfile and -r $logfile) {
+ print_error "Could not find $filename, or file not readable.",
+ "See /set ${sn}_logfile.";
+ return;
+ }
+
+ my $log = Log::Procmail->new;
+ my $wh = IO::Handle->new;
+
+ pipe $log->fh, $wh;
+
+ $log->errors(1);
+
+ $log->fh->blocking(0);
+ $wh->autoflush(1);
+
+ $child = fork;
+
+ if (not defined $child) {
+ print_error "Can't fork. Aborting.";
+ return;
+ }
+
+ if ($child > 0) { # parent
+ Irssi::pidwait_add $child;
+ my $tag;
+ my @args = ($log, \$tag);
+ $tag = Irssi::input_add fileno($log->fh), Irssi::INPUT_READ, \&read_log, \@args;
+ return $logfile;
+ } else { # child
+ open STDOUT, '>&', $wh;
+ open STDERR, '>&', $wh;
+ exec qw(tail -fn0), $logfile;
+ }
+}
+
+sub do_stop
+{
+ qx(kill $child);
+ undef $child;
+}
+
+sub cmd_start
+{
+ if (defined $child) {
+ print_crap "Already started, restarting...";
+ do_stop();
+ Irssi::timeout_add_once 200, \&cmd_start, undef;
+ return;
+ }
+
+ my $win_name = Irssi::settings_get_str $sn.'_window';
+ my $window = Irssi::window_find_item $win_name;
+
+ unless ($window) {
+ print_error "Could not find window '$win_name'. Aborting.", "Please set ${sn}_window.";
+ return;
+ }
+
+ if (my $file = do_start) {
+ print_crap "Started on window '$win_name' and file '$file'.";
+ }
+}
+
+sub cmd_stop
+{
+ unless (defined $child) {
+ print_crap "Not running.";
+ return;
+ }
+
+ do_stop();
+ print_crap "Stopped.";
+}
+
+sub UNLOAD
+{
+ do_stop() if $child;
+}
+
+# Subcommands handler
+Irssi::command_bind $sn, sub {
+ my ($data, $server, $item) = @_;
+ $data =~ s/\s+$//g;
+ Irssi::command_runsub $sn, $data, $server, $item;
+};
+
+# Subcommands
+Irssi::command_bind "$sn help", \&print_help;
+Irssi::command_bind "$sn start", \&cmd_start;
+Irssi::command_bind "$sn stop", \&cmd_stop;
+
+# Help command handler
+Irssi::command_bind 'help', sub {
+ $_[0] =~ s/\s+$//g;
+ return unless $_[0] eq $sn;
+ print_help;
+ Irssi::signal_stop;
+};
+
+# Timeout here to print our message after the loading notice
+Irssi::timeout_add_once 200, \&cmd_start, undef;
+
git.99rst.org / irssi-scripts.irssi.org.git / commitdiff