From 1cd3a3d6c7fb6899b88b65694841cabc00d10fc1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?John=20Ankarstr=C3=B6m?= <john@ankarstrom.se>
Date: Wed, 11 Nov 2020 01:43:39 +0100
Subject: polish

---
 rf.pl | 35 +++++++++++++++++++++++++++--------
 1 file changed, 27 insertions(+), 8 deletions(-)
 mode change 100644 => 100755 rf.pl

(limited to 'rf.pl')

diff --git a/rf.pl b/rf.pl
old mode 100644
new mode 100755
index 86345dd..7696921
--- a/rf.pl
+++ b/rf.pl
@@ -7,7 +7,7 @@ use warnings;
 
 my $format_full = '(%a %y)';
 my $format_extra = '(%y)';
-my $format_list = '%a (%y). %t. %q. %n, %d. %c: %p.';
+my $format_list = '%a (%y). %t. %q. %n, %d. %c: %p. {Available: %w.}';
 
 # Internal variables
 
@@ -46,7 +46,9 @@ while (<>) {
 	push @lines, $_;
 }
 
+$i = -1;
 for (@lines) {
+	$i++;
 	# Inline reference
 	if (/^\.R([fx]) +(.*)/) {
 		my ($fld, $def) = ($1, $2);
@@ -55,18 +57,32 @@ for (@lines) {
 		my $winner = 0;
 		my @words = split /\s/, $def;
 		my @points;
+
+		# replace '' with preceding word
+		for (@words) {
+			if ($_ eq "''") {
+				$_ = $lines[$i-1];
+				$_ =~ s/^.*\s(\S+)\s*$/$1/;
+			}
+		}
+
 		for (my $i = 0; $i < scalar @refs; $i++) {
 			$points[$i] = 0 if not defined $points[$i];
-			$points[$i] += 7 if likeness($refs[$i]{a}, @words);
-			$points[$i] += 4 if likeness($refs[$i]{y}, @words);
-			$points[$i] += 1 if likeness($refs[$i]{t}, @words);
-			$points[$i] += 1 if likeness($refs[$i]{q}, @words);
+			$points[$i] += 100 if likeness($refs[$i]{a}, @words);
+			$points[$i] += 50 if likeness($refs[$i]{y}, @words);
+			$points[$i] += 1 * likeness($refs[$i]{t}, @words);
+			$points[$i] += 1 * likeness($refs[$i]{q}, @words);
 			$winner = $i if $points[$i] > $points[$winner];
 		}
+
 		if (not defined $winner) {
-			print STDERR "Reference '$def' could not be resolved.\n";
+			print STDERR "Error: Reference '$def' could not be resolved.\n";
 			exit 1;
 		}
+		if ($points[$winner] < 11) {
+			print STDERR "Warning: Guessing that reference '$def' refers to " . fmt($format_full, $winner) . ".\n";
+		}
+
 		if ($fld eq 'f') {
 			no warnings;
 			print $prefix . fmt($format_full, $winner) . "$suffix\n";
@@ -105,6 +121,8 @@ sub fmt {
 		}
 	}
 	$fmt =~ s/ +/ /g;
+	$fmt =~ s/([(]) */$1/;
+	$fmt =~ s/ *([.,)])/$1/;
 	$fmt =~ s/^ *//;
 	$fmt =~ s/ *$//;
 	return $fmt;
@@ -127,9 +145,10 @@ sub fmta {
 
 sub likeness {
 	my ($string, @strings) = @_;
+	my $r = 0;
 	return 0 if not defined $string;
 	for (@strings) {
-		return 1 if index($string, $_) != -1;
+		$r += 1 if index($string, $_) != -1;
 	}
-	return 0;
+	return $r;
 }
-- 
cgit v1.2.3