aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Ankarström <john@ankarstrom.se>2020-11-11 20:48:40 +0100
committerJohn Ankarström <john@ankarstrom.se>2020-11-11 20:49:46 +0100
commit153099fdd1488f4e66bd1b29d1b57e10999cac32 (patch)
tree3a7fce0c9ab25683335cbeec7b8c5293a9289776
parent19afddd6a2d3bdcb537868418a8976dd2aee4e93 (diff)
downloadrf-153099fdd1488f4e66bd1b29d1b57e10999cac32.tar.gz
do three passes, improve some other stuff
-rwxr-xr-xrf147
1 files changed, 80 insertions, 67 deletions
diff --git a/rf b/rf
index 7fbc887..0591d67 100755
--- a/rf
+++ b/rf
@@ -5,81 +5,85 @@ 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.}';
+my %fmt;
+$fmt{f} = '(%A %y)';
+$fmt{x} = '(%y)';
+$fmt{d} = '%a (%y). {\fI%t\fR}. {\*Q%q\*U}. %n, %d. %c: %p. {Available: %w.}';
# Internal variables
my $author_last = 1; # whether the previous reference field was Ra
my @lines;
-my $i = 0;
my @refs;
-# Load entire file
+# First pass (process formats)
while (<>) {
- # Formats
- if (/^\.F([fxl])(\\?) +(.*)/) {
- my ($type, $join, $line) = ($1, $2, $3);
- chomp $line;
- $line = "\n$line" if not $join;
+ chomp;
+
+ # Format
+ if (/^\.F([fdx])(\\?) +(.*)/) {
+ my ($type, $join, $rest) = ($1, $2, $3);
+ $rest = "\n$rest" if not $join;
while (not eof()) {
- last if not $line =~ s/\\$//;
- $line .= "\n" . <>;
- chomp $line;
+ last if not $rest =~ s/\\$//;
+ $rest .= "\n" . <>;
+ chomp $rest;
}
- $line .= "\n";
- $format_full = $line if $type eq 'f';
- $format_list = $line if $type eq 'l';
- $format_extra = $line if $type eq 'x';
+ $rest .= "\n";
+ $fmt{$type} = $rest;
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, $_;
}
-# Print processed file
+# Second pass (process reference definitions and inline references)
+
+my $inlref = 0;
+my @r = ();
+my $refblock = 0;
+my $refi = 0;
+for (my $i = $#lines; $i >= 0; $i--) {
+ $_ = $lines[$i];
+ chomp;
+
+ # Definition
+ if (/^\.R([acdnpqtwy]) +(.*)/) {
+ my ($fld, $rest) = ($1, $2);
+
+ $refi++ if not $refblock; # new reference
+ $refblock = 1;
+
+ if ($fld eq 'a') {
+ push @{$refs[$refi]{a}}, $rest;
+ } else {
+ $refs[$refi]{$fld} = $rest;
+ }
+ next;
+ } elsif ($refblock) {
+ # print formatted reference definition
+ push @r, fmt($fmt{d}, $refi) . "\n";
+ }
-$i = -1;
-my $last = '';
-for (@lines) {
# Inline reference
if (/^\.R([fx]) +(.*)/) {
- my ($suffix, $prefix, @points);
my ($fld, $def) = ($1, $2, $3);
- # find potential prefix/suffix and split into words
+ $inlref = 1;
+
+ # find potential prefix/suffix
+ my ($suffix, $prefix);
if ($def =~ s/ ([.,?!:;\])]) ?([\[(])?$//) {
($suffix, $prefix) = ($1, $2);
}
+
my @words = split /\s/, $def;
# replace '' with last word on preceding line
for (@words) {
if ($_ eq "''") {
- $_ = $last;
+ $_ = $lines[$i-1];
chomp;
$_ =~ s/^.*\s(\S+)\s*$/$1/;
}
@@ -87,6 +91,7 @@ for (@lines) {
# find matching reference list entry
my $winner = 0;
+ my @points;
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);
@@ -102,48 +107,56 @@ for (@lines) {
}
if ($points[$winner] < 150) {
- print STDERR "Warning: Guessing that reference '$def' refers to " . fmt($format_full, $winner) . " (match = $points[$winner]).\n";
+ print STDERR "Warning: Guessing that reference '$def' refers to " . fmt($fmt{f}, $winner) . " (match = $points[$winner]).\n";
}
- # Print formatted reference
+ # format reference
my $fmt;
if ($fld eq 'f') {
- $fmt = fmt($format_full, $winner);
+ $fmt = fmt($fmt{f}, $winner);
} else {
- $fmt = fmt($format_extra, $winner);
+ $fmt = fmt($fmt{x}, $winner);
}
+
+ # print formatted reference
+ push @r, "\n" if $fmt =~ s/^\n//;
+ my $n = index($fmt, "\n");
$prefix = '' if not $prefix;
$suffix = '' if not $suffix;
- chomp $last;
- print $last;
- $last = $prefix . substr($fmt, 0, index($fmt, "\n")) . "$suffix";
- $last .= substr($fmt, index($fmt, "\n"));
+ if ($n != -1) {
+ push @r, substr($fmt, index($fmt, "\n"));
+ push @r, $prefix . substr($fmt, 0, index($fmt, "\n")) . "$suffix";
+ } else {
+ push @r, "$prefix$fmt$suffix";
+ }
next;
}
- # Reference definition
- if (/^\.R! (\d+)/) {
- chomp $last;
- print $last;
- $last = fmt($format_list, $1, 1) . "\n";
- next;
+ # non-rf line
+ if (!$inlref) {
+ push @r, "\n";
}
+ push @r, $_;
+
+ $refblock = 0;
+ $inlref = 0;
+}
- # Non-rf line
- print $last;
- $last = $_;
+# Third pass (print the result)
+for (my $i = $#r; $i >= 0; $i--) {
+ print $r[$i];
}
-print $last;
-# Format a given reference after $fmt
+# Format reference at $i after $fmt
sub fmt {
- my ($fmt, $i, $full) = @_;
+ my ($fmt, $i) = @_;
my %ref = %{$refs[$i]};
for my $fld (split //, 'Aacdnpqtwy') {
if ($ref{lc $fld}) {
no warnings;
my $val = $ref{lc $fld};
- $val = fmta($val) if $fld eq 'a' and not $full;
+ $val = join '; ', @$val if lc $fld eq 'a';
+ $val = fmtl($val) if $fld eq 'A';
$fmt =~ s/\{([^{}%]*)%\Q$fld\E([^{}]*)}/$1$val$2/g;
$fmt =~ s/%\Q$fld\E/$val/g;
} else {
@@ -161,7 +174,7 @@ sub fmt {
}
# Remove forenames from a given string of authors
-sub fmta {
+sub fmtl {
my ($a) = @_;
my $r;
for my $name (split /; /, $a) {