aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Ankarström <john@ankarstrom.se>2020-11-10 23:22:20 +0100
committerJohn Ankarström <john@ankarstrom.se>2020-11-10 23:22:20 +0100
commit80b1d2e0e7ba2800924f70c45ce567ae8d8a16b2 (patch)
treef72a8f2120c0b3887da1f32de2356b50ff9bd6e2
parent89304337fba2cda5a823bbfd724a5bc572ea34dd (diff)
downloadrf-80b1d2e0e7ba2800924f70c45ce567ae8d8a16b2.tar.gz
rewrite in perl
-rw-r--r--rf.c120
-rw-r--r--rf.pl126
2 files changed, 126 insertions, 120 deletions
diff --git a/rf.c b/rf.c
deleted file mode 100644
index 6067373..0000000
--- a/rf.c
+++ /dev/null
@@ -1,120 +0,0 @@
-#include <ctype.h>
-#include <err.h>
-#include <stdbool.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <unistd.h>
-
-#define DEFMAX 300
-
-struct ref {
- char *a;
- char *y;
- char *t;
- char *q;
- char *d;
- char *c;
- char *p;
- char *w;
-};
-
-char format_extra[DEFMAX+1];
-char format_full[DEFMAX+1];
-char format_list[DEFMAX+1];
-int refs_s;
-struct ref *refs;
-
-void record(char *dest) {
- char c;
- int i;
- i = 0;
- while (read(STDIN_FILENO, &c, 1) != 0 && isspace(c))
- ;
- while (read(STDIN_FILENO, &c, 1) != 0)
- dest[i++] = c;
- dest[i] = '\0';
-}
-
-int main() {
- char c, *buf, last[4];
- int i, buf_s, ref_i;
-
- buf_s = 200;
- buf = malloc((buf_s+1) * sizeof(char));
- if (buf == NULL) err(1, "malloc");
-
-#define reset(n) do { \
- strncpy(last, " ", 4); \
- i =- n; \
- buf[i] = '\0'; \
-} while (0)
-
- i = 0;
- ref_i = -1;
-
-next:
- while (read(STDIN_FILENO, &c, 1) != 0) {
- if (strncmp(last, "\n.F", 3) != 0)
- goto ref;
-
- /* record format def */
- switch (last[4]) {
- case 'f':
- record(format_full);
- break;
- case 'x':
- record(format_extra);
- break;
- case 'l':
- record(format_list);
- break;
- default:
- goto add;
- }
- reset(3);
- goto next;
-
-ref:
- if (strncmp(last, "\n.R", 3) != 0)
- goto add;
-
- /* record reference def */
- switch(last[4]) {
- case 'a':
- reset(3);
- if (ref_i+1 > refs_s) {
- refs_s += 10;
- refs = realloc(refs, refs_s*sizeof(struct ref));
- if (refs == NULL) err(1, "realloc");
- }
- ref_i++;
- refs[ref_i].a = malloc((DEFMAX+1) * sizeof(char));
- if (refs[ref_i].a == NULL) err(1, "malloc");
- record(refs[ref_i].a);
- break;
- case 'y':
- break;
- default:
- goto add;
- }
- reset(3);
- goto next;
-
-add:
- /* add to buffer */
- if (i+1 > buf_s) {
- buf_s += 100;
- buf = realloc(buf, (buf_s+1) * sizeof(char));
- if (buf == NULL) err(1, "realloc");
- }
- buf[i++] = c;
-
- /* keep track of last 4 characters */
- if (i <= 4) last[i] = c;
- else {
- memmove(last, last+1, 3);
- last[3] = c;
- }
- }
-}
diff --git a/rf.pl b/rf.pl
new file mode 100644
index 0000000..b2fe726
--- /dev/null
+++ b/rf.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+
+use v5.12;
+use warnings;
+
+# Default configuration
+
+my $format_full = '(%a %y)';
+my $format_extra = '(%y)';
+my $format_list = '%a (%y). %t. %q. %n, %d. %c: %p.';
+
+# 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";
+ $refs[$i]{$fld} = $def;
+ $author_last = 1;
+ next;
+ } elsif ($fld =~ /[cdnpqtwy]/) {
+ $refs[$i]{$fld} = $def;
+ $author_last = 0;
+ next;
+ }
+ }
+
+ # Non-rf line
+ push @lines, $_;
+}
+
+for (@lines) {
+ # 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;
+ for (my $i = 0; $i < scalar @refs; $i++) {
+ $points[$i] = 0 if not defined $points[$i];
+ $points[$i] += 7 if likeness($refs[$i]{a}, @words);
+ $points[$i] += 4 if likeness($refs[$i]{y}, @words);
+ $points[$i] += 1 if likeness($refs[$i]{t}, @words);
+ $points[$i] += 1 if likeness($refs[$i]{q}, @words);
+ $winner = $i if $points[$i] > $points[$winner];
+ }
+ if (not defined $winner) {
+ print STDERR "Reference '$def' could not be resolved.\n";
+ exit 1;
+ }
+ 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) . "\n";
+
+ next;
+ }
+
+ # Non-rf line
+ print "$_";
+}
+
+sub fmt {
+ my ($fmt, $i) = @_;
+ 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';
+ $fmt =~ s/\{(.*?)%$fld(.*?)}/$1$val$3/g;
+ $fmt =~ s/%$fld/$val/g;
+ } else {
+ no warnings;
+ $fmt =~ s/\{(.*?)%$fld(.*?)}//g;
+ $fmt =~ s/[.(]?%$fld[.,:;)]?//g;
+ }
+ }
+ $fmt =~ s/ +/ /g;
+ $fmt =~ s/^ *//;
+ $fmt =~ s/ *$//;
+ return $fmt;
+}
+
+sub fmta {
+ my ($name) = @_;
+ if ($name =~ /(.*?),/) {
+ return $1;
+ } else {
+ $name =~ s/(.*?)\s/$1/;
+ return $name;
+ }
+}
+
+sub likeness {
+ my ($string, @strings) = @_;
+ return 0 if not defined $string;
+ for (@strings) {
+ return 1 if index($string, $_) != -1;
+ }
+ return 0;
+}