diff options
Diffstat (limited to 'Build/source')
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 |