s/issue/bug/g + updated ncdc-share-report
This commit is contained in:
Yorhel
parent
05c36a1aef
commit
d6865e7b42
5 changed files with 121 additions and 119 deletions
294
Bug.pm
Normal file
294
Bug.pm
Normal file
|
|
@ -0,0 +1,294 @@
|
|||
|
||||
=head1 SQL Schema
|
||||
|
||||
CREATE TABLE ${p}issues (
|
||||
issue SERIAL PRIMARY KEY,
|
||||
latest integer NOT NULL
|
||||
);
|
||||
|
||||
CREATE TABLE ${p}messages (
|
||||
id SERIAL PRIMARY KEY,
|
||||
issue integer NOT NULL,
|
||||
date timestamptz NOT NULL DEFAULT NOW(),
|
||||
summary varchar(200) NOT NULL,
|
||||
type varchar NOT NULL DEFAULT '',
|
||||
status varchar NOT NULL DEFAULT '',
|
||||
closed boolean NOT NULL DEFAULT false,
|
||||
email varchar NOT NULL DEFAULT '',
|
||||
message varchar NOT NULL DEFAULT ''
|
||||
);
|
||||
|
||||
=cut
|
||||
|
||||
# TODO: Atom feed?
|
||||
|
||||
package TUWF::Bug;
|
||||
|
||||
use TUWF ':html', 'html_escape';
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
return bless {
|
||||
prefix => 'issue_',
|
||||
types => [qw|bug feature docs other|],
|
||||
default_type => 'other',
|
||||
statusses => [qw|new accepted duplicate confirmed fixed wontfix worksforme|],
|
||||
default_status => 'new',
|
||||
admins => ['code1', 'code2'],
|
||||
@_
|
||||
}, $class;
|
||||
}
|
||||
|
||||
|
||||
sub dbListing {
|
||||
my $self = shift;
|
||||
my %o = (
|
||||
results => 100,
|
||||
page => 1,
|
||||
@_
|
||||
);
|
||||
$o{reverse} = 1 if !$o{sort};
|
||||
|
||||
my %where = (
|
||||
$o{id} ? ('i.issue = ?' => $o{id}) : (),
|
||||
);
|
||||
|
||||
my $order = sprintf {
|
||||
date => 'm.id %s',
|
||||
}->{$o{sort}||'date'}, $o{reverse} ? 'DESC' : 'ASC';
|
||||
|
||||
my($r, $np) = $TUWF::OBJ->dbPage(\%o, q{
|
||||
SELECT i.issue, m.summary, to_char(m.date, 'YYYY-MM-DD') AS date, m.type, m.status, m.closed
|
||||
FROM !sissues i
|
||||
JOIN !smessages m ON m.id = i.latest
|
||||
!W
|
||||
ORDER BY !s}, $self->{prefix}, $self->{prefix}, \%where, $order
|
||||
);
|
||||
return wantarray ? ($r, $np) : $r;
|
||||
}
|
||||
|
||||
|
||||
sub dbItem {
|
||||
my($self, $id) = @_;
|
||||
return $TUWF::OBJ->dbAll(q{
|
||||
SELECT m.issue, m.summary, to_char(m.date, 'YYYY-MM-DD HH24:MI:SS (tz)') AS date, m.type, m.status, m.closed, m.message
|
||||
FROM !smessages m
|
||||
WHERE m.issue = ?
|
||||
ORDER BY m.id}, $self->{prefix}, $id
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
sub dbEmails {
|
||||
my($self, $id) = @_;
|
||||
return [ map $_->{email}, @{$TUWF::OBJ->dbAll(q|SELECT DISTINCT m.email FROM !smessages m WHERE m.issue = ? AND m.email <> ''|, $self->{prefix}, $id)} ];
|
||||
}
|
||||
|
||||
|
||||
sub dbSave {
|
||||
my($self, $id, $closed, @a) = @_;
|
||||
$id = $TUWF::OBJ->dbRow('INSERT INTO !sissues (latest) VALUES (0) RETURNING issue', $self->{prefix})->{issue} if !$id;
|
||||
my $latest = $TUWF::OBJ->dbRow(
|
||||
'INSERT INTO !smessages (issue, closed, summary, email, type, status, message) VALUES (?, ?, !l) RETURNING id',
|
||||
$self->{prefix}, $id, $closed?1:0, \@a
|
||||
)->{id};
|
||||
$TUWF::OBJ->dbExec('UPDATE !sissues SET latest = ? WHERE issue = ?', $self->{prefix}, $latest, $id);
|
||||
return $id;
|
||||
}
|
||||
|
||||
|
||||
# TODO: pagination / filtering
|
||||
sub htmlListing {
|
||||
my($s, $l, $lnk) = @_;
|
||||
table class => 'bug_listing';
|
||||
thead; Tr;
|
||||
td class => 'bug_col_id', 'Id';
|
||||
td class => 'bug_col_type', 'Type';
|
||||
td class => 'bug_col_status', 'Status';
|
||||
td class => 'bug_col_date', 'Updated';
|
||||
td class => 'bug_col_summary','Summary';
|
||||
end; end;
|
||||
for(@$l) {
|
||||
Tr $_->{closed} ? (class => 'bug_closed') : ();
|
||||
td class => 'bug_col_id', $_->{issue};
|
||||
td class => 'bug_col_type', $_->{type};
|
||||
td class => 'bug_col_status', $_->{status};
|
||||
td class => 'bug_col_date', $_->{date};
|
||||
td class => 'bug_col_summary';
|
||||
a href => $lnk->($_->{issue}), $_->{summary};
|
||||
end;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
}
|
||||
|
||||
|
||||
sub _escape_url {
|
||||
my $str = shift;
|
||||
my $r = '';
|
||||
my $last = 0;
|
||||
while($str =~ m{((?:https?|ftp)://[^ ><"\n\s]+[\d\w=/-])}g) {
|
||||
$r .= sprintf '%s<a href="%s">%2$s</a>', html_escape(substr $str, $last, (pos($str)-length($1))-$last), html_escape($1);
|
||||
$last = pos $str;
|
||||
}
|
||||
return $r.html_escape(substr $str, $last);
|
||||
}
|
||||
|
||||
|
||||
sub htmlItem {
|
||||
my($s, $d) = @_;
|
||||
my $last = $d->[$#$d];
|
||||
dl class => 'bug_status';
|
||||
dt 'Id'; dd $last->{issue};
|
||||
dt 'Messages'; dd $#$d+1;
|
||||
dt 'Type'; dd $last->{type};
|
||||
dt 'Status'; dd $last->{status};
|
||||
end;
|
||||
div class => 'bug_item';
|
||||
my $num = -1;
|
||||
for my $m (@$d) {
|
||||
div class => 'bug_message';
|
||||
h1 !++$num ? 'Description' : "Reply $num";
|
||||
dl;
|
||||
dt !$num ? 'Created' : 'Added'; dd $m->{date};
|
||||
for($num ? qw|summary type status| : ()) {
|
||||
if($m->{$_} ne $d->[$num-1]{$_}) {
|
||||
dt "\u$_";
|
||||
dd sprintf '"%s" to "%s"', $d->[$num-1]{$_}, $m->{$_};
|
||||
}
|
||||
}
|
||||
if($num && !$m->{closed} != !$d->[$num-1]{$_}) {
|
||||
dt "Closed";
|
||||
dd sprintf '"%s" to "%s"', $d->[$num-1]{closed}?'yes':'no', $m->{closed}?'yes':'no';
|
||||
}
|
||||
end;
|
||||
p; lit _escape_url $m->{message}; end;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
}
|
||||
|
||||
|
||||
sub htmlForm {
|
||||
my($s, $l, $url) = @_;
|
||||
# TODO: anti-spam JS
|
||||
form class => 'bug_frm', action => $url, method => 'post';
|
||||
fieldset;
|
||||
input type => 'hidden', name => 'bug_id', value => $l ? $l->{issue} : 0;
|
||||
legend $l ? 'Reply' : 'Report a new bug';
|
||||
ul;
|
||||
li class => 'bug_frm_summary';
|
||||
label for => 'bug_summary', 'Summary';
|
||||
input type => 'text', name => 'bug_summary', id => 'bug_summary', size => 45, value => $l?$l->{summary}:'';
|
||||
end;
|
||||
li class => 'bug_frm_mail';
|
||||
label for => 'bug_email', 'Email';
|
||||
input type => 'text', name => 'bug_email', id => 'bug_email', size => 20;
|
||||
lit ' ';
|
||||
txt 'Optional, only used for notifications.';
|
||||
end;
|
||||
if($l) {
|
||||
li class => 'bug_frm_admin';
|
||||
label for => 'bug_type', 'Admin';
|
||||
Select name => 'bug_type';
|
||||
option value => $_, $_ eq $l->{type} ? (selected => 'selected') : (), $_ for @{$s->{types}};
|
||||
end;
|
||||
Select name => 'bug_status';
|
||||
option value => $_, $_ eq $l->{status} ? (selected => 'selected') : (), $_ for @{$s->{statusses}};
|
||||
end;
|
||||
Select name => 'bug_closed';
|
||||
option value => 0, !$l->{closed} ? (selected => 'selected') : (), 'Open';
|
||||
option value => 1, $l->{closed} ? (selected => 'selected') : (), 'Closed';
|
||||
end;
|
||||
input type => 'password', name => 'bug_code', id => 'bug_code', size => 10, value => 'code';
|
||||
end;
|
||||
} else {
|
||||
li class => 'bug_frm_type';
|
||||
label for => 'bug_type', 'Type';
|
||||
Select name => 'bug_type';
|
||||
option value => $_, $_ eq $s->{default_type} ? (selected => 'selected') : (), $_ for @{$s->{types}};
|
||||
end;
|
||||
end;
|
||||
}
|
||||
li class => 'bug_frm_message';
|
||||
textarea name => 'bug_message';end; br;
|
||||
lit 'Please use a <a href="http://p.blicky.net/">pastebin</a> if you want to include large chunks of code or program output.';
|
||||
end;
|
||||
li class => 'bug_frm_submit';
|
||||
input type => 'submit', value => 'Submit';
|
||||
end;
|
||||
end 'ul';
|
||||
end;
|
||||
end 'form';
|
||||
}
|
||||
|
||||
|
||||
sub handleForm {
|
||||
my($s, $url) = @_;
|
||||
my $f = $TUWF::OBJ->formValidate(
|
||||
{ post => 'bug_id', min => 0 },
|
||||
{ post => 'bug_summary', maxlength => 200, minlength => 2 },
|
||||
{ post => 'bug_email', required => 0, regex => qr/^[^@<>]+@[^@.<>]+(?:\.[^@.<>]+)+$/ },
|
||||
{ post => 'bug_code', required => 0, default => '' },
|
||||
{ post => 'bug_message', maxlength => 256*1024, minlength => 1 },
|
||||
);
|
||||
return($f, undef) if $f->{_err};
|
||||
|
||||
my $l;
|
||||
# Reply
|
||||
if($f->{bug_id} > 0) {
|
||||
$l = $s->dbListing(id => $f->{bug_id})->[0];
|
||||
push @{$f->{_err}}, ['bug_id', 'db_check', ''] and return($f, undef) if !$l;
|
||||
|
||||
# Check admin things
|
||||
if(grep $_ eq $f->{bug_code}, @{$s->{admins}}) {
|
||||
my $fa = $TUWF::OBJ->formValidate(
|
||||
{ post => 'bug_type', enum => $s->{types} },
|
||||
{ post => 'bug_status', enum => $s->{statusses} },
|
||||
{ post => 'bug_closed', enum => [0,1] },
|
||||
);
|
||||
$f = { %$f, %$fa };
|
||||
return($f, $l) if $f->{_err};
|
||||
} else {
|
||||
$f->{bug_type} = $l->{type};
|
||||
$f->{bug_status} = $l->{status};
|
||||
$f->{bug_closed} = $l->{closed};
|
||||
}
|
||||
|
||||
# New bug
|
||||
} else {
|
||||
$f->{bug_status} = $s->{default_status};
|
||||
$f->{bug_closed} = 0;
|
||||
my $fa = $TUWF::OBJ->formValidate({ post => 'bug_type', enum => $s->{types} });
|
||||
$f = { %$f, %$fa };
|
||||
return($f, $l) if $f->{_err};
|
||||
}
|
||||
|
||||
# No errors? Save!
|
||||
my $id = $s->dbSave(map $f->{"bug_$_"}, qw|id closed summary email type status message|);
|
||||
|
||||
# For replies, send out notification emails
|
||||
if($l) {
|
||||
my $mails = $s->dbEmails($id);
|
||||
my $u = $url->($id);
|
||||
for(grep $_ ne $f->{bug_email}, @$mails) {
|
||||
$TUWF::OBJ->mail(
|
||||
"Hello!\n\n".
|
||||
"A new reply has been posted to an bug you have previously shown\n".
|
||||
"an interest in. You can view the reply at the following URL:\n".
|
||||
" $u\n\n".
|
||||
"If you do not wish to receive any more notifications for this (and\n".
|
||||
"perhaps other) bugs, please reply to this email stating your intent.",
|
||||
Subject => "Reply to $f->{bug_summary}",
|
||||
To => "$_",
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
$l = $s->dbListing(id => $id)->[0] if !$l;
|
||||
|
||||
return($f, $l);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue