doc_gonzo

trigger.pl 1.2.4

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