diff options
author | Karl Berry <karl@freefriends.org> | 2015-10-25 22:57:55 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2015-10-25 22:57:55 +0000 |
commit | 4a9225ab54c95efafd2534812e2f53697fd0f6d9 (patch) | |
tree | 0ba9a25e89367efb21e41640876facce6b60d08c /Master/texmf-dist/scripts | |
parent | 4a0798e9378fdb2de85f56e1ef1d46653f86cc69 (diff) |
bibtexperllibs (25oct15)
git-svn-id: svn://tug.org/texlive/trunk@38711 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts')
5 files changed, 1602 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm new file mode 100644 index 00000000000..8f0ab3a4c49 --- /dev/null +++ b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser.pm @@ -0,0 +1,308 @@ +package BibTeX::Parser; +{ + $BibTeX::Parser::VERSION = '0.65'; +} +# ABSTRACT: A pure perl BibTeX parser +use warnings; +use strict; + +use BibTeX::Parser::Entry; + + +my $re_namechar = qr/[a-zA-Z0-9\!\$\&\*\+\-\.\/\:\;\<\>\?\[\]\^\_\`\|]/o; +my $re_name = qr/$re_namechar+/o; + + +sub new { + my ( $class, $fh ) = @_; + + return bless { + fh => $fh, + strings => { + jan => "January", + feb => "February", + mar => "March", + apr => "April", + may => "May", + jun => "June", + jul => "July", + aug => "August", + sep => "September", + oct => "October", + nov => "November", + dec => "December", + + }, + line => -1, + buffer => "", + }, $class; +} + +sub _slurp_close_bracket; + +sub _parse_next { + my $self = shift; + + while (1) { # loop until regular entry is finished + return 0 if $self->{fh}->eof; + local $_ = $self->{buffer}; + + until (/@/m) { + my $line = $self->{fh}->getline; + return 0 unless defined $line; + $_ .= $line; + } + + my $current_entry = new BibTeX::Parser::Entry; + if (/@($re_name)/cgo) { + my $type = uc $1; + $current_entry->type( $type ); + my $start_pos = pos($_) - length($type) - 1; + + # read rest of entry (matches braces) + my $bracelevel = 0; + $bracelevel += tr/\{/\{/; #count braces + $bracelevel -= tr/\}/\}/; + while ( $bracelevel != 0 ) { + my $position = pos($_); + my $line = $self->{fh}->getline; + last unless defined $line; + $bracelevel = + $bracelevel + ( $line =~ tr/\{/\{/ ) - ( $line =~ tr/\}/\}/ ); + $_ .= $line; + pos($_) = $position; + } + + # Remember raw bibtex code + my $raw = substr($_, $start_pos); + $raw =~ s/^\s+//; + $raw =~ s/\s+$//; + $current_entry->raw_bibtex($raw); + + my $pos = pos $_; + tr/\n/ /; + pos($_) = $pos; + + if ( $type eq "STRING" ) { + if (/\G{\s*($re_name)\s*=\s*/cgo) { + my $key = $1; + my $value = _parse_string( $self->{strings} ); + if ( defined $self->{strings}->{$key} ) { + warn("Redefining string $key!"); + } + $self->{strings}->{$key} = $value; + /\G[\s\n]*\}/cg; + } else { + $current_entry->error("Malformed string!"); + return $current_entry; + } + } elsif ( $type eq "COMMENT" or $type eq "PREAMBLE" ) { + /\G\{./cgo; + _slurp_close_bracket; + } else { # normal entry + $current_entry->parse_ok(1); + + # parse key + if (/\G\s*\{(?:\s*($re_name)\s*,[\s\n]*|\s+\r?\s*)/cgo) { + $current_entry->key($1); + + # fields + while (/\G[\s\n]*($re_name)[\s\n]*=[\s\n]*/cgo) { + $current_entry->field( + $1 => _parse_string( $self->{strings} ) ); + my $idx = index( $_, ',', pos($_) ); + pos($_) = $idx + 1 if $idx > 0; + } + + return $current_entry; + + } else { + + $current_entry->error("Malformed entry (key contains illegal characters) at " . substr($_, pos($_) || 0, 20) . ", ignoring"); + _slurp_close_bracket; + return $current_entry; + } + } + + $self->{buffer} = substr $_, pos($_); + + } else { + $current_entry->error("Did not find type at " . substr($_, pos($_) || 0, 20)); + return $current_entry; + } + + } +} + + +sub next { + my $self = shift; + + return $self->_parse_next; +} + +# slurp everything till the next closing brace. Handels +# nested brackets +sub _slurp_close_bracket { + my $bracelevel = 0; + BRACE: { + /\G[^\}]*\{/cg && do { $bracelevel++; redo BRACE }; + /\G[^\{]*\}/cg + && do { + if ( $bracelevel > 0 ) { + $bracelevel--; + redo BRACE; + } else { + return; + } + } + } +} + +# parse bibtex string in $_ and return. A BibTeX string is either enclosed +# in double quotes '"' or matching braces '{}'. The braced form may contain +# nested braces. +sub _parse_string { + my $strings_ref = shift; + + my $value = ""; + + PART: { + if (/\G(\d+)/cg) { + $value .= $1; + } elsif (/\G($re_name)/cgo) { + warn("Using undefined string $1") unless defined $strings_ref->{$1}; + $value .= $strings_ref->{$1} || ""; + } elsif (/\G"(([^"\\]*(\\.)*[^\\"]*)*)"/cgs) + { # quoted string with embeded escapes + $value .= $1; + } else { + my $part = _extract_bracketed( $_ ); + $value .= substr $part, 1, length($part) - 2; # strip quotes + } + + if (/\G\s*#\s*/cg) { # string concatenation by # + redo PART; + } + } + $value =~ s/[\s\n]+/ /g; + return $value; +} + +sub _extract_bracketed +{ + for($_[0]) # alias to $_ + { + /\G\s+/cg; + my $start = pos($_); + my $depth = 0; + while(1) + { + /\G\\./cg && next; + /\G\{/cg && (++$depth, next); + /\G\}/cg && (--$depth > 0 ? next : last); + /\G([^\\\{\}]+)/cg && next; + last; # end of string + } + return substr($_, $start, pos($_)-$start); + } +} + +1; # End of BibTeX::Parser + + +__END__ +=pod + +=head1 NAME + +BibTeX::Parser - A pure perl BibTeX parser + +=head1 VERSION + +version 0.65 + +=head1 SYNOPSIS + +Parses BibTeX files. + + use BibTeX::Parser; + use IO::File; + + my $fh = IO::File->new("filename"); + + # Create parser object ... + my $parser = BibTeX::Parser->new($fh); + + # ... and iterate over entries + while (my $entry = $parser->next ) { + if ($entry->parse_ok) { + my $type = $entry->type; + my $title = $entry->field("title"); + + my @authors = $entry->author; + # or: + my @editors = $entry->editor; + + foreach my $author (@authors) { + print $author->first . " " + . $author->von . " " + . $author->last . ", " + . $author->jr; + } + } else { + warn "Error parsing file: " . $entry->error; + } + } + +=for stopwords jr von + +=head1 NAME + +BibTeX::Parser - A pure perl BibTeX parser + +=head1 VERSION + +version 0.65 + +=head1 FUNCTIONS + +=head2 new + +Creates new parser object. + +Parameters: + + * fh: A filehandle + +=head2 next + +Returns the next parsed entry or undef. + +=head2 SEE ALSO + +=over 4 + +=item + +L<BibTeX::Parser::Entry> + +=item + +L<BibTeX::Parser::Author> + +=back + +=head1 AUTHOR + +Gerhard Gossen <gerhard.gossen@googlemail.com> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2013 by Gerhard Gossen. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm new file mode 100644 index 00000000000..c358d245116 --- /dev/null +++ b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Author.pm @@ -0,0 +1,267 @@ +package BibTeX::Parser::Author; +{ + $BibTeX::Parser::Author::VERSION = '0.65'; +} + +use warnings; +use strict; + +use overload + '""' => \&to_string; + + + +sub new { + my $class = shift; + + if (@_) { + my $self = [ $class->split(@_) ]; + return bless $self, $class; + } else { + return bless [], $class; + } +} + +sub _get_or_set_field { + my ($self, $field, $value) = @_; + if (defined $value) { + $self->[$field] = $value; + } else { + return $self->[$field]; + } +} + + +sub first { + shift->_get_or_set_field(0, @_); +} + + +sub von { + shift->_get_or_set_field(1, @_); +} + + +sub last { + shift->_get_or_set_field(2, @_); +} + + +sub jr { + shift->_get_or_set_field(3, @_); +} + + +sub split { + my ($self_or_class, $name) = @_; + + # remove whitespace at start and end of string + $name =~ s/^\s*(.*)\s*$/$1/s; + + if ( $name =~ /^\{\s*(.*)\s*\}$/ ) { + return (undef, undef, $1, undef); + } + + if ( $name =~ /\{/ ) { + my @tokens; + my $cur_token = ''; + while ( scalar( $name =~ /\G \s* ( [^,\{]*? ) ( \s* , \s* | \{ | \s* $ ) /xgc ) ) { + $cur_token .= $1 if $1; + if ( $2 =~ /\{/ ) { + if ( scalar( $name =~ /\G([^\}]*)\}/gc ) ) { + $cur_token .= "{$1}"; + } else { + die "Unmatched brace in name '$name'"; + } + } else { + $cur_token =~ s/\s*$//; + push @tokens, $cur_token if $cur_token; + $cur_token = ''; + } + } + push @tokens, $cur_token if $cur_token; + return _get_single_author_from_tokens( @tokens ); + } else { + my @tokens = split /\s*,\s*/, $name; + + return _get_single_author_from_tokens( @tokens ); + } +} + +sub _split_name_parts { + my $name = shift; + + if ( $name !~ /\{/ ) { + return split /\s+/, $name; + } else { + my @parts; + my $cur_token = ''; + while ( scalar( $name =~ /\G ( [^\s\{]* ) ( \s+ | \{ | \s* $ ) /xgc ) ) { + $cur_token .= $1; + if ( $2 =~ /\{/ ) { + if ( scalar( $name =~ /\G([^\}]*)\}/gc ) ) { + $cur_token .= "{$1}"; + } else { + die "Unmatched brace in name '$name'"; + } + } else { + if ( $cur_token =~ /^{(.*)}$/ ) { + $cur_token = $1; + } + push @parts, $cur_token; + $cur_token = ''; + } + } + return @parts; + } + +} + + +sub _get_single_author_from_tokens { + my (@tokens) = @_; + if (@tokens == 0) { + return (undef, undef, undef, undef); + } elsif (@tokens == 1) { # name without comma + if ( $tokens[0] =~ /(^|\s)[[:lower:]]/) { # name has von part or has only lowercase names + my @name_parts = _split_name_parts $tokens[0]; + + my $first; + while (@name_parts && ucfirst($name_parts[0]) eq $name_parts[0] ) { + $first .= $first ? ' ' . shift @name_parts : shift @name_parts; + } + + my $von; + # von part are lowercase words + while ( @name_parts && lc($name_parts[0]) eq $name_parts[0] ) { + $von .= $von ? ' ' . shift @name_parts : shift @name_parts; + } + + if (@name_parts) { + return ($first, $von, join(" ", @name_parts), undef); + } else { + return (undef, undef, $tokens[0], undef); + } + } else { + if ( $tokens[0] !~ /\{/ && $tokens[0] =~ /^((.*)\s+)?\b(\S+)$/) { + return ($2, undef, $3, undef); + } else { + my @name_parts = _split_name_parts $tokens[0]; + return ($name_parts[0], undef, $name_parts[1], undef); + } + } + + } elsif (@tokens == 2) { + my @von_last_parts = _split_name_parts $tokens[0]; + my $von; + # von part are lowercase words + while ( @von_last_parts && lc($von_last_parts[0]) eq $von_last_parts[0] ) { + $von .= $von ? ' ' . shift @von_last_parts : shift @von_last_parts; + } + return ($tokens[1], $von, join(" ", @von_last_parts), undef); + } else { + my @von_last_parts = _split_name_parts $tokens[0]; + my $von; + # von part are lowercase words + while ( @von_last_parts && lc($von_last_parts[0]) eq $von_last_parts[0] ) { + $von .= $von ? ' ' . shift @von_last_parts : shift @von_last_parts; + } + return ($tokens[2], $von, join(" ", @von_last_parts), $tokens[1]); + } + +} + + +sub to_string { + my $self = shift; + + if ($self->jr) { + return $self->von . " " . $self->last . ", " . $self->jr . ", " . $self->first; + } else { + return ($self->von ? $self->von . " " : '') . $self->last . ($self->first ? ", " . $self->first : ''); + } +} + +1; # End of BibTeX::Entry + +__END__ +=pod + +=head1 NAME + +BibTeX::Parser::Author + +=head1 VERSION + +version 0.65 + +=head1 SYNOPSIS + +This class ist a wrapper for a single BibTeX author. It is usually created +by a BibTeX::Parser. + + use BibTeX::Parser::Author; + + my $entry = BibTeX::Parser::Author->new($full_name); + + my $firstname = $author->first; + my $von = $author->von; + my $last = $author->last; + my $jr = $author->jr; + + # or ... + + my ($first, $von, $last, $jr) = BibTeX::Author->split($fullname); + +=head1 NAME + +BibTeX::Author - Contains a single author for a BibTeX document. + +=head1 VERSION + +version 0.65 + +=head1 FUNCTIONS + +=head2 new + +Create new author object. Expects full name as parameter. + +=head2 first + +Set or get first name(s). + +=head2 von + +Set or get 'von' part of name. + +=head2 last + +Set or get last name(s). + +=head2 jr + +Set or get 'jr' part of name. + +=head2 split + +Split name into (firstname, von part, last name, jr part). Returns array +with four strings, some of them possibly empty. + +=head2 to_string + +Return string representation of the name. + +=head1 AUTHOR + +Gerhard Gossen <gerhard.gossen@googlemail.com> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2013 by Gerhard Gossen. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm new file mode 100644 index 00000000000..6fb54a3972a --- /dev/null +++ b/Master/texmf-dist/scripts/bibtexperllibs/BibTeX/Parser/Entry.pm @@ -0,0 +1,360 @@ +package BibTeX::Parser::Entry; +{ + $BibTeX::Parser::Entry::VERSION = '0.65'; +} + +use warnings; +use strict; + +use BibTeX::Parser::Author; + + + +sub new { + my ($class, $type, $key, $parse_ok, $fieldsref) = @_; + + my %fields = defined $fieldsref ? %$fieldsref : (); + if (defined $type) { + $fields{_type} = uc($type); + } + $fields{_key} = $key; + $fields{_parse_ok} = $parse_ok; + $fields{_raw} = ''; + return bless \%fields, $class; +} + + + +sub parse_ok { + my $self = shift; + if (@_) { + $self->{_parse_ok} = shift; + } + $self->{_parse_ok}; +} + + +sub error { + my $self = shift; + if (@_) { + $self->{_error} = shift; + $self->parse_ok(0); + } + return $self->parse_ok ? undef : $self->{_error}; +} + + +sub type { + if (scalar @_ == 1) { + # get + my $self = shift; + return $self->{_type}; + } else { + # set + my ($self, $newval) = @_; + $self->{_type} = uc($newval); + } +} + + +sub key { + if (scalar @_ == 1) { + # get + my $self = shift; + return $self->{_key}; + } else { + # set + my ($self, $newval) = @_; + $self->{_key} = $newval; + } + +} + + +sub field { + if (scalar @_ == 2) { + # get + my ($self, $field) = @_; + return $self->{ lc( $field ) }; + } else { + my ($self, $key, $value) = @_; + $self->{ lc( $key ) } = $value; #_sanitize_field($value); + } + +} + +use LaTeX::ToUnicode qw( convert ); + + +sub cleaned_field { + my ( $self, $field, @options ) = @_; + if ( $field =~ /author|editor/i ) { + return $self->field( $field ); + } else { + return convert( $self->field( lc $field ), @options ); + } +} + + +sub cleaned_author { + my $self = shift; + $self->_handle_cleaned_author_editor( [ $self->author ], @_ ); +} + + +sub cleaned_editor { + my $self = shift; + $self->_handle_cleaned_author_editor( [ $self->editor ], @_ ); +} + +sub _handle_cleaned_author_editor { + my ( $self, $authors, @options ) = @_; + map { + my $author = $_; + my $new_author = BibTeX::Parser::Author->new; + map { + $new_author->$_( convert( $author->$_, @options ) ) + } grep { defined $author->$_ } qw( first von last jr ); + $new_author; + } @$authors; +} + +no LaTeX::ToUnicode; + +sub _handle_author_editor { + my $type = shift; + my $self = shift; + if (@_) { + if (@_ == 1) { #single string + # my @names = split /\s+and\s+/i, $_[0]; + my @names = _split_author_field( $_[0] ); + $self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names]; + $self->field($type, join " and ", @{$self->{"_$type"}}); + } else { + $self->{"_$type"} = []; + foreach my $param (@_) { + if (ref $param eq "BibTeX::Author") { + push @{$self->{"_$type"}}, $param; + } else { + push @{$self->{"_$type"}}, new BibTeX::Parser::Author $param; + } + + $self->field($type, join " and ", @{$self->{"_$type"}}); + } + } + } else { + unless ( defined $self->{"_$type"} ) { + #my @names = split /\s+and\s+/i, $self->{$type} || ""; + my @names = _split_author_field( $self->{$type} || "" ); + $self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names]; + } + return @{$self->{"_$type"}}; + } +} + +# _split_author_field($field) +# +# Split an author field into different author names. +# Handles quoted names ({name}). +sub _split_author_field { + my $field = shift; + + return () if !defined $field || $field eq ''; + + my @names; + + my $buffer; + while (!defined pos $field || pos $field < length $field) { + if ( $field =~ /\G ( .*? ) ( \{ | \s+ and \s+ )/xcgi ) { + my $match = $1; + if ( $2 =~ /and/i ) { + $buffer .= $match; + push @names, $buffer; + $buffer = ""; + } elsif ( $2 =~ /\{/ ) { + $buffer .= $match . "{"; + if ( $field =~ /\G (.* \})/cgx ) { + $buffer .= $1; + } else { + die "Missing closing brace at " . substr( $field, pos $field, 10 ); + } + } else { + $buffer .= $match; + } + } else { + #print "# $field " . (pos ($field) || 0) . "\n"; + $buffer .= substr $field, (pos $field || 0); + last; + } + } + push @names, $buffer if $buffer; + return @names; +} + + +sub author { + _handle_author_editor('author', @_); +} + + +sub editor { + _handle_author_editor('editor', @_); +} + + +sub fieldlist { + my $self = shift; + + return grep {!/^_/} keys %$self; +} + + +sub has { + my ($self, $field) = @_; + + return defined $self->{$field}; +} + +sub _sanitize_field { + my $value = shift; + for ($value) { + tr/\{\}//d; + s/\\(?!=[ \\])//g; + s/\\\\/\\/g; + } + return $value; +} + + + +sub raw_bibtex { + my $self = shift; + if (@_) { + $self->{_raw} = shift; + } + return $self->{_raw}; +} + +1; # End of BibTeX::Entry + +__END__ +=pod + +=head1 NAME + +BibTeX::Parser::Entry + +=head1 VERSION + +version 0.65 + +=head1 SYNOPSIS + +This class ist a wrapper for a single BibTeX entry. It is usually created +by a BibTeX::Parser. + + use BibTeX::Parser::Entry; + + my $entry = BibTeX::Parser::Entry->new($type, $key, $parse_ok, \%fields); + + if ($entry->parse_ok) { + my $type = $entry->type; + my $key = $enty->key; + print $entry->field("title"); + my @authors = $entry->author; + my @editors = $entry->editor; + + ... + } + +=head1 NAME + +BibTeX::Entry - Contains a single entry of a BibTeX document. + +=head1 VERSION + +version 0.65 + +=head1 FUNCTIONS + +=head2 new + +Create new entry. + +=head2 parse_ok + +If the entry was correctly parsed, this method returns a true value, false otherwise. + +=head2 error + +Return the error message, if the entry could not be parsed or undef otherwise. + +=head2 type + +Get or set the type of the entry, eg. 'ARTICLE' or 'BOOK'. Return value is +always uppercase. + +=head2 key + +Get or set the reference key of the entry. + +=head2 field($name [, $value]) + +Get or set the contents of a field. The first parameter is the name of the +field, the second (optional) value is the new value. + +=head2 cleaned_field($name) + +Retrieve the contents of a field in a format that is cleaned of TeX markup. + +=head2 cleaned_author + +Get an array of L<BibTeX::Parser::Author> objects for the authors of this +entry. Each name has been cleaned of accents and braces. + +=head2 cleaned_editor + +Get an array of L<BibTeX::Parser::Author> objects for the editors of this +entry. Each name has been cleaned of accents and braces. + +=head2 author([@authors]) + +Get or set the authors. Returns an array of L<BibTeX::Author|BibTeX::Author> +objects. The parameters can either be L<BibTeX::Author|BibTeX::Author> objects +or strings. + +Note: You can also change the authors with $entry->field('author', $authors_string) + +=head2 editor([@editors]) + +Get or set the editors. Returns an array of L<BibTeX::Author|BibTeX::Author> +objects. The parameters can either be L<BibTeX::Author|BibTeX::Author> objects +or strings. + +Note: You can also change the authors with $entry->field('editor', $editors_string) + +=head2 fieldlist() + +Returns a list of all the fields used in this entry. + +=head2 has($fieldname) + +Returns a true value if this entry has a value for $fieldname. + +=head2 raw_bibtex + +Return raw BibTeX entry (if available). + +=head1 AUTHOR + +Gerhard Gossen <gerhard.gossen@googlemail.com> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2013 by Gerhard Gossen. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/Master/texmf-dist/scripts/bibtexperllibs/LaTeX/ToUnicode.pm b/Master/texmf-dist/scripts/bibtexperllibs/LaTeX/ToUnicode.pm new file mode 100644 index 00000000000..361daf49296 --- /dev/null +++ b/Master/texmf-dist/scripts/bibtexperllibs/LaTeX/ToUnicode.pm @@ -0,0 +1,157 @@ +use strict; +use warnings; +package LaTeX::ToUnicode; +BEGIN { + $LaTeX::ToUnicode::VERSION = '0.03'; +} +#ABSTRACT: Convert LaTeX commands to Unicode + + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw( convert ); + +use utf8; +use LaTeX::ToUnicode::Tables; + + +sub convert { + my ( $string, %options ) = @_; + $string = _convert_commands( $string ); + $string = _convert_accents( $string ); + $string = _convert_german( $string ) if $options{german}; + $string = _convert_symbols( $string ); + $string = _convert_specials( $string ); + $string = _convert_markups( $string ); + $string =~ s/{(\w*)}/$1/g; + $string; +} + +sub _convert_accents { + my $string = shift; + $string =~ s/({\\(.){(\\?\w{1,2})}})/$LaTeX::ToUnicode::Tables::ACCENTS{$2}{$3} || $1/eg; # {\"{a}} + $string =~ s/({\\(.)(\\?\w{1,2})})/$LaTeX::ToUnicode::Tables::ACCENTS{$2}{$3} || $1/eg; # {\"a} + $string; +} + +sub _convert_specials { + my $string = shift; + my $specials = join( '|', @LaTeX::ToUnicode::Tables::SPECIALS ); + my $pattern = qr/\\($specials)/o; + $string =~ s/$pattern/$1/g; + $string =~ s/\\\$/\$/g; + $string; +} + +sub _convert_commands { + my $string = shift; + + foreach my $command ( keys %LaTeX::ToUnicode::Tables::COMMANDS ) { + $string =~ s/{\\$command}/$LaTeX::ToUnicode::Tables::COMMANDS{$command}/g; + $string =~ s/\\$command(?=\s|\b)/$LaTeX::ToUnicode::Tables::COMMANDS{$command}/g; + } + + $string; +} + +sub _convert_german { + my $string = shift; + + foreach my $symbol ( keys %LaTeX::ToUnicode::Tables::GERMAN ) { + $string =~ s/\Q$symbol\E/$LaTeX::ToUnicode::Tables::GERMAN{$symbol}/g; + } + $string; +} + +sub _convert_symbols { + my $string = shift; + + foreach my $symbol ( keys %LaTeX::ToUnicode::Tables::SYMBOLS ) { + $string =~ s/{\\$symbol}/$LaTeX::ToUnicode::Tables::SYMBOLS{$symbol}/g; + $string =~ s/\\$symbol\b/$LaTeX::ToUnicode::Tables::SYMBOLS{$symbol}/g; + } + $string; +} + +sub _convert_markups { + my $string = shift; + + my $markups = join( '|', @LaTeX::ToUnicode::Tables::MARKUPS ); + $string =~ s/({[^{}]+)\\(?:$markups)\s+([^{}]+})/$1$2/g; # { ... \command ... } + my $pattern = qr/{\\(?:$markups)\s+([^{}]*)}/o; + $string =~ s/$pattern/$1/g; + + $string =~ s/``/“/g; + $string =~ s/`/”/g; + $string =~ s/''/‘/g; + $string =~ s/'/’/g; + $string; +} + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +LaTeX::ToUnicode - Convert LaTeX commands to Unicode + +=head1 VERSION + +version 0.03 + +=head1 SYNOPSIS + + use LaTeX::ToUnicode qw( convert ); + + convert( '{\"a}' ) eq 'ä'; # true + convert( '"a', german => 1 ) eq 'ä'; # true, `german' package syntax + convert( '"a', ) eq '"a'; # not enabled by default + +=head1 DESCRIPTION + +This module provides a method to convert LaTeX-style markups for accents etc. +into their Unicode equivalents. It translates commands for special characters +or accents into their Unicode equivalents and removes formatting commands. + +I use this module to convert values from BibTeX files into plain text, if your +use case is different, YMMV. + +In contrast to L<TeX::Encode>, this module does not create HTML of any kind. + +=head1 FUNCTIONS + +=head2 convert( $string, %options ) + +Convert the text in C<$string> that contains LaTeX into a plain(er) Unicode +string. All escape sequences for special characters (e.g. \i, \"a, ...) are +converted, formatting commands (e.g. {\it ...}) are removed. + +C<%options> allows you to enable additional translations. This values are +recognized: + +=over + +=item C<german> + +If true, the commands introduced by the package `german' (e.g. C<"a> eq C<ä>, +note the missing backslash) are also handled. + +=back + +=head1 AUTHOR + +Gerhard Gossen <gerhard.gossen@googlemail.com> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by Gerhard Gossen. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/Master/texmf-dist/scripts/bibtexperllibs/LaTeX/ToUnicode/Tables.pm b/Master/texmf-dist/scripts/bibtexperllibs/LaTeX/ToUnicode/Tables.pm new file mode 100644 index 00000000000..f4fa958b69c --- /dev/null +++ b/Master/texmf-dist/scripts/bibtexperllibs/LaTeX/ToUnicode/Tables.pm @@ -0,0 +1,510 @@ +package LaTeX::ToUnicode::Tables; +BEGIN { + $LaTeX::ToUnicode::Tables::VERSION = '0.03'; +} +use strict; +use warnings; +#ABSTRACT: Character tables for LaTeX::ToUnicode + +use utf8; + + +our %COMMANDS = ( + 'LaTeX' => 'LaTeX', + 'TeX' => 'TEX', + '-' => '', # hypenation + '/' => '', # italic correction + 'log' => 'log', +); + + +our @SPECIALS = ( qw( $ % & _ { } ), '#' ); + + +our %SYMBOLS = ( # Table 3.2 in Lamport + 'aa' => 'å', + 'AA' => 'Å', + 'ae' => 'æ', + 'AE' => 'Æ', + 'dh' => 'ð', + 'DH' => 'Ð', + 'dj' => 'đ', + 'DJ' => 'Ð', + 'i' => chr(0x131), # small dotless i + 'l' => 'ł', + 'L' => 'Ł', + 'ng' => 'ŋ', + 'NG' => 'Ŋ', + 'oe' => 'œ', + 'OE' => 'Œ', + 'o' => 'ø', + 'O' => 'Ø', + 'ss' => 'ß', + 'SS' => 'SS', + 'th' => 'þ', + 'TH' => 'Þ', + 'TM' => chr(0x2122), +); + + +our %ACCENTS = ( + "\"" => { + A => "\304", + E => "\313", + H => "\x{1e26}", + I => "\317", + O => "\326", + U => "\334", + W => "\x{1e84}", + X => "\x{1e8c}", + Y => "\x{178}", + "\\I" => "\317", + "\\i" => "\357", + a => "\344", + e => "\353", + h => "\x{1e27}", + i => "\357", + o => "\366", + t => "\x{1e97}", + u => "\374", + w => "\x{1e85}", + x => "\x{1e8d}", + y => "\377" + }, + "'" => { + A => "\301", + AE => "\x{1fc}", + C => "\x{106}", + E => "\311", + G => "\x{1f4}", + I => "\315", + K => "\x{1e30}", + L => "\x{139}", + M => "\x{1e3e}", + N => "\x{143}", + O => "\323", + P => "\x{1e54}", + R => "\x{154}", + S => "\x{15a}", + U => "\332", + W => "\x{1e82}", + Y => "\335", + Z => "\x{179}", + "\\I" => "\315", + "\\i" => "\355", + a => "\341", + ae => "\x{1fd}", + c => "\x{107}", + e => "\351", + g => "\x{1f5}", + i => "\355", + k => "\x{1e31}", + l => "\x{13a}", + m => "\x{1e3f}", + n => "\x{144}", + o => "\363", + p => "\x{1e55}", + r => "\x{155}", + s => "\x{15b}", + u => "\372", + w => "\x{1e83}", + y => "\375", + z => "\x{17a}" + }, + "." => { + A => "\x{226}", + B => "\x{1e02}", + C => "\x{10a}", + D => "\x{1e0a}", + E => "\x{116}", + F => "\x{1e1e}", + G => "\x{120}", + H => "\x{1e22}", + I => "\x{130}", + M => "\x{1e40}", + N => "\x{1e44}", + O => "\x{22e}", + P => "\x{1e56}", + R => "\x{1e58}", + S => "\x{1e60}", + T => "\x{1e6a}", + W => "\x{1e86}", + X => "\x{1e8a}", + Y => "\x{1e8e}", + Z => "\x{17b}", + "\\I" => "\x{130}", + a => "\x{227}", + b => "\x{1e03}", + c => "\x{10b}", + d => "\x{1e0b}", + e => "\x{117}", + f => "\x{1e1f}", + g => "\x{121}", + h => "\x{1e23}", + m => "\x{1e41}", + n => "\x{1e45}", + o => "\x{22f}", + p => "\x{1e57}", + r => "\x{1e59}", + s => "\x{1e61}", + t => "\x{1e6b}", + w => "\x{1e87}", + x => "\x{1e8b}", + y => "\x{1e8f}", + z => "\x{17c}" + }, + "=" => { + A => "\x{100}", + AE => "\x{1e2}", + E => "\x{112}", + G => "\x{1e20}", + I => "\x{12a}", + O => "\x{14c}", + U => "\x{16a}", + Y => "\x{232}", + "\\I" => "\x{12a}", + "\\i" => "\x{12b}", + a => "\x{101}", + ae => "\x{1e3}", + e => "\x{113}", + g => "\x{1e21}", + i => "\x{12b}", + o => "\x{14d}", + u => "\x{16b}", + y => "\x{233}" + }, + H => { + O => "\x{150}", + U => "\x{170}", + o => "\x{151}", + u => "\x{171}" + }, + "^" => { + A => "\302", + C => "\x{108}", + E => "\312", + G => "\x{11c}", + H => "\x{124}", + I => "\316", + J => "\x{134}", + O => "\324", + S => "\x{15c}", + U => "\333", + W => "\x{174}", + Y => "\x{176}", + Z => "\x{1e90}", + "\\I" => "\316", + "\\i" => "\356", + a => "\342", + c => "\x{109}", + e => "\352", + g => "\x{11d}", + h => "\x{125}", + i => "\356", + j => "\x{135}", + o => "\364", + s => "\x{15d}", + u => "\373", + w => "\x{175}", + y => "\x{177}", + z => "\x{1e91}" + }, + "`" => { + A => "\300", + E => "\310", + I => "\314", + N => "\x{1f8}", + O => "\322", + U => "\331", + W => "\x{1e80}", + Y => "\x{1ef2}", + "\\I" => "\314", + "\\i" => "\354", + a => "\340", + e => "\350", + i => "\354", + n => "\x{1f9}", + o => "\362", + u => "\371", + w => "\x{1e81}", + y => "\x{1ef3}" + }, + c => { + C => "\307", + D => "\x{1e10}", + E => "\x{228}", + G => "\x{122}", + H => "\x{1e28}", + K => "\x{136}", + L => "\x{13b}", + N => "\x{145}", + R => "\x{156}", + S => "\x{15e}", + T => "\x{162}", + c => "\347", + d => "\x{1e11}", + e => "\x{229}", + g => "\x{123}", + h => "\x{1e29}", + k => "\x{137}", + l => "\x{13c}", + n => "\x{146}", + r => "\x{157}", + s => "\x{15f}", + t => "\x{163}" + }, + d => { + A => "\x{1ea0}", + B => "\x{1e04}", + D => "\x{1e0c}", + E => "\x{1eb8}", + H => "\x{1e24}", + I => "\x{1eca}", + K => "\x{1e32}", + L => "\x{1e36}", + M => "\x{1e42}", + N => "\x{1e46}", + O => "\x{1ecc}", + R => "\x{1e5a}", + S => "\x{1e62}", + T => "\x{1e6c}", + U => "\x{1ee4}", + V => "\x{1e7e}", + W => "\x{1e88}", + Y => "\x{1ef4}", + Z => "\x{1e92}", + "\\I" => "\x{1eca}", + "\\i" => "\x{1ecb}", + a => "\x{1ea1}", + b => "\x{1e05}", + d => "\x{1e0d}", + e => "\x{1eb9}", + h => "\x{1e25}", + i => "\x{1ecb}", + k => "\x{1e33}", + l => "\x{1e37}", + m => "\x{1e43}", + n => "\x{1e47}", + o => "\x{1ecd}", + r => "\x{1e5b}", + s => "\x{1e63}", + t => "\x{1e6d}", + u => "\x{1ee5}", + v => "\x{1e7f}", + w => "\x{1e89}", + y => "\x{1ef5}", + z => "\x{1e93}" + }, + h => { + A => "\x{1ea2}", + E => "\x{1eba}", + I => "\x{1ec8}", + O => "\x{1ece}", + U => "\x{1ee6}", + Y => "\x{1ef6}", + "\\I" => "\x{1ec8}", + "\\i" => "\x{1ec9}", + a => "\x{1ea3}", + e => "\x{1ebb}", + i => "\x{1ec9}", + o => "\x{1ecf}", + u => "\x{1ee7}", + y => "\x{1ef7}" + }, + k => { + A => "\x{104}", + E => "\x{118}", + I => "\x{12e}", + O => "\x{1ea}", + U => "\x{172}", + "\\I" => "\x{12e}", + "\\i" => "\x{12f}", + a => "\x{105}", + e => "\x{119}", + i => "\x{12f}", + o => "\x{1eb}", + u => "\x{173}" + }, + r => { + A => "\305", + U => "\x{16e}", + a => "\345", + u => "\x{16f}", + w => "\x{1e98}", + y => "\x{1e99}" + }, + u => { + A => "\x{102}", + E => "\x{114}", + G => "\x{11e}", + I => "\x{12c}", + O => "\x{14e}", + U => "\x{16c}", + "\\I" => "\x{12c}", + "\\i" => "\x{12d}", + a => "\x{103}", + e => "\x{115}", + g => "\x{11f}", + i => "\x{12d}", + o => "\x{14f}", + u => "\x{16d}" + }, + v => { + A => "\x{1cd}", + C => "\x{10c}", + D => "\x{10e}", + DZ => "\x{1c4}", + E => "\x{11a}", + G => "\x{1e6}", + H => "\x{21e}", + I => "\x{1cf}", + K => "\x{1e8}", + L => "\x{13d}", + N => "\x{147}", + O => "\x{1d1}", + R => "\x{158}", + S => "\x{160}", + T => "\x{164}", + U => "\x{1d3}", + Z => "\x{17d}", + "\\I" => "\x{1cf}", + "\\i" => "\x{1d0}", + a => "\x{1ce}", + c => "\x{10d}", + d => "\x{10f}", + dz => "\x{1c6}", + e => "\x{11b}", + g => "\x{1e7}", + h => "\x{21f}", + i => "\x{1d0}", + j => "\x{1f0}", + k => "\x{1e9}", + l => "\x{13e}", + n => "\x{148}", + o => "\x{1d2}", + r => "\x{159}", + s => "\x{161}", + t => "\x{165}", + u => "\x{1d4}", + z => "\x{17e}" + }, + "~" => { + A => "\303", + E => "\x{1ebc}", + I => "\x{128}", + N => "\321", + O => "\325", + U => "\x{168}", + V => "\x{1e7c}", + Y => "\x{1ef8}", + "\\I" => "\x{128}", + "\\i" => "\x{129}", + a => "\343", + e => "\x{1ebd}", + i => "\x{129}", + n => "\361", + o => "\365", + u => "\x{169}", + v => "\x{1e7d}", + y => "\x{1ef9}" + } +); + + +our %GERMAN = ( # for package `german'/`ngerman' + '"a' => 'ä', + '"A' => 'Ä', + '"e' => 'ë', + '"E' => 'Ë', + '"i' => 'ï', + '"I' => 'Ï', + '"o' => 'ö', + '"O' => 'Ö', + '"u' => 'ü', + '"U' => 'Ü', + '"s' => 'ß', + '"S' => 'SS', + '"z' => 'ß', + '"Z' => 'SZ', + '"ck' => 'ck', # old spelling: ck -> k-k + '"ff' => 'ff', # old spelling: ff -> ff-f + '"`' => '„', + "\"'" => '“', + '"<' => '«', + '">' => '»', + '"-' => "\x{AD}", # soft hyphen + '""' => "\x{200B}", # zero width space + '"~' => "\x{2011}", # non-breaking hyphen + '"=' => '-', + '\glq' => '‚', # left german single quote + '\grq' => '‘', # right german single quote + '\flqq' => '«', + '\frqq' => '»', + '\dq' => '"', +); + + +our @MARKUPS = ( qw( em tt small sl bf sc rm it cal ) ); + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +LaTeX::ToUnicode::Tables - Character tables for LaTeX::ToUnicode + +=head1 VERSION + +version 0.03 + +=head1 CONSTANTS + +=head2 %COMMANDS + +Names of argument-less commands like C<\LaTeX> as keys. +Values are the replacements. + +=head2 @SPECIALS + +TeX's metacharacters that need to be escaped in TeX documents + +=head2 %SYMBOLS + +Predefined escape commands for extended characters. + +=head2 %ACCENTS + +Two-level hash of accented characters like C<\'{a}>. The keys of this hash +are the accent symbols, e.g C<`>, C<"> or C<'>. The corresponding values are +references to hashes, where the keys are the base letters and the values are +the decoded characters. As an example, C<< $ACCENTS{'`'}->{a} eq 'à' >>. + +=head2 %GERMAN + +Escape sequences as defined by the package `german'/`ngerman', e.g. +C<"a> (a with umlaut), C<"s> (german sharp s) or C<"`"> (german left quote). +Note the missing backslash. + +The keys of this hash are the literal escape sequences. + +=head2 @MARKUPS + +Command names of formatting commands like C<\tt> + +=head1 AUTHOR + +Gerhard Gossen <gerhard.gossen@googlemail.com> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by Gerhard Gossen. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + |