use strict;
use warnings;
use Irssi;
use Irssi::Irc;
use Data::Dumper;
our $VERSION = '1.0';
our %IRSSI = (
authors => 'Joost Vunderink (Garion)',
contact => 'joost@vunderink.net',
name => 'Dejunk',
description => 'Prevents all kinds of junk from showing up',
license => 'Public Domain',
url => 'http://www.garion.org/irssi/',
changed => '29 September 2012 10:15:10',
);
my ($STATUS_ACTIVE, $STATUS_INACTIVE, $STATUS_UNKNOWN) = (1, 2, 3);
my $activity_filename = 'dejunk.activity.data';
# $activity{$tag}{$nickuserhost_mask} = {
# last_msg => time(),
# }
my %activity;
sub cmd_dejunk {
my ($args, $server, $item) = @_;
if ($args =~ m/^(help)|(status)|(save)/i ) {
Irssi::command_runsub ('dejunk', $args, $server, $item);
return;
}
message("Use /dejunk help for help.");
}
sub cmd_dejunk_help {
message("Dejunk is a script that prevents some clutter from showing up.");
message("In large and/or busy channels, joins, parts, nickchanges and quits can take up a large part of the activity. ".
"Using dejunk, all these events on large channels are hidden if the user doing ".
"them has not said anything for a while.");
message("This way, you only see such activity when it matters.");
message("");
message("Commands:");
message("/dejunk save - Force saving of data immediately.");
message("");
message("Settings:");
message("dejunk_joinpart_enabled - Hide all non-relevant joins, parts, quits and nickchanges.");
message("dejunk_joinpart_idle_time - The amount of minutes of inactivity after which a user will be hidden.");
message("dejunk_joinpart_min_size - Activity on channels with fewer users than this is not hidden.");
message("dejunk_joinpart_show_unknown - If it's unknown whether the user has been active recently, ".
"show them if this setting is true. ".
"This is only relevant if the script has just been loaded for the first time.");
message("dejunk_debug - set to ON to see debug messages.");
}
sub cmd_dejunk_status {
report_status();
}
sub cmd_dejunk_save {
message("Saving dejunk data.");
save_data();
}
sub event_join {
my ($server, $channel, $nick, $host) = @_;
# Don't handle my own JOINs.
return if ($nick eq $server->{nick});
return if channel_size_below_joinpart_minimum($server, $channel);
my $status = get_client_status($server->{tag}, $host, $nick);
my $show_unknown = Irssi::settings_get_bool('dejunk_joinpart_show_unknown');
debug(sprintf("JOIN: channel=$channel nick=$nick host=$host tag=%s", $server->{tag}));
if ($status == $STATUS_ACTIVE) {
debug("Showing: active client");
return;
}
elsif ($status == $STATUS_UNKNOWN && $show_unknown) {
debug("Showing: unknown client and dejunk_joinpart_show_unknown is true");
return;
}
debug("Hiding: Is idle client.");
Irssi::signal_stop();
}
sub event_part {
my ($server, $channel, $nick, $host) = @_;
# Don't handle my own JOINs.
return if ($nick eq $server->{nick});
return if channel_size_below_joinpart_minimum($server, $channel);
my $status = get_client_status($server->{tag}, $host, $nick);
my $show_unknown = Irssi::settings_get_bool('dejunk_joinpart_show_unknown');
debug("PART: nick=$nick host=$host channel=$channel tag=%s", $server->{tag});
if ($status == $STATUS_ACTIVE) {
debug("Showing: active client");
return;
}
elsif ($status == $STATUS_UNKNOWN && $show_unknown) {
debug("Showing: unknown client and dejunk_joinpart_show_unknown is true");
return;
}
debug("Hiding: Is idle client.");
Irssi::signal_stop();
}
sub event_quit {
my ($server, $nick, $host) = @_;
# Don't handle my own QUITs.
return if ($nick eq $server->{nick});
my $channel = get_smallest_channel($server, $nick);
if (!$channel) {
warning("QUIT: Could not get smallest channel for nick '%s' on network '%s'!",
$nick, $server->{tag});
return;
}
return if channel_size_below_joinpart_minimum($server, $channel);
debug("QUIT: nick=$nick host=$host tag=%s", $server->{tag});
my $status = get_client_status($server->{tag}, $host, $nick);
my $show_unknown = Irssi::settings_get_bool('dejunk_joinpart_show_unknown');
if ($status == $STATUS_ACTIVE) {
debug("Showing: active client");
return;
}
elsif ($status == $STATUS_UNKNOWN && $show_unknown) {
debug("Showing: unknown client and dejunk_joinpart_show_unknown is true");
return;
}
debug("Hiding: Is idle client.");
Irssi::signal_stop();
}
sub event_nick {
my ($server, $newnick, $oldnick, $hostmask) = @_;
debug("NICK: old=$oldnick new=$newnick host=$hostmask tag=%s", $server->{tag});
my $nuh_mask = "$oldnick!$hostmask";
if (exists $activity{$server->{tag}}{$nuh_mask}) {
debug("Old client $oldnick was active; adding 'now' for $newnick");
$activity{$server->{tag}}{$nuh_mask} = {
last_msg => time(),
}
}
my $channel = get_smallest_channel($server, $newnick);
if (!$channel) {
warning("NICK: Could not get smallest channel for nick '%s' on network '%s'!",
$newnick, $server->{tag});
return;
}
return if channel_size_below_joinpart_minimum($server, $channel);
my $status = get_client_status($server->{tag}, $hostmask, $oldnick);
my $show_unknown = Irssi::settings_get_bool('dejunk_joinpart_show_unknown');
if ($status == $STATUS_ACTIVE) {
debug("Showing: active client");
return;
}
elsif ($status == $STATUS_UNKNOWN && $show_unknown) {
debug("Showing: unknown client and dejunk_joinpart_show_unknown is true");
return;
}
debug("Hiding: Is idle client.");
Irssi::signal_stop();
}
sub event_public {
my ($server, $data, $nick, $hostmask, $channel) = @_;
# Don't handle my own messages.
return if ($nick eq $server->{nick});
debug("MSG: nick=$nick hostmask=$hostmask tag=%s channel=$channel", $server->{tag});
my $nuh_mask = "$nick!$hostmask";
$activity{$server->{tag}}{$nuh_mask} = {
last_msg => time(),
}
}
sub is_active_client {
my ($tag, $host, $nick) = @_;
my $status = get_client_status($tag, $host, $nick);
if ($status == $STATUS_ACTIVE) {
return 1;
}
return;
}
sub get_client_status {
my ($tag, $host, $nick) = @_;
my $nuh_mask = "$nick!$host";
if (exists $activity{$tag}{$nuh_mask}) {
my $d = $activity{$tag}{$nuh_mask};
if (time() - $d->{last_msg} < 60 * Irssi::settings_get_int('dejunk_joinpart_idle_time')) {
return $STATUS_ACTIVE;
}
else {
return $STATUS_INACTIVE;
}
}
return $STATUS_UNKNOWN;
}
sub channel_size_below_joinpart_minimum {
my ($server, $channel) = @_;
my $chan_obj = $server->channel_find($channel);
if (!$chan_obj) {
warning("Minsize check: could not find channel '%s' on network '%s'!",
$channel, $server->{tag});
return 1;
}
my @nicks = $chan_obj->nicks();
if (scalar @nicks < Irssi::settings_get_int('dejunk_joinpart_min_size')) {
return 1;
}
return 0;
}
sub get_smallest_channel {
my ($server, $nick) = @_;
my $count = 999999999;
my $found_channel;
for my $channel ($server->channels()) {
if ($channel->nick_find($nick)) {
my @nicks = $channel->nicks();
if (scalar @nicks < $count) {
$count = scalar @nicks;
$found_channel = $channel;
}
}
}
return $found_channel->{name};
}
sub load_data {
load_activity_data();
}
sub load_activity_data {
my $fn = Irssi::get_irssi_dir() . '/' . $activity_filename;
if (!-r $fn) {
return;
}
open my $fh, '<', $fn;
if (!$fh) {
error("Could not read dejunk activity data from $fn: $!");
return;
}
$/ = undef;
my $file_contents = <$fh>;
eval {
my $data = eval $file_contents;
%activity = %$data;
};
if ($@) {
error("Error loading activity data from $fn: $@");
}
else {
message("Activity data loaded from $activity_filename");
}
close $fh;
}
sub save_data {
save_activity_data();
}
sub save_activity_data {
clean_activity_data();
my $fn = Irssi::get_irssi_dir() . '/' . $activity_filename;
open my $fh, '>', $fn;
if (!$fh) {
error("Could not write dejunk activity data to $fn: $!");
return;
}
$Data::Dumper::Indent = 1;
$Data::Dumper::Purity = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Terse = 1;
print $fh Dumper \%activity;
close $fh;
}
sub clean_activity_data {
my $threshold_time = time() - 10 * Irssi::settings_get_int('dejunk_joinpart_idle_time');
# Go through all clients and remove the ones that haven't performed any action
# in the past 10 * joinpart_idle_time seconds.
# The factor 10 is here to make sure that if the user increases joinpart_idle_time
# (by no more than a factor 10), we will still have enough data available for the
# script to work properly.
for my $tag (keys %activity) {
for my $nuh_mask (keys %{ $activity{$tag} }) {
if ($activity{$tag}{$nuh_mask}{last_msg} < $threshold_time) {
debug("Deleting old data for $tag:$nuh_mask");
delete $activity{$tag}{$nuh_mask};
}
}
}
}
sub report_status use 5.014; # strict, Unicode 6, unicode regexp modifiers
BEGIN {
require charnames;
if ($^V gt v5.16.0) {
charnames->import(':loose');
} else {
print "unicode.pl: Loose unicode matching not supported on this version of Perl.";
print "Upgrade to 5.16 or newer for case-insensitive names.";
charnames->import(':full');
}
}
use Encode qw(decode_utf8 encode_utf8);
use POSIX ();
use Unicode::UCD qw(charblock charblocks charinfo);
use Irssi qw(command_bind command_bind_first);
our $VERSION = "1";
our %IRSSI = (
authors => 'David Leadbeater',
contact => 'dgl@dgl.cx',
name => 'unicode',
description => 'Get infomation about unicode characters',
license => 'WTFPL <http://dgl.cx/licence>',
url => 'http://dgl.cx/irssi',
);
my $CHARCODE_RE = qr/(?:\d+|(?:U\+|0x)[0-9a-f]+)/ai;
my $pipe_in_progress;
my $USAGE = <<'EOF';
/UNICODE <character | code | name | block name>
Print details about Unicode characters or blocks.
Details about a single character:
/unicode 😸
/unicode U+1F626
Print details about a block (more concise):
/unicode Emoticons
Print details about a range:
/unicode U+1F600..U+1F700
Find a character:
/unicode /\bcat\b/
EOF
if (Irssi::settings_get_str('term_charset') !~ /utf-8/i) {
print "\x{3}4unicode.pl\x{3}: term_charset is not set to UTF-8. ",
"Please set your terminal and Irssi to use UTF-8 so this script works correctly.";
print "Current settings:";
print " Irssi term_charset = ", Irssi::settings_get_str('term_charset');
print " $_ = $ENV{$_}" for grep /^(?:LANG|LC_|TERM$)/, keys %ENV;
}
# TODO: Can we fix Irssi to not need encoding here?
sub p { Irssi::active_win()->print(encode_utf8("@_"), MSGLEVEL_CLIENTCRAP) }
command_bind_first help => sub {
my($arg) = @_;
return unless $arg =~ /^unicode\s*$/i;
print $USAGE;
print "[Perl internal unicode version " . Unicode::UCD::UnicodeVersion() . "]";
Irssi::signal_stop();
};
command_bind unicode => sub {
my($arg) = @_;
if(!$arg) {
print "Usage: /UNICODE <character | code | name | block name>";
print "See /help unicode for more.";
return;
}
# Decode is always required right now, but really irssi core should handle
# this so written in a future proof way.
$arg = decode_utf8 $arg unless Encode::is_utf8($arg, 1);
if (length $arg == 1) {
# Single character
print_info(ord $arg, 1);
} elsif ($arg =~ /^$CHARCODE_RE\s*$/) {
# Character code (decimal or hex)
print_info($arg, 1);
} elsif ($arg =~ /^($CHARCODE_RE)\s*\.\.\s*($CHARCODE_RE)\s*$/) {
# Character range
my($start, $end) = (charinfo($1), charinfo($2));
print_info($_) for hex $start->{code} .. hex $end->{code};
} elsif ($arg =~ m{/(.*)/\s*$}) {
my $re = qr/$1/i;
if ($pipe_in_progress) {
p "Another unicode search is in progress";
return;
}
fork_wrapper(sub { # Child
my($fh) = @_;
my @found;
my $data = "";
# This is not a public API at all, but taking 2 minutes when using the
# public API is a bit of a joke, so we take advantage of perl's cache if
# we can.
$data = do "unicore/Name.pl";
if (!$data) {
for my $block(map { $_->[0] } values %{charblocks()}) {
for($block->[0] .. $block->[1]) {
my $name = charnames::viacode($_);
next unless $name;
$data .= sprintf "%X %s\n", $_, $name;
}
}
}
while ($data =~ /(?:^([A-F0-9]+).*$re)/gm) {
push @found, $1;
}
if(@found > 100) {
syswrite $fh, "- More than 100 matches found, aborting";
} else {
syswrite $fh, "@found";
}
},
sub { # Parent
my($line) = @_;
if ($line =~ /^- (.*)/) {
p $1;
} elsif (!$line) {
p "No matches found";
} else {
print_info($_) for sort { hex $a <=> hex $b } split / /, $line;
}
});
} else {
# Character (or named sequence) or block name
my $string = charnames::string_vianame($arg);
if ($string) {
# Character(s) found
for my $char(split //, $string) {
print_info(ord $char);
}
} elsif(charblock $arg) {
my $block = charblock($arg);
print_info($_) for $block->[0]->[0] .. $block->[0]->[1];
} else {
p "Not found. Try for example /unicode /\\bcat\\b/ for partial matching.";
}
}
};
sub print_info {
my($character, $extra) = @_;
my $info = charinfo $character;
if (!$info) {
p "Character not found" if $extra;
} else {
p chr(hex $info->{code}) . " (U+$info->{code}): $info->{name}";
return unless $extra;
my %extra;
for(qw(block category script)) {
$extra{$_} = $info->{$_}
}
# Optional things
for(qw(decimal digit numeric upper lower title)) {
$extra{$_} = $info->{$_} if $info->{$_};
}
p " " x (7 + length $info->{code}), join(", ", map { "$_=$extra{$_}" } sort keys %extra);
}
}
# Based on scriptassist.
sub fork_wrapper {
my($child, $parent) = @_;
pipe(my $rfh, my $wfh);
my $pid = fork;
$pipe_in_progress = 1;
return unless defined $pid;
if($pid) {
close $wfh;
Irssi::pidwait_add($pid);
my $pipetag;
my @args = ($rfh, \$pipetag, $parent);
$pipetag = Irssi::input_add(fileno($rfh), INPUT_READ, \&pipe_input, \@args);
} else {
eval {
$child->($wfh);
};
syswrite $wfh, "- $@" if $@;
POSIX::_exit(1);
}
}
sub pipe_input {
my ($rfh, $pipetag, $parent) = @{$_[0]};
my $line = <$rfh>;
close($rfh);
Irssi::input_remove($$pipetag);
$pipe_in_progress = 0;
$parent->($line);
}