#!/usr/bin/env perl
# newsformat - formats a news article in a consistent manner.
# Licensed under the same terms as perl.  
# Copyright 2005-2008 Tim Skirvin <tskirvin@killfile.org>

###############################################################################
### Configuration #############################################################
###############################################################################

our $NNTPUSER = $ENV{'USER'};
our $HOSTNAME = hostname ();
our $MAX_REFS = 8;

###############################################################################
### Declarations ##############################################################
###############################################################################

use strict;
use warnings;

use News::Article;
use Sys::Hostname;

###############################################################################
### main() ####################################################################
###############################################################################

my $article = News::Article->new;
$article->read (\*STDIN) or die "Couldn't read article: $!\n";

$article->drop_headers ("Date");
$article->drop_headers ("X-Signature");
$article->add_date;
$article->add_message_id ("$NNTPUSER.", $HOSTNAME);
$article->trim_references ($MAX_REFS);
foreach my $head ($article->header_names) { 
    $article->drop_headers ($head) unless $article->header ($head);
}
$article->write (\*STDOUT);

###############################################################################
### News::Article Subroutines #################################################
###############################################################################

package News::Article;

# need to get this in here for definitions before we start messing w/N::A
BEGIN {
    package News::Article;

    use vars qw/$UNQUOTED_CHAR $UNQUOTED_WORD $LOCAL_PART $DOMAIN $ADDRESS
                $MY_DOMAIN/;

    $MY_DOMAIN     = 'various.nowhere.invalid';     # bogus domain

    $UNQUOTED_CHAR = '[^!\(\)<>\@,\;:\\\"\.\[\]]';
    $UNQUOTED_WORD = $UNQUOTED_CHAR . '+';
    $LOCAL_PART    = $UNQUOTED_WORD . '(?:\.' . $UNQUOTED_WORD . ')*';
    $DOMAIN        = $UNQUOTED_WORD . "(?:\." . $UNQUOTED_WORD . ")*";
    $ADDRESS       = $LOCAL_PART . '@' . $DOMAIN;
}

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

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

        if ($id =~ /^<trimmed[- ]?(\d*).*>$/) { 
            $trimmed += $1; 
            next; 
        }

        if (messageid_is_clean ($id)) { push (@refs, $id) } 
        else                          { $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\@$MY_DOMAIN>", splice (@refs, 1));
    }

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

sub messageid_is_clean {
    my ($id) = @_;
    $id =~ s/\s+//g;
    $id =~ s/^/</ unless $id =~ /^</;
    $id =~ s/$/>/ unless $id =~ />$/;
    return $id =~ m/^<$ADDRESS>$/x ? 1 : 0;
}