aboutsummaryrefslogtreecommitdiff
path: root/rf.pl
diff options
context:
space:
mode:
authorJohn Ankarström <john@ankarstrom.se>2020-11-11 02:19:01 +0100
committerJohn Ankarström <john@ankarstrom.se>2020-11-11 02:20:58 +0100
commit6544282d384e1284b53241c820b17e4f3ad010fe (patch)
tree4d3dc5a7c24e3dbb9ce8d0408daaa6e5bc52ca2f /rf.pl
parent6d4519c780aa7a8b0c329650ae1dcc653c5eb0de (diff)
downloadrf-6544282d384e1284b53241c820b17e4f3ad010fe.tar.gz
add Makefile, remove .pl extension
Diffstat (limited to 'rf.pl')
-rwxr-xr-xrf.pl154
1 files changed, 0 insertions, 154 deletions
diff --git a/rf.pl b/rf.pl
deleted file mode 100755
index bf54bb5..0000000
--- a/rf.pl
+++ /dev/null
@@ -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;
-}