j2bib
j2bib (Version 1.3.0) teaches doi2bib a journal it does not know. Hand it a journal name that iso4 does not abbreviate and it proposes a bib key for it, shows the two lines it would have to write, and once told to go ahead writes them: the s/<journal>/<key>/ rule into iso4 and the @string{<key> = "<journal>"} line into sci.bib, each at a sensible place.
Written with Claude Opus 5 on 1 September (2026), taught on 11 September (2026) to refuse a key BibTeX would not take and to let the proposals be walked with the arrows, and on 13 September (2026) to recognise a journal sci.bib already has under another spelling instead of coining it a second key.
Why a journal takes two files
A journal is written in sci.bib as a bare @string key and never as a name: journal = prl, not journal = {Phys. Rev. Lett.}. Of the entries on file 4845 do it that way and 113 keep the name in braces, which BibTeX accepts but which links to nothing and prints whatever the publisher happened to call the journal that year. Two files together make a key, and neither is any use without the other:
~/bib/doi2bib/iso4— a sed script, ones/<name>/<key>/line per spelling. It is run twice, which is not a belt-and-braces habit but a requirement: about a dozen rules match what an earlier rule produces, so thatPhil. Trans. R. Soc. A.becomesphiltranRS A.on the first pass and only thenphiltranA. Order matters for the same reason a sed script always does: a rule whose left-hand side sits inside another's must come after it, or it fires first and eats the match.- the
@stringblock at the top of sci.bib, alphabetical by key, no blank line anywhere in it. Without a line here the key is undefined, and BibTeX resolves an undefined string to nothing at all rather than complaining loudly.
That second failure is the quiet one. bib2wiki sends its own standard error to /dev/null, so an undefined journal key travels all the way to the wiki and renders there as an empty [[]], with nothing anywhere to say why.
Usage
j2bib "Phys. Chem. Chem. Phys." # propose a key, show the plan, ask
j2bib "Phys. Chem. Chem. Phys." "Physical Chemistry Chemical Physics"
# ... and map the long title too
j2bib -k pccp "Phys. Chem. Chem. Phys." # I know the key I want
j2bib -a "Phys. Chem. Chem. Phys." "Physical Chemistry Chemical Physics"
# -a: what BibTeX should *print*
j2bib -n "..." # dry run, touch nothing
j2bib -y "..." # no question asked
j2bib -l "..." # look it up, say what it is or looks like
The first name given is the one that goes in the @string, and so the one BibTeX prints, unless -a says otherwise. Every name given gets its own iso4 line, so that whichever of Crossref's container-title-short and container-title comes back for a given paper, it lands on the same key.
Here is the whole of the run that gave Journal of Physics F: Metal Physics its key, the journal of Edwards and Anderson's spin-glass paper, Theory of spin glasses. S. Edwards and P. Anderson in J. Phys. F: Met. Phys. 5:965 (1975).:
$ j2bib "J. Phys. F: Met. Phys." "Journal of Physics F: Metal Physics"
"J. Phys. F: Met. Phys." is in neither iso4 nor sci.bib. Keys I can make of it:
jpfmp
jphysfmetphys
/home/laussy/bib/doi2bib/iso4
s/J. Phys. F: Met. Phys./jpfmp/
s/Journal of Physics F: Metal Physics/jpfmp/
/home/laussy/bib/sci.bib
@string{jpfmp = "J. Phys. F: Met. Phys."}
[Enter] to accept, another key to use it, or n to give up:
jpfmp added
/home/laussy/bib/doi2bib/iso4: 2 lines after "J. Phys. B: At. Mol. Opt. Phys."
/home/laussy/bib/sci.bib: between jpcs and jphys
journal = jpfmp
jpfmp and not jpf, which the jpa, jpb, jpc, jpd family would have suggested, because jpf was taken in 1975's own decade by J. Phys. France. A proposal already in use is listed with what it is used for and skipped as the default.
Choosing the key
The first proposal is rarely the wrong one, but it is only a proposal, so the list is walked with the up and down arrows rather than retyped. A marker shows where one is, the list wraps at both ends, and the two lines that would be written are redrawn underneath as the marker moves, so what a key would actually do to iso4 and to sci.bib is on the screen before it is taken:
"Physical Chemistry Chemical Physics" is in neither iso4 nor sci.bib. Keys I can make of it:
pccp
physicalchemistrychemicalphysics
> physchemchemphys
physicalccp
/home/laussy/bib/doi2bib/iso4
s/Physical Chemistry Chemical Physics/physchemchemphys/
/home/laussy/bib/sci.bib
@string{physchemchemphys = "Physical Chemistry Chemical Physics"}
[Enter] to take it, up and down to pick another, or type your own (n gives up):
Typing a key of one's own still works, backspace included, and so does n. A key already in use can be moved onto and read but not taken—unless it is the journal's own key under another spelling, which is the case below: it says who holds it and goes on asking, where before it gave up with an error. The terminal is put into raw mode through POSIX::Termios, which is core perl, and where either end is not a terminal -- a pipe, a cron, standard error redirected -- the old line-at-a-time prompt is used instead, unchanged.
Two things had to be got right here, and were not at first. The handler that gives the terminal back on Ctrl-C has to be installed by the routine that takes raw mode, and not at the foot of the file, where it would sit below the main flow's exit and never run at all; a process killed by a signal runs no END block either, so without it the shell was left with no echo. And redrawing has to step the cursor up by one row fewer than the block is tall, since it is already standing on that block's last row: stepping up the full height climbed into the line above, the clear-to-end-of-screen wiped it, and the list walked up the screen a row per keystroke until it reached the top.
Where the two lines go
Neither file is a list one appends to, so j2bib works out the place rather than asking.
In iso4 the legal window comes first: a rule whose left-hand side is contained in ours would fire before it and mangle the name, so we must go above it, and a rule containing ours would be mangled by us, so we must go below it. Inside that window the new line goes and sits next to its own kind, found as the line sharing the longest opening with it. Scanning from the top for the first line that sorts after ours would land in the wrong part of the file entirely, because iso4 is only roughly alphabetical: it opens with a block of whatever was added last, and the Phys. Rev. lines are ordered by how specific they are rather than by name.
In sci.bib it is simply alphabetical by key, and every other line is left exactly as it was, trailing spaces and all.
Both files are backed up first, as sci.bib.j2bib.bak and iso4.j2bib.bak. The names are deliberately not plain .bak, which would clobber the one doi2bib -d keeps.
What a key may be
A @string name is a BibTeX macro name: it starts with a letter and holds only letters and digits. v1.0.0 tested /^\w+$/ instead, which is not the same thing at all, and two journals walked through the gap:
- a title beginning with a digit. 2D Materials proposed
2m, and BibTeX answers You're missing a string name and then skips the rest of the command — so one bad line costs the@stringlines after it as well as itself. - a bare
&in the name. In Trends in Food Science & Technology the&survived as a significant word, every candidate key therefore held one, every candidate was rejected, and the empty list left the key undefined. Under-ynobody was asked, so j2bib wrote@string{ = "..."}and, worse, aniso4rule replacing the journal name with nothing at all.
Since v1.1.0 the & is dropped like any other punctuation, which is right in any case since it means and and and was already a stop word, and a key that cannot be used stops the run instead of being written. Trends in Food Science & Technology now proposes tfst; 2D Materials proposes nothing and says so, asking for one with -k.
doi2bib calls it by itself
None of this was reachable without knowing the tool existed. Since doi2bib v0.15.0 on 11 September (2026) it is not: doi2bib now checks on every path that the journal is a key and that sci.bib defines it, and hands what it cannot resolve to j2bib. Its -j takes the proposal without asking. If j2bib is declined, or cannot be asked, the name is written in braces — valid BibTeX, so year, volume and pages survive — and the j2bib line to run is printed.
Before that, a journal with no rule went into sci.bib raw, as journal = J. Phys. F: Met. Phys.,, on which bibtex says I was expecting a `,' or a `}' and skips the remainder of the entry, silently taking the year, the volume and the pages with it.
A journal that is there already
Until v1.3.0 the only question put to the two files was whether the name given was in them, spelt exactly so, and that is the wrong question. Of the 413 @string keys in sci.bib, 203 have no iso4 rule at all, so a journal coming back from Crossref under its own spelling looked new every time it came. The case that showed it, on 13 September (2026): Crossref says Quantum Inf Process and Quantum Information Processing, sci.bib has printed qip = "Quantum Inf. Proc." for years, and j2bib offered quantuminfprocess, quaninfproc and quantumip—with qip in the list only because the initials happened to land on it, marked taken, and refused when picked. Take the first and the journal is split across two keys for good.
The names are now compared word by word, case, accents, dots, colons, TeX braces and & aside and the small words of every language dropped (of, the, der, de… but not a, which is the A of Phys. Rev. A). Two words are the same word when they are equal, when one is the truncation of the other—which is all an abbreviation is: Proc. for Processing, J. for Journal, Phys. for Physics, Physik or Physique—or, less surely, when one is a contraction of the other keeping the letters in order, Jpn. for Japanese, Natl. for National. A lone letter is a series letter and equals only itself, except at the front where J. and Z. stand for a first word; without that Phys. Rev. A would be Phys. Rev. Applied. Two names are the same journal when they have the same number of words and each pair matches, or when one is the acronym of the other (QIC). Every key sci.bib defines is tried under every spelling that leads to it, its @string value and each iso4 rule ending on it, and what matches goes to the top of the list: marked exists when every word is equal or a truncation, maybe when a contraction or an acronym was needed. Taking one writes the iso4 rules only; the @string is kept as it is, and the plan says so:
$ j2bib "Quantum Inf Process" "Quantum Information Processing"
"Quantum Inf Process" has no rule in iso4, but sci.bib has a journal that looks like it. Keys, that one first:
> qip <- exists: "Quantum Inf. Proc."
quantuminfprocess
quaninfproc
quantumip
/home/laussy/bib/doi2bib/iso4
s/Quantum Inf Process/qip/
s/Quantum Information Processing/qip/
/home/laussy/bib/sci.bib
@string{qip = "Quantum Inf. Proc."} (already there, kept)
[Enter] to take it, up and down to pick another, or type your own (n gives up):
qip reused
/home/laussy/bib/doi2bib/iso4: 2 lines before "Quantum Information Processing"
/home/laussy/bib/sci.bib: @string{qip = "Quantum Inf. Proc."} kept
journal = qip
Under -y, which is what doi2bib -j asks for and cannot be asked back on, a single exists is taken, two or more stop the run with the -k line to type (Europhys News is both epn and europhysnews), and a maybe alone is not enough to map on: a key is coined as before, with the maybe said out loud. -k onto a key sci.bib has maps onto it as told, with a note when the two do not look alike. -l says what a name looks like, not only what it is. A name that already shares a rule in iso4 with one of the spellings given is the one case with nothing to choose: the other spellings are simply mapped onto that key. And a rule ending on a key sci.bib does not define is reported and left alone—a second rule for the same name would sit below the first and never fire.
Run over every pair of keys already in the two files, the same comparison finds 22 look-alikes, most of them duplicates that got in exactly this way—epn/europhysnews, jp/jphys, rpp/repprog, anom/anmath, amstat/americanstatistician, adp/andpGE, ieeejstqe/ieeejseltopqe, communmath/comathphys, opn/optphotnews, cpc/computphyscomun, archhist/archivehistexsci, natnano/nnano—and three iso4 rules that end on a key sci.bib does not define: epjb (the key is eub), physbiol, and Philosophical Magazine, which is turned into Philos. Mag. and left there, one rule short of philmag. All of them were mended the same day. Each pair was folded into one key—the one iso4 already reached where there was one, else the better cited or the better named—and the 46 entries citing the other rewritten: rpp→repprog, jp→jphys, europhysnews→epn, anmath→anom, americanstatistician→amstat, adp→andpGE (fourteen entries print Annalen der Physik in full against four Ann. Phys., and the full name is what keeps it apart from Annales de Physique and Annals of Physics), arpc→AnnualReviewOfPhysicalChemistry, ieeejseltopqe→ieeejstqe, comathphys→communmath, opn→optphotnews, archivehistexsci→archhist, nnano→natnano, cpc→computphyscomun; eub became epjb, which is what the rule wanted and what its siblings epjd, epjp and epjST are called; physbiol got its @string; the Philosophical Magazine rule now ends on philmag, with Philos. Mag. given a rule of its own. The survivors' printed names and Crossref spellings were then given their iso4 rules through j2bib itself (j2bib -y -k epn "Europhys. News" "Europhysics News" and so on), so that none of the fourteen can come back. 413 keys became 401, bibtex resolves every one of the 46 entries, and the files as they stood before are kept as sci.bib.before-dedup-2026-09-13 and iso4.before-dedup-2026-09-13. What the comparison still pairs off is not duplicates: andpGE, andpFR and anop are three journals that all abbreviate to Ann. Phys., apr is Applied Physics Reviews and apres Applied Physics Research, and Am. Sci. is not the American Statistician.
The script
#!/usr/bin/perl
# _ ____ _ _ _
# (_)___ \| |__ (_) |__
# | | __) | '_ \| | '_ \
# | |/ __/| |_) | | |_) |
# _/ |_____|_.__/|_|_.__/
# |__/
# F.P. Laussy - [email protected]
# v1.0.0 Tue Sep 01 2026 - a doi2bib companion for the journals doi2bib does
# not know: give it a journal name that iso4 does not
# abbreviate, it proposes a bib key for it and, once
# confirmed, writes the s/<journal>/<key>/ line into
# iso4 and the @string{<key> = "<journal>"} line into
# sci.bib, both at a sensible place.
# v1.1.0 Fri Sep 11 2026 - a proposed key is now checked to be a name BibTeX
# can actually take: it must start with a letter and
# hold only letters and digits. Two journals broke
# that and were written anyway. "2D Materials"
# proposed 2m, and bibtex answers "You're missing a
# string name" and skips -- one bad @string spoils
# the block, not just its own line. Worse, a name
# with a bare "&" in it ("Trends in Food Science &
# Technology") made every candidate illegal, propose()
# returned nothing, $key was undef, and j2bib wrote
# @string{ = "..."} plus an iso4 rule that replaced
# the journal with nothing at all. "&" is now dropped
# the way every other punctuation mark is -- it means
# "and", which is already a stop word -- and a key
# that cannot be used stops the run instead of being
# written. doi2bib 0.15.0 calls j2bib on its own, so
# neither could stay a paper cut.
# v1.1.1 Fri Sep 11 2026 - when nothing can be proposed there is no key to show
# a plan for: the prompt used to print @string{ = ".."}
# under two uninitialized warnings. It says <key> now,
# and waits for one to be typed.
# v1.2.1 Fri Sep 11 2026 - the list crept up the screen, a row per keystroke,
# eating whatever was printed above it: redrawing
# stepped the cursor up by the full height of the
# block when it was already standing on the block's
# last row. One row too many, every time, until the
# top of the screen stopped it.
# v1.2.0 Fri Sep 11 2026 - the proposals can be walked with the up and down
# arrows instead of being retyped. The list, the two
# lines that would be written and the prompt are
# redrawn in place as one moves, so what each key
# would do to iso4 and sci.bib is on screen before it
# is taken. Typing a key of one's own still works,
# and so does n. A key already in use can be looked at
# but not accepted. The terminal goes into raw mode
# through POSIX::Termios, which is core, and is put
# back by an END block whatever happens; where there
# is no terminal -- a pipe, a cron -- the old
# line-at-a-time prompt is used unchanged.
# v1.3.0 Sun Sep 13 2026 - a journal sci.bib already has is no longer coined
# a second key. Only an exact spelling was looked
# for, and half the @string keys (203 of 413) have
# no iso4 rule at all, so a journal coming back from
# CrossRef under its own spelling looked new every
# time: "Quantum Inf Process" was offered
# quantuminfprocess beside qip = "Quantum Inf.
# Proc.", and qip itself, when the initials happened
# to land on it, was shown as taken and could not be
# picked. The names are now compared word by word,
# punctuation and case aside, a word matching its
# own truncation ("Proc." for "Processing", "J." for
# "Journal"); a key printing or already reached by
# such a spelling is offered first, marked "exists",
# and taking it writes the iso4 rules only -- the
# @string is kept as it is. A contraction (Jpn.,
# Natl.) or an acronym (QIC) is offered too, marked
# "maybe", but is never taken without being asked.
# Under -y a single confident match is mapped and
# several stop the run, since doi2bib -j is the one
# who asks for -y and cannot be asked back. -k onto
# an existing key maps onto it as told, with a note
# when it does not look like the journal. -l says
# what a name looks like, not only what it is. A
# name with a rule to a key sci.bib does not define
# (epjb, physbiol) is reported and left alone: a
# second rule for the same name would never fire.
#
# NOTE on the shebang: no "-s" here, on purpose. perl -s (which doi2bib does
# use) silently eats a flag written *before* the first argument; j2bib parses
# @ARGV itself so "j2bib -y Foo" and "j2bib Foo -y" both work.
#
# Usage:
# j2bib "Phys. Chem. Chem. Phys." # propose a key, ask, write
# j2bib "Phys. Chem. Chem. Phys." "Physical Chemistry Chemical Physics"
# # ... and map the long title too
# j2bib -k pccp "Phys. Chem. Chem. Phys." # I know the key I want
# j2bib -a "Phys. Chem. Chem. Phys." "Physical Chemistry Chemical Physics"
# # -a: what BibTeX should *print*
# j2bib -n "..." # dry run, touch nothing
# j2bib -y "..." # no question asked
# j2bib -l "..." # look it up, say what it is or looks like
#
# The first name given is the one that goes in the @string (i.e. the one that
# gets printed by BibTeX) unless -a says otherwise; every name given, and the
# -a one, gets its own line in iso4, so that whichever of
# "container-title-short" or "container-title" CrossRef comes back with, it
# lands on the same key. When sci.bib already has the journal under another
# spelling, the key it has is what the names are mapped onto, and no @string
# is written.
use strict;
use warnings;
use Encode qw(decode_utf8);
use Unicode::Normalize qw(NFKD);
use POSIX qw(:termios_h);
my $VERSION = "1.3.0";
my $iso4 = "/home/laussy/bib/doi2bib/iso4";
my $bibfile = "/home/laussy/bib/sci.bib";
# the small words of every language, dropped when two journal names are
# compared (words_of, at the bottom). "a" is not among them: it is the A of
# "Phys. Rev. A", and dropping it would make pra look like pr. Same for "e"
# and "Physica E".
my %small = map { $_ => 1 } qw(of the and in on for an at to
de du der die das des la le les et fur und di del della);
# ---------------------------------------------------------------- arguments
my ($key_flag, $abbrev_flag) = ('', '');
my ($dry, $yes, $lookup) = (0, 0, 0);
my @names;
while (@ARGV) {
my $arg = shift @ARGV;
if ($arg eq '-k') { $key_flag = shift @ARGV // ''; }
elsif ($arg eq '-a') { $abbrev_flag = shift @ARGV // ''; }
elsif ($arg eq '-n') { $dry = 1; }
elsif ($arg eq '-y') { $yes = 1; }
elsif ($arg eq '-l') { $lookup = 1; }
elsif ($arg eq '-h' || $arg eq '--help') { usage(0); }
elsif ($arg eq '-v' || $arg eq '--version') { print "j2bib $VERSION\n"; exit 0; }
elsif ($arg =~ /^-/) { print STDERR "j2bib: unknown flag $arg\n"; usage(-1); }
else { push @names, $arg; }
}
usage(-1) unless @names;
@names = map { my $n = decode_utf8($_); $n =~ s/^\s+|\s+$//g; $n =~ s/\s+/ /g; $n } @names;
$key_flag = decode_utf8($key_flag);
$abbrev_flag = decode_utf8($abbrev_flag); $abbrev_flag =~ s/^\s+|\s+$//g;
my $printed = $abbrev_flag ne '' ? $abbrev_flag : $names[0];
# every spelling worth mapping: the -a one first if it is not already there
my @aliases;
my %seen_alias;
for my $n ($printed, @names) {
next if $n eq '' || $seen_alias{$n}++;
push @aliases, $n;
}
binmode(STDOUT, ':utf8');
binmode(STDERR, ':utf8');
# ------------------------------------------------------- what is known already
my $iso4_nl = ends_with_newline($iso4);
my $bib_nl = ends_with_newline($bibfile);
my @iso4_lines = read_lines($iso4);
my @bib_lines = read_lines($bibfile);
# iso4 is a sed script: s/<journal>/<key>/
my %iso4_key; # journal name (as written) -> key
my @iso4_lhs; # [ line index, lhs, key ]
for my $i (0 .. $#iso4_lines) {
next unless $iso4_lines[$i] =~ m{^s/(.*)/([^/]*)/\s*$};
my ($lhs, $k) = ($1, $2);
$iso4_key{$lhs} = $k;
push @iso4_lhs, [ $i, $lhs, $k ];
}
# sci.bib: @string{key = "printed abbreviation"}
my %string_val; # key -> value
my @string_idx; # line indices of the @string block, in order
for my $i (0 .. $#bib_lines) {
next unless $bib_lines[$i] =~ /^\@string\s*\{\s*([^\s=]+)\s*=\s*"(.*)"\s*\}/;
my ($k, $v) = ($1, $2);
$string_val{$k} = $v;
push @string_idx, $i;
}
unless (@string_idx) {
print STDERR "j2bib: no \@string line found in $bibfile -- refusing to guess where to put one\n";
exit(-1);
}
# already known? A name iso4 has an exact rule for goes where the rule says,
# and if sci.bib defines that key there is nothing to add for that spelling.
my %covered; # alias -> key: iso4 has the rule, sci.bib the key
my %undefined; # alias -> key: iso4 has the rule, sci.bib no key
for my $n (@aliases) {
next unless exists $iso4_key{$n};
my $k = $iso4_key{$n};
if (exists $string_val{$k}) {
print STDERR "iso4 already abbreviates \"$n\" to $k = \"$string_val{$k}\"\n";
$covered{$n} = $k;
} else {
print STDERR "iso4 abbreviates \"$n\" to $k, but sci.bib has no \@string for it!\n";
$undefined{$n} = $k;
}
}
# the spellings without a rule are what there is to add
my @todo = grep { !$covered{$_} } @aliases;
# What sci.bib and iso4 already hold that looks like this journal: the same
# name under other punctuation, its words abbreviated or spelt out, an
# acronym. Half the keys in sci.bib have no iso4 rule at all, so a journal
# coming back from CrossRef under its own spelling looked new every time and
# was coined a second key -- quantuminfprocess beside qip = "Quantum Inf.
# Proc.". Those keys are offered first now, and taking one writes the iso4
# rules only: the @string stays as it is.
my %reuse = candidates(@todo); # key -> [ score, spelling, where seen ]
my @reuse = sort { $reuse{$b}[0] <=> $reuse{$a}[0] || $a cmp $b } keys %reuse;
my @strong = grep { $reuse{$_}[0] >= 1 } @reuse; # every word equal or truncated
my @weak = grep { $reuse{$_}[0] < 1 } @reuse; # a contraction or an acronym
if ($lookup) {
for my $k (@reuse) {
my $r = $reuse{$k};
print STDERR ($r->[0] >= 1 ? "looks like" : "might be")
. " $k = \"$string_val{$k}\""
. ($r->[2] eq 'iso4' && lc $r->[1] ne lc $string_val{$k}
? " (iso4 knows it as \"$r->[1]\")"
: (has_rule($k) ? "" : " (no iso4 rule for it)")) . "\n";
}
print STDERR "nothing known about \"$names[0]\"\n"
unless %covered || %undefined || @reuse;
exit(%covered ? 0 : @reuse ? 2 : 1);
}
# A rule that ends on a key sci.bib does not define is a broken rule, not a
# missing one: a second rule for the same name would sit below it and never
# fire. Say so and stop; mending it is a one-line edit by hand.
if (%undefined) {
for my $n (sort keys %undefined) {
my @same = grep { lc $string_val{$_} eq lc $n } sort keys %string_val;
print STDERR "iso4 sends \"$n\" to $undefined{$n}, which sci.bib does not "
. "define" . (@same ? "; " . join(" and ", @same) . " print"
. (@same > 1 ? "" : "s") . " that very name"
: "")
. ". Mend the rule by hand, or add the \@string.\n";
}
exit(-1);
}
unless (@todo) {
print STDERR "nothing to do (use -l to just look things up)\n";
exit(0);
}
# a key some of the names already go to is the one the others are mapped onto
my %forced = map { $_ => 1 } values %covered;
if (keys %forced > 1) {
print STDERR "the names given already go to different keys ("
. join(", ", sort keys %forced) . "): nothing to do here\n";
exit(-1);
}
my ($forced) = keys %forced;
if ($forced) {
if ($key_flag ne '' && $key_flag ne $forced) {
print STDERR "the journal already goes to $forced in iso4; -k $key_flag "
. "would split it in two\n";
exit(-1);
}
my ($via) = grep { ($covered{$_} // '') eq $forced } @aliases;
$reuse{$forced} = [ 3, $via, 'iso4' ];
}
# -k onto a key sci.bib has: mapping onto it is the whole point, but say so
# when the two do not look alike, so that a slip of the finger shows
if ($key_flag ne '' && exists $string_val{$key_flag} && !$reuse{$key_flag}) {
print STDERR "$key_flag is a key already, printing \"$string_val{$key_flag}\", "
. "which does not look like \"$printed\" -- mapping onto it as told\n";
$reuse{$key_flag} = [ 0, $string_val{$key_flag}, 'string' ];
}
# -------------------------------------------------------------- propose a key
my @proposals = $forced ? ($forced)
: (@reuse, grep { !$reuse{$_} } propose($printed));
@proposals = ($key_flag) if $key_flag ne '';
# -y is doi2bib -j, with nobody to ask back: one confident match is taken, two
# are too many to guess between, a maybe is not enough to map on
if ($yes && !$forced && $key_flag eq '') {
if (@strong > 1) {
print STDERR "\"$printed\" looks like more than one journal sci.bib "
. "already has:\n";
print STDERR " $_ = \"$string_val{$_}\"\n" for @strong;
print STDERR "say which one: j2bib -k <key>"
. join("", map { " \"$_\"" } @aliases) . "\n";
exit(-1);
}
if (@weak && !@strong) {
print STDERR "\"$printed\" might be " . join(" or ",
map { "$_ = \"$string_val{$_}\"" } @weak)
. " -- not sure enough to map onto it unasked, coining a key\n";
}
}
my $default = '';
if ($forced) { $default = $forced }
elsif (@strong) { $default = $strong[0] }
else {
for my $p (@proposals) { if (!taken($p) || $reuse{$p}) { $default = $p; last; } }
$default = $proposals[0] if $default eq '' && @proposals;
}
# With a terminal at both ends the list is walked with the arrows and drawn by
# choose(), which redraws it on every keystroke; the static listing below is for
# everywhere else. -k means a key was named, so there is nothing to choose from,
# and a journal that already has its key in iso4 leaves nothing to choose either.
my $arrows = !$yes && $key_flag eq '' && !$forced && -t STDIN && -t STDERR;
unless ($yes || $key_flag ne '' || $arrows) {
print STDERR headline(), "\n";
for my $p (@proposals) {
printf STDERR " %-24s%s\n", $p, mark_of($p);
}
}
my $key = $key_flag ne '' ? $key_flag : $default;
# Nothing usable, and -y or -k means there is nobody to ask: stop here rather
# than write a line bibtex will refuse. doi2bib calls j2bib with -y, so this is
# the path a journal like "2D Materials" takes when nobody is at the terminal.
if (!legal_key($key) && ($yes || $key_flag ne '')) {
if ($key_flag ne '') {
print STDERR "\"$key_flag\" cannot be a \@string name: it has to start "
. "with a letter and hold only letters and digits\n";
} else {
print STDERR "no usable key can be made of \"$printed\": a \@string name "
. "has to start with a letter and hold only letters and "
. "digits\n";
print STDERR "say which one you want: j2bib -k <key>"
. join("", map { " \"$_\"" } @aliases) . "\n";
}
exit(-1);
}
# ------------------------------------------------------------------- confirm
unless ($yes) {
if ($arrows && raw_on()) {
$key = choose($key);
raw_off();
} else {
while (1) {
show_plan($key);
print STDERR "\n" . ($forced ? "[Enter] to write it, or n to give up: "
: "[Enter] to accept, another key to use it, or n to give up: ");
my $answer = <STDIN>;
if (!defined $answer) { print STDERR "\n"; exit(1); }
chomp $answer;
$answer =~ s/^\s+|\s+$//g;
if ($answer eq '') {
last if legal_key($key);
print STDERR "there is no key there to accept: type the one you want\n";
next;
}
if ($answer =~ /^(n|no|q|quit)$/i) { print STDERR "nothing written\n"; exit(1); }
if ($forced) {
print STDERR "the journal already goes to $forced; there is nothing "
. "else to pick\n";
next;
}
$answer = decode_utf8($answer);
if (!legal_key($answer)) {
print STDERR "\"$answer\" cannot be a \@string name: it has to start "
. "with a letter and hold only letters and digits\n";
next;
}
if (taken($answer) && !$reuse{$answer}) {
print STDERR "$answer is taken already by "
. (exists $string_val{$answer} ? "\"$string_val{$answer}\""
: "a line in iso4")
. " -- pick another one\n";
next;
}
$key = $answer;
}
}
} else {
show_plan($key);
}
if (!legal_key($key)) {
print STDERR "refusing to write \"$key\": a \@string name has to start with "
. "a letter and hold only letters and digits\n";
exit(-1);
}
if (taken($key) && !$reuse{$key}) {
print STDERR "$key is taken already -- pick another one\n";
exit(-1);
}
print STDERR "-a ignored: $key already prints \"$string_val{$key}\"\n"
if $abbrev_flag ne '' && $reuse{$key} && lc $abbrev_flag ne lc $string_val{$key};
if ($dry) { print STDERR "\n-n: nothing written\n"; exit(0); }
# --------------------------------------------------------------------- write
backup($iso4);
backup($bibfile) unless $reuse{$key}; # sci.bib is not touched when a key is reused
# iso4 -- order matters, it is a sed script read top to bottom: a rule whose
# left-hand side is contained in ours would fire first and eat our name, so we
# go above it; a rule whose left-hand side contains ours would be eaten by us,
# so we go below it.
my @new_iso4 = @iso4_lines;
my $added_at = '';
for my $alias (reverse @todo) { # reverse: they end up in the given order
my $line = "s/" . sed_lhs($alias) . "/$key/";
my ($pos, $why) = iso4_position($alias, \@new_iso4);
splice(@new_iso4, $pos, 0, $line);
$added_at = $why;
# the freshly inserted line must be seen by the next round
@iso4_lhs = ();
for my $i (0 .. $#new_iso4) {
next unless $new_iso4[$i] =~ m{^s/(.*)/([^/]*)/\s*$};
push @iso4_lhs, [ $i, $1, $2 ];
}
}
write_lines($iso4, \@new_iso4, $iso4_nl);
# sci.bib -- the @string block is alphabetical by key, near enough; slot the
# new one in where its key belongs and leave every other line exactly as it is.
# A key reused needs no line: the one it has is the point.
my $after = '';
my $before = '';
unless ($reuse{$key}) {
my @new_bib = @bib_lines;
my $bibpos = $string_idx[-1] + 1;
for my $i (@string_idx) {
$new_bib[$i] =~ /^\@string\s*\{\s*([^\s=]+)/ or next;
if (lc($1) gt lc($key)) { $bibpos = $i; $before = $1; last; }
$after = $1;
}
splice(@new_bib, $bibpos, 0, "\@string{$key = \"$printed\"}");
write_lines($bibfile, \@new_bib, $bib_nl);
}
print STDERR "\n$key " . ($reuse{$key} ? "reused" : "added") . "\n";
print STDERR " $iso4: " . scalar(@todo) . " line" . (@todo > 1 ? "s" : "") . " $added_at\n";
print STDERR " $bibfile: "
. ($reuse{$key} ? "\@string{$key = \"$string_val{$key}\"} kept"
: $before ne '' ? ($after ne '' ? "between $after and $before" : "before $before")
: "at the end of the \@string block, after $after") . "\n";
print STDERR "journal = $key\n";
exit(0);
# ----------------------------------------------------------------- functions
sub usage {
my $rc = shift;
print STDERR <<"END";
j2bib $VERSION -- teach doi2bib a journal it does not know
j2bib [-k key] [-a "Printed Abbrev."] [-n] [-y] [-l] "Journal" ["Alias" ...]
-k key the key to use, no proposals asked for
-a name the abbreviation BibTeX should print (default: the first name given)
-n dry run: say what would be written, write nothing
-y do not ask
-l look the journal up in iso4 and sci.bib, say what it is or
looks like, and stop there
j2bib "Phys. Chem. Chem. Phys."
j2bib "Phys. Chem. Chem. Phys." "Physical Chemistry Chemical Physics"
Every name given gets its own s/name/key/ line in
$iso4
(so that either of CrossRef's "container-title-short" and "container-title"
lands on the key), and the printed one a single
\@string{key = "name"}
in $bibfile. A journal sci.bib already has under another spelling -- the
words abbreviated or spelt out, other punctuation -- is offered its existing
key first, marked "exists"; taking it writes the iso4 lines only and keeps
the \@string as it is. A contraction or an acronym is offered as "maybe".
END
exit($rc);
}
sub read_lines {
my $f = shift;
open(my $fh, '<:encoding(UTF-8)', $f) or die "j2bib: cannot read $f: $!\n";
my @l = <$fh>;
close $fh;
chomp @l;
return @l;
}
# sci.bib ends on a bare "}" with no newline after it and doi2bib keeps it
# that way; whatever the file did, do it again
sub ends_with_newline {
my $f = shift;
open(my $fh, '<:raw', $f) or die "j2bib: cannot read $f: $!\n";
return 1 unless -s $f;
seek($fh, -1, 2);
read($fh, my $last, 1);
close $fh;
return $last eq "\n" ? 1 : 0;
}
sub write_lines {
my ($f, $l, $trailing_nl) = @_;
$trailing_nl = 1 unless defined $trailing_nl;
open(my $out, '>:encoding(UTF-8)', $f) or die "j2bib: cannot write $f: $!\n";
my $text = join("\n", @$l);
$text .= "\n" if $trailing_nl;
print $out $text;
close $out;
}
sub backup {
my $f = shift;
# not plain .bak: doi2bib -d keeps sci.bib.bak and iso4.bak is his own
open(my $in, '<:raw', $f) or die "j2bib: cannot read $f: $!\n";
open(my $out, '>:raw', "$f.j2bib.bak") or die "j2bib: cannot back up $f: $!\n";
local $/;
my $all = <$in>;
print $out $all;
close $in; close $out;
}
# ------------------------------------------------------- choosing with arrows
# The terminal, put into raw mode so that a keystroke arrives without waiting
# for Enter, and put back whatever happens -- j2bib is usually run by doi2bib,
# and a shell left in raw mode is a shell nobody can type in. POSIX::Termios is
# core; ISIG is deliberately left alone so Ctrl-C still works, and the handler
# below is what tidies up after it.
{
my ($raw_fd, $raw_saved);
sub raw_on {
return 0 unless -t STDIN;
$raw_fd = fileno(STDIN);
return 0 unless defined $raw_fd && $raw_fd >= 0;
my $saved = POSIX::Termios->new;
eval { $saved->getattr($raw_fd); 1 } or return 0;
my $now = POSIX::Termios->new;
eval { $now->getattr($raw_fd); 1 } or return 0;
$now->setlflag($now->getlflag & ~(ECHO | ICANON));
$now->setcc(VMIN, 1);
$now->setcc(VTIME, 0);
eval { $now->setattr($raw_fd, TCSANOW); 1 } or return 0;
$raw_saved = $saved;
# Ctrl-C is still Ctrl-C -- ISIG was left alone on purpose -- but a
# process killed by a signal runs no END block, so without a handler
# here the terminal would stay raw and the shell would be unusable.
# The handler belongs in raw_on and nowhere else: written at file
# scope it would sit below the main flow's exit and never run at all.
$SIG{INT} = $SIG{TERM} = $SIG{HUP} =
sub { raw_off(); print STDERR "\n"; exit(1) };
return 1;
}
sub raw_off {
return unless $raw_saved;
eval { $raw_saved->setattr($raw_fd, TCSANOW) };
$raw_saved = undef;
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = 'DEFAULT';
}
}
END { raw_off() }
# One keystroke. An arrow arrives as ESC [ A or ESC O A, and a terminal that
# has been told about modifiers sends ESC [ 1 ; 5 A, so the digits and
# semicolons in the middle are swallowed before the letter is read.
sub read_key {
my $c = getc(STDIN);
return undef unless defined $c;
return $c unless $c eq "\e";
my $c2 = getc(STDIN);
return 'OTHER' unless defined $c2 && ($c2 eq '[' || $c2 eq 'O');
my $c3 = getc(STDIN);
return 'OTHER' unless defined $c3;
while ($c3 =~ /[0-9;]/) {
my $n = getc(STDIN);
last unless defined $n;
$c3 = $n;
}
return 'UP' if $c3 eq 'A';
return 'DOWN' if $c3 eq 'B';
return 'OTHER';
}
# How wide the terminal is, so that redrawing can step back over exactly as
# many rows as were printed even when a long path has wrapped.
sub term_cols {
my $c = $ENV{COLUMNS};
if (!$c) { $c = `tput cols 2>/dev/null`; chomp $c if defined $c; }
return 80 unless defined $c && $c =~ /^\d+$/ && $c > 20;
return $c;
}
sub rows_of {
my ($len, $w) = @_;
return 1 if $len <= 0;
return int(($len - 1) / $w) + 1;
}
# The list, the two lines that would be written, and the prompt, as one block.
# The plan is built round whichever key is under the marker, so moving the
# marker shows what that key would actually do before it is taken.
sub render {
my ($i, $typed, $note) = @_;
my $w = term_cols();
my $k = $typed ne '' ? $typed : (@proposals ? $proposals[$i] : '');
my @l;
push @l, headline();
for my $n (0 .. $#proposals) {
my $q = $proposals[$n];
push @l, sprintf(" %s %-24s%s",
($typed eq '' && $n == $i) ? ">" : " ", $q, mark_of($q));
}
my $shown = legal_key($k) ? $k : "<key>";
push @l, "";
push @l, " $iso4";
push @l, " s/" . sed_lhs($_) . "/$shown/" for @todo;
push @l, " $bibfile";
push @l, " " . string_line($shown);
push @l, "";
push @l, $note if defined $note && $note ne '';
my $prompt = "[Enter] to take it"
. (@proposals > 1 ? ", up and down to pick another" : "")
. ", or type your own (n gives up): " . $typed;
print STDERR join("\n", @l), "\n", $prompt;
my $rows = 0;
$rows += rows_of(length($_), $w) for @l;
$rows += rows_of(length($prompt), $w);
return $rows;
}
# Walk the proposals. Returns the key to write; gives up by exiting, as the
# typed prompt does.
sub choose {
my $start = shift;
my $i = 0;
for my $n (0 .. $#proposals) { if ($proposals[$n] eq $start) { $i = $n; last } }
my ($typed, $note, $rows) = ('', '', 0);
while (1) {
# The cursor is on the LAST row of the block just drawn, so getting
# back to its first row is one row fewer than the block is tall.
# Stepping up $rows instead climbed one row into whatever stood above,
# and the \e[J then wiped it: the block walked up the screen on every
# keystroke until it reached the top and stuck there.
if ($rows) {
print STDERR "\e[" . ($rows - 1) . "A" if $rows > 1;
print STDERR "\r\e[J";
}
$rows = render($i, $typed, $note);
$note = '';
my $c = read_key();
if (!defined $c || $c eq "\x03" || $c eq "\x04") { give_up() }
if ($c eq 'UP' || $c eq 'DOWN') {
next unless @proposals;
$typed = '';
$i = ($i + ($c eq 'UP' ? -1 : 1)) % @proposals;
next;
}
if ($c eq "\r" || $c eq "\n") {
give_up() if $typed =~ /^(n|no|q|quit)$/i;
my $pick = $typed ne '' ? $typed : (@proposals ? $proposals[$i] : '');
if (!legal_key($pick)) {
$note = $pick eq ''
? "there is no key there to accept: type one"
: "\"$pick\" cannot be a \@string name: a letter first, "
. "then letters and digits";
$typed = '';
next;
}
if (taken($pick) && !$reuse{$pick}) {
$note = "$pick is taken already by "
. (exists $string_val{$pick} ? "\"$string_val{$pick}\""
: "a line in iso4")
. " -- pick another one";
$typed = '';
next;
}
print STDERR "\n";
return $pick;
}
if ($c eq "\x7f" || $c eq "\x08") { $typed =~ s/.$//; next }
$typed .= $c if $c =~ /^[[:print:]]$/;
}
}
sub give_up {
raw_off();
print STDERR "\nnothing written\n";
exit(1);
}
# What BibTeX will take as an @string name: a letter, then letters and digits.
# /^\w+$/ -- what this used to test -- also passes "2m", "_x" and the empty
# string, and bibtex then says "You're missing a string name" and skips the
# whole command, which takes the @string lines after it down too.
sub legal_key {
my $k = shift;
return defined $k && $k =~ /^[A-Za-z][A-Za-z0-9]*$/ ? 1 : 0;
}
sub taken {
my $k = shift;
return 1 if exists $string_val{$k};
for my $r (@iso4_lhs) { return 1 if $r->[2] eq $k; }
return 0;
}
# a name is a sed left-hand side: guard what would change the match or the
# s/// parsing. The dots are left alone on purpose -- every line already in
# iso4 writes "Phys. Rev." with bare dots, and matching any character there
# has never been a problem in practice.
sub sed_lhs {
my $s = shift;
$s =~ s{([\\/\[\]*^\$])}{\\$1}g;
return $s;
}
# where in iso4 the rule for $name has to go
sub iso4_position {
my ($name, $lines) = @_;
my ($floor, $ceiling) = (-1, scalar @$lines); # after floor, before ceiling
for my $r (@iso4_lhs) {
my ($i, $lhs) = ($r->[0], $r->[1]);
next if $lhs eq $name;
# a shorter rule contained in ours would fire first and mangle us
$ceiling = $i if index($name, $lhs) >= 0 && $i < $ceiling;
# a longer rule containing ours would be mangled by us
$floor = $i if index($lhs, $name) >= 0 && $i > $floor;
}
if ($floor >= $ceiling) {
print STDERR "j2bib: \"$name\" is caught between iso4 lines "
. ($floor+1) . " and " . ($ceiling+1) . "; putting it above the first\n";
return ($ceiling, "at line " . ($ceiling+1) . " (contested)");
}
# Inside that window, go and sit next to one's own kind. iso4 is only
# roughly alphabetical -- it opens with a block of whatever was added last,
# and the Phys. Rev. lines are ordered by how specific they are, not by
# name -- so scanning from the top for the first line that sorts after ours
# lands in the wrong part of the file. The line sharing the longest opening
# with ours is the right neighbour: "Phys. Chem. Chem. Phys." shares
# "Phys. " with the Phys. Rev. block and only "Phys" with "Physics Reports".
my ($best, @kin) = (0);
for my $r (@iso4_lhs) {
my ($i, $lhs) = ($r->[0], $r->[1]);
next if $i <= $floor || $i >= $ceiling;
my $n = 0;
$n++ while $n < length($name) && $n < length($lhs)
&& lc substr($name, $n, 1) eq lc substr($lhs, $n, 1);
if ($n > $best) { $best = $n; @kin = (); }
push @kin, [ $i, $lhs ] if $n == $best;
}
# nothing in common with anything: fall back on the plain alphabetical spot
@kin = grep { $_->[0] > $floor && $_->[0] < $ceiling } map { [ $_->[0], $_->[1] ] } @iso4_lhs
if $best == 0;
my ($pos, $why) = ($ceiling, "at the end");
my $prev;
for my $k (@kin) { # the last one sorting before us
$prev = $k if lc $k->[1] lt lc $name;
}
if ($prev) {
($pos, $why) = ($prev->[0] + 1, "after \"$prev->[1]\"");
} elsif (@kin) {
($pos, $why) = ($kin[0][0], "before \"$kin[0][1]\"");
}
return ($pos, $why);
}
# candidate keys, best first
sub propose {
my $name = shift;
my %stop = map { $_ => 1 } qw(of and the in on for a an at to de du der die das
part section series journal-of new);
my @words;
for my $w (split /\s+/, $name) {
$w =~ s/[^\w]//g; # drop dots, colons, parentheses, &
next if $w eq '';
push @words, $w;
}
my @sig = grep { !$stop{lc $_} } @words;
@sig = @words unless @sig;
my @out;
# 1. the initials: "Phys. Chem. Chem. Phys." -> pccp, and it is also what
# gives jcis for "Journal of Colloid and Interface Science"
push @out, join('', map { lc substr($_, 0, 1) } @sig);
# 2. the words run together, as they are written: -> physchemchemphys
push @out, lc join('', @sig);
# 3. the words cut to four letters: -> physchemchemphys too here, but
# advopticsphotonics -> advoptipho
push @out, lc join('', map { substr($_, 0, 4) } @sig);
# 4. first word whole, then initials: -> physccp
push @out, lc($sig[0]) . join('', map { lc substr($_, 0, 1) } @sig[1 .. $#sig])
if @sig > 1;
my (@uniq, %seen);
for my $p (@out) {
next if !legal_key($p) || $seen{$p}++;
push @uniq, $p;
}
return @uniq;
}
sub show_plan {
my $k = shift;
# nothing could be proposed: show the shape of the two lines, not a plan
# built round an empty key
$k = "<key>" unless legal_key($k);
print STDERR "\n $iso4\n";
print STDERR " s/" . sed_lhs($_) . "/$k/\n" for @todo;
print STDERR " $bibfile\n";
print STDERR " " . string_line($k) . "\n";
}
# the @string line the plan shows: the one that would be written, or the one
# that is there already and stays
sub string_line {
my $k = shift;
return $reuse{$k} ? "\@string{$k = \"$string_val{$k}\"} (already there, kept)"
: "\@string{$k = \"$printed\"}";
}
# the first line of the listing, whichever way it is drawn
sub headline {
return "\"$printed\" already goes to $forced in iso4, and the other spelling"
. (@todo > 1 ? "s" : "") . " given will too:" if $forced;
return "\"$printed\" has no rule in iso4, but sci.bib has "
. (@reuse > 1 ? "journals that look like it. Keys, those first:"
: "a journal that looks like it. Keys, that one first:")
if @reuse;
return @proposals
? "\"$printed\" is in neither iso4 nor sci.bib. Keys I can make of it:"
: "\"$printed\" is in neither iso4 nor sci.bib, and no key can be made "
. "of it: type one.";
}
# what stands after a key in the listing: an existing key it could be, a key
# that is taken by something else, or nothing
sub mark_of {
my $q = shift;
if ($reuse{$q}) {
my $r = $reuse{$q};
my $m = " <- " . ($r->[0] >= 1 ? "exists" : "maybe") . ": \"$string_val{$q}\"";
$m .= " (iso4 knows it as \"$r->[1]\")"
if $r->[2] eq 'iso4' && lc $r->[1] ne lc $string_val{$q};
return $m;
}
return taken($q) ? " <- taken: "
. (exists $string_val{$q} ? "\"$string_val{$q}\"" : "in iso4") : "";
}
sub has_rule {
my $k = shift;
for my $r (@iso4_lhs) { return 1 if $r->[2] eq $k; }
return 0;
}
# --------------------------------------------- does sci.bib have it already?
# Every key sci.bib defines, under every spelling that leads to it -- the
# @string value itself and each iso4 rule that ends on it -- against the names
# given. Returns key -> [ score, the spelling that matched, where it was seen ].
sub candidates {
my @names = @_;
my @spell = map { [ $string_val{$_}, $_, 'string' ] } keys %string_val;
push @spell, map { [ $_->[1], $_->[2], 'iso4' ] }
grep { exists $string_val{$_->[2]} } @iso4_lhs;
my %best;
for my $n (@names) {
for my $sp (@spell) {
my $sc = similar($n, $sp->[0]);
next unless $sc;
my $k = $sp->[1];
$best{$k} = [ $sc, $sp->[0], $sp->[2] ]
if !$best{$k} || $best{$k}[0] < $sc;
}
}
return %best;
}
# A name cut into the words that carry it: case, accents, dots, colons,
# TeX braces and "&" gone, and the small words of every language (%small, set
# up at the top: a "my" down here would still be empty when the main flow
# calls this) dropped.
sub words_of {
my $s = shift;
$s = NFKD($s);
$s =~ s/\p{Mn}//g;
$s =~ s/&/ /g;
$s =~ s/\\[A-Za-z]+//g;
$s =~ s/[\\'"`^~]//g;
$s = lc $s;
$s =~ s/[^a-z0-9]+/ /g;
return grep { $_ ne '' && !$small{$_} } split ' ', $s;
}
# Two words for the same one: equal (2), one the truncation of the other (1),
# which is what an abbreviation is -- "Proc." for "Processing", "J." for
# "Journal", "Phys." for "Physics", "Physik" or "Physique" -- or a contraction
# keeping the letters in order (0.5): "Jpn." for "Japanese", "Natl." for
# "National". A lone letter is a series letter and equals only itself, except
# at the front, where "J." and "Z." stand for a journal's first word; without
# that "Phys. Rev. A" would match "Phys. Rev. Applied".
sub word_match {
my ($a, $b, $first) = @_;
return 2 if $a eq $b;
my ($short, $long) = length $a <= length $b ? ($a, $b) : ($b, $a);
return 0 if length($short) == 1 && !$first;
return 1 if index($long, $short) == 0;
return 0 unless length($short) >= 3 && substr($short, 0, 1) eq substr($long, 0, 1);
my $i = 0;
for my $c (split //, $short) {
$i = index($long, $c, $i);
return 0 if $i < 0;
$i++;
}
return 0.5;
}
# How much two journal names look like the same journal: 0 when they do not,
# 3 when they are the same words, else the average word score when they have
# the same number of words and each pair matches -- 1 or more when every word
# is equal or a truncation, less than 1 when a contraction was needed.
# One word of letters against the initials of the other's words is an
# acronym, 0.5: QIC for "Quantum Inf. Comput.".
sub similar {
my ($x, $y) = @_;
my @a = words_of($x);
my @b = words_of($y);
return 0 unless @a && @b;
return 3 if "@a" eq "@b";
if (@a == @b) {
my ($t, $contracted) = (0, 0);
for my $i (0 .. $#a) {
my $m = word_match($a[$i], $b[$i], $i == 0);
return 0 unless $m;
$t += $m;
$contracted = 1 if $m < 1;
}
# one contraction anywhere and the whole is a maybe: "Am. Sci." would
# otherwise average above 1 against "American Statistician"
return $contracted ? $t / @a / 4 : $t / @a;
}
for my $p ([ \@a, \@b ], [ \@b, \@a ]) {
my ($one, $many) = @$p;
next unless @$one == 1 && @$many >= 2 && $one->[0] =~ /^[a-z]{2,}$/;
return 0.5 if $one->[0] eq join('', map { substr($_, 0, 1) } @$many);
}
return 0;
}