#!/usr/bin/env perl

# our $whoami = "/usr/ucb/whoami";
our $whoami = "whoami";
my $nntpuser ||= (`$whoami`);
chomp($nntpuser);

use strict;
use News::Article;
my $article = new News::Article(\*STDIN);

$article->drop_headers("date", 'x-auth');
$article->add_date;
$article->add_message_id ( "$nntpuser." )  ;
$article->trim_references(8);
$article->write(\*STDOUT);

package News::Article;

BEGIN {
  package News::Article;
  use vars qw( $UNQUOTED_CHAR $UNQUOTED_WORD $LOCAL_PART $DOMAIN $ADDRESS );

  $UNQUOTED_CHAR = '[^!\(\)<>\@,\;:\\\"\.\[\]]';
  $UNQUOTED_WORD = $UNQUOTED_CHAR . '+';
  $LOCAL_PART    = $UNQUOTED_WORD . '(?:\.' . $UNQUOTED_WORD . ')*';
  $DOMAIN        = $UNQUOTED_WORD . "(?:\." . $UNQUOTED_WORD . ")*";
  $ADDRESS       = $LOCAL_PART . '@' . $DOMAIN;
  
  use vars qw( $PREFIX $MYDOMAIN $MAXREFS );
  $PREFIX    = "tskirvin";
  $MYDOMAIN  = "various.nowhere.invalid";
  $MAXREFS   = 6;	# How many references should we keep, by default?
}


sub trim_references {
  my ($self, $maxrefs) = @_;
  $maxrefs ||= $MAXREFS;

  my $refs = $self->header('references');
  my ($trimmed, @refs, %refs);
  foreach (split('\s+|\s*,\s*|><', $refs)) {
    s/\s//g;                    # Wipe the whitespace.
    s/^/</ unless /^</;         # Adds in the <'s and >'s if necessary.
    s/$/>/ unless />$/;
    next if $refs{$_};
    $refs{$_}++;

    if (/^<trimmed[- ]?(\d*).*>$/) { $trimmed += $1; next; }
    my $clean = _clean_messageid($_);
    $clean eq $_ ? push (@refs, $_) : $trimmed++;
  }

  if (scalar(@refs) > $maxrefs ) {     # There's too many references
    my $difference = scalar(@refs) - $maxrefs;
    $trimmed += $difference;
    @refs = ($refs[0], splice(@refs, $difference + 1));
  }

  if ($trimmed) {
    @refs = ($refs[0], "<trimmed-$trimmed\@$MYDOMAIN>", splice(@refs, 1));
  }

  $article->set_headers('References', join(" ", @refs)) if scalar @refs;
  1;
}

sub _clean_messageid {
  my $id = shift;
     $id =~ s/\s+//g;
     $id =~ s/^/</ unless $id =~ /^</;
     $id =~ s/$/>/ unless $id =~ />$/;

  return $id if $id =~ m/^<$ADDRESS>$/x;

  # Make a new ID if necessary (code from Andrew Gierth's News::Article)
  my ($sec,$min,$hr,$mday,$mon,$year) = gmtime(time);
  ++$mon;
  $id = sprintf('<%s%04d%02d%02d%02d%02d%02d$%04x@%s>',
                 $PREFIX, $year+1900, $mon, $mday, $hr, $min, $sec,
                 0xFFFF & (rand(32768) ^ $$), $MYDOMAIN);
}