#!/usr/bin/perl

$DEBUG = 1;

use lib '/usr/local/libexec/w3mmlconfig';
require 'mlconfig-data.pl';

open(CHALLENGE, "$ENV{HOME}/.mlterm/challenge");
$challenge = <CHALLENGE>;
close(CHALLENGE);

$config_file = "$ENV{HOME}/.mlterm/main";
$CGI = $ENV{SCRIPT_NAME} || $0;
$CGI = &html_quote($CGI);
$local_cookie = $ENV{LOCAL_COOKIE};
$method = ($ENV{REQUEST_METHOD} eq 'POST');
if ($method) {
	sysread(STDIN, $query, $ENV{CONTENT_LENGTH});
} else {
	$query = $ENV{QUERY_STRING};
}
for (split('&', $query)) {
	s/^([^=]*)=//;
	$value->{$1} = &form_decode($_);
}
if ($local_cookie ne $value->{COOKIE}) {
	$method = 0;
}
if ($method) {
	if ($value->{SAVE}) {
		if ($value->{SAVE} eq 'Yes') {
			&save_config();
		}
		&make_header(0, $method);
		exit;
	}
	if ($value->{SUBMIT} eq 'Cancel') {
		&make_header(1, $method);
		exit;
	} elsif ($value->{full_reset}) {
		&set_config({ full_reset => '' });
		&get_config();
		&check_value();
	} else {
		&check_value();
		if ($value->{SUBMIT} eq 'Save') {
			&load_config();
			&make_save_config();
			exit;
		} elsif ($value->{SUBMIT} eq 'OK') {
			&set_config();
			&make_header(1, $method);
			exit;
		} elsif ($value->{SUBMIT} eq 'Apply') {
			&set_config();
		} elsif ($value->{fontsize_larger}) {
			&set_config({ fontsize => 'larger' });
			&get_config([ 'fontsize' ]);
		} elsif ($value->{fontsize_smaller}) {
			&set_config({ fontsize => 'smaller' });
			&get_config([ 'fontsize' ]);
		}
	}
} else {
	&get_config();
	&check_value();
}

&make_header(0, $method);
&make_html();

sub make_header {
	local($quit, $method) = @_;

	if ($value->{SAVE}) {
		print "w3m-control: DELETE_PREVBUF\n";
		print "w3m-control: BACK\n";
	} elsif ($quit && $value->{QUIT} ne 'no') {
		print "w3m-control: EXIT\n";
	} else {
		if ($value->{SUBMIT} eq 'Apply') {
			print "w3m-control: GOTO #apply\n";
		} else {
			print "w3m-control: GOTO #pos\n";
		}
		print "w3m-control: DELETE_PREVBUF\n";
		if ($quit || $method) {
			print "w3m-control: DELETE_PREVBUF\n";
		}
	}
	print "Content-Type: text/html\n\n";
}

sub make_html {
	local($s);

	print <<EOF;
<html>
<head>
<title>mlterm configuration</title>
</head>
<body>
<form action="$CGI" method=POST>
<input type=hidden name="COOKIE" value="$local_cookie">
<input type=hidden name="QUIT" value="$value->{QUIT}">
<center>
<b>mlterm configuration</b>
<table border=1 width=200>
EOF
	$value->{SECTION} ||= $value->{"default-SECTION"};
	$value->{SECTION} =~ tr/A-Z/a-z/;
	if (!defined($section_attr->{$value->{SECTION}})) {
		$value->{SECTION} = $section[0];
	}
	&make_section($value->{SECTION});
	print <<EOF;
<tr><td colspan=2 align=center><nobr>
<input type=submit name="SUBMIT" value="OK">
&nbsp;
<a name="apply"><input type=submit name="SUBMIT" value="Apply"></a>
&nbsp;
<input type=submit name="SUBMIT" value="Cancel">
&nbsp;
<input type=reset value="Reset">
&nbsp;
<input type=submit name="SUBMIT" value="Save">
</nobr>
<tr align=center><td width=50%>
<table>
<tr><td>Font size<br>
<input type=submit name="fontsize_larger" value="Larger">
<input type=submit name="fontsize_smaller" value="Smaller">
</table>
<td width=50%>
<table>
<tr><td>Full Reset<br>
<input type=submit name="full_reset" value="Full Reset">
</table>
</table>
</center>
</form>
</body>
</html>
EOF
}

