X-Git-Url: http://git.shiar.net/sheet.git/blobdiff_plain/e4d544e9178552fdf5f7caf2d5869b502110fcd9..3a619ed93038baf5568d87d3d4a24056e813e8af:/writer.plp

diff --git a/writer.plp b/writer.plp
index ce421b8..bae010c 100644
--- a/writer.plp
+++ b/writer.plp
@@ -4,6 +4,86 @@ Html({
 	title => 'words cheat sheet admin',
 	version => '1.0',
 	nocache => 1,
+	raw => <<'EOT',
+<style>
+dl {
+	display: inline-grid;
+	grid: auto-flow / min-content repeat(10, auto);
+}
+
+form > ul {
+	display: table;
+	border-spacing: 0 2px;
+}
+form > ul li {
+	display: table-row;
+}
+form > ul li > * {
+	display: table-cell;
+	padding-right: .5em;
+}
+form > ul li > label {
+	/* th */
+	text-align: right;
+}
+form > ul li > label + * {
+	/* td */
+	width: 32em;
+}
+
+input:not([type]) {
+	box-sizing: border-box;
+	width: 100%;
+	padding: .4rem;
+	font-family: monospace;
+}
+select {
+	padding: .3rem .2rem; /* TODO: input */
+}
+
+ul.popup {
+	display: flex;
+	flex-wrap: wrap;
+	align-items: end;
+	position: fixed;
+	left: 0;
+	top: 0;
+	margin: auto;
+	max-height: 90%;
+	max-width: 90%;
+	overflow: auto;
+	background: rgba(0, 0, 0, .8);
+	border: 1px solid #CCC;
+}
+
+h1 {
+	margin-bottom: 1ex;
+}
+.inline {
+	display: inline-flex;
+	align-items: start;
+	margin: 0 -1ex; /* inner gap */
+}
+.inline > * {
+	margin: 0 1ex;
+}
+.inline .inline {
+	display: flex;
+}
+
+#nav {
+	-margin-left: 1em; /* flex gap */
+}
+#nav > ul,
+#nav > ul strong,
+#nav form {
+	margin: 1ex 0;
+	display: inline-block;
+}
+</style>
+
+<script src="/writer.js"></script>
+EOT
 });
 
 use List::Util qw( pairs pairkeys );
@@ -20,47 +100,180 @@ my $db = eval {
 } or Abort('Database error', 501, $@);
 
 my @wordcols = (
-	form    => 'Translation',
-	ref     => 'Reference',
-	cat     => 'Category',
 	lang    => 'Language',
-	source  => 'Image URL',
-	thumb   => 'Convert options',
+	cat     => 'Category',
+	ref     => undef, # included with cat
+	prio    => 'Level',
+	cover   => undef, # included with prio
+	form    => 'Translation',
+	alt     => 'Synonyms',
 	wptitle => 'Wikipedia',
+	source  => 'Image',
+	thumb   => 'Convert options',
 );
-my $find = $Request ? {id => $Request} : undef;
+my @prioenum = qw( essential basic common distinctive rare invisible );
+my ($find) = map {{id => $_}} $fields{id} || $Request || ();
 
 my $row;
