#!/usr/bin/perl -w
#
# fmscore -- freshmeat daily e-mail newsletter parser
#
# Copyright (c) 1999 Adam Spiers <adam@spiers.net>. All rights
# reserved. This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Version 0.93
#

use strict;
#use diagnostics;

use Mail::Freshmeat;

my $newsletter = new Mail::Freshmeat( \*STDIN );

$newsletter->parse;

my @entries = @{$newsletter->entries};

my $max_score = -99999;
my $min_allowed_score = 0;
my $scorer = '';
my $scorer_file = "$ENV{HOME}/.fmscorerc";

read_config_file();
score_entries($scorer);
output_scored();

exit 0;


############################################################################

sub read_config_file {
  open(SCORER, $scorer_file)
    or die "Couldn't open config file $scorer_file: $!\n";
  while (<SCORER>) {
    if (/^\s*minimum allowed score\s+([+-]?\d+)\s*$/) {
      $min_allowed_score = $1;
      next;
    }
    
    $scorer .= $_;
  }
  close(SCORER);
}

sub score_entries {
  my $scorer = shift;

  $scorer =~ s/\$(\w+)/\$entry->{$1}/g;
  $scorer =~ s/ \b score \( ( [^)]+ ) \)
              /score(\$entry->{score}, \\\@reasons, \$entry->{name}, $1)/gx;

  foreach my $entry (@entries) {
    # Add extra keys 'ALL', 'HEADER', 'BODY' to allow cool searches
    $entry->{ALL}    = $newsletter->long_entry($entry);
    $entry->{HEADER} = $newsletter->entry_header($entry);
    $entry->{BODY}   = $newsletter->entry_body($entry);

    # Avoid 'uninitialized value' warnings in the eval()
    foreach my $key ($newsletter->entry_keys()) {
      $entry->{$key} = '' unless defined $entry->{$key};
    }
    
    $entry->{score} = 0;
    my @reasons = ();

#   This makes jackshit difference
#    study $entry->{body};

    eval $scorer;

    if ($@) {
      die <<EOF;
Sorry, but your scoring code failed due to the following error:

$@
EOF
    }

    $entry->{score_reasons} = @reasons ?
                                 ' (' . (join ', ', @reasons) . ')'
                               : '';

    $max_score = $entry->{score} if $max_score < $entry->{score};
  }
}

sub score {
  my ($reasons, $name, $score, $reason) = @_[1 .. 4];

  $_[0] += $score;

  $score =~ s/^(?=[1-9])/+/;

  if ($reason) {
    push @$reasons, "${reason}->$score";
  }
}

sub output_scored {
  my $before = @entries;
  @entries = grep { $_->{score} >= $min_allowed_score } @entries;
  my $num_removed = $before - @entries;

  @entries = sort {
                       $b->{score} <=> $a->{score}
                                   ||
                    $a->{position} <=> $a->{position}
                  }
                  @entries;

  my $summary = $newsletter->summary;
  $summary =~ s/ and are included in this email//;

  print $newsletter->head->as_string,
        "\n",
        $summary,
        "\n\n",
        "$num_removed articles have been removed by fmscore because they scored too low.\n\n",
        $newsletter->list_header;

  my $score_width = length $max_score;

  print map {
             (sprintf "[%${score_width}d] ", $_->{score}) .
             $newsletter->short_entry($_) .
             "\n"
            }
            @entries;

  print "\n", $newsletter->details_header;

  print join
          $newsletter->divider,
          map {
               my $entry = $newsletter->long_entry($_);
               my $score = $_->{score};
               my $score_reasons = $_->{score_reasons};
               $entry =~ s/^(\s*? name: .* $ \n)
                          /$1    score: $score$score_reasons\n/mx;
               $entry
              }
              @entries;

  print $newsletter->divider,
        "\n",
        $newsletter->footer;
}