#!/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] I =head1 OPTIONS =over 4 =item [-d] Send debugging output to stdout =item B<-o> I 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 recognizes URL fields of the kind C and their variants and converts them to DOI fields (see also L script). The switch B<-u> suppresses this cleanup. =back =head1 DESCRIPTION The script tries to reconstruct a C file from the corresponding C 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 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-2022 Boris Veytsman This is free software. You may redistribute copies of it under the terms of the GNU General Public License L. 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=TEXMFROOT`); # 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 = <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>/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";
}