html/mangle.pl
1 #!/usr/bin/perl
2 #
3 # by Szymon Sokol <szymon@hell.pl>
4 # ideas taken from BabelIRC by Stefan Tomanek
5 #
6
7 use strict;
8 use locale;
9 use Irssi 20020324;
10 use POSIX;
11 use Data::Dumper;
12
13 use vars qw($VERSION %IRSSI %HELP %channels %translations);
14 $VERSION = '2004031701';
15 %IRSSI = (
16 authors => 'Szymon Sokol',
17 contact => 'szymon@hell.pl',
18 name => 'mangle',
19 description => 'translates your messages into Morse code, rot13 and other sillinesses.',
20 license => 'GPLv2',
21 url => 'http://irssi.org/scripts/', changed => $VERSION,
22 modules => 'Data::Dumper'
23 );
24
25 # To work, this help requires scripthelp.pl by Maciek 'fahren' Freudenheim
26 $HELP{"mangle add"} = "/mangle add <translation> [<channel>]
27 Add a new translation entry for <channel> (default is current channel)";
28 $HELP{"mangle del"} = "/mangle del [<channel>]
29 Removes the translation for <channel> (default is current channel)";
30 $HELP{"mangle say"} = "/mangle say <translation> <message>
31 Says something to the current channel using given translation";
32 $HELP{"mangle load"} = "/mangle load
33 Loads translations from file";
34 $HELP{"mangle save"} = "/mangle save
35 Saves active translations to file";
36 $HELP{"mangle show"} = "/mangle show
37 Shows active translations";
38 $HELP{"mangle list"} = "/mangle list
39 Lists available translations";
40
41 # the endless possibilities for extensions here
42 %translations = (
43 # CChheecckk yyoouurr dduupplleexx sswwiittcchh
44 "duplex" => sub {
45 my ($text) = @_;
46 $text =~ s/./$&$&/g;
47 return $text;
48 },
49 # TaLk LiKe ThIs - EvErY OtHeR LeTtEr Is UpPeRcAse
50 "funky" => sub {
51 my ($text) = @_;
52 $text =~ s/(\w.)/\u$1/g;
53 return $text;
54 },
55 # TalkLikeThis-NoSpaces,WordBeginsWithUppercase
56 "gnome" => sub {
57 my ($text) = @_;
58 $text =~ s/\b(\w)/\u$1/g;
59 $text =~ s/\s+//g;
60 return $text;
61 },
62 # -- --- .-. ... . -.-. --- -.. .
63 "morse" => sub {
64 my %morse = (
65 " " => "",
66 "a" => ".-",
67 "b" => "-...",
68 "c" => "-.-.",
69 "d" => "-..",
70 "e" => ".",
71 "f" => "..-.",
72 "g" => "--.",
73 "h" => "....",
74 "i" => "..",
75 "j" => ".---",
76 "k" => "-.-",
77 "l" => ".-..",
78 "m" => "--",
79 "n" => "-.",
80 "o" => "---",
81 "p" => ".--.",
82 "q" => "--.-",
83 "r" => ".-.",
84 "s" => "...",
85 "t" => "-",
86 "u" => "..-",
87 "v" => "...-",
88 "w" => ".--",
89 "x" => "-..-",
90 "y" => "-.--",
91 "z" => "--..",
92 # notice: Polish and German diacritical characters have their own
93 # Morse codes; the same probably stands true for other languages
94 # using ISO-8859-2 - if you happen to know them, please send me e-mail
95 "±" => ".-.-",
96 "æ" => "-.-..",
97 "ê" => "..-..",
98 "³" => ".-..-",
99 "ñ" => "--.-",
100 "ó" => "---.".
101 "¶" => "...-...",
102 "¼" => "--..",
103 "¿" => "--..-",
104 'ä'=>'.-.-',
105 'ö'=>'---.',
106 'ü'=>'..--',
107 "0" => "-----",
108 "1" => ".----",
109 "2" => "..---",
110 "3" => "...--",
111 "4" => "....-",
112 "5" => ".....",
113 "6" => "-....",
114 "7" => "--...",
115 "8" => "---..",
116 "9" => "----.",
117 "'" => ".----.",
118 '"' => ".-..-.",
119 '.' => ".-.-.-",
120 ',' => "--..--",
121 '?' => "..--..",
122 ':' => "---...",
123 ';' => "-.-.-.",
124 '-' => "-....-",
125 '_' => "..--.-",
126 '/' => "-..-.",
127 '(' => "-.--.",
128 ')' => "-.--.-",
129 '@' => ".--.-.", # byFlorian Ernst <florian@uni-hd.de>
130 '=' => "-...-"
131 );
132 my ($text) = @_;
133 $text = lc($text);
134 $text =~ s/./defined $morse{$&} ? $morse{$&}." " : ""/eg;
135 return $text.'[morse]';
136 },
137 # convert text in Polish from ISO-8859-2 to 7-bit approximation
138 # if you know how to do it for other languages using 8859-2,
139 # please let me know
140 "polskawe" => sub {
141 my ($text) = @_;
142 $text =~ y/¡ÆÊ£ÑÓ¦¯¬±æê³ñ󶿼/ACELNOSZZacelnoszz/;
143 return $text;
144 },
145 # Ouch, my eyes!
146 "rainbow" => sub {
147 my ($text) = @_;
148 # colors list
149 # 0 == white
150 # 4 == light red
151 # 8 == yellow
152 # 9 == light green
153 # 11 == light cyan
154 # 12 == light blue
155 # 13 == light magenta
156 my @colors = ('00','04','08','09','11','12','13');
157 my $color;
158 $text = join '', map { push @colors, $color = shift @colors;
159 "\003" . $color . ($_ eq "," ? ",," : $_) } split(//,$text);
160 return $text;
161 },
162 # .drawkcab klaT
163 "reverse" => sub {
164 my ($text) = @_;
165 $text = scalar reverse $text;
166 return $text;
167 },
168 # Gnyx va ebg13 rapbqvat.
169 "rot13" => sub {
170 my ($text) = @_;
171 $text =~ y/N-ZA-Mn-za-m/A-Za-z/;
172 return $text.' [rot13]';
173 },
174 # T-T-Talk l-l-like y-y-you h-h-have a s-s-stutter.
175 "stutter" => sub {
176 my ($text) = @_;
177 $text =~ s/(\w)(\w+)/$1-$1-$1$2/g;
178 return $text;
179 },
180 # rmv vwls
181 "vowels" => sub {
182 my ($text) = @_;
183 $text =~ y/aeiouy±ê//d;
184 return $text;
185 }
186 );
187
188 sub add_channel ($$) {
189 my ($channel,$code) = @_;
190 $channels{$channel} = $code;
191 }
192
193 sub save_channels {
194 my $filename = Irssi::settings_get_str('mangle_filename');
195 local *F;
196 open F, '>'.$filename;
197 my $data = Dumper(\%channels);
198 print F $data;
199 close F;
200 print CLIENTCRAP "%R>>%n Mangle channels saved";
201 }
202
203 sub load_channels {
204 my $filename = Irssi::settings_get_str('mangle_filename');
205 return unless (-e $filename);
206 local *F;
207 open F, '<'.$filename;
208 my $text;
209 $text .= $_ foreach <F>;
210 no strict "vars";
211 %channels = %{ eval "$text" };
212 }
213
214 sub mangle_show ($$) {
215 my ($item, $get_size_only) = @_;
216 my $win = !Irssi::active_win() ? undef : Irssi::active_win()->{active};
217 if (ref $win && ($win->{type} eq "CHANNEL" || $win->{type} eq "QUERY") && $channels{$win->{name}}) {
218 my $code = $channels{$win->{name}};
219 $item->{min_size} = $item->{max_size} = length($code);
220 $code = '%U%g'.$code.'%U%n';
221 my $format = "{sb ".$code."}";
222 $item->default_handler($get_size_only, $format, 0, 1);
223 } else {
224 $item->{min_size} = $item->{max_size} = 0;
225 }
226 }
227 sub cmd_mangle ($$$) {
228 my ($args, $server, $witem) = @_;
229 my @arg = split(/ +/, $args);
230 if ($arg[0] eq 'add' && defined $arg[1]) {
231 my $code = $arg[1];
232 if(exists $translations{$code}) {
233 if (defined $arg[2]) {
234 add_channel($arg[2], $code);
235 }
236 elsif($witem) {
237 add_channel($witem->{name}, $code);
238 }
239 } else {
240 Irssi::print("There is no such translation as $code !");
241 }
242 } elsif ($arg[0] eq 'del') {
243 if(defined $arg[1]) {
244 delete $channels{$arg[1]} if defined $channels{$arg[1]};
245 } elsif($witem) {
246 delete $channels{$witem->{name}} if defined $channels{$witem->{name}};
247 }
248 } elsif ($arg[0] eq 'say' && defined $arg[1]) {
249 my $code = $arg[1];
250 if(exists $translations{$code}) {
251 if($witem) {
252 say($code, join(' ',@arg[2..$#arg]), $server, $witem);
253 }
254 } else {
255 Irssi::print("There is no such translation as $code !");
256 }
257 } elsif ($arg[0] eq 'save') {
258 save_channels();
259 } elsif ($arg[0] eq 'load') {
260 load_channels();
261 } elsif ($arg[0] eq 'list') {
262 Irssi::print("mangle: available translations are: ".
263 join(" ", sort keys %translations));
264 } elsif ($arg[0] eq 'show') {
265 for (sort keys %channels) {
266 Irssi::print("mangle: ".$_." set to ".$channels{$_});
267 }
268 } else {
269 Irssi::print("mangle v. $VERSION; use /help mangle for help (ensure you have scripthelp.pl loaded!)");
270 }
271 Irssi::statusbar_items_redraw('mangle_sb');
272 }
273
274 sub say ($$$$) {
275 my ($code, $line, $server, $witem) = @_;
276 my $target = "";
277 if ($line =~ s/^(\w+?: )//) {
278 $target = $1;
279 }
280 $line = $translations{$code}->($line);
281 $server->command('MSG '.$witem->{name}.' '.$target.$line);
282 }
283
284 sub event_send_text ($$$) {
285 my ($line, $server, $witem) = @_;
286 return unless ($witem &&
287 ($witem->{type} eq "CHANNEL" || $witem->{type} eq "QUERY") &&
288 $channels{$witem->{name}});
289 say($channels{$witem->{name}}, $line, $server, $witem);
290 Irssi::signal_stop();
291 Irssi::statusbar_items_redraw('mangle_sb');
292 }
293
294 # main
295
296 Irssi::command_bind('mangle', \&cmd_mangle);
297 foreach my $cmd ('add', 'del', 'save', 'load', 'say', 'list', 'show') {
298 Irssi::command_bind('mangle '.$cmd => sub {
299 cmd_mangle($cmd." ".$_[0], $_[1], $_[2]); });
300 }
301
302 Irssi::statusbar_item_register('mangle_sb', 0, "mangle_show");
303 Irssi::signal_add('setup saved', 'save_channels');
304 Irssi::signal_add('send text', \&event_send_text);
305 Irssi::signal_add('window changed', sub {Irssi::statusbar_items_redraw('mangle_sb');});
306
307 Irssi::settings_add_str($IRSSI{name}, 'mangle_filename', Irssi::get_irssi_dir()."/mangle_channels");
308 load_channels();
309 print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded: /help mangle for help';
310
311 # ;-)