AdvSearch: Add script to convert old saved filters + check saved queries + improve compat

I'll use the conversion script when the new advanced search replaces
the old filter system. Seems to be working alright, but should not be
used in its current form because release filters don't have the
'original language' field yet.

4 files changed, 114 insertions, 10 deletions

diff --git a/lib/VNWeb/AdvSearch.pm b/lib/VNWeb/AdvSearch.pm
index 93469303..6266a2f2 100644
--- a/lib/VNWeb/AdvSearch.pm
+++ b/lib/VNWeb/AdvSearch.pm
@@ -18,6 +18,7 @@ use TUWF;
 use VNWeb::Auth;
 use VNWeb::DB;
 use VNWeb::Validation;
+use VNWeb::HTML ();
 use VNDB::Types;
 
 
diff --git a/lib/VNWeb/Filters.pm b/lib/VNWeb/Filters.pm
index 039d3a32..e38f7a06 100644
--- a/lib/VNWeb/Filters.pm
+++ b/lib/VNWeb/Filters.pm
@@ -119,6 +119,18 @@ sub filter_vn_compat {
 }
 
 
+# Resolutions were passed as integers into an array index before 6bd0b0cd1f3892253d881f71533940f0cf07c13d.
+# New resolutions have been added to this array in the past, so some older filters may reference the wrong resolution.
+my @OLDRES = (qw/unknown nonstandard 640x480 800x600 1024x768 1280x960 1600x1200 640x400 960x600 1024x576 1024x600 1024x640 1280x720 1280x800 1366x768 1600x900 1920x1080/);
+
+sub filter_release_compat {
+    my($fil) = @_;
+    my $mod = 0;
+    $fil->{resolution} &&= [ map /^(?:0|[1-9][0-9]*)$/ && $_ <= $#OLDRES ? do { $mod++; $OLDRES[$_] } : $_, $fil->{resolution}->@* ];
+    $mod;
+}
+
+
 # Throws error on failure.
 sub filter_parse {
     my($type, $str) = @_;
@@ -128,6 +140,7 @@ sub filter_parse {
     die "Invalid filter data: $str\n" if !$data;
     my $f = $s->validate($data)->data;
     filter_vn_compat $f if $type eq 'v';
+    filter_release_compat $f if $type eq 'r';
     $f
 }
 
@@ -207,14 +220,14 @@ sub filter_vn_adv {
     defined $fil->{lang}        ? [ 'or', map [ 'lang',     '=', $_ ], $fil->{lang}->@* ] : (),
     defined $fil->{olang}       ? [ 'or', map [ 'olang',    '=', $_ ], $fil->{olang}->@* ] : (),
     defined $fil->{plat}        ? [ 'or', map [ 'platform', '=', $_ ], $fil->{plat}->@* ] : (),
-    defined $fil->{staff_inc}   ? [ 'staff', '=',  [ 'or', map [ 'id', '=', $_ ], $fil->{staff_inc} ] ] : (),
-    defined $fil->{staff_exc}   ? [ 'staff', '!=', [ 'or', map [ 'id', '=', $_ ], $fil->{staff_exc} ] ] : (),
+    defined $fil->{staff_inc}   ? [ 'staff', '=',  [ 'or', map [ 'id', '=', $_ ], $fil->{staff_inc}->@* ] ] : (),
+    defined $fil->{staff_exc}   ? [ 'staff', '!=', [ 'or', map [ 'id', '=', $_ ], $fil->{staff_exc}->@* ] ] : (),
     auth ? (
-        defined $fil->{ul_notblack}   ? [ 'label', '!=', 6 ] : (),
-        defined $fil->{ul_onwish}     ? [ 'label', $fil->{ul_onwish} ? '=' : '!=', 5 ] : (),
-        defined $fil->{ul_voted}      ? [ 'label', $fil->{ul_voted}  ? '=' : '!=', 7 ] : (),
+        defined $fil->{ul_notblack}   ? [ 'label', '!=', [ auth->uid, 6 ] ] : (),
+        defined $fil->{ul_onwish}     ? [ 'label', $fil->{ul_onwish} ? '=' : '!=', [ auth->uid, 5 ] ] : (),
+        defined $fil->{ul_voted}      ? [ 'label', $fil->{ul_voted}  ? '=' : '!=', [ auth->uid, 7 ] ] : (),
         # XXX: "Not on list" can't be represented in the same way with an AdvSearch query, so it's instead taken to mean "not assigned any of the built-in labels"
-        defined $fil->{ul_onlist}     ? [$fil->{ul_onlist} ? ('or', [ 'label', '=', 0 ], [ 'label', '!=', 0 ]) : ('and', map [ 'label', '!=', $_ ], 1..7)] : (),
+        defined $fil->{ul_onlist}     ? [$fil->{ul_onlist} ? ('or', [ 'label', '=', [ auth->uid, 0 ] ], [ 'label', '!=', [ auth->uid, 0 ] ]) : ('and', map [ 'label', '!=', [ auth->uid, $_ ] ], 1..7)] : (),
     ) : ()
     ]
 }
@@ -231,18 +244,18 @@ sub filter_release_adv {
     defined $fil->{date_before} ? [ 'released', '<=', $fil->{date_before} ] : (),
     defined $fil->{date_after}  ? [ 'released', '>=', $fil->{date_after}  ] : (),
     defined $fil->{released}    ? [ 'released', $fil->{released} ? '<=' : '>', 1 ] : (),
-    defined $fil->{minage}      ? [ 'or', map [ 'minage', '=', $_ ], $fil->{minage}->@* ] : (),
+    defined $fil->{minage}      ? [ 'or', map [ 'minage', '=', $_ == -1 ? undef : $_ ], $fil->{minage}->@* ] : (),
     defined $fil->{lang}        ? [ 'or', map [ 'lang', '=', $_ ], $fil->{lang}->@* ] : (),
     defined $fil->{olang}       ? () : (), # TODO: This isn't supported (yet? it's more like a VN filter).
     defined $fil->{resolution}  ? [ 'or', map [ 'resolution', '=', $_ eq 'unknown' ? [0,0] : $_ eq 'nonstandard' ? [0,1] : [split /x/] ], $fil->{resolution}->@* ] : (),
     defined $fil->{plat}        ? [ 'or', map [ 'platform', '=', $_ eq 'unk' ? '' : $_ ], $fil->{plat}->@* ] : (),
-    defined $fil->{prod_inc}    ? [ 'or', map [ 'producer', '=', $_ ], $fil->{prod_inc}->@* ] : (),
-    defined $fil->{prod_exc}    ? [ 'and', map [ 'producer', '!=', $_ ], $fil->{prod_exc}->@* ] : (),
+    defined $fil->{prod_inc}    ? [ 'or', map [ 'producer-id', '=', $_ ], $fil->{prod_inc}->@* ] : (),
+    defined $fil->{prod_exc}    ? [ 'and', map [ 'producer-id', '!=', $_ ], $fil->{prod_exc}->@* ] : (),
     defined $fil->{med}         ? [ 'or', map [ 'medium', '=', $_ eq 'unk' ? '' : $_ ], $fil->{med}->@* ] : (),
     defined $fil->{voiced}      ? [ 'or', map [ 'voiced', '=', $_ ], $fil->{voiced}->@* ] : (),
     defined $fil->{ani_story}   ? [ 'or', map [ 'animation-story', '=', $_ ], $fil->{ani_story}->@* ] : (),
     defined $fil->{ani_ero}     ? [ 'or', map [ 'animation-ero',   '=', $_ ], $fil->{ani_ero}->@* ]  : (),
-    defined $fil->{engine}      ? [ 'or', map [ 'engine', '=', $_ ], $fil->{engine}->@* ] : (),
+    defined $fil->{engine}      ? [ 'engine', '=', $fil->{engine} ] : (),
     ]
 }
 
