zsh_dots 0.5.9 → 0.6.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -0,0 +1,1225 @@
1
+ # trigger.pl - execute a command or replace text, triggered by an event in irssi
2
+ # Do /TRIGGER HELP or look at http://wouter.coekaerts.be/irssi/ for help
3
+
4
+ # Copyright (C) 2002-2006 Wouter Coekaerts <wouter@coekaerts.be>
5
+ #
6
+ # This program is free software; you can redistribute it and/or modify
7
+ # it under the terms of the GNU General Public License as published by
8
+ # the Free Software Foundation; either version 2 of the License, or
9
+ # (at your option) any later version.
10
+ #
11
+ # This program is distributed in the hope that it will be useful,
12
+ # but WITHOUT ANY WARRANTY; without even the implied warranty of
13
+ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14
+ # GNU General Public License for more details.
15
+ #
16
+ # You should have received a copy of the GNU General Public License
17
+ # along with this program; if not, write to the Free Software
18
+ # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19
+
20
+ use strict;
21
+ use Irssi 20020324 qw(command_bind command_runsub command signal_add_first signal_continue signal_stop signal_remove);
22
+ use Text::ParseWords;
23
+ use IO::File;
24
+ use vars qw($VERSION %IRSSI);
25
+
26
+ $VERSION = '1.0';
27
+ %IRSSI = (
28
+ authors => 'Wouter Coekaerts',
29
+ contact => 'wouter@coekaerts.be',
30
+ name => 'trigger',
31
+ description => 'execute a command or replace text, triggered by an event in irssi',
32
+ license => 'GPLv2 or later',
33
+ url => 'http://wouter.coekaerts.be/irssi/',
34
+ changed => '$LastChangedDate: 2006-01-23 13:10:19 +0100 (Mon, 23 Jan 2006) $',
35
+ );
36
+
37
+ sub cmd_help {
38
+ Irssi::print (<<'SCRIPTHELP_EOF', MSGLEVEL_CLIENTCRAP);
39
+
40
+ TRIGGER LIST
41
+ TRIGGER SAVE
42
+ TRIGGER RELOAD
43
+ TRIGGER MOVE <number> <number>
44
+ TRIGGER DELETE <number>
45
+ TRIGGER CHANGE <number> ...
46
+ TRIGGER ADD ...
47
+
48
+ When to match:
49
+ On which types of event to trigger:
50
+ These are simply specified by -name_of_the_type
51
+ The normal IRC event types are:
52
+ publics, %|privmsgs, pubactions, privactions, pubnotices, privnotices, joins, parts, quits, kicks, topics, invites, nick_changes, dcc_msgs, dcc_actions, dcc_ctcps
53
+ mode_channel: %|a mode on the (whole) channel (like +t, +i, +b)
54
+ mode_nick: %|a mode on someone in the channel (like +o, +v)
55
+ -all is an alias for all of those.
56
+ Additionally, there is:
57
+ rawin: %|raw text incoming from the server
58
+ send_command: %|commands you give to irssi
59
+ send_text: %|lines you type that aren't commands
60
+ beep: %|when irssi beeps
61
+ notify_join: %|someone in you notify list comes online
62
+ notify_part: %|someone in your notify list goes offline
63
+ notify_away: %|someone in your notify list goes away
64
+ notify_unaway: %|someone in your notify list goes unaway
65
+ notify_unidle: %|someone in your notify list stops idling
66
+
67
+ Filters (conditions) the event has to satisfy. They all take one parameter.
68
+ If you can give a list, seperate elements by space and use quotes around the list.
69
+ -pattern: %|The message must match the given pattern. ? and * can be used as wildcards
70
+ -regexp: %|The message must match the given regexp. (see man perlre)
71
+ %|if -nocase is given as an option, the regexp or pattern is matched case insensitive
72
+ -tags: %|The servertag must be in the given list of tags
73
+ -channels: %|The event must be in one of the given list of channels.
74
+ Examples: %|-channels '#chan1 #chan2' or -channels 'IRCNet/#channel'
75
+ %|-channels 'EFNet/' means every channel on EFNet and is the same as -tags 'EFNet'
76
+ -masks: %|The person who triggers it must match one of the given list of masks
77
+ -hasmode: %|The person who triggers it must have the give mode
78
+ Examples: %|'-o' means not opped, '+ov' means opped OR voiced, '-o&-v' means not opped AND not voiced
79
+ -hasflag: %|Only trigger if if friends.pl (friends_shasta.pl) or people.pl is loaded and the person who triggers it has the given flag in the script (same syntax as -hasmode)
80
+ -other_masks
81
+ -other_hasmode
82
+ -other_hasflag: %|Same as above but for the victim for kicks or mode_nick.
83
+
84
+ What to do when it matches:
85
+ -command: Execute the given Irssi-command
86
+ %|You are able to use $1, $2 and so on generated by your regexp pattern.
87
+ %|For multiple commands ; (or $;) can be used as seperator
88
+ %|The following variables are also expanded:
89
+ $T: %|Server tag
90
+ $C: %|Channel name
91
+ $N: %|Nickname of the person who triggered this command
92
+ $A: %|His address (foo@bar.com),
93
+ $I: %|His ident (foo)
94
+ $H: %|His hostname (bar.com)
95
+ $M: %|The complete message
96
+ ${other}: %|The victim for kicks or mode_nick
97
+ ${mode_type}: %|The type ('+' or '-') for a mode_channel or mode_nick
98
+ ${mode_char}: %|The mode char ('o' for ops, 'b' for ban,...)
99
+ ${mode_arg} : %|The argument to the mode (if there is one)
100
+ %|$\X, with X being one of the above expands (e.g. $\M), escapes all non-alphanumeric characters, so it can be used with /eval or /exec. Don't use /eval or /exec without this, it's not safe.
101
+
102
+ -replace: %|replaces the matching part with the given replacement in the event (requires a -regexp or -pattern)
103
+ -once: %|remove the trigger if it is triggered, so it only executes once and then is forgotten.
104
+ -stop: %|stops the signal. It won't get displayed by Irssi. Like /IGNORE
105
+ -debug: %|print some debugging info
106
+
107
+ Other options:
108
+ -disabled: %|Same as removing it, but keeps it in case you might need it later
109
+ -name: %|Give the trigger a name. You can refer to the trigger with this name in add/del/change commands
110
+
111
+ Examples:
112
+ Knockout people who do a !list:
113
+ /TRIGGER ADD %|-publics -channels "#channel1 #channel2" -nocase -regexp ^!list -command "KN $N This is not a warez channel!"
114
+ React to !echo commands from people who are +o in your friends-script:
115
+ /TRIGGER ADD %|-publics -regexp '^!echo (.*)' -hasflag '+o' -command 'say echo: $1'
116
+ Ignore all non-ops on #channel:
117
+ /TRIGGER ADD %|-publics -actions -channels "#channel" -hasmode '-o' -stop
118
+ Send a mail to yourself every time a topic is changed:
119
+ /TRIGGER ADD %|-topics -command 'exec echo $\N changed topic of $\C to: $\M | mail you@somewhere.com -s topic'
120
+
121
+
122
+ Examples with -replace:
123
+ %|Replace every occurence of shit with sh*t, case insensitive:
124
+ /TRIGGER ADD %|-all -nocase -regexp shit -replace sh*t
125
+ %|Strip all colorcodes from *!lamer@*:
126
+ /TRIGGER ADD %|-all -masks *!lamer@* -regexp '\x03\d?\d?(,\d\d?)?|\x02|\x1f|\x16|\x06' -replace ''
127
+ %|Never let *!bot1@foo.bar or *!bot2@foo.bar hilight you
128
+ %|(this works by cutting your nick in 2 different parts, 'myn' and 'ick' here)
129
+ %|you don't need to understand the -replace argument, just trust that it works if the 2 parts separately don't hilight:
130
+ /TRIGGER ADD %|-all masks '*!bot1@foo.bar *!bot2@foo.bar' -regexp '(myn)(ick)' -nocase -replace '$1\x02\x02$2'
131
+ %|Avoid being hilighted by !top10 in eggdrops with stats.mod (but show your nick in bold):
132
+ /TRIGGER ADD %|-publics -regexp '(Top.0\(.*\): 1.*)(my)(nick)' -replace '$1\x02$2\x02\x02$3\x02'
133
+ %|Convert a Windows-1252 Euro to an ISO-8859-15 Euro (same effect as euro.pl):
134
+ /TRIGGER ADD %|-regexp '\x80' -replace '\xA4'
135
+ %|Show tabs as spaces, not the inverted I (same effect as tab_stop.pl):
136
+ /TRIGGER ADD %|-all -regexp '\t' -replace ' '
137
+ SCRIPTHELP_EOF
138
+ } # /
139
+
140
+ my @triggers; # array of all triggers
141
+ my %triggers_by_type; # hash mapping types on triggers of that type
142
+ my $recursion_depth = 0;
143
+ my $changed_since_last_save = 0;
144
+
145
+ ###############
146
+ ### formats ###
147
+ ###############
148
+
149
+ Irssi::theme_register([
150
+ 'trigger_header' => 'Triggers:',
151
+ 'trigger_line' => '%#$[-4]0 $1',
152
+ 'trigger_added' => 'Trigger $0 added: $1',
153
+ 'trigger_not_found' => 'Trigger {hilight $0} not found',
154
+ 'trigger_saved' => 'Triggers saved to $0',
155
+ 'trigger_loaded' => 'Triggers loaded from $0'
156
+ ]);
157
+
158
+ #########################################
159
+ ### catch the signals & do your thing ###
160
+ #########################################
161
+
162
+ # trigger types with a message and a channel
163
+ my @allchanmsg_types = qw(publics pubactions pubnotices pubctcps pubctcpreplies parts quits kicks topics);
164
+ # trigger types with a message
165
+ my @allmsg_types = (@allchanmsg_types, qw(privmsgs privactions privnotices privctcps privctcpreplies dcc_msgs dcc_actions dcc_ctcps));
166
+ # trigger types with a channel
167
+ my @allchan_types = (@allchanmsg_types, qw(mode_channel mode_nick joins invites));
168
+ # trigger types in -all
169
+ my @all_types = (@allmsg_types, qw(mode_channel mode_nick joins invites nick_changes));
170
+ # trigger types with a server
171
+ my @all_server_types = (@all_types, qw(rawin notify_join notify_part notify_away notify_unaway notify_unidle));
172
+ # all trigger types
173
+ my @trigger_types = (@all_server_types, qw(send_command send_text beep));
174
+ #trigger types that are not in -all
175
+ #my @notall_types = grep {my $a=$_; return (!grep {$_ eq $a} @all_types);} @trigger_types;
176
+ my @notall_types = qw(rawin notify_join notify_part notify_away notify_unaway notify_unidle send_command send_text beep);
177
+
178
+ my @signals = (
179
+ # "message public", SERVER_REC, char *msg, char *nick, char *address, char *target
180
+ {
181
+ 'types' => ['publics'],
182
+ 'signal' => 'message public',
183
+ 'sub' => sub {check_signal_message(\@_,1,$_[0],$_[4],$_[2],$_[3],'publics');},
184
+ },
185
+ # "message private", SERVER_REC, char *msg, char *nick, char *address
186
+ {
187
+ 'types' => ['privmsgs'],
188
+ 'signal' => 'message private',
189
+ 'sub' => sub {check_signal_message(\@_,1,$_[0],undef,$_[2],$_[3],'privmsgs');},
190
+ },
191
+ # "message irc action", SERVER_REC, char *msg, char *nick, char *address, char *target
192
+ {
193
+ 'types' => ['privactions','pubactions'],
194
+ 'signal' => 'message irc action',
195
+ 'sub' => sub {
196
+ if ($_[4] eq $_[0]->{nick}) {
197
+ check_signal_message(\@_,1,$_[0],undef,$_[2],$_[3],'privactions');
198
+ } else {
199
+ check_signal_message(\@_,1,$_[0],$_[4],$_[2],$_[3],'pubactions');
200
+ }
201
+ },
202
+ },
203
+ # "message irc notice", SERVER_REC, char *msg, char *nick, char *address, char *target
204
+ {
205
+ 'types' => ['privnotices','pubnotices'],
206
+ 'signal' => 'message irc notice',
207
+ 'sub' => sub {
208
+ if ($_[4] eq $_[0]->{nick}) {
209
+ check_signal_message(\@_,1,$_[0],undef,$_[2],$_[3],'privnotices');
210
+ } else {
211
+ check_signal_message(\@_,1,$_[0],$_[4],$_[2],$_[3],'pubnotices');
212
+ }
213
+ }
214
+ },
215
+ # "message join", SERVER_REC, char *channel, char *nick, char *address
216
+ {
217
+ 'types' => ['joins'],
218
+ 'signal' => 'message join',
219
+ 'sub' => sub {check_signal_message(\@_,-1,$_[0],$_[1],$_[2],$_[3],'joins');}
220
+ },
221
+ # "message part", SERVER_REC, char *channel, char *nick, char *address, char *reason
222
+ {
223
+ 'types' => ['parts'],
224
+ 'signal' => 'message part',
225
+ 'sub' => sub {check_signal_message(\@_,4,$_[0],$_[1],$_[2],$_[3],'parts');}
226
+ },
227
+ # "message quit", SERVER_REC, char *nick, char *address, char *reason
228
+ {
229
+ 'types' => ['quits'],
230
+ 'signal' => 'message quit',
231
+ 'sub' => sub {check_signal_message(\@_,3,$_[0],undef,$_[1],$_[2],'quits');}
232
+ },
233
+ # "message kick", SERVER_REC, char *channel, char *nick, char *kicker, char *address, char *reason
234
+ {
235
+ 'types' => ['kicks'],
236
+ 'signal' => 'message kick',
237
+ 'sub' => sub {check_signal_message(\@_,5,$_[0],$_[1],$_[3],$_[4],'kicks',{'other'=>$_[2]});}
238
+ },
239
+ # "message topic", SERVER_REC, char *channel, char *topic, char *nick, char *address
240
+ {
241
+ 'types' => ['topics'],
242
+ 'signal' => 'message topic',
243
+ 'sub' => sub {check_signal_message(\@_,2,$_[0],$_[1],$_[3],$_[4],'topics');}
244
+ },
245
+ # "message invite", SERVER_REC, char *channel, char *nick, char *address
246
+ {
247
+ 'types' => ['invites'],
248
+ 'signal' => 'message invite',
249
+ 'sub' => sub {check_signal_message(\@_,-1,$_[0],$_[1],$_[2],$_[3],'invites');}
250
+ },
251
+ # "message nick", SERVER_REC, char *newnick, char *oldnick, char *address
252
+ {
253
+ 'types' => ['nick_changes'],
254
+ 'signal' => 'message nick',
255
+ 'sub' => sub {check_signal_message(\@_,-1,$_[0],undef,$_[1],$_[3],'nick_changes');}
256
+ },
257
+ # "message dcc", DCC_REC *dcc, char *msg
258
+ {
259
+ 'types' => ['dcc_msgs'],
260
+ 'signal' => 'message dcc',
261
+ 'sub' => sub {check_signal_message(\@_,1,$_[0]->{'server'},undef,$_[0]->{'nick'},undef,'dcc_msgs');
262
+ }
263
+ },
264
+ # "message dcc action", DCC_REC *dcc, char *msg
265
+ {
266
+ 'types' => ['dcc_actions'],
267
+ 'signal' => 'message dcc action',
268
+ 'sub' => sub {check_signal_message(\@_,1,$_[0]->{'server'},undef,$_[0]->{'nick'},undef,'dcc_actions');}
269
+ },
270
+ # "message dcc ctcp", DCC_REC *dcc, char *cmd, char *data
271
+ {
272
+ 'types' => ['dcc_ctcps'],
273
+ 'signal' => 'message dcc ctcp',
274
+ 'sub' => sub {check_signal_message(\@_,1,$_[0]->{'server'},undef,$_[0]->{'nick'},undef,'dcc_ctcps');}
275
+ },
276
+ # "server incoming", SERVER_REC, char *data
277
+ {
278
+ 'types' => ['rawin'],
279
+ 'signal' => 'server incoming',
280
+ 'sub' => sub {check_signal_message(\@_,1,$_[0],undef,undef,undef,'rawin');}
281
+ },
282
+ # "send command", char *args, SERVER_REC, WI_ITEM_REC
283
+ {
284
+ 'types' => ['send_command'],
285
+ 'signal' => 'send command',
286
+ 'sub' => sub {
287
+ sig_send_text_or_command(\@_,1);
288
+ }
289
+ },
290
+ # "send text", char *line, SERVER_REC, WI_ITEM_REC
291
+ {
292
+ 'types' => ['send_text'],
293
+ 'signal' => 'send text',
294
+ 'sub' => sub {
295
+ sig_send_text_or_command(\@_,0);
296
+ }
297
+ },
298
+ # "beep"
299
+ {
300
+ 'types' => ['beep'],
301
+ 'signal' => 'beep',
302
+ 'sub' => sub {check_signal_message(\@_,-1,undef,undef,undef,undef,'beep');}
303
+ },
304
+ # "event "<cmd>, SERVER_REC, char *args, char *sender_nick, char *sender_address
305
+ {
306
+ 'types' => ['mode_channel', 'mode_nick'],
307
+ 'signal' => 'event mode',
308
+ 'sub' => sub {
309
+ my ($server, $event_args, $nickname, $address) = @_;
310
+ my ($target, $modes, $modeargs) = split(/ /, $event_args, 3);
311
+ return if (!$server->ischannel($target));
312
+ my (@modeargs) = split(/ /,$modeargs);
313
+ my ($pos, $type, $event_type, $arg) = (0, '+');
314
+ foreach my $char (split(//,$modes)) {
315
+ if ($char eq "+" || $char eq "-") {
316
+ $type = $char;
317
+ } else {
318
+ if ($char =~ /[Oovh]/) { # mode_nick
319
+ $event_type = 'mode_nick';
320
+ $arg = $modeargs[$pos++];
321
+ } elsif ($char =~ /[beIqdk]/ || ( $char =~ /[lfJ]/ && $type eq '+')) { # chan_mode with arg
322
+ $event_type = 'mode_channel';
323
+ $arg = $modeargs[$pos++];
324
+ } else { # chan_mode without arg
325
+ $event_type = 'mode_channel';
326
+ $arg = undef;
327
+ }
328
+ check_signal_message(\@_,-1,$server,$target,$nickname,$address,$event_type,{
329
+ 'mode_type' => $type,
330
+ 'mode_char' => $char,
331
+ 'mode_arg' => $arg,
332
+ 'other' => ($event_type eq 'mode_nick') ? $arg : undef
333
+ });
334
+ }
335
+ }
336
+ }
337
+ },
338
+ # "notifylist joined", SERVER_REC, char *nick, char *user, char *host, char *realname, char *awaymsg
339
+ {
340
+ 'types' => ['notify_join'],
341
+ 'signal' => 'notifylist joined',
342
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], 'notify_join', {'realname' => $_[4]});}
343
+ },
344
+ {
345
+ 'types' => ['notify_part'],
346
+ 'signal' => 'notifylist left',
347
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], 'notify_left', {'realname' => $_[4]});}
348
+ },
349
+ {
350
+ 'types' => ['notify_unidle'],
351
+ 'signal' => 'notifylist unidle',
352
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], 'notify_unidle', {'realname' => $_[4]});}
353
+ },
354
+ {
355
+ 'types' => ['notify_away', 'notify_unaway'],
356
+ 'signal' => 'notifylist away changed',
357
+ 'sub' => sub {check_signal_message(\@_, 5, $_[0], undef, $_[1], $_[2].'@'.$_[3], ($_[5] ? 'notify_away' : 'notify_unaway'), {'realname' => $_[4]});}
358
+ },
359
+ # "ctcp msg", SERVER_REC, char *args, char *nick, char *addr, char *target
360
+ {
361
+ 'types' => ['pubctcps', 'privctcps'],
362
+ 'signal' => 'ctcp msg',
363
+ 'sub' => sub {
364
+ my ($server, $args, $nick, $addr, $target) = @_;
365
+ if ($target eq $server->{'nick'}) {
366
+ check_signal_message(\@_, 1, $server, undef, $nick, $addr, 'privctcps');
367
+ } else {
368
+ check_signal_message(\@_, 1, $server, $target, $nick, $addr, 'pubctcps');
369
+ }
370
+ }
371
+ },
372
+ # "ctcp reply", SERVER_REC, char *args, char *nick, char *addr, char *target
373
+ {
374
+ 'types' => ['pubctcpreplies', 'privctcpreplies'],
375
+ 'signal' => 'ctcp reply',
376
+ 'sub' => sub {
377
+ my ($server, $args, $nick, $addr, $target) = @_;
378
+ if ($target eq $server->{'nick'}) {
379
+ check_signal_message(\@_, 1, $server, undef, $nick, $addr, 'privctcps');
380
+ } else {
381
+ check_signal_message(\@_, 1, $server, $target, $nick, $addr, 'pubctcps');
382
+ }
383
+ }
384
+ }
385
+ );
386
+
387
+ sub sig_send_text_or_command {
388
+ my ($signal, $iscommand) = @_;
389
+ my ($line, $server, $item) = @$signal;
390
+ my ($channelname,$nickname,$address) = (undef,undef,undef);
391
+ if ($item && (ref($item) eq 'Irssi::Irc::Channel' || ref($item) eq 'Irssi::Silc::Channel')) {
392
+ $channelname = $item->{'name'};
393
+ } elsif ($item && ref($item) eq 'Irssi::Irc::Query') { # TODO Silc query ?
394
+ $nickname = $item->{'name'};
395
+ $address = $item->{'address'}
396
+ }
397
+ # TODO pass context also for non-channels (queries and other stuff)
398
+ check_signal_message($signal,0,$server,$channelname,$nickname,$address,$iscommand ? 'send_command' : 'send_text');
399
+
400
+ }
401
+
402
+ my %filters = (
403
+ 'tags' => {
404
+ 'types' => \@all_server_types,
405
+ 'sub' => sub {
406
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
407
+
408
+ if (!defined($server)) {
409
+ return 0;
410
+ }
411
+ my $matches = 0;
412
+ foreach my $tag (split(/ /,$param)) {
413
+ if (lc($server->{'tag'}) eq lc($tag)) {
414
+ $matches = 1;
415
+ last;
416
+ }
417
+ }
418
+ return $matches;
419
+ }
420
+ },
421
+ 'channels' => {
422
+ 'types' => \@allchan_types,
423
+ 'sub' => sub {
424
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
425
+
426
+ if (!defined($channelname) || !defined($server)) {
427
+ return 0;
428
+ }
429
+ my $matches = 0;
430
+ foreach my $trigger_channel (split(/ /,$param)) {
431
+ if (lc($channelname) eq lc($trigger_channel)
432
+ || lc($server->{'tag'}.'/'.$channelname) eq lc($trigger_channel)
433
+ || lc($server->{'tag'}.'/') eq lc($trigger_channel)) {
434
+ $matches = 1;
435
+ last; # this channel matches, stop checking channels
436
+ }
437
+ }
438
+ return $matches;
439
+ }
440
+ },
441
+ 'masks' => {
442
+ 'types' => \@all_types,
443
+ 'sub' => sub {
444
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
445
+ return (defined($nickname) && defined($address) && defined($server) && $server->masks_match($param, $nickname, $address));
446
+ }
447
+ },
448
+ 'other_masks' => {
449
+ 'types' => ['kicks', 'mode_nick'],
450
+ 'sub' => sub {
451
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
452
+ return 0 unless defined($extra->{'other'});
453
+ my $other_address = get_address($extra->{'other'}, $server, $channelname);
454
+ return defined($other_address) && $server->masks_match($param, $extra->{'other'}, $other_address);
455
+ }
456
+ },
457
+ 'hasmode' => {
458
+ 'types' => \@all_types,
459
+ 'sub' => sub {
460
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
461
+ return hasmode($param, $nickname, $server, $channelname);
462
+ }
463
+ },
464
+ 'other_hasmode' => {
465
+ 'types' => ['kicks', 'mode_nick'],
466
+ 'sub' => sub {
467
+ my ($param,$signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
468
+ return defined($extra->{'other'}) && hasmode($param, $extra->{'other'}, $server, $channelname);
469
+ }
470
+ },
471
+ 'hasflag' => {
472
+ 'types' => \@all_types,
473
+ 'sub' => sub {
474
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
475
+ return 0 unless defined($nickname) && defined($address) && defined($server);
476
+ my $flags = get_flags ($server->{'chatnet'},$channelname,$nickname,$address);
477
+ return defined($flags) && check_modes($flags,$param);
478
+ }
479
+ },
480
+ 'other_hasflag' => {
481
+ 'types' => ['kicks', 'mode_nick'],
482
+ 'sub' => sub {
483
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
484
+ return 0 unless defined($extra->{'other'});
485
+ my $other_address = get_address($extra->{'other'}, $server, $channelname);
486
+ return 0 unless defined($other_address);
487
+ my $flags = get_flags ($server->{'chatnet'},$channelname,$extra->{'other'},$other_address);
488
+ return defined($flags) && check_modes($flags,$param);
489
+ }
490
+ },
491
+ 'mode_type' => {
492
+ 'types' => ['mode_channel', 'mode_nick'],
493
+ 'sub' => sub {
494
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
495
+ return (($param) eq $extra->{'mode_type'});
496
+ }
497
+ },
498
+ 'mode_char' => {
499
+ 'types' => ['mode_channel', 'mode_nick'],
500
+ 'sub' => sub {
501
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
502
+ return (($param) eq $extra->{'mode_char'});
503
+ }
504
+ },
505
+ 'mode_arg' => {
506
+ 'types' => ['mode_channel', 'mode_nick'],
507
+ 'sub' => sub {
508
+ my ($param, $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra) = @_;
509
+ return (($param) eq $extra->{'mode_arg'});
510
+ }
511
+ }
512
+ );
513
+
514
+ sub get_address {
515
+ my ($nick, $server, $channel) = @_;
516
+ my $nickrec = get_nickrec($nick, $server, $channel);
517
+ return $nickrec ? $nickrec->{'host'} : undef;
518
+ }
519
+ sub get_nickrec {
520
+ my ($nick, $server, $channel) = @_;
521
+ return unless defined($server) && defined($channel) && defined($nick);
522
+ my $chanrec = $server->channel_find($channel);
523
+ return $chanrec ? $chanrec->nick_find($nick) : undef;
524
+ }
525
+
526
+ sub hasmode {
527
+ my ($param, $nickname, $server, $channelname) = @_;
528
+ my $nickrec = get_nickrec($nickname, $server, $channelname);
529
+ return 0 unless defined $nickrec;
530
+ my $modes =
531
+ ($nickrec->{'op'} ? 'o' : '')
532
+ . ($nickrec->{'voice'} ? 'v' : '')
533
+ . ($nickrec->{'halfop'} ? 'h' : '')
534
+ ;
535
+ return check_modes($modes, $param);
536
+ }
537
+
538
+ # list of all switches
539
+ my @trigger_switches = (@trigger_types, qw(all nocase stop once debug disabled));
540
+ # parameters (with an argument)
541
+ my @trigger_params = qw(pattern regexp command replace name);
542
+ # list of all options (including switches) for /TRIGGER ADD
543
+ my @trigger_add_options = (@trigger_switches, @trigger_params, keys(%filters));
544
+ # same for /TRIGGER CHANGE, this includes the -no<option>'s
545
+ my @trigger_options = map(($_,'no'.$_) ,@trigger_add_options);
546
+
547
+ # check the triggers on $signal's $parammessage parameter, for triggers with $condition set
548
+ # on $server in $channelname, for $nickname!$address
549
+ # set $parammessage to -1 if the signal doesn't have a message
550
+ # for signal without channel, nick or address, set to undef
551
+ sub check_signal_message {
552
+ my ($signal, $parammessage, $server, $channelname, $nickname, $address, $condition, $extra) = @_;
553
+ my ($changed, $stopped, $context, $need_rebuild);
554
+ my $message = ($parammessage == -1) ? '' : $signal->[$parammessage];
555
+
556
+ return if (!$triggers_by_type{$condition});
557
+
558
+ if ($recursion_depth > 10) {
559
+ Irssi::print("Trigger error: Maximum recursion depth reached, aborting trigger.", MSGLEVEL_CLIENTERROR);
560
+ return;
561
+ }
562
+ $recursion_depth++;
563
+
564
+ TRIGGER:
565
+ foreach my $trigger (@{$triggers_by_type{$condition}}) {
566
+ # check filters
567
+ foreach my $trigfilter (@{$trigger->{'filters'}}) {
568
+ if (! ($trigfilter->[2]($trigfilter->[1], $signal,$parammessage,$server,$channelname,$nickname,$address,$condition,$extra))) {
569
+
570
+ next TRIGGER;
571
+ }
572
+ }
573
+
574
+ # check regexp (and keep matches in @- and @+, so don't make a this a {block})
575
+ next if ($trigger->{'compregexp'} && ($parammessage == -1 || $message !~ m/$trigger->{'compregexp'}/));
576
+
577
+ # if we got this far, it fully matched, and we need to do the replace/command/stop/once
578
+ my $expands = $extra;
579
+ $expands->{'M'} = $message,;
580
+ $expands->{'T'} = (defined($server)) ? $server->{'tag'} : '';
581
+ $expands->{'C'} = $channelname;
582
+ $expands->{'N'} = $nickname;
583
+ $expands->{'A'} = $address;
584
+ $expands->{'I'} = ((!defined($address)) ? '' : substr($address,0,index($address,'@')));
585
+ $expands->{'H'} = ((!defined($address)) ? '' : substr($address,index($address,'@')+1));
586
+ $expands->{'$'} = '$';
587
+ $expands->{';'} = ';';
588
+
589
+ if (defined($trigger->{'replace'})) { # it's a -replace
590
+ $message =~ s/$trigger->{'compregexp'}/do_expands($trigger->{'compreplace'},$expands,$message)/ge;
591
+ $changed = 1;
592
+ }
593
+
594
+ if ($trigger->{'command'}) { # it's a (nonempty) -command
595
+ my $command = $trigger->{'command'};
596
+ # $1 = the stuff behind the $ we want to expand: a number, or a character from %expands
597
+ $command = do_expands($command, $expands, $message);
598
+
599
+ if (defined($server)) {
600
+ if (defined($channelname) && $server->channel_find($channelname)) {
601
+ $context = $server->channel_find($channelname);
602
+ } else {
603
+ $context = $server;
604
+ }
605
+ } else {
606
+ $context = undef;
607
+ }
608
+
609
+ if (defined($context)) {
610
+ $context->command("eval $command");
611
+ } else {
612
+ Irssi::command("eval $command");
613
+ }
614
+ }
615
+
616
+ if ($trigger->{'debug'}) {
617
+ print("DEBUG: trigger $condition pmesg=$parammessage message=$message server=$server->{tag} channel=$channelname nick=$nickname address=$address " . join(' ',map {$_ . '=' . $extra->{$_}} keys(%$extra)));
618
+ }
619
+
620
+ if ($trigger->{'stop'}) {
621
+ $stopped = 1;
622
+ }
623
+
624
+ if ($trigger->{'once'}) {
625
+ # find this trigger in the real trigger list, and remove it
626
+ for (my $realindex=0; $realindex < scalar(@triggers); $realindex++) {
627
+ if ($triggers[$realindex] == $trigger) {
628
+ splice (@triggers,$realindex,1);
629
+ last;
630
+ }
631
+ }
632
+ $need_rebuild = 1;
633
+ }
634
+ }
635
+
636
+ if ($need_rebuild) {
637
+ rebuild();
638
+ $changed_since_last_save = 1;
639
+ }
640
+ if ($stopped) { # stopped with -stop
641
+ signal_stop();
642
+ } elsif ($changed) { # changed with -replace
643
+ $signal->[$parammessage] = $message;
644
+ signal_continue(@$signal);
645
+ }
646
+ $recursion_depth--;
647
+ }
648
+
649
+ # used in check_signal_message to expand $'s
650
+ # $inthis is a string that can contain $ stuff (like 'foo$1bar$N')
651
+ sub do_expands {
652
+ my ($inthis, $expands, $from) = @_;
653
+ # @+ and @- are copied because there are two s/// nested, and the inner needs the $1 and $2,... of the outer one
654
+ my @plus = @+;
655
+ my @min = @-;
656
+ my $p = \@plus; my $m = \@min;
657
+ $inthis =~ s/\$(\\*(\d+|[^0-9x{]|x[0-9a-fA-F][0-9a-fA-F]|{.*?}))/expand_and_escape($1,$expands,$m,$p,$from)/ge;
658
+ return $inthis;
659
+ }
660
+
661
+ # \ $ and ; need extra escaping because we use eval
662
+ sub expand_and_escape {
663
+ my $retval = expand(@_);
664
+ $retval =~ s/([\\\$;])/\\\1/g;
665
+ return $retval;
666
+ }
667
+
668
+ # used in do_expands (via expand_and_escape), to_expand is the part after the $
669
+ sub expand {
670
+ my ($to_expand, $expands, $min, $plus, $from) = @_;
671
+ if ($to_expand =~ /^\d+$/) { # a number => look up in $vars
672
+ # from man perlvar:
673
+ # $3 is the same as "substr $var, $-[3], $+[3] - $-[3])"
674
+ return ($to_expand > @{$min} ? '' : substr($from,$min->[$to_expand],$plus->[$to_expand]-$min->[$to_expand]));
675
+ } elsif ($to_expand =~ s/^\\//) { # begins with \, so strip that from to_expand
676
+ my $exp = expand($to_expand,$expands,$min,$plus,$from); # first expand without \
677
+ $exp =~ s/([^a-zA-Z0-9])/\\\1/g; # escape non-word chars
678
+ return $exp;
679
+ } elsif ($to_expand =~ /^x([0-9a-fA-F]{2})/) { # $xAA
680
+ return chr(hex($1));
681
+ } elsif ($to_expand =~ /^{(.*?)}$/) { # ${foo}
682
+ return expand($1, $expands, $min, $plus, $from);
683
+ } else { # look up in $expands
684
+ return $expands->{$to_expand};
685
+ }
686
+ }
687
+
688
+ sub check_modes {
689
+ my ($has_modes, $need_modes) = @_;
690
+ my $matches;
691
+ my $switch = 1; # if a '-' if found, will be 0 (meaning the modes should not be set)
692
+ foreach my $need_mode (split /&/, $need_modes) {
693
+ $matches = 0;
694
+ foreach my $char (split //, $need_mode) {
695
+ if ($char eq '-') {
696
+ $switch = 0;
697
+ } elsif ($char eq '+') {
698
+ $switch = 1;
699
+ } elsif ((index($has_modes, $char) != -1) == $switch) {
700
+ $matches = 1;
701
+ last;
702
+ }
703
+ }
704
+ if (!$matches) {
705
+ return 0;
706
+ }
707
+ }
708
+ return 1;
709
+ }
710
+
711
+ # get someones flags from people.pl or friends(_shasta).pl
712
+ sub get_flags {
713
+ my ($chatnet, $channel, $nick, $address) = @_;
714
+ my $flags;
715
+ no strict 'refs';
716
+ if (defined %{ 'Irssi::Script::people::' }) {
717
+ if (defined ($channel)) {
718
+ $flags = (&{ 'Irssi::Script::people::find_local_flags' }($chatnet,$channel,$nick,$address));
719
+ } else {
720
+ $flags = (&{ 'Irssi::Script::people::find_global_flags' }($chatnet,$nick,$address));
721
+ }
722
+ $flags = join('',keys(%{$flags}));
723
+ } else {
724
+ my $shasta;
725
+ if (defined %{ 'Irssi::Script::friends_shasta::' }) {
726
+ $shasta = 'friends_shasta';
727
+ } elsif (defined &{ 'Irssi::Script::friends::get_idx' }) {
728
+ $shasta = 'friends';
729
+ } else {
730
+ return undef;
731
+ }
732
+ my $idx = (&{ 'Irssi::Script::'.$shasta.'::get_idx' }($nick, $address));
733
+ if ($idx == -1) {
734
+ return '';
735
+ }
736
+ $flags = (&{ 'Irssi::Script::'.$shasta.'::get_friends_flags' }($idx,undef));
737
+ if ($channel) {
738
+ $flags .= (&{ 'Irssi::Script::'.$shasta.'::get_friends_flags' }($idx,$channel));
739
+ }
740
+ }
741
+ return $flags;
742
+ }
743
+
744
+ ########################################################
745
+ ### internal stuff called by manage, needed by above ###
746
+ ########################################################
747
+
748
+ my %mask_to_regexp = ();
749
+ foreach my $i (0..255) {
750
+ my $ch = chr $i;
751
+ $mask_to_regexp{$ch} = "\Q$ch\E";
752
+ }
753
+ $mask_to_regexp{'?'} = '(.)';
754
+ $mask_to_regexp{'*'} = '(.*)';
755
+
756
+ sub compile_trigger {
757
+ my ($trigger) = @_;
758
+ my $regexp;
759
+
760
+ if ($trigger->{'regexp'}) {
761
+ $regexp = $trigger->{'regexp'};
762
+ } elsif ($trigger->{'pattern'}) {
763
+ $regexp = $trigger->{'pattern'};
764
+ $regexp =~ s/(.)/$mask_to_regexp{$1}/g;
765
+ } else {
766
+ delete $trigger->{'compregexp'};
767
+ return;
768
+ }
769
+
770
+ if ($trigger->{'nocase'}) {
771
+ $regexp = '(?i)' . $regexp;
772
+ }
773
+
774
+ $trigger->{'compregexp'} = qr/$regexp/;
775
+
776
+ if(defined($trigger->{'replace'})) {
777
+ (my $replace = $trigger->{'replace'}) =~ s/\$/\$\$/g;
778
+ $trigger->{'compreplace'} = Irssi::parse_special($replace);
779
+ }
780
+ }
781
+
782
+ # rebuilds triggers_by_type and updates signal binds
783
+ sub rebuild {
784
+ %triggers_by_type = ();
785
+ foreach my $trigger (@triggers) {
786
+ if (!$trigger->{'disabled'}) {
787
+ if ($trigger->{'all'}) {
788
+ # -all is an alias for all types in @all_types for which the filters can apply
789
+ ALLTYPES:
790
+ foreach my $type (@all_types) {
791
+ # check if all filters can apply to $type
792
+ foreach my $filter (@{$trigger->{'filters'}}) {
793
+ if (! grep {$_ eq $type} $filters{$filter->[0]}->{'types'}) {
794
+ next ALLTYPES;
795
+ }
796
+ }
797
+ push @{$triggers_by_type{$type}}, ($trigger);
798
+ }
799
+ }
800
+
801
+ foreach my $type ($trigger->{'all'} ? @notall_types : @trigger_types) {
802
+ if ($trigger->{$type}) {
803
+ push @{$triggers_by_type{$type}}, ($trigger);
804
+ }
805
+ }
806
+ }
807
+ }
808
+
809
+ foreach my $signal (@signals) {
810
+ my $should_bind = 0;
811
+ foreach my $type (@{$signal->{'types'}}) {
812
+ if (defined($triggers_by_type{$type})) {
813
+ $should_bind = 1;
814
+ }
815
+ }
816
+ if ($should_bind && !$signal->{'bind'}) {
817
+ signal_add_first($signal->{'signal'}, $signal->{'sub'});
818
+ $signal->{'bind'} = 1;
819
+ } elsif (!$should_bind && $signal->{'bind'}) {
820
+ signal_remove($signal->{'signal'}, $signal->{'sub'});
821
+ $signal->{'bind'} = 0;
822
+ }
823
+ }
824
+ }
825
+
826
+ ################################
827
+ ### manage the triggers-list ###
828
+ ################################
829
+
830
+ my $trigger_file; # cached setting
831
+
832
+ sub sig_setup_changed {
833
+ $trigger_file = Irssi::settings_get_str('trigger_file');
834
+ }
835
+
836
+ sub autosave {
837
+ cmd_save() if ($changed_since_last_save);
838
+ }
839
+
840
+ # TRIGGER SAVE
841
+ sub cmd_save {
842
+ my $io = new IO::File $trigger_file, "w";
843
+ if (defined $io) {
844
+ $io->print("#Triggers file version $VERSION\n");
845
+ foreach my $trigger (@triggers) {
846
+ $io->print(to_string($trigger) . "\n");
847
+ }
848
+ $io->close;
849
+ }
850
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'trigger_saved', $trigger_file);
851
+ $changed_since_last_save = 0;
852
+ }
853
+
854
+ # save on unload
855
+ sub UNLOAD {
856
+ cmd_save();
857
+ }
858
+
859
+ # TRIGGER LOAD
860
+ sub cmd_load {
861
+ sig_setup_changed(); # make sure we've read the trigger_file setting
862
+ my $converted = 0;
863
+ my $io = new IO::File $trigger_file, "r";
864
+ if (not defined $io) {
865
+ if (-e $trigger_file) {
866
+ Irssi::print("Error opening triggers file", MSGLEVEL_CLIENTERROR);
867
+ }
868
+ return;
869
+ }
870
+ if (defined $io) {
871
+ @triggers = ();
872
+ my $text;
873
+ $text = $io->getline;
874
+ my $file_version = '';
875
+ if ($text =~ /^#Triggers file version (.*)\n/) {
876
+ $file_version = $1;
877
+ }
878
+ if ($file_version lt '0.6.1+2') {
879
+ no strict 'vars';
880
+ $text .= $_ foreach ($io->getlines);
881
+ my $rep = eval "$text";
882
+ if (! ref $rep) {
883
+ Irssi::print("Error in triggers file");
884
+ return;
885
+ }
886
+ my @old_triggers = @$rep;
887
+
888
+ for (my $index=0;$index < scalar(@old_triggers);$index++) {
889
+ my $trigger = $old_triggers[$index];
890
+
891
+ if ($file_version lt '0.6.1') {
892
+ # convert old names: notices => pubnotices, actions => pubactions
893
+ foreach $oldname ('notices','actions') {
894
+ if ($trigger->{$oldname}) {
895
+ delete $trigger->{$oldname};
896
+ $trigger->{'pub'.$oldname} = 1;
897
+ $converted = 1;
898
+ }
899
+ }
900
+ }
901
+ if ($file_version lt '0.6.1+1' && $trigger->{'modifiers'}) {
902
+ if ($trigger->{'modifiers'} =~ /i/) {
903
+ $trigger->{'nocase'} = 1;
904
+ Irssi::print("Trigger: trigger ".($index+1)." had 'i' in it's modifiers, it has been converted to -nocase");
905
+ }
906
+ if ($trigger->{'modifiers'} !~ /^[ig]*$/) {
907
+ Irssi::print("Trigger: trigger ".($index+1)." had unrecognised modifier '". $trigger->{'modifiers'} ."', which couldn't be converted.");
908
+ }
909
+ delete $trigger->{'modifiers'};
910
+ $converted = 1;
911
+ }
912
+
913
+ if (defined($trigger->{'replace'}) && ! $trigger->{'regexp'}) {
914
+ Irssi::print("Trigger: trigger ".($index+1)." had -replace but no -regexp, removed it");
915
+ splice (@old_triggers,$index,1);
916
+ $index--; # nr of next trigger now is the same as this one was
917
+ }
918
+
919
+ # convert to text with compat, and then to new trigger hash
920
+ $text = to_string($trigger,1);
921
+ my @args = &shellwords($text . ' a');
922
+ my $trigger = parse_options({},@args);
923
+ if ($trigger) {
924
+ push @triggers, $trigger;
925
+ }
926
+ }
927
+ } else { # new format
928
+ while ( $text = $io->getline ) {
929
+ chop($text);
930
+ my @args = &shellwords($text . ' a');
931
+ my $trigger = parse_options({},@args);
932
+ if ($trigger) {
933
+ push @triggers, $trigger;
934
+ }
935
+ }
936
+ }
937
+ }
938
+ Irssi::printformat(MSGLEVEL_CLIENTNOTICE, 'trigger_loaded', $trigger_file);
939
+ if ($converted) {
940
+ Irssi::print("Trigger: Triggers file will be in new format next time it's saved.");
941
+ }
942
+ rebuild();
943
+ }
944
+
945
+ # escape for printing with to_string
946
+ # <<abcdef>> => << 'abcdef' >>
947
+ # <<abc'def>> => << "abc'def" >>
948
+ # <<abc'def\x02>> => << 'abc'\''def\x02' >>
949
+ sub param_to_string {
950
+ my ($text) = @_;
951
+ # avoid ugly escaping if we can use "-quotes without other escaping (no " or \)
952
+ if ($text =~ /^[^"\\]*'[^"\\]$/) {
953
+ return ' "' . $text . '" ';
954
+ }
955
+ # "'" signs without a (odd number of) \ in front of them, need be to escaped as '\''
956
+ # this is ugly :(
957
+ $text =~ s/(^|[^\\](\\\\)*)'/$1'\\''/g;
958
+ return " '$text' ";
959
+ }
960
+
961
+ # converts a trigger back to "-switch -options 'foo'" form
962
+ # if $compat, $trigger is in the old format (used to convert)
963
+ sub to_string {
964
+ my ($trigger, $compat) = @_;
965
+ my $string;
966
+
967
+ foreach my $switch (@trigger_switches) {
968
+ if ($trigger->{$switch}) {
969
+ $string .= '-'.$switch.' ';
970
+ }
971
+ }
972
+
973
+ if ($compat) {
974
+ foreach my $filter (keys(%filters)) {
975
+ if ($trigger->{$filter}) {
976
+ $string .= '-' . $filter . param_to_string($trigger->{$filter});
977
+ }
978
+ }
979
+ } else {
980
+ foreach my $trigfilter (@{$trigger->{'filters'}}) {
981
+ $string .= '-' . $trigfilter->[0] . param_to_string($trigfilter->[1]);
982
+ }
983
+ }
984
+
985
+ foreach my $param (@trigger_params) {
986
+ if ($trigger->{$param} || ($param eq 'replace' && defined($trigger->{'replace'}))) {
987
+ $string .= '-' . $param . param_to_string($trigger->{$param});
988
+ }
989
+ }
990
+ return $string;
991
+ }
992
+
993
+ # find a trigger (for REPLACE and DELETE), returns index of trigger, or -1 if not found
994
+ sub find_trigger {
995
+ my ($data) = @_;
996
+ if ($data =~ /^[0-9]*$/ and defined($triggers[$data-1])) {
997
+ return $data-1;
998
+ } else {
999
+ for (my $i=0; $i < scalar(@triggers); $i++) {
1000
+ if ($triggers[$i]->{'name'} eq $data) {
1001
+ return $i;
1002
+ }
1003
+ }
1004
+ }
1005
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_not_found', $data);
1006
+ return -1; # not found
1007
+ }
1008
+
1009
+
1010
+ # TRIGGER ADD <options>
1011
+ sub cmd_add {
1012
+ my ($data, $server, $item) = @_;
1013
+ my @args = shellwords($data . ' a');
1014
+
1015
+ my $trigger = parse_options({}, @args);
1016
+ if ($trigger) {
1017
+ push @triggers, $trigger;
1018
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_added', scalar(@triggers), to_string($trigger));
1019
+ rebuild();
1020
+ $changed_since_last_save = 1;
1021
+ }
1022
+ }
1023
+
1024
+ # TRIGGER CHANGE <nr> <options>
1025
+ sub cmd_change {
1026
+ my ($data, $server, $item) = @_;
1027
+ my @args = shellwords($data . ' a');
1028
+ my $index = find_trigger(shift @args);
1029
+ if ($index != -1) {
1030
+ if(parse_options($triggers[$index], @args)) {
1031
+ Irssi::print("Trigger " . ($index+1) ." changed to: ". to_string($triggers[$index]));
1032
+ }
1033
+ rebuild();
1034
+ $changed_since_last_save = 1;
1035
+ }
1036
+ }
1037
+
1038
+ # parses options for TRIGGER ADD and TRIGGER CHANGE
1039
+ # if invalid args returns undef, else changes $thetrigger and returns it
1040
+ sub parse_options {
1041
+ my ($thetrigger,@args) = @_;
1042
+ my ($trigger, $option);
1043
+
1044
+ if (pop(@args) ne 'a') {
1045
+ Irssi::print("Syntax error, probably missing a closing quote", MSGLEVEL_CLIENTERROR);
1046
+ return undef;
1047
+ }
1048
+
1049
+ %$trigger = %$thetrigger; # make a copy to prevent changing the given trigger if args doesn't parse
1050
+ ARGS: for (my $arg = shift @args; $arg; $arg = shift @args) {
1051
+ # expand abbreviated options, put in $option
1052
+ $arg =~ s/^-//;
1053
+ $option = undef;
1054
+ foreach my $ioption (@trigger_options) {
1055
+ if (index($ioption, $arg) == 0) { # -$opt starts with $arg
1056
+ if ($option) { # another already matched
1057
+ Irssi::print("Ambiguous option: $arg", MSGLEVEL_CLIENTERROR);
1058
+ return undef;
1059
+ }
1060
+ $option = $ioption;
1061
+ last if ($arg eq $ioption); # exact match is unambiguous
1062
+ }
1063
+ }
1064
+ if (!$option) {
1065
+ Irssi::print("Unknown option: $arg", MSGLEVEL_CLIENTERROR);
1066
+ return undef;
1067
+ }
1068
+
1069
+ # -<param> <value> or -no<param>
1070
+ foreach my $param (@trigger_params) {
1071
+ if ($option eq $param) {
1072
+ $trigger->{$param} = shift @args;
1073
+ next ARGS;
1074
+ }
1075
+ if ($option eq 'no'.$param) {
1076
+ $trigger->{$param} = undef;
1077
+ next ARGS;
1078
+ }
1079
+ }
1080
+
1081
+ # -[no]<switch>
1082
+ foreach my $switch (@trigger_switches) {
1083
+ # -<switch>
1084
+ if ($option eq $switch) {
1085
+ $trigger->{$switch} = 1;
1086
+ next ARGS;
1087
+ }
1088
+ # -no<switch>
1089
+ elsif ($option eq 'no'.$switch) {
1090
+ $trigger->{$switch} = undef;
1091
+ next ARGS;
1092
+ }
1093
+ }
1094
+
1095
+ # -<filter> <value>
1096
+ if ($filters{$option}) {
1097
+ push @{$trigger->{'filters'}}, [$option, shift @args, $filters{$option}->{'sub'}];
1098
+ next ARGS;
1099
+ }
1100
+
1101
+ # -<nofilter>
1102
+ if ($option =~ /^no(.*)$/ && $filters{$1}) {
1103
+ my $filter = $1;
1104
+ # the new filters are the old grepped for everything except ones with name $filter
1105
+ @{$trigger->{'filters'}} = grep( $_->[0] ne $filter, @{$trigger->{'filters'}} );
1106
+ }
1107
+ }
1108
+
1109
+ if (defined($trigger->{'replace'}) && ! $trigger->{'regexp'} && !$trigger->{'pattern'}) {
1110
+ Irssi::print("Trigger error: Can't have -replace without -regexp", MSGLEVEL_CLIENTERROR);
1111
+ return undef;
1112
+ }
1113
+
1114
+ if ($trigger->{'pattern'} && $trigger->{'regexp'}) {
1115
+ Irssi::print("Trigger error: Can't have -pattern and -regexp in same trigger", MSGLEVEL_CLIENTERROR);
1116
+ return undef;
1117
+ }
1118
+
1119
+ # remove types that are implied by -all
1120
+ if ($trigger->{'all'}) {
1121
+ foreach my $type (@all_types) {
1122
+ delete $trigger->{$type};
1123
+ }
1124
+ }
1125
+
1126
+ # remove types for which the filters don't apply
1127
+ foreach my $type (@trigger_types) {
1128
+ if ($trigger->{$type}) {
1129
+ foreach my $filter (@{$trigger->{'filters'}}) {
1130
+ if (!grep {$_ eq $type} @{$filters{$filter->[0]}->{'types'}}) {
1131
+ Irssi::print("Warning: the filter -" . $filter->[0] . " can't apply to an event of type -$type, so I'm removing that type from this trigger.");
1132
+ delete $trigger->{$type};
1133
+ }
1134
+ }
1135
+ }
1136
+ }
1137
+
1138
+ # check if it has at least one type
1139
+ my $has_a_type;
1140
+ foreach my $type (@trigger_types) {
1141
+ if ($trigger->{$type}) {
1142
+ $has_a_type = 1;
1143
+ last;
1144
+ }
1145
+ }
1146
+ if (!$has_a_type && !$trigger->{'all'}) {
1147
+ Irssi::print("Warning: this trigger doesn't trigger on any type of message. you probably want to add -publics or -all");
1148
+ }
1149
+
1150
+ compile_trigger($trigger);
1151
+ %$thetrigger = %$trigger; # copy changes to real trigger
1152
+ return $thetrigger;
1153
+ }
1154
+
1155
+ # TRIGGER DELETE <num>
1156
+ sub cmd_del {
1157
+ my ($data, $server, $item) = @_;
1158
+ my @args = shellwords($data);
1159
+ my $index = find_trigger(shift @args);
1160
+ if ($index != -1) {
1161
+ Irssi::print("Deleted ". ($index+1) .": ". to_string($triggers[$index]));
1162
+ splice (@triggers,$index,1);
1163
+ rebuild();
1164
+ $changed_since_last_save = 1;
1165
+ }
1166
+ }
1167
+
1168
+ # TRIGGER MOVE <num> <num>
1169
+ sub cmd_move {
1170
+ my ($data, $server, $item) = @_;
1171
+ my @args = &shellwords($data);
1172
+ my $index = find_trigger(shift @args);
1173
+ if ($index != -1) {
1174
+ my $newindex = shift @args;
1175
+ if ($newindex < 1 || $newindex > scalar(@triggers)) {
1176
+ Irssi::print("$newindex is not a valid trigger number");
1177
+ return;
1178
+ }
1179
+ Irssi::print("Moved from ". ($index+1) ." to $newindex: ". to_string($triggers[$index]));
1180
+ $newindex -= 1; # array starts counting from 0
1181
+ my $trigger = splice (@triggers,$index,1); # remove from old place
1182
+ splice (@triggers,$newindex,0,($trigger)); # insert at new place
1183
+ rebuild();
1184
+ $changed_since_last_save = 1;
1185
+ }
1186
+ }
1187
+
1188
+ # TRIGGER LIST
1189
+ sub cmd_list {
1190
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_header');
1191
+ my $i=1;
1192
+ foreach my $trigger (@triggers) {
1193
+ Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'trigger_line', $i++, to_string($trigger));
1194
+ }
1195
+ }
1196
+
1197
+ ######################
1198
+ ### initialisation ###
1199
+ ######################
1200
+
1201
+ command_bind('trigger help',\&cmd_help);
1202
+ command_bind('help trigger',\&cmd_help);
1203
+ command_bind('trigger add',\&cmd_add);
1204
+ command_bind('trigger change',\&cmd_change);
1205
+ command_bind('trigger move',\&cmd_move);
1206
+ command_bind('trigger list',\&cmd_list);
1207
+ command_bind('trigger delete',\&cmd_del);
1208
+ command_bind('trigger save',\&cmd_save);
1209
+ command_bind('trigger reload',\&cmd_load);
1210
+ command_bind 'trigger' => sub {
1211
+ my ( $data, $server, $item ) = @_;
1212
+ $data =~ s/\s+$//g;
1213
+ command_runsub('trigger', $data, $server, $item);
1214
+ };
1215
+
1216
+ Irssi::signal_add('setup saved', \&autosave);
1217
+ Irssi::signal_add('setup changed', \&sig_setup_changed);
1218
+
1219
+ # This makes tab completion work
1220
+ Irssi::command_set_options('trigger add',join(' ',@trigger_add_options));
1221
+ Irssi::command_set_options('trigger change',join(' ',@trigger_options));
1222
+
1223
+ Irssi::settings_add_str($IRSSI{'name'}, 'trigger_file', Irssi::get_irssi_dir()."/triggers");
1224
+
1225
+ cmd_load();