From 6544282d384e1284b53241c820b17e4f3ad010fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?John=20Ankarstr=C3=B6m?= Date: Wed, 11 Nov 2020 02:19:01 +0100 Subject: add Makefile, remove .pl extension --- Makefile | 3 ++ rf | 154 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ rf.1 | 1 - rf.pl | 154 --------------------------------------------------------------- 4 files changed, 157 insertions(+), 155 deletions(-) create mode 100644 Makefile create mode 100755 rf delete mode 100755 rf.pl diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..6e1b4f1 --- /dev/null +++ b/Makefile @@ -0,0 +1,3 @@ +install: + install rf /usr/local/bin/rf + cp rf.1 /usr/share/man/man1/rf.1 diff --git a/rf b/rf new file mode 100755 index 0000000..bf54bb5 --- /dev/null +++ b/rf @@ -0,0 +1,154 @@ +#!/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; +} diff --git a/rf.1 b/rf.1 index 24ac621..ad9d2bd 100644 --- a/rf.1 +++ b/rf.1 @@ -8,7 +8,6 @@ . .Sh SYNOPSIS .Nm -.Li < .Ar file . .Sh DESCIPTION 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; -} -- cgit v1.2.3