<(common.inc.plp)><: Html({ title => 'words cheat sheet admin', version => '1.0', nocache => 1, raw => <<'EOT', EOT }); use List::Util qw( pairs pairkeys ); my $db = eval { my @dbinfo = ( 'DBI:Pg:dbname=sheet;host=localhost', 'sheetadmin', 'fairuse', ) or die "database not configured\n"; require DBIx::Simple; DBIx::Simple->new(@dbinfo[0..2], { RaiseError => 1, pg_enable_utf8 => 1, }); } or Abort('Database error', 501, $@); my @wordcols = ( lang => 'Language', cat => 'Category', ref => undef, # included with cat grade => undef, # " prio => 'Level', cover => undef, # included with prio form => 'Title', alt => 'Synonyms', wptitle => 'Wikipedia', source => 'Image', thumb => 'Convert options', ); my @prioenum = qw( essential basic common distinctive rare invisible ); my %langflag = ( nld => "\N{REGIONAL INDICATOR SYMBOL LETTER N}\N{REGIONAL INDICATOR SYMBOL LETTER L}", eng => "\N{REGIONAL INDICATOR SYMBOL LETTER G}\N{REGIONAL INDICATOR SYMBOL LETTER B}", epo => '★', ); my ($find) = map {{id => $_}} $fields{id} || $Request || (); my $row; 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 => '*'); my $query = $find ? $db->update(word => $row, $find, \%res) : $db->insert(word => $row, \%res); $row = $query->hash; } or do { Alert("Entry could not be saved", $@); next; }; my $imgpath = Shiar_Sheet::FormRow::imagepath($row, 'source'); 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 $download 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 = Shiar_Sheet::FormRow::imagepath($row => 'thumb'); 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 = $row->{id} ? "entry #$row->{id}" : 'new entry'; package Shiar_Sheet::FormRow { sub input { my ($row, $col, $type, $label) = @_; my $val = $row->{$col} // ''; $val = '{'.join(',', map {s/,/\\,/gr} @{$val}).'}' if ref $val eq 'ARRAY'; if (ref $type eq 'ARRAY') { return ( sprintf('', ); } elsif ($type eq 'checkbox') { return sprintf( join('', '', ), $col, $type, !!$val && ' checked', $label ); } else { my $html = ''; $html .= qq( $_="$type->{$_}") for sort keys %{$type // {}}; return ( $label ? sprintf('', $col, $label) : (), sprintf('', $col, PLP::Functions::EscapeHTML($val), $html ), (map { sprintf '%s', $col, $_, $row->{form}, $col eq 'source' ? ' hidden' : ''; } grep { -e } $row->imagepath($col)), ); } } sub imagepath { my ($row, $col) = @_; return "data/word/org/$row->{id}.jpg" if $col eq 'source'; return "data/word/eng/$row->{form}.jpg" if $col eq 'thumb'; return; } } bless $row, 'Shiar_Sheet::FormRow'; :>

Words <:= $title :>

<: if ($row->{id}) { :> <: } :>