use warnings;
use strict;

package BarnOwl::Module::Unicorn;

our $VERSION = '0.3.3';

# your one-stop shop for dealing with magical unclasses and tangentially
# related goodies

# hacked from a thing ltchin gave me
# she says it's from wings or horkley, idk
# --bpchen 2015-11-3

# now supports adding clauses to narrow --bpchen 2016-2-2

# quotemeta added --bpchen 2016-2-27
# the versatile unireply added --bpchen 2016-2-27

# quotemeta fixed into our own version --bpchen 2016-3-7

# this part is mostly copied from Alias.pm, due to nelhage(?)

my $cfg = BarnOwl::get_config_dir();
my $mapfile = "$cfg/unclassmap";
my %unclassmap;
my %unclasslistmap;
my %rootclassmap;
if (-r $mapfile) {
	open(my $fh, "<:encoding(UTF-8)", $mapfile) or die("Unable to read $mapfile$!\n");
	while(defined(my $line = <$fh>)) {
		next if $line =~ /^\s+#/;
		next if $line =~ /^\s+$/;
		my @components = split(/\s+/, $line);
		next unless @components;
		my $cls0 = shift @components;
		$rootclassmap{$cls0} = $cls0;
		$unclasslistmap{$cls0} = [@components];
		my $clsprev = shift @components;
		$rootclassmap{lc($clsprev)} = $cls0;
		$unclassmap{lc($cls0)} = $clsprev;
		while (@components) {
			my $clsnext = shift @components;
			$unclassmap{lc($clsprev)} = $clsnext;
			$rootclassmap{lc($clsnext)} = $cls0;

			$clsprev = $clsnext;
		}
	}
	close($fh);
}

sub get_unclass {
	my $cls = shift;
	my $uncls = $unclassmap{lc($cls)};
	return defined($uncls) ? $uncls : "un$cls";
}

sub make_unireply {
	my $operations = shift;
	my $z = BarnOwl::getcurmsg();

	my ($class, $instance, $to, $cc);

	return unless $z->is_zephyr;

	$class = $z->class;
	$instance = $z->instance;
	$to = $z->recipient;
	$cc = $z->zephyr_cc();
	if($to eq '*' || $to eq '') {
		$to = '';
	} elsif($to !~ /^@/) {
		$to = $z->sender;
	}

	my $cmd;
	if(lc $z->opcode eq 'crypt') {
		$cmd = 'zcrypt';
	} else {
		$cmd = 'zwrite';
	}
	my $cmd_prefix = BarnOwl::getvar('unicorn:prefix');
	if ($cmd_prefix ne '') {
		$cmd = "$cmd_prefix $cmd";
	}
	my $do_un = sub {
		if (lc $class eq 'message') {
			$instance = "un$instance";
		} else {
			$class = get_unclass($class);
		}
	};

	for (split //, $operations) {
		if (/[A-Z]/) {
			$_ = lc;
			$instance = "'$instance'";
		}
		if ($_ eq 'u') {
			$do_un->();
		} elsif (/\d/) {
			my $n = $_;
			for (1..$n) { $do_un->(); }
		} elsif ($_ eq 'd') {
			$instance = "$instance.d";
		} elsif ($_ eq 'q') {
			$instance = "$instance.q";
		} elsif ($_ eq 't') {
			$instance = "$instance.ttants";
		} elsif ($_ eq 'p') {
			$instance = "$instance.pwants";
		} elsif ($_ eq 'z' || $_ eq 's') {
			$instance = "$instance.zsig";
		}
	}

	if (lc $class eq 'message') {
		$cmd .= " -i " . BarnOwl::quote($instance);
	} else {
		$cmd .= " -c " . BarnOwl::quote($class);
		if (lc $instance ne 'personal') {
			$cmd .= " -i " . BarnOwl::quote($instance);
		}
	}

	if ($to ne '') {
		$to = BarnOwl::Message::Zephyr::strip_realm($to);
		if(BarnOwl::getvar('smartstrip') eq 'on') {
			$to = BarnOwl::zephyr_smartstrip_user($to);
		}
		$cmd .= " $to";
	}
	return $cmd;
}

sub make_unreply { return make_unireply('u'); }

sub unreply { BarnOwl::command(make_unreply()); }
sub unireply { BarnOwl::command(make_unireply($_[1])); }
sub start_unreply { BarnOwl::command("start-command " . make_unreply()); }

