294 lines
8.6 KiB
Perl
294 lines
8.6 KiB
Perl
|
|
=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::Issue;
|
|
|
|
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 => 'issue_listing';
|
|
thead; Tr;
|
|
td class => 'issue_col_id', 'Id';
|
|
td class => 'issue_col_type', 'Type';
|
|
td class => 'issue_col_status', 'Status';
|
|
td class => 'issue_col_date', 'Updated';
|
|
td class => 'issue_col_summary','Summary';
|
|
end; end;
|
|
for(@$l) {
|
|
Tr $_->{closed} ? (class => 'issue_closed') : ();
|
|
td class => 'issue_col_id', $_->{issue};
|
|
td class => 'issue_col_type', $_->{type};
|
|
td class => 'issue_col_status', $_->{status};
|
|
td class => 'issue_col_date', $_->{date};
|
|
td class => 'issue_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 => 'issue_status';
|
|
dt 'Id'; dd $last->{issue};
|
|
dt 'Messages'; dd $#$d+1;
|
|
dt 'Type'; dd $last->{type};
|
|
dt 'Status'; dd $last->{status};
|
|
end;
|
|
div class => 'issue_item';
|
|
my $num = -1;
|
|
for my $m (@$d) {
|
|
div class => 'issue_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 => 'issue_frm', action => $url, method => 'post';
|
|
fieldset;
|
|
input type => 'hidden', name => 'issue_id', value => $l ? $l->{issue} : 0;
|
|
legend $l ? 'Reply' : 'Report a new issue';
|
|
ul;
|
|
li class => 'issue_frm_summary';
|
|
label for => 'issue_summary', 'Summary';
|
|
input type => 'text', name => 'issue_summary', id => 'issue_summary', size => 45, value => $l?$l->{summary}:'';
|
|
end;
|
|
li class => 'issue_frm_mail';
|
|
label for => 'issue_email', 'Email';
|
|
input type => 'text', name => 'issue_email', id => 'issue_email', size => 20;
|
|
lit ' ';
|
|
txt 'Optional, only used for notifications.';
|
|
end;
|
|
if($l) {
|
|
li class => 'issue_frm_admin';
|
|
label for => 'issue_type', 'Admin';
|
|
Select name => 'issue_type';
|
|
option value => $_, $_ eq $l->{type} ? (selected => 'selected') : (), $_ for @{$s->{types}};
|
|
end;
|
|
Select name => 'issue_status';
|
|
option value => $_, $_ eq $l->{status} ? (selected => 'selected') : (), $_ for @{$s->{statusses}};
|
|
end;
|
|
Select name => 'issue_closed';
|
|
option value => 0, !$l->{closed} ? (selected => 'selected') : (), 'Open';
|
|
option value => 1, $l->{closed} ? (selected => 'selected') : (), 'Closed';
|
|
end;
|
|
input type => 'password', name => 'issue_code', id => 'issue_code', size => 10, value => 'code';
|
|
end;
|
|
} else {
|
|
li class => 'issue_frm_type';
|
|
label for => 'issue_type', 'Type';
|
|
Select name => 'issue_type';
|
|
option value => $_, $_ eq $s->{default_type} ? (selected => 'selected') : (), $_ for @{$s->{types}};
|
|
end;
|
|
end;
|
|
}
|
|
li class => 'issue_frm_message';
|
|
textarea name => 'issue_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 => 'issue_frm_submit';
|
|
input type => 'submit', value => 'Submit';
|
|
end;
|
|
end 'ul';
|
|
end;
|
|
end 'form';
|
|
}
|
|
|
|
|
|
sub handleForm {
|
|
my($s, $url) = @_;
|
|
my $f = $TUWF::OBJ->formValidate(
|
|
{ post => 'issue_id', min => 0 },
|
|
{ post => 'issue_summary', maxlength => 200, minlength => 2 },
|
|
{ post => 'issue_email', required => 0, regex => qr/^[^@<>]+@[^@.<>]+(?:\.[^@.<>]+)+$/ },
|
|
{ post => 'issue_code', required => 0, default => '' },
|
|
{ post => 'issue_message', maxlength => 256*1024, minlength => 1 },
|
|
);
|
|
return($f, undef) if $f->{_err};
|
|
|
|
my $l;
|
|
# Reply
|
|
if($f->{issue_id} > 0) {
|
|
$l = $s->dbListing(id => $f->{issue_id})->[0];
|
|
push @{$f->{_err}}, ['issue_id', 'db_check', ''] and return($f, undef) if !$l;
|
|
|
|
# Check admin things
|
|
if(grep $_ eq $f->{issue_code}, @{$s->{admins}}) {
|
|
my $fa = $TUWF::OBJ->formValidate(
|
|
{ post => 'issue_type', enum => $s->{types} },
|
|
{ post => 'issue_status', enum => $s->{statusses} },
|
|
{ post => 'issue_closed', enum => [0,1] },
|
|
);
|
|
$f = { %$f, %$fa };
|
|
return($f, $l) if $f->{_err};
|
|
} else {
|
|
$f->{issue_type} = $l->{type};
|
|
$f->{issue_status} = $l->{status};
|
|
$f->{issue_closed} = $l->{closed};
|
|
}
|
|
|
|
# New issue
|
|
} else {
|
|
$f->{issue_status} = $s->{default_status};
|
|
$f->{issue_closed} = 0;
|
|
my $fa = $TUWF::OBJ->formValidate({ post => 'issue_type', enum => $s->{types} });
|
|
$f = { %$f, %$fa };
|
|
return($f, $l) if $f->{_err};
|
|
}
|
|
|
|
# No errors? Save!
|
|
my $id = $s->dbSave(map $f->{"issue_$_"}, 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->{issue_email}, @$mails) {
|
|
$TUWF::OBJ->mail(
|
|
"Hello!\n\n".
|
|
"A new reply has been posted to an issue 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) issues, please reply to this email stating your intent.",
|
|
Subject => "Reply to $f->{issue_summary}",
|
|
To => "$_",
|
|
);
|
|
}
|
|
}
|
|
|
|
$l = $s->dbListing(id => $id)->[0] if !$l;
|
|
|
|
return($f, $l);
|
|
}
|
|
|
|
|
|
1;
|