diff options
author | John Ankarström <john@ankarstrom.se> | 2020-11-11 02:19:01 +0100 |
---|---|---|
committer | John Ankarström <john@ankarstrom.se> | 2020-11-11 02:20:58 +0100 |
commit | 6544282d384e1284b53241c820b17e4f3ad010fe (patch) | |
tree | 4d3dc5a7c24e3dbb9ce8d0408daaa6e5bc52ca2f /rf.pl | |
parent | 6d4519c780aa7a8b0c329650ae1dcc653c5eb0de (diff) | |
download | rf-6544282d384e1284b53241c820b17e4f3ad010fe.tar.gz |
add Makefile, remove .pl extension
Diffstat (limited to 'rf.pl')
-rwxr-xr-x | rf.pl | 154 |
1 files changed, 0 insertions, 154 deletions
@@ -1,154 +0,0 @@ -#!/usr/bin/perl - -use v5.12; -use warnings; - -# Default configuration - -my $format_full = '(%a %y)'; -my $format_extra = '(%y)'; -my $format_list = '%a (%y). {\fI%t\fR}. {\*Q%q\*U}. %n, %d. %c: %p. {Available: %w.}'; - -# Internal variables - -my $author_last = 0; # whether the previous reference field was Ra -my @lines; -my $i = -1; -my @refs; - -while (<>) { - # Formats - if (/^\.Ff +(.*)/) { $format_full = $1; next; } - if (/^\.Fx +(.*)/) { $format_extra = $1; next; } - if (/^\.Fl +(.*)/) { $format_list = $1; next; } - - # Reference definitions - if (/^\.R([a-z]) +(.*)/) { - my ($fld, $def) = ($1, $2); - if ($fld eq 'a') { - $i++ if not $author_last; - push @lines, ".R! $i"; - if (defined $refs[$i]{a}) { - $refs[$i]{a} = "; $def"; - } else { - $refs[$i]{a} = $def; - } - $author_last = 1; - next; - } elsif ($fld =~ /[cdnpqtwy]/) { - $refs[$i]{$fld} = $def; - $author_last = 0; - next; - } - } - - # Non-rf line - push @lines, $_; -} - -$i = -1; -for (@lines) { - $i++; - # Inline reference - if (/^\.R([fx]) +(.*)/) { - my ($fld, $def) = ($1, $2); - $def =~ s/ ([.,:;\])]) ?([\[(])?$//; - my ($suffix, $prefix) = ($1, $2); - 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] += 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 "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"; - } else { - no warnings; - print $prefix . fmt($format_extra, $winner) . "$suffix\n"; - } - next; - } - - # Reference definition - if (/^\.R! (\d+)/) { - print fmt($format_list, $1, 1) . "\n"; - - next; - } - - # Non-rf line - print "$_"; -} - -sub fmt { - my ($fmt, $i, $full) = @_; - my %ref = %{$refs[$i]}; - for my $fld (split //, 'acdnpqtwy') { - if ($ref{$fld}) { - no warnings; - my $val = $ref{$fld}; - $val = fmta($val) if $fld eq 'a' and not $full; - $fmt =~ s/\{([^{}%]*)%\Q$fld\E([^{}]*)}/$1$val$2/g; - $fmt =~ s/%\Q$fld\E/$val/g; - } else { - no warnings; - $fmt =~ s/[.(]?\{([^{}%]*)%\Q$fld\E([^{}]*)}[.,:;)]?//g; - $fmt =~ s/[.(]?%\Q$fld\E[.,:;)]?//g; - } - } - $fmt =~ s/ +/ /g; - #$fmt =~ s/([(]) +/$1/; - #$fmt =~ s/ +([.,)])/$1/; - $fmt =~ s/^ *//; - $fmt =~ s/ *$//; - return $fmt; -} - -sub fmta { - my ($a) = @_; - my $r; - for my $name (split /; /, $a) { - if ($name =~ /(.*?),/) { - $r .= ", $1"; - } else { - $name =~ s/(.*?)\s/$1/; - return ", $name"; - } - } - $r =~ s/^, //; - return $r; -} - -sub likeness { - my ($string, @strings) = @_; - my $r = 0; - return 0 if not defined $string; - for (@strings) { - $r += 1 if index($string, $_) != -1; - } - return $r; -} |