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