sub make_section {
	local($s) = @_;
	local($attr) = $section_attr->{$s};
	local($k, $s2);

	print <<EOF;
<tr><td colspan=2 align=center><nobr>
<input type=hidden name="default-SECTION" value="$s">
EOF
	for $s2 (@section) {
		if ($s eq $s2) {
			print "<b>[<a name=\"pos\">$section_attr->{$s}{title}</a>]</b>\n";
		} else {
			print "<input type=submit name=\"SECTION\"",
				" value=\"$section_attr->{$s2}{title}\">\n";
		}
	}
	print <<EOF;
</nobr>
<tr><td colspan=2 align=center>
<table>
EOF
	for $k (@{$attr->{key}}) {
		&make_key($k);
	}
	print <<EOF;
</table>
EOF
	for $s2 (@section) {
		$s eq $s2 && next;
		$attr = $section_attr->{$s2};
		for $k (@{$attr->{key}}) {
			print "<input type=hidden name=\"$k\" value=\"",
				&html_quote($value->{$k}), "\">\n";
			print "<input type=hidden name=\"default-$k\" value=\"",
				&html_quote($value->{"default-$k"}), "\">\n";
		}
	}
}

sub make_key {
	local($k) = @_;
	local($attr) = $key_attr->{$k};
	local($type) = $attr->{type};
	local($i);

	if (! $attr->{col}) {
		print "<tr>";
		if ($type =~ /^checkbox/ || $type =~ /^none/) {
			print "<td colspan=2>\n";
		} elsif ($type =~ /^radio/) {
			print "<td colspan=2><nobr>$attr->{title}\n";
		} else {
			print "<td><nobr>$attr->{title}</nobr>\n";
			print "<td>";
		}
	} else {
		print "&nbsp;\n";
	}
	if ($type =~ /^text/) {
		print "<input type=text name=\"$k\" value=\"",
			&html_quote($value->{$k}), "\">\n";
	} elsif ($type =~ /^select/) {
		print "<select name=\"$k\">\n";
		for $i (@{$attr->{item}}) {
			print "<option value=\"$i\"";
			if ($value->{$k} eq "$i") {
				print " selected";
			}
			print ">";
			print "$item_attr->{$k}{$i}\n";
		}
		print "</select>\n";
	} elsif ($type =~ /^radio/) {
		for $i (@{$attr->{item}}) {
			print "&nbsp;<input type=radio name=\"$k\" value=\"$i\"";
			if ($value->{$k} eq "$i") {
				print " checked";
			}
			print "> $item_attr->{$k}{$i}\n";
		}
		print "</nobr>\n";
	} elsif ($type =~ /^checkbox/) {
		print "<input type=checkbox name=\"$k\" value=\"true\"";
		if ($value->{$k} eq "true") {
			print " checked";
		}
		print ">\n";
		print "$attr->{title}\n";
	} elsif ($type =~ /^none/) {
		print "$attr->{title}\n";
		return;
	}
	print "<input type=hidden name=\"default-$k\" value=\"",
		&html_quote($value->{"default-$k"}), "\">\n";
}

sub check_value {
	local($k, $attr, $_, $ok);

	for $k (keys %{$key_attr}) {
		$k =~ /^_/ && next;
		$attr = $key_attr->{$k};
		$ok = 1;
		if ($attr->{type} =~ /^text:digit/) {
			if ($value->{$k} !~ /^\d+$/) {
				$ok = 0;
			}
		} elsif ($attr->{type} =~ /^(select|radio):lower/) {
			$value->{$k} =~ tr/A-Z/a-z/;
			if (! defined($item_attr->{$k}{$value->{$k}})) {
				$ok = 0;
			}
		} elsif ($attr->{type} =~ /^(select|radio):upper/) {
			$value->{$k} =~ tr/a-z/A-Z/;
			if (! defined($item_attr->{$k}{$value->{$k}})) {
				$ok = 0;
			}
		} elsif ($attr->{type} =~ /^checkbox/) {
			$value->{$k} =~ tr/A-Z/a-z/;
			if (! defined($value->{$k}) || $value->{$k} eq '') {
				$value->{$k} = 'false';
			} elsif (! ($value->{$k} eq 'true' ||
				 $value->{$k} eq 'false')) {
				$ok = 0;
			}
		}
		if ($ok) {
			if (!defined($value->{"default-$k"})) {
				$value->{"default-$k"} = $value->{"$k"};
			}
		} else {
			$value->{$k} = defined($value->{"default-$k"})
				? $value->{"default-$k"} : $attr->{default};
		}
	}
}

