crossrefware (15feb16)

git-svn-id: svn://tug.org/texlive/trunk@39727 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 139 insertions, 190 deletions

diff --git a/Build/source/texk/texlive/linked_scripts/crossrefware/bibdoiadd.pl b/Build/source/texk/texlive/linked_scripts/crossrefware/bibdoiadd.pl
index b9be8dec824..8937729a3ba 100755
--- a/Build/source/texk/texlive/linked_scripts/crossrefware/bibdoiadd.pl
+++ b/Build/source/texk/texlive/linked_scripts/crossrefware/bibdoiadd.pl
@@ -8,7 +8,7 @@ bibdoiadd.pl - add DOI numbers to papers in a given bib file
 
 =head1 SYNOPSIS
 
-bibdoiadd [B<-c> I<config_file>]  [B<-o> I<output>] I<bib_file>
+bibdoiadd [B<-c> I<config_file>] [B<-f>] [B<-o> I<output>] I<bib_file>
 
 =head1 OPTIONS
 
@@ -19,6 +19,9 @@ bibdoiadd [B<-c> I<config_file>]  [B<-o> I<output>] I<bib_file>
 Configuration file.  If this file is absent, some defaults are used.
 See below for its format.
 
+=item B<-f>
+
+Force checking doi number even if one is present
 
 =item B<-o> I<output>
 
@@ -72,7 +75,7 @@ Boris Veytsman
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2014  Boris Veytsman
+Copyright (C) 2014-2016  Boris Veytsman
 
 This is free software.  You may redistribute copies of it under the
 terms of the GNU General Public License
@@ -82,19 +85,23 @@ extent permitted by law.
 =cut
 
 use strict;
-use Text::BibTeX;
-use Text::BibTeX::Name;
+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 LaTeX::ToUnicode qw (convert);
 use Getopt::Std;
 use URI::Escape;
 use LWP::Simple;
-use TeX::Encode;
-use Encode;
-use HTML::Entities;
-use XML::Entities;
 
-my $USAGE="USAGE: $0 [-c config] [-o output] file\n";
+my $USAGE="USAGE: $0 [-c config] [-f] [-o output] file\n";
 my $VERSION = <<END;
-bibdoiadd v1.0
+bibdoiadd v2.0
 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
@@ -102,7 +109,7 @@ extent permitted by law.
 $USAGE
 END
 my %opts;
