diff options
| -rwxr-xr-x | rf | 147 |
1 files changed, 80 insertions, 67 deletions
@@ -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) { |