use warnings;
use strict;

package BarnOwl::Module::Unicorn;

our $VERSION = '0.2';

# 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

# 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_unreply {
	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';
	}

	if (lc $class eq 'message') {
		$cmd .= " -i " . BarnOwl::quote("un".$instance);
	} else {
		$cmd .= " -c " . BarnOwl::quote(get_unclass($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 unreply { BarnOwl::command(make_unreply()); }
sub start_unreply { BarnOwl::command("start-command " . make_unreply()); }

sub discuss {
	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';
	}

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

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

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

sub uninarrow {
	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();

	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;
	}
	if ($delegate_flag) {
		BarnOwl::command('smartnarrow');
	} else {
		my @args = (qw{view -d ( class}, '^(un)*' . $rootclass . '(\\.d)*$');
		for (@cs) {
			push @args, 'or', 'class', "^$_\$";
		}
		push @args, ')';
		# BarnOwl::popless_text(BarnOwl::quote(@args, @_));
		BarnOwl::command(BarnOwl::quote(@args, @_));
	}
}

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
(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",
	}
);

1;