X-Git-Url: http://git.shiar.net/sheet.git/blobdiff_plain/09d717e37fb372aa459fa1aab3cc5334ddb849b8..3207fe934ef25ea7980d123c83c2711cf8964646:/writer.plp

diff --git a/writer.plp b/writer.plp
index 6177fcd..cd2e2bf 100644
--- a/writer.plp
+++ b/writer.plp
@@ -11,6 +11,8 @@ EOT
 });
 
 use List::Util qw( pairs pairkeys );
+use Shiar_Sheet::FormRow;
+use JSON;
 
 my $db = eval {
 	require Shiar_Sheet::DB;
@@ -98,9 +100,13 @@ my %wordcol = (
 	form    => {-label => 'Title'},
 	alt     => {-label => 'Synonyms', -multiple => 1},
 	wptitle => {-label => 'Wikipedia'},
-	source  => {-label => 'Image'},
-	thumb   => {-label => 'Convert options', -multiple => 1},
-	story   => {-label => 'Story', type => 'textarea'},
+	source  => {-label => 'Image', -json => 'image', -src => sub {
+		return "data/word/org/$_[0]->{id}.jpg";
+	}},
+	convert => {-label => 'Convert options', -json => 'image', -multiple => 1, -src => sub {
+		return "data/word/en/$_[0]->{id}.jpg";
+	}},
+	story   => {-label => 'Story', type => 'textarea', hidden => 'hidden'},
 );
 
 if (my $search = $fields{q}) {
@@ -109,7 +115,7 @@ if (my $search = $fields{q}) {
 	say '<h1>Search</h1><ul>';
 	printf("<li><small>%s</small> %s %s</li>\n",
 		$_->{id}, showlink($_->{form}, "/writer/$_->{id}"),
-		sprintf('<img src="/%s" style="height:3ex; width:auto" />', Shiar_Sheet::FormRow::imagepath($_ => 'thumb')) x defined $_->{thumb}
+		sprintf('<img src="/%s" style="height:3ex; width:auto" />', $wordcol{convert}->{-src}->($_)) x defined $_->{image}
 	) for $results->hashes;
 	say "</ul>\n";
 	exit;
@@ -132,12 +138,22 @@ elsif (defined $post{form}) {{
 		return Encode::decode_utf8($_[0]);
 	}
 
-	my $replace = $row;
-	$row = {map { $_ =>
-		ref $wordcol{$_} eq 'HASH' && $wordcol{$_}->{-multiple} ?
-			[ map { parseinput($_) } $post{'@'.$_}->@* ] :
-		scalar parseinput($post{$_})
-	} keys %wordcol};
+	my $replace = $row;  # currently stored
+	$row = {};  # proposed update
+	while (my ($col, $colinfo) = each %wordcol) {
+		ref $colinfo eq 'HASH' or $colinfo = {};
+		my @val = map { parseinput($_) } $post{'@'.$col}->@*;
+		my $val = $colinfo->{-multiple} && @val ? \@val : $val[-1];
+		if (my $jsoncol = $colinfo->{-json}) {
+			defined $val and
+			$row->{$jsoncol}->{$col} = $val;  # hash will be encoded
+		}
+		else {
+			$row->{$col} = $val;
+		}
+	}
+	my $imagecol = $row->{image};  # backup image subcolumns
+	ref $_ eq 'HASH' and $_ = encode_json($_) for values %{$row};
 
 	if (!$row->{form}) {
 		if ($row->{ref} ne 'delete') {
@@ -183,67 +199,24 @@ elsif (defined $post{form}) {{
 		return 1;
 	} or Alert('Error creating translation entries', $@);
 
-	my $imgpath = Shiar_Sheet::FormRow::imagepath($row, 'source');
+	require Shiar_Sheet::ImagePrep;
+	my $image = Shiar_Sheet::ImagePrep->new($wordcol{source}->{-src}->($row));
 	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";
+		($imagecol->{source} // '') ne ($replace->{source} // '') or return;
+		$image->download($imagecol->{source});
 	};
 	!$@ or Alert(["Source image not found", $@]);
 
-	$reimage ||= $row->{thumb} ~~ $replace->{thumb};  # different convert
+	$reimage ||= $row->{image} ~~ $replace->{image};  # different source
 	$reimage ||= $row->{cover} ~~ $replace->{cover};  # resize
 	$reimage++ if $fields{rethumb};  # force refresh
-
-	my $thumbpath = Shiar_Sheet::FormRow::imagepath($row => 'thumb');
 	if ($reimage) {
-		if (-e $imgpath) {
-			my $xyres = $row->{cover} ? '600x400' : '300x200';
-			my @cmds = @{ $row->{thumb} // [] };
-			if (my ($cmdarg) = grep { $cmds[$_] eq '-area' } 0 .. $#cmds) {
-				# replace option by permillage crop
-				my @dim = map { $_ / 1000 } split /\D/, $cmds[$cmdarg + 1];
-				splice @cmds, $cmdarg, 2, (
-					-set => 'option:distort:viewport' => sprintf(
-						'%%[fx:w*%s]x%%[fx:h*%s]+%%[fx:w*%s]+%%[fx:h*%s]',
-						($dim[2] || 1) - $dim[0], # width  = x2 - x1
-						($dim[3] || 1) - $dim[1], # height = y2 - y1
-						@dim[0, 1]                # offset = x1,y1
-					),
-					-distort => SRT => 0, # noop transform to apply viewport
-				);
-			}
-			@cmds = (
-				'convert',
-				$imgpath,
-				-delete => '1--1', -background => 'white',
-				-gravity => defined $row->{thumb} ? 'northwest' : 'center',
-				@cmds,
-				-resize => "$xyres^", -extent => $xyres,
-				'-strip', -quality => '60%', -interlace => 'plane',
-				$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;
-		}
+		eval {
+			$image->convert($wordcol{convert}->{-src}->($row), $imagecol->{convert});
+		} or do {
+			my ($warn, @details) = ref $@ ? @{$@} : $@;
+			Alert([ "Thumbnail image not generated", $warn ], @details);
+		};
 	}
 }}
 else {
@@ -252,78 +225,15 @@ else {
 	$row->{prio} = defined $row->{ref} ? undef : 1 unless exists $row->{prio};
 }
 
-my $title = $row->{id} ? "entry <small>#$row->{id}</small>" : 'new entry';
-
-package Shiar_Sheet::FormRow {
-	use PLP::Functions 'EscapeHTML';
-
-	sub input {
-		my ($row, $col, $attr) = @_;
-		my $val = $row->{$col} // '';
-		my $html = '';
-		$html .= qq( $_="$attr->{$_}") for sort grep {!/^-/} keys %{$attr // {}};
-
-		if (my $options = $attr->{-select}) {
-			$options = $options->(@_) if ref $options eq 'CODE';
-			$options->{$val} //= "unknown ($val)";  # preserve current
-			return (
-				sprintf('<select id="%s" name="%1$s">', $col),
-				(map { sprintf('<option value="%s"%s>%s</option>',
-					$_, $val eq $_ && ' selected', $options->{$_}
-				) } sort keys %{$options}),
-				'</select>',
-			);
-		}
-		elsif ($attr->{type} eq 'textarea') {
-			return (
-				(map {
-					sprintf('<label for="%s">%s</label>', $col, $_)
-				} $attr->{-label} // ()),
-				sprintf('<textarea id="%s" name="%1$s"%s>%s</textarea>',
-					$col, $html, EscapeHTML($val)
-				),
-			);
-		}
-		elsif ($attr->{type} eq 'checkbox') {
-			$html .= ' checked' if $val;
-			return sprintf(
-				join('',
-					'<label>',
-					'<input name="%1$s" value="0" type="hidden" />',
-					'<input id="%s" name="%1$s" value="1"%s>',
-					' %s</label>',
-				), $col, $html, $attr->{-label}
-			);
-		}
-		else {
-			my $multiple = ref $val eq 'ARRAY' || $attr->{-multiple};
-			return (
-				(map {
-					sprintf('<label for="%s">%s</label>', $col, $_)
-				} $attr->{-label} // ()),
-				$multiple ? '<span class="inline multiinput">' : (),
-				(map {
-					sprintf('<input name="%s" value="%s" />', $col, EscapeHTML($_))
-				} ref $val eq 'ARRAY' ? @{$val} : ()),
-				sprintf('<input id="%s" name="%1$s" value="%s"%s />',
-					$col, $multiple ? '' : EscapeHTML($val), $html
-				),
-				$multiple ? '</span>' : (),
-				(map {
-					sprintf '<img id="%spreview" src="/%s" alt="%s"%s />',
-						$col, $_, $row->{form}, $col eq 'source' ? ' hidden' : '';
-				} grep { -e } $row->imagepath($col)),
-			);
-		}
+eval {
+	my $imagerow = $row->{image} && decode_json(delete $row->{image}) || {};
+	while (my ($col, $val) = each %{$imagerow}) {
+		$row->{$col} = $val;
 	}
+	1;
+} or Alert("Error decoding image metadata", $@);
 
-	sub imagepath {
-		my ($row, $col) = @_;
-		return "data/word/org/$row->{id}.jpg"   if $col eq 'source';
-		return "data/word/en/$row->{id}.jpg"  if $col eq 'thumb';
-		return;
-	}
-}
+my $title = $row->{id} ? "entry <small>#$row->{id}</small>" : 'new entry';
 bless $row, 'Shiar_Sheet::FormRow';
 :>
 <h1>Words <:= $title :></h1>
@@ -337,10 +247,16 @@ bless $row, 'Shiar_Sheet::FormRow';
 for my $col (@wordcols) {
 	my $info = $wordcol{$col} or next;
 	my ($attr, @span) = ref $info eq 'ARRAY' ? @{$info} : $info;
+	next if delete $attr->{hidden} and not $row->{$col};
 	my $title = ref $attr ? delete $attr->{-label} : $attr;
 	printf '<li><label for="%s">%s</label><p>', $col, $title;
 		printf '<span class=inline>';
 		print $row->input($col => $attr);
+		if (my $imgsrc = $attr->{-src}) {
+			printf('<img id="%spreview" src="/%s" alt="%s"%s />',
+				$col, $_, $row->{form}, $col eq 'source' && ' hidden'
+			) for grep { -e } $imgsrc->($row);
+		}
 		print $row->input($_ => delete $wordcol{$_}) for @span;
 		print '</span>';
 	say '</p></li>';