Reports: Allow reporting DB entries

8 files changed, 61 insertions, 36 deletions

diff --git a/lib/VNWeb/Discussions/Board.pm b/lib/VNWeb/Discussions/Board.pm
index edce6789..6262deaf 100644
--- a/lib/VNWeb/Discussions/Board.pm
+++ b/lib/VNWeb/Discussions/Board.pm
@@ -9,13 +9,10 @@ TUWF::get qr{/t/(all|$BOARD_RE)}, sub {
 
     my $page = tuwf->validate(get => p => { upage => 1 })->data;
 
-    my $obj =   !$id ? undef :
-        $type eq 'v' ? tuwf->dbRowi('SELECT id, title, original, hidden AS entry_hidden, locked AS entry_locked FROM vn        WHERE id =', \$id) :
-        $type eq 'p' ? tuwf->dbRowi('SELECT id, name,  original, hidden AS entry_hidden, locked AS entry_locked FROM producers WHERE id =', \$id) :
-        $type eq 'u' ? tuwf->dbRowi('SELECT id,', sql_user(), 'FROM users u WHERE id =', \$id) : undef;
+    my $obj = $id ? dbobj $type, $id : undef;
     return tuwf->resNotFound if $id && !$obj->{id};
 
-    my $ititle = $obj && ($obj->{title} || $obj->{name} || user_displayname $obj);
+    my $ititle = $obj && ($obj->{title} || user_displayname $obj);
     my $title = $obj ? "Related discussions for $ititle" : $type eq 'all' ? 'All boards' : $BOARD_TYPE{$type}{txt};
     my $createurl = '/t/'.($id ? $type.$id : $type eq 'db' ? 'db' : 'ge').'/new';
 
diff --git a/lib/VNWeb/Docs/Page.pm b/lib/VNWeb/Docs/Page.pm
index 6bf6ebfe..eeda0d00 100644
--- a/lib/VNWeb/Docs/Page.pm
+++ b/lib/VNWeb/Docs/Page.pm
@@ -46,6 +46,7 @@ TUWF::get qr{/$RE{drev}} => sub {
     sub {
         _rev_ $d if tuwf->capture('rev');
         div_ class => 'mainbox', sub {
+            itemmsg_ d => $d;
             h1_ $d->{title};
             div_ class => 'docs', sub {
                 _index_;
diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm
index 46905887..91c13526 100644
--- a/lib/VNWeb/HTML.pm
+++ b/lib/VNWeb/HTML.pm
@@ -752,14 +752,19 @@ sub searchbox_ {
 }
 
 
-# Generate a message to display on an entry page when the entry has been locked or the user can't edit it.
+# Generate a message to display on an entry page to report the entry and to indicate it has been locked or the user can't edit it.
 sub itemmsg_ {
     my($type, $obj) = @_;
-    if($obj->{entry_locked}) {
-        p_ class => 'locked', 'Locked for editing';
-    } elsif(auth && !can_edit $type => $obj) {
-        p_ class => 'locked', 'You can not edit this page';
-    }
+    p_ class => 'itemmsg', sub {
+        if($type ne 'd') {
+            if($obj->{entry_locked}) {
+                txt_ 'Locked for editing. ';
+            } elsif(auth && !can_edit $type => $obj) {
+                txt_ 'You can not edit this page. ';
+            }
+        }
+        a_ href => "/report/db/$type$obj->{id}", 'Report an issue on this page.';
+    };
 }
 
 
diff --git a/lib/VNWeb/Misc/History.pm b/lib/VNWeb/Misc/History.pm
index 26ef5f48..7ce5584f 100644
--- a/lib/VNWeb/Misc/History.pm
+++ b/lib/VNWeb/Misc/History.pm
@@ -170,19 +170,7 @@ sub filters_ {
 TUWF::get qr{/(?:([upvrcsd])([1-9]\d*)/)?hist} => sub {
     my($type, $id) = (tuwf->capture(1)||'', tuwf->capture(2));
 
-    my sub dbitem {
-        my($table, $title) = @_;
-        tuwf->dbRowi('SELECT id,', $title, ' AS title, hidden AS entry_hidden, locked AS entry_locked FROM', $table, 'WHERE id =', \$id);
-    };
-
-    my $obj = !$type ? undef :
-        $type eq 'u' ? tuwf->dbRowi('SELECT id, ', sql_user(), 'FROM users u WHERE id =', \$id) :
-        $type eq 'p' ? dbitem producers => 'name' :
-        $type eq 'v' ? dbitem vn        => 'title' :
-        $type eq 'r' ? dbitem releases  => 'title' :
-        $type eq 'c' ? dbitem chars     => 'name' :
-        $type eq 's' ? dbitem staff     => '(SELECT name FROM staff_alias WHERE aid = staff.aid)' :
-        $type eq 'd' ? dbitem docs      => 'title' : die;
+    my $obj = dbobj $type, $id;
 
     return tuwf->resNotFound if $type && !$obj->{id};
     $obj->{title} = user_displayname $obj if $type eq 'u';
diff --git a/lib/VNWeb/Misc/Reports.pm b/lib/VNWeb/Misc/Reports.pm
index d229d434..fa1cbb44 100644
--- a/lib/VNWeb/Misc/Reports.pm
+++ b/lib/VNWeb/Misc/Reports.pm
@@ -16,16 +16,23 @@ sub enrich_object {
                   FROM threads t JOIN threads_posts tp ON tp.tid = t.id LEFT JOIN users u ON u.id = tp.uid
                  WHERE NOT t.hidden AND NOT t.private AND t.id =', \"$+{id}", 'AND tp.num =', \"$+{num}"
             );
-            if($post->{num}) {
-                $o->{title} = xml_string sub {
-                    txt_ 'Post ';
-                    a_ href => "/$o->{object}", "#$post->{num}";
-                    txt_ ' on ';
-                    a_ href => "/$o->{object}", $post->{title};
-                    txt_ ' by ';
-                    user_ $post;
-                };
-            }
+            $o->{title} = xml_string sub {
+                txt_ 'Post ';
+                a_ href => "/$o->{object}", "#$post->{num}";
+                txt_ ' on ';
+                a_ href => "/$o->{object}", $post->{title};
+                txt_ ' by ';
+                user_ $post;
+            } if $post->{num};
+
+        } elsif($o->{rtype} eq 'db' && $o->{object} =~ /^([vrpcsd])$RE{num}$/) {
+            my($t,$id) = ($1, $+{num});
+            my $obj = dbobj $t, $id;
+            $o->{title} = xml_string sub {
+                txt_ {qw/v VN r Release p Producer c Character s Staff d Doc/}->{$t};
+                txt_ ': ';
+                a_ href => "/$t$id", $obj->{title};
+            } if $obj->{id};
         }
     }
 }
@@ -63,7 +70,7 @@ elm_api Report => undef, $FORM, sub {
 };
 
 
-TUWF::get qr{/report/(?<rtype>t)/(?<object>.+)}, sub {
+TUWF::get qr{/report/(?<rtype>t|db)/(?<object>.+)}, sub {
     my $obj = { rtype => tuwf->capture('rtype'), object => tuwf->capture('object') };
     enrich_object $obj;
     return tuwf->resNotFound if !$obj->{title};
diff --git a/lib/VNWeb/Prelude.pm b/lib/VNWeb/Prelude.pm
index c79cc09b..50906792 100644
--- a/lib/VNWeb/Prelude.pm
+++ b/lib/VNWeb/Prelude.pm
@@ -72,6 +72,7 @@ sub import {
     *{$c.'::RE'} = *RE;
     *{$c.'::in'} = \&in;
     *{$c.'::idcmp'} = \&idcmp;
+    *{$c.'::dbobj'} = \&dbobj;
 }
 
 
@@ -122,4 +123,26 @@ sub idcmp($$) {
     $a1 cmp $b1 || $a2 <=> $b2
 }
 
+
+# Returns very generic information on a DB entry object.
+# Only { id, title, entry_hidden, entry_locked } for now.
+# Suitable for passing to HTML::framework_'s dbobj argument.
+sub dbobj {
+    my($type, $id) = @_;
+
+    my sub item {
+        my($table, $title) = @_;
+        tuwf->dbRowi('SELECT id,', $title, ' AS title, hidden AS entry_hidden, locked AS entry_locked FROM', $table, 'WHERE id =', \$id);
+    };
+
+    !$type ? undef :
+        $type eq 'u' ? tuwf->dbRowi('SELECT id, ', sql_user(), 'FROM users u WHERE id =', \$id) :
+        $type eq 'p' ? item producers => 'name' :
+        $type eq 'v' ? item vn        => 'title' :
+        $type eq 'r' ? item releases  => 'title' :
+        $type eq 'c' ? item chars     => 'name' :
+        $type eq 's' ? item staff     => '(SELECT name FROM staff_alias WHERE aid = staff.aid)' :
+        $type eq 'd' ? item docs      => 'title' : die;
+}
+
 1;
diff --git a/lib/VNWeb/Producers/Page.pm b/lib/VNWeb/Producers/Page.pm
index 65196e76..802218d6 100644
--- a/lib/VNWeb/Producers/Page.pm
+++ b/lib/VNWeb/Producers/Page.pm
@@ -159,7 +159,10 @@ TUWF::get qr{/$RE{prev}(?:/(?<tab>vn|rel))?}, sub {
     },
     sub {
         rev_ $p if tuwf->capture('rev');
-        div_ class => 'mainbox', sub { info_ $p };
+        div_ class => 'mainbox', sub {
+            itemmsg_ p => $p;
+            info_ $p;
+        };
         div_ class => 'maintabs right', sub {
             ul_ sub {
                 li_ mkclass(tabselected => $tab eq 'vn'),  sub { a_ href => "/p$p->{id}/vn",  'Visual Novels' };
diff --git a/lib/VNWeb/VN/Page.pm b/lib/VNWeb/VN/Page.pm
index 72ccbf6c..4ff6dbdd 100644
--- a/lib/VNWeb/VN/Page.pm
+++ b/lib/VNWeb/VN/Page.pm
@@ -322,6 +322,7 @@ sub infobox_useroptions_ {
 sub infobox_ {
     my($v) = @_;
     div_ class => 'mainbox', sub {
+        itemmsg_ v => $v;
         h1_ $v->{title};
         h2_ class => 'alttitle', lang_attr($v->{c_olang}), $v->{original} if $v->{original};