X-Git-Url: http://git.shiar.net/sheet.git/blobdiff_plain/df43fa85051ebf955c1f42dab2d789b5d6a68aa6..74d561810b2bf81617b84bc1581d8b59c359d5c9:/writer.plp diff --git a/writer.plp b/writer.plp index 62d26d7..493f745 100644 --- a/writer.plp +++ b/writer.plp @@ -5,89 +5,7 @@ Html({ version => '1.0', nocache => 1, raw => <<'EOT', - - + EOT }); @@ -95,16 +13,58 @@ 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, - }); + require Shiar_Sheet::DB; + Shiar_Sheet::DB->connect; } or Abort('Database error', 501, $@); -$db->abstract->{array_datatypes}++; + +my $user = eval { + if (defined $post{username}) { + $cookie{login} = EncodeURI(join ':', @post{qw( username pass )}); + } + elsif (exists $fields{logout}) { + require CGI::Cookie; + if (AddCookie(CGI::Cookie->new( + -name => 'login', + -value => '', + -path => '/writer', + -expires => 'now', + )->as_string)) { + delete $cookie{login}; + die "Logged out as requested\n"; + } + Alert("Failed to log out", "Login cookie could not be removed."); + } + + my $cookiedata = $cookie{login} or return; + my ($name, $key) = split /[:\v]/, DecodeURI($cookiedata); + my %rowmatch = (username => $name, pass => $key); + my $found = $db->select(login => '*', \%rowmatch)->hash + or die "Invalid user or password\n"; + + eval { + require CGI::Cookie; + my $httpcookie = CGI::Cookie->new( + -name => 'login', + -value => join(':', @{$found}{qw( username pass )}), + -path => '/writer', + ) or die "prepared object is empty\n"; + AddCookie($httpcookie->as_string); + } or Abort(["Unable to create login cookie", $@], 403); + + return $found; +} or do { + say '

Login to edit words

'; + Alert('Access denied', $@) if $@; + say '
'; + exit; +}; my %lang = ( nl => ["\N{REGIONAL INDICATOR SYMBOL LETTER N}\N{REGIONAL INDICATOR SYMBOL LETTER L}", 'nederlands'], @@ -120,9 +80,14 @@ my %wordcol = ( cat => [{-label => 'Category'}, 'ref'], ref => {-label => 'Reference'}, prio => [ - {-label => 'Level', -select => [qw( - essential basic common distinctive rare invisible - )]}, + {-label => 'Level', -select => sub { + my ($row) = @_; + my @enum = qw[ essential basic common distinctive optional invisible ]; + return { + ('' => 'parent') x (defined $row->{ref}), + map { $_ => $enum[$_] } 0 .. $#enum + }; + }}, 'cover', 'grade', ], cover => {-label => 'Highlighted', type => 'checkbox'}, @@ -144,13 +109,19 @@ if ($find) { if (exists $get{copy}) { $row = {%{$row}{ qw(prio lang cat) }}; } -elsif ($ENV{REQUEST_METHOD} eq 'POST') {{ +elsif (defined $post{form}) {{ + sub parseinput { + return if not length $_[0]; + require Encode; + return Encode::decode_utf8($_[0]); + } + my $replace = $row; - $row = {%post{keys %wordcol}}; - $row->{$_} = [grep {length} @{ $post{"\@$_"} }] for grep { - ref $wordcol{$_} eq 'HASH' and $wordcol{$_}->{-multiple} - } keys %wordcol; - $_ = length ? $_ : undef for values %{$row}; + $row = {map { $_ => + ref $wordcol{$_} eq 'HASH' && $wordcol{$_}->{-multiple} ? + [ map { parseinput($_) } $post{'@'.$_}->@* ] : + scalar parseinput($post{$_}) + } keys %wordcol}; if (!$row->{form}) { if ($row->{ref} ne 'delete') { @@ -167,6 +138,8 @@ elsif ($ENV{REQUEST_METHOD} eq 'POST') {{ eval { my %res = (returning => '*'); + $row->{creator} = $user->{id} unless $find; + $row->{updated} = ['now()']; my $query = $find ? $db->update(word => $row, $find, \%res) : $db->insert(word => $row, \%res); $row = $query->hash; @@ -179,11 +152,15 @@ elsif ($ENV{REQUEST_METHOD} eq 'POST') {{ while (my ($lang, $val) = each %post) { my $field = $lang; $lang =~ s/^trans-// or next; - $db->insert(word => { + $val = parseinput($val) or next; + my %subrow = ( ref => $row->{id}, lang => $lang, form => $val, - }); + prio => undef, + ); + $subrow{wptitle} = $1 if $subrow{form} =~ s/\h*\[(.*)\]$//; # [Link] shorthand + $db->insert(word => \%subrow); delete $fields{$field}; } return 1; @@ -228,12 +205,13 @@ elsif ($ENV{REQUEST_METHOD} eq 'POST') {{ } @cmds = ( 'convert', + $imgpath, -delete => '1--1', -background => 'white', -gravity => @cmds ? 'northwest' : 'center', @cmds, -resize => "$xyres^", -extent => $xyres, '-strip', -quality => '60%', -interlace => 'plane', - $imgpath => $thumbpath + $thumbpath ); eval { require IPC::Run; @@ -252,8 +230,9 @@ elsif ($ENV{REQUEST_METHOD} eq 'POST') {{ } }} else { - $row->{prio} //= 1; + $row->{lang} //= $user->{editlang}->[0]; $row->{$_} = $get{$_} for keys %get; + $row->{prio} = defined $row->{ref} ? undef : 1 unless exists $row->{prio}; } my $title = $row->{id} ? "entry #$row->{id}" : 'new entry'; @@ -268,8 +247,7 @@ package Shiar_Sheet::FormRow { $html .= qq( $_="$attr->{$_}") for sort grep {!/^-/} keys %{$attr // {}}; if (my $options = $attr->{-select}) { - $options = { map {$_ => $options->[$_]} 0 .. $#{$options} } - if ref $options eq 'ARRAY'; + $options = $options->(@_) if ref $options eq 'CODE'; $options->{$val} //= "unknown ($val)"; # preserve current return ( sprintf('', $col, EscapeHTML($_)) } ref $val eq 'ARRAY' ? @{$val} : ()), sprintf('', - $col, ref $val eq 'ARRAY' ? '' : EscapeHTML($val), $html + $col, $multiple ? '' : EscapeHTML($val), $html ), + $multiple ? '' : (), (map { sprintf '%s', $col, $_, $row->{form}, $col eq 'source' ? ' hidden' : ''; @@ -312,7 +293,7 @@ package Shiar_Sheet::FormRow { sub imagepath { my ($row, $col) = @_; return "data/word/org/$row->{id}.jpg" if $col eq 'source'; - return "data/word/en/$row->{form}.jpg" if $col eq 'thumb'; + return "data/word/en/$row->{id}.jpg" if $col eq 'thumb'; return; } } @@ -338,14 +319,18 @@ for my $col (@wordcols) { say '

'; } -if ($row->{id} and not $row->{ref}) { +if (not $row->{ref}) { printf '
    • ';