1 # ho_operwall.pl
  2 #
  3 # $Id: ho_operwall.pl,v 1.15 2004/10/02 10:10:21 jvunder REL_0_3 $
  4 #
  5 # Part of the Hybrid Oper Script Collection (I hope)
  6 #
  7 # This script grabs all wallops starting OPERWALL and
  8 # reformats them with the "operwall" format, and sends them to
  9 # the 'operwall' window.
 10 #
 11 
 12 # ---------------------------------------------------------------------
 13 
 14 use strict;
 15 use Irssi;
 16 use Irssi::Irc;
 17 use HOSC::again;
 18 use HOSC::again 'HOSC::Base';
 19 use HOSC::again 'HOSC::Tools';
 20 import HOSC::Tools qw{get_named_token};
 21 
 22 use vars qw[$VERSION %IRSSI $SCRIPT_NAME];
 23 
 24 $SCRIPT_NAME = 'Operwall';
 25 ($VERSION) = '$Revision: 1.15 $' =~ / (\d+\.\d+) /;
 26 %IRSSI = (
 27     authors     => 'James Seward',
 28     contact     => 'james@jamesoff.net', 
 29     name        => 'ho_operwall',
 30     description => 'Sends operwall and locops messages named windows.',
 31     license     => 'Public Domain',
 32     url         => 'http://www.jamesoff.net/irc',
 33     changed     => '06/04/2004 08:15',
 34     changes     => 'v1.2 - fixed typo',
 35 );
 36 
 37 # ---------------------------------------------------------------------
 38 #
 39 # Thanks to:
 40 # Garion - for creating the hosc project :)
 41 #
 42 # ---------------------------------------------------------------------
 43 # catch a line typed in any operwall window, and operwall it to the
 44 # server
 45 
 46 # Keeps track of the most recent operwall messages per tag. Used to
 47 # prevent duplication of operwalls.
 48 my %operwall_history;
 49 
 50 # ---------------------------------------------------------------------
 51 
 52 sub cmd_operwall {
 53     my ($args, $server, $item) = @_;
 54 
 55     if ($args =~ m/^(status)|(help)|(example)/i ) {
 56         Irssi::command_runsub ('operwall', $args, $server, $item);
 57         return;
 58     }
 59 
 60     print_usage();
 61 }
 62 
 63 # ---------------------------------------------------------------------
 64 
 65 sub cmd_operwall_help {
 66     print_help();
 67 }
 68 
 69 # ---------------------------------------------------------------------
 70 
 71 sub cmd_operwall_status {
 72     print_status();
 73 }
 74 
 75 # ---------------------------------------------------------------------
 76 
 77 sub cmd_operwall_example {
 78     print_example();
 79 }
 80 
 81 # ---------------------------------------------------------------------
 82 
 83 sub event_operwall_text {
 84     my ( $text, $server, $witem ) = @_;
 85     my $active_window = Irssi::active_win();
 86 
 87     # Only process typed text in named windows.
 88     return unless length $active_window->{name} > 0;
 89 
 90     my $sdata = get_send_data_for_windowname(lc $active_window->{name});
 91     return unless defined $sdata->{type};
 92 
 93     for my $tag (@{ $sdata->{servers} }) {
 94         if ($tag eq 'active server') {
 95             # special tag!
 96             my $server = Irssi::active_server();
 97             if (!defined $server) {
 98                 ho_print_error("No active server in this window.");
 99                 return;
100             }
101             if ($sdata->{type} eq 'operwall') {
102                 $server->send_raw_now("OPERWALL :$text");
103             } else {
104                 $server->send_raw_now("LOCOPS :$text");
105             }
106             return;
107         }
108         my $server = Irssi::server_find_tag($tag);
109         next unless defined $server;
110         next unless $server->{server_operator} or $server->{usermode} =~ /o/i;
111 
112         if ($sdata->{type} eq 'operwall') {
113             $server->send_raw_now("OPERWALL :$text");
114         } else {
115             $server->send_raw_now("LOCOPS :$text");
116         }
117         return;
118     }
119 
120     ho_print_warning("Not connected to a server in (" .
121         (join ',', @{ $sdata->{servers} }) . ") for this window.");
122 }
123 
124 # ---------------------------------------------------------------------
125 # catch an incoming wallop and reformat if it's an operwall
126 
127 sub event_wallop {
128     my ($server, $args, $sender, $addr) = @_;
129 
130     clear_operwall_history();
131 
132     my @ignorenicks = split(/ +/, Irssi::settings_get_str("ho_operwall_ignore"));
133     if (grep /^$sender$/, @ignorenicks) {
134         Irssi::signal_stop();
135         return;
136     }
137  
138     if ($args =~ s/^:OPERWALL - //) {
139         process_incoming_operwall($server, $sender, $args);
140     }
141     
142     if ($args =~ s/^:LOCOPS - //) {
143         process_incoming_locops($server, $sender, $args);
144     }
145 }
146 
147 # ---------------------------------------------------------------------
148 
149 sub process_incoming_operwall {
150     my ($server, $sender, $text) = @_;
151     my $tag    = $server->{tag};
152     my $lc_tag = lc $tag;
153 
154     my $window_name = get_named_token(
155         lc Irssi::settings_get_str('ho_operwall_operwall_windows'), 
156         $lc_tag);
157 
158     # Fergot about it if no window has been found.
159     return if length $window_name == 0;
160 
161     if ($window_name eq 'devnull') {
162         Irssi::signal_stop();
163         return;
164     }
165 
166     my $win = Irssi::window_find_name(lc $window_name);
167 
168     if (!defined $win) {
169         ho_print_error("Operwall: window named $window_name for tag " .
170             "$tag not found.");
171         return;
172     }
173 
174     Irssi::signal_stop();
175 
176     return if already_displayed($server, $sender, $text);
177 
178     add_to_history($server, $sender, $text);
179 
180     my @prepend_tags = split / +/, 
181         lc Irssi::settings_get_str('ho_operwall_ow_prepend_tag');
182     
183     if (grep /^$lc_tag$/, @prepend_tags) {
184         $win->printformat(MSGLEVEL_WALLOPS | MSGLEVEL_CLIENTCRAP, 
185             'ho_operwall_tag', $tag, $sender, $text);
186     } else {
187         $win->printformat(MSGLEVEL_WALLOPS | MSGLEVEL_CLIENTCRAP, 
188             'ho_operwall', $sender, $text);
189     }
190 }
191 
192 # ---------------------------------------------------------------------
193 
194 sub process_incoming_locops {
195     my ($server, $sender, $args) = @_;
196     my $tag    = $server->{'tag'};
197     my $lc_tag = lc $tag;
198 
199     my $window_name = get_named_token(
200         lc Irssi::settings_get_str('ho_operwall_locops_windows'), 
201         $lc_tag);
202 
203     # Fergot about it if no window has been found.
204     return if length $window_name == 0;
205 
206     if ($window_name eq 'devnull') {
207         Irssi::signal_stop();
208         return;
209     }
210 
211     my $win = Irssi::window_find_name(lc $window_name);
212 
213     if (!defined $win) {
214         ho_print_error("Locops: window named $window_name for tag " .
215             "$tag not found.");
216         return;
217     }
218 
219     Irssi::signal_stop();
220     
221     my @prepend_tags = split / +/, 
222         lc Irssi::settings_get_str('ho_operwall_lo_prepend_tag');
223     
224     if (grep /^$lc_tag$/, @prepend_tags) {
225         $win->printformat(MSGLEVEL_WALLOPS | MSGLEVEL_CLIENTCRAP, 
226             'ho_locops_tag', $tag, $sender, $args);
227     } else {
228         $win->printformat(MSGLEVEL_WALLOPS | MSGLEVEL_CLIENTCRAP, 
229             'ho_locops', $sender, $args);
230     }
231 }
232 
233 # ---------------------------------------------------------------------
234 
235 sub get_send_data_for_windowname {
236     my ($windowname) = @_;
237 
238     my %data = (
239         type    => undef,
240         servers => [],
241     );
242 
243     for my $type (qw[operwall locops]) {
244         my $windows = Irssi::settings_get_str("ho_operwall_".$type."_windows");
245 
246         for my $dest (split /\s+/, $windows) {
247             if ($dest =~ /^([^:]+):$windowname$/) {
248                 push @{ $data{servers} }, $1;
249             } elsif ($dest eq $windowname) {
250                 $data{type} = $type;
251                 push @{ $data{servers} }, 'active server';
252                 return \%data;
253             }
254         }
255 
256         if (@{ $data{servers} } > 0) {
257             $data{type} = $type;
258             return \%data;
259         }
260     }
261 
262     return \%data;
263 }
264 
265 # ---------------------------------------------------------------------
266 
267 sub add_to_history {
268     my ($server, $sender, $text) = @_;
269 
270     my $group = get_group(lc $server->{tag});
271     return unless $group;
272 
273     my $item = {
274         ts     => time(),
275         sender => $sender,
276         text   => $text,
277     };
278     
279     push @{ $operwall_history{$group} }, $item;
280 }
281 
282 # ---------------------------------------------------------------------
283 
284 sub clear_operwall_history {
285     my $history_time = Irssi::settings_get_int('ho_operwall_history_time');
286 
287     my %new_history;
288     my $now = time();
289 
290     for my $group (keys %operwall_history) {
291         my @history_items = @{ $operwall_history{$group} };
292         for my $msg (@history_items) {
293             if ($msg->{ts} >= $now - $history_time) {
294                 push @{ $new_history{$group} }, $msg;
295             }
296         }
297     }
298 
299     undef %operwall_history;
300     %operwall_history = %new_history;
301 }
302 
303 # ---------------------------------------------------------------------
304 
305 sub already_displayed {
306     my ($server, $sender, $text) = @_;
307 
308     my $group = get_group(lc $server->{tag});
309     return 0 unless $group;
310 
311     my $now = time();
312     my $history_time = Irssi::settings_get_int('ho_operwall_history_time');
313     return 0 unless defined $operwall_history{$group}; 
314 
315     my @history_items = @{ $operwall_history{$group} };
316     for my $msg (@history_items) {
317         if ($msg->{ts} >= $now - $history_time &&
318             $msg->{sender} eq $sender &&
319             $msg->{text} eq $text
320         ) {
321             return 1;
322         }
323     }
324     
325     return 0;
326 }
327 
328 # ---------------------------------------------------------------------
329 
330 sub get_group {
331     my ($tag) = @_;
332     my @groups = 
333         split /\s+/, lc Irssi::settings_get_str('ho_operwall_groups');
334 
335     for my $group (@groups) {
336         my @servers = split /,/, $group;
337         next unless grep /^$tag$/, @servers;
338         return $group;
339     }
340 
341     return undef;
342 }
343 
344 # ---------------------------------------------------------------------
345 # Still ugly, but will be improved.
346 
347 sub print_status {
348     ho_print("Operwall/Locops status.");
349 
350     my %target_windows;
351 
352     ho_print("Recv. OW.  Network     Target window");
353     my $windows = Irssi::settings_get_str("ho_operwall_operwall_windows");
354     for my $dest (split /\s+/, $windows) {
355         if ($dest =~ /^([^:]+):(.+)$/) {
356             $target_windows{$2} = 1;
357             ho_print((' ' x 11) . $1 . (' ' x (12 - length $1)) . $2);
358         } else {
359             $target_windows{$dest} = 1;
360             ho_print((' ' x 11) . "[rest]      $dest");
361         }
362     }
363 
364     ho_print("Recv. LO.  Network     Target window");
365     my $windows = Irssi::settings_get_str("ho_operwall_locops_windows");
366     for my $dest (split /\s+/, $windows) {
367         if ($dest =~ /^([^:]+):(.+)$/) {
368             $target_windows{$2} = 1;
369             ho_print((' ' x 11) . $1 . (' ' x (12 - length $1)) . $2);
370         } else {
371             $target_windows{$dest} = 1;
372             ho_print((' ' x 11) . "[rest]      $dest");
373         }
374     }
375 
376     ho_print("Sent OW/LO Window name Type      Target server");
377     for my $window_name (sort keys %target_windows) {
378         my $data = get_send_data_for_windowname($window_name);
379         if (defined $data->{type}) {
380             ho_print((' ' x 11) . $window_name . 
381                 (' ' x (11 - length $window_name)) . " " . $data->{type}.
382                 (' ' x (10 - length $data->{type})) .
383                 join ', ', @{ $data->{servers} });
384         } else {
385             ho_print("$window_name: ERROR");
386         }
387     }
388 }
389 
390 # ---------------------------------------------------------------------
391 
392 ho_print_init_begin();
393 
394 Irssi::theme_register([
395     # i like my nicks right-aligned to 9 chars, with overspill
396     'ho_operwall',     '[{nick $[!-9]0}] $1-',
397     'ho_locops',       '[{nick $[!-9]0}] $1-',
398     'ho_operwall_tag', '[$0] [{nick $[!-9]1}] $2-',
399     'ho_locops_tag',   '[$0] [{nick $[!-9]1}] $2-',
400 ]);
401 
402 Irssi::signal_add('send text',     'event_operwall_text');
403 Irssi::signal_add('event wallops', 'event_wallop');
404 
405 Irssi::settings_add_str("ho",  "ho_operwall_ignore",       '');
406 
407 Irssi::settings_add_str('ho',  'ho_operwall_operwall_windows', 'operwall');
408 Irssi::settings_add_str('ho',  'ho_operwall_locops_windows',   'locops');
409 Irssi::settings_add_str('ho',  'ho_operwall_groups',           '');
410 Irssi::settings_add_int('ho',  'ho_operwall_history_time',     15);
411 Irssi::settings_add_str('ho',  'ho_operwall_ow_prepend_tag',   '');
412 Irssi::settings_add_str('ho',  'ho_operwall_lo_prepend_tag',   '');
413 
414 Irssi::command_bind('operwall',         'cmd_operwall');
415 Irssi::command_bind('operwall help',    'cmd_operwall_help');
416 Irssi::command_bind('operwall example', 'cmd_operwall_example');
417 Irssi::command_bind('operwall status',  'cmd_operwall_status');
418 
419 ho_print("If you have an alias '/OPERWALL', remove that for optimal ".
420     "functionality of this script.");
421 ho_print("Use /OPERWALL HELP for help.");
422 ho_print_init_end();
423 
424 # ---------------------------------------------------------------------
425 
426 sub print_usage {
427     ho_print_help('section', 'Syntax');
428     ho_print_help('syntax', 'OPERWALL help');
429     ho_print_help('syntax', 'OPERWALL example');
430     ho_print_help('syntax', 'OPERWALL status');
431 }
432 
433 sub print_help {
434     ho_print_help('head', $SCRIPT_NAME);
435 
436     print_usage();
437 
438     ho_print_help('section', 'Description');
439     ho_print_help('This script reformats all OPERWALL and LOCOPS '.
440         "messages and sends them to the right windows. Also, it allows ".
441         "text to be typed in those windows, which will then be sent as ".
442         "OPERWALL or LOCOPS message to the right server.\n");
443     ho_print_help("If you only oper on one server, forget about the ".
444         "complex settings and just create a window named 'operwall' and ".
445         "one named 'locops'.\n");
446     ho_print_help("If you want to use the script to manipulate ".
447         "OPERWALL and LOCOPS for multiple servers on multiple networks, ".
448         "read the explanation of the settings carefully. The meaning of " .
449         "the settings is best shown by example: /OPERWALL EXAMPLE.\n");
450 
451     ho_print_help('section', 'Settings');
452     ho_print_help('setting', 'ho_operwall_operwall_windows',
453         'Destination windows of OPERWALL messages. '.
454         'This is a multitoken. See /HO HELP MULTITOKEN');
455     ho_print_help('setting', 'ho_operwall_locops_windows',
456         'Destination windows of LOCOPS messages. '.
457         'This is a multitoken. See /HO HELP MULTITOKEN');
458     ho_print_help('setting', 'ho_operwall_groups',
459         'Space separated list of comma separated network tags. Each comma '.
460         'separated list defines one group of tags which are considered to '.
461         'be on the same network.');
462     ho_print_help('setting', 'ho_operwall_ow_prepend_tag',
463         'Space separated list of network tags for which each operwall '.
464         'message must have [tag] in front of it.');
465     ho_print_help('setting', 'ho_operwall_lo_prepend_tag',
466         'Space separated list of network tags for which each locops '.
467         'message must have [tag] in front of it.');
468 }
469 
470 sub print_example {
471     ho_print_help('section', 'Example');
472 
473     ho_print_help("Consider the following settings:\n");
474     ho_print_help('setting', "ho_operwall_operwall_windows", 
475         "operwall cnqnet:ow_cnq vuurwerk:ow_efnet ".
476         "dkom:ow_efnet blackened:ow_efnet test1:blah test2:blah");
477     ho_print_help('setting', "ho_operwall_locops_windows",
478         "locops vuurwerk:lo_vuurwerk test1:bleh test2:devnull");
479     ho_print_help('setting', "ho_operwall_groups",
480         "vuurwerk,dkom,blackened test1,test2\n");
481 
482     ho_print_help("Operwalls for network tag 'cnqnet' will be sent to the ".
483         "window named 'ow_cnq'. Operwalls for tags 'vuurwerk', 'dkom', and ".
484         "'blackened' all go to the window 'ow_efnet'. The operwalls for ".
485         "'test1' and 'test2' both go to window 'blah', and all other ".
486         "operwalls go to window 'operwall'.\n");
487     ho_print_help("When typing in window 'ow_cnq', the script can see ".
488         "that this should be an Operwall message for tag 'cnqnet', so ".
489         "it will search for the server with that tag and send the operwall ".
490         "to there.");
491     ho_print_help("For a message in window 'ow_efnet', the script will " .
492         "first see if a connection to tag 'vuurwerk' exists. If so, that " .
493         "is used to send the operwall. If not, the script will try tags ".
494         "'dkom' and 'blackened', i.e. the same order as in the setting.\n");
495     ho_print_help("If the client is receiving operwall messages for all ".
496         "three tags that send to ow_efnet, the script will still only ".
497         "display each message once. That is because the ho_operwall_groups ".
498         "setting indicates that these three servers are on the same ".
499         "network.\n");
500     ho_print_help("For Locops message, the same rules are followed, except ".
501         "that they can't be grouped.");
502 }


syntax highlighted by Code2HTML, v. 0.9.1