word/edit: subpage alias to writer functionality
[sheet.git] / writer.plp
index 7280142226a1c30dd19ddeb734e9825b02636f0e..84dc4a8a2b66795ca574173d6e9d96fd6dd6b7d3 100644 (file)
@@ -5,89 +5,7 @@ Html({
        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,select {
-       box-sizing: border-box;
-       flex-grow: 1;
-}
-input:not([type=submit]) {
-       padding: .4rem;
-       font-family: monospace;
-}
-input[type=number] {
-       max-width: 7em;
-}
-select {
-       padding: .3rem .2rem; /* TODO: input */
-}
-#thumbpreview {
-       width: 300px;
-       align-self: start;
-}
-
-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: baseline;
-       margin: 0 -1ex; /* inner gap */
-}
-.inline > * {
-       margin: 0 1ex;
-}
-.inline .inline {
-       display: flex;
-}
-
-#nav > ul,
-#nav > ul strong,
-#nav form {
-       margin: 1ex 0;
-       display: inline-block;
-}
-</style>
-
+<link rel="stylesheet" type="text/css" media="all" href="/editor.css" />
 <script src="/writer.js"></script>
 EOT
 });
@@ -95,21 +13,66 @@ 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, $@);
 
+my $user = eval {
+       my $rootpath = ($ENV{REQUEST_URI} // '/writer') =~ s{(?<!^)/.+}{}r;
+       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    => $rootpath,
+                       -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    => $rootpath,
+               ) or die "prepared object is empty\n";
+               AddCookie($httpcookie->as_string);
+       } or Abort(["Unable to create login cookie", $@], 403);
+
+       return $found;
+} or do {
+       say '<h1>Login to edit words</h1>';
+       Alert('Access denied', $@) if $@;
+       say '<form action="?" method="post" class="inline"><ul>';
+       my $loginform = bless {%post}, 'Shiar_Sheet::FormRow';
+       say '<li>', $loginform->input(@{$_}), '</li>' for pairs (
+               username => {-label => 'User name'},
+               pass     => {-label => 'Password', type => 'password'},
+       );
+       say '<li><input type="submit" value="Login" /></li>';
+       say '</ul></form>';
+       exit;
+};
+
 my %lang = (
        nl => ["\N{REGIONAL INDICATOR SYMBOL LETTER N}\N{REGIONAL INDICATOR SYMBOL LETTER L}", 'nederlands'],
        en => ["\N{REGIONAL INDICATOR SYMBOL LETTER G}\N{REGIONAL INDICATOR SYMBOL LETTER B}", 'english'],
        eo => ['<span style="color:green">★</span>', 'esperanto'],
        ru => ["\N{REGIONAL INDICATOR SYMBOL LETTER R}\N{REGIONAL INDICATOR SYMBOL LETTER U}", 'русский'],
+       la => ["\N{PUSHPIN}", 'latin'],
 );
 my @wordcols = pairkeys
 my %wordcol = (
@@ -119,21 +82,38 @@ 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'},
        grade   => {-label => 'Order', type => 'number'},
        form    => {-label => 'Title'},
-       alt     => {-label => 'Synonyms'},
+       alt     => {-label => 'Synonyms', -multiple => 1},
        wptitle => {-label => 'Wikipedia'},
        source  => {-label => 'Image'},
-       thumb   => {-label => 'Convert options'},
+       thumb   => {-label => 'Convert options', -multiple => 1},
 );
-my ($find) = map {{id => $_}} $fields{id} || $Request || ();
 
+if (my $search = $fields{q}) {
+       my %filter = (form => {ilike => '%'.$search.'%'});
+       my $results = $db->select(word => '*', \%filter);
+       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}
+       ) for $results->hashes;
+       say "</ul>\n";
+       exit;
+}
+
+my ($find) = map {{id => $_}} $fields{id} || $Request || ();
 my $row;
 if ($find) {
        $row = $db->select(word => '*', $find)->hash
@@ -143,10 +123,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}};
-       $_ = 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') {
@@ -163,6 +152,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;
@@ -175,11 +166,16 @@ 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
+                       $subrow{alt} = [split m{/}, $1] if $subrow{form} =~ s{/(\S.*)}{}; # /alternates shorthand
+                       $db->insert(word => \%subrow);
                        delete $fields{$field};
                }
                return 1;
@@ -224,12 +220,13 @@ elsif ($ENV{REQUEST_METHOD} eq 'POST') {{
                        }
                        @cmds = (
                                'convert',
+                               $imgpath,
                                -delete => '1--1', -background => 'white',
-                               -gravity => @cmds ? 'northwest' : 'center',
+                               -gravity => defined $row->{thumb} ? 'northwest' : 'center',
                                @cmds,
                                -resize => "$xyres^", -extent => $xyres,
                                '-strip', -quality => '60%', -interlace => 'plane',
-                               $imgpath => $thumbpath
+                               $thumbpath
                        );
                        eval {
                                require IPC::Run;
@@ -248,23 +245,24 @@ 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 <small>#$row->{id}</small>" : 'new entry';
 
 package Shiar_Sheet::FormRow {
+       use PLP::Functions 'EscapeHTML';
+
        sub input {
                my ($row, $col, $attr) = @_;
                my $val = $row->{$col} // '';
-               $val = '{'.join(',', map {s/,/\\,/gr} @{$val}).'}' if ref $val eq 'ARRAY';
                my $html = '';
                $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('<select id="%s" name="%1$s">', $col),
@@ -286,13 +284,19 @@ package Shiar_Sheet::FormRow {
                        );
                }
                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, PLP::Functions::EscapeHTML($val), $html
+                                       $col, $multiple ? '' : EscapeHTML($val), $html
                                ),
+                               $multiple ? '</span>' : (),
                                (map {
                                        sprintf '<img id="%spreview" src="/%s" alt="%s"%s />',
                                                $col, $_, $row->{form}, $col eq 'source' ? ' hidden' : '';
@@ -304,7 +308,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;
        }
 }
@@ -330,14 +334,18 @@ for my $col (@wordcols) {
        say '</p></li>';
 }
 
-if ($row->{id} and not $row->{ref}) {
+if (not $row->{ref}) {
        printf '<li><label for="%s">%s</label><div><ul class="inline" id="%1$s">',
                'trans', 'Translations';
-       my @children = $db->select(word => '*', {ref => $row->{id}}, 'lang, id')->hashes;
+       my @children = !$row->{id} ? () :
+               $db->select(word => '*', {ref => $row->{id}}, 'lang, id')->hashes;
        while (my ($lang, $val) = each %fields) {
                $lang =~ s/^trans-// or next;
                push @children, { lang => $lang, form => $val };
        }
+       my %existing = map { $_->{lang} => 1 } $row, @children;
+       $existing{$_} or push @children, { lang => $_ } for @{$user->{editlang}};
+
        for my $ref (@children) {
                printf(
                        '<li><label for="%s" title="%3$s">%s </label>',
@@ -346,7 +354,7 @@ if ($row->{id} and not $row->{ref}) {
                printf(
                        $ref->{id} ? '<a id="%s" href="%s">%s</a></li>' :
                        '<input id="%s" name="%1$s" value="%3$s" />',
-                       "trans-$ref->{lang}", "/writer/$ref->{id}", Entity($ref->{form}),
+                       "trans-$ref->{lang}", "/writer/$ref->{id}", Entity($ref->{form} // ''),
                );
        }
        say '</ul></div></li>';