#
# For instance, you might never want to be disturbed by activity in any
# channel, unless someone highlights you. However, you do want all activity
-# in queries, as well as an indication about any chatter in your company
-# channels. The following ctrlact map would do this for you:
+# in queries (except on efnet, as well as an indication about any chatter in
+# your company channels. The following ctrlact map would do this for you:
#
-# channel /^#myco-/ messages
-# channel * hilights
-# query * all
+# channel /^#myco-/ messages
+# channel * hilights
+# query efnet * messages
+# query * all
#
# These three lines would be interpreted/read as:
# "only messages or higher in a channel matching /^#myco-/ should trigger act"
# "in all other channels, only hilights (or higher) should trigger act"
-# "messages of all levels should trigger act in queries"
+# "queries on efnet should only trigger act for messages and higher"
+# "messages of all levels should trigger act in queries elsewhere"
#
# The activity level in the third column is thus to be interpreted as
# "the minimum level of activity that will trigger an indication"
#
# - figure out interplay with activity_hide_level
# - /ctrlact add/delete/move and /ctrlact save, maybe
-# - ability to add a server tag to an item name to make matches more specific
# - completion for commands
#
use strict;
use Irssi;
use Text::ParseWords;
-our $VERSION = '1.0';
+our $VERSION = '1.1';
our %IRSSI = (
authors => 'martin f. krafft',
name => 'ctrlact',
description => 'allows per-channel control over activity indication',
license => 'MIT',
- changed => '2017-02-12'
+ changed => '2017-02-15'
);
### DEFAULTS AND SETTINGS ######################################################
### HELPERS ####################################################################
my $_inhibit_debug_activity = 0;
-use constant DEBUGEVENTFORMAT => "%7s %-22.22s %d %s %d → %-7s (%-8s ← %s)";
+use constant DEBUGEVENTFORMAT => "%7s %7.7s %-22.22s %d %s %d → %-7s (%-8s ← %s)";
sub debugprint {
return unless $debug;
my ($msg, @rest) = @_;
}
sub walk_match_array {
- my ($name, $type, @arr) = @_;
- foreach my $pair (@arr) {
- my $match = match($pair->[0], $name);
- next unless $match;
- my $result = to_data_level($pair->[1]);
+ my ($name, $net, $type, @arr) = @_;
+ foreach my $quadruplet (@arr) {
+ my $netmatch = match($quadruplet->[0], $net);
+ my $match = match($quadruplet->[1], $name);
+ next unless $netmatch and $match;
+
+ my $result = to_data_level($quadruplet->[2]);
my $tresult = from_data_level($result);
$name = '(unnamed)' unless length $name;
+ $match = sprintf('line %-3d = net:%-10.10s name:%s',
+ $quadruplet->[3], $netmatch, $match);
return ($result, $tresult, $match)
}
return -1;
my (@arr) = @_;
my @ret = ();
for (my $i = 0; $i < @arr; $i++) {
- push @ret, sprintf("%4d: %-40s %-10s", $i, $arr[$i]->[0], $arr[$i]->[1]);
+ push @ret, sprintf("%4d: %-10s %-40s %-10s",
+ $i, $arr[$i]->[0], $arr[$i]->[1], $arr[$i]->[2]);
}
return join("\n", @ret);
}
sub get_specific_threshold {
- my ($type, $name) = @_;
+ my ($type, $name, $net) = @_;
$type = lc($type);
if ($type eq 'window') {
- return walk_match_array($name, $type, @window_thresholds);
+ return walk_match_array($name, $net, $type, @window_thresholds);
}
elsif ($type eq 'channel') {
- return walk_match_array($name, $type, @channel_thresholds);
+ return walk_match_array($name, $net, $type, @channel_thresholds);
}
elsif ($type eq 'query') {
- return walk_match_array($name, $type, @query_thresholds);
+ return walk_match_array($name, $net, $type, @query_thresholds);
}
else {
die "ctrlact: can't look up threshold for type: $type";
}
sub get_item_threshold {
- my ($chattype, $type, $name) = @_;
- my ($ret, $tret, $match) = get_specific_threshold($type, $name);
+ my ($chattype, $type, $name, $net) = @_;
+ my ($ret, $tret, $match) = get_specific_threshold($type, $name, $net);
return ($ret, $tret, $match) if $ret > 0;
if ($type eq 'CHANNEL') {
return ($fallback_channel_threshold, from_data_level($fallback_channel_threshold), '[default]');
}
sub get_win_threshold {
- my ($name) = @_;
- my ($ret, $tret, $match) = get_specific_threshold('window', $name);
+ my ($name, $net) = @_;
+ my ($ret, $tret, $match) = get_specific_threshold('window', $name, $net);
if ($ret > 0) {
return ($ret, $tret, $match);
}
Irssi::print("ctrlact: $type mappings:");
for (my $i = 0; $i < @arr; $i++) {
my $name = $arr[$i]->{'name'};
- my ($t, $tt, $match) = get_specific_threshold($type, $name);
- my $c = ($type eq 'window') ? $arr[$i]->{'refnum'} : $i;
- printf CLIENTCRAP "%4d: %-40s → %d (%s; match:%s)", $c, $name, $t, $tt, $match;
+ my $net = $arr[$i]->{'server'}->{'tag'} // '';
+ my ($t, $tt, $match) = get_specific_threshold($type, $name, $net);
+ my $c = ($type eq 'window') ? $arr[$i]->{'refnum'} : $arr[$i]->window()->{'refnum'};
+ printf CLIENTCRAP "%4d: %-40.40s → %d (%-8s) match %s", $c, $name, $t, $tt, $match;
}
}
my $wichattype = $witem->{'chat_type'};
my $witype = $witem->{'type'};
my $winame = $witem->{'name'};
- my ($th, $tth, $match) = get_item_threshold($wichattype, $witype, $winame);
+ my $witag = $witem->{'server'}->{'tag'} // '';
+ my ($th, $tth, $match) = get_item_threshold($wichattype, $witype, $winame, $witag);
my $inhibit = $newlevel > 0 && $newlevel < $th;
- debugprint(sprintf(DEBUGEVENTFORMAT, lc($witype), $winame, $newlevel,
+ debugprint(sprintf(DEBUGEVENTFORMAT, lc($witype), $witag, $winame, $newlevel,
$inhibit ? ('<',$th,'inhibit'):('≥',$th,'pass'),
$tth, $match));
if ($inhibit) {
return if ($newlevel <= $oldlevel);
my $wname = $win->{'name'};
- my ($th, $tth, $match) = get_win_threshold($wname);
+ my $wtag = $win->{'server'}->{'tag'} // '';
+ my ($th, $tth, $match) = get_win_threshold($wname, $wtag);
my $inhibit = $newlevel > 0 && $newlevel < $th;
- debugprint(sprintf(DEBUGEVENTFORMAT, 'window',
+ debugprint(sprintf(DEBUGEVENTFORMAT, 'window', $wtag,
$wname?$wname:'(unnamed)', $newlevel,
$inhibit ? ('<',$th,'inhibit'):('≥',$th,'pass'),
$tth, $match));
# ctrlact mappings file (version:$VERSION)
#
# type: window, channel, query
+# server: the server tag (chatnet)
# name: full name to match, /regexp/, or * (for all)
# min.level: none, messages, hilights, all, or 1,2,3,4
#
-# type name min.level
+# type server name min.level
# EXAMPLES
#
### only indicate activity in the status window if messages were displayed:
-# window (status) messages
+# window * (status) messages
#
### never ever indicate activity for any item bound to this window:
-# window oubliette none
+# window * oubliette none
#
-### indicate activity on all messages in debian-related channels:
-# channel /^#debian/ messages
+### indicate activity on all messages in debian-related channels on OFTC:
+# channel oftc /^#debian/ messages
#
### display any text (incl. joins etc.) for the '#madduck' channel:
-# channel #madduck all
+# channel * #madduck all
#
### otherwise ignore everything in channels, unless a hilight is triggered:
-# channel * hilights
+# channel * * hilights
#
### make somebot only get your attention if they hilight you:
-# query somebot hilights
+# query efnet somebot hilights
#
### otherwise we want to see everything in queries:
-# query * all
+# query * * all
# DEFAULTS:
-# window * $ftw
-# channel * $ftc
-# query * $ftq
+# window * * $ftw
+# channel * * $ftc
+# query * * $ftq
# vim:noet:tw=0:ts=16
EOF
my ($filename) = @_;
@window_thresholds = @channel_thresholds = @query_thresholds = ();
my $fh = get_mappings_fh($filename);
+ my $firstline = <$fh>;
+ my $version;
+ if ($firstline =~ m/^#+\s+ctrlact mappings file \(version:([\d.]+)\)/) {
+ $version = $1;
+ }
+ else {
+ die "First line of $filename is not a ctrlact header.";
+ }
+
+ my $nrcols = 4;
+ if ($version eq $VERSION) {
+ # current version
+ }
+ elsif ($version eq "1.0") {
+ $nrcols = 3;
+ }
+ else {
+ die "Unsupported version found in $filename: $version"
+ }
+ my $linesplitter = '^\s*'.join('\s+', ('(\S+)') x $nrcols).'\s*$';
+ my $l = 1;
while (<$fh>) {
+ $l++;
next if m/^\s*(?:#|$)/;
- m/^\s*(\S+)\s+(\S+)\s+(\S+)\s*$/;
- push @window_thresholds, [$2, $3] if match($1, 'window');
- push @channel_thresholds, [$2, $3] if match($1, 'channel');
- push @query_thresholds, [$2, $3] if match($1, 'query');
+ my ($type, @matchers) = m/$linesplitter/;
+ @matchers = ['*', @matchers] if ($version eq "1.0");
+ push @matchers, $l;
+ push @window_thresholds, [@matchers] if match($type, 'window');
+ push @channel_thresholds, [@matchers] if match($type, 'channel');
+ push @query_thresholds, [@matchers] if match($type, 'query');
}
close($fh) || die "Cannot close mappings file: $!";
}
my (@args) = @_;
my @words = ();
my $typewasset = 0;
+ my $tag;
my $max = 0;
my $type = undef;
foreach my $arg (@args) {
$type = 'query' if $1 =~ m/^q/;
$typewasset = 1
}
- elsif ($arg =~ m/^-/) {
- error("Unknown argument: $arg");
+ elsif ($arg =~ m/-(\S+)/) {
+ $tag = $1;
}
else {
push @words, $arg;
$max = length $arg if length $arg > $max;
}
}
- return ($type, $max, @words);
+ return ($type, $tag, $max, @words);
}
sub cmd_query {
my ($data, $server, $item) = @_;
my @args = shellwords($data);
- my ($type, $max, @words) = parse_args(@args);
+ my ($type, $tag, $max, @words) = parse_args(@args);
$type = $type // 'channel';
+ $tag = $tag // '*';
foreach my $word (@words) {
- my ($t, $tt, $match) = get_specific_threshold($type, $word);
- printf CLIENTCRAP "ctrlact $type map: %*s → %d (%s, match:%s)", $max, $word, $t, $tt, $match;
+ my ($t, $tt, $match) = get_specific_threshold($type, $word, $tag);
+ printf CLIENTCRAP "ctrlact $type map: %s %*s → %d (%s, match:%s)", $tag, $max, $word, $t, $tt, $match;
}
}
git.99rst.org / irssi-scripts.irssi.org.git / commitdiff