summaryrefslogtreecommitdiff
path: root/support/crossrefware/bbl2bib.pl
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/crossrefware/bbl2bib.pl
Initial commit
Diffstat (limited to 'support/crossrefware/bbl2bib.pl')
-rwxr-xr-xsupport/crossrefware/bbl2bib.pl350
1 files changed, 350 insertions, 0 deletions
diff --git a/support/crossrefware/bbl2bib.pl b/support/crossrefware/bbl2bib.pl
new file mode 100755
index 0000000000..397e52a6af
--- /dev/null
+++ b/support/crossrefware/bbl2bib.pl
@@ -0,0 +1,350 @@
+#!/usr/bin/env perl
+
+=pod
+
+=head1 NAME
+
+bbl2bib.pl - convert thebibliography environment to a bib file
+
+=head1 SYNOPSIS
+
+bbl2bib.pl [-d] [-u] [B<-o> I<output>] I<file>
+
+=head1 OPTIONS
+
+=over 4
+
+=item [-d]
+
+Send debugging output to stdout
+
+=item B<-o> I<output>
+
+Output file. If this option is not used, the name for the
+output file is formed by changing the extension to C<.bib>
+
+
+=item B<-u>
+
+Do not clean URL fields.
+
+Normally C<bbl2bib> recognizes URL fields of the kind
+C<http://dx.doi.org> and their variants and converts them to DOI
+fields (see also L<biburl2doi(1)> script). The switch B<-u>
+suppresses this cleanup.
+
+=back
+
+=head1 DESCRIPTION
+
+The script tries to reconstruct a C<bib> file from the corresponding
+C<thebibliography> environment. One can argue that this operation is
+akin to reconstructing a cow from the steak. The way the script does
+it is searching for the entry in the MR database, and
+creating the corresponding BibTeX fields.
+
+The script reads a TeX or Bbl file and extracts from it the
+C<thebibliography> environment. For each bibitem it creates a plain
+text bibliography entry, and then tries to match it in
+the database.
+
+=head1 INPUT FILE
+
+We assume some structure of the input file:
+
+=over 4
+
+=item 1.
+
+The bibliography is contained between the lines
+
+ \begin{thebibliography}...
+
+and
+
+ \end{thebibliography}
+
+=item 2.
+
+Each bibliography item starts from the line
+
+ \bibitem[...]{....}
+
+=back
+
+
+
+=head1 EXAMPLES
+
+ bbl2bib -o - file.tex > result.bib
+ bbl2bib -o result.bib file.bbl
+ bbl2bib file.tex
+
+=head1 AUTHOR
+
+Boris Veytsman
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2014-2017 Boris Veytsman
+
+This is free software. You may redistribute copies of it under the
+terms of the GNU General Public License
+L<http://www.gnu.org/licenses/gpl.html>. There is NO WARRANTY, to the
+extent permitted by law.
+
+=cut
+
+use strict;
+BEGIN {
+ # find files relative to our installed location within TeX Live
+ chomp(my $TLMaster = `kpsewhich -var-value=SELFAUTOPARENT`); # TL root
+ if (length($TLMaster)) {
+ unshift @INC, "$TLMaster/texmf-dist/scripts/bibtexperllibs";
+ }
+}
+use IO::File;
+use BibTeX::Parser;
+use FileHandle;
+use LaTeX::ToUnicode qw (convert);
+use Getopt::Std;
+use URI::Escape;
+use LWP::Simple;
+# Sometimes AMS forgets to update certificates
+$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0;
+
+
+my $USAGE="USAGE: $0 [-d] [-u] [-o output] file\n";
+my $VERSION = <<END;
+bbl2bib v2.3
+This is free software. You may redistribute copies of it under the
+terms of the GNU General Public License
+http://www.gnu.org/licenses/gpl.html. There is NO WARRANTY, to the
+extent permitted by law.
+$USAGE
+END
+our %opts;
+getopts('do:huV',\%opts) or die $USAGE;
+
+if ($opts{h} || $opts{V}){
+ print $VERSION;
+ exit 0;
+}
+
+################################################################
+# Defaults and parameters
+################################################################
+
+my $inputfile = shift;
+
+my $outputfile = $inputfile;
+
+$outputfile =~ s/\.([^\.]*)$/.bib/;
+
+if (exists $opts{o}) {
+ $outputfile = $opts{o};
+}
+
+my $debug=0;
+if ($opts{d}) {
+ $debug=1;
+}
+
+my $cleanUrls = 1;
+if ($opts{u}) {
+ $cleanUrls = 0;
+}
+
+my $input= IO::File->new($inputfile) or
+ die "Cannot find Bbl or TeX file $inputfile\n$USAGE\n";
+my $output = IO::File->new("> $outputfile") or
+ die "Cannot write to $outputfile\n$USAGE\n";
+
+my $userAgent = LWP::UserAgent->new;
+
+
+# Bibitem is a hash with the entries 'key', 'text', 'mr',
+# 'zbl'
+my $bibitem;
+
+while (<$input>) {
+ if (!(/\\begin\{thebibliography\}/../\\end\{thebibliography\}/) ||
+ /\\begin\{thebibliography\}/ || /\\end\{thebibliography\}/) {
+ next;
+ }
+ if (/\\bibitem\s*(\[[^\]]*\])?\{([^\}]*)\}/) {
+ ProcessBibitem($bibitem);
+ $bibitem = undef;
+ $bibitem->{key}=$2;
+ $bibitem->{text}="";
+ }
+ if (!/^\s*$/) {
+ $bibitem -> {text} .= $_;
+ }
+}
+ProcessBibitem($bibitem);
+
+
+exit 0;
+
+sub ProcessBibitem {
+ my $bibitem = shift;
+ my $key = $bibitem->{key};
+ my $text=$bibitem->{text};
+
+ if ($debug) {
+ print STDOUT "DEBUG: Processing item $key\n";
+ }
+
+ if (!length($text) || $text =~ /^\s+$/s) {
+ if ($debug) {
+ print STDOUT "DEBUG: No text found\n";
+ }
+ return;
+ }
+
+ my $printtext = $text;
+ $printtext =~ s/^(.)/% $1/mg;
+ print $output "$printtext";
+ $text =~ s/\n/ /mg;
+ $text =~ s/\\bibitem(\[[^\]]*\])?\{[^\}]*\}//;
+
+ # Arxiv entry?
+ if ($text =~ s/\\arxiv\{([^\}]+)\}\.?//) {
+ if ($debug) {
+ print STDOUT "DEBUG: Found arXiv number $1\n";
+ }
+ $bibitem->{arxiv}=$1;
+ }
+
+ # Mr number exists?
+ if ($text =~ s/\\mr\{([^\}]+)\}\.?//) {
+ if ($debug) {
+ print STDOUT "DEBUG: Found mr number $1\n";
+ }
+ $bibitem->{mr}=$1;
+ }
+
+ # zbl number exists?
+ if ($text =~ s/\\zbl\{([^\}]+)\}\.?//) {
+ if ($debug) {
+ print STDOUT "DEBUG: Found zbl number $1\n";
+ }
+ $bibitem->{zbl}=$1;
+ }
+
+ # doi number exists?
+ if ($text =~ s/\\doi\{([^\}]+)\}\.?//) {
+ if ($debug) {
+ print STDOUT "DEBUG: Found doi $1\n";
+ }
+ $bibitem->{doi}=$1;
+ }
+
+ $bibitem->{bib} = SearchMref($bibitem);
+
+ if ($cleanUrls) {
+ $bibitem->{bib} = CleanUrl ($bibitem->{bib});
+ }
+
+ PrintBibitem($bibitem);
+ return;
+}
+
+
+sub SearchMref {
+ my $bibitem = shift;
+ my $mirror = "http://www.ams.org/mathscinet-mref";
+ my $string=uri_escape_utf8($bibitem->{text});
+ if ($debug) {
+ print STDOUT "Sending $mirror?ref=$string".'&'."dataType=bibtex\n"
+ }
+ my $response = $userAgent->get("$mirror?ref=$string&dataType=bibtex") ->
+ decoded_content();
+ if ($debug) {
+ print STDOUT "DEBUG: Response $response\n";
+ }
+ if ($response =~ /<pre>(.*)<\/pre>/s) {
+ my $bib= $1;
+ # Looks like Mathscinet sometimes fails to unaccent text.
+ # For the time being we just delete the offending characters.
+ # Should probably write LaTeX::FromUnicode instead
+ $bib =~ s/[^\x00-\x7f]//g;
+ if ($debug) {
+ print STDOUT "DEBUG: got $bib\n";
+ }
+ my $fh = new FileHandle;
+ open $fh, "<", \$bib;
+ my $parser = new BibTeX::Parser($fh);
+ my $entry = $parser->next;
+ if (ref($entry) && $entry->parse_ok()) {
+ $entry->key($bibitem->{key});
+ return ($entry);
+ } else {
+ if ($debug) {
+ if (!ref($entry)) {
+ print STDERR "DEBUG: not a reference\n";
+ } else{
+ print STDERR "DEBUG: parsing $entry->parse_ok\n";
+ }
+ }
+ }
+ } else {
+ if ($debug) {
+ print STDOUT "DEBUG: did not get an entry\n";
+ }
+ }
+}
+
+sub CleanUrl {
+ my $entry = shift;
+ if (!ref($entry)) {
+ return $entry;
+ }
+
+ if ($entry->has('doi')) {
+ return $entry;
+ }
+ if (!$entry->has('url')) {
+ return $entry;
+ }
+ if ($entry->field('url') =~ m|^http(?:s)?://(?:dx\.)?doi\.org/(.*)$|) {
+ $entry->field('doi', $1);
+ delete $entry->{'url'};
+ }
+ return $entry;
+
+}
+
+
+sub PrintBibitem {
+ print $output "\n";
+ my $bibitem = shift;
+ if (!ref($bibitem->{bib})) {
+ return;
+ }
+ my $entry=$bibitem->{bib};
+ if ($bibitem->{mr} && ! $entry->field('mrnumber')) {
+ $entry->field('mrnumber', $bibitem->{mr});
+ }
+ if ($entry->field('mrnumber')) {
+ my $mr=$entry->field('mrnumber');
+ while (length($mr)<7) {
+ $mr = "0$mr";
+ }
+ $mr=$entry->field('mrnumber', $mr);
+ }
+ if ($bibitem->{zbl} && ! $entry->field('zblnumber')) {
+ $entry->field('zblnumber', $bibitem->{zbl});
+ }
+ if ($bibitem->{doi} && ! $entry->field('doi')) {
+ $entry->field('doi', $bibitem->{doi});
+ }
+ if ($bibitem->{arxiv} && ! $entry->field('arxiv')) {
+ $entry->field('arxiv', $bibitem->{arxiv});
+ }
+
+ print $output $entry->to_string(), "\n\n";
+}
+
+