-if ($ENV{REQUEST_METHOD} eq 'POST') {
+if ($find) {
+	$row = $db->select(word => '*', $find)->hash
+		or Abort("Word not found", 404);
+}
+
+if (exists $get{copy}) {
+	$row = {%{$row}{ qw(prio lang cat) }};
+}
+elsif ($ENV{REQUEST_METHOD} eq 'POST') {{
+	my $replace = $row;
 	$row = {%post{ pairkeys @wordcols }};
 	$_ = length ? $_ : undef for values %{$row};
+
 	eval {
-		my %res = (returning => $Request ? '*' : 'lang, cat');
+		my %res = (returning => '*');
 		my $query = $find ? $db->update(word => $row, $find, \%res) :
 			$db->insert(word => $row, \%res);
 		$row = $query->hash;
-	} or Alert("Entry could not be saved", $@);
-}
-elsif ($find) {
-	$row = $db->select(word => '*', $find)->hash
-		or Abort("Word not found", 404);
+	} or do {
+		Alert("Entry could not be saved", $@);
+		next;
+	};
+
+	my $imgpath = "data/word/org/$row->{id}.jpg";
+	my $reimage = eval {
+		($row->{source} // '') ne ($replace->{source} // '') or return;
+		# copy changed remote url to local file
+		unlink $imgpath if -e $imgpath;
+		my $download = $row->{source} or return 1;
+		require LWP::UserAgent;
+		my $ua = LWP::UserAgent->new;
+		$ua->agent('/');
+		my $status = $ua->mirror($download, $imgpath);
+		$status->is_success
+			or die "Download from <q>$download</q> failed: ".$status->status_line."\n";
+	};
+	!$@ or Alert(["Source image not found", $@]);
+
+	$reimage ||= $row->{thumb} ~~ $replace->{thumb};  # different convert
+	$reimage ||= $row->{cover} ~~ $replace->{cover};  # resize
+	$reimage++ if $fields{rethumb};  # force refresh
+
+	my $thumbpath = "data/word/eng/$row->{form}.jpg";
+	if ($reimage) {
+		if (-e $imgpath) {
+			my $xyres = $row->{cover} ? '600x400' : '300x200';
+			my @cmds = @{ $row->{thumb} // [] };
+			@cmds = (
+				'convert',
+				-delete => '1--1', -background => 'white',
+				-gravity => @cmds ? 'northwest' : 'center',
+				@cmds,
+				-resize => "$xyres^", -extent => $xyres,
+				'-strip', -quality => '60%', -interlace => 'plane',
+				$imgpath => $thumbpath
+			);
+			eval {
+				require IPC::Run;
+				my $output;
+				IPC::Run::run(\@cmds, '<' => \undef, '>&' => \$output)
+					or die $output ||
+						($? & 127 ? "signal $?" : "error code ".($? >> 8))."\n";
+			} or Alert([
+				"Thumbnail image not generated",
+				"Failed to convert source image.",
+			], "@cmds\n$@");
+		}
+		else {
+			unlink $thumbpath;
+		}
+	}
+}}
+else {
+	$row->{prio} //= 1;
+	$row->{$_} = $get{$_} for keys %get;
 }
 
-my $title = $find ? "entry <small>#$Request</small>" : 'new entry';
+my $title = $row->{id} ? "entry <small>#$row->{id}</small>" : 'new entry';
 :>
 <h1>Words <:= $title :></h1>
 
-<form action="" method="post">
-<dl>
+<div class="inline">
+
+<form action="?" method="post">
+<input id="id" name="id" value="<:= $row->{id} // '' :>" type="hidden" />
+<ul>
 <:
 
-for my $col (pairs @wordcols) {
-	printf '<dt><label for="%s">%s</label></dt>'
-		. '<dd><input id="%1$s" name="%1$s" value="%s" />',
-		$col->key, $col->value, $row->{$col->key} // '';
-	say '</dd>';
+for my $colinfo (pairs @wordcols) {
+	my ($col, $title) = @{$colinfo};
+	defined $title or next;
+	my $val = $row->{$col} // '';
+	$val = '{'.join(',', map {s/,/\\,/gr} @{$val}).'}' if ref $val eq 'ARRAY';
+	printf '<li><label for="%s">%s</label><p>', $col, $title;
+		printf '<span class=inline>';
+	if ($col eq 'prio') {
+		printf '<select id="%s" name="%1$s">', $col;
+		printf('<option value="%s"%s>%s</option>',
+			$_, $row->{$col} eq $_ && ' selected', $prioenum[$_]
+		) for 0 .. $#prioenum;
+		print '</select>';
+		printf(
+			join('',
+				'<label>',
+				'<input id="%1$s" name="%1$s" value="0" type="hidden" />',
+				'<input id="%s" name="%1$s" value="1" type="checkbox"%s>',
+				' %s</label>',
+			),
+			'cover', !!$row->{cover} && ' checked', 'Highlighted'
+		);
+	}
+	else {
+		printf '<input id="%s" name="%1$s" value="%s" />', $col, Entity($val);
+		-e and printf '<img src="/%s" alt="%s" />', $_, $row->{form}
+			for $col eq 'thumb'  ? "data/word/eng/$row->{form}.jpg" : ();
+		printf('<label for="%s">%s</label><input id="%1$s" name="%1$s" value="%s" />',
+			'ref', 'Reference', Entity($row->{ref})
+		) if $col eq 'cat';
+	}
+		print '</span>';
+	-e and printf('<img id="%spreview" src="/%s" alt="%s" hidden />',
+		$col, $_, $row->{form}
+	) for $col eq 'source' ? "data/word/org/$row->{id}.jpg" : ();
+	say '</p></li>';
 }
 :>
-</dl>
-<p><input type="submit" value="Save" /></p>
+</ul>
+<p>
+	<input type="submit" value="Save" />
+	<input type="submit" value="New" formaction="/writer?copy=cat" />
+</p>
 </form>
+
+<:
+if ($row->{id}) {
+:>
+<section id="nav">
+<h2>Hierarchy</h2>
+
+<:
+say '<ul>';
+my $parents = $db->select(word => '*', {id => $row->{cat}});
+while (my $ref = $parents->hash) {
+	printf '<li><a href="/writer/%d">%s</a></li>', $ref->{id}, Entity($ref->{form});
+}
+say "<li><strong>$row->{form}</strong></li>";
+my $children = $db->select(word => '*', {cat => $row->{id}});
+while (my $ref = $children->hash) {
+	printf '<li><a href="/writer/%d">%s</a></li>', $ref->{id}, Entity($ref->{form});
+}
+:>
+<li><form action="/writer">
+	<input type="hidden" name="cat" value="<:= $row->{id} :>" />
+	<input type="hidden" name="lang" value="<:= $row->{lang} :>" />
+	<input type="submit" value="Add" />
+</form></li>
+</ul>
+</section>
+<:
+}
+:>
+</div>