=head1 SQL Schema

  CREATE TABLE $p (
    id      integer PRIMARY KEY AUTOINCREMENT NOT NULL,
    issue   integer NOT NULL,
    date    integer NOT NULL,
    name    text DEFAULT '' NOT NULL,
    email   text DEFAULT '' NOT NULL,
    admin   integer DEFAULT 0 NOT NULL,
    closed  integer DEFAULT 0 NOT NULL,
    type    text DEFAULT '' NOT NULL,
    status  text DEFAULT '' NOT NULL,
    summary text NOT NULL,
    message text DEFAULT '' NOT NULL
  );

=cut

package TUWF::Bug;

use TUWF ':xml', ':html', 'html_escape';
use POSIX 'strftime';

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 ? ('closed = ?' => $o{closed}?1:0) : (),
  );

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

  my($r, $np) = $TUWF::OBJ->dbPage(\%o, q{
    SELECT issue, summary, 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, date, type, status, closed, name, admin, message
      FROM !s
     WHERE issue = ?
     ORDER BY id}, $self->{table}, $id
  );
}


sub dbRecent {
  my $self = shift;
  return $TUWF::OBJ->dbAll(q{
    SELECT issue, summary, date, name
      FROM !s
     ORDER BY id DESC LIMIT 10}, $self->{table}
  );
}


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.
  my $issue = $id ? '?' : '(SELECT COALESCE(MAX(issue)+1, 1) FROM !s)';

  $TUWF::OBJ->dbExec(
    "INSERT INTO !s (issue, date, closed, summary, name, email, type, status, message, admin) VALUES ($issue, ?, ?, !l)",
    $self->{table}, $id || $self->{table}, time(), $closed?1:0, \@a);
  return $TUWF::OBJ->dbRow('SELECT MAX(issue) AS issue FROM !s', $self->{table})->{issue};
}


# TODO: pagination / filtering
sub htmlListing {
  my($s, $l, $lnk) = @_;
  if(!@$l) {
    p class => 'bug_nolisting', 'No bugs found! Yay?';
    return;
  }
  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',   strftime '%Y-%m-%d', gmtime $_->{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 strftime '%Y-%m-%d %T GMT', gmtime $m->{date};
       txt ' 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',      template => 'uint' },
    { post => 'bug_summary', maxlength => 200, minlength => 2 },
    { post => 'bug_name',    required => 0, default => '', maxlength => 200 },
    { post => 'bug_email',   required => 0, template => 'email' },
    { post => 'bug_code',    required => 0, default => '' },
    { post => 'bug_message', maxlength => 256*1024, minlength => 1 },
  );
  return($f, undef) if $f->{_err};
  return({ _err => [['bug_summary']], %$f}, undef) if $f->{bug_summary} =~ qr{http://}; # SPAM
  return({ _err => [['bug_summary']], %$f}, undef) if $f->{bug_message} =~ qr{(?:<a href=|\[url=|\[link=)}i; # SPAM

  $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);
}


sub atomFeed {
  my($s, $lnk) = @_;

  my $r = $s->dbRecent();
  my $t = $r->[0]{date}||1463296545;

  $TUWF::OBJ->resHeader('Last-Modified' => strftime '%a, %d %b %Y %H:%M:%S GMT', gmtime $t);
  $TUWF::OBJ->resHeader('Content-Type' => 'application/atom+xml');
  xml;
  tag feed => xmlns => 'http://www.w3.org/2005/Atom', 'xml:lang' => 'en', 'xml:base' => 'https://dev.yorhel.nl/';
  tag title => "\u$s->{table} Recent Comments";
  tag updated => strftime('%Y-%m-%dT%H:%M:%SZ', gmtime $t);
  tag id => $lnk->('feed.atom');
  tag link => rel => 'self', type => 'application/atom+xml', href => $lnk->('feed.atom'), undef;
  tag link => rel => 'alternate', type => 'text/html', href => $lnk->(''), undef;

  for(@$r) {
    my $d = strftime('%Y-%m-%dT%H:%M:%SZ', gmtime $_->{date});
    tag 'entry';
     tag id => $lnk->($_->{issue})."#$d";
     tag title => $_->{summary};
     tag updated => $d;
     tag published => $d;
     tag 'author';
      tag name => $_->{name};
     end;
     tag link => rel => 'alternate', type => 'text/html', href => $lnk->($_->{issue}), undef;
    end 'entry';
  }
  end 'feed';
}

1;