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