=head1 SQL Schema

  CREATE TABLE $p (
    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 RENAME TO $p;
  DROP TABLE ${p}issues;

  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 {
    table => 'issues',
    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 = (
    'NOT EXISTS(SELECT 1 FROM !s im WHERE im.id > m.id AND im.issue = m.issue)' => $self->{table},
    $o{id} ? ('issue = ?' => $o{id}) : (),
    $o{closed} != 2 ? ('!s closed' => !$o{closed} ? 'NOT' : '') : (),
  );

  my $order = sprintf {
    date => 'id %s',
  }->{$o{sort}||'date'}, $o{reverse} ? 'DESC' : 'ASC';

  my($r, $np) = $TUWF::OBJ->dbPage(\%o, q{
    SELECT issue, summary, to_char(date, 'YYYY-MM-DD') AS date, type, status, closed
      FROM !s m
        !W
     ORDER BY !s}, $self->{table}, \%where, $order
  );
  return wantarray ? ($r, $np) : $r;
}


sub dbItem {
  my($self, $id) = @_;
  return $TUWF::OBJ->dbAll(q{
    SELECT issue, summary, to_char(date, 'YYYY-MM-DD HH24:MI:SS (tz)') AS date, type, status, closed, name, admin, message
      FROM !s
     WHERE issue = ?
     ORDER BY id}, $self->{table}, $id
  );
}


sub dbEmails {
  my($self, $id) = @_;
  return [ map $_->{email}, @{$TUWF::OBJ->dbAll(q|SELECT DISTINCT email FROM !s WHERE issue = ? AND email <> ''|, $self->{table}, $id)} ];
}


sub dbSave {
  my($self, $id, $closed, @a) = @_;

  # TODO: Issue ID allocation may currently cause two bug reports created at
  # the same time to get the same id. It'd be better to use a PostgreSQL
  # sequence...
  my $issue = $id ? '?' : '(SELECT COALESCE(MAX(issue)+1, 1) FROM !s)';

  return $TUWF::OBJ->dbRow(
    "INSERT INTO !s (issue, closed, summary, name, email, type, status, message, admin) VALUES ($issue, ?, !l) RETURNING issue",
    $self->{table}, $id || $self->{table}, $closed?1:0, \@a
  )->{issue}
}


# 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]{closed}) {
        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 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\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;