=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 '',
    admin    boolean NOT NULL DEFAULT false,
    name     varchar(200) NOT NULL DEFAULT ''
  );

=head2 Update queries

  ALTER TABLE ${p}messages ADD COLUMN admin boolean NOT NULL DEFAULT false;
  ALTER TABLE ${p}messages ADD COLUMN name varchar(200) 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,
    closed => 2,
    @_
  );
  $o{reverse} = 1 if !$o{sort};

  my %where = (
    $o{id} ? ('i.issue = ?' => $o{id}) : (),
    $o{closed} != 2 ? ('!s m.closed' => !$o{closed} ? 'NOT' : '') : (),
  );

  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.name, m.admin, 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, name, email, type, status, message, admin) 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;
       txt "$m->{date} by ";
       txt $m->{name}||'Anonymous' if !$m->{admin};
       b $m->{name}||'Admin' if $m->{admin};
      end;
      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_name';
      label for => 'bug_name', 'Name';
      input type => 'text', name => 'bug_name', id => 'bug_name', size => 20, value => $TUWF::OBJ->reqCookie('bug_name')||'';
      lit '&nbsp;';
      txt 'Name+email will be remembered with a cookie.';
     end;
     li class => 'bug_frm_mail';
      label for => 'bug_email', 'Email';
      input type => 'text', name => 'bug_email', id => 'bug_email', size => 20, value => $TUWF::OBJ->reqCookie('bug_email')||'';
      lit '&nbsp;';
      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 => $TUWF::OBJ->reqCookie('bug_code')||'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_name',    required => 0, default => '', maxlength => 200 },
    { 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};

  $f->{bug_code} = '' if $f->{bug_code} eq 'code';
  my $admin = grep($_ eq $f->{bug_code}, @{$s->{admins}}) ? 1 : 0;

  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($admin) {
      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 {
      push @{$f->{_err}}, [ 'bug_code', 'invalid', '' ] and return($f, undef) if $f->{bug_code};
      $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 name email type status message|), $admin);

  my $u = $url->($id);

  # For replies, send out notification emails
  if($l) {
    my $mails = $s->dbEmails($id);
    my $base = $TUWF::OBJ->reqBaseURI();
    for(grep $_ ne $f->{bug_email}, @$mails) {
      $TUWF::OBJ->mail(
        "Hello!\n\n".
        "A new reply has been posted to a bug you have previously shown\n".
        "an interest in. You can find the reply at the following URL:\n".
        "  $base$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;
  $TUWF::OBJ->resRedirect($u, 'post');
  $f->{$_} and $TUWF::OBJ->resCookie($_ => $f->{$_}, expires => time()+365*24*3600) for ('bug_name', 'bug_email', 'bug_code');

  return($f, $l);
}


1;