v2rw/TagPage: Add /experimental/ tag page rewrite with AdvSearch support

3 files changed, 235 insertions, 44 deletions

diff --git a/lib/VNWeb/TT/Index.pm b/lib/VNWeb/TT/Index.pm
index de3fc3f3..5b3b5661 100644
--- a/lib/VNWeb/TT/Index.pm
+++ b/lib/VNWeb/TT/Index.pm
@@ -1,49 +1,7 @@
 package VNWeb::TT::Index;
 
 use VNWeb::Prelude;
-use VNWeb::TT::Lib 'enrich_group';
-
-
-sub tree_ {
-    my($type) = @_;
-    my $table = $type eq 'g' ? 'tag' : 'trait';
-    my $top = tuwf->dbAlli(
-        "SELECT id, name, c_items FROM ${table}s WHERE state = 1+1 AND NOT EXISTS(SELECT 1 FROM ${table}s_parents WHERE $table = id)
-          ORDER BY ", $type eq 'g' ? 'name' : '"order"'
-    );
-
-    enrich childs => id => parent => sub { sql
-        "SELECT tp.parent, t.id, t.name, t.c_items FROM ${table}s t JOIN ${table}s_parents tp ON tp.$table = t.id WHERE state = 1+1 AND tp.parent IN", $_, 'ORDER BY name'
-    }, $top;
-    $top = [ sort { $b->{childs}->@* <=> $a->{childs}->@* } @$top ] if $type eq 'g';
-
-    my sub lnk_ {
-        a_ href => "/$type$_[0]{id}", $_[0]{name};
-        b_ class => 'grayedout', " ($_[0]{c_items})" if $_[0]{c_items};
-    }
-    div_ class => 'mainbox', sub {
-        h1_ $type eq 'g' ? 'Tag tree' : 'Trait tree';
-        ul_ class => 'tagtree', sub {
-            li_ sub {
-                lnk_ $_;
-                my $sub = $_->{childs};
-                ul_ sub {
-                    li_ sub {
-                        txt_ '> ';
-                        lnk_ $_;
-                    } for grep $_, $sub->@[0 .. (@$sub > 6 ? 4 : 5)];
-                    li_ sub {
-                        my $num = @$sub-5;
-                        txt_ '> ';
-                        a_ href => "/$type$_->{id}", style => 'font-style: italic', sprintf '%d more %s%s', $num, $table, $num == 1 ? '' : 's';
-                    } if @$sub > 6;
-                } if @$sub;
-            } for @$top;
-        };
-        clearfloat_;
-        br_;
-    };
-}
+use VNWeb::TT::Lib 'enrich_group', 'tree_';
 
 
 sub recent_ {
diff --git a/lib/VNWeb/TT/Lib.pm b/lib/VNWeb/TT/Lib.pm
index 7521b4f0..cb8bf64d 100644
--- a/lib/VNWeb/TT/Lib.pm
+++ b/lib/VNWeb/TT/Lib.pm
@@ -3,7 +3,7 @@ package VNWeb::TT::Lib;
 use VNWeb::Prelude;
 use Exporter 'import';
 
-our @EXPORT = qw/ tagscore_ enrich_group /;
+our @EXPORT = qw/ tagscore_ enrich_group tree_ /;
 
 sub tagscore_ {
     my($s, $ign) = @_;
@@ -20,4 +20,52 @@ sub enrich_group {
     enrich_merge id => 'SELECT t.id, g.name AS "group" FROM traits t JOIN traits g ON g.id = t."group" WHERE t.id IN', @lst if $type eq 'i';
 }
 
+
+sub tree_ {
+    my($type, $id) = @_;
+    my $table = $type eq 'g' ? 'tag' : 'trait';
+    my $top = tuwf->dbAlli(
+        "SELECT id, name, c_items FROM ${table}s
+          WHERE state = 1+1
+            AND", $id ? sql "id IN(SELECT $table FROM ${table}s_parents WHERE parent = ", \$id, ')'
+                      : "NOT EXISTS(SELECT 1 FROM ${table}s_parents WHERE $table = id)", "
+          ORDER BY ", $type eq 'g' || $id ? 'name' : '"order"'
+    );
+    return if !@$top;
+
+    enrich childs => id => parent => sub { sql
+        "SELECT tp.parent, t.id, t.name, t.c_items FROM ${table}s t JOIN ${table}s_parents tp ON tp.$table = t.id WHERE state = 1+1 AND tp.parent IN", $_, 'ORDER BY name'
+    }, $top;
+    $top = [ sort { $b->{childs}->@* <=> $a->{childs}->@* } @$top ] if $type eq 'g' || $id;
+
+    my sub lnk_ {
+        a_ href => "/$type$_[0]{id}", $_[0]{name};
+        b_ class => 'grayedout', " ($_[0]{c_items})" if $_[0]{c_items};
+    }
+    div_ class => 'mainbox', sub {
+        h1_ $id ? ($type eq 'g' ? 'Child tags' : 'Child traits') : $type eq 'g' ? 'Tag tree' : 'Trait tree';
+        ul_ class => 'tagtree', sub {
+            li_ sub {
+                lnk_ $_;
+                my $sub = $_->{childs};
+                ul_ sub {
+                    li_ sub {
+                        txt_ '> ';
+                        lnk_ $_;
+                    } for grep $_, $sub->@[0 .. (@$sub > 6 ? 4 : 5)];
+                    li_ sub {
+                        my $num = @$sub-5;
+                        txt_ '> ';
+                        a_ href => "/$type$_->{id}", style => 'font-style: italic', sprintf '%d more %s%s', $num, $table, $num == 1 ? '' : 's';
+                    } if @$sub > 6;
+                } if @$sub;
+            } for @$top;
+        };
+        clearfloat_;
+        br_;
+    };
+}
+
+
+
 1;
diff --git a/lib/VNWeb/TT/TagPage.pm b/lib/VNWeb/TT/TagPage.pm
new file mode 100644
index 00000000..80b14d8d
--- /dev/null
+++ b/lib/VNWeb/TT/TagPage.pm
@@ -0,0 +1,185 @@
+package VNWeb::TT::TagPage;
+
+use VNWeb::Prelude;
+use VNWeb::Filters;
+use VNWeb::AdvSearch;
+use VNWeb::VN::List;
+use VNWeb::TT::Lib 'tree_';
+
+
+sub parents_ {
+    my($t) = @_;
+
+    my %t;
+    push $t{$_->{child}}->@*, $_ for tuwf->dbAlli('
+        WITH RECURSIVE p(id,child,name) AS (
+            SELECT ', \$t->{id}, '::int, 0, NULL::text
+            UNION
+            SELECT t.id, p.id, t.name FROM p JOIN tags_parents tp ON tp.tag = p.id JOIN tags t ON t.id = tp.parent
+        ) SELECT * FROM p WHERE child <> 0 ORDER BY name
+    ')->@*;
+
+    my sub rec {
+        $t{$_[0]} ? map { my $e=$_; map [ @$_, $e ], __SUB__->($e->{id}) } $t{$_[0]}->@* : []
+    }
+
+    p_ sub {
+        join_ \&br_, sub {
+            a_ href => '/g', 'Tags';
+            for (@$_) {
+                txt_ ' > ';
+                a_ href => "/g$_->{id}", $_->{name};
+            }
+            txt_ ' > ';
+            txt_ $t->{name};
+        }, rec($t->{id});
+    };
+}
+
+
+sub infobox_ {
+    my($t) = @_;
+
+    p_ class => 'mainopts', sub {
+        a_ href => "/g$t->{id}/add", 'Create child tag';
+    } if $t->{state} != 1 && can_edit g => {};
+    h1_ "Tag: $t->{name}";
+    debug_ $t;
+
+    div_ class => 'warning', sub {
+        h2_ 'Tag deleted';
+        p_ sub {
+            txt_ 'This tag has been removed from the database, and cannot be used or re-added.';
+            br_;
+            txt_ 'File a request on the ';
+            a_ href => '/t/db', 'discussion board';
+            txt_ ' if you disagree with this.';
+        }
+    } if $t->{state} == 1;
+
+    div_ class => 'notice', sub {
+        h2_ 'Waiting for approval';
+        p_ 'This tag is waiting for a moderator to approve it. You can still use it to tag VNs as you would with a normal tag.';
+    } if $t->{state} == 0;
+
+    parents_ $t;
+
+    p_ class => 'description', sub {
+        lit_ bb_format $t->{description};
+    } if $t->{description};
+
+    my @prop = (
+        $t->{searchable} ? () : 'Not searchable.',
+        $t->{applicable} ? () : 'Can not be directly applied to visual novels.'
+    );
+    p_ class => 'center', sub {
+        b_ 'Properties';
+        br_;
+        join_ \&br_, \&txt_, @prop;
+    } if @prop;
+
+    p_ class => 'center', sub {
+        b_ 'Category';
+        br_;
+        txt_ $TAG_CATEGORY{$t->{cat}};
+    };
+
+    p_ class => 'center', sub {
+        b_ 'Aliases';
+        br_;
+        join_ \&br_, sub { txt_ $_ }, $t->{aliases}->@*;
+    } if $t->{aliases}->@*;
+}
+
+
+sub vns_ {
+    my($t) = @_;
+
+    my $opt = tuwf->validate(get =>
+        p => { upage => 1 },
+        f => { advsearch => 'v' },
+        s => { onerror => 'tagscore', enum => [qw/tagscore title rel pop rating/] },
+        o => { onerror => 'd', enum => ['a','d'] },
+        m => { onerror => [auth->pref('spoilers')||0], type => 'array', scalar => 1, minlength => 1, values => { enum => [0..2] } },
+        fil => { required => 0 },
+    )->data;
+    $opt->{m} = $opt->{m}[0];
+
+    # URL compatibility with old filters
+    if(!$opt->{f}->{query} && $opt->{fil}) {
+        my $q = eval {
+            tuwf->compile({ advsearch => 'v' })->validate(filter_release_adv filter_parse v => $opt->{fil})->data;
+        };
+        if(!$q) {
+            warn "Filter compatibility conversion failed\n$@";
+        } else {
+            return tuwf->resRedirect(tuwf->reqPath().'?'.query_encode(%$opt, fil => undef, f => $q), 'temp');
+        }
+    }
+
+    if(auth && !$opt->{f}{query} && !defined tuwf->reqGet('f')) {
+        my $def = tuwf->dbVali('SELECT query FROM saved_queries WHERE qtype = \'v\' AND name = \'\' AND uid =', \auth->uid);
+        $opt->{f} = tuwf->compile({ advsearch => 'v' })->validate($def)->data if $def;
+    }
+
+    my $where = sql 'tvi.tag =', \$t->{id}, 'AND NOT v.hidden AND tvi.spoiler <=', \$opt->{m}, 'AND', $opt->{f}->sql_where();
+
+    my $time = time;
+    my($count, $list);
+    db_maytimeout {
+        $count = tuwf->dbVali('SELECT count(*) FROM vn v JOIN tags_vn_inherit tvi ON tvi.vid = v.id WHERE', $where);
+        $list = $count ? tuwf->dbPagei({results => 50, page => $opt->{p}}, '
+            SELECT tvi.rating AS tagscore, v.id, v.title, v.original, v.c_released, v.c_popularity, v.c_votecount, v.c_rating
+                 , v.c_platforms::text[] AS platforms, v.c_languages::text[] AS lang
+              FROM vn v
+              JOIN tags_vn_inherit tvi ON tvi.vid = v.id
+             WHERE', $where, '
+             ORDER BY', sprintf {
+                 tagscore => 'tvi.rating %s, v.title',
+                 title    => 'v.title %s',
+                 rel      => 'v.c_released %s, v.title',
+                 pop      => 'v.c_popularity %s NULLS LAST, v.title',
+                 rating   => 'v.c_rating %s NULLS LAST, v.title'
+             }->{$opt->{s}}, $opt->{o} eq 'a' ? 'ASC' : 'DESC'
+        ) : [];
+    } || (($count, $list) = (undef, []));
+
+    VNWeb::VN::List::enrich_userlist $list;
+    $time = time - $time;
+
+    div_ class => 'mainbox', sub {
+        p_ class => 'mainopts', sub {
+            a_ href => "/g/links?t=$t->{id}", 'Recently tagged';
+        };
+        h1_ 'Visual novels';
+        form_ action => "/experimental/g$t->{id}", method => 'get', sub {
+            p_ class => 'browseopts', sub {
+                button_ type => 'submit', name => 'm', value => 0, $opt->{m} == 0 ? (class => 'optselected') : (), 'Hide spoilers';
+                button_ type => 'submit', name => 'm', value => 1, $opt->{m} == 1 ? (class => 'optselected') : (), 'Show minor spoilers';
+                button_ type => 'submit', name => 'm', value => 2, $opt->{m} == 2 ? (class => 'optselected') : (), 'Spoil me!';
+            };
+            input_ type => 'hidden', name => 'o', value => $opt->{o};
+            input_ type => 'hidden', name => 's', value => $opt->{s};
+            input_ type => 'hidden', name => 'm', value => $opt->{m};
+            $opt->{f}->elm_;
+            advsearch_msg_ $count, $time;
+        };
+    };
+    VNWeb::VN::List::listing_ $opt, $list, $count, 1 if $count;
+}
+
+
+TUWF::get qr{/experimental/$RE{gid}}, sub {
+    my $t = tuwf->dbRowi('SELECT id, name, description, state, c_items, cat, defaultspoil, searchable, applicable FROM tags WHERE id =', \tuwf->capture('id'));
+    return tuwf->resNotFound if !$t->{id};
+
+    enrich_flatten aliases => id => tag => sub { 'SELECT tag, alias FROM tags_aliases WHERE tag IN', $_, 'ORDER BY alias' }, $t;
+
+    framework_ index => $t->{state} == 2, title => "Tag: $t->{name}", type => 'g', dbobj => $t, sub {
+        div_ class => 'mainbox', sub { infobox_ $t; };
+        tree_ g => $t->{id};
+        vns_ $t if $t->{searchable} && $t->{state} == 2;
+    };
+};
+
+1;