#! /usr/bin/perl
#
# WARNING: THIS SCRIPT IS UNTESTED
#
# turn a flnews(1) score file into a tin(1) regexp filter file.
#
# flnews2tin.pl < ~/.config/flnews/scorefile > checkme.tmp
# cat checkme.tmp >> ~/.tin/filter
#
# 2024-09-30 <[email protected]>

require 5.008;

use strict;
use warnings;

# version Number
# my $version = "0.0.8";

my ($line, $target, $type, $score, $string, $prefix, $suffix, @comments);

# max score value (tin limit)
use constant SCORE_MAX => 10000;

while (defined($line = <>)) {
   chomp $line;

   # ignore empty lines
   next if ($line =~ m/^(?:\s|$)/);

   # save comments
   if ($line =~ s/^\#\s*(\S.*)$/$1/) {
       push @comments, $line;
       next;
   }

   # skip lines with less than 3 colons
   if ($line !~ m/^([^:]+):([^:]+):([^:]+):(.*)/) {
       next;
   } else {
       $target = $1;
       $type = $2;
       $score = $3;
       $string = $4;
   }

   # skip non target
   next if ($target =~ m/^\s*$/);

   # skip non types
   next if ($type !~ m/^(?:from|from_ere|group|msgid_ere|subject|subject_ere)$/);

   # skip non scores
   next if ($score !~ m/^\s*[+-]?\d+\s*$/);

   # skip non string
   next if ($string =~ m/^$/);

   # looks like we have a valid line, here we go
   unshift(@comments, "converted from: ".$line);
   $prefix = $suffix = "";

   # stuff which needs to be anchored and quoted
   if ($type =~ m/^(?:from|group|subject)$/) {
       $suffix = "\$";
       $string = quotemeta($string);
       $string =~ s/(?<!\\)\\([ !@,;:#<>-])/$1/g; # undo excessive quoting
   }

   $prefix = "from=^" if ($type eq "from");
   $prefix = "from=" if ($type eq "from_ere");

   if ($type eq "group") {
       $prefix = "xref=(?:^|,)";
       $suffix = "(?:,|\$)";
   }

   $prefix = "msgid_only=" if ($type eq "msgid_ere");

   $prefix = "subj=^" if ($type eq "subject");
   $prefix = "subj=" if ($type eq "subject_ere");

   # cosmetics
   $score =~ s/\s+//g;

   # check limits
   $score = SCORE_MAX if ($score > SCORE_MAX);
   $score = -SCORE_MAX if ($score < -SCORE_MAX);

   # print rule
   map{print "\ncomment=$_"} @comments;
   print "\ngroup=".$target."\n";
   print "case=0\n";
   print "score=".$score."\n";
   print $prefix.$string.$suffix."\n";
   @comments = ();
}