Releases::List: Add experimental new release browser with advanced search

Uses the same release_row_() function used on VN and producer pages, so
this adds a lot more information and user list management functionality
to the release browser.

Removed compat with *very* old URLs, I'm monitoring the logs to see if
those are still used. Also removes a friendly message when the filters
don't match anything.

Main reason for implementing this before going live with the VN advanced
search is to make it possible to also switch the default saved release
filters to the new system in one go.

2 files changed, 115 insertions, 4 deletions

diff --git a/lib/VNWeb/Releases/Lib.pm b/lib/VNWeb/Releases/Lib.pm
index 207faba8..07bb6878 100644
--- a/lib/VNWeb/Releases/Lib.pm
+++ b/lib/VNWeb/Releases/Lib.pm
@@ -68,8 +68,12 @@ sub release_extlinks_ {
 }
 
 
+# Options
+#   id:   unique identifier if the same release may be listed on a page twice.
+#   lang: 0/1 whether to display language icons
+#   prod: 0/1 whether to display Pub/Dev indication
 sub release_row_ {
-    my($r, $id, $prodpage) = @_;
+    my($r, $opt) = @_;
 
     my sub icon_ {
         my($img, $label, $class) = @_;
@@ -103,7 +107,7 @@ sub release_row_ {
         td_ class => 'tc2', $r->{minage} < 0 ? '' : minage $r->{minage};
         td_ class => 'tc3', sub {
             abbr_ class => "icons $_", title => $PLATFORM{$_}, '' for grep $_ ne 'oth', $r->{platforms}->@*;
-            if($prodpage) {
+            if($opt->{lang}) {
                 abbr_ class => "icons lang $_", title => $LANGUAGE{$_}, '' for $r->{lang}->@*;
             }
             abbr_ class => "icons rt$r->{type}", title => $r->{type}, '';
@@ -114,11 +118,11 @@ sub release_row_ {
             b_ class => 'grayedout', " ($note)" if $note;
         };
         td_ class => 'tc_icons', sub { icons_ $r };
-        td_ class => 'tc_prod', join ' & ', $r->{publisher} ? 'Pub' : (), $r->{developer} ? 'Dev' : () if $prodpage;
+        td_ class => 'tc_prod', join ' & ', $r->{publisher} ? 'Pub' : (), $r->{developer} ? 'Dev' : () if $opt->{prod};
         td_ class => 'tc5 elm_dd_left', sub {
             elm_ 'UList.ReleaseEdit', $VNWeb::ULists::Elm::RLIST_STATUS, { rid => $r->{id}, uid => auth->uid, status => $r->{rlist_status}, empty => '--' } if auth;
         };
-        td_ class => 'tc6', sub { release_extlinks_ $r, "${id}_$r->{id}" };
+        td_ class => 'tc6', sub { release_extlinks_ $r, "$opt->{id}_$r->{id}" };
     }
 }
 
diff --git a/lib/VNWeb/Releases/List.pm b/lib/VNWeb/Releases/List.pm
new file mode 100644
index 00000000..89332200
--- /dev/null
+++ b/lib/VNWeb/Releases/List.pm
@@ -0,0 +1,107 @@
+package VNWeb::Releases::List;
+
+use VNDB::Func 'gtintype';
+use VNWeb::Prelude;
+use VNWeb::AdvSearch;
+use VNWeb::Filters;
+use VNWeb::Releases::Lib;
+
+
+sub listing_ {
+    my($opt, $list, $count) = @_;
+    my sub url { '?'.query_encode %$opt, @_ }
+    paginate_ \&url, $opt->{p}, [$count, 50], 't';
+    div_ class => 'mainbox browse', sub {
+        table_ class => 'stripe releases', sub {
+            thead_ sub { tr_ sub {
+                td_ class => 'tc1', sub { txt_ 'Date';   sortable_ 'released',$opt, \&url; debug_ $list; };
+                td_ class => 'tc2', sub { txt_ 'Rating'; sortable_ 'minage',  $opt, \&url };
+                td_ class => 'tc3', '';
+                td_ class => 'tc4', sub { txt_ 'Title';  sortable_ 'title',   $opt, \&url };
+                td_ class => 'tc_icons', '';
+                td_ class => 'tc5', '';
+                td_ class => 'tc6', '';
+            } };
+            my $ropt = { id => '', lang => 1 };
+            release_row_ $_, $ropt for @$list;
+        }
+    };
+    paginate_ \&url, $opt->{p}, [$count, 50], 'b';
+}
+
+
+TUWF::get qr{/experimental/r}, sub {
+    my $opt = tuwf->validate(get =>
+        q => { onerror => undef },
+        p => { upage => 1 },
+        f => { advsearch => 'r' },
+        s => { onerror => 'title', enum => [qw/released minage title/] },
+        o => { onerror => 'a', enum => ['a','d'] },
+        fil => { required => 0 },
+    )->data;
+
+    # URL compatibility with old filters
+    if(!$opt->{f}->{query} && $opt->{fil}) {
+        my $q = eval {
+            tuwf->compile({ advsearch => 'r' })->validate(filter_release_adv filter_parse r => $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 = \'r\' AND name = \'\' AND uid =', \auth->uid);
+        $opt->{f} = tuwf->compile({ advsearch => 'r' })->validate($def)->data if $def;
+    }
+
+    my @search = map {
+        my $l = '%'.sql_like($_).'%';
+        /^\d+$/ && gtintype($_) ? sql 'r.gtin =', \"$_" :
+                  length $_ > 0 ? sql '(r.title ILIKE', \$l, 'OR r.original ILIKE', \$l, 'OR r.catalog =', \"$_", ')' : ();
+    } split /[ -,._]/, $opt->{q}||'';
+    my $where = sql_and 'NOT r.hidden', $opt->{f}->sql_where(), @search;
+
+    my $time = time;
+    my($count, $list);
+    db_maytimeout {
+        $count = tuwf->dbVali('SELECT count(*) FROM releases r WHERE', $where);
+        $list = $count ? tuwf->dbPagei({results => 50, page => $opt->{p}}, '
+            SELECT r.id, r.type, r.patch, r.released, r.gtin, ', sql_extlinks(r => 'r.'), '
+              FROM releases r
+             WHERE', $where, '
+             ORDER BY', sprintf {
+                 title    => 'r.title %s, r.released %1$s',
+                 minage   => 'r.minage %s, r.title %1$s, r.released %1$s',
+                 released => 'r.released %s, r.id %1$s',
+             }->{$opt->{s}}, $opt->{o} eq 'a' ? 'ASC' : 'DESC'
+        ) : [];
+    } || (($count, $list) = (undef, []));
+
+    enrich_extlinks r => $list;
+    enrich_release $list;
+    $time = time - $time;
+
+    framework_ title => 'Browse releases', sub {
+        div_ class => 'mainbox', sub {
+            h1_ 'Browse releases';
+            div_ class => 'warning', sub {
+                h2_ 'EXPERIMENTAL';
+                p_ "This is Yorhel's playground. Lots of functionality is missing, lots of stuff is or will be broken. Here be dragons. Etc.";
+            };
+            br_;
+            form_ action => '/experimental/r', method => 'get', sub {
+                searchbox_ r => $opt->{q}//'';
+                input_ type => 'hidden', name => 'o', value => $opt->{o};
+                input_ type => 'hidden', name => 's', value => $opt->{s};
+                $opt->{f}->elm_;
+                advsearch_msg_ $count, $time;
+            };
+        };
+        listing_ $opt, $list, $count if $count;
+    };
+};
+
+1;