#!/usr/bin/perl
# -----------------------------------------------------------------------------
# zzzmorse.pl (Irssi version) -- encode to / decode from morse code
# Copyright (C) 2003 Fabian "zzznowman" Pietsch <fabian-irssi@zzznowman.dyndns.org>
#
# Irssi interface usage taken from kenny.pl
# http://alfie.ist.org/projects/irssi/scripts/kenny.pl
# Copyright (C) 2002 Gerfried Fuchs <alfie@channel.debian.de>
#
# Inspired by and initially based on morse_encode.pl & morse_decode.pl,
# available at http://loeffel.dyndns.org/stuff/
# Copyright (C) 2003 s_20 <s20@s20.homelinux.org> & maka 
#
# Distributed under the GNU GPL (General Public Licence)
# zzzmorse is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# zzzmorse is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# -----------------------------------------------------------------------------
#
# Version 0.1.3 (2003-11-22)
#
# ChangeLog:
#   o fixed typo in Irssi signal handling ("mores" should be "morse".. *sigh*)
#   o added s_20's email address to credits
#   o changed morse code detection regex in signal handler
#     (evil '160' Windows non-wrapping space-like character... -_-)
#   o morse_encode, morse_decode no longer directly output errors,
#     but push to @errs (which is then output to the correct channel)
#   o changed Irssi::print MSGLEVEL so output will hopefully be logged properly
#   o error messages go to the relevant window now,
#     normal output isn't stopped on error even if zzzmorse_stopraw
#   o if /morse is used in status/empty window, morse-encoded message
#     is output there instead of crashing the script
#   o don't send /morse-d messages on encoding error
#   o general signal handling & code cleanup
#
# Bugs:
#   o Currently doesn't encode:  # * = + ~ µ @ ^ ° § $ % & ² ³ < >  etc.
#   o While encoding, the code for Ch isn't used; this is due to only humans
#     being able to decide whether 'ch' in a word is meant to be a german 'ch'
#     or not. (At least I guess so...)
#

use Irssi qw(command_bind command signal_add_last signal_stop settings_get_bool settings_add_bool);
use strict;
use vars qw($VERSION %IRSSI);

$VERSION = '0.1.3';

%IRSSI = (
	'authors'     => 'Fabian "zzznowman" Pietsch',
	'contact'     => 'fabian-irssi@zzznowman.dyndns.org',
	'name'        => 'zzzmorse',
	'description' => 'Autodecodes morse coded messages, adds /morse, /demorse. Based on zzzmorse (the standalone version).',
	'license'     => 'GPL',
	'url'         => 'http://zzz.deixu.net/software/raw/script/irssi/zzzmorse.pl',
	'changed'     => '2003-11-22'
);


# morse translation table
# source: http://www.soton.ac.uk/~scp93ch/morse/index.html?http://www.soton.ac.uk/~scp93ch/morse/morse.html
my %trans_to = (
	# letters
	'A' => '.-',
	'B' => '-...',
	'C' => '-.-.',
	'D' => '-..',
	'E' => '.',
	'F' => '..-.',
	'G' => '--.',
	'H' => '....',
	'I' => '..',
	'J' => '.---',
	'K' => '-.-',
	'L' => '.-..',
	'M' => '--',
	'N' => '-.',
	'O' => '---',
	'P' => '.--.',
	'Q' => '--.-',
	'R' => '.-.',
	'S' => '...',
	'T' => '-',
	'U' => '..-',
	'V' => '...-',
	'W' => '.--',
	'X' => '-..-',
	'Y' => '-.--',
	'Z' => '--..',

	# digits
	'1' => '.----',
	'2' => '..---',
	'3' => '...--',
	'4' => '....-',
	'5' => '.....',
	'6' => '-....',
	'7' => '--...',
	'8' => '---..',
	'9' => '----.',
	'0' => '-----',

	# foreign letters
	'Ä' => '.-.-',
	'Á' => '.--.-',
	'Å' => '.--.-',
	'Ch' => '----',
	'É' => '..-..',
	'Ñ' => '--.--',
	'Ö' => '---.',
	'Ü' => '..--',

	# punctuation chars
	'.' => '.-.-.-',
	',' => '--..--',
	':' => '---...',
	'?' => '..--..',
	"'" => '.----.',
	'-' => '-....-',
	'/' => '-..-.',		# "fraction bar"
	'{PAR}' => '-.--.-',	# "brackets (parentheses)"
	'"' => '.-..-.',

	' ' => '',   		# spacing: char component: 1 unit  -> nothing
				#          chars:          3 units -> space
				#          words:          7 units -> two spaces
				# space between chars forms in final @out expansion
				# spaces between words form by expanding the
				#   empty string, so that split()ing leads to
				#   only one space again while decoding

	'{ERR}' => '........'	# "error" / "delete last word"
  );
my %trans_from = reverse(%trans_to);
my @errs;


# encode array of tokens to morse code
# if only one argument is given, it's split into its characters
sub morse_encode {
	my @in = $#_ ? @_ : split(//, $_[0]);
	my @out;

	@errs = ();
	foreach my $token (@in) {
		# handle  () {} []  correctly
		$token =~ s/^(\(|\)|\[|\]|\{|\})$/{PAR}/g;

		if (defined($trans_to{$token})) {
			push(@out, $trans_to{$token});
		}
		else {
			##warn("Can't encode '$token'");
			#Irssi::print("[zzzmorse] can't encode '$token'", MSGLEVEL_CRAP);
			push(@errs, $token);
			push(@out, '{???}');
		}
	}

	# return @out in list context; else expand it with spaces
	# (e.g.,  @out = ('.', '-', '.-')  becomes  "@out" eq '. - .-'  )
	return wantarray ? @out : "@out";
}