diff --git a/util/saved-queries.pl b/util/saved-queries.pl
new file mode 100755
index 00000000..97b4073c
--- /dev/null
+++ b/util/saved-queries.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+# This script checks and updates all queries in the saved_queries table.
+
+use v5.24;
+use warnings;
+use Cwd 'abs_path';
+use TUWF;
+
+my $ROOT;
+BEGIN { ($ROOT = abs_path $0) =~ s{/util/saved-queries\.pl$}{}; }
+
+use lib $ROOT.'/lib';
+use VNDB::Config;
+
+TUWF::set %{ config->{tuwf} };
+
+require VNWeb::AdvSearch;
+
+
+my($total, $updated, $err) = (0,0,0);
+
+for my $r (tuwf->dbAlli('SELECT uid, qtype, name, query FROM saved_queries')->@*) {
+    $total++;
+    my $q = eval { tuwf->compile({advsearch => $r->{qtype}})->validate($r->{query})->data };
+    if(!$q) {
+        $err++;
+        warn "Invalid query: u$r->{uid}, $r->{qtype}, \"$r->{name}\": $r->{query}\n";
+        next;
+    }
+    my $qs = $q->query_encode;
+    if(!$qs) {
+        warn "Empty query: u$r->{uid}, $r->{qtype}, \"$r->{name}\": $r->{query}\n";
+        next;
+    }
+    if($qs ne $r->{query}) {
+        $updated++;
+        tuwf->dbExeci('UPDATE saved_queries SET query =', \$qs, 'WHERE', { uid => $r->{uid}, qtype => $r->{qtype}, name => $r->{name} });
+    }
+}
+
+tuwf->dbCommit;
+
+printf "Updated %d/%d saved queries, %d errors.\n", $updated, $total, $err;
diff --git a/util/updates/wip-advsearch-convert-saved-filters.pl b/util/updates/wip-advsearch-convert-saved-filters.pl
new file mode 100755
index 00000000..16e569b0
--- /dev/null
+++ b/util/updates/wip-advsearch-convert-saved-filters.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+use v5.24;
+use warnings;
+use TUWF;
+use Cwd 'abs_path';
+
+my $ROOT;
+BEGIN { ($ROOT = abs_path $0) =~ s{/util/updates/[^/]+.pl$}{}; }
+
+use lib $ROOT.'/lib';
+use VNDB::Config;
+
+BEGIN { TUWF::set %{ config->{tuwf} } };
+
+use VNWeb::AdvSearch;
+use VNWeb::Filters;
+
+for my $r (tuwf->dbAlli('SELECT id, filter_vn AS fil FROM users WHERE filter_vn <> \'\' AND NOT EXISTS(SELECT 1 FROM saved_queries WHERE uid = id AND name = \'\' AND qtype = \'v\') ORDER BY id')->@*) {
+    next if $r->{fil} =~ /^tagspoil-\d+$/;
+
+    # HACK: trick VNWeb code into thinking we're logged in as the user owning the filter.
+    tuwf->{_TUWF}{request_data}{auth} = bless { user => { user_id => $r->{id} } }, 'VNWeb::Auth';
+
+    my $q = eval { tuwf->compile({advsearch => 'v'})->validate(filter_vn_adv filter_parse v => $r->{fil})->data };
+    if(!$q) {
+        warn "Unable to convert VN filter for u$r->{id}, \"$r->{fil}\": $@";
+        next;
+    }
+    my $qs = $q->query_encode;
+    tuwf->dbExeci('INSERT INTO saved_queries', { uid => $r->{id}, qtype => 'v', name => '', query => $qs }) if $qs;
+}
+
+for my $r (tuwf->dbAlli('SELECT id, filter_release AS fil FROM users WHERE filter_release <> \'\' AND NOT EXISTS(SELECT 1 FROM saved_queries WHERE uid = id AND name = \'\' AND qtype = \'r\') ORDER BY id')->@*) {
+    tuwf->{_TUWF}{request_data}{auth} = bless { user => { user_id => $r->{id} } }, 'VNWeb::Auth';
+
+    my $q = eval { tuwf->compile({advsearch => 'r'})->validate(filter_release_adv filter_parse r => $r->{fil})->data };
+    if(!$q) {
+        warn "Unable to convert release filter for u$r->{id}, \"$r->{fil}\": $@";
+        next;
+    }
+    my $qs = $q->query_encode;
+    tuwf->dbExeci('INSERT INTO saved_queries', { uid => $r->{id}, qtype => 'r', name => '', query => $qs }) if $qs;
+}
+
+tuwf->dbCommit;