do three passes, improve some other stuff

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) {