# decode array of tokens from morse code
# if only one argument is given, it's split into its words(/split by spaces)
sub morse_decode {
	# $#_ -> max. index of @_ => at least two elements in @_ if $#_ is true
	my @in = $#_ ? @_ : split(/ /, $_[0]);
	my @out;

	@errs = ();
	foreach my $token (@in) {
		# if ($token eq '') {
		# 	# empty tokens are autoconverted to spaces while decoding
		# 	push(@out, ' ');
		# }
		# ^ ..this directly works through $trans_from now
		if (defined($trans_from{$token})) {
			push(@out, $trans_from{$token});
		}
		else {
			##warn("Can't decode '$token'");
			#Irssi::print("[zzzmorse] can't decode '$token'", MSGLEVEL_CRAP);
			push(@errs, $token);
			push(@out, '{???}');
		}
	}

	# return @out in list context; else join the decoded characters together
	# (e.g.,  @out = ('a', 'b', 'c')  becomes  "abc"  )
	return wantarray ? @out : join('', @out);
}


#
# Irssi interface specific code
#

# use only one real signal handler internally
#   while letting it know what signal it's currently handling
sub sig_morse_pub {
	sig_morse_int('pub', @_);
}
sub sig_morse_priv {
	sig_morse_int('priv', @_);
}
sub sig_morse_int {
	my ($sig, $server, $msg, $nick, $address, $target) = @_;

	# does this look like morse code?
        #   (e.g.,  {'.', '-'}x(1+), ~space, {~space, '.', '-'}x(1+)  )
	if ($msg =~ /^[.-]+[ \240][ \240.-]+$/) {
		$target = $nick if ($target eq '');

		# if $address is empty, assume own_{public,private} => own nick
		$nick = $server->{'nick'} if ($address eq '');

		# get ref to object to do output on (different from closure below!)
		my $iout = $server->window_item_find($target);
		$iout->print("[zzzmorse] <$nick> " . morse_decode($msg), do {
			($sig eq 'pub')  ? MSGLEVEL_PUBLIC :
			($sig eq 'priv') ? MSGLEVEL_MSGS   :
			MSGLEVEL_CLIENTCRAP;
		  });
		if (scalar(@errs)) {
			$iout->print("[zzzmorse] couldn't decode: @errs", MSGLEVEL_CLIENTCRAP);
		}
		else {	# don't signal_stop if there've been any translation errors
			signal_stop if (settings_get_bool('zzzmorse_stopraw'));
		}
	}
}

# /demorse Irssi command -- morse-decode message and output it to the user only
sub cmd_demorse {
	my ($msg, undef, $channel) = @_;
	my $decoded = morse_decode($msg);

	# get code ref to closure (anonymous sub) for doing output
	#   "&" without "()" lets the called sub see/use our own @_
	my $iout = $channel ?
	  sub { $channel->print(shift, @_) } :
	  sub { &Irssi::print };

	# output decoded message
	$iout->("[zzzmorse] decoded: $decoded", MSGLEVEL_CLIENTCRAP);

	# check for decoding errors
	if (scalar(@errs)) {
		$iout->("[zzzmorse] couldn't decode: @errs", MSGLEVEL_CLIENTCRAP);
	}
}

# /morse Irssi command -- morse-encode a message and send it to the channel (if any)
sub cmd_morse {
	my ($msg, undef, $channel) = @_;

	# Users are dumb, so filter user's dumbness.
	# While decoding, we're either
	#  o parsing the output of a program which
	#    has already done this job for us or
	#  o parsing data from a user who knows morse code,
	#    so (hopefully) knows what he is doing...

	# there are some native language's letters most probably
	#   missing here, I know... *sigh*
	$msg =~ tr/_!;|\`´äÀáàÃãËëÈéèÏïÍÌíìöÓÒóòÕõüÚÙúùÿ\\/-..,''ÄAÁAAAEEEÉEIIIIIIÖOOOOOOÜUUUUY\//;
	$msg =~ s/ß/sz/;

	# convert to upper case
	$msg =~ s/([a-z])/uc($1)/eg;

	# finally morse-encode the message
	my $encoded = morse_encode($msg);

	# get code ref to closure (anonymous sub) for doing output (see above)
	my $iout = $channel ?
	  sub { $channel->print(shift, @_) } :
	  sub { &Irssi::print };

	# check for encoding errors
	if (scalar(@errs)) {
		# output the error & abort
		$iout->("[zzzmorse] couldn't encode: @errs", MSGLEVEL_CLIENTCRAP);
	}
	else {
		# being on a channel/query?
		if ($channel) {
			# send morse-encoded message to channel/querry
			$channel->command("msg $channel->{'name'} $encoded");
		}
		else {
			# output morse-encoded message to status window
			Irssi::print("[zzzmorse] encoded: $encoded", MSGLEVEL_CLIENTCRAP);
		}
	}
}


settings_add_bool('lookandfeel', 'zzzmorse_stopraw', 0);

signal_add_last('message own_public',  'sig_morse_pub');
signal_add_last('message public',      'sig_morse_pub');
signal_add_last('message own_private', 'sig_morse_priv');
signal_add_last('message private',     'sig_morse_priv');

command_bind('demorse', 'cmd_demorse');
command_bind('morse',   'cmd_morse');