-getopts('c:o:hV',\%opts) or die $USAGE;
+getopts('fc:o:hV',\%opts) or die $USAGE;
 
 if ($opts{h} || $opts{V}){
     print $VERSION;
@@ -123,6 +130,9 @@ if ($opts{o}) {
     $outputfile = $opts{o};
 }
 
+my $forceSearch=$opts{f};
+
+
 our $mode='free';
 our $email;
 our $username;
@@ -149,10 +159,12 @@ if ($mode eq 'paid' && (!length($username) || !length($password))) {
 	"Crossref requires a username and password for the paid mode queries\n";
 }
 
-my $input = new Text::BibTeX::File "$inputfile" or 
-    die "Cannot BibTeX file $inputfile\n";
-my $output = new Text::BibTeX::File "> $outputfile" or 
-    die "Cannot write to $outputfile\n";
+my $input= IO::File->new($inputfile) or 
+    die "Cannot find BibTeX file $inputfile\n$USAGE\n";
+my $output = IO::File->new("> $outputfile") or 
+    die "Cannot write to $outputfile\n$USAGE\n";
+
+my $parser=new BibTeX::Parser($input);
 
 my $prefix = 
     "http://www.crossref.org/openurl?redirect=false";
@@ -164,30 +176,31 @@ if ($mode eq 'free') {
 }
 
 # Processing the input
-while (my $entry = new Text::BibTeX::Entry $input) {
+while (my $entry = $parser->next) {
     if (!$entry->parse_ok()) {
 	print STDERR "Cannot understand entry: ";
 	$entry->print(*STDERR);
 	print STDERR "Skipping this entry\n";
 	next;
     }
-    if (!(($entry->metatype() eq BTE_REGULAR) &&
-	  ($entry->type() eq 'article'))) {
-	$entry->write($output);
+
+    if (!($entry->type() eq 'ARTICLE')) {
+	print $output $entry->raw_bibtex(), "\n\n";
 	next;
     }
-    if ($entry->exists('doi')) {
-	$entry->write($output);
+    if ($entry->has('doi') && !$forceSearch) {
+	print $output $entry->raw_bibtex(), "\n\n";
 	next;
     }
     
+    
+
+     my $doi = GetDoi($prefix, $entry);
+     if (length($doi)) {
+ 	$entry->field('doi',$doi);
+     }
+    print $output $entry->to_string(), "\n\n";
 
-    # Now we have an entry with no doi.  Let us get to work.
-    my $doi = GetDoi($prefix,$entry);
-    if (length($doi)) {
-	$entry->set('doi',$doi);
-    }
-    $entry->write($output);
 
 }
 
@@ -201,33 +214,30 @@ exit 0;
 
 sub GetDoi {
     my ($url,$entry) = @_;
-    if ($entry->exists('issn')) {
-	$url .= "&issn=".uri_escape(SanitizeText($entry->get('issn')));
+    if ($entry->has('issn')) {
+	$url .= "&issn=".uri_escape_utf8(SanitizeText($entry->field('issn')));
     }
-    if ($entry->exists('journal')) {
-	$url .= "&title=".uri_escape(SanitizeText($entry->get('journal')));
+    if ($entry->has('journal')) {
+	$url .= "&title=".uri_escape_utf8(SanitizeText($entry->field('journal')));
     }
-    my @names=$entry->names ('author');
+    my @names=$entry->author();
     if (scalar(@names)) {
-	my @lastnames = $names[0]->part ('last');
-	if (scalar(@lastnames)) {
-	    my $lastname = SanitizeText(join(' ',@lastnames));
-	    $url .= "&aulast=".uri_escape($lastname);
-	}
+	my $lastname = SanitizeText($names[0]->last());
+	$url .= "&aulast=".uri_escape_utf8($lastname);
     }
-    if ($entry->exists('volume')) {
-	$url .= "&volume=".uri_escape($entry->get('volume'));
+    if ($entry->has('volume')) {
+	$url .= "&volume=".uri_escape_utf8($entry->field('volume'));
     }    
-    if ($entry->exists('number')) {
-	$url .= "&issue=".uri_escape($entry->get('number'));
+    if ($entry->has('number')) {
+	$url .= "&issue=".uri_escape_utf8($entry->field('number'));
     }    
-    if ($entry->exists('pages')) {
-	my $pages=$entry->get('pages');
+    if ($entry->has('pages')) {
+	my $pages=$entry->field('pages');
 	$pages =~ s/-.*$//;
-	$url .= "&spage=".uri_escape($pages);
+	$url .= "&spage=".uri_escape_utf8($pages);
     }    
-    if ($entry->exists('year')) {
-	$url .= "&date=".uri_escape($entry->get('year'));
+    if ($entry->has('year')) {
+	$url .= "&date=".uri_escape_utf8($entry->field('year'));
     }    
 
     my $result=get($url);
@@ -244,24 +254,22 @@ sub GetDoi {
 ###############################################################
 sub SanitizeText {
     my $string = shift;
-    # There is a bug in the decode function, which we need to work 
-    # around:  it adds space to constructions like \o x
-    $string =~ s/(\\[a-zA-Z])\s+/$1/g;
+    $string = convert($string);
     $string =~ s/\\newblock//g;
+    $string =~ s/\\bgroup//g;
+    $string =~ s/\\egroup//g;
+    $string =~ s/\\scshape//g;
     $string =~ s/\\urlprefix//g;
     $string =~ s/\\emph//g;
+    $string =~ s/\\textbf//g;
     $string =~ s/\\enquote//g;
     $string =~ s/\\url/URL: /g;
     $string =~ s/\\doi/DOI: /g;
     $string =~ s/\\\\/ /g;
-    $string = decode('latex', $string);
-    $string =~ s/\\[a-zA-Z]+/ /g;
-    $string =~ s/\\\\/ /g;
-    $string =~ s/[\[\{\}\]]/ /g;
-    $string = encode_entities($string);
-    $string = XML::Entities::numify('all', $string);
-    $string =~ s/amp;//g;
+    $string =~ s/\$//g;
+    $string =~ s/\\checkcomma/,/g;
     $string =~ s/~/ /g;
-    $string =~ s/\s*([\.;,])/$1/g;
+    $string =~ s/[\{\}]//g;
     return $string;
 }
+
diff --git a/Build/source/texk/texlive/linked_scripts/crossrefware/bibzbladd.pl b/Build/source/texk/texlive/linked_scripts/crossrefware/bibzbladd.pl
index 4059b7b0a12..f348cd4b946 100755
--- a/Build/source/texk/texlive/linked_scripts/crossrefware/bibzbladd.pl
+++ b/Build/source/texk/texlive/linked_scripts/crossrefware/bibzbladd.pl
@@ -8,12 +8,15 @@ bibzbladd.pl - add Zbl numbers to papers in a given bib file
 
 =head1 SYNOPSIS
 
-bibzbladd  [B<-o> I<output>] I<bib_file>
+bibzbladd  [B<-f>] [B<-o> I<output>] I<bib_file>
 
 =head1 OPTIONS
 
 =over 4
 
+=item B<-f>
+
+Force searching for Zbl numbers even if the entry already has one.
 
 =item B<-o> I<output>
 
@@ -25,7 +28,7 @@ output file is formed by adding C<_zbl> to the input file
 =head1 DESCRIPTION
 
 The script reads a BibTeX file.  It checks whether the entries have
-Zbls.  If now, tries to contact internet to get the numbers.  The
+Zbls.  If not, tries to contact internet to get the numbers.  The
 result is a BibTeX file with the fields 
 C<zblnumber=...> added.  
 
@@ -38,7 +41,7 @@ Boris Veytsman
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2014  Boris Veytsman
+Copyright (C) 2014-2016  Boris Veytsman
 
 This is free software.  You may redistribute copies of it under the
 terms of the GNU General Public License
@@ -48,16 +51,22 @@ extent permitted by law.
 =cut
 
 use strict;
-use Text::BibTeX;
-use Text::BibTeX::Name;
+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 Getopt::Std;
 use URI::Escape;
 use LWP::UserAgent;
-use TeX::Encode;
 
-my $USAGE="USAGE: $0  [-o output] file\n";
+my $USAGE="USAGE: $0  [-f] [-o output] file\n";
 my $VERSION = <<END;
-bibzbladd v1.0
+bibzbladd v2.0
 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
@@ -65,7 +74,7 @@ extent permitted by law.
 $USAGE
 END
 my %opts;
-getopts('o:hV',\%opts) or die $USAGE;
+getopts('fo:hV',\%opts) or die $USAGE;
 
 if ($opts{h} || $opts{V}){
     print $VERSION;
@@ -86,41 +95,45 @@ if ($opts{o}) {
     $outputfile = $opts{o};
 }
 
-my $input = new Text::BibTeX::File "$inputfile" or 
-    die "Cannot BibTeX file $inputfile\n";
-my $output = new Text::BibTeX::File "> $outputfile" or 
-    die "Cannot write to $outputfile\n";
+my $forceSearch=$opts{f};
+
+my $input= IO::File->new($inputfile) or 
+    die "Cannot find BibTeX file $inputfile\n$USAGE\n";
+my $output = IO::File->new("> $outputfile") or 
+    die "Cannot write to $outputfile\n$USAGE\n";
+
+my $parser=new BibTeX::Parser($input);
+
 
 
 # Creating the HTTP parameters
 my $mirror =
-    "http://www.zentralblatt-math.org/MIRROR/zmath/en/search/";
+    "https://zbmath.org/citationmatching/bibtex/match";
 my $userAgent = LWP::UserAgent->new;
 
-# Processing the input
-while (my $entry = new Text::BibTeX::Entry $input) {
+while (my $entry = $parser->next ) {
     if (!$entry->parse_ok()) {
 	print STDERR "Cannot understand entry: ";
 	$entry->print(*STDERR);
 	print STDERR "Skipping this entry\n";
 	next;
     }
-    if (!(($entry->metatype() eq BTE_REGULAR))) {
-	$entry->write($output);
+    if (!($entry->type() eq 'ARTICLE')) {
+	print $output $entry->raw_bibtex(), "\n\n";
 	next;
     }
-    if ($entry->exists('zblnumber')) {
-	$entry->write($output);
+    if ($entry->has('zblnumber') && !$forceSearch) {
+	print $output $entry->raw_bibtex(), "\n\n";
 	next;
     }
     
 
-    # Now we have an entry with no Zbl.  Let us get to work.
-    my $zbl = GetZbl($entry, $userAgent, $mirror);
-    if (length($zbl)) {
-	$entry->set('zblnumber',$zbl);
-    }
-    $entry->write($output);
+     # Now we have an entry with no Zbl.  Let us get to work.
+     my $zbl = GetZbl($entry, $userAgent, $mirror);
+     if (length($zbl)) {
+ 	$entry->field('zblnumber',$zbl);
+     }
+    print $output $entry->to_string(), "\n\n";
 
 }
 
@@ -139,77 +152,16 @@ sub GetZbl {
     
     my @query;
 
-    my @names=$entry->names ('author');
-    if (scalar(@names)) {
-	foreach my $name (@names) {
-	    my @lastnames = $name->part ('last');
-	    if (scalar(@lastnames)) {
-		foreach my $lastname (@lastnames) {
-		    push @query, "au:$lastname";
-		}
-	    }
-	}
-    }
-    if (my $title = $entry->get('title')) {
-	push @query, "ti:$title";
-    }
+    my $string=uri_escape_utf8($entry->to_string());
     
-    if (my $year = $entry->get('year')) {
-	push @query, "py:$year";
-    }
-
-    if (my $year = $entry->get('year')) {
-	push @query, "py:$year";
-    }
 
-    my $type = $entry->type;
-    if ($type eq 'article') {
-	push @query, "dt:j";
-    }
-    if ($type eq 'book') {
-	push @query, "dt:b";
-    }
-    if ($type eq 'inproceedings' || $type eq 'incollection') {
-	push @query, "dt:a";
-    }
-
-    my $source = "";
-    if ($type eq 'article') {
-	if ($entry->get('journal')) {
-	    $source .= $entry->get('journal');
-	}
-	if (my $vol=$entry->get('volume')) {
-	    $source .= ",$vol";
-	}
-	if (my $pages=$entry->get('pages')) {
-	    $source .= ",$pages";
-	}
-    } else {
-	if (my $bt=$entry->get('booktitle')) {
-	    $source .= "$bt";
-	}
-    }
-
-    if ($source) {
-	push @query, "so:$source";
-    }
-
-
-    my $qstring = join(" & ", @query);
-#    print STDERR "$qstring\n";
 
-    my $form;
-
-    $form->{name}='form';
-    $form->{q} =  $qstring;
-    $form->{type} = "ascii";
-    $form->{submit} = 'Search';
-
-    my $response = $userAgent->post($mirror, $form);
-    if ($response->decoded_content =~ /^an:\s*Zbl\s*(\S+)\s*$/m) {
+    my $response = $userAgent->get("$mirror?bibtex=$string");
+    if ($response->decoded_content =~ /^\s*"zbl_id":\s*"(.*)",\s*$/m) {
 	return $1;
-    } else {
-	return ("");
+     } else {
+ 	return ("");
     }
+
 }
 	
diff --git a/Build/source/texk/texlive/linked_scripts/crossrefware/ltx2crossrefxml.pl b/Build/source/texk/texlive/linked_scripts/crossrefware/ltx2crossrefxml.pl
index 5824511cdbf..f9585399cfa 100755
--- a/Build/source/texk/texlive/linked_scripts/crossrefware/ltx2crossrefxml.pl
+++ b/Build/source/texk/texlive/linked_scripts/crossrefware/ltx2crossrefxml.pl
@@ -56,7 +56,7 @@ Boris Veytsman
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2012-2015  Boris Veytsman
+Copyright (C) 2012-2016  Boris Veytsman
 
 This is free software.  You may redistribute copies of it under the
 terms of the GNU General Public License
@@ -67,18 +67,22 @@ 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 POSIX qw(strftime);
- use Text::BibTeX;
- use Text::BibTeX::Name;
- use TeX::Encode;
- use Encode;
- use HTML::Entities;
- use XML::Entities;
+ use BibTeX::Parser::Author;
+ use LaTeX::ToUnicode qw (convert);
  use File::Basename;
  use File::Spec;
  my $USAGE="USAGE: $0 [-c config] [-o output] file1 file2 ...\n";
 my $VERSION = <<END;
-ltx2crossrefxml v1.0
+ltx2crossrefxml v2.0
 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
@@ -88,6 +92,8 @@ END
  use Getopt::Std;
  my %opts;
  getopts('c:o:hV',\%opts) or die $USAGE;
+ use utf8;
+ binmode(STDOUT, ":utf8");
 
 if ($opts{h} || $opts{V}){
     print $VERSION;
@@ -102,6 +108,7 @@ if ($opts{h} || $opts{V}){
  
  if (defined($opts{o})) {
      open (OUT, ">$opts{o}") or die "Cannot open file $opts{o} for writing\n";
+     binmode(OUT, ":utf8")
  }
 
 
@@ -292,7 +299,7 @@ END
 ###############################################################
 sub PrintPaper {
     my $paper = shift;
-    my $title=SanitizeText($paper->{title});
+    my $title=convert($paper->{title});
     my $url=GetURL($paper);
     print OUT <<END;
       <journal_article publication_type="full_text">
@@ -358,9 +365,7 @@ END
 ###############################################################
 sub SanitizeText {
     my $string = shift;
-    # There is a bug in the decode function, which we need to work 
-    # around:  it adds space to constructions like \o x
-    $string =~ s/(\\[a-zA-Z])\s+/$1/g;
+    $string = convert($string);
     $string =~ s/\\newblock//g;
     $string =~ s/\\bgroup//g;
     $string =~ s/\\egroup//g;
@@ -373,27 +378,9 @@ sub SanitizeText {
     $string =~ s/\\doi/DOI: /g;
     $string =~ s/\\\\/ /g;
     $string =~ s/\$//g;
-    # Another bug in decode: it does not understan macrons
-    $string =~ s/\\=(A|\{A\})/##SANITIZE#MACRON##256;/g;
-    $string =~ s/\\=(a|\{a\})/##SANITIZE#MACRON##257;/g;
-    $string =~ s/\\=(E|\{E\})/##SANITIZE#MACRON##274;/g;
-    $string =~ s/\\=(e|\{e\})/##SANITIZE#MACRON##275;/g;
-    $string =~ s/\\=(I|\{I\})/##SANITIZE#MACRON##298;/g;
-    $string =~ s/\\=(i|\{i\})/##SANITIZE#MACRON##299;/g;
-    $string =~ s/\\=(O|\{O\})/##SANITIZE#MACRON##332;/g;
-    $string =~ s/\\=(o|\{o\})/##SANITIZE#MACRON##333;/g;
-    $string =~ s/\\=(U|\{U\})/##SANITIZE#MACRON##362;/g;
-    $string =~ s/\\=(u|\{u\})/##SANITIZE#MACRON##363;/g;
-    $string = decode('latex', $string);    
-    $string =~ s/\\[a-zA-Z]+/ /g;
-    $string =~ s/\\\\/ /g;
-    $string =~ s/[\[\{\}\]]/ /g;
-    $string = encode_entities($string);
-    $string = XML::Entities::numify('all', $string);
-    $string =~ s/amp;//g;
+    $string =~ s/\\checkcomma/,/g;
     $string =~ s/~/ /g;
-    $string =~ s/\s*([\.;,])/$1/g;
-    $string =~ s/##SANITIZE#MACRON##(\d+);/&#$1;/g;
+    $string =~ s/[\{\}]//g;
     return $string;
 }
 
@@ -403,11 +390,10 @@ sub SanitizeText {
 sub PrintAuthor {
     my $author=shift;
 
-    my $person=new Text::BibTeX::Name ($author);
+    my $person=new BibTeX::Parser::Author ($author);
 
-    if ($person->part('first')) {
-	my @tokens = $person->part('first');
-	my $line = join(" ", @tokens);
+    if ($person->first) {
+	my $line = $person->first;
 	$line = SanitizeText($line);
 	print OUT <<END;
             <given_name>$line</given_name>
@@ -415,16 +401,19 @@ END
 
     }
 
-    if ($person->part('last')) {
-	my $line = SanitizeText($person->part('last'));
+    if ($person->last) {
+	my $line = SanitizeText($person->last);
+	if ($person->von) {
+	    $line = SanitizeText($person->von)." $line";
+	}
 	print OUT <<END;
             <surname>$line</surname>
 END
 
     }
 
-    if ($person->part('jr')) {
-	my $line = SanitizeText($person->part('jr'));
+    if ($person->jr) {
+	my $line = SanitizeText($person->jr);
 	print OUT <<END;
             <suffix>$line</suffix>
 END