diff options
| -rwxr-xr-x | rf | 36 |
1 files changed, 23 insertions, 13 deletions
@@ -6,8 +6,8 @@ use warnings; # Default configuration my %fmt; -$fmt{f} = '(%A %y)'; -$fmt{x} = '(%y)'; +$fmt{f} = "\n(%A %y)"; +$fmt{x} = "\n(%y)"; $fmt{d} = '%a (%y). {\fI%t\fR}. {\*Q%q\*U}. %n, %d. %c: %p. {Available: %w.}'; # Internal variables @@ -29,7 +29,7 @@ while (<>) { $rest .= "\n" . <>; chomp $rest; } - $rest .= "\n"; + chomp $rest; $fmt{$type} = $rest; next; } @@ -42,7 +42,7 @@ while (<>) { my $inlref = 0; my @r = (); my $refblock = 0; -my $refi = 0; +my $refi = -1; for (my $i = $#lines; $i >= 0; $i--) { $_ = $lines[$i]; chomp; @@ -67,17 +67,17 @@ for (my $i = $#lines; $i >= 0; $i--) { # Inline reference if (/^\.R([fx]) +(.*)/) { - my ($fld, $def) = ($1, $2, $3); + my ($fld, $rest) = ($1, $2, $3); $inlref = 1; # find potential prefix/suffix my ($suffix, $prefix); - if ($def =~ s/ ([.,?!:;\])]) ?([\[(])?$//) { + if ($rest =~ s/ ([.,?!:;\])]) ?([\[(])?$//) { ($suffix, $prefix) = ($1, $2); } - my @words = split /\s/, $def; + my @words = split /\s/, $rest; # replace '' with last word on preceding line for (@words) { @@ -88,12 +88,13 @@ for (my $i = $#lines; $i >= 0; $i--) { } } - # find matching reference list entry + # find matching definition my $winner = 0; my @points; for (my $i = 0; $i < scalar @refs; $i++) { + my $a = join '; ', @{$refs[$i]{a}} if exists $refs[$i]{a}; $points[$i] = 0 if not defined $points[$i]; - $points[$i] += 100 if likeness($refs[$i]{a}, @words); + $points[$i] += 100 if likeness($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); @@ -101,12 +102,20 @@ for (my $i = $#lines; $i >= 0; $i--) { } if (not defined $winner) { - print STDERR "Error: Reference '$def' could not be resolved.\n"; + print STDERR "Error: Reference '$rest' could not be resolved.\n"; exit 1; } if ($points[$winner] < 150) { - print STDERR "Warning: Guessing that reference '$def' refers to " . fmt($fmt{f}, $winner) . " (match = $points[$winner]).\n"; + my $f = fmt("%a, %y", $winner); + print STDERR "Warning: Guessing that reference '$rest' refers to $f; "; + if ($points[$winner] > 100) { + print STDERR "only date matches.\n"; + } elsif ($points[$winner] > 50) { + print STDERR "only date and title matches.\n"; + } else { + print STDERR "only title matches (level = $points[$winner]).\n"; + } } # format reference @@ -121,7 +130,8 @@ for (my $i = $#lines; $i >= 0; $i--) { my $n = index($fmt, "\n"); $prefix = '' if not $prefix; $suffix = '' if not $suffix; - if ($n != -1) { + push @r, "\n"; + if ($n != 0) { push @r, substr($fmt, index($fmt, "\n")); push @r, $prefix . substr($fmt, 0, index($fmt, "\n")) . "$suffix"; } else { @@ -197,7 +207,7 @@ sub likeness { my $r = 0; return 0 if not defined $string; for (@strings) { - $r += 1 if index($string, $_) != -1; + $r += 1 if index(lc $string, lc $_) != -1; } return $r; } |