sub get_config {
	local($key) = @_;
	local($k, $_);

	if (! $key) {
		$key = [ keys %{$key_attr} ];
	}
	open(TTY, "+>/dev/tty");
	for $k (@{$key}) {
		$k =~ /^_/ && next;
		print TTY "\033]5380;$challenge;$k\007";
		$_ = <TTY>;
$DEBUG && print "DEBUG: get $_";
		s/^\#${k}=// || next;
		chop;
		$value->{$k} = $_;
		$value->{"default-$k"} = $_;
	}
	close(TTY);
}

sub set_config {
	local($val) = @_;
	local(@key, $k, $_);

	if ($val) {
		@key = keys %{$val};
	} else {
		@key = keys %{$key_attr};
		$val = $value;
	}

	open(TTY, ">/dev/tty");
	for $k (@key) {
		$k =~ /^_/ && next;
		$val->{$k} eq $value->{"default-$k"} && next;
$DEBUG && print "DEBUG: set $k=$val->{$k}\n";
		print TTY "\033]5379;$k=$val->{$k}\007";
		$value->{"default-$k"} = $val->{$k};
	}
	close(TTY);
}

sub load_config {
	local($_, $k);

	open(F, "<$config_file") || return;
	while (<F>) {
		s/^(\w+)\s*=\s*// || next;
		$k = $1;
		$k =~ tr/A-Z/a-z/;
		chomp;
		$config->{$k} = $_;
	}
	close(F);
}

sub save_config {
	local($k);
	local($dir) = $config_file;

	$dir =~ s@[^/]+$@@;
	if (-d $dir) {
		if (-f $config_file) {
			rename($config_file, "$config_file.bak") || return;
		}
	} else {
		mkdir($dir, 0700) || return;
	}
	open(F, ">$config_file") || return;
	for $k (split(" ", $value->{KEYS})) {
		print F "$k=$value->{$k}\n";
	}
	close(F);
}

sub make_save_config {
	local($s, $attr, $k, $v, @ks);

	print "Content-Type: text/html\n\n";
	print <<EOF;
<html>
<head>
<title>mlterm configuration</title>
</head>
<body>
<center>
<b>mlterm configuration</b>
</center>
<form action="$CGI" method=POST>
<input type=hidden name="COOKIE" value="$local_cookie">
<p>
Do you save the configuration to $config_file ?
<br>
<input type=submit name="SAVE" value="Yes">
<input type=submit name="SAVE" value="No">
<hr>
EOF
	@ks = ();
	for $s (@section) {
		$attr = $section_attr->{$s};
		for $k (@{$attr->{key}}) {
			defined($config->{$k}) && delete $config->{$k};
			$v = $value->{$k};
			if ($key_attr->{$k}{type} eq 'none'
				|| $key_attr->{$k}{default} eq '-'
				|| $v eq $key_attr->{$k}{default}
				|| $v eq '') {
				next;
			}
			$v = &html_quote($v);
			print "$k=$v<br>\n";
			print "<input type=hidden name=\"$k\" value=\"$v\">\n";
			push(@ks, $k);
		}
	}
	for $k (sort keys %{$config}) {
		$v = &html_quote($config->{$k});
		print "$k=$v<br>\n";
		print "<input type=hidden name=\"$k\" value=\"$v\">\n";
		push(@ks, $k);
	}
	print <<EOF;
<input type=hidden name=\"KEYS\" value=\"@ks\">
</form>
</body>
</html>
EOF
}

sub html_quote {
	local($_) = @_;
	local(%QUOTE) = (
		'<', '&lt;',
		'>', '&gt;',
		'&', '&amp;',
		'"', '&quot;',
	);
	s/[<>&"]/$QUOTE{$&}/g;
	return $_;
}

sub form_decode {
	local($_) = @_;
	s/\+/ /g;
	s/%([\da-f][\da-f])/pack('c', hex($1))/egi;
	return $_;
}
