TraitPage: Rewrite to use new AdvSearch system

Largely a copy-paste from TagPage.

5 files changed, 185 insertions, 43 deletions

diff --git a/lib/VNDB/Handler/Traits.pm b/lib/VNDB/Handler/Traits.pm
index d3c717e1..9dc08b9f 100644
--- a/lib/VNDB/Handler/Traits.pm
+++ b/lib/VNDB/Handler/Traits.pm
@@ -8,7 +8,7 @@ use VNDB::Func;
 
 
 TUWF::register(
-  qr{i([1-9]\d*)},        \&traitpage,
+  qr{old/i([1-9]\d*)},        \&traitpage,
   qr{xml/traits\.xml},    \&traitxml,
 );
 
diff --git a/lib/VNWeb/Chars/List.pm b/lib/VNWeb/Chars/List.pm
index 62b0d3e9..506f720f 100644
--- a/lib/VNWeb/Chars/List.pm
+++ b/lib/VNWeb/Chars/List.pm
@@ -5,6 +5,7 @@ use VNWeb::AdvSearch;
 use VNWeb::Filters;
 
 
+# Also used by VNWeb::TT::TraitPage
 sub listing_ {
     my($opt, $list, $count) = @_;
     my sub url { '?'.query_encode %$opt, @_ }
@@ -28,6 +29,18 @@ sub listing_ {
 }
 
 
+# Also used by VNWeb::TT::TraitPage
+sub enrich_listing {
+    enrich vn => id => cid => sub { sql '
+        SELECT cv.id AS cid, v.id, v.title, v.original
+          FROM chars_vns cv
+          JOIN vn v ON v.id = cv.vid
+         WHERE NOT v.hidden AND cv.id IN', $_, '
+         ORDER BY v.title'
+    }, @_;
+}
+
+
 TUWF::get qr{/c(?:/(?<char>all|[a-z0]))?}, sub {
     my $opt = tuwf->validate(get =>
         q => { onerror => undef },
@@ -75,14 +88,7 @@ TUWF::get qr{/c(?:/(?<char>all|[a-z0]))?}, sub {
         ) : [];
     } || (($count, $list) = (undef, []));
 
-    enrich vn => id => cid => sub { sql '
-        SELECT cv.id AS cid, v.id, v.title, v.original
-          FROM chars_vns cv
-          JOIN vn v ON v.id = cv.vid
-         WHERE NOT v.hidden AND cv.id IN', $_, '
-         ORDER BY v.title'
-    }, $list;
-
+    enrich_listing $list;
     $time = time - $time;
 
     framework_ title => 'Browse characters', sub {
diff --git a/lib/VNWeb/TT/Lib.pm b/lib/VNWeb/TT/Lib.pm
index cb8bf64d..bb8c1375 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 tree_ /;
+our @EXPORT = qw/ tagscore_ enrich_group tree_ parents_ /;
 
 sub tagscore_ {
     my($s, $ign) = @_;
@@ -67,5 +67,36 @@ sub tree_ {
 }
 
 
+# Breadcrumbs-style listing of parent tags/traits
+sub parents_ {
+    my($type, $t) = @_;
+
+    my %t;
+    my $name = $type eq 'g' ? 'tag' : 'trait';
+    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 ${name}s_parents tp ON tp.${name} = p.id JOIN ${name}s 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 => "/$type", $type eq 'g' ? 'Tags' : 'Traits';
+            for (@$_) {
+                txt_ ' > ';
+                a_ href => "/$type$_->{id}", $_->{name};
+            }
+            txt_ ' > ';
+            txt_ $t->{name};
+        }, rec($t->{id});
+    };
+}
+
 
 1;
diff --git a/lib/VNWeb/TT/TagPage.pm b/lib/VNWeb/TT/TagPage.pm
index c9682551..70f009da 100644
--- a/lib/VNWeb/TT/TagPage.pm
+++ b/lib/VNWeb/TT/TagPage.pm
@@ -4,37 +4,7 @@ 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});
-    };
-}
+use VNWeb::TT::Lib 'tree_', 'parents_';
 
 
 sub infobox_ {
@@ -62,7 +32,7 @@ sub infobox_ {
         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;
+    parents_ g => $t;
 
     p_ class => 'description', sub {
         lit_ bb_format $t->{description};
@@ -172,7 +142,7 @@ sub vns_ {
 
 
 TUWF::get qr{/$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'));
+    my $t = tuwf->dbRowi('SELECT id, name, description, state, c_items, cat, 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;
diff --git a/lib/VNWeb/TT/TraitPage.pm b/lib/VNWeb/TT/TraitPage.pm
new file mode 100644
index 00000000..5a36d667
--- /dev/null
+++ b/lib/VNWeb/TT/TraitPage.pm
@@ -0,0 +1,135 @@
+package VNWeb::TT::TraitPage;
+
+use VNWeb::Prelude;
+use VNWeb::Filters;
+use VNWeb::AdvSearch;
+use VNWeb::TT::Lib 'tree_', 'parents_';
+
+
+sub infobox_ {
+    my($t) = @_;
+
+    p_ class => 'mainopts', sub {
+        a_ href => "/i$t->{id}/add", 'Create child trait';
+    } if $t->{state} != 1 && can_edit i => {};
+    h1_ "Trait: $t->{name}";
+    debug_ $t;
+
+    div_ class => 'warning', sub {
+        h2_ 'Trait deleted';
+        p_ sub {
+            txt_ 'This trait 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 trait is waiting for a moderator to approve it.';
+    } if $t->{state} == 0;
+
+    parents_ i => $t;
+
+    p_ class => 'description', sub {
+        lit_ bb_format $t->{description};
+    } if $t->{description};
+
+    my @prop = (
+        !$t->{sexual}    ? () : 'Indicates sexual content.',
+        $t->{searchable} ? () : 'Not searchable.',
+        $t->{applicable} ? () : 'Can not be directly applied to characters.',
+    );
+    p_ class => 'center', sub {
+        b_ 'Properties';
+        br_;
+        join_ \&br_, sub { txt_ $_ }, @prop;
+    } if @prop;
+
+    p_ class => 'center', sub {
+        b_ 'Aliases';
+        br_;
+        join_ \&br_, sub { txt_ $_ }, split /\n/, $t->{alias};
+    } if $t->{alias};
+}
+
+
+sub chars_ {
+    my($t) = @_;
+
+    my $opt = tuwf->validate(get =>
+        p => { upage => 1 },
+        f => { advsearch_err => 'c' },
+        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 {
+            my $f = filter_parse c => $opt->{fil};
+            # Old URLs often had the trait ID as part of the filter, let's remove that.
+            $f->{trait_inc} = [ grep $_ != $t->{id}, $f->{trait_inc}->@* ] if $f->{trait_inc};
+            delete $f->{trait_inc} if $f->{trait_inc} && !$f->{trait_inc}->@*;
+            $f = filter_char_adv $f;
+            tuwf->compile({ advsearch => 'c' })->validate(@$f > 1 ? $f : undef)->data;
+        };
+        if(!$q) {
+            warn "Filter compatibility conversion failed\n$@";
+        } elsif($q->{query}) {
+            return tuwf->resRedirect(tuwf->reqPath().'?'.query_encode(%$opt, fil => undef, f => $q), 'temp');
+        }
+    }
+
+    $opt->{f} = advsearch_default 'c' if !$opt->{f}{query} && !defined tuwf->reqGet('f');
+
+    my $where = sql 'tc.tid =', \$t->{id}, 'AND NOT c.hidden AND tc.spoil <=', \$opt->{m}, 'AND', $opt->{f}->sql_where();
+
+    my $time = time;
+    my($count, $list);
+    db_maytimeout {
+        $count = tuwf->dbVali('SELECT count(*) FROM chars c JOIN traits_chars tc ON tc.cid = c.id WHERE', $where);
+        $list = $count ? tuwf->dbPagei({results => 50, page => $opt->{p}}, '
+            SELECT c.id, c.name, c.original, c.gender
+              FROM chars c
+              JOIN traits_chars tc ON tc.cid = c.id
+             WHERE', $where, '
+             ORDER BY c.name, c.id'
+        ) : [];
+    } || (($count, $list) = (undef, []));
+
+    VNWeb::Chars::List::enrich_listing $list;
+    $time = time - $time;
+
+    div_ class => 'mainbox', sub {
+        h1_ 'Characters';
+        form_ action => "/i$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 => 'm', value => $opt->{m};
+            $opt->{f}->elm_;
+            advsearch_msg_ $count, $time;
+        };
+    };
+    VNWeb::Chars::List::listing_ $opt, $list, $count, 1 if $count;
+}
+
+
+TUWF::get qr{/$RE{iid}}, sub {
+    my $t = tuwf->dbRowi('SELECT id, name, alias, description, state, c_items, sexual, searchable, applicable FROM traits WHERE id =', \tuwf->capture('id'));
+    return tuwf->resNotFound if !$t->{id};
+
+    framework_ index => $t->{state} == 2, title => "Trait: $t->{name}", type => 'i', dbobj => $t, sub {
+        div_ class => 'mainbox', sub { infobox_ $t; };
+        tree_ i => $t->{id};
+        chars_ $t if $t->{searchable} && $t->{state} == 2;
+    };
+};
+
+1;