view release on metacpan or  search on metacpan

script/news  view on Meta::CPAN

    }
    # reverse the list of articles, latest ones come first
    return [reverse @$articles]});
  return $c->render(template => 'noserver') if 'error' eq $data;
  $nntp->quit if $nntp;
  # If the cached data did not include our article, delete the cache and retry.
  # This could be optimized to extend the existing data…
  if ($include and (@$data == 0 or $include < $data->[$#$data]->{num})) {
    my $seen = grep { $_->{num} == $include } @$data;
    if (not $seen) {
      app->log->debug("$include was not seen in the cached data");
      $cache->set("$group tag $tag" => undef);
      return $c->redirect_to('tag');
    }
  }
  $c->render(template => 'tag', group => $group, tag => $tag, edit => $edit, list => $data);
} => 'tag';

# This only works for message-ids, not for message numbers (since they require a
# group).
get '/article/#id' => sub {
  my $c = shift;
  show_article($c, $c->param('id'));
} => 'article_id';

get '/article/#group/#id' => sub {
  my $c = shift;
  show_article($c, $c->param('id'), $c->param('group'));
} => 'article';

sub show_article {
  # When following a link from the group, $id_or_num is a num and $group is
  # important. When following a reference from an article, $id_or_num is a
  # message-id and $group is only used for the reply form.
  my ($c, $id_or_num, $group) = @_;
  my $article = cached("$group article $id_or_num", sub {
    my $nntp = Net::NNTP->new() or return 'noserver';
    $nntp->group($group) if $group;
    my $article = $nntp->article($id_or_num);
    return 'unknown' unless $article;
    # app->log->trace(join("", @$article));
    # $article is header lines, an empty line, and body lines
    my $headers = Mojo::Headers->new;
    while ($_ = shift(@$article)) {
      $headers->parse("$_\r\n");
      last unless /\S/;
    }
    my $id = $headers->header("message-id");
    my $subject = decode("MIME-Header", $headers->header("subject")) || "?";
    my $from = no_email(decode("MIME-Header", $headers->header("from")));
    my $date = $headers->header("date");
    my $dt = DateTime::Format::Mail->new->loose->parse_datetime($date);
    $date = [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)];
    my $newsgroups = [split(/\s*,\s*/, decode("MIME-Header", $headers->header("newsgroups")) || "")];
    $group ||= "@$newsgroups";
    my $references = [split(/\s+/, decode("MIME-Header", $headers->header("references")) || "")];
    my $body = join("", @$article);
    $body =~ s/\s*<\S*?@\S*?>//g; # remove email addresses
    $body =~ s/\s*"\S*?@\S*?"//g; # remove email addresses
    if ($headers->header('content-type')) {
      my ($charset) = $headers->header('content-type') =~ /charset=['"]?([^;'"]*)/;
      $body = decode($charset, $body) if $charset;
    }
    my $value = {
      id => $id,
      group => $group,
      from => $from,
      subject => $subject,
      date => $date,
      newsgroups => $newsgroups,
      references => $references,
      html_body => html_unwrap($body),
      body => $body,
    };
    # perhaps we have cached replies from looking at the group (space and no page number at the end)
    my $cached_group = cached("$group list ", sub {}) || {};
    my $cached_article = (first { $_->{id} eq $id } @{$cached_group->{articles}}) || {};
    $value->{replies} = $cached_article->{replies} || [];
    app->log->debug("$id replies: @{$value->{replies}}");
    $nntp->quit;
    # If $id_or_num was a number, add a second key to the cache in case we need
    # the same article but following a reference.
    $cache->set("$group article $id" => [time, $value]) if $id_or_num ne $id;
    return $value });
  return $c->render(template => $article) unless ref $article;
  $c->render(template => 'article', article => $article, edit => $c->param('edit'));
}

get '/post/#group' => sub {
  my $c = shift;
  # copy from the cookie
  $c->param($_ => $c->session->{$_}) for qw(name username password);
  $c->render(template => 'post',
             id => '',
             subject => '',
             supersedes => '',
             references => '');
} => 'new';

post '/reply' => sub {
  my $c = shift;
  # copy from the cookie
  $c->param($_ => $c->session->{$_}) for qw(name username password);
  $c->render(template => 'post',
             id => $c->param('id'),
             group => $c->param('group'),
             subject => $c->param('subject'),
             supersedes => '',
             references => $c->param('references'));
} => 'reply';

post '/supersede' => sub {
  my $c = shift;
  # copy from the cookie
  $c->param($_ => $c->session->{$_}) for qw(name username password);
  $c->render(template => 'post',
             id => '',
             body => $c->param('body'),
             group => $c->param('group'),
             subject => $c->param('subject'),
             supersedes => $c->param('supersedes'),
             references => $c->param('references'));
} => 'supersede';

post '/post' => sub {
  my $c = shift;
  $c->session(expiration => time + 7 * 24 * 60 * 60); # one week
  my $username = $c->param('username');
  return $c->error("No username") unless $username or $ENV{NEWS_MODE} and $ENV{NEWS_MODE} eq "NOAUTH";
  $c->session(username => $username);

  my $password = $c->param('password');
  return $c->error("No password") unless $password or $ENV{NEWS_MODE} and $ENV{NEWS_MODE}eq "NOAUTH";
  $c->session(password => $password);

  my $name = $c->param('name');
  return $c->error("No from address specified") unless $name;
  $name =~ s/[^[:graph:] ]//g;
  return $c->error("From address does not have the format 'Your Name <mail\@example.org>'") unless $name =~ /<\S+@\S+\.\S+>/;
  $c->session(name => $name);

  my $group = $c->param('group');
  return $c->error("No group") unless $group;
  $group =~ s/[^[:graph:]]//g;
  return $c->error("No group") unless $group;

  my $references = $c->param('references');
  my $supersedes = $c->param('supersedes');

  my $subject = $c->param('subject');
  return $c->error("No subject") unless $subject;
  # $subject = encode("MIME-Header", $subject);

  my $body = $c->param('body');
  return $c->error("No body") unless $body;

  $body = wrap($body) if $c->param('wrap');

  my $nntp = Net::NNTP->new() or return $c->render(template => 'noserver');
  $nntp->authinfo($username, $password) if $username and $password;
  my $article = [];
  push(@$article, "From: $name\r\n");
  push(@$article, "Subject: $subject\r\n");
  push(@$article, "Newsgroups: $group\r\n");
  push(@$article, "References: $references\r\n") if $references;
  push(@$article, "Supersedes: $supersedes\r\n") if $supersedes;
  push(@$article, "MIME-Version: 1.0\r\n");
  push(@$article, "Content-Type: text/plain; charset=UTF-8\r\n");
  push(@$article, "Content-Transfer-Encoding: 8bit\r\n");
  push(@$article, "\r\n");
  push(@$article, map { "$_\r\n" } split(/\r?\n/, encode('UTF-8', $body)));
  app->log->debug(join("", @$article));
  my $ok = $nntp->post($article);
  $cache->set("$group list " => undef) if $ok; # includes space and no page number
  $nntp->quit;
  $c->render('posted', group => $group, ok => $ok);
} => 'post';

get '/latest' => sub {
  my $c = shift;
  my $list = cached("news " . ($ENV{NEWS_GROUPS} || "*"), sub {
    my $nntp = Net::NNTP->new() or return 'error';
    my $since = time() - 7 * 24 * 60 * 60; # one week
    my $ids = $nntp->newnews($since, $ENV{NEWS_GROUPS} || "*");
    $ids = [@$ids[$#$ids - $per_page .. $#$ids]] if @$ids > $per_page;
    my $articles = [];
    my $parser = DateTime::Format::Mail->new->loose;
    for my $id (@$ids) {
      my $head = $nntp->head($id);
      next unless $head;
      my $headers = Mojo::Headers->new;
      for my $line (@$head) {
        $headers->parse("$line\r\n");
      }
      $headers->parse("\r\n"); # make sure it finishes correctly
      my $subject = decode("MIME-Header", $headers->header("subject")) || "?";
      my ($tag) = $subject =~ /\[(.*?)\]/;
      my $from = no_email(decode("MIME-Header", $headers->header("from")));
      my $date = $headers->header("date");
      app->log->debug("$from/$subject/$date") unless $date;
      my $dt = $parser->parse_datetime($date);
      $date = [$dt->ymd, sprintf("%02d:%02d", $dt->hour, $dt->minute)];
      my $newsgroups = [split(/\s*,\s*/, decode("MIME-Header", $headers->header("newsgroups")) || "")];
      my $group = "@$newsgroups";
      my $url = $c->url_for('article', group => $group, id => $id); # $num is not available
      push(@$articles, {
        id => $id,
        tag => $tag,
        url => $url,
        group => $group,
        from => $from,
        subject => $subject,
        date => $date,
        newsgroups => $newsgroups, });
    };
    $nntp->quit;
    return $articles });
  return $c->render(template => 'noserver') if $list eq 'error';
  $c->render(template => 'latest', list => $list);
} => 'latest';

app->start;

__DATA__

@@ index.html.ep
% layout "default";
% title 'News';