Codebase list irssi-scripts / 0f39757
New upstream release Daniel Echeverri 1 year, 9 months ago
36 changed file(s) with 5014 addition(s) and 1017 deletion(s). Raw diff Collapse all Expand all
+36
-3
scripts/0x0st.pl less more
77 use Storable qw/store_fd fd_retrieve/;
88 use File::Glob qw/:bsd_glob/;
99
10 $VERSION = '0.03';
10 $VERSION = '0.04';
1111 %IRSSI = (
1212 authors => 'bw1',
1313 contact => 'bw1@aol.at',
1515 description => 'upload file to https://0x0.st/',
1616 license => 'ISC',
1717 url => 'https://scripts.irssi.org/',
18 changed => '2020-04-12',
18 changed => '2021-01-13',
1919 modules => 'POSIX HTTP::Request::Common LWP::UserAgent Storable File::Glob',
2020 commands=> '0x0st',
21 selfcheckcmd=> '0x0st -c',
2122 );
2223
2324 my $help = << "END";
2728 $VERSION
2829 %9Syntax%9
2930 /0x0st [-p] [-s <URL> | -u <URL> | file ]
31 /0x0st -c
3032 %9Description%9
3133 $IRSSI{description}
3234 -p past url to channel
3335 -s shorten url
3436 -u file from url
37 -c self check
3538 %9See also%9
3639 https://0x0.st/
3740 https://github.com/lachs0r/0x0
4245 my $base_uri;
4346
4447 my %bg_process= ();
48 my $self_check_timer;
4549
4650 sub background {
4751 my ($cmd) =@_;
146150 $cmd->{cmd}=\&shorten;
147151 $cmd->{args}=[$arg];
148152 background( $cmd );
153 } elsif (exists $opt->{c}) {
154 $cmd->{cmd}=\&shorten;
155 $cmd->{args}=['https://scripts.irssi.org/'];
156 $cmd->{last}=[\&self_check];
157 $self_check_timer= Irssi::timeout_add_once(2000, \&self_check, '');
158 background( $cmd );
149159 } else {
150160 $cmd->{cmd}=\&upload;
151161 $cmd->{args}=[$arg];
154164 } else {
155165 cmd_help($IRSSI{'name'});
156166 }
167 }
168
169 sub self_check {
170 my ( $arg )=@_;
171 my $s='ok';
172 my @res;
173 if ( ref($arg) ne 'HASH' ) {
174 $s = 'Error: timeout';
175 } else {
176 @res= @{$arg->{res}};
177 Irssi::timeout_remove($self_check_timer);
178 Irssi::print("0x0st: surl: $res[0] stat: $res[1]", MSGLEVEL_CLIENTCRAP);
179 if ( 2 != scalar (@res ) ) {
180 $s = 'Error: arg count';
181 } elsif ( $res[1] != 200 ) {
182 $s = "Error: HTTP status code ($res[1])";
183 } elsif ( $res[0] !~ m/^http/ ) {
184 $s = "Error: result ($res[0])";
185 }
186 }
187 Irssi::print("0x0st: selfckeck $s", MSGLEVEL_CLIENTCRAP);
188 my $schs_version = $Irssi::Script::selfcheckhelperscript::VERSION;
189 Irssi::command("selfcheckhelperscript $s") if (defined $schs_version);
157190 }
158191
159192 sub cmd_help {
176209
177210 Irssi::command_bind($IRSSI{name}, \&cmd);
178211 Irssi::command_bind('help', \&cmd_help);
179 Irssi::command_set_options($IRSSI{name},"p u s");
212 Irssi::command_set_options($IRSSI{name},"p u s c");
180213
181214 sig_setup_changed();
+40
-6
scripts/adv_windowlist.pl less more
00 use strict;
11 use warnings;
22
3 our $VERSION = '1.9'; # 32a6d4807a45e71
3 our $VERSION = '1.11'; # 28b8dcf69e0355e
44 our %IRSSI = (
55 authors => 'Nei',
66 contact => 'Nei @ anti@conference.jabber.teamidiot.de',
9696 # 1 to hide visible windows without items (negative exempt
9797 # active window)
9898 #
99 # /set awl_custom_key_re <regex>
100 # * regex : which symbolic key names to show in $Q (for example F-keys)
101 #
99102 # /set awl_detach <list>
100103 # * list of windows that should be hidden from the window list. you
101104 # can also use /awl detach and /awl attach to manage this
344347 my $settings_str = '1';
345348 my $window_sort_func;
346349 my $custom_xform;
350 my $custom_key_re = qr/(?!)/;
347351 my ($sb_base_width, $sb_base_width_pre, $sb_base_width_post);
348352 my $print_text_activity;
349353 my $shade_line_timer;
478482 { my %killBar;
479483 sub get_old_status {
480484 my ($textDest, $cont, $cont_stripped) = @_;
481 if ($textDest->{level} == 524288 and $textDest->{target} eq '' and !defined $textDest->{server}) {
485 if ($textDest->{level} == MSGLEVEL_CLIENTCRAP and $textDest->{target} eq '' and !defined $textDest->{server}) {
482486 my $name = quotemeta(set '');
483487 if ($cont_stripped =~ m/^$name(\d+)\s/) { $killBar{$1} = 1; }
484488 Irssi::signal_stop;
501505
502506 sub get_keymap {
503507 my ($textDest, undef, $cont_stripped) = @_;
504 if ($textDest->{level} == 524288 and $textDest->{target} eq '' and !defined $textDest->{server}) {
508 if ($textDest->{level} == MSGLEVEL_CLIENTCRAP and $textDest->{target} eq '' and !defined $textDest->{server}) {
505509 my $one_meta_or_ctrl_key = qr/((?:meta-)*?)(?:(meta-|\^)(\S)|(\w+))/;
506510 $cont_stripped = as_uni($cont_stripped);
507511 if ($cont_stripped =~ m/((?:$one_meta_or_ctrl_key-)*$one_meta_or_ctrl_key)\s+(.*)$/) {
510514 while ($combo =~ s/(?:-|^)$one_meta_or_ctrl_key$//) {
511515 my ($level, $ctl, $key, $nkey) = ($1, $2, $3, $4);
512516 my $numlevel = ($level =~ y/-//);
517 if (not defined $key and $nkey =~ /^($custom_key_re)$/) {
518 $key = $nkey;
519 }
513520 $ctl = '' if !$ctl || $ctl ne '^';
514521 $map = ('-' x ($numlevel%2)) . ('+' x ($numlevel/2)) .
515522 $ctl . (defined $key ? $key : "\01$nkey\01") . $map;
13321339 my $was_xform = $S{xform} // '';
13331340 my $was_shared = $S{shared_sbar};
13341341 my $was_no_hint = $S{no_mode_hint};
1342 my $was_custom_key = $S{custom_key_re} // '';
13351343 %S = (
13361344 sort => Irssi::settings_get_str( set 'sort'),
13371345 fancy_abbrev => Irssi::settings_get_str('fancy_abbrev'),
13421350 hide_data => Irssi::settings_get_int( set 'hide_data'),
13431351 hide_name => Irssi::settings_get_int( set 'hide_name_data'),
13441352 hide_empty => Irssi::settings_get_int( set 'hide_empty'),
1353 custom_key_re => Irssi::settings_get_str( set 'custom_key_re'),
13451354 detach => Irssi::settings_get_str( set 'detach'),
13461355 detach_data => Irssi::settings_get_int( set 'detach_data'),
13471356 detach_aht => Irssi::settings_get_bool(set 'detach_aht'),
14321441 }
14331442 }
14341443 }
1444 if ($was_custom_key ne $S{custom_key_re}) {
1445 my $custom_key = $S{custom_key_re};
1446 my $was_custom_key_re = $custom_key_re;
1447 local $@;
1448 eval { $custom_key_re = qr/(?i)$custom_key/; 1 }
1449 or do {
1450 print '%_'.(set 'custom_key_re').'%_ did not compile: '
1451 . do { $@ =~ /(.*) at / && $1 };
1452 $custom_key_re = qr/(?!)/;
1453 };
1454 if ($was_custom_key_re ne $custom_key_re) {
1455 update_keymap();
1456 }
1457 }
14351458
14361459 my $new_settings = join "\n", $VIEWER_MODE
14371460 ? ("\\", $S{block}, $S{height_adjust}, $S{maxlines}, $S{maxcolumns}, $S{true_colour})
18031826 return unless defined $^S;
18041827 return if $BLOCK_ALL;
18051828 return unless $print_text_activity;
1806 return if $_[0]->{level} == 262144 and $_[0]->{target} eq ''
1829 return if $_[0]->{level} == MSGLEVEL_CLIENTNOTICE and $_[0]->{target} eq ''
18071830 and !defined($_[0]->{server});
18081831 &wl_changed;
18091832 }
19601983 Irssi::settings_add_bool(setc, set 'mouse', 0); #
19611984 Irssi::settings_add_str( setc, set 'path', Irssi::get_irssi_dir . '/_windowlist'); #
19621985 Irssi::settings_add_str( setc, set 'custom_xform', ''); #
1986 Irssi::settings_add_str( setc, set 'custom_key_re', 'f\d+'); #
19631987 Irssi::settings_add_time(setc, set 'last_line_shade', '0'); #
19641988 Irssi::settings_add_int( setc, set 'mouse_offset', 1); #
19651989 Irssi::settings_add_int( setc, 'mouse_scroll', 3); #
20142038
20152039 # Mouse script based on irssi mouse patch by mirage
20162040 { my $mouse_status = -1; # -1:off 0,1,2:filling mouse_combo
2017 my @mouse_combo; # 0:button 1:x 2:y
2018 my @mouse_previous; # previous contents of mouse_combo
2041 my @mouse_combo = (-1, -1, -1); # 0:button 1:x 2:y
2042 my @mouse_previous = (-1, -1, -1); # previous contents of mouse_combo
20192043
20202044 sub mouse_xterm_off {
20212045 $mouse_status = -1;
28102834
28112835 # Changelog
28122836 # =========
2837 # 1.11
2838 # - fix compat with Irssi 1.4
2839 #
2840 # 1.10
2841 # - add /set awl_custom_key_re, to display custom keys in the $Q
2842 # expando. requested by madduck
2843 #
2844 # 1.9.1
2845 # - fix crash on mouse click
2846 #
28132847 # 1.9
28142848 # - add %Z support to viewer
28152849 #
+18
-39
scripts/autochannel.pl less more
0 #! /usr/bin/perl
10 #
2 # $Id: autochannel.pl,v 1.2 2007/09/20 06:58:11 peder Exp $
3 #
4 # Copyright (C) 2007 by Peder Stray <peder@ninja.no>
1 # Copyright (C) 2007-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
85 use Irssi;
96 use Irssi::Irc;
107
11 use Data::Dumper;
12 $Data::Dumper::Indent = 1;
8 use vars qw{$VERSION %IRSSI};
9 ($VERSION) = ' $Revision: 1.3.1 $ ' =~ / (\d+(\.\d+)+) /;
10 %IRSSI = (
11 name => 'autochannel',
12 authors => 'Peder Stray',
13 contact => 'peder.stray@gmail.com',
14 url => 'https://github.com/pstray/irssi-autochannel',
15 license => 'GPL',
16 description => 'Auto add channels to channel list on join',
17 );
1318
14 # ======[ Script Header ]===============================================
19 # "channel joined", channel
20 sub sig_channel_joined {
21 my($c) = @_;
1522
16 use vars qw{$VERSION %IRSSI};
17 ($VERSION) = ' $Revision: 1.2 $ ' =~ / (\d+\.\d+) /;
18 %IRSSI = (
19 name => 'autochannel',
20 authors => 'Peder Stray',
21 contact => 'peder@ninja.no',
22 url => 'http://ninja.no/irssi/autochannel.pl',
23 license => 'GPL',
24 description => 'Auto add channels to channel list on join',
25 );
23 my $server = $c->{server};
24 my $channel = $c->{name};
2625
27 # ======[ Signal hooks ]================================================
28
29 # "message join", SERVER_REC, char *channel, char *nick, char *address
30 sub sig_message_join {
31 my($server,$channel,$nick,$addr) = @_;
32
33 return unless $nick eq $server->{nick};
3426 return unless $server->{chatnet};
3527 return unless Irssi::settings_get_bool('channel_add_on_join');
36
28
3729 Irssi::command(sprintf "channel add %s %s %s",
3830 Irssi::settings_get_bool('channel_add_with_auto')
3931 ? '-auto' : '',
6759 }
6860 }
6961
70 # ======[ Setup ]=======================================================
71
72 # --------[ Settings ]--------------------------------------------------
73
7462 Irssi::settings_add_bool('autochannel', 'channel_add_on_join', 1);
7563 Irssi::settings_add_bool('autochannel', 'channel_add_with_auto', 1);
7664 Irssi::settings_add_bool('autochannel', 'channel_remove_auto_on_part', 1);
7765 Irssi::settings_add_bool('autochannel', 'channel_remove_on_part', 0);
7866
79 # --------[ Signals ]---------------------------------------------------
80
81 Irssi::signal_add_last('message join', 'sig_message_join');
67 Irssi::signal_add_last('channel joined', 'sig_channel_joined');
8268 Irssi::signal_add_last('message part', 'sig_message_part');
83
84 # ======[ END ]=========================================================
85
86 # Local Variables:
87 # header-initial-hide: t
88 # mode: header-minor
89 # end:
+8
-2
scripts/autorealname.pl less more
33 use Irssi 20011207;
44 use strict;
55 use vars qw($VERSION %IRSSI);
6 $VERSION = "0.8.6";
6 $VERSION = "0.8.7";
77 %IRSSI = (
88 authors => "Timo \'cras\' Sirainen, Bastian Blank",
99 contact => "tss\@iki.fi, waldi\@debian.org",
1111 description => "Print realname of everyone who join to channels",
1212 license => "GPLv2 or later",
1313 url => "http://irssi.org/",
14 changed => "Fri, 24 Jan 2003 15:40:22 +0100"
14 changed => "2021-01-16"
1515 );
1616
17 # v0.8.7 changes - bw1
18 # - fix Can't call method "nick_find" ... line 282.
1719 # v0.8.6 changes - Juhamatti Niemelä
1820 # - fix join msg printing when there are multiple common channels
1921 # v0.8.5 changes - Bastian Blank
210212 else {
211213 foreach my $channel (@{$rec->{nicks}->{$nick}->{chans_realname}}) {
212214 my $chanrec = $server->channel_find($channel);
215 next unless (defined $chanrec);
213216 my $nickrec = $chanrec->nick_find($nick);
214217 if ($chanrec && $nickrec) {
215218 $chanrec->printformat(MSGLEVEL_JOINS, 'join_realname_only', $nick, $realname);
278281 my @channels = @{$rec->{nicks}->{$nick}->{chans_join}};
279282 foreach my $channel (@channels) {
280283 my $chanrec = $server->channel_find($channel);
284 next unless (defined $chanrec);
281285 my $nickrec = $chanrec->nick_find($nick);
282286 if ($nickrec && $chanrec) {
283287 $chanrec->printformat(MSGLEVEL_JOINS, 'join', $nick, $nickrec->{host}, $channel);
295299 'redir autorealname_whois' => \&event_whois,
296300 'redir autorealname_whois_unknown' => \&event_whois_unknown,
297301 'redir autorealname_whois_last' => \&event_whois_last });
302
303 # vim:set sw=2 ts=8 et:
+569
-0
scripts/chankeys.pl less more
0 # chankeys.pl — Irssi script for associating key shortcuts with channels
1 #
2 # © 2021 martin f. krafft <madduck@madduck.net>
3 # Released under the MIT licence.
4 #
5 ### Usage:
6 #
7 # /script load chankeys
8 #
9 # This plugin serves to simplify the assignment of keyboard shortcuts that
10 # take you to channels or queries (so-called "window items").
11 #
12 # Let's assume you're in the #irssi channel, then you could issue the command
13 #
14 # /chankeys add meta-s-meta-i
15 #
16 # and thenceforth, hitting that key combination will take you to the channel.
17 # It's smart enough to check whether a mapping is already in use by chankey,
18 # or whether a key combination won't work, for instance because meta-s was
19 # already assigned elsewhere in the above.
20 #
21 # You can also explicitly specify the name (and chatnet) if you'd like to
22 # set up a mapping for another item:
23 #
24 # /chankeys add F12 &bitlbee
25 #
26 # Key bindings are removed when you leave a channel or a query is closed, and
27 # reinstated when the channel or query is reinstated. They are saved to
28 # ~/.irssi/chankeys on /save, and loaded from there on startup and /reload.
29 #
30 ### To-do:
31 #
32 # * Mappings for {01..99} and associated hook to renumber windows with named
33 # mappings
34 # * Handle queries better, i.e. they should be created if not found, probably
35 # just use /query instead of /window goto
36 # * When adding a keymap from /chankey add, if the keymap is already assigned
37 # to another channel, we need to handle this better
38 # * check_for_existing_bind really hurts and causes a bit of lag in Irssi that
39 # it doesn't recover from for a few seconds after load. Better to read /bind
40 # output once into a hash and use that.
41 #
42 use strict;
43 use warnings;
44 use Irssi;
45 use version;
46
47 our %IRSSI = (
48 authors => 'martin f. krafft',
49 contact => 'madduck@madduck.net',
50 name => 'chankeys',
51 description => 'manage channel keyboard shortcuts',
52 license => 'MIT',
53 version => '0.4',
54 changed => '2021-11-03'
55 );
56
57 our $VERSION = $IRSSI{version};
58 my $_VERSION = version->parse($VERSION);
59
60 ### DEFAULTS AND SETTINGS ######################################################
61
62 my $map_file = Irssi::get_irssi_dir()."/chankeys";
63 my $go_command = 'window goto $C';
64 my $autosave = 1;
65 my $overwrite_binds = 0;
66 my $clear_composites = 0;
67 my $debug = 0;
68
69 Irssi::settings_add_str('chankeys', 'chankeys_go_command', $go_command);
70 Irssi::settings_add_bool('chankeys', 'chankeys_autosave', $autosave);
71 Irssi::settings_add_bool('chankeys', 'chankeys_overwrite_binds', $overwrite_binds);
72 Irssi::settings_add_bool('chankeys', 'chankeys_clear_composites', $clear_composites);
73 Irssi::settings_add_bool('chankeys', 'chankeys_debug', $debug);
74
75 sub sig_setup_changed {
76 $debug = Irssi::settings_get_bool('chankeys_debug');
77 $clear_composites = Irssi::settings_get_bool('chankeys_clear_composites');
78 $overwrite_binds = Irssi::settings_get_bool('chankeys_overwrite_binds');
79 $autosave = Irssi::settings_get_bool('chankeys_autosave');
80 $go_command = Irssi::settings_get_str('chankeys_go_command');
81 }
82 Irssi::signal_add('setup changed', \&sig_setup_changed);
83 Irssi::signal_add('setup reread', \&sig_setup_changed);
84 sig_setup_changed();
85
86 my $changed_since_last_save = 0;
87
88 my %itemmap;
89 my %leadkeys;
90
91 ### HELPERS ####################################################################
92
93 sub say {
94 my ($msg, $level, $inwin) = @_;
95 $level = $level // MSGLEVEL_CLIENTCRAP;
96 if ($inwin) {
97 Irssi::active_win->print("chankeys: $msg", $level);
98 }
99 else {
100 Irssi::print("chankeys: $msg", $level);
101 }
102 }
103
104 sub debug {
105 return unless $debug;
106 my ($msg, $inwin) = @_;
107 $msg = $msg // "";
108 say("DEBUG: ".$msg, MSGLEVEL_CRAP + MSGLEVEL_NO_ACT, $inwin);
109 }
110
111 sub info {
112 my ($msg, $inwin) = @_;
113 say($msg, MSGLEVEL_CLIENTCRAP, $inwin);
114 }
115
116 use Data::Dumper;
117 sub dumper {
118 debug(scalar Dumper(@_), 1);
119 }
120
121 sub warning {
122 my ($msg, $inwin) = @_;
123 $msg = $msg // "";
124 say("WARNING: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
125 }
126
127 sub error {
128 my ($msg, $inwin) = @_;
129 $msg = $msg // "";
130 say("ERROR: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
131 }
132
133 sub channet_pair_to_string {
134 my ($name, $chatnet) = @_;
135 my $ret = $chatnet ? "$chatnet/" : '';
136 return $ret . $name;
137 }
138
139 sub string_to_channet_pair {
140 my ($str) = @_;
141 return reverse(split(/\//, $str));
142 }
143
144 sub get_keymap_for_channet_pair {
145 my ($name, $chatnet) = @_;
146 foreach my $cn ($chatnet, undef) {
147 # if not found with $chatnet, fallback to no chatnet
148 my $item = channet_pair_to_string($name, $cn);
149 my $keys = $itemmap{$item};
150 return ($keys, $name, $cn) if $keys;
151 }
152 return ();
153 }
154
155 sub get_go_command {
156 my ($name, $chatnet) = @_;
157 my $cmd = $go_command;
158 $cmd =~ s/\$C/$name/;
159 $cmd =~ s/\$chatnet/$chatnet/;
160 $cmd =~ s/\s+$//;
161 return $cmd;
162 }
163
164 my $keybind_to_check;
165 my $existing_binding;
166 sub check_existing_binds {
167 my ($rec, undef, $text) = @_;
168 if ($rec->{level} == 524288 and $rec->{target} eq '' and !defined $rec->{server}) {
169 if ($text =~ /^\Q${keybind_to_check}\E\s+(.+?)\s*$/) {
170 $existing_binding = $1;
171 }
172 Irssi::signal_stop();
173 }
174 }
175
176 sub check_for_existing_bind {
177 my ($keys) = @_;
178 $keybind_to_check = $keys;
179 $existing_binding = undef;
180 Irssi::signal_add_first('print text' => \&check_existing_binds);
181 Irssi::command("bind $keybind_to_check");
182 Irssi::signal_remove('print text' => \&check_existing_binds);
183 return $existing_binding;
184 }
185
186 ## KEYMAP HANDLERS #############################################################
187
188 sub create_keymapping {
189 my ($keys, $name, $chatnet) = @_;
190 my $cmd = 'command ' . get_go_command($name, $chatnet);
191 if ($keys =~ /(meta-.)-.+/ and !exists($leadkeys{$1})) {
192 if (my $bind = check_for_existing_bind($1)) {
193 if ($clear_composites) {
194 warning("Removing bind from $1 to '$bind' as instructed");
195 Irssi::command("^bind -delete $1");
196 $leadkeys{$1} = $bind;
197 }
198 else {
199 error("$1 is bound to '$bind' and cannot be used in composite keybinding", 1);
200 return 0;
201 }
202 }
203 }
204 Irssi::command("^bind $keys $cmd");
205 return 1;
206 }
207
208 sub check_create_keymapping {
209 my ($keys, $name, $chatnet) = @_;
210 my $cmd = 'command ' . get_go_command($name, $chatnet);
211 my $bind = check_for_existing_bind($keys);
212 if ($bind and $bind ne $cmd) {
213 if ($overwrite_binds) {
214 warning("Overwriting bind from $keys to '$bind' as instructed");
215 }
216 else {
217 error("Key $keys already bound to '$bind', please remove first.", 1);
218 return 0;
219 }
220 }
221 return create_keymapping($keys, $name, $chatnet);
222 }
223
224 sub add_keymapping {
225 my ($keys, $name, $chatnet) = @_;
226 if (check_create_keymapping($keys, $name, $chatnet)) {
227 $name = channet_pair_to_string($name, $chatnet);
228 debug("Key binding created: $keys → $name", 1);
229 return 1;
230 }
231 return 0;
232 }
233
234 sub remove_keymapping {
235 my ($keys) = @_;
236 my $bind = check_for_existing_bind($keys);
237 if (!$bind) {
238 error("No chankey mapping for $keys");
239 return;
240 }
241 my $item = lookup_item_by_keys($keys);
242 if ($item) {
243 Irssi::command("^bind -delete $keys");
244 return $bind;
245 }
246 else {
247 error("The key binding for '$keys' is not a chankeys binding: $bind");
248 return;
249 }
250 }
251
252 sub lookup_item_by_keys {
253 my ($data) = @_;
254 my $ret;
255 while (my ($item, $keys) = each %itemmap) {
256 $ret = $item if ($keys eq $data);
257 # do not call last or the iterator won't be reset
258 }
259 return $ret;
260 }
261
262 sub remove_existing_binds {
263 while (my ($item, $keys) = each %itemmap) {
264 Irssi::command("^bind -delete $keys");
265 }
266 %leadkeys = ();
267 }
268
269 ### SAVING AND LOADING #########################################################
270
271 sub get_mappings_fh {
272 my ($filename) = @_;
273 my $fh;
274 if (! -e $filename) {
275 save_mappings($filename);
276 info("Created new/empty mappings file: $filename");
277 }
278 open($fh, '<', $filename) || error("Cannot open mappings file: $!");
279 return $fh;
280 }
281
282 sub load_mappings {
283 my ($filename) = @_;
284 %itemmap = ();
285 my $fh = get_mappings_fh($filename);
286 my $firstline = <$fh> || error("Cannot read from $filename.");;
287 my $version;
288 if ($firstline =~ m/^;+\s+chankeys keymap file \(version: *([\d.]+)\)/) {
289 $version = $1;
290 }
291 else {
292 error("First line of $filename is not a chankey header.");
293 }
294
295 my $l = 1;
296 while (<$fh>) {
297 $l++;
298 next if m/^\s*(?:;|$)/;
299 my ($item, $keys, $rest) = split;
300 if ($rest) {
301 error("Cannot parse $filename:$l: $_");
302 return;
303 }
304 $itemmap{$item} = $keys;
305 }
306 close($fh) || error("Cannot close mappings file: $!");
307 }
308
309 sub save_mappings {
310 my ($filename) = @_;
311 open(FH, '+>', $filename) || error("Cannot create mappings file: $!");
312 print FH <<"EOF";
313 ; chankeys keymap file (version: $_VERSION)
314 ;
315 ; WARNING: this file will be overwritten on /save,
316 ; use "/set chankey_autosave off" to avoid.
317 ;
318 ; item: channel name (optionally chatnet/#channel) or query partner
319 ; keys: key combination
320 ;
321 ; item keys
322
323 EOF
324 while (my ($name, $keys) = each %itemmap) {
325 print FH "$name\t$keys\n";
326 }
327 print FH <<"EOF";
328
329 ; EXAMPLES
330 ;
331 ;;; associate meta-s-meta-i with the #irssi channel
332 ; libera/#irssi meta-s-meta-i
333 ;
334 ;;; associate F12 with the bitlbee control window
335 ; &bitlbee F12
336 ;
337 ;;; associate meta-\ with a query
338 ; bitlbee/sgs7e meta-\\
339
340 ; vim:noet:tw=0:ts=48:com=b\\:;
341 EOF
342 close(FH);
343 }
344
345 ## COMMAND HANDLERS ############################################################
346
347 sub chankey_add {
348 my ($data, $server, $witem) = @_;
349 my ($keys, $name, $chatnet) = split /\s+/, $data;
350 if ($name) {
351 ($name, $chatnet) = string_to_channet_pair($name) unless $chatnet;
352 }
353 else {
354 if (!$witem) {
355 error("No active window item to add a channel key for", 1);
356 return;
357 }
358 $name = $witem->{name};
359 $chatnet = $server->{chatnet};
360 }
361 if (add_keymapping($keys, $name, $chatnet)) {
362 $itemmap{channet_pair_to_string($name, $chatnet)} = $keys;
363 $changed_since_last_save = 1;
364 }
365 }
366
367 sub chankey_remove {
368 my ($data) = @_;
369 return unless $data;
370 my $bind = remove_keymapping($data);
371 if ($bind) {
372 debug("Key binding removed: $data (was: $bind)");
373 my $item = lookup_item_by_keys($data);
374 delete($itemmap{$item});
375 $changed_since_last_save = 1;
376 }
377 }
378
379 sub chankey_list {
380 return unless %itemmap;
381 info("Key bindings I know about:", 1);
382 foreach my $item (sort keys %itemmap) {
383 my $keys = $itemmap{$item};
384 my $active;
385 if (my $bind = check_for_existing_bind($keys)) {
386 my ($name, $chatnet) = string_to_channet_pair($item);
387 $active = $bind eq ('command ' . get_go_command($name, $chatnet));
388 }
389 my $out = sprintf("%13s %1s %s", $keys, $active ? '→' : '', $item);
390 info($out, 1);
391 }
392 }
393
394 sub chankey_load {
395 remove_existing_binds();
396 load_mappings($map_file);
397 my $cnt = scalar(keys %itemmap);
398 foreach my $channel (Irssi::channels, Irssi::queries) {
399 my $name = $channel->{name};
400 my $chatnet = $channel->{server}->{chatnet};
401 if (my @keymap = get_keymap_for_channet_pair($name, $chatnet)) {
402 create_keymapping(@keymap);
403 }
404 }
405 $changed_since_last_save = 0;
406 info("Loaded $cnt mappings from $map_file");
407 }
408
409 sub chankey_save {
410 my ($args) = @_;
411 if (!$changed_since_last_save and $args ne '-force') {
412 info("Not saving unchanged mappings without -force");
413 return;
414 }
415 autosave(1);
416 }
417
418 sub chankey_goto {
419 my ($args) = @_;
420 my ($name, $chatnet) = split /\s+/, $args;
421 my $cmd = get_go_command($name, $chatnet);
422 Irssi::command("^$cmd");
423 }
424
425 Irssi::command_bind('chankeys add', \&chankey_add);
426 Irssi::command_bind('chankeys remove', \&chankey_remove);
427 Irssi::command_bind('chankeys list', \&chankey_list);
428 Irssi::command_bind('chankeys reload', \&chankey_load);
429 Irssi::command_bind('chankeys save', \&chankey_save);
430 Irssi::command_bind('chankeys goto', \&chankey_goto);
431 Irssi::command_bind('chankeys help', \&chankey_help);
432 Irssi::command_bind('chankeys', sub {
433 my ( $data, $server, $item ) = @_;
434 $data =~ s/\s+$//g;
435 if ($data) {
436 Irssi::command_runsub('chankeys', $data, $server, $item);
437 }
438 else {
439 chankey_help();
440 }
441 }
442 );
443 Irssi::command_bind('help', sub {
444 $_[0] =~ s/\s+$//g;
445 return unless $_[0] eq 'chankeys';
446 chankey_help();
447 Irssi::signal_stop();
448 }
449 );
450
451 sub chankey_help {
452 my ($data, $server, $item) = @_;
453 Irssi::print (<<"SCRIPTHELP_EOF", MSGLEVEL_CLIENTCRAP);
454 %_chankeys $_VERSION - associate key shortcuts with channels
455
456 %U%_Synopsis%_%U
457
458 %_CHANKEYS ADD%_ <%Ukeybinding%U> [<%Uchannel%U>] [<%Uchatnet%U>]
459 %_CHANKEYS REMOVE%_ <%Ukeybinding%U>
460 %_CHANKEYS LIST%_
461 %_CHANKEYS [RE]LOAD%_
462 %_CHANKEYS SAVE%_ [-force]
463 %_CHANKEYS GOTO%_ <%Uchannel%U> [<%Uchatnet%U>]
464 %_CHANKEYS HELP%_
465
466 <%Ukeybinding%U> %| Key(s) to bind. Refer to %_/HELP BIND%_ for format
467 <%Uchannel%U> %| Channel name to associate. Can include %_/chatnet%.
468 <%Uchatnet%U> %| The chatnet of the channel. Not generally supported.
469
470 %U%_Settings%_%U
471
472 /set %_chankeys_go_command%_ [$go_command]
473 %| The command to use to switch to a matching window item. The only reason
474 %| you might need to set this is if you have channels with the same name
475 %| across different chatnets. In this case, you need to load the go2.pl
476 %| module, and set this to "go \$C \$chatnet", because "window goto" cannot
477 %| incorporate the chatnet (yet). Beware that this will prevent
478 %| adv_windowlist.pl from reading out the keybinding to use for the
479 %| statusbar.
480
481 /set %_chankeys_overwrite_binds%_ [$overwrite_binds]
482 %| When chankey encounters an existing key mapping, it refuses to overwrite
483 %| it unless this is switched on.
484
485 /set %_chankeys_clear_composites%_ [$clear_composites]
486 %| A mapping like meta-s-meta-i will not work if meta-s is bound to something
487 %| already, and chankey will check and fail in such a case. Setting this
488 %| to on will make chankeys remove the existing mapping, such that the
489 %| composite mapping works.
490
491 /set %_chankeys_autosave%_ [$autosave]
492 %| Skip saving/overwriting the chankeys setup to file if you prefer to
493 %| maintain the mappings outside of irssi.
494
495 /set %_chankeys_debug%_ [$debug]
496 %| Turns on debug output. Not that this may itself be buggy, so please don't
497 %| use it unless you really need it.
498
499 %U%_Examples%_%U
500
501 Associate %_meta-d-meta-d%_ with the current channel
502 %|%#/%_CHANKEYS ADD%_ meta-d-meta-d
503
504 Associate F12 with the &bitlbee window
505 %|%#/%_BIND%_ ^[[24~ key F12
506 %|%#/%_CHANKEYS ADD%_ F12 &bitlbee
507
508 Associate %_meta-m-meta-m%_ with the #matrix channel on LiberaChat
509 %|%#/%_CHANKEYS ADD%_ meta-m-meta-m #matrix LiberaChat
510
511 Alternative form to specify chatnet
512 %|%#/%_CHANKEYS ADD%_ meta-m-meta-m #matrix/LiberaChat
513
514 Save mappings to file ($map_file), using -force to write even if nothing has changed:
515 %|%#/%_CHANKEYS SAVE%_ -force
516
517 Load mappings from file ($map_file):
518 %|%#/%_CHANKEYS LOAD%_
519
520 List all known key associations
521 %|%#/%_CHANKEYS LIST%_
522 SCRIPTHELP_EOF
523 }
524
525 ## SIGNAL HANDLERS #############################################################
526
527 sub on_channel_created {
528 my ($chanrec, $auto) = @_;
529 my $name = $chanrec->{name};
530 my $chatnet = $chanrec->{server}->{chatnet};
531 my @keymap = get_keymap_for_channet_pair($name, $chatnet);
532 add_keymapping(@keymap) if @keymap;
533 }
534 Irssi::signal_add('channel created' => \&on_channel_created);
535 Irssi::signal_add('query created' => \&on_channel_created);
536
537 sub on_channel_destroyed {
538 my ($chanrec) = @_;
539 my $name = $chanrec->{name};
540 my $chatnet = $chanrec->{server}->{chatnet};
541 my ($keys, undef, undef) = get_keymap_for_channet_pair($name, $chatnet);
542 remove_keymapping($keys) if $keys;
543 }
544 Irssi::signal_add('channel destroyed' => \&on_channel_destroyed);
545 Irssi::signal_add('query destroyed' => \&on_channel_destroyed);
546
547 sub autosave {
548 my ($force) = @_;
549 return unless $changed_since_last_save or $force;
550 if (!$autosave) {
551 info("Not saving mappings due to chankeys_autosave setting");
552 return;
553 }
554 info("Saving mappings to $map_file");
555 save_mappings($map_file);
556 $changed_since_last_save = 0;
557 }
558
559 sub UNLOAD {
560 autosave();
561 }
562
563 Irssi::signal_add('setup saved', \&autosave);
564 Irssi::signal_add('setup reread', \&chankey_load);
565
566 ## INIT ########################################################################
567
568 chankey_load();
+68
-18
scripts/chansearch.pl less more
44 use strict;
55
66 use vars qw($VERSION %IRSSI);
7 $VERSION = '2.1';
7 $VERSION = '2.3';
88 %IRSSI = (
99 authors => 'Stefan \'tommie\' Tomanek, bw1',
1010 contact => 'bw1@aol.at',
1313 license => 'GPLv2',
1414 url => 'http://scripts.irssi.org/',
1515 changed => $VERSION,
16 selfcheckcmd=> '/chansearch -check',
1617 );
1718
1819 my $help = << "END";
3839 use Irssi 20020324;
3940 use open qw/:std :utf8/;
4041 use LWP::UserAgent;
42 use LWP::Protocol::https;
4143 use HTML::Entities;
4244 use JSON::PP;
4345 use Getopt::Long qw(GetOptionsFromString);
4951 my $footer;
5052 my ($default_network, $max_results, $max_columns);
5153 my ($max_columns2);
52 my @results;
54 my (@results, $resultcount);
5355
5456 # ! for the fork
55 my @clist;
56 my $t;
57 my (@clist, $t, $rcount);
5758
5859 sub draw_box ($$$$) {
5960 my ($title, $text, $footer, $colour) = @_;
7071 sub dehtml {
7172 my ($text) =@_;
7273 $text =decode_entities($text);
73 utf8::decode($text);
7474 $text =~ s/<.*?>//g;
7575 return $text;
7676 }
7777
7878 sub get_entries_count {
79 $t =~ m/(\d+) matching entries found/;
79 $t =~ m/(\d+) matching results/;
8080 return $1;
8181 }
8282
8383 sub html_to_list {
84 utf8::decode($t);
8485 while (length($t) > 0) {
8586 my %h;
8687 if ($t =~ m#<span class="cs-channel">(.*?)</span>#p) {
8788 $h{channel}= dehtml($1);
8889 $' =~ m#<span class="cs-network">(.*?)</span>#p;
8990 $h{network}= dehtml($1);
90 $' =~ m#<span class="cs-users">(.*?)</span>#p;
91 #$' =~ m#<span class="cs-users">(.*?)</span>#p;
92 #$' =~ m#<span class="cs-details">Chat Room.*?(\d+).*?</span>#p;
93 $' =~ m#<span class="cs-details">Chat Room - (\d+) users - </span>#p;
9194 my $u=$1;
92 $' =~ m#class="cs-time">.*?</span>(.*?)<span class="cs-category"#p;
95 #$' =~ m#class="cs-time">.*?</span>(.*?)<span class="cs-category"#p;
96 $' =~ m#(current topic:|No topic)(.*?)<br>#p;
9397 $t= $';
94 $h{topic}=dehtml($1);
98 $h{topic}=dehtml($2);
9599 $u =~ m/(\d+)/;
96100 $h{users}=$1;
97101 push @clist, {%h};
118122 print CLIENTCRAP "%R>>%n Please wait...";
119123 } else {
120124 search_channels($query,$net);
121 my $data = encode_json( \@clist );
125 #my $data = encode_json( \@clist );
126 my $data = encode_json( { clist=>[ @clist ], rcount=>$rcount } );
122127 print($wh $data);
123128 close($wh);
124129 POSIX::_exit(1);
138143 Irssi::input_remove($$pipetag);
139144 return unless($data);
140145
141 @results = @{ decode_json( $data ) };
146 my $res= decode_json( $data );
147 @results = @{ $res->{clist} };
148 $resultcount = $res->{rcount};
142149
143150 my $lnet=0;
144151 my $lchan=0;
167174 # http://irc.netsplit.de/channels/?net=IRCnet&chat=linux&num=10
168175 my $num='';
169176 my $count=0;
170 my $rcount;
171177 do {
172178 my $page = "http://irc.netsplit.de/channels/?net=$net&chat=$query$num";
173179 my $result = $ua->get($page);
202208 }
203209
204210 sub self_check_init {
205 fork_search('linux','IRCnet');
211 $max_results=30;
212 fork_search('linux','Freenode');
206213 Irssi::timeout_add_once(5*1000, 'sig_self_check','');
207 Irssi::command_bind('quit', \&cmd_quit_self_check);
214 }
215
216 sub self_check_quit {
217 my ( $s )=@_;
218 Irssi::command("selfcheckhelperscript $s");
208219 }
209220
210221 sub sig_self_check {
211 my $min=10;
212 if ( scalar @results > $min) {
222 my ($min, $max);
223 # min result
224 $min=20;
225 if ( scalar @results >= $min) {
213226 print "Results: ",scalar @results," check";
214227 } else {
215228 print "Results: ",scalar @results," <$min fail";
216 die("Error: self check fail");
217 }
229 self_check_quit("Error: self check fail (result)");
230 }
231 # result more pages
232 if ( $resultcount == scalar @results || $max_results == scalar @results ) {
233 print "Resultscount: $resultcount check";
234 } else {
235 print "Resultscount: $resultcount fail";
236 self_check_quit("Error: self check fail (pages)");
237 }
238 $max_results= Irssi::settings_get_int($IRSSI{name}.'_max_results');
239 # topic
240 $min= 1000;
241 $max= 0;
242 foreach my $n ( @results ) {
243 my $l = length ( $n->{topic} );
244 $min = $l if ($l < $min);
245 $max = $l if ($l > $max);
246 }
247 if ( $min != $max && $max >200 ) {
248 print "Topic min:$min max:$max check";
249 } else {
250 print "Topic min:$min max:$max";
251 self_check_quit("Error: self check fail (topic)");
252 }
253 # users
254 $min= 10000;
255 $max= 0;
256 foreach my $n ( @results ) {
257 my $l = $n->{users} ;
258 $min = $l if ($l < $min);
259 $max = $l if ($l > $max);
260 }
261 if ( $min != $max && $max >200 ) {
262 print "Users min:$min max:$max check";
263 } else {
264 print "Users min:$min max:$max";
265 self_check_quit("Error: self check fail (users)");
266 }
267 self_check_quit('ok');
218268 }
219269
220270 sub sig_setup_changed {
+18
-42
scripts/chansort.pl less more
0 #! /usr/bin/perl
10 #
2 # $Id: chansort.pl,v 1.4 2004/11/02 22:52:33 peder Exp $
3 #
4 # Copyright (C) 2004 by Peder Stray <peder@gzip.ninja.no>
1 # Copyright (C) 2004-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
85 use Irssi;
96 use Irssi::Irc;
107
11 # ======[ Script Header ]===============================================
12
138 use vars qw{$VERSION %IRSSI};
14 ($VERSION) = '$Revision: 1.4 $' =~ / (\d+\.\d+) /;
9 ($VERSION) = '$Revision: 1.5.1 $' =~ / (\d+(\.\d+)+) /;
1510 %IRSSI = (
16 name => 'chansort',
17 authors => 'Peder Stray',
18 contact => 'peder@ninja.no',
19 url => 'http://ninja.no/irssi/chansort.pl',
20 license => 'GPL',
21 description => 'Sort all channel and query windows',
22 );
23
24 # ======[ Hooks ]=======================================================
25
26 # --------[ sig_sort_trigger ]------------------------------------------
11 name => 'chansort',
12 authors => 'Peder Stray',
13 contact => 'peder.stray@gmail.com',
14 url => 'https://github.com/pstray/irssi-chansort',
15 license => 'GPL',
16 description => 'Sort all channel and query windows',
17 );
2718
2819 sub sig_sort_trigger {
2920 return unless Irssi::settings_get_bool('chansort_autosort');
3021 cmd_chansort();
3122 }
3223
33 # ======[ Commands ]====================================================
34
35 # --------[ CHANSORT ]--------------------------------------------------
36
3724 # Usage: /CHANSORT
3825 sub cmd_chansort {
3926 my(@windows);
4027 my($minwin);
4128
29 my $netonly = Irssi::settings_get_bool('chansort_netonly');
30
4231 for my $win (Irssi::windows()) {
4332 my $act = $win->{active};
4433 my $key;
4534
35 my $id = sprintf "%05d", $win->{refnum};
36
4637 if ($act->{type} eq 'CHANNEL') {
47 $key = "C".$act->{server}{tag}.' '.substr($act->{visible_name}, 1);
38 $key = "C".$act->{server}{tag}.' '.($netonly ? $id : substr($act->{visible_name}, 1));
4839 }
4940 elsif ($act->{type} eq 'QUERY') {
50 $key = "Q".$act->{server}{tag}.' '.$act->{visible_name};
41 $key = "Q".$act->{server}{tag}.' '.($netonly ? $id : $act->{visible_name});
5142 }
5243 else {
5344 next;
6253 for (sort {$a->[0] cmp $b->[0]} @windows) {
6354 my($key,$win) = @$_;
6455 my($act) = $win->{active};
65
66 # printf("win[%d->%d]: t[%s] [%s] [%s] {%s}\n",
56
57 # printf("win[%d->%d]: t[%s] [%s] [%s] {%s}\n",
6758 # $win->{refnum},
6859 # $minwin,
6960 # $act->{type},
7768 }
7869 }
7970
80 # ======[ Setup ]=======================================================
81
82 # --------[ Register commands ]-----------------------------------------
83
8471 Irssi::command_bind('chansort', 'cmd_chansort');
8572
86 # --------[ Register settings ]-----------------------------------------
87
8873 Irssi::settings_add_bool('chansort', 'chansort_autosort', 0);
89
90 # --------[ Register signals ]------------------------------------------
74 Irssi::settings_add_bool('chansort', 'chansort_netonly', 0);
9175
9276 Irssi::signal_add_last('window item name changed', 'sig_sort_trigger');
9377 Irssi::signal_add_last('channel created', 'sig_sort_trigger');
9478 Irssi::signal_add_last('query created', 'sig_sort_trigger');
95
96 # ======[ END ]=========================================================
97
98 # Local Variables:
99 # header-initial-hide: t
100 # mode: header-minor
101 # end:
102
+217
-0
scripts/colorize_nicks.pl less more
0 use strict;
1 use warnings;
2
3 our $VERSION = '0.4.1'; # ed9cb119fc4b3d1
4 our %IRSSI = (
5 authors => 'Nei',
6 contact => 'Nei @ anti@conference.jabber.teamidiot.de',
7 url => "http://anti.teamidiot.de/",
8 name => 'colorize_nicks',
9 description => 'Colourise mention of nicks in the message body.',
10 license => 'GNU GPLv2 or later',
11 );
12
13 # inspired by mrwright's nickcolor.pl and xt's colorize_nicks.pl
14 #
15 # you need nickcolor_expando or another nickcolor script providing the
16 # get_nick_color2 function
17
18 # Usage
19 # =====
20 # should start working once loaded
21
22 # Options
23 # =======
24 # /set colorize_nicks_skip_formats <num>
25 # * how many forms (blocks of irssi format codes or non-letters) to
26 # skip at the beginning of line before starting to colourise nicks
27 # (you usually want to skip the speaker's nick itself and the
28 # timestamp)
29 #
30 # /set colorize_nicks_ignore_list <words to ignore>
31 # * list of nicks (words) that should never be coloured
32 #
33 # /set colorize_nicks_repeat_formats <ON|OFF>
34 # * repeat the format stack from the beginning of line, enable when
35 # using per-line colours and colorize_nicks breaks it
36
37 # Commands
38 # ========
39 # you can use this alias:
40 #
41 # /alias nocolorize set colorize_nicks_ignore_list $colorize_nicks_ignore_list
42 #
43 # /nocolorize <nick>
44 # * quickly add nick to the bad word list of nicks that should not be
45 # colourised
46
47 no warnings 'redefine';
48 use Irssi;
49
50 my $irssi_mumbo = qr/\cD[`-i]|\cD[&-@\xff]./;
51
52 my $nickchar = qr/[\]\[[:alnum:]\\|`^{}_-]/;
53 my $nick_pat = qr/($nickchar+)/;
54
55 my @ignore_list;
56
57 my $colourer_script;
58
59 sub _find_colourer {
60 my $colourer;
61 unless ($colourer_script
62 && ($colourer = "Irssi::Script::$colourer_script"->can('get_nick_color2'))) {
63 for my $script (sort map { s/::$//r } keys %Irssi::Script::) {
64 if ($colourer = "Irssi::Script::$script"->can('get_nick_color2')) {
65 $colourer_script = $script;
66 last;
67 }
68 }
69 }
70 $colourer
71 }
72
73 sub _get_chanref {
74 my ($dest) = @_;
75 return unless $dest->{level} & MSGLEVEL_PUBLIC;
76 return unless defined $dest->{target};
77 return unless ref $dest->{server};
78 $dest->{server}->channel_find($dest->{target})
79 }
80
81 sub _colourise_nicks {
82 my ($dest, $chanref, $colourer, @nicks) = @_;
83
84 my %nicks = map { $_->[0] => $colourer->($dest->{server}{tag}, $chanref->{name}, $_->[1], 1) }
85 grep { defined }
86 map { if (my $nr = $chanref->nick_find($_)) {
87 [ $_ => $nr->{nick} ]
88 } }
89 keys %{ +{ map { $_ => undef } @nicks } };
90 delete @nicks{ @ignore_list };
91
92 my $nick_re = join '|', map { quotemeta } sort { length $b <=> length $a } grep { length $nicks{$_} } keys %nicks;
93
94 (\%nicks, $nick_re)
95 }
96
97 sub _colourise_form {
98 my ( $text,
99 $skip,
100 $nicks,
101 $nick_re ) = @_;
102 return if $skip < 0;
103
104 my $repeat = Irssi::settings_get_bool('colorize_nicks_repeat_formats');
105
106 my @forms = split /((?:$irssi_mumbo|\s|[.,*@%+&!#$()=~'";:?\/><]+(?=$irssi_mumbo|\s))+)/, $text, -1;
107 my $ret = '';
108 my $fmtstack = '';
109 while (@forms) {
110 my ($t, $form) = splice @forms, 0, 2;
111 if ($skip > 0) {
112 --$skip;
113 $ret .= $t;
114 $ret .= $form if defined $form;
115 if ($repeat) {
116 $fmtstack .= join '', $form =~ /$irssi_mumbo/g if defined $form;
117 $fmtstack =~ s/\cDe//g;
118 }
119 }
120 elsif (length $nick_re
121 && $t =~ s/((?:^|\s)\W{0,3}?)(?<!$nickchar|')($nick_re)(?!$nickchar)/$1$nicks->{$2}$2\cDg$fmtstack/g) {
122 $ret .= "$t\cDg$fmtstack";
123 $ret .= $form if defined $form;
124 $fmtstack .= join '', $form =~ /$irssi_mumbo/g if defined $form;
125 $fmtstack =~ s/\cDe//g;
126 }
127 else {
128 $ret .= $t;
129 $ret .= $form if defined $form;
130 }
131 }
132
133 $ret
134 }
135
136 # TXT_OWN_MSG, server->nick, msg, nickmode
137 # TXT_OWN_MSG_CHANNEL, server->nick, target, msg, nickmode
138 # TXT_PUBMSG_HILIGHT, color, printnick, msg, nickmode
139 # TXT_PUBMSG_HILIGHT_CHANNEL, color, printnick, target, msg, nickmode
140 # for_me ? TXT_PUBMSG_ME : TXT_PUBMSG, printnick, msg, nickmode
141 # for_me ? TXT_PUBMSG_ME_CHANNEL : TXT_PUBMSG_CHANNEL, printnick, target, msg, nickmode
142 sub prt_format_issue {
143 my ( $theme,
144 $module,
145 $dest,
146 $format,
147 @args
148 ) = @_;
149 my $chanref = _get_chanref($dest);
150 return unless $chanref;
151 my $colourer = _find_colourer();
152 return unless $colourer;
153
154 my $arg = 1;
155 $arg++ if $format =~ /_channel/;
156 $arg++ if $format =~ /_hilight/;
157 return unless @args > $arg;
158
159 utf8::decode($args[$arg]);
160 my $text = $args[$arg];
161 my $stripped = Irssi::strip_codes($text);
162
163 utf8::decode($stripped);
164 my ($nicks, $nick_re) = _colourise_nicks($dest, $chanref, $colourer, $stripped =~ /$nick_pat/g);
165 return unless $nicks;
166
167 $args[$arg] = _colourise_form($text, 0, $nicks, $nick_re);
168 Irssi::signal_continue($theme, $module, $dest, $format, @args)
169 if defined $args[$arg] && $args[$arg] ne $text;
170 }
171
172 sub prt_text_issue {
173 my ( $dest,
174 $text,
175 $stripped
176 ) = @_;
177 my $chanref = _get_chanref($dest);
178 return unless $chanref;
179 my $colourer = _find_colourer();
180 return unless $colourer;
181
182 utf8::decode($text);
183 utf8::decode($stripped);
184 my ($nicks, $nick_re) = _colourise_nicks($dest, $chanref, $colourer, $stripped =~ /$nick_pat/g);
185 return unless $nicks;
186
187 my $skip = Irssi::settings_get_int('colorize_nicks_skip_formats');
188 my $ret = _colourise_form($text, $skip, $nicks, $nick_re);
189 Irssi::signal_continue($dest, $ret, $stripped)
190 if defined $ret && $ret ne $text;
191 }
192
193 sub setup_changed {
194 @ignore_list = split /\s+|,/, Irssi::settings_get_str('colorize_nicks_ignore_list');
195 }
196
197 sub init {
198 setup_changed();
199 }
200
201 if ((Irssi::parse_special('$abiversion')||0) >= 28) {
202 Irssi::signal_add(
203 'print format' => 'prt_format_issue'
204 );
205 } else {
206 Irssi::signal_add(
207 'print text' => 'prt_text_issue'
208 );
209 Irssi::settings_add_int('colorize_nicks', 'colorize_nicks_skip_formats' => 2);
210 }
211 Irssi::signal_add_last('setup changed' => 'setup_changed');
212
213 Irssi::settings_add_str('colorize_nicks', 'colorize_nicks_ignore_list' => '');
214 Irssi::settings_add_bool('colorize_nicks', 'colorize_nicks_repeat_formats' => 0);
215
216 init();
+1087
-0
scripts/ctrlact.pl less more
0 # ctrlact.pl — Irssi script for fine-grained control of activity indication
1 #
2 # © 2017–2021 martin f. krafft <madduck@madduck.net>
3 # Released under the MIT licence.
4 #
5 ### Usage:
6 #
7 # /script load ctrlact
8 #
9 # If you like a busy activity statusbar, this script is not for you.
10 #
11 # If, on the other hand, you don't care about most activity, but you do want
12 # the ability to define, per-item and per-window, what level of activity should
13 # trigger a change in the statusbar, possibily depending on how long ago
14 # you yourself were active on the channel, then ctrlact might be for you.
15 #
16 # For instance, you might never want to be disturbed by activity in any
17 # channel, unless someone highlights you, or if you've said something yourself
18 # in the channel in the past hour. You also want all activity
19 # in queries (except on efnet), as well as an indication about any chatter in
20 # your company channels. The following ctrlact map would do this for you:
21 #
22 # channel * /^#myco-/ messages
23 # channel * * messages 3600
24 # channel * * hilights
25 # query efnet * messages
26 # query * * all
27 #
28 # These five lines would be interpreted/read as:
29 # "only messages or higher in a channel matching /^#myco-/ should trigger act"
30 # "in all other channels where I've been active in the last 3600 seconds,
31 # trigger on all messages"
32 # "in all other channels, only hilights (or higher) should trigger act"
33 # "queries on efnet should only trigger act for messages and higher"
34 # "privmsgs of all levels should trigger act in queries elsewhere"
35 #
36 # The activity level in the fourth column is thus to be interpreted as
37 # "the minimum level of activity that will trigger an indication"
38 #
39 # Loading this script per-se should not change anything, except it will create
40 # ~/.irssi/ctrlact with some informational content, including the defaults and
41 # some examples.
42 #
43 # The four activity levels are, and you can use either the words, or the
44 # integers in the map.
45 #
46 # all (data_level: 1)
47 # messages (data_level: 2)
48 # hilights (data_level: 3)
49 # none (data_level: 4)
50 #
51 # Note that the name is either matched in full and verbatim, or treated like
52 # a regular expression, if it starts and ends with the same punctuation
53 # character. You may also use the asterisk by itself to match everything, or
54 # as part of a word, e.g. #debian-*. No other wildcards are supported.
55 #
56 # If you change the file, make sure to use /ctrlact reload or else it may get
57 # overwritten.
58 #
59 # There's an interplay between window items and windows here, and you can
60 # specify mininum activity levels for each. Here are the rules:
61 #
62 # 1. if the minimum activity level of a window item (channel or query) is not
63 # reached, then the window is prevented from indicating activity.
64 # 2. if traffic in a window item does reach minimum activity level, then the
65 # minimum activity level of the window is considered, and activity is only
66 # indicated if the window's minimum activity level is lower.
67 #
68 # In general, this means you'd have windows defaulting to 'all', but it might
69 # come in handy to move window items to windows with min.levels of 'hilights'
70 # or even 'none' in certain cases, to further limit activity indication for
71 # them.
72 #
73 # You can use the Irssi settings activity_msg_level and activity_hilight_level
74 # to specify which IRC levels will be considered messages and hilights. Note
75 # that if an activity indication is inhibited, then there also won't be
76 # a beep (cf. beep_msg_level), unless you toggle ctrlmap_inhibit_beep.
77 #
78 ### Changelog:
79 #
80 # 2021-09-20 : v1.5
81 # * Introduce snoop and sleep. Snooping means ctrlact will apply rules as if
82 # you had just been active on the channel, and sleeping means that ctrlact
83 # applies rules as if you hadn't been active recently.
84 # * Also display the time remaining when an attention-span rule matches
85 # * Sanity checks on the fallback settings
86 # * Implement /ctrlact help
87 # * Fix /ctrlact show with an empty ruleset
88 #
89 # 2021-09-11 : v1.4
90 # * Let rules be defined and removed with /ctrlact add/remove
91 # * Implement saving of map file
92 # * Introduce the concept of attention span
93 # * Wildcard matching on substrings
94 # * Several code refactorings and improvements
95 #
96 # 2021-09-06 : v1.3
97 # * Maintenance release, minor fixups
98 #
99 # 2017-02-24 : v1.2
100 # * Fix invocation of '/ctrlact query' without a -tag (#354)
101 #
102 # 2017-02-15 : v1.1
103 # * Configurable inhibition of beeps
104 # * Re-read configuration properly
105 # * Provide for matching on chatnet/server tag
106 #
107 # 2017-02-12 : v1.0
108 # * Initial public release
109 #
110 ### To-do:
111 #
112 # - figure out interplay with activity_hide_level
113 # - use Irssi formats
114 #
115 use strict;
116 use warnings;
117 use utf8;
118 use Carp qw( croak );
119 use Irssi;
120 use Text::ParseWords;
121 use version;
122
123 our %IRSSI = (
124 authors => 'martin f. krafft',
125 contact => 'madduck@madduck.net',
126 name => 'ctrlact',
127 description => 'allows per-channel control over activity indication',
128 license => 'MIT',
129 url => 'https://github.com/irssi/scripts.irssi.org/blob/master/scripts/ctrlact.pl',
130 version => '1.5',
131 changed => '2021-09-20'
132 );
133
134 our $VERSION = $IRSSI{version};
135 my $_VERSION = version->parse($VERSION);
136
137 ### DEFAULTS AND SETTINGS ######################################################
138
139 my @DATALEVEL_KEYWORDS = ('all', 'messages', 'hilights', 'none');
140
141 my $debug = 0;
142 my $map_file = Irssi::get_irssi_dir()."/ctrlact";
143 my $fallback_channel_threshold = 1;
144 my $fallback_query_threshold = 1;
145 my $fallback_window_threshold = 1;
146 my $inhibit_beep = 1;
147 my $autosave = 1;
148
149 Irssi::settings_add_str('ctrlact', 'ctrlact_map_file', $map_file);
150 Irssi::settings_add_bool('ctrlact', 'ctrlact_debug', $debug);
151 Irssi::settings_add_str('ctrlact', 'ctrlact_fallback_channel_threshold', $fallback_channel_threshold);
152 Irssi::settings_add_str('ctrlact', 'ctrlact_fallback_query_threshold', $fallback_query_threshold);
153 Irssi::settings_add_str('ctrlact', 'ctrlact_fallback_window_threshold', $fallback_window_threshold);
154 Irssi::settings_add_bool('ctrlact', 'ctrlact_inhibit_beep', $inhibit_beep);
155 Irssi::settings_add_bool('ctrlact', 'ctrlact_autosave', $autosave);
156
157 sub init_threshold_setting {
158 my ($type, $ref) = @_;
159 my $setting = 'ctrlact_fallback_'.$type.'_threshold';
160 my $th = Irssi::settings_get_str($setting);
161 my $dl = get_data_level($th);
162 if ($dl) {
163 ${$ref} = $dl;
164 }
165 else {
166 Irssi::settings_set_str($setting, ${$ref});
167 }
168 }
169
170 sub sig_setup_changed {
171 $debug = Irssi::settings_get_bool('ctrlact_debug');
172 $map_file = Irssi::settings_get_str('ctrlact_map_file');
173
174 init_threshold_setting('channel', \$fallback_channel_threshold);
175 init_threshold_setting('query', \$fallback_query_threshold);
176 init_threshold_setting('window', \$fallback_window_threshold);
177
178 $inhibit_beep = Irssi::settings_get_bool('ctrlact_inhibit_beep');
179 $autosave = Irssi::settings_get_bool('ctrlact_autosave');
180 }
181 Irssi::signal_add('setup changed', \&sig_setup_changed);
182 Irssi::signal_add('setup reread', \&sig_setup_changed);
183 sig_setup_changed();
184
185 my $changed_since_last_save = 0;
186
187 my @window_thresholds;
188 my @channel_thresholds;
189 my @query_thresholds;
190 my %THRESHOLDARRAYS = ('window' => \@window_thresholds,
191 'channel' => \@channel_thresholds,
192 'query' => \@query_thresholds
193 );
194
195 my %OWN_ACTIVITY = ();
196
197 ### HELPERS ####################################################################
198
199 use constant DEBUGEVENTFORMAT => "%7s %7.7s %-22.22s %d %s %d → %-7s (%-8s ← %s)";
200 sub say {
201 my ($msg, $level, $inwin) = @_;
202 $level = $level // MSGLEVEL_CLIENTCRAP;
203 if ($inwin) {
204 Irssi::active_win->print("ctrlact: $msg", $level);
205 }
206 else {
207 Irssi::print("ctrlact: $msg", $level);
208 }
209 }
210
211 sub debug {
212 return unless $debug;
213 my ($msg, $inwin) = @_;
214 $msg = $msg // "";
215 say("DEBUG: ".$msg, MSGLEVEL_CRAP + MSGLEVEL_NO_ACT, $inwin);
216 }
217
218 use Data::Dumper;
219 sub dumper {
220 debug(scalar Dumper(@_), 1);
221 }
222
223 sub info {
224 my ($msg, $inwin) = @_;
225 say($msg, MSGLEVEL_CLIENTCRAP, $inwin);
226 }
227
228 sub warning {
229 my ($msg, $inwin) = @_;
230 $msg = $msg // "";
231 say("WARNING: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
232 }
233
234 sub error {
235 my ($msg, $inwin) = @_;
236 $msg = $msg // "";
237 say("ERROR: ".$msg, MSGLEVEL_CLIENTERROR, $inwin);
238 }
239
240 sub match {
241 my ($pat, $text) = @_;
242 if ($pat =~ m/^(\W)(.+)\1$/) {
243 return ($pat, $text) if $text =~ /$2/i;
244 }
245 elsif ($pat =~ m/\*/) {
246 my $rpat = $pat =~ s/\*/.*/gr;
247 return ($pat, $text) if $text =~ /$rpat/
248 }
249 else {
250 return ($pat, $text) if lc($text) eq lc($pat);
251 }
252 return ();
253 }
254
255 sub to_data_level {
256 my ($kw) = @_;
257 my $ret = 0;
258 for my $i (0 .. $#DATALEVEL_KEYWORDS) {
259 if ($kw eq $DATALEVEL_KEYWORDS[$i]) {
260 $ret = $i + 1;
261 }
262 }
263 return $ret
264 }
265
266 sub is_data_level {
267 my ($dl) = @_;
268 return $dl =~ /^[1-4]$/;
269 }
270
271 sub from_data_level {
272 my ($dl) = @_;
273 if (is_data_level($dl)) {
274 return $DATALEVEL_KEYWORDS[$dl-1];
275 }
276 }
277
278 sub get_data_level {
279 my ($data) = @_;
280 if (is_data_level($data)) {
281 return $data;
282 }
283 elsif((my $dl = to_data_level($data)) > 0) {
284 return $dl;
285 }
286 else {
287 error("Invalid data level: $data");
288 }
289 }
290
291 sub walk_match_array {
292 my ($name, $net, $type, $arr) = @_;
293 foreach my $rule (@{$arr}) {
294 my ($netpat, $net) = match($rule->[0], $net);
295 my ($namepat, $name) = match($rule->[1], $name);
296 next unless $netpat and $namepat;
297
298 my $own = $OWN_ACTIVITY{($net, $name)} // 0;
299 my $time = time();
300 my $span = ($rule->[3] eq '∞') ? 0 : $rule->[3];
301 my $remaining = $own + $span - $time;
302
303 if ($span > 0 and $remaining <= 0) {
304 delete $OWN_ACTIVITY{($net, $name)};
305 next;
306 }
307
308 my $result = to_data_level($rule->[2]);
309 my $tresult = from_data_level($result);
310 $name = '(unnamed)' unless length $name;
311 my $match = sprintf('%s = net:%s name:%s span:%s',
312 $rule->[4], $netpat, $namepat,
313 ($remaining < 0) ? $rule->[3] : $remaining.'s remain');
314 return ($result, $tresult, $match);
315 }
316 return -1;
317 }
318
319 sub get_mappings_table {
320 my ($arr, $fallback) = @_;
321 my @ret = ();
322 while (my ($i, $elem) = each @{$arr}) {
323 push @ret, sprintf("%7d: %-16s %-32s %-9s %-5s (%s)",
324 $i, @{$elem});
325 }
326 push @ret, sprintf("%7s: %-16s %-32s %-9s %-5s (%s)",
327 'last', '*', '*', from_data_level($fallback), '∞', 'default');
328 return join("\n", @ret);
329 }
330
331 sub get_specific_threshold {
332 my ($type, $name, $net) = @_;
333 $type = lc($type);
334 if (exists $THRESHOLDARRAYS{$type}) {
335 return walk_match_array($name, $net, $type, $THRESHOLDARRAYS{$type});
336 }
337 else {
338 croak "ctrlact: can't look up threshold for type: $type";
339 }
340 }
341
342 sub get_item_threshold {
343 my ($type, $name, $net) = @_;
344 my ($ret, $tret, $match) = get_specific_threshold($type, $name, $net);
345 return ($ret, $tret, $match) if $ret > 0;
346 if ($type eq 'CHANNEL') {
347 return ($fallback_channel_threshold, from_data_level($fallback_channel_threshold), '[default]');
348 }
349 else {
350 return ($fallback_query_threshold, from_data_level($fallback_query_threshold), '[default]');
351 }
352 }
353
354 sub get_win_threshold {
355 my ($name, $net) = @_;
356 my ($ret, $tret, $match) = get_specific_threshold('window', $name, $net);
357 if ($ret > 0) {
358 return ($ret, $tret, $match);
359 }
360 else {
361 return ($fallback_window_threshold, from_data_level($fallback_window_threshold), '[default]');
362 }
363 }
364
365 sub set_threshold {
366 my ($arr, $chatnet, $name, $level, $pos, $span) = @_;
367
368 if ($level =~ /^[1-4]$/) {
369 $level = from_data_level($level);
370 }
371 elsif (!to_data_level($level)) {
372 error("Not a valid activity level: $level", 1);
373 return -1;
374 }
375
376 my $found = 0;
377 my $index = 0;
378 for (; $index < scalar @{$arr}; ++$index) {
379 my $item = $arr->[$index];
380 if ($item->[0] eq $chatnet and $item->[1] eq $name) {
381 $found = 1;
382 last;
383 }
384 }
385
386 if ($found) {
387 splice @{$arr}, $index, 1;
388 $pos = $index unless defined $pos;
389 }
390
391 splice @{$arr}, $pos // 0, 0, [$chatnet, $name, $level, $span, 'manual'];
392 $changed_since_last_save = 1;
393 return $found;
394 }
395
396 sub unset_threshold {
397 my ($arr, $chatnet, $name, $pos) = @_;
398 my $found = 0;
399 if (defined $pos) {
400 if ($pos > $#{$arr}) {
401 warning("There exists no rule \@$pos");
402 }
403 else {
404 splice @{$arr}, $pos, 1;
405 $found = 1;
406 }
407 }
408 else {
409 for (my $i = scalar @{$arr} - 1; $i >= 0; --$i) {
410 my $item = $arr->[$i];
411 if ($item->[0] eq $chatnet and $item->[1] eq $name) {
412 splice @{$arr}, $i, 1;
413 $found = 1;
414 }
415 }
416 if (!$found) {
417 warning("No matching rule found for deletion");
418 }
419 }
420 $changed_since_last_save = $found;
421 return $found;
422 }
423
424 sub print_levels_for_all {
425 my ($type, @arr) = @_;
426 info(uc("$type mappings:"));
427 for my $i (@arr) {
428 my $name = $i->{'name'};
429 my $net = $i->{'server'}->{'tag'} // '';
430 my ($c, $t, $tt, $match);
431 if ($type eq 'window') {
432 ($t, $tt, $match) = get_win_threshold($name, $net);
433 $c = $i->{'refnum'};
434 }
435 else {
436 ($t, $tt, $match) = get_item_threshold($type, $name, $net);
437 $c = $i->window()->{'refnum'};
438 }
439 info(sprintf("%4d: %-40.40s → %d (%-8s) match %s", $c, $name, $t, $tt, $match));
440 }
441 }
442
443 sub parse_args {
444 # type: -window -channel -query
445 # tag: -*
446 # span: +\d
447 # position: @\d
448 # anything else: item
449 my ($data) = @_;
450 my @args = shellwords($data);
451 my ($type, $tag, $pos, $span);
452 my @rest = ();
453 my $max = 0;
454
455 foreach my $arg (@args) {
456 if ($arg =~ m/^-(windows?|channels?|quer(?:ys?|ies))/) {
457 if ($type) {
458 error("Can't specify $arg after -$type", 1);
459 return 1;
460 }
461 my $m = $1;
462 $type = 'window' if $m =~ m/^w/;
463 $type = 'channel' if $m =~ m/^c/;
464 $type = 'query' if $m =~ m/^q/;
465 }
466 elsif ($arg =~ m/^-(\S+)/) {
467 if ($tag) {
468 error("Tag -$tag already specified, cannot accept $arg", 1);
469 return 1;
470 }
471 $tag = $1;
472 }
473 elsif ($arg =~ m/^@([0-9]+)/) {
474 if ($pos) {
475 error("Position $pos already given, cannot accept $arg", 1);
476 return 1;
477 }
478 $pos = $1;
479 }
480 elsif ($arg =~ m/^\+([0-9]+)/) {
481 if ($span) {
482 error("Span $span already given, cannot accept $arg", 1);
483 return 1;
484 }
485 $span = $1;
486 }
487 else {
488 push @rest, $arg;
489 $max = length $arg if length $arg > $max;
490 }
491 }
492
493 my %args = (
494 type => $type,
495 tag => $tag,
496 pos => $pos,
497 span => $span,
498 rest => \@rest,
499 max => $max
500 );
501 return \%args;
502 }
503
504 ### HILIGHT SIGNAL HANDLERS ####################################################
505
506 my $_inhibit_beep = 0;
507 my $_inhibit_window = 0;
508
509 sub maybe_inhibit_witem_hilight {
510 my ($witem, $oldlevel) = @_;
511 return unless $witem;
512 $oldlevel = 0 unless $oldlevel;
513 my $newlevel = $witem->{'data_level'};
514 return if ($newlevel <= $oldlevel);
515
516 $_inhibit_window = 0;
517 $_inhibit_beep = 0;
518 my $witype = $witem->{'type'};
519 my $winame = $witem->{'name'};
520 my $witag = $witem->{'server'}->{'tag'} // '';
521 my ($th, $tth, $match) = get_item_threshold($witype, $winame, $witag);
522 my $inhibit = $newlevel > 0 && $newlevel < $th;
523 debug(sprintf(DEBUGEVENTFORMAT, lc($witype), $witag, $winame, $newlevel,
524 $inhibit ? ('<',$th,'inhibit'):('≥',$th,'pass'),
525 $tth, $match));
526 if ($inhibit) {
527 Irssi::signal_stop();
528 # the rhval comes from config, so if the user doesn't want the
529 # bell inhibited, this is effectively a noop.
530 $_inhibit_beep = $inhibit_beep;
531 $_inhibit_window = $witem->window();
532 }
533 }
534 Irssi::signal_add_first('window item hilight', \&maybe_inhibit_witem_hilight);
535
536 sub inhibit_win_hilight {
537 my ($win) = @_;
538 Irssi::signal_stop();
539 Irssi::signal_emit('window dehilight', $win);
540 }
541
542 sub maybe_inhibit_win_hilight {
543 my ($win, $oldlevel) = @_;
544 return unless $win;
545 if ($_inhibit_window && $win->{'refnum'} == $_inhibit_window->{'refnum'}) {
546 inhibit_win_hilight($win);
547 }
548 else {
549 $oldlevel = 0 unless $oldlevel;
550 my $newlevel = $win->{'data_level'};
551 return if ($newlevel <= $oldlevel);
552
553 my $wname = $win->{'name'};
554 my $wtag = $win->{'server'}->{'tag'} // '';
555 my ($th, $tth, $match) = get_win_threshold($wname, $wtag);
556 my $inhibit = $newlevel > 0 && $newlevel < $th;
557 debug(sprintf(DEBUGEVENTFORMAT, 'window', $wtag,
558 $wname?$wname:"$win->{'refnum'}(unnamed)", $newlevel,
559 $inhibit ? ('<',$th,'inhibit'):('≥',$th,'pass'),
560 $tth, $match));
561 inhibit_win_hilight($win) if $inhibit;
562 }
563 }
564 Irssi::signal_add_first('window hilight', \&maybe_inhibit_win_hilight);
565
566 sub maybe_inhibit_beep {
567 Irssi::signal_stop() if $_inhibit_beep;
568 }
569 Irssi::signal_add_first('beep', \&maybe_inhibit_beep);
570
571 ###
572
573 sub record_own_message {
574 my ($server, $msg, $target) = @_;
575 $OWN_ACTIVITY{($server->{chatnet}, $target)} = time();
576 }
577 for my $i ('public', 'private') {
578 Irssi::signal_add("message own_$i", \&record_own_message);
579 }
580
581 ### SAVING AND LOADING #########################################################
582
583 sub get_mappings_fh {
584 my ($filename) = @_;
585 my $fh;
586 if (! -e $filename) {
587 save_mappings($filename);
588 info("Created new/empty mappings file: $filename");
589 }
590 open($fh, '<', $filename) || croak "Cannot open mappings file: $!";
591 return $fh;
592 }
593
594 sub load_mappings {
595 my ($filename) = @_;
596 @window_thresholds = @channel_thresholds = @query_thresholds = ();
597 my $fh = get_mappings_fh($filename);
598 my $firstline = <$fh> || croak "Cannot read from $filename.";;
599 my $version;
600 if ($firstline =~ m/^#+\s+ctrlact mappings file \(version: *([\d.]+)\)/) {
601 $version = version->parse($1);
602 }
603 else {
604 croak "First line of $filename is not a ctrlact header.";
605 }
606
607 my $nrcols = 5;
608 if ($version <= version->parse('1.0')) {
609 $nrcols = 3;
610 }
611 elsif ($version <= version->parse('1.3')) {
612 $nrcols = 4;
613 }
614 my $l = 1;
615 my $cnt = 0;
616 while (<$fh>) {
617 $l++;
618 next if m/^\s*(?:#|$)/;
619 my ($type, @matchers) = split;
620 if (scalar @matchers >= $nrcols) {
621 error("Cannot parse $filename:$l: $_");
622 return;
623 }
624 @matchers = ['*', @matchers] if $version <= version->parse('1.0');
625
626 if (scalar @matchers == $nrcols - 2) {
627 push @matchers, '∞';
628 }
629
630 push @matchers, sprintf('line %2d', $l);
631
632 if (exists $THRESHOLDARRAYS{$type}) {
633 push @{$THRESHOLDARRAYS{$type}}, [@matchers];
634 $cnt += 1;
635 }
636 }
637 close($fh) || croak "Cannot close mappings file: $!";
638 return $cnt;
639 }
640
641 sub save_mappings {
642 my ($filename) = @_;
643 open(FH, '+>', $filename) || croak "Cannot create mappings file: $!";
644
645 my $ftw = from_data_level($fallback_window_threshold);
646 my $ftc = from_data_level($fallback_channel_threshold);
647 my $ftq = from_data_level($fallback_query_threshold);
648 print FH <<"EOF";
649 # ctrlact mappings file (version: $_VERSION)
650 #
651 # WARNING: this file will be overwritten on /save,
652 # use "/set ctrlact_autosave off" to avoid.
653 #
654 # type: window, channel, query
655 # server: the server tag (chatnet)
656 # name: full name to match, /regexp/, or * (for all)
657 # min.level: none, messages, hilights, all, or 1,2,3,4
658 # span: "attention span", how many seconds after your own
659 # last message should this rule apply
660 #
661 # type server name min.level span
662
663 EOF
664 foreach my $type (sort keys %THRESHOLDARRAYS) {
665 foreach my $arr (@{$THRESHOLDARRAYS{$type}}) {
666 print FH "$type\t";
667 print FH join "\t", @{$arr}[0..2];
668 print FH "\t" . @{$arr}[3] if @{$arr}[3] ne '∞';
669 print FH "\n";
670 }
671 }
672 print FH <<"EOF";
673
674 # EXAMPLES
675 #
676 ### only indicate activity in the status window if messages were displayed:
677 # window * (status) messages
678 #
679 ### never ever indicate activity for any item bound to this window:
680 # window * oubliette none
681 #
682 ### indicate activity on all messages in debian-related channels on OFTC:
683 # channel oftc /^#debian/ messages
684 #
685 ### display any text (incl. joins etc.) for the '#madduck' channel:
686 # channel * #madduck all
687 #
688 ### display messages in channels in which we were recently (3600s) active:
689 # channel * * messages 3600
690 #
691 ### otherwise ignore everything in channels, unless a hilight is triggered:
692 # channel * * hilights
693 #
694 ### make somebot only get your attention if they hilight you:
695 # query efnet somebot hilights
696 #
697 ### otherwise we want to see everything in queries:
698 # query * * all
699
700 # DEFAULTS:
701 # window * * $ftw
702 # channel * * $ftc
703 # query * * $ftq
704
705 # vim:noet:tw=0:ts=16
706 EOF
707 close FH;
708 }
709
710 sub cmd_load {
711 my $cnt = load_mappings($map_file);
712 if (!$cnt) {
713 @window_thresholds = @channel_thresholds = @query_thresholds = ();
714 }
715 else {
716 info("Loaded $cnt mappings from $map_file");
717 $changed_since_last_save = 0;
718 }
719 }
720
721 sub cmd_save {
722 my ($args) = @_;
723 if (!$changed_since_last_save and $args ne '-force') {
724 info("Not saving unchanged mappings without -force");
725 return;
726 }
727 autosave(1);
728 }
729
730 ### OTHER COMMANDS #############################################################
731
732 sub cmd_add {
733 my ($data, $server, $witem) = @_;
734 my $args = parse_args($data);
735 my $type = $args->{type} // 'channel';
736 my $tag = $args->{tag} // '*';
737 my $pos = $args->{pos};
738 my $span = $args->{span} // '∞';
739 my ($name, $level);
740
741 for my $item (@{$args->{rest}}) {
742 if (!$name) {
743 $name = $item;
744 }
745 elsif (!$level) {
746 $level = $item;
747 }
748 else {
749 error("Unexpected argument: $item");
750 return;
751 }
752 }
753
754 if (!$name) {
755 error("Must specify at least a level");
756 return;
757 }
758 elsif (!length $level) {
759 if ($witem) {
760 $level = $name;
761 $name = $witem->{name};
762 $tag = $server->{chatnet} unless $tag;
763 }
764 else {
765 error("No name specified, and no active window item");
766 return;
767 }
768 }
769
770 my $res = set_threshold($THRESHOLDARRAYS{$type}, $tag, $name, $level, $pos, $span);
771 if ($res > 0) {
772 info("Existing rule replaced.");
773 }
774 elsif ($res == 0) {
775 info("Rule added.");
776 }
777 }
778
779 sub cmd_remove {
780 my ($data, $server, $witem) = @_;
781 my $args = parse_args($data);
782 my $type = $args->{type} // 'channel';
783 my $tag = $args->{tag} // '*';
784 my $pos = $args->{pos};
785 my $name;
786
787 for my $item (@{$args->{rest}}) {
788 if (!$name) {
789 $name = $item;
790 }
791 else {
792 error("Unexpected argument: $item");
793 return;
794 }
795 }
796 if (!defined $pos) {
797 if (!$name) {
798 if ($witem) {
799 $name = $witem->{name};
800 $tag = $server->{chatnet} unless $tag;
801 }
802 else {
803 error("No name specified, and no active window item");
804 return;
805 }
806 }
807 }
808
809 if (unset_threshold($THRESHOLDARRAYS{$type}, $tag, $name, $pos)) {
810 info("Rule removed.");
811 }
812 }
813
814 sub cmd_snoop {
815 my ($data, $server, $witem) = @_;
816 my $args = parse_args($data);
817 my $type = $args->{type} // 'channel';
818 my $tag = $args->{tag};
819 my $name;
820
821 for my $item (@{$args->{rest}}) {
822 if (!$name) {
823 $name = $item;
824 }
825 else {
826 error("Unexpected argument: $item");
827 return;
828 }
829 }
830
831 if (!$name) {
832 if ($witem) {
833 $name = $witem->{name};
834 $tag = $server->{chatnet} unless $tag;
835 }
836 else {
837 error("No name specified, and no active window item");
838 return;
839 }
840 }
841
842 $OWN_ACTIVITY{($tag, $name)} = time();
843 info("Snooping in on $tag/$name", 1);
844 }
845
846 sub cmd_sleep {
847 my ($data, $server, $witem) = @_;
848 my $args = parse_args($data);
849 my $type = $args->{type} // 'channel';
850 my $tag = $args->{tag};
851 my $name;
852
853 for my $item (@{$args->{rest}}) {
854 if (!$name) {
855 $name = $item;
856 }
857 else {
858 error("Unexpected argument: $item");
859 return;
860 }
861 }
862
863 if (!$name) {
864 if ($witem) {
865 $name = $witem->{name};
866 $tag = $server->{chatnet} unless $tag;
867 }
868 else {
869 error("No name specified, and no active window item");
870 return;
871 }
872 }
873
874 my $was = $OWN_ACTIVITY{($tag, $name)};
875 delete $OWN_ACTIVITY{($tag, $name)};
876 if ($was) {
877 $was = time() - $was;
878 info("Back to sleep on $tag/$name (after $was seconds)", 1);
879 }
880 }
881
882 sub cmd_list {
883 info("WINDOW MAPPINGS\n" . get_mappings_table(\@window_thresholds, $fallback_window_threshold));
884 info("CHANNEL MAPPINGS\n" . get_mappings_table(\@channel_thresholds, $fallback_channel_threshold));
885 info("QUERY MAPPINGS\n" . get_mappings_table(\@query_thresholds, $fallback_query_threshold));
886 }
887
888 sub cmd_query {
889 my ($data, $server, $witem) = @_;
890 my $args = parse_args($data);
891 my $type = $args->{type} // 'channel';
892 my $tag = $args->{tag} // '*';
893 my $max = $args->{max};
894 my @words = @{$args->{rest}};
895
896 if (!@words) {
897 if ($witem) {
898 push @words, $witem->{name};
899 $tag = $server->{chatnet} unless $tag ne '*';
900 }
901 else {
902 error("No name specified, and no active window item");
903 return;
904 }
905 }
906
907 foreach my $name (@words) {
908 my ($t, $tt, $match) = get_specific_threshold($type, $name, $tag);
909 info(sprintf("%7s: %7s %-22s → %-8s match: %s", $type, $tag, $name, $tt, $match), 1);
910 }
911 }
912
913 sub cmd_show {
914 my ($data, $server, $item) = @_;
915 my $args = parse_args($data);
916 my $type = $args->{type} // 'all';
917
918 if ($type eq 'channel' or $type eq 'all') {
919 print_levels_for_all('channel', Irssi::channels());
920 }
921 if ($type eq 'query' or $type eq 'all') {
922 print_levels_for_all('query', Irssi::queries());
923 }
924 if ($type eq 'window' or $type eq 'all') {
925 print_levels_for_all('window', Irssi::windows());
926 }
927 }
928
929 sub autosave {
930 my ($force) = @_;
931 return unless $force or $changed_since_last_save;
932 if (!$autosave) {
933 info("Not saving mappings due to ctrlact_autosave setting");
934 return;
935 }
936 info("Saving mappings to $map_file");
937 save_mappings($map_file);
938 $changed_since_last_save = 0;
939 }
940
941 sub UNLOAD {
942 autosave();
943 }
944
945 sub cmd_help {
946 my ($data, $server, $item) = @_;
947 Irssi::print (<<"SCRIPTHELP_EOF", MSGLEVEL_CLIENTCRAP);
948 %_ctrlact $_VERSION - fine-grained control of activity indication%_
949
950 %U%_Synopsis%_%U
951
952 %_CTRLACT ADD%_ [<%Umatchspec%U>] [@<%Uposition%U>] [+<%Uspan%U>] <%Ulevel%U>
953 %_CTRLACT REMOVE%_ [<%Umatchspec%U>] [@<%Uposition%U>]
954 %_CTRLACT QUERY%_ [<%Umatchspec%U>]
955 %_CTRLACT SNOOP%_ [<%Umatchspec%U>]
956 %_CTRLACT SLEEP%_ [<%Umatchspec%U>]
957 %_CTRLACT LIST%_
958 %_CTRLACT SHOW%_ [<%Utype%U>]
959 %_CTRLACT SAVE%_ [-force]
960 %_CTRLACT [RE]LOAD%_
961 %_CTRLACT HELP%_
962
963 <%Umatchspec%U> %| [-<%Utype%U>] [-<%Utag%U>] <%Uname%U>
964 %U%U %| (defaults to current window item, if available)
965 <%Utype%U> %| "window"|"channel"|"query"
966 %U%U %| (default: "channel")
967 <%Utag%U> %| The chat network's tag, e.g. oftc
968 <%Uname%U> %| Name of the channel, query, or window
969 %U%U %| May include '*', or be a regular expression: /.../
970 <%Ulevel%U> %| Minimum activity level to match:
971 %U%U %| 1, all, 2, messages, 3, highlights, 4, none
972 <%Uposition%U> %| Integer index where to insert new rule, or of rule to remove
973 <%Uspan%U> %| Time in seconds during which this rule applies following own engagement
974
975 %U%_Settings%_%U
976
977 /set %_ctrlact_map_file%_ [$map_file]
978 %| Controls where the activity control map will be read from (and saved to)
979
980 /set %_ctrlact_fallback_channel_threshold%_ [$fallback_channel_threshold]
981 /set %_ctrlact_fallback_query_threshold%_ [$fallback_query_threshold]
982 /set %_ctrlact_fallback_window_threshold%_ [$fallback_window_threshold]
983 %| Controls the lowest data level that will trigger activity for channels,
984 %| queries, and windows respectively, if no applicable mapping could be
985 %| found. Valid values are 1, all, 2, messages, 3, highlights, 4, none.
986
987 /set %_ctrlact_inhibit_beep%_ [$inhibit_beep]
988 %| If an activity wouldn't be indicated, also inhibit the beep/bell. Turn
989 %| this off if you want the bell anyway.
990
991 /set %_ctrlact_autosave%_ [$autosave]
992 %| Unless this is disabled, the rules will be written out to the map file
993 %| (and overwriting it) on /save and /ctrlact save.
994
995 /set %_ctrlact_debug%_ [$debug]
996 %| Turns on debug output. Not that this may itself be buggy, so please don't
997 %| use it unless you really need it.
998
999 %U%_Examples%_%U
1000
1001 Set channel default level to hilights only:
1002 %|%#/SET %_ctrlact_fallback_channel_threshold%_ hilights
1003
1004 Show activity for messages in the #irssi channel on LiberaChat:
1005 %|%#/%_CTRLACT ADD%_ -LiberaChat #irssi messages
1006
1007 Show all activity for messages on my company's channels:
1008 %|%#/%_CTRLACT ADD%_ -channel #myco-* all
1009
1010 Create a rule for the current window item:
1011 %|%#/%_CTRLACT ADD%_ all
1012
1013 Insert a rule at position 3 (default is to insert at the top):
1014 %|%#/%_CTRLACT ADD%_ @3 #mutt messages
1015
1016 List all mappings:
1017 %|%#/%_CTRLACT LIST%_
1018
1019 Remove mapping at position 3:
1020 %|%#/%_CTRLACT REMOVE%_ @3
1021
1022 Remove mapping for current window item:
1023 %|%#/%_CTRLACT REMOVE%_
1024
1025 Remove mapping for #irssi channel (see above)
1026 %|%#/%_CTRLACT REMOVE%_ -LiberaChat #irssi
1027
1028 Save mappings to file ($map_file), using -force to write even if nothing has changed:
1029 %|%#/%_CTRLACT SAVE%_ -force
1030
1031 Load mappings from file ($map_file):
1032 %|%#/%_CTRLACT LOAD%_
1033
1034 Create a rule to show activity on any channel in which we've engaged in the last hour:
1035 %|%#/%_CTRLACT ADD%_ +3600 -* * messages
1036
1037 Pretend that we interacted with the #perl channel, so as to get activity as per the last rule:
1038 %|%#/%_CTRLACT SNOOP%_ #perl
1039
1040 Stop activity indication for the current channel after we engaged with it:
1041 %|%#/%_CTRLACT SLEEP%_
1042
1043 Query which rule would apply to the current channel:
1044 %|%#/%_CTRLACT QUERY%_
1045
1046 Show the matching rule for every query:
1047 %|%#/%_CTRLACT SHOW%_ -query
1048 SCRIPTHELP_EOF
1049 }
1050
1051 Irssi::signal_add('setup saved', \&autosave);
1052 Irssi::signal_add('setup reread', \&cmd_load);
1053
1054 Irssi::command_bind('ctrlact help',\&cmd_help);
1055 Irssi::command_bind('ctrlact reload',\&cmd_load);
1056 Irssi::command_bind('ctrlact load',\&cmd_load);
1057 Irssi::command_bind('ctrlact save',\&cmd_save);
1058 Irssi::command_bind('ctrlact add',\&cmd_add);
1059 Irssi::command_bind('ctrlact remove',\&cmd_remove);
1060 Irssi::command_bind('ctrlact snoop',\&cmd_snoop);
1061 Irssi::command_bind('ctrlact sleep',\&cmd_sleep);
1062 Irssi::command_bind('ctrlact list',\&cmd_list);
1063 Irssi::command_bind('ctrlact query',\&cmd_query);
1064 Irssi::command_bind('ctrlact show',\&cmd_show);
1065
1066 Irssi::command_bind('ctrlact' => sub {
1067 my ($data, $server, $item) = @_;
1068 $data =~ s/\s+$//g;
1069 if ($data) {
1070 Irssi::command_runsub('ctrlact', $data, $server, $item);
1071 }
1072 else {
1073 cmd_help();
1074 }
1075 }
1076 );
1077 Irssi::command_bind('help', sub {
1078 my ($data, $server, $item) = @_;
1079 my @words = split /\s+/, $data;
1080 return unless shift @words eq 'ctrlact';
1081 cmd_help();
1082 Irssi::signal_stop();
1083 }
1084 );
1085
1086 cmd_load();
+11
-14
scripts/dccmove.pl less more
0 #! /usr/bin/perl
10 #
2 # $Id: dccmove.pl,v 1.4 2007/04/17 21:32:30 peder Exp $
3 #
4 # Copyright (C) 2003 by Peder Stray <peder@ninja.no>
1 # Copyright (C) 2003-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
85 use Irssi;
96 use vars qw{$VERSION %IRSSI};
10 ($VERSION) = '$Revision: 1.4 $' =~ / (\d+\.\d+) /;
7 ($VERSION) = '$Revision: 1.4.1 $' =~ / (\d+(\.\d+)+) /;
118 %IRSSI = (
12 name => 'dccmove',
13 authors => 'Peder Stray',
14 contact => 'peder@ninja.no',
15 url => 'http://ninja.no/irssi/dccmove.pl',
16 license => 'GPL',
17 description => 'Move completed dcc gets to the subfolder done',
18 );
9 name => 'dccmove',
10 authors => 'Peder Stray',
11 contact => 'peder.stray@gmail.com',
12 url => 'https://github.com/pstray/irssi-dccmove',
13 license => 'GPL',
14 description => 'Move completed dcc gets to the subfolder done',
15 );
1916
2017 sub sig_dcc_closed {
2118 my($dcc) = @_;
2825 $dir .= "/done";
2926
3027 if ($dcc->{transfd} < $dcc->{size}) {
31 printf('%%gDCC aborted %%_%s%%_, %%R%d%%%%%%g remaining%%n',
28 printf('%%gDCC aborted %%_%s%%_, %%R%d%%%%%%g remaining%%n',
3229 $file,
3330 $dcc->{size} ? 100 - $dcc->{transfd}/$dcc->{size}*100 : 0,
3431 );
3936 rename $dcc->{file}, "$dir/$file";
4037
4138 printf('%%gDCC moved %%_%s%%_ to %%_%s%%_%%n', $file, $dir);
42
39
4340 }
4441
4542 Irssi::signal_add_last('dcc closed', 'sig_dcc_closed');
+45
-0
scripts/discord_unbridge.pl less more
0 use strict;
1 use warnings;
2 use Irssi;
3
4 our $VERSION = '1.6';
5 our %IRSSI = (
6 authors => 'Idiomdrottning',
7 contact => 'sandra.snan@idiomdrottning.org',
8 name => 'discord_unbridge.pl',
9 description => 'In channels with a discord bridge, turns "<bridge> <Sender> Message" into "<Sender> Message", and hides spoilers.',
10 license => 'Public Domain',
11 url => 'https://idiomdrottning.org/discord_unbridge.pl',
12 );
13
14 # HOWTO:
15 #
16 # set $bridgename to your bot's name, default is Yoda50.
17 #
18 # Regardless, to use the script just
19 # /load discord_unbridge.pl
20 #
21 # NOTE:
22 #
23 # git clone https://idiomdrottning.org/discord_unbridge.pl
24 # for version history and to send patches.
25 #
26 # Based on discord_unhilight by Christoffer Holmberg, in turn
27 # based on slack_strip_auto_cc.pl by Ævar Arnfjörð Bjarmason.
28
29 my $bridgename = "Yoda50";
30
31 sub msg_bot_clean {
32 my ($server, $data, $nick, $nick_and_address) = @_;
33 my ($target, $message) = split /:/, $data, 2;
34 my ($name, $text) = $message =~ /< *([^>]*)> (.*)/s;
35 if ($text && $nick eq $bridgename) {
36 $nick = $name;
37 $message = $text;
38 }
39 $message =~ s/\|\|([^|]+)\|\|/1,1$1/g;
40 my $new_data = "$target:$message";
41 Irssi::signal_continue($server, $new_data, $nick, $nick_and_address);
42 }
43
44 Irssi::signal_add('event privmsg', 'msg_bot_clean');
+256
-0
scripts/duckduckgo.pl less more
0 # duckduckgo.pl is free software: you can redistribute it and/or modify
1 # it under the terms of the GNU Lesser General Public License as published by
2 # the Free Software Foundation, either version 3 of the License.
3 #
4 # This program is distributed in the hope that it will be useful,
5 # but WITHOUT ANY WARRANTY; without even the implied warranty of
6 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
7 # GNU Lesser General Public License for more details.
8 #
9 # You should have received a copy of the GNU General Public License
10 # along with this program. If not, see <https://www.gnu.org/licenses/>.
11
12 use strict;
13 use POSIX;
14 use vars qw($VERSION %IRSSI);
15
16 use Irssi;
17 use LWP::UserAgent;
18 use HTML::Entities;
19 use URI::Escape;
20
21 $VERSION = '0.03';
22 %IRSSI = (
23 authors => 'bw1',
24 contact => 'bw1@aol.at',
25 name => 'duckduckgo',
26 description => 'search by https://duckduckgo.com/html/',
27 license => 'lgplv3',
28 url => 'http://scripts.irssi.org',
29 changed => '2021-10-09',
30 selfcheckcmd=> 'ddg -check',
31 );
32
33 my $url="https://duckduckgo.com/html?q={}";
34 #my $url="https://duckduckgo.com/html?q=irssi";
35 my $view_count=5;
36 my $browser="firefox '{}'";
37
38 my @res;
39 my $res_next;
40
41 # fork
42 my $read_handle;
43 my $write_handle;
44 my $forkcount=0;
45 my $pipe_tag;
46
47 sub www_get {
48 (my $url) =@_;
49 # Initialize LWP
50 my $ua = new LWP::UserAgent;
51 $ua->agent("duckduckgo.pl/0.1 " . $ua->agent);
52 # get
53 my $req = new HTTP::Request GET =>$url;
54 my $res = $ua->request($req);
55 return $res->content;
56 }
57
58 sub content2res {
59 (my $content) = @_;
60 my @content =split /\n/,$content;
61 my @res;
62 my $index=1;
63 foreach (@content) {
64 if ($_ =~ m/class="result__a"/) {
65 my %r;
66 $r{index}=$index;
67 # url
68 $_ =~ m/href="(.*?)"/;
69 $1 =~ m/uddg=(.*)&amp/;
70 my $u=uri_unescape($1);
71 $r{url}=$u;
72 # txt
73 $_ =~ m#">(.*?)</a>#;
74 my $s =$1;
75 $r{txt_raw}=$s;
76 $s=~s/<b>/%U/g;
77 $s=~s#</b>#%U#g;
78 $r{txt}=$s;
79 # out
80 push @res,{%r};
81 $index++;
82 }
83 }
84 return @res;
85 }
86
87 sub backgroundf {
88 (my $url, my $write_handle) =@_;
89 print "child start";
90 my $res = www_get($url);
91 print "child fertig";
92 print $write_handle $res;
93 print $write_handle "\n";
94 close $write_handle;
95 }
96
97 sub view_results {
98 my ($start) =@_;
99 print "duckduckgo: results ";
100 for (my $c=$start; $c < $view_count+$start && $c <= $#res; $c ++) {
101 print $c,". ",$res[$c]->{txt};
102 if (length($res[$c]->{url}) <50) {
103 print " ",$res[$c]->{url};
104 } else {
105 print " ",substr($res[$c]->{url},0,20),"=>>";
106 }
107 }
108 }
109
110 sub sig_result {
111 print "sig_result";
112 my $r;
113 my $o_fh;
114 # input
115 $o_fh=select($read_handle);
116 local $/;
117 select($o_fh);
118 $r=readline($read_handle);
119 close($read_handle);
120 Irssi::input_remove($pipe_tag);
121 # filter
122 @res= content2res($r);
123 $res_next=0;
124 $forkcount--;
125 view_results($res_next);
126 }
127
128 sub sig_config {
129 $url = Irssi::settings_get_str('ddg_url');
130 $view_count = Irssi::settings_get_int('ddg_view_count');
131 }
132
133 sub cmd_ddg {
134 my ($args, $server, $witem) = @_;
135
136 my @alist =split / /,$args;
137 if ($alist[0] !~ m/^-/) {
138 cmd_searchf($args);
139 } else {
140 if ($alist[0] eq '-browser') {
141 cmd_browser($alist[1]);
142 } elsif ($alist[0] eq '-next') {
143 cmd_next();
144 } elsif ($alist[0] eq '-help') {
145 cmd_help('ddg');
146 } elsif ($alist[0] eq '-drop') {
147 cmd_drop($alist[1],$witem);
148 } elsif ($alist[0] eq '-check') {
149 @res=();
150 cmd_searchf("irssi");
151 Irssi::timeout_add_once(3000,\&self_check,'');
152 }
153 }
154 }
155
156 sub cmd_drop {
157 my ($args, $witem) =@_;
158 if ($witem) {
159 $witem->command("/say $res[$args*1]->{url}");
160 }
161 }
162
163 sub cmd_next {
164 $res_next+=$view_count;
165 view_results($res_next);
166 }
167
168 sub cmd_searchf {
169 my ($args) = @_;
170 my $url2=$url;
171 $args=~s/ /+/g;
172 $url2=~s/{}/$args/;
173 # fork
174 if ($forkcount==0) {
175 print "ddg:",$url2;
176 $forkcount++;
177 pipe($read_handle, $write_handle);
178 my $o_fh=select($write_handle);
179 local $|=1;
180 select($o_fh);
181 my $pid =fork();
182 if (not defined $pid) {
183 _error("Can't fork: Aborting");
184 close($read_handle);
185 close($write_handle);
186 return;
187 }
188 if ($pid == 0) {
189 # child
190 backgroundf($url2,$write_handle);
191 POSIX::_exit(1);
192 } else {
193 # parent
194 close ($write_handle);
195 Irssi::pidwait_add($pid);
196 $pipe_tag = Irssi::input_add(fileno($read_handle),
197 Irssi::INPUT_READ, \&sig_result, "");
198 }
199 }
200 }
201
202 sub cmd_browser {
203 my ($args) = @_;
204 my $b=$browser;
205 $b =~ s/{}/$res[$args*1]->{url}/;
206 system($b);
207 }
208
209 sub self_check {
210 my $s='ok';
211 Irssi::print("Result count: ".scalar(@res));
212 Irssi::print("Result url: ".$res[0]->{url});
213 Irssi::print("Result txt length: ".length($res[0]->{txt}));
214 if ( scalar ( @res ) <10 ) {
215 $s= "Error: result count (".scalar(@res).")";
216 } elsif ( $res[0]->{url} !~ m/^http.*\/$/ ) {
217 $s= "Error: url (".$res[0]->{url}.")";
218 } elsif ( length($res[0]->{txt}) < 5 ) {
219 $s= "Error: txt length (".length($res[0]->{txt}).")";
220 }
221 Irssi::print("Selfcheck $s");
222 my $schs = exists $Irssi::Script::{'selfcheckhelperscript::'};
223 Irssi::command("selfcheckhelperscript $s") if ( $schs );
224 }
225
226 sub cmd_help {
227 if ($_[0] eq 'ddg' || $_[0] eq 'duckduckgo') {
228
229 my $help = <<'END';
230 /ddg <keywords> search for the keywords
231 /ddg -next display the next results
232 /ddg -browser <num> give the url to firefox
233 /ddg -drop <num> drop the url in a channel
234 /ddg -check self check
235
236 settings:
237 ddg_view_count,
238 ddg_url, ddg_browser (placeholder {} )
239 END
240 Irssi::print($help, MSGLEVEL_CLIENTCRAP);
241 Irssi::signal_stop;
242 }
243 }
244
245 Irssi::settings_add_str("duckduckgo", "ddg_url", $url);
246 Irssi::settings_add_str("duckduckgo", "ddg_browser", $browser);
247 Irssi::settings_add_int("duckduckgo", "ddg_view_count", $view_count);
248
249 Irssi::signal_add('setup changed', "sig_config");
250
251 Irssi::command_bind('help',\&cmd_help);
252 Irssi::command_bind("ddg", \&cmd_ddg);
253 Irssi::command_set_options('ddg','help browser next drop');
254
255 sig_config();
+137
-0
scripts/elist.pl less more
0 #!/usr/bin/perl
1
2 # (c) 2007, Ilya Cassina <icassina@gmail.com>
3 #
4 # inspired by 'xlist.pl' by Matthäus 'JonnyBG' Wander <jbg@swznet.de>
5
6 # Usage: /elist [-min <usercount>] [-max <usercount] [#]<channelmask>
7
8
9 use strict;
10 use vars qw($VERSION %IRSSI);
11
12 use Irssi;
13 use Getopt::Long;
14
15 $VERSION = '1.2';
16 %IRSSI = (
17 authors => 'Ilya Cassina',
18 contact => 'icassina@gmail.com',
19 name => 'Enanched LIST',
20 description => 'This script allow advanced parametrization ' .
21 'of the /list command. Accepted parameters are ' .
22 '-minusers <#users> and -maxusers <#users>. ',
23 license => 'GPLv2',
24 );
25
26 use Irssi qw(
27 command_bind
28 signal_add
29 );
30
31 ### global variables ####
32 my %elist_channels = ();
33 my %elist_config = ();
34
35 ### settings
36 Irssi::settings_add_bool($IRSSI{'name'}, 'elist_colorized', 1);
37
38 sub elist_channels_free {
39 %elist_channels = ();
40 }
41
42 sub elist_config_init {
43 %elist_config = (
44 mincount => 0,
45 maxcount => 10000,
46 yes => "",
47 chanmask => ""
48 );
49 }
50
51 sub elist {
52 my ($data, $server, $witem) = @_;
53
54 ### init variables ###
55 elist_config_init();
56
57 #### processing arguments using Getopt ###
58 Getopt::Long::config('permute', 'no_ignore_case');
59
60 local(@ARGV) = split(/\s/, $data,);
61 GetOptions (
62 'mincount|m=i' => \$elist_config{"mincount"},
63 'maxcount|M=i' => \$elist_config{"maxcount"},
64 'yes|YES' => \$elist_config{"yes"}
65 );
66
67 ## setting chanmask (remaining argument) ##
68 if (@ARGV . length == 0) {
69 $elist_config{"chanmask"} = "";
70 } else {
71 # adding '#' character at the beginning if not already present! #
72 if ($ARGV[0] !~/^\#.*/) {
73 $elist_config{"chanmask"} = "\#". $ARGV[0];
74 } else {
75 $elist_config{"chanmask"} = $ARGV[0];
76 }
77 }
78
79 ### sending LIST command to the server ###
80 print "%K[%n".$server->{'tag'}."%K]%n %B<-->%n %m"."elist %n%B(%y"."min=%m".$elist_config{"mincount"}."%n".
81 ", %y"."max=%m".$elist_config{"maxcount"}."%n".
82 ", %y"."mask=%K'%m".$elist_config{"chanmask"}."%K'%B)";
83 $server->command("LIST " . ($elist_config{"yes"} ? "-YES " : "") . $elist_config{"chanmask"});
84 }
85
86
87 sub elist_collect {
88 my ($server, $data) = @_;
89
90 my (undef, $channel, $users, $topic) = split(/\s/, $data, 4);
91 $topic = substr($topic, 1);
92
93 if (!Irssi::settings_get_bool('elist_colorized')) {
94 # code below stolen from script: cleanpublic.pl by Jørgen Tjernø
95 $topic =~ s/\x03\d?\d?(,\d?\d?)?|\x02|\x1f|\x16|\x06|\x07//g;
96 }
97
98 if ($users >= $elist_config{"mincount"} and $users <= $elist_config{"maxcount"}) {
99 push @{$elist_channels{$users}}, [ $channel, $topic ];
100 }
101 }
102
103 sub elist_show {
104 my ($server) = @_;
105 my ($printstring, $channel);
106
107 ## keys of elist_channels are (int) users in channel ##
108 foreach (reverse sort { $a <=> $b } keys %elist_channels) {
109 my $user_count = $_;
110 ## values are arrays of [ channel_name, topic ] ##
111 foreach (@{$elist_channels{$user_count}}) {
112 $printstring = "%K[%n" . $server->{'tag'} . "%K]%n " .
113 sprintf("%4d", $user_count ) .
114 " " . @{$_}[0]; ## channel name
115 if (length @{$_}[1] > 0) {
116 $printstring .= " %B->%n " . @{$_}[1]; ## topic
117 }
118
119 print $printstring;
120 }
121 }
122
123 elist_channels_free();
124
125 print "%K[%n".$server->{'tag'}."%K]%n %B<-->%n End of %m"."elist%n";
126 }
127
128 command_bind('elist', \&elist);
129 signal_add('event 322', \&elist_collect);
130 signal_add('event 323', \&elist_show);
131
132
133 ##print "Usage: /elist [-min <usercount>] [-max <usercount] [#]<channelmask>"
134
135 # EOF #
136 # vim: set expandtab tabstop=2 shiftwidth=2:
+35
-6
scripts/fpaste.pl less more
55
66 use Irssi;
77
8 $VERSION = '0.01';
8 $VERSION = '0.02';
99 %IRSSI = (
1010 authors => 'bw1',
1111 contact => 'bw1@aol.at',
1313 description => 'copy infos to fpaste',
1414 license => 'Public Domain',
1515 url => 'https://scripts.irssi.org/',
16 changed => '2019-11-05',
16 changed => '2021-01-24',
1717 modules => 'HTTP::Tiny File::Glob',
1818 commands=> 'fpaste',
19 selfcheckcmd=> 'fpaste -check',
1920 );
2021
2122 my $help = << "END";
3132 -file paste the file to fpaste
3233 -command run the command and paste the result
3334 -sysinfo colletct system infos and load them up
35 -check self check
3436 %9See also%9
3537 http://fpaste.scsys.co.uk/irssi
3638 https://github.com/rcaputo/bot-pastebot
4042 '#irssi'=>1,
4143 '#curl'=>1,
4244 '#ledgersmb'=>1,
45 '#mojo'=>1,
4346 '#ospkg'=>1,
4447 '#perl'=>1,
45 '#perl6'=>1,
4648 '#r'=>1,
49 '#raku'=>1,
4750 );
4851
4952 my $host="http://fpaste.scsys.co.uk";
175178 return $info;
176179 }
177180
181 sub self_check {
182 my ( $res ) = @_;
183 my $s="ok";
184 if ( $res !~ m/^http/ ) {
185 $s= "Error: url ($res)";
186 }
187 Irssi::print("fpaste: selfcheck: $s");
188 my $schs_version = $Irssi::Script::selfcheckhelperscript::VERSION;
189 Irssi::command("selfcheckhelperscript $s") if ( defined $schs_version );
190 }
191
178192 sub cmd {
179193 my ($args, $server, $witem)=@_;
180194 my ($opt, $arg) = Irssi::command_parse_options($IRSSI{name}, $args);
181195 my $channel='(none)';
182 my ($nick, $result, $summary, $paste, $run);
183 $nick= Irssi::active_server()->{nick};
196 my ($nick, $result, $summary, $paste, $run, $check);
197 my $serv= Irssi::active_server();
198 if ( defined $serv ){
199 $nick= $server->{nick};
200 } else {
201 $nick= Irssi::settings_get_str('nick');
202 }
184203 if (defined $witem) {
185204 if ($witem->{type} eq 'CHANNEL') {
186205 if ( exists $fpaste_channels{$witem->{name}} ) {
208227 if (exists $opt->{summary}) {
209228 $summary=$opt->{summary};
210229 }
230 if (exists $opt->{check}) {
231 $summary='check';
232 $paste=sysinfo();
233 $run=1;
234 $check=1;
235 }
211236 if ( defined $run ) {
212237 $result= paste($channel, $nick, $summary, $paste);
238 if ( $check == 1 ) {
239 self_check($result);
240 $check=0;
241 }
213242 if (defined $witem) {
214243 $witem->print($result, MSGLEVEL_CLIENTCRAP);
215244 } else {
231260
232261 Irssi::command_bind($IRSSI{name}, \&cmd);
233262 Irssi::command_bind('help', \&cmd_help);
234 Irssi::command_set_options($IRSSI{name}, "+file +command sysinfo +summary help");
263 Irssi::command_set_options($IRSSI{name}, "+file +command sysinfo +summary help check");
+36
-126
scripts/friends_peder.pl less more
0 # friends - irssi 0.8.4.CVS
10 #
2 # $Id: friends.pl,v 1.34 2004/03/08 21:47:12 peder Exp $
3 #
4 # Copyright (C) 2001, 2002, 2003 by Peder Stray <peder@ninja.no>
1 # Copyright (C) 2001-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
96 use Irssi::Irc;
107 use Irssi::TextUI;
118
12 use Data::Dumper;
13 $Data::Dumper::Indent = 1;
14
15 # ======[ Script Header ]===============================================
16
179 use vars qw{$VERSION %IRSSI};
18 ($VERSION) = '$Revision: 1.34 $' =~ / (\d+\.\d+) /;
10 ($VERSION) = '$Revision: 1.34.1 $' =~ / (\d+(\.\d+)+) /;
1911 %IRSSI = (
20 name => 'friends',
21 authors => 'Peder Stray',
22 contact => 'peder@ninja.no',
23 url => 'http://ninja.no/irssi/friends.pl',
24 license => 'GPL',
25 description => 'Basicly an autoop script with a nice interface and nick coloring ;)',
26 );
27
28 # ======[ Variables ]===================================================
12 name => 'friends',
13 authors => 'Peder Stray',
14 contact => 'peder.stray@gmail.com',
15 url => 'https://github.com/pstray/irssi-friends',
16 license => 'GPL',
17 description => 'Basically an autoop script with a nice interface and nick coloring ;)',
18 );
2919
3020 my(%friends, @friends);
3121
3626 );
3727 my(%flaglong) = map { $flagshort{$_} => $_ } keys %flagshort;
3828
39 # ======[ Helper functions ]============================================
40
41 # --------[ crap ]------------------------------------------------------
42
4329 sub crap {
4430 my $template = shift;
4531 my $msg = sprintf $template, @_;
4632 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'friends_crap', $msg);
4733 }
48
49 # --------[ load_friends ]----------------------------------------------
5034
5135 sub load_friends {
5236 my($file) = Irssi::get_irssi_dir."/friends";
6650 }
6751 close FILE;
6852 $count = keys %friends;
69
53
7054 crap("Loaded $count friends from $file");
7155 }
72
73 # --------[ save_friends ]----------------------------------------------
7456
7557 sub save_friends {
7658 my($auto) = @_;
9779 unless $auto;
9880 }
9981
100 # --------[ is_friends_window ]-----------------------------------------
101
10282 sub is_friends_window {
10383 my($win) = @_;
10484 return $win->{name} eq '<Friends>';
10585 }
106
107 # --------[ get_friends_window ]----------------------------------------
10886
10987 sub get_friends_window {
11088 my($win) = Irssi::window_find_name('<Friends>');
11997 return $win;
12098 }
12199
122 # --------[ get_friend ]------------------------------------------------
123
124100 sub get_friend {
125101 my($channel,$nick) = @_;
126102 my($server) = $channel->{server};
127103 my($chan) = lc $channel->{name};
128104 my($net) = lc $server->{chatnet};
129105 my($flags,@friend);
130
106
131107 for my $mask (keys %friends) {
132 next unless $server->mask_match_address($mask,
108 next unless $server->mask_match_address($mask,
133109 $nick->{nick},
134110 $nick->{host});
135111 for my $n ('*', $net) {
146122 return undef;
147123 }
148124
149 # --------[ check_friends ]---------------------------------------------
150
151125 sub check_friends {
152126 my($channel, @nicks) = @_;
153127 my(%op,%voice);
154 my($nick,$friend,$list);
128 my($nick,$friend,$list);
155129 my(@friends);
156130
157131 return unless $channel->{chanop} || $channel->{ownnick}{op};
174148 my($max) = Irssi::settings_get_int("friends_max_nicks");
175149 @friends = sort @friends;
176150 $channel->printformat(MSGLEVEL_CLIENTCRAP,
177 @friends>$max
151 @friends>$max
178152 ? 'friends_check_more' : 'friends_check',
179153 join(" ", splice @friends, 0, $max),
180154 scalar @friends);
181155 }
182156
183157 if ($list = join " ", sort keys %op) {
184 $channel->command("op $list");
158 $channel->command("op $list");
185159 }
186160 if ($list = join " ", sort keys %voice) {
187 $channel->command("voice $list");
188 }
189 }
190
191 # --------[ update_friends_hash ]---------------------------------------
161 $channel->command("voice $list");
162 }
163 }
192164
193165 sub update_friends_hash {
194166 %friends = ();
200172 }
201173 }
202174
203 # --------[ update_friends_window ]-------------------------------------
204
205175 sub update_friends_window {
206176 my($win) = Irssi::window_find_name('<Friends>');
207177 my($view);
215185 for $mask (sort keys %friends) {
216186 for $net (sort keys %{$friends{$mask}}) {
217187 for $channel (sort keys %{$friends{$mask}{$net}}) {
218 $flags = join "", sort map {$flagshort{$_}}
188 $flags = join "", sort map {$flagshort{$_}}
219189 keys %{$friends{$mask}{$net}{$channel}};
220190 push @friends, [ ++$num, $mask, $channel, $net, $flags ];
221191 }
240210 }
241211 }
242212
243 # ======[ Signal Hooks ]================================================
244
245 # --------[ sig_send_command ]------------------------------------------
246
247213 sub sig_send_command {
248214 my($win) = Irssi::active_win;
249215 if (is_friends_window($win)) {
262228
263229 } elsif (/^(?:n(et)?|chat(net)?)$/) {
264230 $changed = subcmd_friends_net($win,@param);
265
231
266232 } elsif (/^del(ete)?$/) {
267233 $changed = subcmd_friends_delete($win,@param);
268
234
269235 } elsif (/^f(lags?)?$/) {
270236 $changed = subcmd_friends_flags($win,@param);
271237
292258 }
293259 }
294260
295 # --------[ sig_massjoin ]----------------------------------------------
296
297261 sub sig_massjoin {
298262 my($channel, $nicks) = @_;
299263 check_friends($channel, @$nicks);
300264 }
301
302 # --------[ sig_nick_mode_changed ]-------------------------------------
303265
304266 sub sig_nick_mode_changed {
305267 my($channel, $nick) = @_;
308270 }
309271 }
310272
311 # --------[ sig_channel_sync ]------------------------------------------
312
313273 sub sig_channel_sync {
314274 my($channel) = @_;
315275 check_friends($channel, $channel->nicks);
316276 }
317277
318 # --------[ sig_setup_reread ]------------------------------------------
319
320278 sub sig_setup_reread {
321279 load_friends;
322280 }
323
324 # --------[ sig_setup_save ]--------------------------------------------
325281
326282 sub sig_setup_save {
327283 my($mainconf,$auto) = @_;
328284 save_friends($auto);
329285 }
330
331 # --------[ sig_window_changed ]----------------------------------------
332286
333287 sub sig_window_changed {
334288 my($new,$old) = @_;
337291 }
338292 }
339293
340 # --------[ sig_message_public ]----------------------------------------
341
342294 sub sig_message_public {
343295 my($server, $msg, $nick, $addr, $target) = @_;
344296 my($window,$theme,$friend,$oform,$nform);
353305 if ($friend && $color =~ /^[rgbcmykpwRGBCMYKPWFU0-9_]$/) {
354306 $window = $server->window_find_item($target);
355307 $theme = $window->{theme} || Irssi::current_theme;
356
308
357309 $oform = $nform = $theme->get_format('fe-common/core', 'pubmsg');
358310 $nform =~ s/(\$(\[-?\d+\])?0)/%$color$1%n/g;
359311
362314 $window->command("^format pubmsg $oform");
363315 }
364316 }
365
366 # --------[ sig_message_irc_action ]------------------------------------
367317
368318 sub sig_message_irc_action {
369319 my($server, $msg, $nick, $addr, $target) = @_;
379329 if ($friend && $color =~ /^[rgbcmykpwRGBCMYKPWFU0-9_]$/) {
380330 $window = $server->window_find_item($target);
381331 $theme = $window->{theme} || Irssi::current_theme;
382
383 $oform = $nform = $theme->get_format('fe-common/irc',
332
333 $oform = $nform = $theme->get_format('fe-common/irc',
384334 'action_public');
385335 $nform =~ s/(\$(\[-?\d+\])?0)/%$color$1%n/g;
386336
389339 $window->command("^format action_public $oform");
390340 }
391341 }
392
393 # ======[ Commands ]====================================================
394
395 # --------[ FRIENDS ]---------------------------------------------------
396342
397343 # Usage: /FRIENDS
398344 sub cmd_friends {
400346 update_friends_window();
401347 }
402348
403 # --------[ subcmd_friends_channel ]------------------------------------
404
405349 sub subcmd_friends_channel {
406350 my($win,$num,$chan) = @_;
407351
420364 return 1;
421365 }
422366
423 # --------[ subcmd_friends_delete ]-------------------------------------
424
425367 sub subcmd_friends_delete {
426368 my($win,$num) = @_;
427369
429371 $win->print("Syntax: DELETE <num>", MSGLEVEL_NEVER);
430372 return;
431373 }
432
374
433375 unless (0 < $num && $num <= @friends) {
434376 $win->print("Error: Element $num not in list", MSGLEVEL_NEVER);
435377 return;
436378 }
437
379
438380 splice @friends, $num-1, 1;
439381
440382 return 1;
441383 }
442
443 # --------[ subcmd_friends_flags ]--------------------------------------
444384
445385 sub subcmd_friends_flags {
446386 my($win,$num,$flags) = @_;
447387 my(%f);
448
388
449389 unless ($flags && defined $num) {
450390 $win->print("Syntax: FLAGS <num> <flags>", MSGLEVEL_NEVER);
451391 return;
455395 $win->print("Error: Element $num not in list", MSGLEVEL_NEVER);
456396 return;
457397 }
458
398
459399 $friends[$num-1][4] = join "", sort grep {!$f{$_}++}
460400 split //, $flags;
461401
462402 return 1;
463403 }
464404
465 # --------[ subcmd_friends_help ]---------------------------------------
466
467405 sub subcmd_friends_help {
468406 my($win) = @_;
469407
492430
493431 }
494432
495 # --------[ subcmd_friends_mask ]---------------------------------------
496
497433 sub subcmd_friends_mask {
498434 my($win, $num, $mask) = @_;
499435
501437 $win->print("Syntax: MASK <num> <mask>", MSGLEVEL_NEVER);
502438 return;
503439 }
504
440
505441 unless (0 < $num && $num <= @friends) {
506442 $win->print("Error: Element $num not in list", MSGLEVEL_NEVER);
507443 return;
508444 }
509
445
510446 unless ($mask =~ /^.+!.+@.+$/) {
511447 $win->print("Error: Mask $mask is not valid", MSGLEVEL_NEVER);
512448 }
513
449
514450 $friends[$num-1][1] = $mask;
515451
516452 return 1;
517453 }
518
519 # --------[ subcmd_friends_net ]----------------------------------------
520454
521455 sub subcmd_friends_net {
522456 my($win,$num,$net) = @_;
531465 $win->print("Error: Element $num not in list", MSGLEVEL_NEVER);
532466 return;
533467 }
534
468
535469 if ($net eq '*') {
536470 # all is well
537471 } elsif ($n = Irssi::chatnet_find($net)) {
541475 MSGLEVEL_NEVER);
542476 return;
543477 }
544
478
545479 $friends[$num-1][3] = $net;
546480
547481 return 1;
548482 }
549
550 # --------[ ADDFRIEND ]-------------------------------------------------
551483
552484 # Usage: /ADDFRIEND <nick>|<mask> [<channel>|* [<net>|*]]
553485 # [-mask host|normal|domain|full]
554 # [-flags <flags>]
486 # [-flags <flags>]
555487 sub cmd_addfriend {
556488 my($param,$serv,$chan) = @_;
557489 my(@param,@flags);
567499 $type = Irssi::Irc::MASK_HOST;
568500 } elsif (/^n(ormal)?$/) {
569501 $type = Irssi::Irc::MASK_USER
570 | Irssi::Irc::MASK_DOMAIN;
502 | Irssi::Irc::MASK_DOMAIN;
571503 } elsif (/^d(omain)?$/) {
572504 $type = Irssi::Irc::MASK_DOMAIN;
573505 } elsif (/^f(ull)?$/) {
574506 $type = Irssi::Irc::MASK_NICK
575 | Irssi::Irc::MASK_USER
507 | Irssi::Irc::MASK_USER
576508 | Irssi::Irc::MASK_HOST;
577509 } else {
578510 # fjekk
659591 save_friends(1);
660592 }
661593
662 # ======[ Setup ]=======================================================
663
664 # --------[ Register settings ]-----------------------------------------
665
666594 Irssi::settings_add_bool('friends', 'friends_autosave', 1);
667595 Irssi::settings_add_int('friends', 'friends_max_nicks', 10);
668596 Irssi::settings_add_bool('friends', 'friends_show_check', 1);
669
670597 Irssi::settings_add_str('friends', 'friends_nick_color', '');
671
672 # --------[ Register formats ]------------------------------------------
673598
674599 Irssi::theme_register(
675600 [
693618
694619 ]);
695620
696 # --------[ Register signals ]------------------------------------------
697
698621 Irssi::signal_add_first("send command", "sig_send_command");
699622
700623 Irssi::signal_add_last("massjoin", "sig_massjoin");
709632 Irssi::signal_add_first('message public', 'sig_message_public');
710633 Irssi::signal_add_first('message irc action', 'sig_message_irc_action');
711634
712 # --------[ Register commands ]-----------------------------------------
713
714635 Irssi::command_bind('friends', 'cmd_friends');
715636 Irssi::command_bind('addfriend', 'cmd_addfriend');
716637
717 # --------[ Register timers ]-------------------------------------------
718
719 # --------[ Load config ]-----------------------------------------------
720
721638 load_friends;
722
723 # ======[ END ]=========================================================
724
725 # Local Variables:
726 # header-initial-hide: t
727 # mode: header-minor
728 # end:
+29
-2
scripts/google.pl less more
55 use strict;
66 use vars qw($VERSION %IRSSI);
77
8 $VERSION = '2.00';
8 $VERSION = '2.01';
99 %IRSSI = (
1010 authors => 'bw1',
1111 contact => 'bw1@aol.at',
1515 url => 'https://scripts.irssi.org/',
1616 modules => '',
1717 commands=> 'google',
18 selfcheckcmd=> 'google -check',
1819 );
1920
2021 my $help = << "END";
2728 [-n|-count N] [-s|-start] <KEYWORD>
2829 /google {-h|-help}
2930 /google {-p|-say N}
31 /google -check
3032 %9Description%9
3133 $IRSSI{description}
3234 first author: Oddbjørn Kvalsund
3941 -s|-start start at the Nth result
4042 -h|-help show this help message
4143 -p|-say say the N url in channel
44 -check self check
4245 %9See also%9
4346 https://github.com/jarun/googler
4447 END
4548
46 my ($copt, $tld, $lang, $count, $start, $chelp, $say);
49 my ($copt, $tld, $lang, $count, $start, $chelp, $say, $check);
4750 my %options = (
4851 'N'=> sub {$copt .= '--news '},
4952 'news'=> sub {$copt .= '--news '},
6164 'help' => \$chelp,
6265 'p=o' => \$say,
6366 'say=o' => \$say,
67 'check' => \$check,
6468 );
6569
6670 ## Usage:
7175 ## Version 0.1 - Initial release
7276 ## - 2019-08-04
7377 ## Version 2.0 - Change to googler
78 ## - 2021-01-26
79 ## Version 2.01 - self check
7480 ## -------------------------------
7581
7682 my (%readex, $instr, $errstr, @res);
145151 $cmd .="--lang $lang " if (defined $lang);
146152 $cmd .="--count $count " if (defined $count);
147153 $cmd .="--start $start " if (defined $start);
154 $cmd .="irssi " if (defined $check);
148155 $cmd .="$copt " if (defined $copt);
149156 $cmd .=join(" ",@{$arg});
150157 Irssi::print(">$cmd<", MSGLEVEL_CLIENTCRAP);
160167 $say=undef;
161168 }
162169
170 sub self_check {
171 my @r =@_;
172 my $s="ok";
173 $check=undef;
174 Irssi::print("Selfcheck: results: ".scalar @r);
175 Irssi::print("Selfcheck: url: ".$r[0]->{url});
176 Irssi::print("Selfcheck: title: ".$r[0]->{title});
177 if ( scalar(@r) < 6 ) {
178 $s="Error: results (".scalar @r.")";
179 } elsif ( $r[0]->{url} !~ m/^http/ ) {
180 $s="Error: url (".$r[0]->{url}.")";
181 } elsif ( length($r[0]->{title}) < 4) {
182 $s="Error: title (".$r[0]->{title}.")";
183 }
184 Irssi::print("Selfcheck: $s");
185 my $schs_version = $Irssi::Script::selfcheckhelperscript::VERSION;
186 Irssi::command("selfcheckhelperscript $s") if ( defined $schs_version );
187 }
188
163189 sub print_all {
164190 if( length($errstr) <1 ) {
165191 @res= @{decode_json($instr)};
192 self_check(@res) if (defined $check);
166193 Irssi::print("/---- google ----", MSGLEVEL_CLIENTCRAP);
167194 my $c=1;
168195 foreach my $r (@res) {
+2
-2
scripts/hideshow.pl less more
00 use strict;
11 use warnings;
22
3 our $VERSION = '0.4.5'; # 701c53e4db98fb0
3 our $VERSION = '0.4.6'; # 4cc7adcb14932da
44 our %IRSSI = (
55 authors => 'Nei',
66 contact => 'Nei @ anti@conference.jabber.teamidiot.de',
4949 use Encode;
5050 use version;
5151
52 my $irssi_version = qv(Irssi::parse_special('v$J') =~ s/-.*//r);
52 my $irssi_version = qv('v'.Irssi::parse_special('$J') =~ s/[^.\d].*//r);
5353
5454 sub setc () {
5555 $IRSSI{name}
+3
-3
scripts/iMPD.pl less more
7979 use strict;
8080 use vars qw($VERSION %ENABLED %SAVE_VARS %IRSSI %COUNT %SET);
8181
82 $VERSION = '0.0.0n';
82 $VERSION = '0.0.0o';
8383 %IRSSI = (
8484 authors => 'Santabutthead',
8585 contact => 'starz@antisocial.com',
350350
351351 sub crossfade {
352352 &read_settings;
353 if ($_[0] =~ m/\d{1-4}/) {
353 if ($_[0] =~ m/\d{1,4}/) {
354354 &current_window;
355355 Irssi::command( "$SET{'intrairssi'} crossfade $_[0]" );
356356 &mpdbar_refresh; # Impatience
925925
926926 sub seek {
927927 &read_settings;
928 if ($_[0] =~ m/\d{1-3}/) {
928 if ($_[0] =~ m/\d{1,3}/) {
929929 &current_window;
930930 Irssi::command( "$SET{'intrairssi'} seek $_[0]" );
931931 &mpdbar_refresh; # Impatience
+30
-2
scripts/il.pl less more
2626 use Irssi::TextUI;
2727
2828 use vars qw($VERSION %IRSSI);
29 $VERSION = '0.0.5';
29 $VERSION = '0.0.6';
3030 %IRSSI = (
3131 authors => 'Marcus Rueckert',
3232 contact => 'darix@irssi.org',
3535 sbitems => 'inputlength',
3636 license => 'BSD License or something more liberal',
3737 url => 'http://www.irssi.de./',
38 changed => '2003-01-13T13:17:44Z'
38 changed => '2021-01-11'
3939 );
40
41 my $help = << "END";
42 %9Name%9
43 $IRSSI{name}
44 %9Version%9
45 $VERSION
46 %9Description%9
47 $IRSSI{description}
48
49 To activate the inputlength indicator do:
50 /STATUSBAR window add inputlength
51 Statusbar syntax was changed in Irssi 1.2.
52 /STATUSBAR ADDITEM inputlength window
53 %9Settings%9
54 /set inputlength_width 0
55 /set inputlength_padding_char
56 END
4057
4158 sub beancounter {
4259 my ( $sbItem, $get_size_only ) = @_;
102119 # you can use any char you like here. :) even numbers should work
103120 #
104121
122 sub cmd_help {
123 my ($args, $server, $witem)=@_;
124 $args=~ s/\s+//g;
125 if ($IRSSI{name} eq $args) {
126 Irssi::print($help, MSGLEVEL_CLIENTCRAP);
127 Irssi::signal_stop();
128 }
129 }
130
131 Irssi::command_bind('help', \&cmd_help);
132 Irssi::command_bind($IRSSI{name}, sub { cmd_help($IRSSI{name}); } );
+41
-4
scripts/imdb.pl less more
33 use HTML::Entities;
44 use vars qw($VERSION %IRSSI $cache);
55
6 $VERSION = '1.02';
6 $VERSION = '1.04';
77 %IRSSI = (
88 authors => 'Eric Jansen',
99 contact => 'chaos@sorcery.net',
1212 license => 'GPL',
1313 modules => 'LWP::UserAgent HTML::Entities',
1414 url => 'http://xyrion.org/irssi/',
15 changed => '2018-06-14'
15 changed => '2021-10-09',
16 selfcheckcmd=> 'imdb check',
1617 );
1718
1819 my $ua = new LWP::UserAgent;
2021
2122 # Set the timeout to five second, so it won't freeze the client too long on laggy connections
2223 $ua->timeout(5);
24
25 my $last_result;
2326
2427 sub event_nickchange {
2528
4144 else {
4245
4346 # Fetch the movie detail page
44 my $req = new HTTP::Request(GET => "http://us.imdb.com/title/tt$id");
47 my $req = new HTTP::Request(GET => "http://www.imdb.com/title/tt$id/");
4548 my $res = $ua->request($req);
4649
4750 # Get the title and year from the fetched page
5760
5861 # Decode special characters in the title
5962 $title= decode_entities($title);
63 $last_result= { title=> $title, year=> $year };
6064
6165 # Print it
62 $channel->printformat(MSGLEVEL_CRAP, 'imdb_lookup', $old_nick, $title, $year);
66 if ($channel->{type} eq "CHANNEL" ) {
67 $channel->printformat(MSGLEVEL_CRAP, 'imdb_lookup', $old_nick, $title, $year);
68 } else {
69 Irssi::printformat(MSGLEVEL_CRAP, 'imdb_lookup', $old_nick, $title, $year);
70 }
6371
6472 # And cache it
6573 $cache->{$id} = {
7179 }
7280 }
7381
82 # /imdb
83 sub cmd {
84 my ($args, $server, $witem)=@_;
85 if ($args =~ m/check/) {
86 my $s='ok';
87 $last_result= {};
88 $witem->{'ownnick'}->{'nick'}="sepp";
89 my $nick={ nick=>"susi_1234567" };
90 event_nickchange( $witem, $nick , "imdb");
91 unless ( $last_result->{title} =~ m/You Can Dance/ ) {
92 $s="Error: title ($last_result->{title})";
93 }
94 unless ($last_result->{year} =~ m/2008/ ) {
95 $s="Error: year ($last_result->{year})";
96 }
97 Irssi::print("imdb: self check: $s");
98 my $schs = exists $Irssi::Script::{'selfcheckhelperscript::'};
99 Irssi::command("selfcheckhelperscript $s") if ( $schs );
100 } elsif ( $args =~ m/\d{7}/ ) {
101 $args =~ s/\s//g;
102 $witem->{'ownnick'}->{'nick'}="sepp";
103 my $nick={ nick=>"susi_$args" };
104 event_nickchange( $witem, $nick , "imdb");
105 }
106 }
107
74108 Irssi::theme_register([
75109 'imdb_lookup', '{nick $0} is watching {hilight $1} ($2)'
76110 ]);
77111 Irssi::signal_add('nicklist changed', 'event_nickchange');
112 Irssi::command_bind($IRSSI{name},\&cmd);
113
114 # vim:set ts=8 sw=4:
+217
-0
scripts/intercept.pl less more
0 # Some elements borrowed from ideas developed by shabble@freenode(https://github.com/shabble/irssi-docs/wiki )
1 #
2 # You can change what intercept.pl considers a linestart by setting
3 # /set intercept_linestart to a regular expression that fits your needs.
4 # For most, a simple whitespace or . pattern will stop most accidental
5 # inputs.
6 #
7 # You can also tell which patterns should be ignored, for example
8 # /set intercept_exceptions s/\w+/[\w\s\d]+/ wouldn't consider
9 # s/word a mistyped command if it is followed by a slash, string of
10 # valid characters and a final slash.
11 # You can enter several patterns separated by a space.
12
13 use strict;
14 use warnings;
15 use Data::Dumper;
16 use Carp qw( croak );
17 use Irssi;
18 use Data::Munge 'list2re';
19
20 use vars qw($VERSION %IRSSI);
21
22 $VERSION = "0.3";
23 %IRSSI = (
24 authors => "Jari Matilainen",
25 contact => 'vague!#irssi@libera.chat on irc',
26 name => "intercept",
27 description => "Intercept misprinted commands and offer to remove the first character before sending it on",
28 license => "Public Domain",
29 url => "https://irssi.org",
30 changed => "04 Mar 16:00:00 CET 2022",
31 );
32
33 my $active = 0;
34 my $permit_pending = 0;
35 my $pending_input = {};
36 my $verbose = 0;
37 my $isword = 0;
38 my $cmdregexp = list2re map {$_->{cmd}} Irssi::commands();
39
40 sub script_is_loaded {
41 return exists($Irssi::Script::{$_[0] . '::'});
42 }
43
44 if (script_is_loaded('uberprompt')) {
45 app_init();
46 }
47 else {
48 print "This script requires 'uberprompt.pl' in order to work. "
49 . "Attempting to load it now...";
50
51 Irssi::signal_add('script error', 'load_uberprompt_failed');
52 Irssi::command("script load uberprompt.pl");
53
54 unless(script_is_loaded('uberprompt')) {
55 load_uberprompt_failed("File does not exist");
56 }
57 app_init();
58 }
59
60 sub load_uberprompt_failed {
61 Irssi::signal_remove('script error', 'load_uberprompt_failed');
62
63 print "Script could not be loaded. Script cannot continue. "
64 . "Check you have uberprompt.pl installed in your scripts directory and "
65 . "try again. Otherwise, it can be fetched from: ";
66 print "https://github.com/shabble/irssi-scripts/raw/master/"
67 . "prompt_info/uberprompt.pl";
68
69 croak "Script Load Failed: " . join(" ", @_);
70 }
71
72 sub sig_send_text {
73 my ($data, $server, $witem) = @_;
74
75 if($permit_pending == 1) {
76 $pending_input = {};
77 $permit_pending = 0;
78 Irssi::signal_continue(@_);
79 }
80 elsif($permit_pending == 2) {
81 my $regexp = Irssi::settings_get_str('intercept_linestart');
82 $pending_input = {};
83 $permit_pending = 0;
84 Irssi::signal_stop();
85 $data =~ s/^$regexp//;
86
87 if(ref $witem && $witem->{type} eq 'CHANNEL') {
88 $witem->command($data);
89 }
90 else {
91 $server->command($data);
92 }
93 }
94 elsif($permit_pending == 3) {
95 $pending_input = {};
96 $permit_pending = 0;
97 $isword = 0;
98 Irssi::signal_stop();
99
100 if(ref $witem && $witem->{type} eq 'CHANNEL') {
101 $witem->command($data);
102 }
103 else {
104 $server->command($data);
105 }
106 }
107 else {
108 (my $cmdchars = Irssi::settings_get_str('cmdchars')) =~ s/(.)(.)/$1|$2/;
109 my @exceptions = split / /, Irssi::settings_get_str('intercept_exceptions');
110
111 foreach(@exceptions) {
112 return if($data =~ m{$_}i);
113 }
114
115 my ($first) = split ' ', $data;
116
117 my $regexp = Irssi::settings_get_str('intercept_linestart');
118 $regexp =~ s/(^[\^])|([\$]$)//g;
119 if($data =~ /^($regexp)($cmdchars)/i) {
120 my $text = "You have " . ($1 eq ' '?'a space':$1) . " infront of your cmdchar '$2', is this what you wanted? [y/F/c]";
121 $pending_input = {
122 text => $data,
123 server => $server,
124 win_item => $witem,
125 };
126
127 Irssi::signal_stop();
128 require_confirmation($text);
129 }
130 elsif($data =~ /^\s*($cmdregexp)\b/i) {
131 my $text = "The first word, '$1', looks like a command, is this what you wanted? [y/F/c]";
132 $isword = 1;
133 $pending_input = {
134 text => $data,
135 server => $server,
136 win_item => $witem,
137 };
138
139 Irssi::signal_stop();
140 require_confirmation($text);
141 }
142 }
143 }
144
145 sub sig_gui_keypress {
146 my ($key) = @_;
147
148 return if not $active;
149
150 my $char = chr($key);
151
152 # we support f, F, enter for Fix.
153 if($char =~ m/^f?$/i) {
154 $permit_pending = 2 + $isword;
155 Irssi::signal_stop();
156 Irssi::signal_emit('send text',
157 $pending_input->{text},
158 $pending_input->{server},
159 $pending_input->{win_item});
160 $active = 0;
161 set_prompt('');
162 }
163 elsif($char =~ m/^y$/i) {
164 # y or Y for send as is
165 $permit_pending = 1;
166 Irssi::signal_stop();
167 Irssi::signal_emit('send text',
168 $pending_input->{text},
169 $pending_input->{server},
170 $pending_input->{win_item});
171 $active = 0;
172 set_prompt('');
173 }
174 elsif ($char =~ m/^c$/i or $key == 3 or $key == 7) {
175 # we support c, C, Ctrl-C, and Ctrl-G for don't send
176 Irssi::signal_stop();
177 set_prompt('');
178 $permit_pending = 0;
179 $active = 0;
180 $pending_input = {};
181 }
182 else {
183 Irssi::signal_stop();
184 return;
185 }
186 }
187
188 sub app_init {
189 Irssi::signal_add_first("send text" => \&sig_send_text);
190 Irssi::signal_add_first('gui key pressed' => \&sig_gui_keypress);
191 Irssi::signal_add("commandlist new" =>
192 sub {
193 $cmdregexp = list2re map {$_->{cmd}} Irssi::commands();
194 });
195 Irssi::settings_add_str('Intercept', 'intercept_exceptions', 's/\w+/[\w\s\d]+/');
196 Irssi::settings_add_str('Intercept', 'intercept_linestart', '\s');
197 }
198
199 sub require_confirmation {
200 $active = 1;
201 set_prompt(shift);
202 }
203
204 sub set_prompt {
205 my ($msg) = @_;
206 $msg = ': ' . $msg if length $msg;
207 Irssi::signal_emit('change prompt', $msg, 'UP_INNER');
208 }
209
210 sub _debug {
211 return unless $verbose;
212
213 my ($msg, @params) = @_;
214 my $str = sprintf($msg, @params);
215 print $str;
216 }
+30
-101
scripts/keepnick.pl less more
0 # keepnick - irssi 0.7.98.CVS
10 #
2 # $Id: keepnick.pl,v 1.19 2013/05/23 05:08:34 peder Exp $
3 #
4 # Copyright (C) 2001, 2002, 2006, 2013 by Peder Stray <peder@ninja.no>
1 # Copyright (C) 2001-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
85 use Irssi 20011118.1727;
96 use Irssi::Irc;
107
11 # ======[ Script Header ]===============================================
12
138 use vars qw{$VERSION %IRSSI};
14 ($VERSION) = '$Revision: 1.19 $' =~ / (\d+\.\d+) /;
9 ($VERSION) = '$Revision: 1.19.1 $' =~ / (\d+(\.\d+)+) /;
1510 %IRSSI = (
16 name => 'keepnick',
17 authors => 'Peder Stray',
18 contact => 'peder@ninja.no',
19 url => 'http://ninja.no/irssi/keepnick.pl',
20 license => 'GPL',
21 description => 'Try to get your nick back when it becomes available.',
22 );
23
24 # ======[ Variables ]===================================================
11 name => 'keepnick',
12 authors => 'Peder Stray',
13 contact => 'peder.stray@gmail.com',
14 url => 'https://github.com/pstray/irssi-keepnick',
15 license => 'GPL',
16 description => 'Try to get your nick back when it becomes available.',
17 );
2518
2619 my(%keepnick); # nicks we want to keep
2720 my(%getnick); # nicks we are currently waiting for
2821 my(%inactive); # inactive chatnets
2922 my(%manual); # manual nickchanges
30
31 # ======[ Helper functions ]============================================
32
33 # --------[ change_nick ]-----------------------------------------------
3423
3524 sub change_nick {
3625 my($server,$nick) = @_;
4231 $server->send_raw("NICK :$nick");
4332 }
4433
45 # --------[ check_nick ]------------------------------------------------
46
4734 sub check_nick {
4835 my($server,$net,$nick);
4936
5037 %getnick = (); # clear out any old entries
51
38
5239 for $net (keys %keepnick) {
5340 next if $inactive{$net};
5441 $server = Irssi::server_find_chatnet($net);
5542 next unless $server;
5643 next if lc $server->{nick} eq lc $keepnick{$net};
57
44
5845 $getnick{$net} = $keepnick{$net};
5946 }
60
47
6148 for $net (keys %getnick) {
6249 $server = Irssi::server_find_chatnet($net);
6350 next unless $server;
7360 }
7461 }
7562
76 # --------[ load_nicks ]------------------------------------------------
77
7863 sub load_nicks {
7964 my($file) = Irssi::get_irssi_dir."/keepnick";
8065 my($count) = 0;
8166 local(*CONF);
82
67
8368 %keepnick = ();
8469 open CONF, "<", $file;
8570 while (<CONF>) {
9075 }
9176 }
9277 close CONF;
93
78
9479 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
9580 "Loaded $count nicks from $file");
9681 }
97
98 # --------[ save_nicks ]------------------------------------------------
9982
10083 sub save_nicks {
10184 my($auto) = @_;
10285 my($file) = Irssi::get_irssi_dir."/keepnick";
10386 my($count) = 0;
10487 local(*CONF);
105
88
10689 return if $auto && !Irssi::settings_get_bool('keepnick_autosave');
107
90
10891 open CONF, ">", $file;
10992 for my $net (sort keys %keepnick) {
11093 print CONF "$net\t$keepnick{$net}\n";
11194 $count++;
11295 }
11396 close CONF;
114
97
11598 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
11699 "Saved $count nicks to $file")
117100 unless $auto;
118101 }
119
120 # --------[ server_printformat ]----------------------------------------
121102
122103 sub server_printformat {
123104 my($server,$level,$format,@params) = @_;
136117 unless $emitted;
137118 }
138119
139 # ======[ Signal Hooks ]================================================
140
141 # --------[ sig_message_nick ]------------------------------------------
142
143120 # if anyone changes their nick, check if we want their old one.
144121 sub sig_message_nick {
145122 my($server,$newnick,$oldnick) = @_;
148125 change_nick($server, $getnick{$chatnet});
149126 }
150127 }
151
152 # --------[ sig_message_own_nick ]--------------------------------------
153128
154129 # if we change our nick, check it to see if we wanted it and if so
155130 # remove it from the list.
160135 delete $getnick{$chatnet};
161136 if ($inactive{$chatnet}) {
162137 delete $inactive{$chatnet};
163 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_unhold',
138 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_unhold',
164139 $newnick, $chatnet);
165140 }
166141 } elsif (lc $oldnick eq lc $keepnick{$chatnet} &&
171146 $oldnick, $chatnet);
172147 }
173148 }
174
175 # --------[ sig_message_own_nick_block ]--------------------------------
176149
177150 sub sig_message_own_nick_block {
178151 my($server,$new,$old,$addr) = @_;
186159 }
187160 }
188161
189 # --------[ sig_message_quit ]------------------------------------------
190
191162 # if anyone quits, check if we want their nick.
192163 sub sig_message_quit {
193164 my($server,$nick) = @_;
197168 }
198169 }
199170
200 # --------[ sig_redir_keepnick_ison ]-----------------------------------
201
202171 sub sig_redir_keepnick_ison {
203172 my($server,$text) = @_;
204173 my $nick = $getnick{lc $server->{chatnet}};
206175 unless $text =~ /:\Q$nick\E\s?$/i;
207176 }
208177
209 # --------[ sig_redir_keepnick_nick ]-----------------------------------
210
211178 sub sig_redir_keepnick_nick {
212179 my($server,$args,$nick,$addr) = @_;
213180 Irssi::signal_add_first('message own_nick', 'sig_message_own_nick_block');
215182 Irssi::signal_remove('message own_nick', 'sig_message_own_nick_block');
216183 }
217184
218 # --------[ sig_setup_reread ]------------------------------------------
219
220185 # main setup is reread, so let us do it too
221186 sub sig_setup_reread {
222187 load_nicks;
223188 }
224
225 # --------[ sig_setup_save ]--------------------------------------------
226189
227190 # main config is saved, and so we should save too
228191 sub sig_setup_save {
229192 my($mainconf,$auto) = @_;
230193 save_nicks($auto);
231194 }
232
233 # ======[ Commands ]====================================================
234
235 # --------[ KEEPNICK ]--------------------------------------------------
236195
237196 # Usage: /KEEPNICK [-net <chatnet>] [<nick>]
238197 sub cmd_keepnick {
258217 if ($chatnet) {
259218 my($cn) = Irssi::chatnet_find($chatnet);
260219 unless ($cn) {
261 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
220 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
262221 "Unknown chat network: $chatnet");
263222 return;
264223 }
268227
269228 # if we need a server, check if the one we got is connected.
270229 unless ($server || ($nick && $chatnet)) {
271 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
230 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
272231 "Not connected to server");
273232 return;
274233 }
283242 "Unable to find server network, maybe you forgot /server add before connecting?");
284243 return;
285244 }
286
245
287246 if ($inactive{lc $chatnet}) {
288247 delete $inactive{lc $chatnet};
289248 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_unhold',
299258 check_nick();
300259 }
301260
302 # --------[ UNKEEPNICK ]------------------------------------------------
303
304261 # Usage: /UNKEEPNICK [<chatnet>]
305262 sub cmd_unkeepnick {
306263 my($chatnet,$server) = @_;
307
264
308265 # check if the ircnet specified (if any) is valid, and if so get the
309266 # server for it
310267 if ($chatnet) {
311268 my($cn) = Irssi::chatnet_find($chatnet);
312269 unless ($cn) {
313 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
270 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'keepnick_crap',
314271 "Unknown chat network: $chatnet");
315272 return;
316273 }
327284
328285 save_nicks(1);
329286 }
330
331 # --------[ LISTNICK ]--------------------------------------------------
332287
333288 # Usage: /LISTNICK
334289 sub cmd_listnick {
349304 }
350305 }
351306
352 # --------[ NICK ]------------------------------------------------------
353
354307 sub cmd_nick {
355308 my($data,$server) = @_;
356309 my($nick) = split " ", $data;
358311 $manual{lc $server->{chatnet}} = $nick;
359312 }
360313
361 # ======[ Setup ]=======================================================
362
363 # --------[ Register settings ]-----------------------------------------
364
365314 Irssi::settings_add_bool('keepnick', 'keepnick_autosave', 1);
366315 Irssi::settings_add_bool('keepnick', 'keepnick_quiet', 0);
367316
368 # --------[ Register formats ]------------------------------------------
369
370317 Irssi::theme_register(
371318 [
372 'keepnick_crap',
319 'keepnick_crap',
373320 '{line_start}{hilight Keepnick:} $0',
374321
375 'keepnick_add',
322 'keepnick_add',
376323 '{line_start}{hilight Keepnick:} Now keeping {nick $0} on [$1]',
377324
378325 'keepnick_remove',
384331 'keepnick_unhold',
385332 '{line_start}{hilight Keepnick:} Nickkeeping reactivated on [$1]',
386333
387 'keepnick_list_empty',
334 'keepnick_list_empty',
388335 '{line_start}{hilight Keepnick:} No nicks in keep list',
389336
390 'keepnick_list_header',
337 'keepnick_list_header',
391338 '',
392339
393 'keepnick_list_line',
340 'keepnick_list_line',
394341 '{line_start}{hilight Keepnick:} Keeping {nick $0} in [$1] ($2)',
395342
396 'keepnick_list_footer',
343 'keepnick_list_footer',
397344 '',
398345
399346 'keepnick_got_nick',
400347 '{hilight Keepnick:} Nickstealer left [$1], got {nick $0} back',
401
348
402349 ]);
403
404 # --------[ Register signals ]------------------------------------------
405350
406351 Irssi::signal_add('message quit', 'sig_message_quit');
407352 Irssi::signal_add('message nick', 'sig_message_nick');
412357
413358 Irssi::signal_add('setup saved', 'sig_setup_save');
414359 Irssi::signal_add('setup reread', 'sig_setup_reread');
415
416 # --------[ Register commands ]-----------------------------------------
417360
418361 Irssi::command_bind("keepnick", "cmd_keepnick");
419362 Irssi::command_bind("unkeepnick", "cmd_unkeepnick");
420363 Irssi::command_bind("listnick", "cmd_listnick");
421364 Irssi::command_bind("nick", "cmd_nick");
422365
423 # --------[ Register timers ]-------------------------------------------
424
425366 Irssi::timeout_add(12000, 'check_nick', '');
426
427 # --------[ Register redirects ]----------------------------------------
428367
429368 Irssi::Irc::Server::redirect_register('keepnick ison', 0, 0,
430369 undef,
444383 },
445384 undef );
446385
447 # --------[ Load config ]-----------------------------------------------
448
449386 load_nicks;
450
451 # ======[ END ]=========================================================
452
453 # Local Variables:
454 # header-initial-hide: t
455 # mode: header-minor
456 # end:
457 # vim:set ts=8 sw=4:
+80
-4
scripts/leodict.pl less more
33 use strict;
44
55 use vars qw($VERSION %IRSSI);
6 $VERSION = '20180321';
6 $VERSION = '20220104';
77 %IRSSI = (
88 authors => 'Stefan \'tommie\' Tomanek, bw1',
99 contact => 'bw1@aol.at',
1212 license => 'GPLv2',
1313 url => 'http://irssi.org/scripts/',
1414 modules => 'Mojo::UserAgent Encode JSON::PP Mojo::DOM Getopt::Long POSIX',
15 commands => "leodict"
15 commands => "leodict",
16 selfcheckcmd=> 'leodict -chec',
1617 );
1718 use vars qw($forked);
1819 use utf8;
3435 my $word;
3536 my $dir;
3637 my $ddir= '';
38 my $check;
3739
3840 # for fork
3941 my $ftext;
7577 -ru Russian
7678 -pt Portuguese
7779 -pl Polish
80 -chec selfcheck
7881 SETTINGS
7982 'leodict_default_options'
8083 example: -it -from
8184 'leodict_paste_max_translations'
8285 'leodict_paste_beautify'
86 'leodict_http_proxy_address'
87 example: 127.0.0.1
88 defaults to none, meaning no proxy will be used for requests.
89 despite the name, does not have to be http proxy.
90 'leodict_http_proxy_port'
91 example: 9050
92 defaults to 0, but must be changed if proxy address is not none.
93 'leodict_http_proxy_type'
94 supported: socks, https, http
8395 ";
8496 my $text='';
8597 foreach (split(/\n/, $help)) {
104116 %fresult=();
105117
106118 # tables
107 return unless (defined $ftext);
119 unless (defined $ftext) {
120 %fresult=('Error'=>[['no data']]);
121 return;
122 }
108123 my $dom = Mojo::DOM->new($ftext);
109124 foreach my $tbl ( $dom->find('table')->each ) {
110125
140155 my ($url) = @_;
141156 #return get('http://dict.leo.org/?search='.$word.'&relink=off');
142157 my $ua = Mojo::UserAgent->new;
158
159 # Add proxy to Mojo if needed
160 my $proxy_addr = Irssi::settings_get_str('leodict_http_proxy_address');
161 my $proxy_port = Irssi::settings_get_int('leodict_http_proxy_port');
162 my $proxy_type = Irssi::settings_get_str('leodict_http_proxy_type');
163 if ($proxy_addr ne 'none') {
164 # Socks proxy
165 if ($proxy_type eq 'socks' || $proxy_type eq 'https') {
166 $ua->proxy->http("$proxy_type://$proxy_addr:$proxy_port")->https("$proxy_type://$proxy_addr:$proxy_port");
167 }
168 # Must be http proxy
169 else {
170 $ua->proxy->http("$proxy_type://$proxy_addr:$proxy_port");
171 }
172 }
173
143174 my $res;
144175 eval {
145176 $res=$ua->get($url)->result;
171202 print CLIENTCRAP "%R>>%n Please wait until your earlier request has been finished.";
172203 return;
173204 }
205
206 # Validate proxy if needed
207 my $proxy_addr = Irssi::settings_get_str('leodict_http_proxy_address');
208 my $proxy_port = Irssi::settings_get_int('leodict_http_proxy_port');
209 my $proxy_type = Irssi::settings_get_str('leodict_http_proxy_type');
210 if ($proxy_addr ne 'none') {
211 if ($proxy_type ne 'socks' && $proxy_type ne 'https' && $proxy_type ne 'http') {
212 print CLIENTCRAP "%R>>%n Invalid proxy type: $proxy_type.";
213 return;
214 }
215 if ($proxy_port eq 0) {
216 print CLIENTCRAP "%R>>%n Please specify a proxy port.";
217 return;
218 }
219 }
220
174221 my $pid = fork();
175222 $forked = 1;
176223 if ($pid > 0) {
220267 sub show_translations($$) {
221268 my %trans = %{$_[0]};
222269 my $word = $_[1];
270 self_check(\%trans) if ( defined $check );
223271 if (%trans) {
224272 my $text;
225273 foreach my $k (keys %trans) {
295343 "h" => \$help,
296344 "b" => \$browse,
297345 "p" => \$paste,
346 "chec" => \$check,
298347 );
299348
300349 sub cmd_leodict ($$$) {
301350 my ($args, $server, $witem) = @_;
302351 utf8::decode($args);
303 my $burl= "https://dict.leo.org/";
352 my $burl = "https://dict.leo.org/";
304353 my $url;
305354
306355 $lang= $dlang;
308357 undef $help;
309358 undef $browse;
310359 undef $paste;
360 undef $check;
311361
312362 my ($ret, $arg) = GetOptionsFromString($args, %options);
313363
328378 return unless defined $witem;
329379 return unless defined $server;
330380 translate($url, $witem->{name}, $witem->{server}->{tag});
381 } elsif (defined $check) {
382 $url=$burl.'englisch-deutsch/'.'tree'.$dir;
383 translate($url,'', '');
331384 } else {
332385 #show_translations($_);
333386 translate($url,'', '');
334387 }
388 }
389
390 sub self_check {
391 my ( $tr ) =@_;
392 my $s='ok';
393 Irssi::print("selfcheck: categorys ".scalar( keys %$tr ));
394 my $count=0;
395 foreach my $n ( keys %$tr ) {
396 Irssi::print("selfcheck: category $n ".scalar( @{$tr->{$n}} ));
397 $count +=scalar( @{$tr->{$n}} );
398 }
399 Irssi::print("selfcheck: results $count");
400 if ( scalar( keys %$tr ) <4 ) {
401 $s='Error: categorys ('.scalar( keys %$tr ).')';
402 } elsif ( $count < 35 ) {
403 $s="Error: results ($count)";
404 }
405 Irssi::print("selfcheck: $s");
406 my $schs = exists $Irssi::Script::{'selfcheckhelperscript::'};
407 Irssi::command("selfcheckhelperscript $s") if ( $schs );
335408 }
336409
337410 sub sig_setup_changed {
350423 Irssi::settings_add_str($IRSSI{'name'}, 'leodict_default_options', '-en -both');
351424 Irssi::settings_add_int($IRSSI{'name'}, 'leodict_paste_max_translations', 2);
352425 Irssi::settings_add_bool($IRSSI{'name'}, 'leodict_paste_beautify', 1);
426 Irssi::settings_add_str($IRSSI{'name'}, 'leodict_http_proxy_address', 'none');
427 Irssi::settings_add_int($IRSSI{'name'}, 'leodict_http_proxy_port', 0);
428 Irssi::settings_add_str($IRSSI{'name'}, 'leodict_http_proxy_type', 'none');
353429
354430 sig_setup_changed();
355431
+312
-221
scripts/log2ansi.pl less more
00 #! /usr/bin/perl
11 #
2 # $Id: log2ansi,v 1.10 2010/02/13 13:59:47 peder Exp $
3 #
4 # Copyright (C) 2002, 2003, 2010 by Peder Stray <peder@ninja.no>
2 # Copyright (C) 2002-2021 by Peder Stray <peder.stray@gmail.com>
53 #
64 # This is a standalone perl program and not intended to run within
75 # irssi, it will complain if you try to...
97 use strict;
108 use Getopt::Long;
119 use Encode;
10 use Pod::Usage;
1211
1312 use vars qw(%ansi %base %attr %old);
1413 use vars qw(@bols @nums @mirc @irssi @mc @mh @ic @ih @cn);
1514 use vars qw($class $oldclass);
1615
1716 use vars qw{$VERSION %IRSSI};
18 ($VERSION) = ' $Revision: 1.10 $ ' =~ / (\d+\.\d+) /;
17 ($VERSION) = '$Revision: 1.11.1 $' =~ / (\d+(\.\d+)+) /;
1918 %IRSSI = (
20 name => 'log2ansi',
21 authors => 'Peder Stray',
22 contact => 'peder@ninja.no',
23 url => 'http://ninja.no/irssi/log2ansi',
24 license => 'GPL',
25 description => 'convert mirc color and irssi interal formatting to ansi colors, useful for log filtering',
26 );
19 name => 'log2ansi',
20 authors => 'Peder Stray',
21 contact => 'peder.stray@gmail.com',
22 url => 'https://github.com/pstray/irssi-log2ansi',
23 license => 'GPL',
24 description => 'Convert various color codes to ANSI colors, useful for log filtering and viewing.',
25 );
26
27 my $opt_clear = 0;
28 my $opt_html = 0;
29 my $opt_utf8 = 0;
30 my $opt_help = 0;
2731
2832 if (__PACKAGE__ =~ /^Irssi/) {
2933 # we are within irssi... die!
3034 Irssi::print("%RWarning:%n log2ansi should not run from within irssi");
31 die "Suicide to prevent loading\n";
32 }
33
34 my $opt_clear = 0;
35 my $opt_html = 0;
36 my $opt_utf8 = 0;
37
38 GetOptions(
39 'clear!' => \$opt_clear,
40 'html!' => \$opt_html,
41 'utf8!' => \$opt_utf8,
42 );
43
44 for (@ARGV) {
45 if (/\.bz2$/) {
46 $_ = "bunzip2 < '$_' |";
47 } elsif (/\.gz$/) {
48 $_ = "gunzip < '$_' |";
49 }
50 }
51
52 my($n) = 0;
53 %ansi = map { $_ => $n++ } split //, 'krgybmcw';
54
55 @bols = qw(bold underline blink reverse fgh bgh);
56 @nums = qw(fgc bgc);
57
58 @base{@bols} = qw(1 4 5 7 1 5);
59 @base{@nums} = qw(30 40);
60
61 @mirc = split //, 'WkbgRrmyYGcCBMKw';
62 @irssi = split //, 'kbgcrmywKBGCRMYW';
63
64 @mc = map {$ansi{lc $_}} @mirc;
65 @mh = map {$_ eq uc $_} @mirc;
66
67 @ic = map {$ansi{lc $_}} @irssi;
68 @ih = map {$_ eq uc $_} @irssi;
69
70 @cn = qw(black dr dg dy db dm dc lgray dgray lr lg ly lb lm lc white);
35 }
36 else {
37 do_convert();
38 }
7139
7240 sub defc {
7341 my($attr) = shift || \%attr;
7745
7846 sub defm {
7947 my($attr) = shift || \%attr;
80 $attr->{bold} = $attr->{underline} =
48 $attr->{bold} = $attr->{underline} =
8149 $attr->{blink} = $attr->{reverse} = 0;
8250 }
8351
9967 # do nothing
10068 }
10169 else {
102
70
10371 if ($opt_html) {
10472 my %class;
105
73
10674 for (@bols) {
10775 $class{$_}++ if $attr{$_};
10876 }
12694 );
12795
12896 $elem{0}++ if @clear;
129
97
13098 for (@bols) {
131 $elem{$base{$_}}++
99 $elem{$base{$_}}++
132100 if $attr{$_} && ($old{$_} != $attr{$_} || $elem{0});
133101 }
134
102
135103 for (@nums) {
136104 $elem{$base{$_}+$attr{$_}}++
137105 if $attr{$_} >= 0 && ($old{$_} != $attr{$_} || $elem{0});
138106 }
139
107
140108 @elem = sort {$a<=>$b} keys %elem;
141
109
142110 if (@elem) {
143111 @elem = () if @elem == 1 && !$elem[0];
144112 printf "\e[%sm", join ";", @elem;
159127 setold;
160128 }
161129
162 if ($opt_html) {
163 print qq{<div class="loglines">\n};
164 }
165
166 if ($opt_utf8) {
167 binmode STDIN, ':bytes'; #encoding(cp1252)';
168 binmode STDOUT, ':utf8';
169 }
170
171 while (<>) {
130 sub do_convert {
131
132 GetOptions(
133 'c|clear!' => \$opt_clear,
134 'h|html!' => \$opt_html,
135 'u|utf8!' => \$opt_utf8,
136 'help' => sub { $opt_help = 1 },
137 'full-help' => sub { $opt_help = 2 },
138 ) or pod2usage(2);
139
140 # show some help if stdin is a tty and no files
141 $opt_help = 1 if !$opt_help && -t 0 && !@ARGV;
142
143 pod2usage(-verbose => $opt_help,
144 -exitval => 0,
145 ) if $opt_help;
146
147 for (@ARGV) {
148 if (/\.xz$/) {
149 $_ = "unxz < '$_' |";
150 }
151 elsif (/\.bz2$/) {
152 $_ = "bunzip2 < '$_' |";
153 }
154 elsif (/\.gz$/) {
155 $_ = "gunzip < '$_' |";
156 }
157 elsif (/\.lzma$/) {
158 $_ = "unlzma < '$_' |";
159 }
160 }
161
162 my($n) = 0;
163 %ansi = map { $_ => $n++ } split //, 'krgybmcw';
164
165 @bols = qw(bold underline blink reverse fgh bgh);
166 @nums = qw(fgc bgc);
167
168 @base{@bols} = qw(1 4 5 7 1 5);
169 @base{@nums} = qw(30 40);
170
171 @mirc = split //, 'WkbgRrmyYGcCBMKw';
172 @irssi = split //, 'kbgcrmywKBGCRMYW';
173
174 @mc = map {$ansi{lc $_}} @mirc;
175 @mh = map {$_ eq uc $_} @mirc;
176
177 @ic = map {$ansi{lc $_}} @irssi;
178 @ih = map {$_ eq uc $_} @irssi;
179
180 @cn = qw(black dr dg dy db dm dc lgray dgray lr lg ly lb lm lc white);
181
182
183 if ($opt_html) {
184 print qq{<div class="loglines">\n};
185 }
186
172187 if ($opt_utf8) {
173 my $line;
188 binmode STDIN, ':bytes'; #encoding(cp1252)';
189 binmode STDOUT, ':encoding((UTF-8)';
190 }
191
192 while (<>) {
193 if ($opt_utf8) {
194 my $line;
195 while (length) {
196 $line .= decode("utf8", $_, Encode::FB_QUIET);
197 $line .= substr $_, 0, 1, "";
198 }
199 $_ = $line;
200 }
201
202 chomp;
203
204 def;
205 setold;
206
207 if ($opt_html) {
208 printf qq{<div class="logline">};
209 }
210
174211 while (length) {
175 $line .= decode("utf8", $_, Encode::FB_QUIET);
176 $line .= substr $_, 0, 1, "";
177 }
178 $_ = $line;
179 }
180
181 chomp;
182
183 def;
184 setold;
212 if (s/^\cB//) {
213 # toggle bold
214 $attr{bold} = !$attr{bold};
215
216 } elsif (s/^\cC//) {
217 # mirc colors
218
219 if (/^[^\d,]/) {
220 defc;
221 } else {
222
223 if (s/^(\d\d?)//) {
224 $attr{fgc} = $mc[$1 % 16];
225 $attr{fgh} = $mh[$1 % 16];
226 }
227
228 if (s/^,//) {
229 if (s/^(\d\d?)//) {
230 $attr{bgc} = $mc[$1 % 16];
231 $attr{bgh} = $mh[$1 % 16];
232 } else {
233 $attr{bgc} = -1;
234 $attr{bgh} = 0;
235 }
236 }
237 }
238
239 } elsif (s/^\cD//) {
240 # irssi format
241
242 if (s/^a//) {
243 $attr{blink} = !$attr{blink};
244 } elsif (s/^b//) {
245 $attr{underline} = !$attr{underline};
246 } elsif (s/^c//) {
247 $attr{bold} = !$attr{bold};
248 } elsif (s/^d//) {
249 $attr{reverse} = !$attr{reverse};
250 } elsif (s/^e//) {
251 # indent
252 } elsif (s/^f([^,]*),//) {
253 # indent_func
254 } elsif (s/^g//) {
255 def;
256 } elsif (s/^h//) {
257 # cleol
258 } elsif (s/^i//) {
259 # monospace
260 } else {
261 s/^(.)(.)//;
262 my($f,$b) = map { ord($_)-ord('0') } $1, $2;
263 if ($f<0) {
264 # $attr{fgc} = -1; $attr{fgh} = 0;
265 } else {
266 # c>7 => bold, c -= 8 if c>8
267 $attr{fgc} = $ic[$f];
268 $attr{fgh} = $ih[$f];
269 }
270 if ($b<0) {
271 # $attr{bgc} = -1; $attr{bgh} = 0;
272 } else {
273 # c>7 => blink, c -= 8
274 $attr{bgc} = $ic[$b];
275 $attr{bgh} = $ih[$b];
276 }
277 }
278
279 } elsif (s/^\cF//) {
280 # blink
281 $attr{blink} = !$attr{blink};
282
283 } elsif (s/^\cO//) {
284 def;
285
286 } elsif (s/^\cV//) {
287 $attr{reverse} = !$attr{reverse};
288
289 } elsif (s/^\c[\[([^m]*)m//) {
290 my(@ansi) = split ";", $1;
291 my(%a);
292
293 push @ansi, 0 unless @ansi;
294
295 for my $code (@ansi) {
296 if ($code == 0) {
297 def(\%a);
298 } elsif ($code == $base{bold}) {
299 $a{bold} = 1;
300 } elsif ($code == $base{underline}) {
301 $a{underline} = 1;
302 } elsif ($code == $base{blink}) {
303 $a{underline} = 1;
304 } elsif ($code == $base{reverse}) {
305 $a{reverse} = 1;
306 } elsif ($code >= 30 && $code <= 37) {
307 $a{fgc} = $code - 30;
308 } elsif ($code >= 40 && $code <= 47) {
309 $a{bgc} = $code - 40;
310 } else {
311 $a{$code} = 1;
312 }
313 }
314
315 if ($a{fgc} >= 0 && $a{bold}) {
316 $a{fgh} = 1;
317 $a{bold} = 0;
318 }
319
320 if ($a{bgc} >= 0 && $a{blink}) {
321 $a{bgh} = 1;
322 $a{blink} = 0;
323 }
324
325 for my $key (keys %a) {
326 $attr{$key} = $a{$key};
327 }
328
329 } elsif (s/^\c_//) {
330 $attr{underline} = !$attr{underline};
331
332 } else {
333 s/^(.[^\cB\cC\cD\cF\cO\cV\c[\c_]*)//;
334 emit $1;
335 }
336 }
337
338 def;
339 emit "";
340 if ($opt_html) {
341 print "</div>";
342 }
343 print "\n";
344 }
185345
186346 if ($opt_html) {
187 printf qq{<div class="logline">};
188 }
189
190 while (length) {
191 if (s/^\cB//) {
192 # toggle bold
193 $attr{bold} = !$attr{bold};
194
195 } elsif (s/^\cC//) {
196 # mirc colors
197
198 if (/^[^\d,]/) {
199 defc;
200 } else {
201
202 if (s/^(\d\d?)//) {
203 $attr{fgc} = $mc[$1 % 16];
204 $attr{fgh} = $mh[$1 % 16];
205 }
206
207 if (s/^,//) {
208 if (s/^(\d\d?)//) {
209 $attr{bgc} = $mc[$1 % 16];
210 $attr{bgh} = $mh[$1 % 16];
211 } else {
212 $attr{bgc} = -1;
213 $attr{bgh} = 0;
214 }
215 }
216 }
217
218 } elsif (s/^\cD//) {
219 # irssi format
220
221 if (s/^a//) {
222 $attr{blink} = !$attr{blink};
223 } elsif (s/^b//) {
224 $attr{underline} = !$attr{underline};
225 } elsif (s/^c//) {
226 $attr{bold} = !$attr{bold};
227 } elsif (s/^d//) {
228 $attr{reverse} = !$attr{reverse};
229 } elsif (s/^e//) {
230 # indent
231 } elsif (s/^f([^,]*),//) {
232 # indent_func
233 } elsif (s/^g//) {
234 def;
235 } elsif (s/^h//) {
236 # cleol
237 } elsif (s/^i//) {
238 # monospace
239 } else {
240 s/^(.)(.)//;
241 my($f,$b) = map { ord($_)-ord('0') } $1, $2;
242 if ($f<0) {
243 # $attr{fgc} = -1; $attr{fgh} = 0;
244 } else {
245 # c>7 => bold, c -= 8 if c>8
246 $attr{fgc} = $ic[$f];
247 $attr{fgh} = $ih[$f];
248 }
249 if ($b<0) {
250 # $attr{bgc} = -1; $attr{bgh} = 0;
251 } else {
252 # c>7 => blink, c -= 8
253 $attr{bgc} = $ic[$b];
254 $attr{bgh} = $ih[$b];
255 }
256 }
257
258 } elsif (s/^\cF//) {
259 # blink
260 $attr{blink} = !$attr{blink};
261
262 } elsif (s/^\cO//) {
263 def;
264
265 } elsif (s/^\cV//) {
266 $attr{reverse} = !$attr{reverse};
267
268 } elsif (s/^\c[\[([^m]*)m//) {
269 my(@ansi) = split ";", $1;
270 my(%a);
271
272 push @ansi, 0 unless @ansi;
273
274 for my $code (@ansi) {
275 if ($code == 0) {
276 def(\%a);
277 } elsif ($code == $base{bold}) {
278 $a{bold} = 1;
279 } elsif ($code == $base{underline}) {
280 $a{underline} = 1;
281 } elsif ($code == $base{blink}) {
282 $a{underline} = 1;
283 } elsif ($code == $base{reverse}) {
284 $a{reverse} = 1;
285 } elsif ($code => 30 && $code <= 37) {
286 $a{fgc} = $code - 30;
287 } elsif ($code => 40 && $code <= 47) {
288 $a{bgc} = $code - 40;
289 } else {
290 $a{$code} = 1;
291 }
292 }
293
294 if ($a{fgc} >= 0 && $a{bold}) {
295 $a{fgh} = 1;
296 $a{bold} = 0;
297 }
298
299 if ($a{bgc} >= 0 && $a{blink}) {
300 $a{bgh} = 1;
301 $a{blink} = 0;
302 }
303
304 for my $key (keys %a) {
305 $attr{$key} = $a{$key};
306 }
307
308 } elsif (s/^\c_//) {
309 $attr{underline} = !$attr{underline};
310
311 } else {
312 s/^(.[^\cB\cC\cD\cF\cO\cV\c[\c_]*)//;
313 emit $1;
314 }
315 }
316
317 def;
318 emit "";
319 if ($opt_html) {
320 print "</div>";
321 }
322 print "\n";
323 }
324
325 if ($opt_html) {
326 print "</div>\n";
327 }
347 print "</div>\n";
348 }
349
350 }
351
352 __END__
353
354 =head1 NAME
355
356 log2ansi - Convert foo various color escape codes to ANSI (or strip them)
357
358 =head1 SYNOPSIS
359
360 B<log2ansi>
361 [B<-c>|B<--clear>]
362 [B<-h>|B<--html>]
363 [B<-u>|B<--utf8>]
364 [B<--help>]
365 [I<logfile ...>]
366
367 =head1 OPTIONS
368
369 =over
370
371 =item B<-c>, B<--clear>
372
373 Instructs B<log2ansi> to clear all formatting and output plain text logs.
374
375 =item B<-h>, B<--html>
376
377 Instructs B<log2ansi> to output a HTML fragment instead of ANSI text.
378
379 The whole log will be wrapped in a div with class C<loglines>, each line
380 of the log in a div with class C<logline>. Colors are wrapped in spans,
381 with a class name consisting of C<fg> or C<bg>, concatenated with the
382 color name, either C<black> or C<white>, or C<r>, C<g>, C<b>, C<c>,
383 C<m>, C<y>, or C<gray> prefixed with either C<l> for light, or C<d> for
384 dark.
385
386 You have to include appropriate CSS yourself to get any colors at all
387 when viewing the log.
388
389 =item B<-u>, B<--utf8>
390
391 This forces output to be UTF-8, and does input decoding of UTF-8 with
392 fallback to ISO-8859-1. Use this if your input logs have mixed UTF-8
393 and ISO-8859-1.
394
395 =item B<--help>, B<--full-help>
396
397 Show help, either just option descriptions or a full man page.
398
399 =back
400
401 =head1 DESCRIPTION
402
403 Use B<log2ansi> to convert logfiles from Irssi with internal escape
404 codes, mIRC color codes or ANSI escapes to plain text with ANSI
405 formatted color codes for viewing in a terminal.
406
407 Use the B<--clear> option to strip all formatting escapes and output
408 just plain text.
409
410 You can supply input on standard input, or as filenames on the command
411 line. Any file ending in B<.gz>, B<.bz2>, B<.xz> or B<.lzma> will be
412 uncompressed automatically before processing.
413
414 =head1 AUTHORS
415
416 Peder Stray <peder.stray@gmail.com>
417
418 =cut
+3
-3
scripts/mouse.pl less more
2222
2323 use vars qw($VERSION %IRSSI);
2424
25 $VERSION = '1.1.1';
25 $VERSION = '1.1.2';
2626 %IRSSI = (
2727 authors => 'Wouter Coekaerts',
2828 contact => 'wouter@coekaerts.be',
3030 description => 'control irssi using mouse clicks and gestures',
3131 license => 'GPLv2 or later',
3232 url => 'http://wouter.coekaerts.be/irssi/',
33 changed => '2019-01-14',
33 changed => '2021-03-05',
3434 );
3535
3636 my @BUTTONS = ('', '_middle', '_right');
131131 mouse_disable();
132132 }
133133
134 if ($ENV{"TERM"} !~ /^rxvt|screen|xterm(-(256)?(color|kitty))?$/) {
134 if ($ENV{"TERM"} !~ /^rxvt|screen|xterm|tmux(-(256)?(color|kitty))?$/) {
135135 die "Your terminal doesn't seem to support this.";
136136 }
137137
+1026
-0
scripts/perlalias.pl less more
0 =head1 perlalias.pl - Perl-based command aliases for irssi
1
2 This script provides an /alias-like function that uses small pieces of perl code to carry out the commands.
3
4 =head2 Usage
5
6 Install into irssi script directory and /run perlalias and/or put into autorun.
7
8 =head2 Commands
9
10 =over
11
12 =item /perlalias
13
14 Syntax: /perlalias [[[-]<alias>] [<code>]]
15
16 Parameters: A name of the alias and the perl code to execute.
17
18 If you prepend the alias with -, it will remove the alias.
19
20 If you give no arguments, the list of defined aliases will be displayed.
21
22 Description:
23
24 Creates or updates an alias. Like any perl code, multiple statements must be separated using ; characters.
25 No replacement of parameter values is done: any $text is a perl variable.
26
27 Examples:
28
29 /PERLALIAS UNACT foreach my $w (Irssi::windows) { $w->activity(0); }
30
31 =back
32
33 =over
34
35 =item /perlunalias
36
37 Syntax: /perlunalias <alias>
38
39 Parameters: The alias to remove.
40
41 Description:
42
43 Removes the given alias.
44
45 =back
46
47 Notes on alias authoring:
48
49 The following variables are available to you in in the body of your perlalias:
50
51 * $_ contains the raw text of the arguments supplied to the command
52 * @_ contains those some arguments split on whitespace
53 * $server references the currently active server, if any, otherwise undef.
54 * $witem references the currently active window item (channel, query, or other), if any. Otherwise undef.
55 * Most of the irssi $X variables are available as well, producing results exactly as if you used Irssi::parse_special.
56 * Note that $1, $2, etc do not map to the irssi variables. Those are regex variables. You want $_[0], $_[1], etc:
57 ** Unless you mess with $", $3- is basically "@_[2..$#_]", and $* is "@_" or simply $_ (which has repeated spaces intact)
58
59 The alias is compiled once, when the alias is added or the script loads the saved aliases. As usual, your BEGIN {} blocks will run immediately at
60 that time. If an alias encounters a fatal-error during compilation, the alias will still be stored and saved, and the error will be saved in the alias. The error will be redisplayed if you try to use the alias: no attempt to execute any code will be made. The alias will also be displayed differently in the /perlalias listing.
61
62 You can use signal_add or command_bind as normal in your alias. However, if you use them normally, the signals and commands you
63 add will be removed when the alias finishes executing. If you want a persistant signal or command, you must place it inside a
64 BEGIN {} or UNITCHECK {} block (and you must pass the compile stage).
65
66 Note that because you are adding code to an already-running perl state, CHECK {} blocks do not run.
67
68 Additionally, all aliases added are linked to perlalias.pl: if it is unloaded, the aliases will be removed.
69
70 You can retain data between multiple use of the alias using an 'our' variable. These variables are not shared with other aliases, and neither are named subs that you might declare.
71 In addition, these variables aren't saved if the script is unloaded and reloaded (or if irssi restarts).
72
73 The following directives are in effect on alias code:
74
75 use strict;
76 use warnings FATAL => qw(closure);
77
78 All default warnings - those marked (S) or (D) in perldiag - are enabled and closure warnings are made fatal errors.
79
80 Closure warnings are made fatal errors, so you get an error if you try to use an outer lexical (my/state) variable inside a named sub. This won't
81 work as you might normally expect at file-scope as alias code is compiled once and run multiple times. All other warnings are off by default. If you
82 want them, you can use warnings; as usual.
83
84 Aliases can be saved and reloaded with the usual /save and /reload (including autosave). Saved aliases are loaded at script load. The textual content
85 of the alias (including BEGIN {} and UNITCHECK {} blocks) are saved and will be re-executed when the alias next loads.
86
87 =head2 ChangeLog
88
89 =over
90
91 =item 2.0
92
93 Perl 5.22 or later is now mandatory.
94
95 Major overhaul to how aliases get compiled and executed:
96
97 * Aliases are now under the effect of 'use 5.22.0': perl version 5.22.0 is required both for perlalias itself and for aliases. In addition, all perl 5.22.0 feature bundles are enabled (see perldoc feature). Notably, 'state $var' is available by default.
98 * Aliases are now compiled with strict on, default perl warnings (previously all warnings were off), and with closure warnings (see perldiag) enabled. This will help warn you of using outside 'my' variables inside named subs : this won't work as you expect!
99 * Perlalias warnings will emit to the default window with a nicer looking output now.
100 * Aliases now get their own individual package scopes, so your 'our' variables and named subs are no longer shared among aliases.
101 * You can use 'shared state $Var' to share the $Var variable with your other aliases. You have to do this in each alias that wants to use the shared variable. You can share scalars, arrays, and hashes this way.
102 ** If you use an initializer, only the first alias to run that declares the state variable will decide the initial value of the variable.
103 * You now have access to most of the $X-type special variables used in standard aliases, without needing to deal with parse_special().
104 * Aliases that fail to compile are no longer rejected. They'll be registered, but when you try to execute them, the compile error message will simply be displayed again. Failed aliases will also display differently in the alias list.
105
106 =item 1.3
107
108 Made signal_add and command_bind usable within the alias code. They will persist if used inside a BEGIN block but will be removed
109 after execution otherwise.
110
111 =item 1.0
112
113 First version.
114
115 =back
116
117 =cut
118
119 # This need to be before pragmas, so that the eval runs in a pragma-free state
120 sub _clean_eval { eval $_[0]; } ## no critic
121
122 use 5.22.0;
123 use strict;
124 use warnings FATAL => qw(all);
125 use Irssi;
126 use Irssi::Irc;
127 use Carp ();
128
129 use B ();
130
131 { package Irssi::Nick; } # Keeps trying to look for this package but for some reason it doesn't get loaded.
132
133 our $VERSION = '2.0.1';
134 our %IRSSI = (
135 authors => 'aquanight',
136 contact => 'aquanight@gmail.com',
137 name => 'perlalias',
138 description => 'Quickly create commands from short perl blocks',
139 license => 'public domain'
140 );
141
142 package Irssi::Script::perlalias::IrssiVar {
143 sub TIESCALAR {
144 my $class = shift;
145 my $irssivar = shift;
146 my $this = bless \$irssivar, $class;
147 return $this;
148 }
149
150 sub FETCH {
151 my $this = shift;
152 my $irssivar = $$this;
153 return Irssi::Script::perlalias::aliaspkg::parse_special($irssivar);
154 }
155
156 sub STORE { Carp::croak "Attempt to modify irssi special variable"; }
157 }
158
159 my $_eval_prep;
160 BEGIN { $_eval_prep = ""; }
161
162 # Base package which provides variables to the alias code.
163 package Irssi::Script::perlalias::aliaspkg {
164 our $server;
165 our $witem;
166
167 our @_irssi_vars;
168 use vars map '$'.$_, @_irssi_vars = (
169 qw(A B C F I J K k M N O P Q R T V versiontime abiversion W Y Z sysname sysrelease sysarch topic tag chatnet itemname), # core
170 qw(H S X x usermode cumode cumode_space), # irc
171 qw(E L U), # gui
172 qw(winref winname), # fe
173 qw(D)); # notify-whois
174
175 BEGIN {
176 for my $var (@_irssi_vars) {
177 use Symbol ();
178 my $gr = Symbol::qualify_to_ref($var);
179 my $sv = *$gr{SCALAR};
180 tie $$sv, 'Irssi::Script::perlalias::IrssiVar' => "\$$var";
181 $_eval_prep .= "our \$$var;\n";
182 }
183 }
184
185 our %shared;
186
187 # Empty placeholder sub for our keyword.
188 sub shared {
189 }
190
191 sub parse_special {
192 my ($special) = @_;
193 defined $witem and return $witem->parse_special($special);
194 defined $server and return $server->parse_special($special);
195 return Irssi::parse_special($special);
196 }
197 }
198
199 # The below is intended to be representative of the template of an alias's package.
200 #package Irssi::Script::perlalias::aliaspkg::perlalias {
201 # BEGIN {
202 # import Irssi::Script::perlalias::aliaspkg;
203 # }
204 #
205 # our $_name = "name of the command";
206 #
207 # our $_text = "plaintext of the alias";
208 #
209 # sub invoke {
210 # # The compiled version of the alias.
211 # }
212 #
213 # our @_signals; # Data about the signals this alias has hooked
214 # our @_commands: # Data about commands this alias has created
215 #
216 # our $_error; # Stored compilation error
217 #}
218
219 # Unfortunately, we can't really just use the alias name as a package name. Irssi commands have no restrictions on what characters are in them.
220 # Nothing stops someone from wanting a command named mallet::gnome or something else weird. It's on them to figure out how to type in weird stuff
221 # like ^W or whatever. Whitespace is somewhat safe due to the command format but not entirely.
222 our %alias_packages = ();
223
224 my $pkgindex = 0;
225
226 sub next_package_name { sprintf("Irssi::Script::perlalias::aliaspkg::A%d", ++$pkgindex); };
227
228 # These capture signal_add* and command_bind* invocations that occur during alias compilation (via BEGIN{}s) and execution.
229
230 sub capture_signal_command {
231 my ($cmd, $irssi_proc, $store) = @_;
232 my $capture_handler = sub {
233 #exists $cmds{$cmd} or return;
234 #defined $cmds{$cmd}->{cmpcmd} or return;
235 #Carp::cluck "Capturing attempt to add signal";
236 $irssi_proc->(@_);
237 push @$store, $_[0], $_[1];
238 };
239 return $capture_handler;
240 }
241
242 sub cleanup_signals {
243 my ($remove_proc, @signals) = @_;
244 while (scalar(@signals) > 0) {
245 my ($signal, $handler) = splice @signals, 0, 2;
246 defined($signal) or return;
247 $remove_proc->($signal, $handler);
248 }
249 }
250
251 sub execute_alias;
252
253 our $alias_depth = "";
254 sub cmd__alias {
255 my ($data, $server, $witem) = @_;
256 return if $alias_depth;
257 # If they do Irssi::command("blerp") or anything like that, it needs to go to a real command, just like aliases do.
258 local $alias_depth = 1;
259 my $sig = Irssi::signal_get_emitted();
260 Irssi::signal_stop(); # Don't let any real command catch it.
261 my ($cmd) = ($sig =~ m/^command (.*)$/);
262 defined $cmd or Carp::confess "This is weird"; # What are we doing here?
263 execute_alias $cmd, $data, $server, $witem;
264 }
265
266 # The new alias handling code starts here:
267
268 sub destroy_alias_package {
269 my ($name) = @_;
270 my $package = $alias_packages{$name};
271 return unless defined $package;
272 no strict 'refs';
273 my @signals = @{"${package}::signals"};
274 my @commands = @{"${package}::commands"};
275 cleanup_signals(\&Irssi::signal_remove, @signals);
276 cleanup_signals(\&Irssi::command_unbind, @commands);
277 delete $alias_packages{$name};
278 Irssi::command_unbind("$name", \&cmd__alias);
279 Symbol::delete_package($package);
280 return;
281 }
282
283 sub collect_shared_variables;
284
285 sub setup_alias_package {
286 my ($name, $code) = @_;
287 # Terminate the existing alias, if there is one.
288 exists $alias_packages{$name} and destroy_alias_package $name;
289 Irssi::command_bind_first("$name", \&cmd__alias);
290 my $package = next_package_name;
291 $alias_packages{$name} = $package;
292 my $signals;
293 my $commands;
294 {
295 no strict 'refs';
296 ${"${package}::_text"} = $code;
297 ${"${package}::_name"} = $name;
298 @{"${package}::_signals"} = ();
299 $signals = \@{"${package}::_signals"};
300 @{"${package}::_commands"} = ();
301 $commands = \@{"${package}::_commands"};
302 ${"${package}::_error"} = undef;
303 }
304 no warnings 'redefine'; # Shut up about monkey patching
305 local *Irssi::signal_add = capture_signal_command($name, Irssi->can("signal_add"), $signals);
306 local *Irssi::signal_add_first = capture_signal_command($name, Irssi->can("signal_add_first"), $signals);
307 local *Irssi::signal_add_last = capture_signal_command($name, Irssi->can("signal_add_last"), $signals);
308 local *Irssi::signal_add_priority = capture_signal_command($name, Irssi->can("signal_add_priority"), $signals);
309 local *Irssi::command_bind = capture_signal_command($name, Irssi->can("command_bind"), $commands);
310 local *Irssi::command_bind_first = capture_signal_command($name, Irssi->can("command_bind_first"), $commands);
311 local *Irssi::command_bind_last = capture_signal_command($name, Irssi->can("command_bind_last"), $commands);
312 local $SIG{__WARN__} = sub {
313 Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_warning => $name);
314 Irssi::print($_[0], MSGLEVEL_CLIENTERROR);
315 };
316 my sub failed_alias { ## no critic
317 my $err = shift;
318 $err =~ /^ASSERT/ and die $err; ## no critic
319 no strict 'refs';
320 undef *{"${package}::invoke"}; # Kill the sub if it compiled but we failed shared-state setup.
321 ${"${package}::_error"} = $err;
322 Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_compile_error => $name);
323 Irssi::print($err, MSGLEVEL_CLIENTERROR);
324 cleanup_signals(\&Irssi::signal_remove, @$signals);
325 cleanup_signals(\&Irssi::command_unbind, @$commands);
326 }
327 _clean_eval qq{
328 #line 1 "perlalias-eval-setup"
329 package Irssi::Script::perlalias::aliaspkg;
330 BEGIN { \*${package}::shared = \\&shared; }
331 our \$shared;
332 our \$witem;
333 $_eval_prep
334 package $package;
335 use 5.22.0;
336 use strict;
337 use warnings 'closure';
338 use Irssi;
339 sub invoke {
340 #line 1 "perlalias $name"
341 $code;
342 }
343 1;
344 } or do { failed_alias $@; return; };
345 eval {
346 collect_shared_variables $package;
347 1;
348 } or do { failed_alias $@; return; };
349 }
350
351 sub execute_alias {
352 my ($name, $data, $server, $witem) = @_;
353 local $Irssi::Script::perlalias::aliaspkg::server = $server;
354 local $Irssi::Script::perlalias::aliaspkg::witem = $witem;
355 my $package = $alias_packages{$name};
356 return unless defined $package;
357 no strict 'refs';
358 my $proc = "$package"->can("invoke");
359 unless (defined $proc) {
360 my $err = ${"${package}::_error"};
361 defined $err or return; # Not sure how we'd get here with no error and no proc. Perhaps we lost a race?
362 Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_compile_error => $name);
363 Irssi::print($err, MSGLEVEL_CLIENTERROR);
364 }
365 my @signals;
366 my @commands;
367 no warnings 'redefine'; # SHUT UP ABOUT MONKEY PATCHING
368 local *Irssi::signal_add = capture_signal_command($name, Irssi->can("signal_add"), \@signals);
369 local *Irssi::signal_add_first = capture_signal_command($name, Irssi->can("signal_add_first"), \@signals);
370 local *Irssi::signal_add_last = capture_signal_command($name, Irssi->can("signal_add_last"), \@signals);
371 local *Irssi::signal_add_priority = capture_signal_command($name, Irssi->can("signal_add_priority"), \@signals);
372 local *Irssi::command_bind = capture_signal_command($name, Irssi->can("command_bind"), \@commands);
373 local *Irssi::command_bind_first = capture_signal_command($name, Irssi->can("command_bind_first"), \@commands);
374 local *Irssi::command_bind_last = capture_signal_command($name, Irssi->can("command_bind_last"), \@commands);
375 local $SIG{__WARN__} = sub {
376 Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_warning => $name);
377 Irssi::print($_[0], MSGLEVEL_CLIENTERROR);
378 };
379 local $_ = $data;
380 my @args = split / +/, $data;
381 eval { $proc->(@args);};
382 my $err = $@;
383 # signals/commands created during this step were not the result of a BEGIN{}/UNITCHECK{}/etc.
384 # These signals get removed after completion!
385 cleanup_signals(\&Irssi::signal_remove, @signals);
386 cleanup_signals(\&Irssi::command_unbind, @commands);
387 if ($err) {
388 Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_exec_error => $name);
389 Irssi::print($err, MSGLEVEL_CLIENTERROR);
390 }
391 }
392
393 sub list_commands {
394 my ($prefix) = @_;
395 my @whichones = sort grep /^\Q$prefix\E/, keys %alias_packages;
396 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'perlaliaslist_header');
397 for my $name (@whichones) {
398 my $package = $alias_packages{$name};
399 no strict 'refs';
400 my $text = ${"${package}::_text"};
401 if (defined "$package"->can("invoke")) {
402 Irssi::printformat(MSGLEVEL_CLIENTCRAP, perlaliaslist_line => $name, $text);
403 }
404 else {
405 Irssi::printformat(MSGLEVEL_CLIENTCRAP, perlaliaslist_line_error => $name, $text);
406 }
407 }
408 }
409
410 sub cmd_perlalias {
411 my ($data, $server, $witem) = @_;
412 my ($command, $script) = split /\s+/, $data, 2;
413 if (($command//"") eq "") {
414 list_commands "";
415 }
416 elsif ($command =~ m/^-/) {
417 $command = substr($command, 1);
418 if (exists $alias_packages{$command}) {
419 destroy_alias_package $command;
420 Irssi::printformat(MSGLEVEL_CLIENTNOTICE, perlalias_removed => $command);
421 }
422 else {
423 Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_not_found => $command);
424 }
425 }
426 elsif (($script//"") eq "") {
427 list_commands $command;
428 }
429 else {
430 setup_alias_package $command, $script;
431 Irssi::printformat(MSGLEVEL_CLIENTNOTICE, perlalias_added => $command);
432 }
433
434 }
435
436 sub cmd_perlunalias {
437 my ($data, $server, $witem) = @_;
438 my $command = $data;
439 if (exists $alias_packages{$command}) {
440 destroy_alias_package $command;
441 Irssi::printformat(MSGLEVEL_CLIENTNOTICE, perlalias_removed => $command);
442 }
443 else {
444 Irssi::printformat(MSGLEVEL_CLIENTERROR, perlalias_not_found => $command);
445 }
446 }
447
448 sub sig_setup_saved {
449 my ($main, $auto) = @_;
450 my $file = Irssi::get_irssi_dir() . "/perlalias.json";
451 open my $fd, '>', $file or return;
452 my $js = JSON::PP->new->utf8->pretty(0);
453 my $obj = [ map {
454 my $package = $alias_packages{$_};
455 no strict 'refs';
456 my $text = ${"${package}::_text"};
457 +{ command => $_, script => $text };
458 } keys %alias_packages ];
459 $fd->print($js->encode($obj));
460 close $fd;
461 }
462
463 use JSON::PP;
464
465 use constant JSON_CONFIG => Irssi::get_irssi_dir() . "/perlalias.json";
466 use constant LEGACY_CONFIG => Irssi::get_irssi_dir() . "/perlalias";
467
468 sub sig_setup_reread {
469 my %newcmds;
470 my $fd;
471 if (open $fd, "<", JSON_CONFIG) {
472 my $js = JSON::PP->new->utf8->pretty(0);
473 local $/;
474 unless (eval {
475 my $obj = $js->decode(<$fd>);
476 for my $entry (@$obj) {
477 my ($cmd, $script) = $entry->@{qw/command script/};
478 if (exists $newcmds{$cmd}) {
479 Irssi::print("There is a duplicate record in the PerlAlias save file.", MSGLEVEL_CLIENTERROR);
480 Irssi::print("Offending alias: $cmd", MSGLEVEL_CLIENTERROR);
481 Irssi::print("Previous definition: " . $newcmds{$cmd}, MSGLEVEL_CLIENTERROR);
482 Irssi::print("Duplicate definition: $script", MSGLEVEL_CLIENTERROR);
483 }
484 $newcmds{$cmd} = $script;
485 }
486 1;
487 }) { goto LEGACY_CONF; }
488 close $fd;
489 goto PROCESS;
490 }
491 else
492 {
493 LEGACY_CONF:
494 open my $fd, "<", LEGACY_CONFIG or return;
495 my $ln;
496 while (defined($ln = <$fd>)) {
497 chomp $ln;
498 my ($cmd, $script) = split /\t/, $ln, 2;
499 if (exists $newcmds{$cmd}) {
500 Irssi::print("There is a duplicate record in the PerlAlias save file.", MSGLEVEL_CLIENTERROR);
501 Irssi::print("Offending alias: $cmd", MSGLEVEL_CLIENTERROR);
502 Irssi::print("Previous definition: " . $newcmds{$cmd}, MSGLEVEL_CLIENTERROR);
503 Irssi::print("Duplicate definition: $script", MSGLEVEL_CLIENTERROR);
504 }
505 $newcmds{$cmd} = $script;
506 }
507 Irssi::print("Legacy config loaded. Please /save to upgrade config file.", MSGLEVEL_CLIENTNOTICE);
508 close $fd;
509 }
510 PROCESS:
511 # Scrub the existing list. Update existings, remove any that aren't in the config, then we'll add any that's new.
512 my @currentcmds = keys %alias_packages;
513 for my $cmd (@currentcmds) {
514 if (exists $newcmds{$cmd}) {
515 setup_alias_package($cmd, $newcmds{$cmd});
516 }
517 else {
518 destroy_alias_package($cmd);
519 }
520 delete $newcmds{$cmd};
521 }
522 # By this point all that should be in newcmds is any ... new commands.
523 for my $cmd (keys %newcmds) {
524 setup_alias_package($cmd, $newcmds{$cmd});
525 }
526 }
527
528 sub sig_complete_perlalias {
529 my ($lst, $win, $word, $line, $want_space) = @_;
530 $word//return;
531 $line//return;
532 $lst//return;
533 if ($line ne '') {
534 my $package = $alias_packages{$line};
535 no strict 'refs';
536 my $def = ${"${package}::_text"};
537 $def//return;
538 push @$lst, $def->{textcmd};
539 Irssi::signal_stop();
540 }
541 else {
542 push @$lst, (grep /^\Q$word\E/i, keys %alias_packages);
543 Irssi::signal_stop();
544 }
545 }
546
547 sub sig_complete_perlunalias {
548 my ($lst, $win, $word, $line, $want_space) = @_;
549 $lst//return;
550 $word//return;
551 push @$lst, (grep /^\Q$word\E/i, keys %alias_packages);
552 }
553
554 Irssi::signal_register({"complete command " => [qw(glistptr_char* Irssi::UI::Window string string intptr)]});
555 Irssi::signal_add("complete command perlalias" => \&sig_complete_perlalias);
556 Irssi::signal_add("complete command perlunalias" => \&sig_complete_perlunalias);
557
558 Irssi::signal_add("setup saved" => \&sig_setup_saved);
559 Irssi::signal_add("setup reread" => \&sig_setup_reread);
560
561 Irssi::command_bind(perlalias => \&cmd_perlalias);
562 Irssi::command_bind(perlunalias => \&cmd_perlunalias);
563
564 my %formats = (
565 # $0 Name of alias
566 'perlalias_compile_error' => '{error Error compiling alias {hilight $0}:}',
567 # $0 Name of alias
568 'perlalias_exec_error' => '{error Error executing alias {hilight $0}:}',
569 'perlalias_warning' => '{error Warning in alias {hilight $0}:}',
570 'perlalias_cmd_in_use' => 'Command {hilight $0} is already in use',
571 'perlalias_added' => 'PerlAlias {hilight $0} added',
572 'perlalias_removed' => 'PerlAlias {hilight $0} removed',
573 'perlalias_not_found' => 'PerlAlias {hilight $0} not found',
574 'perlaliaslist_header' => '%#PerlAliases:',
575 # $0 Name of alias, $1 alias text
576 'perlaliaslist_line' => '%#$[10]0 $1',
577 'perlaliaslist_line_error' => '%#{error $[10]0} $1',
578 );
579
580 Irssi::theme_register([%formats]);
581
582 sig_setup_reread;
583
584 #__END__
585
586 # For error helping:
587 my $_skip_asserts = 0;
588 sub assert :prototype(&$) {
589 return if $_skip_asserts;
590 my $condition = shift;
591 my $message = shift;
592 return if $condition->();
593 Carp::confess "ASSERT FAILURE: $message";
594 }
595
596 # There is going to be some pretty heavy stuff going on here.
597
598 # Because every perlalias runs inside its own package, there are basically three classes of variables:
599 #
600 # # Variables that reset every time the alias runs -- my $x; (*)
601 # # Variables that keep their value between different alias runs, but are not visible to other aliases -- state $x; our $y;
602 # # Variables that keep their value between different alias runs, and are shared across aliases -- shared state $z;
603 #
604 # The 'shared state' declarator brings the third type into existence.
605 #
606 # Major credit to 'mst' and 'LeoNerd' of Freendoe/#perl for putting up with my awkward attempts at figuring this out.
607
608 # Shared variables are now of the format:
609 # [ <data>, <proc>, <pad>, <index> ]
610 # <data> contains an instance of Tie::StdScalar, Tie::StdArray, or Tie::StdHash
611 # <proc> contains an anonymous sub. Any time the variable is accessed, we call <proc> in void context.
612 # <proc> will just be a small sub that contains a state with initializer. Calling it will trigger the initializer.
613 # <pad> Contains an array reference which is a reference to the first PAD of <proc>, which will be where we find....
614 # <index> The index number to the state's "initializer has run" controlling variable.
615 # When setting up a new shared variable, that variable should be a state, and if it has its own initializer, we will link that state
616 # variable's initializer-control variable to the one in the anonymous sub. Thus if either initializer runs, neither will run again.
617
618 use Tie::Scalar ();
619 use Tie::Array ();
620 use Tie::Hash ();
621
622 use Scalar::Util 'reftype';
623
624 package Irssi::Script::perlalias::SharedVar {
625 sub create {
626 my ($class, $data, $proc, $pad, $index) = @_;
627 my $this = bless [$data, $proc, $pad, $index], $class;
628 return $this;
629 }
630
631 sub TIESCALAR {
632 my ($class, $to) = @_;
633 return $to;
634 }
635
636 sub TIEARRAY {
637 my ($class, $to) = @_;
638 return $to;
639 }
640
641 sub TIEHASH {
642 my ($class, $to) = @_;
643 return $to;
644 }
645
646 for my $method (qw/FETCH STORE FETCHSIZE STORESIZE CLEAR PUSH POP SHIFT UNSHIFT SPLICE EXTEND DELETE EXISTS
647 DESTROY UNTIE FIRSTKEY NEXTKEY SCALAR/) {
648 no strict 'refs';
649 *{"Irssi::Script::perlalias::SharedVar::$method"} = sub {
650 my $this = shift;
651 my ($data, $proc, $pad, $index) = @$this;
652 # Spring the state initializer.
653 $proc->() unless $method eq "DESTROY" || $method eq "UNTIE";
654 $data->$method(@_);
655 }
656 }
657 };
658
659 # Be careful with the array this returns. It is ONLY safe to access indexes linked to scalars!
660 sub get_state_pad {
661 my $sub = shift;
662 assert {defined $sub} "Undefined proc";
663 assert {ref($sub) eq "CODE"} "Not a proc";
664 return B::svref_2object($sub)->PADLIST->ARRAYelt(1)->object_2svref;
665 }
666
667 # Keep the C-style for loop for child-op enumeration in one spot.
668 sub op_kids {
669 my $op = shift;
670 assert {defined $op} "Got an undefined op";
671 assert {$op->UNIVERSAL::isa("B::OP")} "Invalid opcode class";
672 my @kids;
673 if ($op->flags & B::OPf_KIDS) {
674 for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
675 assert { defined $kid } "Undefined kid";
676 push @kids, $kid;
677 }
678 }
679 return @kids;
680 }
681
682 # prototype for a map-like operator, so we can have walk_ops { BLOCK } $op
683 sub walk_ops :prototype(&@) {
684 my $sub = shift;
685 my @ops = @_;
686 my @return;
687 while (scalar @ops) {
688 my $op = shift @ops;
689 assert {defined $op} "Undefined op";
690 assert {$op->UNIVERSAL::isa("B::OP")} "Invalid opcode class";
691 next unless $$op;
692 local $_ = $op;
693 push @return, $sub->();
694 unshift @ops, op_kids $op;
695 }
696 return @return;
697 }
698
699 # Returns the sub, the array for its PAD, and the index of the state variable's control var.
700 # Packs it all into an array that we can shove into %shared_init;
701 sub generate_state_locker {
702 my $sub = sub { state $x = 42; };
703 my $pad = get_state_pad $sub;
704 my ($stateix) = walk_ops {
705 return () unless B::class($_) eq "LOGOP";
706 return () unless $_->name eq 'once';
707 return ($_->targ);
708 } B::svref_2object($sub)->ROOT;
709 return $sub, $pad, $stateix;
710 }
711
712 use constant true => !0;
713 use constant false => !1;
714
715 sub is_op_type {
716 my ($op, $name) = @_;
717 $op->name eq $name and return true;
718 $op->name eq 'null' or return false;
719 return B::ppname($op->targ) eq "pp_$name";
720 }
721
722 sub op_is_sub {
723 my ($pad, $op, $sub) = @_;
724 assert {defined $op} "Undefined op";
725 assert {$op->UNIVERSAL::isa("B::OP")} "Invalid opcode class";
726 if (!is_op_type($op, "rv2cv")) {
727 return false;
728 }
729 assert { ($op->flags & ~B::RV2CVOPCV_FLAG_MASK) == 0 } "Not possible: perl should've paniced already";
730 if ($op->private & B::OPpENTERSUB_AMPER) { return false; }
731 if ($op->flags & B::OPf_KIDS == 0) { return false; }
732 my $rvop = $op->first;
733 my $cv;
734 if (is_op_type($rvop, 'gv') || is_op_type($rvop, 'const')) {
735 if (B::class($rvop) eq "PADOP") {
736 $cv = $pad->ARRAYelt($rvop->padix)->object_2svref;
737 }
738 elsif (B::class($rvop) eq "SVOP") {
739 $cv = $rvop->sv->object_2svref;
740 }
741 else {
742 assert { 0 } "Impossible, class is: " . B::class($rvop);
743 }
744 if (reftype($cv) eq "GLOB") {
745 $cv = *$cv{CODE};
746 }
747 }
748 elsif (is_op_type($rvop, 'padcv')) {
749 return false; # Not needed at this time.
750 }
751 else {
752 return false;
753 }
754 if (reftype($cv) ne "CODE") { return false; }
755 return $cv == $sub;
756 }
757
758 use B::Concise ();
759
760 sub collect_shared_variables {
761 my $package = shift;
762 my $invoke = $package->can("invoke");
763
764 my $invoke_cv = B::svref_2object $invoke;
765 my $invoke_pl = $invoke_cv->PADLIST;
766 my $invoke_pn = $invoke_pl->NAMES;
767
768 my $pad = $invoke_pl->ARRAYelt(1);
769 my $padobj = $pad->object_2svref;
770
771 my sub padname {
772 my $ix = shift;
773 return $invoke_pn->ARRAYelt($ix);
774 }
775
776 my $cop;
777
778 my sub op_die {
779 die sprintf("%s at %s line %d.\n", shift, $cop->file, $cop->line); ## no critic
780 }
781
782 my sub op_assert(&$) {
783 return if $_skip_asserts;
784 my $condition = shift;
785 my $message = shift;
786 return if $condition->();
787 my $concise = "";
788 open my $fd, ">", \$concise;
789 my $prev = B::Concise::walk_output;
790 B::Concise::walk_output $fd;
791 B::Concise::concise_subref(basic => $invoke, "${package}::invoke");
792 B::Concise::walk_output $prev; # Set back to
793 close $fd;
794 Carp::confess sprintf("ASSERT FAILURE: %s at %s line %d.\n%s\n", $message, $cop->file, $cop->line, $concise);
795 }
796
797 my sub register_state {
798 my ($name, $ref, $state_control_index) = @_;
799 op_assert {ref $ref} "Didn't get a reference";
800 # Is there an existing shared state:
801 my $current = $Irssi::Script::perlalias::aliaspkg::shared{$name};
802 unless(defined $current) {
803 # No current state, so we need to create one.
804 my $data;
805 for (substr($name, 0, 1) . ref($ref)) {
806 /^\$SCALAR$/ and do { $data = Tie::StdScalar->TIESCALAR(); }, last;
807 /^\@ARRAY$/ and do { $data = Tie::StdArray->TIEARRAY(); }, last;
808 /^\%HASH$/ and do { $data = Tie::StdHash->TIEHASH(); }, last;
809 op_die "Can't figure out what to do with '$name'";
810 }
811 $current = Irssi::Script::perlalias::SharedVar->create($data, generate_state_locker);
812 $Irssi::Script::perlalias::aliaspkg::shared{$name} = $current;
813 }
814 ref $current eq "Irssi::Script::perlalias::SharedVar" or Carp::confess "Corrupt state in shared table at '$name'";
815 for (ref($ref)) {
816 /^SCALAR$/ and do { tie $$ref, "Irssi::Script::perlalias::SharedVar", $current; }, last;
817 /^ARRAY$/ and do { tie @$ref, "Irssi::Script::perlalias::SharedVar", $current; }, last;
818 /^HASH$/ and do { tie %$ref, "Irssi::Script::perlalias::SharedVar", $current; }, last;
819 op_die "Can't figure out what to do with '$name'";
820 }
821 if (defined $state_control_index) {
822 use feature 'refaliasing';
823 no warnings 'experimental';
824 \($padobj->[$state_control_index]) = \($current->[2]->[$current->[3]]);
825 }
826 }
827
828 # state $x; state @x; state %x;
829 my sub try_basic_state {
830 my $op = shift;
831 if ($op->name eq "padsv" or $op->name eq "padav" or $op->name eq "padhv") {
832 # Correct candidate for a direct variable access. At this point, we return either the name and reference
833 # to the variable or we raise an exception.
834 my $padix = $op->targ;
835 my $pname = padname $padix;
836 my $name = $pname->PVX;
837 my $ref = $pad->ARRAYelt($padix)->object_2svref;
838 # Check that this is a proper introduction
839 unless ($op->private & B::OPpLVAL_INTRO) {
840 op_die "Can't share variable '$name' because of its previous life (are you missing a 'state'?)";
841 }
842 if ($pname->FLAGS & B::PADNAMEt_OUR) {
843 # Sanity check mostly. 'our' variables will look like a global in the optree
844 op_die "Can't share 'our' variable '$name'";
845 }
846 unless ($pname->FLAGS & B::PADNAMEt_STATE) {
847 op_die "Can't share 'my' variable '$name'";
848 }
849 # It's a properly declared state variable, return the name and reference.
850 assert {ref $ref} "B returned something undefined";
851 register_state $name, $ref;
852 return 1;
853 }
854 return "";
855 }
856
857 # state ($x, $y, @x, %y);
858 my sub try_multi_state {
859 my $op = shift;
860 #
861 if (is_op_type $op, 'list') {
862 my @kids = op_kids $op;
863 for my $k (@kids) {
864 $k->name eq 'null' and next;
865 try_basic_state $k or op_die "Invalid multiple-variable state";
866 }
867 return 1;
868 }
869 return "";
870 }
871
872 # state $x = 42;
873 # state @x = (1..5);
874 my sub try_initializer_state {
875 my $op = shift;
876 # Initializers use a null which then goes to a 'once' opcode...
877 if ($op->name eq 'null') {
878 $op = $op->first;
879 # There should be no siblings...
880 return () if $op->sibling->$*;
881 return () unless $op->name eq 'once';
882 my @once_kids = op_kids $op;
883 # once has the following moving parts:
884 # ->targ is the pad index of the control variable:
885 my $control_padix = $op->targ;
886 # It also has three child ops:
887 # The first is a 'null' op for some reason.
888 # The second will be some kind of assignment op. This is the initializer.
889 # The third will ALWAYS be a padsv REGARDLESS OF WHAT KIND OF THING (it's never a padav or padhv).
890 # The third is the variable that was initialized - we'll also see it in the initializer if we went looking.
891 # Because the only thing in perl syntax that generates a 'once' opcode right now is 'state', we can assume
892 # this is what we're dealing with:
893 my $varop = pop @once_kids;
894 op_assert {$varop->name eq 'padsv'} sprintf("Unexpected once child '%s'", $varop->name);
895 #op_die sprintf("Unexpected once child '%s'", $varop->name) unless $varop->name eq 'padsv'; ##### assert
896 my $svix = $varop->targ;
897 my $pname = padname $svix;
898 my $name = $pname->PVX;
899 # Sanity check:
900 if (($pname->FLAGS & (B::PADNAMEt_OUR | B::PADNAMEt_STATE)) != B::PADNAMEt_STATE) {
901 op_die "Unexpected non-state variable"; ##### assert
902 }
903 my $ref = $pad->ARRAYelt($svix)->object_2svref;
904 assert {ref $ref} "B returned something undefined";
905 register_state $name, $ref, $control_padix;
906 return 1;
907 }
908 return "";
909 }
910
911 # Just tries to detect certain incorrect uses of 'shared' to give a more useful error message.
912 my sub nicer_errors {
913 my $op = shift;
914 op_assert {defined $op} "Undefined opcode";
915 if (is_op_type($op, 'rv2sv') || is_op_type($op, 'rv2av') || is_op_type($op, 'rv2hv') || is_op_type($op, 'rv2gv')) {
916 # Possible pattern for a global symbol
917 my $nx = $op->first;
918 if ($nx->name eq 'gvsv' or $nx->name eq 'gv') {
919 # Under multiplicity, gvsv is a PADOP and has ->padix point to a PAD containing the GV
920 # Without, gvsv is an SVOP and has the GV directly.
921 my $gv;
922 if (B::class($nx) eq 'PADOP') {
923 my $gvix = $nx->padix;
924 my $gvslot = $pad->ARRAYelt($gvix);
925 $gv = $gvslot->object_2svref;
926 }
927 else { # B::class($nx) eq 'SVOP'
928 $gv = $op->sv->object_2svref;
929 }
930 my $name = *$gv{NAME};
931 if ($nx->name eq 'gvsv' or $op->name eq 'rv2sv') {
932 $name = '$' . $name;
933 }
934 elsif ($op->name eq 'rv2av') {
935 $name = '@' . $name;
936 }
937 elsif ($op->name eq 'rv2hv') {
938 $name = '%' . $name;
939 }
940 elsif ($op->name eq 'rv2gv') {
941 $name = '*' . $name;
942 }
943 else {
944 return; # Fallback to default message.
945 }
946 if ($op->private & B::OPpOUR_INTRO) { # our statement introduced a global
947 op_die "Can't share 'our' variable '$name'";
948 }
949 else { # Qualified, previously-declared, or 'no strict'
950 op_die "Can't share global symbol '$name'";
951 }
952 }
953 }
954 }
955
956 walk_ops {
957 if (B::class($_) eq "COP") {
958 $cop = $_;
959 return ();
960 }
961 return () unless B::class($_) eq "UNOP";
962 return () unless $_->name eq 'entersub';
963 my @argops = op_kids $_;
964 if (@argops == 1) {
965 @argops = op_kids $_->first;
966 }
967 op_assert {@argops > 1} "What no arguments?";
968 my $subop = pop @argops;
969 # Check if it is the sub shared...
970 return unless op_is_sub($pad, $subop, \&Irssi::Script::perlalias::aliaspkg::shared);
971 # At this point forward, we start triggering exceptions if we find something we don't like.
972 $argops[0]->name eq 'pushmark' and shift @argops;
973 # We want only a single argument.
974 for my $op (@argops) {
975 my ($name, $ref, $state_control_index);
976 try_basic_state($op) and next;
977 try_multi_state($op) and next;
978 try_initializer_state($op) and next;
979 nicer_errors $op;
980 op_die "Invalid use of shared";
981 }
982 } $invoke_cv->ROOT;
983 }
984
985 # Some assorted debugging aids... Use via /script exec I guess.
986 sub dump_aliases {
987 while (my ($alias, $package) = each %alias_packages) {
988 Irssi::print("Alias '$alias' : Package '$package'");
989 no strict 'refs';
990 if ($alias eq ${"${package}::_name"}) {
991 Irssi::print "-> _name is correct";
992 }
993 else {
994 Irssi::print "-> !!! _name is not correct! " . ${"${package}::_name"};
995 }
996 Irssi::print "-> Original code: " . ${"${package}::_text"};
997 if (defined(my $err = ${"${package}::_error"})) {
998 Irssi::print "-> Script did not compile: $err";
999 }
1000 else {
1001 my $cv = "$package"->can("invoke");
1002 Irssi::print "-> PADNAME listing: [index] [name] [flags]";
1003 {
1004 my $cvb = B::svref_2object($cv);
1005 my $cvpl = $cvb->PADLIST;
1006 my $cvpn = $cvpl->NAMES;
1007 for my $ix ( 0 .. $cvpn->MAX) {
1008 my $pn = $cvpn->ARRAYelt($ix);
1009 if ($pn->isa("B::PADNAME")) {
1010 Irssi::print sprintf("[%d] [%s] [%x]", $ix, $pn->PVX//"(null)", $pn->FLAGS);
1011 }
1012 }
1013 }
1014
1015 Irssi::print "-> Concise dump:";
1016 my $concise = "";
1017 open my $fd, ">", \$concise;
1018 my $prev = B::Concise::walk_output;
1019 B::Concise::walk_output $fd;
1020 B::Concise::concise_subref(basic => $cv, "${package}::invoke");
1021 B::Concise::walk_output $prev; # Set back to
1022 Irssi::print $concise;
1023 }
1024 }
1025 }
+319
-0
scripts/print_signals.pl less more
0 # print_signals.pl — Irssi script to help with inspecting signals
1 #
2 # © 2017,2021 martin f. krafft <madduck@madduck.net>
3 # Released under the MIT licence.
4 #
5 ### Usage:
6 #
7 # /script load print_signals
8 #
9 # and then use e.g. tail -F /tmp/irssi_signals.log outside of irssi.
10 #
11 ### Settings:
12 #
13 # /set print_signals_to_file ["/tmp/irssi_signals.log"]
14 # Set the file to which to log all signals and their data
15 #
16 # /set print_signals_limit_regexp [""]
17 # Specify a regexp to limit the signals being captured, e.g. "^window".
18 # Default is no limit.
19 #
20 # # Please note that exclude takes precedence over limit:
21 #
22 # /set print_signals_exclude_regexp ["print text|key press|textbuffer"]
23 # Specify a regexp to exclude signals from being captured. Default is not to
24 # fire on signals about printing text or key presses.
25 #
26 ### Changelog:
27 #
28 # 2021-11-04 v1.2
29 # * Omit signals that cannot be enumerated
30 #
31 # 2021-09-20 v1.1
32 # * Unload signal handlers when script is unloaded
33 # * Update list of signals from upstream
34 #
35 # 2017-02-03 v1.0
36 #
37 # * Initial release.
38 #
39
40 use strict;
41 use warnings;
42 use vars qw($VERSION %IRSSI);
43 use Irssi;
44 use Data::Dumper;
45
46 $VERSION = '1.2';
47
48 %IRSSI = (
49 authors => 'martin f. krafft',
50 contact => 'madduck@madduck.net',
51 name => 'print signals debugger',
52 description => 'hooks into almost every signal and writes the information provided to a file',
53 license => 'MIT',
54 changed => '2021-11-04'
55 );
56
57 Irssi::settings_add_str('print_signals', 'print_signals_to_file', '/tmp/irssi_signals.log');
58 Irssi::settings_add_str('print_signals', 'print_signals_limit_regexp', '');
59 Irssi::settings_add_str('print_signals', 'print_signals_exclude_regexp',
60 'print text|key press|textbuffer|rawlog|log written');
61
62 $Data::Dumper::Sortkeys = 1;
63 $Data::Dumper::Pad = ' ';
64
65 sub signal_handler {
66 my $signal = shift(@_);
67 my $limitre = Irssi::settings_get_str('print_signals_limit_regexp');
68 return unless $signal =~ qr/$limitre/;
69 my $excludere = Irssi::settings_get_str('print_signals_exclude_regexp');
70 return if $signal =~ qr/$excludere/;
71 my @names = shift(@_);
72 my @data = shift(@_);
73 my $outfile = Irssi::settings_get_str('print_signals_to_file');
74 my $fh;
75 if (!open($fh, '>>', $outfile)) {
76 Irssi::print("cannot append to log file $outfile while handling signal '$signal'");
77 return;
78 };
79 print $fh "\n== $signal ==\n";
80 print $fh Data::Dumper->Dump(@data, @names);
81 close($fh);
82 }
83
84 # TODO: a programmatic way to extract the list of all signals from Irssi
85 # itself, along with descriptive names of the arguments.
86 # curl -s https://raw.githubusercontent.com/irssi/irssi/master/docs/signals.txt | sed -rne 's,^ ",",p'
87 my $signals = <<_END;
88 "gui exit"
89 "gui dialog", char *type, char *text
90 "send command", char *command, SERVER_REC, WI_ITEM_REC
91 "chat protocol created", CHAT_PROTOCOL_REC
92 "chat protocol updated", CHAT_PROTOCOL_REC
93 "chat protocol destroyed", CHAT_PROTOCOL_REC
94 "channel created", CHANNEL_REC, int automatic
95 "channel destroyed", CHANNEL_REC
96 "chatnet created", CHATNET_REC
97 "chatnet destroyed", CHATNET_REC
98 "commandlist new", COMMAND_REC
99 "commandlist remove", COMMAND_REC
100 "error command", int err, char *cmd
101 "send command", char *args, SERVER_REC, WI_ITEM_REC
102 "send text", char *line, SERVER_REC, WI_ITEM_REC
103 "command "<cmd>, char *args, SERVER_REC, WI_ITEM_REC
104 "default command", char *args, SERVER_REC, WI_ITEM_REC
105 "ignore created", IGNORE_REC
106 "ignore destroyed", IGNORE_REC
107 "ignore changed", IGNORE_REC
108 "log new", LOG_REC
109 "log remove", LOG_REC
110 "log create failed", LOG_REC
111 "log locked", LOG_REC
112 "log started", LOG_REC
113 "log stopped", LOG_REC
114 "log rotated", LOG_REC
115 "log written", LOG_REC, char *line
116 "module loaded", MODULE_REC, MODULE_FILE_REC
117 "module unloaded", MODULE_REC, MODULE_FILE_REC
118 "module error", int error, char *text, char *rootmodule, char *submodule
119 "tls handshake finished", SERVER_REC, TLS_REC
120 "nicklist new", CHANNEL_REC, NICK_REC
121 "nicklist remove", CHANNEL_REC, NICK_REC
122 "nicklist changed", CHANNEL_REC, NICK_REC, char *old_nick
123 "nicklist host changed", CHANNEL_REC, NICK_REC
124 "nicklist account changed", CHANNEL_REC, NICK_REC, char *account
125 "nicklist gone changed", CHANNEL_REC, NICK_REC
126 "nicklist serverop changed", CHANNEL_REC, NICK_REC
127 "pidwait", int pid, int status
128 "query created", QUERY_REC, int automatic
129 "query destroyed", QUERY_REC
130 "query nick changed", QUERY_REC, char *orignick
131 "window item name changed", WI_ITEM_REC
132 "query address changed", QUERY_REC
133 "query server changed", QUERY_REC, SERVER_REC
134 "rawlog", RAWLOG_REC, char *data
135 "server looking", SERVER_REC
136 "server connected", SERVER_REC
137 "server connecting", SERVER_REC, ulong *ip
138 "server connect failed", SERVER_REC
139 "server disconnected", SERVER_REC
140 "server quit", SERVER_REC, char *msg
141 "server sendmsg", SERVER_REC, char *target, char *msg, int target_type
142 "setup changed"
143 "setup reread", char *fname
144 "setup saved", char *fname, int autosaved
145 "ban type changed", char *bantype
146 "channel joined", CHANNEL_REC
147 "channel wholist", CHANNEL_REC
148 "channel sync", CHANNEL_REC
149 "channel topic changed", CHANNEL_REC
150 "ctcp msg", SERVER_REC, char *args, char *nick, char *addr, char *target
151 "ctcp msg "<cmd>, SERVER_REC, char *args, char *nick, char *addr, char *target
152 "default ctcp msg", SERVER_REC, char *args, char *nick, char *addr, char *target
153 "ctcp reply", SERVER_REC, char *args, char *nick, char *addr, char *target
154 "ctcp reply "<cmd>, SERVER_REC, char *args, char *nick, char *addr, char *target
155 "default ctcp reply", SERVER_REC, char *args, char *nick, char *addr, char *target
156 "ctcp action", SERVER_REC, char *args, char *nick, char *addr, char *target
157 "awaylog show", LOG_REC, int away_msgs, int filepos
158 "server nick changed", SERVER_REC
159 "event connected", SERVER_REC
160 "server cap ack "<cmd>, SERVER_REC
161 "server cap nak "<cmd>, SERVER_REC
162 "server cap new "<cmd>, SERVER_REC
163 "server cap delete "<cmd>, SERVER_REC
164 "server cap end", SERVER_REC
165 "server cap req", SERVER_REC, char *caps
166 "server sasl failure", SERVER_REC, char *reason
167 "server sasl success", SERVER_REC
168 "server event", SERVER_REC, char *data, char *sender_nick, char *sender_address
169 "server event tags", SERVER_REC, char *data, char *sender_nick, char *sender_address, char *tags
170 "event "<cmd>, SERVER_REC, char *args, char *sender_nick, char *sender_address
171 "default event", SERVER_REC, char *data, char *sender_nick, char *sender_address
172 "whois default event", SERVER_REC, char *args, char *sender_nick, char *sender_address
173 "server incoming", SERVER_REC, char *data
174 "redir "<cmd>, SERVER_REC, char *args, char *sender_nick, char *sender_address
175 "server lag", SERVER_REC
176 "server lag disconnect", SERVER_REC
177 "massjoin", CHANNEL_REC, GSList of NICK_RECs
178 "ban new", CHANNEL_REC, BAN_REC
179 "ban remove", CHANNEL_REC, BAN_REC, char *setby
180 "channel mode changed", CHANNEL_REC, char *setby
181 "nick mode changed", CHANNEL_REC, NICK_REC, char *setby, char *mode, char *type
182 "user mode changed", SERVER_REC, char *old
183 "away mode changed", SERVER_REC
184 "netsplit server new", SERVER_REC, NETSPLIT_SERVER_REC
185 "netsplit server remove", SERVER_REC, NETSPLIT_SERVER_REC
186 "netsplit new", NETSPLIT_REC
187 "netsplit remove", NETSPLIT_REC
188 "dcc ctcp "<cmd>, char *args, DCC_REC
189 "default dcc ctcp", char *args, DCC_REC
190 "dcc unknown ctcp", char *args, char *sender, char *sendaddr
191 "dcc reply "<cmd>, char *args, DCC_REC
192 "default dcc reply", char *args, DCC_REC
193 "dcc unknown reply", char *args, char *sender, char *sendaddr
194 "dcc chat message", DCC_REC, char *msg
195 "dcc created", DCC_REC
196 "dcc destroyed", DCC_REC
197 "dcc connected", DCC_REC
198 "dcc rejecting", DCC_REC
199 "dcc closed", DCC_REC
200 "dcc request", DCC_REC, char *sendaddr
201 "dcc request send", DCC_REC
202 "dcc chat message", DCC_REC, char *msg
203 "dcc transfer update", DCC_REC
204 "dcc get receive", DCC_REC
205 "dcc error connect", DCC_REC
206 "dcc error file create", DCC_REC, char *filename
207 "dcc error file open", char *nick, char *filename, int errno
208 "dcc error get not found", char *nick
209 "dcc error send exists", char *nick, char *filename
210 "dcc error unknown type", char *type
211 "dcc error close not found", char *type, char *nick, char *filename
212 "autoignore new", SERVER_REC, AUTOIGNORE_REC
213 "autoignore remove", SERVER_REC, AUTOIGNORE_REC
214 "flood", SERVER_REC, char *nick, char *host, int level, char *target
215 "notifylist new", NOTIFYLIST_REC
216 "notifylist remove", NOTIFYLIST_REC
217 "notifylist joined", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
218 "notifylist away changed", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
219 "notifylist left", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
220 "proxy client connecting", CLIENT_REC
221 "proxy client connected", CLIENT_REC
222 "proxy client disconnected", CLIENT_REC
223 "proxy client command", CLIENT_REC, char *args, char *data
224 "proxy client dump", CLIENT_REC, char *data
225 "gui print text", WINDOW_REC, int fg, int bg, int flags, char *text, TEXT_DEST_REC
226 "gui print text finished", WINDOW_REC, TEXT_DEST_REC
227 "complete word", GList * of char *s, WINDOW_REC, char *word, char *linestart, int *want_space
228 "irssi init read settings"
229 "exec new", PROCESS_REC
230 "exec remove", PROCESS_REC, int status
231 "exec input", PROCESS_REC, char *text
232 "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
233 "message private", SERVER_REC, char *msg, char *nick, char *address, char *target
234 "message own_public", SERVER_REC, char *msg, char *target
235 "message own_private", SERVER_REC, char *msg, char *target, char *orig_target
236 "message join", SERVER_REC, char *channel, char *nick, char *address, char *account, char *realname
237 "message part", SERVER_REC, char *channel, char *nick, char *address, char *reason
238 "message quit", SERVER_REC, char *nick, char *address, char *reason
239 "message kick", SERVER_REC, char *channel, char *nick, char *kicker, char *address, char *reason
240 "message nick", SERVER_REC, char *newnick, char *oldnick, char *address
241 "message own_nick", SERVER_REC, char *newnick, char *oldnick, char *address
242 "message invite", SERVER_REC, char *channel, char *nick, char *address
243 "message invite_other", SERVER_REC, char *channel, char *invited, char *nick, char *address
244 "message topic", SERVER_REC, char *channel, char *topic, char *nick, char *address
245 "message host_changed", SERVER_REC, char *nick, char *newaddress, char *oldaddress
246 "message account_changed", SERVER_REC, char *nick, char *address, char *account
247 "message away_notify", SERVER_REC, char *nick, char *address, char *awaymsg
248 "keyinfo created", KEYINFO_REC
249 "keyinfo destroyed", KEYINFO_REC
250 "print text", TEXT_DEST_REC *dest, char *text, char *stripped
251 "print format", THEME_REC *theme, char *module, TEXT_DEST_REC *dest, formatnum_args
252 "print noformat", TEXT_DEST_REC *dest, char *text
253 "theme created", THEME_REC
254 "theme destroyed", THEME_REC
255 "window hilight", WINDOW_REC
256 "window hilight check", TEXT_DEST_REC, char *msg, int *data_level, int *should_ignore
257 "window dehilight", WINDOW_REC
258 "window activity", WINDOW_REC, int old_level
259 "window item hilight", WI_ITEM_REC
260 "window item activity", WI_ITEM_REC, int old_level
261 "window item new", WINDOW_REC, WI_ITEM_REC
262 "window item remove", WINDOW_REC, WI_ITEM_REC
263 "window item moved", WINDOW_REC, WI_ITEM_REC, WINDOW_REC
264 "window item changed", WINDOW_REC, WI_ITEM_REC
265 "window item server changed", WINDOW_REC, WI_ITEM_REC
266 "window created", WINDOW_REC
267 "window destroyed", WINDOW_REC
268 "window changed", WINDOW_REC, WINDOW_REC old
269 "window changed automatic", WINDOW_REC
270 "window server changed", WINDOW_REC, SERVER_REC
271 "window refnum changed", WINDOW_REC, int old
272 "window name changed", WINDOW_REC
273 "window history changed", WINDOW_REC, char *oldname
274 "window level changed", WINDOW_REC
275 "default event numeric", SERVER_REC, char *data, char *nick, char *address
276 "message irc op_public", SERVER_REC, char *msg, char *nick, char *address, char *target
277 "message irc own_wall", SERVER_REC, char *msg, char *target
278 "message irc own_action", SERVER_REC, char *msg, char *target
279 "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
280 "message irc own_notice", SERVER_REC, char *msg, char *target
281 "message irc notice", SERVER_REC, char *msg, char *nick, char *address, char *target
282 "message irc own_ctcp", SERVER_REC, char *cmd, char *data, char *target
283 "message irc ctcp", SERVER_REC, char *cmd, char *data, char *nick, char *address, char *target
284 "message irc mode", SERVER_REC, char *channel, char *nick, char *addr, char *mode
285 "message dcc own", DCC_REC *dcc, char *msg
286 "message dcc own_action", DCC_REC *dcc, char *msg
287 "message dcc own_ctcp", DCC_REC *dcc, char *cmd, char *data
288 "message dcc", DCC_REC *dcc, char *msg
289 "message dcc action", DCC_REC *dcc, char *msg
290 "message dcc ctcp", DCC_REC *dcc, char *cmd, char *data
291 "gui key pressed", int key
292 "beep"
293 "gui print text after finished", WINDOW_REC, LINE_REC *line, LINE_REC *prev_line, TEXT_DEST_REC
294 "gui textbuffer line removed", TEXTBUFFER_VIEW_REC *view, LINE_REC *line, LINE_REC *prev_line
295 "otr event", SERVER_REC, char *nick, char *status
296 _END
297
298 my %handlers = ();
299
300 sub load {
301 foreach my $sigline (split(/\n/, $signals)) {
302 my ($sig, @args) = split(/, /, $sigline);
303 $sig =~ y/"//d;
304 next if ( $sig =~ m/<.*>/ );
305 my $handler = sub { signal_handler($sig, \@args, \@_); };
306 Irssi::signal_add_first($sig, $handler);
307 $handlers{$sig} = $handler;
308 }
309 }
310
311 sub UNLOAD {
312 while (my ($sig, $handler) = each %handlers) {
313 Irssi::signal_remove($sig, $handler);
314 }
315 %handlers = ();
316 }
317
318 load();
+46
-123
scripts/query.pl less more
0 # query - irssi 0.8.4.CVS
10 #
2 # $Id: query.pl,v 1.24 2009/03/29 12:23:10 peder Exp $
3 #
4 # Copyright (C) 2001, 2002, 2004, 2007 by Peder Stray <peder@ninja.no>
1 # Copyright (C) 2001-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
107 use Text::Abbrev;
118 use POSIX;
129
13 #use Data::Dumper;
14
15 # ======[ Script Header ]===============================================
16
1710 use vars qw{$VERSION %IRSSI};
18 ($VERSION) = '$Revision: 1.25 $' =~ / (\d+\.\d+) /;
11 ($VERSION) = '$Revision: 1.26.1 $' =~ / (\d+(\.\d+)+) /;
1912 %IRSSI = (
2013 name => 'query',
2114 authors => 'Peder Stray',
22 contact => 'peder@ninja.no',
23 url => 'http://ninja.no/irssi/query.pl',
15 contact => 'peder.stray@gmail.com',
16 url => 'https://github.com/pstray/irssi-query',
2417 license => 'GPL',
2518 description => 'Give you more control over when to jump to query windows and when to just tell you one has been created. Enhanced autoclose.',
2619 );
2720
28 # ======[ Variables ]===================================================
29
3021 use vars qw(%state);
3122 *state = \%Query::state; # used for tracking idletime and state
3223
3425 my(%defaults); # used for storing defaults
3526 my($query_opts) = {}; # stores option abbrevs
3627
37 # ======[ Helper functions ]============================================
38
39 # --------[ load_defaults ]---------------------------------------------
40
4128 sub load_defaults {
4229 my $file = Irssi::get_irssi_dir."/query";
4330 local *FILE;
4431
4532 %defaults = ();
46 open FILE, '<',$file;
33 open FILE, "<", $file;
4734 while (<FILE>) {
4835 my($mask,$maxage,$immortal) = split;
4936 $defaults{$mask}{maxage} = $maxage;
5239 close FILE;
5340 }
5441
55 # --------[ save_defaults ]---------------------------------------------
56
5742 sub save_defaults {
5843 my $file = Irssi::get_irssi_dir."/query";
5944 local *FILE;
6045
61 open FILE, '>', $file;
46 open FILE, ">", $file;
6247 for (keys %defaults) {
6348 my $d = $defaults{$_};
64 print FILE join("\t", $_,
49 print FILE join("\t", $_,
6550 exists $d->{maxage} ? $d->{maxage} : -1,
6651 exists $d->{immortal} ? $d->{immortal} : -1,
6752 ), "\n";
6853 }
6954 close FILE;
7055 }
71
72 # --------[ sec2str ]---------------------------------------------------
7356
7457 sub sec2str {
7558 my($sec) = @_;
8467
8568 $ret = ($sec%24)."h ".$ret;
8669 $sec /= 24;
87
70
8871 $ret = $sec."d ".$ret;
89
72
9073 $ret =~ s/\b0[dhms] //g;
9174 $ret =~ s/ $//;
92
75
9376 return $ret;
9477 }
95
96 # --------[ str2sec ]---------------------------------------------------
9778
9879 sub str2sec {
9980 my($str) = @_;
11798 return $str;
11899 }
119100
120 # --------[ set_defaults ]----------------------------------------------
121
122101 sub set_defaults {
123102 my($serv,$nick,$address) = @_;
124103 my $tag = lc $serv->{tag};
125
104
126105 return unless $address;
127106 $state{$tag}{$nick}{address} = $address;
128107
136115 }
137116 }
138117
139 # --------[ time2str ]--------------------------------------------------
140
141118 sub time2str {
142119 my($time) = @_;
143120 return strftime("%c", localtime $time);
144121 }
145
146 # --------[ userhost_cmp ]----------------------------------------------
147122
148123 sub userhost_cmp {
149124 my($serv, $am, $bm) = @_;
178153
179154 }
180155
181 # ======[ Signal Hooks ]================================================
182
183 # --------[ sig_message_own_private ]-----------------------------------
184
185156 sub sig_message_own_private {
186157 my($server,$msg,$nick,$orig_target) = @_;
187158 $own = $nick;
188159 }
189160
190 # --------[ sig_message_private ]---------------------------------------
191
192161 sub sig_message_private {
193162 my($server,$msg,$nick,$addr) = @_;
194163 undef $own;
195164 }
196165
197 # --------[ sig_print_message ]-----------------------------------------
198
199166 sub sig_print_message {
200167 my($dest, $text, $strip) = @_;
201
168
202169 return unless $dest->{level} & MSGLEVEL_MSGS;
203170
204 my $server = $dest->{server};
171 my $server = $dest->{server};
205172
206173 return unless $server;
207174
213180 $state{$tag}{$witem->{name}}{time} = time;
214181 }
215182
216 # --------[ sig_query_address_changed ]---------------------------------
217
218183 sub sig_query_address_changed {
219184 my($query) = @_;
220185
221186 set_defaults($query->{server}, $query->{name}, $query->{address});
222187
223188 }
224
225 # --------[ sig_query_created ]-----------------------------------------
226189
227190 sub sig_query_created {
228191 my ($query, $auto) = @_;
248211 $qwin->set_active();
249212 } else {
250213 $awin->printformat(MSGLEVEL_CLIENTCRAP, 'query_created',
251 $nick, $query->{server_tag},
214 $nick, $query->{server_tag},
252215 $qwin->{refnum})
253216 if Irssi::settings_get_bool('query_noisy');
254217 }
258221
259222 $state{$tag}{$nick} = { time => time };
260223
261 $serv->redirect_event('userhost', 1, ":$nick", -1, undef,
262 {
263 "event 302" => "redir query userhost",
264 "" => "event empty",
265 });
266 $serv->send_raw("USERHOST :$nick");
267 }
268
269 # --------[ sig_query_destroyed ]---------------------------------------
224 if (ref($serv) eq 'Irssi::Irc::Server') {
225 $serv->redirect_event('userhost', 1, ":$nick", -1, undef,
226 {
227 "event 302" => "redir query userhost",
228 "" => "event empty",
229 });
230 $serv->send_raw("USERHOST :$nick");
231 }
232 }
270233
271234 sub sig_query_destroyed {
272235 my($query) = @_;
273236
274237 delete $state{lc $query->{server_tag}}{$query->{name}};
275238 }
276
277
278 # --------[ sig_query_nick_changed ]------------------------------------
279239
280240 sub sig_query_nick_changed {
281241 my($query,$old_nick) = @_;
283243
284244 $state{$tag}{$query->{name}} = delete $state{$tag}{$old_nick};
285245 }
286
287 # --------[ sig_redir_query_userhost ]----------------------------------
288246
289247 sub sig_redir_query_userhost {
290248 my($serv,$data) = @_;
297255 }
298256 }
299257
300 # --------[ sig_session_restore ]---------------------------------------
301
302258 sub sig_session_restore {
303 open STATE, sprintf "< %s/query.state", Irssi::get_irssi_dir;
259 open STATE, "<", sprintf "%s/query.state", Irssi::get_irssi_dir;
304260 %state = (); # only needed if bound as command
305261 while (<STATE>) {
306262 chomp;
312268 close STATE;
313269 }
314270
315 # --------[ sig_session_save ]------------------------------------------
316
317271 sub sig_session_save {
318 open STATE, sprintf "> %s/query.state", Irssi::get_irssi_dir;
272 open STATE, ">", sprintf "%s/query.state", Irssi::get_irssi_dir;
319273 for my $tag (keys %state) {
320274 for my $nick (keys %{$state{$tag}}) {
321275 print STATE join("\t",$tag,$nick,%{$state{$tag}{$nick}}), "\n";
323277 }
324278 close STATE;
325279 }
326
327 # ======[ Timers ]======================================================
328
329 # --------[ check_queries ]---------------------------------------------
330280
331281 sub check_queries {
332282 my(@queries) = Irssi::queries;
354304 # not old enough
355305 next if $age < $maxage;
356306
357 # unseen messages
307 # unseen messages
358308 next if $query->{data_level} > 1;
359309
360310 # active window
361 next if $query->is_active &&
311 next if $query->is_active &&
362312 $query->window->{refnum} == $win->{refnum};
363313
364314 # graceperiod
373323 }
374324 }
375325
376 # ======[ Commands ]====================================================
377
378 # --------[ cmd_query ]-------------------------------------------------
379
380326 sub cmd_query {
381327 my($data,$server,$witem) = @_;
382328 my(@data) = split " ", $data;
394340
395341 if ($opt eq 'window') {
396342 push @opts, "-$param";
397
343
398344 } elsif ($opt eq 'immortal') {
399345 $state->{immortal} = 1;
400
346
401347 } elsif ($opt eq 'info') {
402348 $info = 1;
403
349
404350 } elsif ($opt eq 'mortal') {
405351 $state->{immortal} = 0;
406
352
407353 } elsif ($opt eq 'timeout') {
408354 $state->{maxage} = str2sec shift @data;
409355
414360 # unhandled known opt
415361
416362 }
417
363
418364 } elsif ($tag = Irssi::server_find_tag($param)) {
419365 $tag = $tag->{tag};
420366 push @opts, "-$tag";
428374 } else {
429375 # normal parameter
430376 push @params, $param;
431
377
432378 }
433379 }
434380
472418 } else {
473419 $timeout .= " (Off)";
474420 }
475
421
476422 @items = (
477423 Server => $query->{server_tag},
478424 Nick => $nick,
482428 Timeout => $timeout,
483429 Idle => sec2str(time - $state->{time}),
484430 );
485
431
486432 $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info_header');
487433 while (($key,$val) = splice @items, 0, 2) {
488434 $query->printformat(MSGLEVEL_CLIENTCRAP, 'query_info',
502448 return;
503449 }
504450
505 my $mask = Irssi::Irc::get_mask($nick, $state->{address},
506 Irssi::Irc::MASK_USER |
451 my $mask = Irssi::Irc::get_mask($nick, $state->{address},
452 Irssi::Irc::MASK_USER |
507453 Irssi::Irc::MASK_DOMAIN
508454 );
509455
525471 return if $opts;
526472
527473 if ($state{$tag}{$nick}{immortal}) {
528 $witem->printformat(MSGLEVEL_CLIENTCRAP,
474 $witem->printformat(MSGLEVEL_CLIENTCRAP,
529475 'query_crap', 'This query is immortal');
530476 } else {
531477 $witem->command("unquery")
538484
539485 }
540486
541 # --------[ cmd_unquery ]-----------------------------------------------
542
543487 sub cmd_unquery {
544488 my($data,$server,$witem) = @_;
545489 my($param) = split " ", $data;
557501
558502 if ($state{$tag}{$nick}{immortal}) {
559503 if ($param) {
560 $witem->printformat(MSGLEVEL_CLIENTCRAP,
561 'query_crap',
504 $witem->printformat(MSGLEVEL_CLIENTCRAP,
505 'query_crap',
562506 "Query with $nick is immortal");
563507 } else {
564 $witem->printformat(MSGLEVEL_CLIENTCRAP,
565 'query_crap',
508 $witem->printformat(MSGLEVEL_CLIENTCRAP,
509 'query_crap',
566510 'This query is immortal');
567511 }
568512 Irssi::signal_stop;
569513 }
570514 }
571515 }
572
573 # ======[ Setup ]=======================================================
574
575 # --------[ Register commands ]-----------------------------------------
576516
577517 Irssi::command_bind('query', 'cmd_query');
578518 Irssi::command_bind('unquery', 'cmd_unquery');
583523 #Irssi::command_bind('query_save', 'sig_session_save');
584524 #Irssi::command_bind('query_restore', 'sig_session_restore');
585525
586 # --------[ Register formats ]------------------------------------------
587
588526 Irssi::theme_register(
589527 [
590528 'query_created',
608546
609547 ]);
610548
611 # --------[ Register settings ]-----------------------------------------
612
613549 Irssi::settings_add_bool('query', 'query_autojump_own', 1);
614550 Irssi::settings_add_bool('query', 'query_autojump', 0);
615551 Irssi::settings_add_bool('query', 'query_noisy', 1);
616 Irssi::settings_add_bool('query', 'query_unqueries',
617 Irssi::version < 20020919.1507 ||
552 Irssi::settings_add_bool('query', 'query_unqueries',
553 Irssi::version < 20020919.1507 ||
618554 Irssi::version >= 20021006.1620 );
619555
620556 Irssi::settings_add_time('query', 'query_autoclose', 0);
621557 Irssi::settings_add_time('query', 'query_autoclose_grace', '5min');
622
623 # --------[ Register signals ]------------------------------------------
624558
625559 Irssi::signal_add_last('message own_private', 'sig_message_own_private');
626560 Irssi::signal_add_last('message private', 'sig_message_private');
638572 Irssi::signal_add('session save', 'sig_session_save');
639573 Irssi::signal_add('session restore', 'sig_session_restore');
640574
641 # --------[ Register timers ]-------------------------------------------
642
643575 Irssi::timeout_add(5000, 'check_queries', undef);
644
645 # ======[ Initialization ]==============================================
646576
647577 load_defaults;
648578
650580 my($tag) = lc $query->{server_tag};
651581 my($nick) = $query->{name};
652582
653 $state{$tag}{$nick}{time}
583 $state{$tag}{$nick}{time}
654584 ||= $query->{last_unread_msg} || $query->{createtime} || time;
655
585
656586 set_defaults($query->{server}, $nick, $query->{address});
657587 }
658588
660590 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'query_warn',
661591 "autoclose_query is set, please set to 0");
662592 }
663
664 # ======[ END ]=========================================================
665
666 # Local Variables:
667 # header-initial-hide: t
668 # mode: header-minor
669 # end:
+4
-4
scripts/randname.pl less more
0 # RandName 1.0
0 # RandName 1.1
11 #
22 # set a random real name taken from a file
33 #
77 use Irssi;
88 use vars qw($VERSION %IRSSI);
99
10 $VERSION = '1.0';
10 $VERSION = '1.1';
1111 %IRSSI = (
1212 authors => 'legion',
1313 contact => 'a.lepore(at)email.it',
1919
2020 sub randname {
2121
22 my $namefile = glob Irssi::settings_get_str('random_realname_file');
22 my $namefile = (glob Irssi::settings_get_str('random_realname_file'))[0];
2323
2424 open (FILE, "<", $namefile) || return;
2525 my $lines = 0; while(<FILE>) { $lines++; };
3333 $realname = $_;
3434 last;
3535 }
36 close(f);
36 close(FILE);
3737
3838 Irssi::print("%9RandName.pl%_:", MSGLEVEL_CRAP);
3939 Irssi::command("set real_name $realname");
+232
-148
scripts/spellcheck.pl less more
0 #!/usr/bin/perl -w
1
2 # ** This script is a 10-minutes-hack, so it's EXPERIMENTAL. **
0 # Copyright © 2008 Jakub Jankowski <shasta@toxcorp.com>
1 # Copyright © 2012-2020 Jakub Wilk <jwilk@jwilk.net>
2 # Copyright © 2012 Gabriel Pettier <gabriel.pettier@gmail.com>
33 #
4 # Requires:
5 # - Irssi 0.8.12 or newer (http://irssi.org/).
6 # - GNU Aspell with appropriate dictionaries (http://aspell.net/).
7 # - Perl module Text::Aspell (available from CPAN).
4 # This program is free software; you can redistribute it and/or modify
5 # it under the terms of the GNU General Public License as published by
6 # the Free Software Foundation; version 2 dated June, 1991.
87 #
9 #
10 # Description:
11 # Works as you type, printing suggestions when Aspell thinks
12 # your last word was misspelled.
13 # It also adds suggestions to the list of tabcompletions,
14 # so once you know last word is wrong, you can go back
15 # and tabcomplete through what Aspell suggests.
16 #
17 #
18 # Settings:
19 #
20 # spellcheck_languages -- a list of space and/or comma
21 # separated languages to use on certain networks/channels.
22 # Example:
23 # /set spellcheck_languages netA/#chan1/en_US, #chan2/fi_FI, netB/!chan3/pl_PL
24 # will use en_US for #chan1 on network netA, fi_FI for #chan2
25 # on every network, and pl_PL for !chan3 on network netB.
26 # By default this setting is empty.
27 #
28 # spellcheck_default_language -- language to use in empty
29 # windows, or when nothing from spellcheck_languages matches.
30 # Defaults to 'en_US'.
31 #
32 # spellcheck_enabled [ON/OFF] -- self explaining. Sometimes
33 # (like when pasting foreign-language text) you don't want
34 # the script to spit out lots of suggestions, and turning it
35 # off for a while is the easiest way. By default it's ON.
36 #
37 #
38 # BUGS:
39 # - won't catch all mistakes
40 # - picking actual words from what you type is very kludgy,
41 # you may occasionally see some leftovers like digits or punctuation
42 # - works every time you press space or a dot (so won't work for
43 # the last word before pressing enter, unless you're using dot
44 # to finish your sentences)
45 # - when you press space and realize that the word is wrong,
46 # you can't tabcomplete to the suggestions right away - you need
47 # to use backspace and then tabcomplete. With dot you get an extra
48 # space after tabcompletion.
49 # - all words will be marked and no suggestions given if
50 # dictionary is missing (ie. wrong spellcheck_default_language)
51 # - probably more, please report to $IRSSI{'contact'}
52 #
53 #
54 # $Id: spellcheck.pl 5 2008-05-28 22:31:06Z shasta $
55 #
8 # This program is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 # General Public License for more details.
5612
5713 use strict;
14 use warnings;
15
5816 use vars qw($VERSION %IRSSI);
5917 use Irssi 20070804;
18 use Irssi::TextUI;
19 use Encode;
6020 use Text::Aspell;
6121
62 $VERSION = '0.4';
22 $VERSION = '0.9.1';
6323 %IRSSI = (
64 authors => 'Jakub Jankowski',
65 contact => 'shasta@toxcorp.com',
66 name => 'Spellcheck',
67 description => 'Checks for spelling errors using Aspell.',
24 authors => 'Jakub Wilk, Jakub Jankowski, Gabriel Pettier, Nei',
25 name => 'spellcheck',
26 description => 'checks for spelling errors using Aspell',
6827 license => 'GPLv2',
69 url => 'http://toxcorp.com/irc/irssi/spellcheck/',
28 url => 'http://jwilk.net/software/irssi-spellcheck',
7029 );
7130
7231 my %speller;
7332
7433 sub spellcheck_setup
7534 {
76 return if (exists $speller{$_[0]} && defined $speller{$_[0]});
77 $speller{$_[0]} = Text::Aspell->new or return undef;
78 $speller{$_[0]}->set_option('lang', $_[0]) or return undef;
79 $speller{$_[0]}->set_option('sug-mode', 'fast') or return undef;
80 return 1;
35 my ($lang) = @_;
36 my $speller = $speller{$lang};
37 return $speller if defined $speller;
38 $speller = Text::Aspell->new or return;
39 $speller->set_option('lang', $lang) or return;
40 $speller->set_option('sug-mode', 'fast') or return;
41 $speller{$lang} = $speller;
42 return $speller;
8143 }
8244
8345 # add_rest means "add (whatever you chopped from the word before
84 # spellchecking it) to the suggestions returned"
46 # spell-checking it) to the suggestions returned"
8547 sub spellcheck_check_word
8648 {
87 my ($lang, $word, $add_rest) = @_;
49 my ($langs, $word, $add_rest) = @_;
8850 my $win = Irssi::active_win();
89 my @suggestions = ();
90
91 # setup Text::Aspell for that lang if needed
92 if (!exists $speller{$lang} || !defined $speller{$lang})
93 {
94 if (!spellcheck_setup($lang))
95 {
96 $win->print("Error while setting up spellchecker for $lang");
97 # don't change the message
98 return @suggestions;
99 }
100 }
101
102 # do the spellchecking
103 my ($stripped, $rest) = $word =~ /([^[:punct:][:digit:]]{2,})(.*)/; # HAX
104 # Irssi::print("Debug: stripped $word is '$stripped', rest is '$rest'");
105 if (defined $stripped && !$speller{$lang}->check($stripped))
106 {
107 push(@suggestions, $add_rest ? $_ . $rest : $_) for ($speller{$lang}->suggest($stripped));
108 }
109 return @suggestions;
110 }
111
112 sub spellcheck_find_language
51 my $prefix = '';
52 my $suffix = '';
53
54 my @langs = split(/[+]/, $langs);
55 for my $lang (@langs) {
56 my $speller = spellcheck_setup($lang);
57 if (not defined $speller) {
58 $win->print('%R' . "Error while setting up spell-checker for $lang" . '%N', MSGLEVEL_CLIENTERROR);
59 return;
60 }
61 }
62
63 return if $word =~ m{^/}; # looks like a path
64 $word =~ s/^([[:punct:]]*)//; # strip leading punctuation characters
65 $prefix = $1 if $add_rest;
66 $word =~ s/([[:punct:]]*)$//; # ...and trailing ones, too
67 $suffix = $1 if $add_rest;
68 return if $word =~ m{^\w+://}; # looks like a URL
69 return if $word =~ m{^[^@]+@[^@]+$}; # looks like an e-mail
70 return if $word =~ m{^[[:digit:][:punct:]]+$}; # looks like a number
71
72 my @result;
73 for my $lang (@langs) {
74 my $ok = $speller{$lang}->check($word);
75 if (not defined $ok) {
76 $win->print('%R' . "Error while spell-checking for $lang" . '%N', MSGLEVEL_CLIENTERROR);
77 return;
78 }
79 if ($ok) {
80 return;
81 } else {
82 push @result, map { "$prefix$_$suffix" } $speller{$lang}->suggest($word);
83 }
84 }
85 return \@result;
86 }
87
88 sub _spellcheck_find_language
11389 {
11490 my ($network, $target) = @_;
11591 return Irssi::settings_get_str('spellcheck_default_language') unless (defined $network && defined $target);
12298 $target = lc($target);
12399
124100 # possible settings: network/channel/lang or channel/lang
125 my @languages = split(/[ ,]/, Irssi::settings_get_str('spellcheck_languages'));
126 for my $langstr (@languages)
127 {
128 # strip trailing slashes
129 $langstr =~ s=/+$==;
130 # Irssi::print("Debug: checking network $network target $target against langstr $langstr");
131 my ($s1, $s2, $s3) = split(/\//, $langstr, 3);
132 my ($t, $c, $l);
133 if (defined $s3 && $s3 ne '')
134 {
135 # network/channel/lang
136 $t = lc($s1); $c = lc($s2); $l = $s3;
137 }
138 else
139 {
140 # channel/lang
141 $c = lc($s1); $l = $s2;
142 }
143
144 if ($c eq $target && (!defined $t || $t eq $network))
145 {
146 # Irssi::print("Debug: language found: $l");
147 return $l;
148 }
149 }
150
151 # Irssi::print("Debug: language not found, using default");
101 my @languages = split(/[ ,]+/, Irssi::settings_get_str('spellcheck_languages'));
102 for my $langstr (@languages) {
103 my ($t, $c, $l) = $langstr =~ m{^(?:([^/]+)/)?([^/]+)/([^/]+)/*$};
104 $t //= $network;
105 if (lc($c) eq $target and lc($t) eq $network) {
106 return $l;
107 }
108 }
109
152110 # no match, use defaults
153111 return Irssi::settings_get_str('spellcheck_default_language');
154112 }
155113
114 sub spellcheck_find_language
115 {
116 my ($win) = @_;
117 return _spellcheck_find_language(
118 $win->{active_server}->{tag},
119 $win->{active}->{name}
120 );
121 }
122
156123 sub spellcheck_key_pressed
157124 {
158125 my ($key) = @_;
159126 my $win = Irssi::active_win();
160127
161 # I know no way to *mark* misspelled words in the input line,
162 # that's why there's no spellcheck_print_suggestions -
163 # because printing suggestions is our only choice.
128 my $correction_window;
129 my $window_height;
130
131 my $window_name = Irssi::settings_get_str('spellcheck_window_name');
132 if ($window_name ne '') {
133 $correction_window = Irssi::window_find_name($window_name);
134 $window_height = Irssi::settings_get_str('spellcheck_window_height');
135 }
136
164137 return unless Irssi::settings_get_bool('spellcheck_enabled');
165138
166 # don't bother unless pressed key is space or dot
167 return unless (chr $key eq ' ' or chr $key eq '.');
139 # hide correction window when message is sent
140 if (chr($key) =~ /\A[\r\n]\z/ && $correction_window) {
141 $correction_window->command("^window hide $window_name");
142 if (Irssi->can('gui_input_clear_extents')) {
143 Irssi::gui_input_clear_extents(0, 9999);
144 }
145 }
168146
169147 # get current inputline
170148 my $inputline = Irssi::parse_special('$L');
149 my $utf8 = lc Irssi::settings_get_str('term_charset') eq 'utf-8';
150 if ($utf8) {
151 Encode::_utf8_on($inputline);
152 }
153
154 # ensure that newly added characters are not colored
155 # when correcting a colored word
156 # FIXME: this works at EOL, but not elsewhere
157 if (Irssi->can('gui_input_set_extent')) {
158 Irssi::gui_input_set_extent(length $inputline, '%n');
159 }
160
161 # don't bother unless pressed key is space
162 # or a terminal punctuation mark
163 return unless grep { chr $key eq $_ } (' ', qw(. ? !));
164
165 $inputline = substr $inputline, 0, Irssi::gui_input_get_pos();
171166
172167 # check if inputline starts with any of cmdchars
173 # we shouldn't spellcheck commands
168 # we shouldn't spell-check commands
169 # (except /SAY and /ME)
174170 my $cmdchars = Irssi::settings_get_str('cmdchars');
175 my $cmdre = qr/^[$cmdchars]/;
176 return if ($inputline =~ $cmdre);
171 my $re = qr{^(?:
172 [\Q$cmdchars\E] (?i: say | me ) \s* \S |
173 [^\Q$cmdchars\E]
174 )}x;
175 return if ($inputline !~ $re);
177176
178177 # get last bit from the inputline
179 my ($word) = $inputline =~ /\s*([^\s]+)$/;
180
181 # do not spellcheck urls
182 my $urlre = qr/(^[a-zA-Z]+:\/\/\S+)|(^www)/;
183 return if ($word =~ $urlre);
184
185 # find appropriate language for current window item
186 my $lang = spellcheck_find_language($win->{active_server}->{tag}, $win->{active}->{name});
187
188 my @suggestions = spellcheck_check_word($lang, $word, 0);
189 # Irssi::print("Debug: spellcheck_check_word($word) returned array of " . scalar @suggestions);
190 return if (scalar @suggestions == 0);
178 my ($word) = $inputline =~ /\s*(\S+)\s*$/;
179 defined $word or return;
180
181 # remove color from the last word
182 # (we will add it back later if needed)
183 my $start = $-[1];
184 if (Irssi->can('gui_input_clear_extents')) {
185 Irssi::gui_input_clear_extents($start, length $word);
186 }
187
188 my $lang = spellcheck_find_language($win);
189
190 return if $lang eq 'und';
191
192 my $suggestions = spellcheck_check_word($lang, $word, 0);
193
194 return unless defined $suggestions;
195
196 # strip leading and trailing punctuation
197 $word =~ s/^([[:punct:]]+)// and $start += length $1;
198 $word =~ s/[[:punct:]]+$//;
199
200 # add color to the misspelled word
201 my $color = Irssi::settings_get_str('spellcheck_word_input_color');
202 if ($color && Irssi->can('gui_input_set_extents')) {
203 Irssi::gui_input_set_extents($start, length $word, $color, '%n');
204 }
205
206 return unless Irssi::settings_get_bool('spellcheck_print_suggestions');
207
208 # show corrections window if hidden
209 if ($correction_window) {
210 $win->command("^window show $window_name");
211 $correction_window->command('^window stick off');
212 $win->set_active;
213 $correction_window->command("window size $window_height");
214 } else {
215 $correction_window = $win;
216 }
191217
192218 # we found a mistake, print suggestions
193 $win->print("Suggestions for $word - " . join(", ", @suggestions));
194 }
195
219
220 $word =~ s/%/%%/g;
221 $color = Irssi::settings_get_str('spellcheck_word_color');
222 if (scalar @$suggestions > 0) {
223 if ($utf8) {
224 Encode::_utf8_on($_) for @$suggestions;
225 }
226 $correction_window->print("Suggestions for $color$word%N - " . join(', ', @$suggestions));
227 } else {
228 $correction_window->print("No suggestions for $color$word%N");
229 }
230
231 return;
232 }
196233
197234 sub spellcheck_complete_word
198235 {
200237
201238 return unless Irssi::settings_get_bool('spellcheck_enabled');
202239
203 # find appropriate language for the current window item
204 my $lang = spellcheck_find_language($win->{active_server}->{tag}, $win->{active}->{name});
240 my $lang = spellcheck_find_language($win);
241
242 return if $lang eq 'und';
205243
206244 # add suggestions to the completion list
207 push(@$complist, spellcheck_check_word($lang, $word, 1));
208 }
209
245 my $suggestions = spellcheck_check_word($lang, $word, 1);
246 push(@$complist, @$suggestions) if defined $suggestions;
247
248 return;
249 }
250
251 sub spellcheck_add_word
252 {
253 my ($cmd_line, $server, $win_item) = @_;
254 my $win = Irssi::active_win();
255 my @args = split(' ', $cmd_line);
256
257 if (@args <= 0) {
258 $win->print('SPELLCHECK_ADD <word>... add word(s) to personal dictionary');
259 return;
260 }
261
262 my $lang = spellcheck_find_language($win);
263
264 my $speller = spellcheck_setup($lang);
265 if (not defined $speller) {
266 $win->print('%R' . "Error while setting up spell-checker for $lang" . '%N', MSGLEVEL_CLIENTERROR);
267 return;
268 }
269
270 $win->print("Adding to $lang dictionary: @args");
271 for my $word (@args) {
272 $speller{$lang}->add_to_personal($word);
273 }
274 my $ok = $speller{$lang}->save_all_word_lists();
275 if (not $ok) {
276 $win->print('%R' . "Error while saving $lang dictionary" . '%N', MSGLEVEL_CLIENTERROR);
277 }
278
279 return;
280 }
281
282 Irssi::command_bind('spellcheck_add', 'spellcheck_add_word');
210283
211284 Irssi::settings_add_bool('spellcheck', 'spellcheck_enabled', 1);
285 Irssi::settings_add_bool('spellcheck', 'spellcheck_print_suggestions', 1);
212286 Irssi::settings_add_str( 'spellcheck', 'spellcheck_default_language', 'en_US');
213287 Irssi::settings_add_str( 'spellcheck', 'spellcheck_languages', '');
214
215 Irssi::signal_add_first('gui key pressed', 'spellcheck_key_pressed');
288 Irssi::settings_add_str( 'spellcheck', 'spellcheck_word_color', '%R');
289 Irssi::settings_add_str( 'spellcheck', 'spellcheck_word_input_color', '%U');
290 Irssi::settings_add_str( 'spellcheck', 'spellcheck_window_name', '');
291 Irssi::settings_add_str( 'spellcheck', 'spellcheck_window_height', 10);
292
293 Irssi::signal_add_last('key word_completion', sub{spellcheck_key_pressed(ord '.')});
294 Irssi::signal_add_last('key word_completion_backward', sub{spellcheck_key_pressed(ord '.')});
295 Irssi::signal_add_last('gui key pressed', 'spellcheck_key_pressed');
216296 Irssi::signal_add_last('complete word', 'spellcheck_complete_word');
297
298 1;
299
300 # vim:ts=4 sts=4 sw=4 et
+22
-10
scripts/tab_stop.pl less more
88 #
99 # 24.05.2011
1010 # * Buggered about with by shabble.
11 #
12 # 19.01.2022
13 # * Added tabstop_interval support
1114
1215 use strict;
1316 use warnings;
1417
1518 use Irssi;
1619
17 our $VERSION = "2011052400";
20 our $VERSION = "2022011900";
1821 our %IRSSI = (
19 authors => "Stefan 'tommie' Tomanek, shabble",
20 contact => "stefan\@pico.ruhr.de, shabble@#irssi/Freenode",
21 name => "tab_stop",
22 description => 'Replaces \t TAB characters with '
23 . 'contents of /set tabstop_replacement',
24 license => "GPLv2",
25 changed => "$VERSION",
26 );
22 authors => "Stefan 'tommie' Tomanek, shabble",
23 contact => "stefan\@pico.ruhr.de, shabble@#irssi/Freenode",
24 name => "tab_stop",
25 description => 'Replaces \t TAB characters to line up with tab stops '
26 . '(default 8) or to contents of /set tabstop_replacement '
27 . 'if tabstop_interval is set to 0',
28 license => "GPLv2",
29 changed => "$VERSION",
30 );
2731
2832 my $not_tab;
33 my $interval;
2934
3035 sub sig_gui_print_text {
3136 return unless $_[4] =~ /\t/;
32 $_[4] =~ s/\t/$not_tab/g;
37 if ($interval) {
38 while ($_[4] =~ s{^(.*?)\t}{ sprintf("%s%s", $1, " " x ($interval - length($1) % $interval)) }e) {
39 }
40 } else {
41 $_[4] =~ s/\t/$not_tab/g;
42 }
3343 Irssi::signal_continue(@_);
3444 }
3545
4050 Irssi::signal_add_first('gui print text', \&sig_gui_print_text);
4151 Irssi::signal_add('setup changed', \&sig_setup_changed);
4252 Irssi::settings_add_str('misc', 'tabstop_replacement', " ");
53 Irssi::settings_add_int('misc', 'tabstop_interval', 8);
4354
4455 sub sig_setup_changed {
4556 $not_tab = Irssi::settings_get_str('tabstop_replacement');
57 $interval = Irssi::settings_get_int('tabstop_interval');
4658 }
4759
4860 sig_setup_changed();
+0
-1
scripts/tinyurl.pl less more
0 #!/usr/bin/perl
10 #
21 # by Atoms
32
+5
-4
scripts/trigger.pl less more
2222 use IO::File;
2323 use vars qw($VERSION %IRSSI);
2424
25 $VERSION = '1.2.4';
25 $VERSION = '1.2.5';
2626 %IRSSI = (
2727 authors => 'Wouter Coekaerts',
2828 contact => 'wouter@coekaerts.be',
3030 description => 'execute a command or replace text, triggered by an event in irssi',
3131 license => 'GPLv2 or later',
3232 url => 'http://wouter.coekaerts.be/irssi/',
33 changed => '2020-03-10',
33 changed => '2022-01-02',
3434 );
3535
3636 sub cmd_help {
674674 # return array of filters for the given trigger
675675 sub filters_for_trigger($) {
676676 my ($trigger) = @_;
677 return values(%{$trigger->{'filters'}});
677 my $href = $trigger->{filters};
678 return @{$href}{ sort keys %$href };
678679 }
679680
680681 # used in check_signal_message to expand $'s
10001001 }
10011002
10021003 if ($compat) {
1003 foreach my $filter (keys(%filters)) {
1004 foreach my $filter (sort keys(%filters)) {
10041005 if ($trigger->{$filter}) {
10051006 $string .= '-' . $filter . param_to_string($trigger->{$filter});
10061007 }
+13
-58
scripts/upgradeinfo.pl less more
0 # upgradeinfo - irssi 0.8.6.CVS
10 #
2 # $Id: upgradeinfo.pl,v 1.7 2003/02/04 02:29:57 peder Exp $
3 #
4 # Copyright (C) 2002, 2003 by Peder Stray <peder@ninja.no>
1 # Copyright (C) 2002-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
85 use Irssi 20021204.1123;
96 use Irssi::TextUI;
107
11 # ======[ Script Header ]===============================================
12
138 use vars qw{$VERSION %IRSSI};
14 ($VERSION) = '$Revision: 1.7 $' =~ / (\d+\.\d+) /;
9 ($VERSION) = '$Revision: 1.7.1 $' =~ / (\d+(\.\d+)+) /;
1510 %IRSSI = (
16 name => 'upgradeinfo',
17 authors => 'Peder Stray',
18 contact => 'peder@ninja.no',
19 url => 'http://ninja.no/irssi/upgradeinfo.pl',
20 license => 'GPL',
21 description => 'Statusbaritem notifying you about updated binary',
11 name => 'upgradeinfo',
12 authors => 'Peder Stray',
13 contact => 'peder.stray@gmail.com',
14 url => 'https://github.com/pstray/irssi-upgradeinfo',
15 license => 'GPL',
16 description => 'Statusbar item notifying you about updated binary',
2217 sbitems => 'upgradeinfo',
23 );
24
25 # ======[ Variables ]===================================================
18 );
2619
2720 my($load_time) = 0; # modification time of binary at load
2821 my($file_time) = 0; # modification time of binary file
2922 my($timer) = 0; # ID of current timer
30
31 # ======[ Commands ]====================================================
32
33 # --------[ UPGRADEINFO ]-----------------------------------------------
3423
3524 sub cmd_upgradeinfo {
3625 my($param,$serv,$chan) = @_;
3726
3827 print CLIENTCRAP sprintf ">> load: %s", scalar localtime $load_time;
3928 print CLIENTCRAP sprintf ">> file: %s", scalar localtime $file_time;
40
4129 }
42
43 # ======[ Signal Hooks ]================================================
44
45 # --------[ sig_setup_changed ]-----------------------------------------
4630
4731 sub sig_setup_changed {
4832 my($interval) = Irssi::settings_get_int('upgrade_check_interval');
5943 $timer = Irssi::timeout_add($interval, 'ui_check' , undef);
6044 }
6145
62 # ======[ Statusbar Hooks ]=============================================
63
64 # --------[ sb_upgradeinfo ]--------------------------------------------
65
6646 sub sb_upgradeinfo {
6747 my($item, $get_size_only) = @_;
6848 my $format = "";
6949 my($time);
7050 my($timefmt) = Irssi::settings_get_str('upgrade_time_format');
71
51
7252 $time = $file_time - $load_time;
73
53
7454 if ($time) {
75 $time = sprintf($timefmt,
55 $time = sprintf($timefmt,
7656 $time/60/60/24,
7757 $time/60/60%24,
7858 $time/60%60,
8161 $time =~ s/^(0+\D+)+//;
8262 $format = "{sb %r$time%n}";
8363 }
84
64
8565 $item->default_handler($get_size_only, $format, undef, 1);
8666 }
87
88 # ======[ Timers ]======================================================
89
90 # --------[ ui_check ]--------------------------------------------------
9167
9268 sub ui_check {
9369 $file_time = (stat Irssi::get_irssi_binary)[9];
9571 Irssi::statusbar_items_redraw('upgradeinfo');
9672 }
9773
98 # ======[ Setup ]=======================================================
99
100 # --------[ Register commands ]-----------------------------------------
101
10274 Irssi::command_bind('upgradeinfo', 'cmd_upgradeinfo');
103
104 # --------[ Register formats ]------------------------------------------
105
106 # --------[ Register settings ]-----------------------------------------
10775
10876 Irssi::settings_add_int('upgrade', 'upgrade_check_interval', 300);
10977 Irssi::settings_add_str('upgrade', 'upgrade_time_format', '%d+%02d:%02d');
11078
111 # --------[ Register signals ]------------------------------------------
112
11379 Irssi::signal_add('setup changed', 'sig_setup_changed');
11480
115 # --------[ Register statusbar items ]----------------------------------
116
11781 Irssi::statusbar_item_register('upgradeinfo', undef, 'sb_upgradeinfo');
118
119 # --------[ Other setup ]-----------------------------------------------
12082
12183 $load_time = (stat Irssi::get_irssi_binary)[9];
12284 $file_time = $load_time;
12385
12486 sig_setup_changed;
125
126 # ======[ END ]=========================================================
127
128 # Local Variables:
129 # header-initial-hide: t
130 # mode: header-minor
131 # end:
+13
-67
scripts/uptime.pl less more
0 # uptime - irssi 0.7.98.CVS
10 #
2 # $Id: uptime.pl,v 1.6 2003/02/04 02:43:06 peder Exp $
3 #
4 # Copyright (C) 2002, 2003 by Peder Stray <peder@ninja.no>
1 # Copyright (C) 2002-2021 by Peder Stray <peder.stray@gmail.com>
52 #
63
74 use strict;
96 use Irssi::Irc;
107 use Irssi::TextUI;
118
12 # ======[ Script Header ]===============================================
13
149 use vars qw{$VERSION %IRSSI};
15 ($VERSION) = '$Revision: 1.6 $' =~ / (\d+\.\d+) /;
10 ($VERSION) = '$Revision: 1.6.1 $' =~ / (\d+(\.\d+)+) /;
1611 %IRSSI = (
17 name => 'uptime',
18 authors => 'Peder Stray',
19 contact => 'peder@ninja.no',
20 url => 'http://ninja.no/irssi/uptime.pl',
21 license => 'GPL',
22 description => 'Try a little harder to figure out client uptime',
23 sbitems => 'uptime',
24 );
25
26 # ======[ Variables ]===================================================
12 name => 'uptime',
13 authors => 'Peder Stray',
14 contact => 'peder.stray@gmail.com',
15 url => 'https://github.com/pstray/irssi-uptime',
16 license => 'GPL',
17 description => 'Try a little harder to figure out client uptime',
18 sbitem => 'uptime',
19 );
2720
2821 my($timer) = 0; # ID of current timer
29
30 # ======[ Helper functions ]============================================
31
32 # --------[ uptime_linux ]----------------------------------------------
3322
3423 sub uptime_linux {
3524 my($sys_uptime);
4736 return $sys_uptime - $irssi_start/100;
4837 }
4938
50 # --------[ uptime_solaris ]--------------------------------------------
51
5239 sub uptime_solaris {
5340 my($irssi_start);
5441
5643
5744 return $irssi_start;
5845 }
59
60 # --------[ uptime ]----------------------------------------------------
6146
6247 sub uptime {
6348 my($sysname) = @_;
7459 return $time;
7560 }
7661
77 # --------[ format_interval ]-------------------------------------------
78
7962 sub format_interval {
8063 my($interval) = @_;
8164
9073 return $str;
9174 }
9275
93 # ======[ Commands ]====================================================
94
95 # --------[ cmd_uptime ]------------------------------------------------
96
9776 sub cmd_uptime {
9877 my($data,$server,$witem) = @_;
9978 my($sysname) = Irssi::parse_special('$sysname');
10382 if ($data && $server) {
10483 $server->command("MSG $data uptime: $str");
10584 } elsif ($witem && ($witem->{type} eq "CHANNEL" ||
106 $witem->{type} eq "QUERY")) {
85 $witem->{type} eq "QUERY")) {
10786 $witem->command("MSG ".$witem->{name}." uptime: $str");
10887 } else {
10988 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'uptime',
11089 $str, $sysname);
11190 }
11291 }
113
114 # ======[ Signal Hooks ]================================================
115
116 # --------[ sig_setup_changed ]-----------------------------------------
11792
11893 sub sig_setup_changed {
11994 my($interval) = Irssi::settings_get_int('uptime_refresh_interval');
130105 $timer = Irssi::timeout_add($interval, 'uptime_refresh' , undef);
131106 }
132107
133 # ======[ Statusbar Hooks ]=============================================
134
135 # --------[ sb_uptime ]-------------------------------------------------
136
137108 sub sb_uptime {
138109 my($item, $get_size_only) = @_;
139110 my $format = "";
140111 my($uptime) = uptime(Irssi::parse_special('$sysname'));
141112 my($time) = format_interval($uptime);
142
113
143114 $format = "{sb %g$time%n}";
144
115
145116 $item->default_handler($get_size_only, $format, undef, 1);
146117 }
147
148 # ======[ Timers ]======================================================
149
150 # --------[ uptime_refresh ]--------------------------------------------
151118
152119 sub uptime_refresh {
153120 Irssi::statusbar_items_redraw('uptime');
154121 }
155122
156 # ======[ Setup ]=======================================================
157
158 # --------[ Register commands ]-----------------------------------------
159
160123 Irssi::command_bind('uptime', 'cmd_uptime');
161
162 # --------[ Register formats ]------------------------------------------
163124
164125 Irssi::theme_register(
165126 [
167128 '{line_start}{hilight Uptime:} $0 ($1)',
168129 ]);
169130
170 # --------[ Register settings ]-----------------------------------------
171
172131 Irssi::settings_add_int('upgrade', 'uptime_refresh_interval', 12);
173
174 # --------[ Register signals ]------------------------------------------
175132
176133 Irssi::signal_add('setup changed', 'sig_setup_changed');
177134
178 # --------[ Register statusbar items ]----------------------------------
179
180135 Irssi::statusbar_item_register('uptime', undef, 'sb_uptime');
181136
182 # --------[ Other setup ]-----------------------------------------------
183
184137 sig_setup_changed;
185
186 # ======[ END ]=========================================================
187
188 # Local Variables:
189 # header-initial-hide: t
190 # mode: header-minor
191 # end:
+6
-4
scripts/urlgrab.pl less more
66 #
77
88 use strict;
9 use Time::Piece;
910 use Irssi 20010120.0250 ();
1011 use vars qw($VERSION %IRSSI);
11 $VERSION = "0.4";
12 $VERSION = "0.5";
1213 %IRSSI = (
13 authors => 'David Leadbeater',
14 contact => 'dgl@dgl.cx',
14 authors => 'David Leadbeater, Thorsten Scherf',
15 contact => 'dgl@dgl.cx, tscherf@redhat.com',
1516 name => 'urlgrab',
1617 description => 'Captures urls said in channel and private messages and saves them to a file, also adds a /url command which loads the last said url into a browser.',
1718 license => 'GNU GPLv2 or later',
5455 }
5556
5657 sub url_log{
58 my $t = localtime;
5759 my($where,$channel,$url) = @_;
5860 return if lc $url eq lc $lasturl; # a tiny bit of protection from spam/flood
5961 $lasturl = $url;
6062 open(URLLOG, ">>", $file) or return;
61 print URLLOG time." $where $channel $lasturl\n";
63 print URLLOG $t->datetime . " $where $channel $lasturl\n";
6264 close(URLLOG);
6365 }
6466