sub discuss { BarnOwl::command(make_unireply('d')); }

sub root_instance {
	my $s = shift;
	my $c = 64;
	# I don't know why /^(?:un)*+(.*?)(?:\\.d)*$/ doesn't work
	while (length($s) >= 2 && substr($s, 0, 2) eq 'un') {
		$s = substr($s, 2);
		$c -= 1;
		if ($c <= 0) { # emergency break! or brake!
			BarnOwl::popless_text("failed miserably on $s in loop 1");
		}
	}
	while (length($s) >= 2 && substr($s, -2) eq '.d') {
		$s = substr($s, 0, length($s) - 2);
		$c -= 1;
		if ($c <= 0) { # emergency break! or brake!
			BarnOwl::popless_text("failed miserably on $s in loop 2");
		}
	}
	return $s;
}

sub uniquotemeta {
	$_ = shift;
	# usually one would use perl's builtin quotemeta because backslashing
	# nonmetacharaters shouldn't hurt, but for some reason barnowl doesn't
	# like it when we do that, so...
	s/[\\|()[{^\$*+?.]/\\$&/g;
	return $_;
}

sub uninarrow {
	shift;
	my $narrow_instance = 0;
	if (@_ && $_[0] == '-i') {
		shift;
		$narrow_instance = 1;
	}
	my $z = BarnOwl::getcurmsg();

	my ($class, $instance, $to, $cc);

	unless ($z->is_zephyr) {
		if ($narrow_instance) {
			BarnOwl::command('smartnarrow -i');
		} else {
			BarnOwl::command('smartnarrow');
		}
		return;
	}

	$class = $z->class;
	$instance = $z->instance;
	$to = $z->recipient;
	$cc = $z->zephyr_cc();

	my $rootclass = $rootclassmap{$class};
	my @cs = ();
	my $delegate_flag = 1; # do we delegate to smartnarrow?
	if (defined($rootclass)) {
		@cs = @{$unclasslistmap{$rootclass}};
		$delegate_flag = 0;
	} elsif (@_) {
		$rootclass = $class;
		$delegate_flag = 0;
	}
	$instance = root_instance($instance);
	if ($instance =~ /^'(.*)'$/) {
		$instance = $1;
		$delegate_flag = 0;
	}
	if ($delegate_flag) {
		if ($narrow_instance) {
			BarnOwl::command('smartnarrow -i');
		} else {
			BarnOwl::command('smartnarrow');
		}
	} else {
		my @class_clauses = ('class', '^(un)*' . uniquotemeta($rootclass) . '(\\.d)*$');
		for (@cs) {
			push @class_clauses, 'or', 'class', '^' . uniquotemeta($_) . '$';
		}
		my $filter_name = "uninarrowed-class-$rootclass";
		my @clauses;
		if ($narrow_instance) {
			@clauses = ('(', @class_clauses, qw{) and instance}, '^(un)*\'?' . uniquotemeta($instance) . '\'?(\\.d)*$');
			$filter_name .= "-instance-$instance";
		} else {
			@clauses = @class_clauses;
		}
		# BarnOwl::popless_text(BarnOwl::quote(qw(view -d), '(', @clauses, ')', @_));
		# $filter_name = "unitest";
		BarnOwl::command(BarnOwl::quote('filter', $filter_name, '(', @clauses, ')', @_));
		BarnOwl::command(BarnOwl::quote('view', $filter_name));
	}
}

BarnOwl::new_command
(unreply => \&unreply,
	{summary => "like reply, but prepends un- to the class or instance magically",
	}
);
BarnOwl::new_command
('start-unreply' => \&start_unreply,
	{summary => "like reply -e, but prepends un- to the class or instance magically",
	}
);
BarnOwl::new_command
(unireply => \&unireply,
	{summary => "like reply, but takes a magic string and does magic things to the class/instance",
	}
);
BarnOwl::new_command
(discuss => \&discuss,
	{summary => "like reply, but appends .d to the instance",
	}
);
BarnOwl::new_command
(uninarrow => \&uninarrow,
	{summary => "like smartnarrow, but also narrows special unclasses magically",
	}
);
BarnOwl::new_variable_string('unicorn:prefix', {
		default => "",
		summary => "Tokens prepended to all zwrite/zcrypt commands generated by Unicorn (e.g. 'csig')",
		description => "Tokens prepended to all zwrite/zcrypt commands generated by Unicorn (e.g. 'csig')",
	});

1;