File Coverage

blib/lib/LaTeX/ToUnicode.pm

Criterion	Covered	Total	%
statement	132	187	70.5
branch	19	50	38.0
condition	0	3	0.0
subroutine	18	21	85.7
pod	2	3	66.6
total	171	264	64.7

use strict;
use warnings;
package LaTeX::ToUnicode;
BEGIN {
  $LaTeX::ToUnicode::VERSION = '1.95';
}
#ABSTRACT: Convert LaTeX commands to Unicode (simplistically)

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( convert debuglevel $endcw );

use utf8;
use Encode;
use LaTeX::ToUnicode::Tables;

# Terminating a control word (not symbol) the way TeX does: at the
# boundary between a letter (lookbehind) and a nonletter (lookahead),
# and then ignore any following whitespace.
our $endcw = qr/(?<=[a-zA-Z])(?=[^a-zA-Z]|$)\s*/;

# Debugging output on or off; it's pretty random what gets output.
# Add more as needed. There is also more debugging output as warn
# statements, commented out, too voluminous to enable here.
my $debug = 0;

sub debuglevel { $debug = shift; }
sub _debug {
  return unless $debug;
  # The backtrace info is split between caller(0) and caller(1), sigh.
  # We don't need the package name, it's included in $subr in practice.
  my (undef,$filename,$line,undef) = caller(0);
  my (undef,undef,undef,$subr) = caller(1);
  warn @_, " at $filename:$line ($subr)\n";
}

# The main conversion function.
#
sub convert {
    my ($string, %options) = @_;
    #warn debug_hash_as_string("starting with: $string", %options);

    # First, remove leading and trailing horizontal whitespace
    # on each line of the possibly-multiline string we're given.
    $string =~ s/^[ \t]*//m;
    $string =~ s/[ \t]*$//m;

    # For HTML output, must convert special characters that were in the
    # TeX text (&<>) to their entities to avoid misparsing. We want to
    # do this first, because conversion of the markup commands might
    # output HTML tags like , and we don't want to convert those <>.
    # Although <tt> works, better to keep the output HTML as
    # human-readable as we can.
    #
    if ($options{html}) {
        $string =~ s/([^\\]|^)&/$1&/g;
        $string =~ s/
        $string =~ s/>/>/g;
    }

    my $user_hook = $options{hook};
    if ($user_hook) {
        _debug("before user hook: $string");
        $string = &$user_hook($string, \%options);
        _debug("after user hook: $string");
    }

    # Convert general commands that take arguments, since (1) they might
    # insert TeX commands that need to be converted, and (2) because
    # their arguments could well contain constructs that will map to a
    # Perl string \x{nnnn} for Unicode character nnnn; those Perl braces
    # for the \x will confuse further parsing of the TeX.
    #
    $string = _convert_commands_with_arg($string);
    _debug("after commands with arg: $string");

    # Convert markups (\texttt, etc.); they have the same brace-parsing issue.
    $string = _convert_markups($string, \%options);
    _debug("after markups: $string");

    # And urls, a special case of commands with arguments.
    $string = _convert_urls($string, \%options);
    _debug("after urls: $string");

    $string = _convert_control_words($string);
    _debug("after control words: $string");

    $string = _convert_control_symbols($string);
    _debug("after control symbols: $string");

    $string = _convert_accents($string);
    $string = _convert_german($string) if $options{german};
    $string = _convert_symbols($string);
    $string = _convert_ligatures($string);
    $string = _convert_glue_etc_primitives($string);
    _debug("after the rest: $string");

    # Let's handle ties here, after all the other conversions, since
    # they don't fit well with any of the tables. We don't handle TeX's
    # other special characters: $ & # ^ _.
    #
    # /~, or ~ at the beginning of a line, is probably part of a url or
    # path, not a tie. Otherwise, consider it a space, since we can't
    # distinguish true no-break spots (Donald~E. Knuth) from ties that
    # are only relevant to a particular line width.
    #
    $string =~ s,([^/])~,$1 ,g;

    # After all the conversions, $string contains \x{....} constructs
    # (Perl Unicode characters) where translations have happened. Change
    # those to the desired output format. Thus we assume that the
    # Unicode \x{....}'s are not themselves involved in further
    # translations, which is, so far, true.
    #
    if (! $options{entities}) {
      # Convert our \x strings from Tables.pm to the binary characters.

      # As an extra-special case, we want to preserve the translation of
      # \{ and \} as 007[bd] entities even if the --entities option is
      # not give; otherwise they'd get eliminated like all other braces.
      # Use a temporary cs \xx to keep them marked, and don't use braces
      # to delimit the argument since they'll get deleted.
      $string =~ s/\\x\{(007[bd])\}/\\xx($1)/g;

      # Convert all other characters to characters.
      # Assume exactly four hex digits, since we wrote Tables.pm that way.
      $string =~ s/\\x\{(....)\}/ pack('U*', hex($1))/eg;

    } elsif ($options{entities}) {
      # Convert the XML special characters that appeared in the input,
      # e.g., from a TeX \&. Unless we're generating HTML output, in
      # which case they have already been converted.
      if (! $options{html}) {
          $string =~ s/&/&/g;
          $string =~ s/
          $string =~ s/>/>/g;
      }

      # Our values in Tables.pm are simple ASCII strings \x{....},
      # so we can replace them with hex entities with no trouble.
      # Fortunately TeX does not have a standard \x control sequence.
      $string =~ s/\\x\{(....)\}/&#x$1;/g;

      # The rest of the job is about binary Unicode characters in the
      # input. We want to transform them into entities also. As always
      # in Perl, there's more than one way to do it, and several are
      # described here, just for the fun of it.
      my $ret = "";
      #
      # decode_utf8 is described in https://perldoc.perl.org/Encode.
      # Without the decode_utf8, all of these methods output each byte
      # separately; apparently $string is a byte string at this point,
      # not a Unicode string. I don't know why that is.
      $ret = decode_utf8($string);
      #
      # Transform everything that's not printable ASCII or newline into
      # entities.
      $ret =~ s/([^ -~\n])/ sprintf("&#x%04x;", ord($1)) /eg;
      #
      # This method leaves control characters as literal; doesn't matter
      # for XML output, since control characters aren't allowed, but
      # let's use the regexp method anyway.
      #$ret = encode("ascii", decode_utf8($string), Encode::FB_XMLCREF);
      #
      # The nice_string function from perluniintro also works.
      #
      # This fails, just outputs numbers (that is, ord values):
      # foreach my $c (unpack("U*", $ret)) {
      #
      # Without the decode_utf8, outputs each byte separately.
      # With the decode_utf8, works, but the above seems cleaner.
      #foreach my $c (split(//, $ret)) {
      #  if (ord($c) <= 31 || ord($c) >= 128) {
      #    $ret .= sprintf("&#x%04x;", ord($c));
      #  } else {
      #    $ret .= $c;
      #  }
      #}
      #
      $string = $ret; # assigned from above.
    }

    if ($string =~ /\\x\{/) {
      warn "LaTeX::ToUnicode::convert: untranslated \\x remains: $string\n";
      warn "LaTeX::ToUnicode::convert:   please report as bug.\n";
    }

    # Drop all remaining braces.
    $string =~ s/[{}]//g;

    if (! $options{entities}) {
      # With all the other braces gone, now we can convert the preserved
      # brace entities from \{ and \} to actual braces.
      $string =~ s/\\xx\((007[bd])\)/ pack('U*', hex($1))/eg;
    }

    # Backslashes might remain. Don't remove them, as it makes for a
    # useful way to find unhandled commands.

    # leave newlines alone, but trim spaces and tabs.
    $string =~ s/^[ \t]+//s;  # remove leading whitespace
    $string =~ s/[ \t]+$//s;  # remove trailing whitespace
    $string =~ s/[ \t]+/ /gs; # collapse all remaining whitespace to one space

    $string;
}

#  Convert commands that take a single braced argument. The table
# defines text we're supposed to insert before and after the argument.
# We let future processing handle conversion of both the inserted text
# and the argument.
#
sub _convert_commands_with_arg {
    my $string = shift;

    foreach my $cmd ( keys %LaTeX::ToUnicode::Tables::ARGUMENT_COMMANDS ) {
        my $repl = $LaTeX::ToUnicode::Tables::ARGUMENT_COMMANDS{$cmd};
        my $lft = $repl->[0]; # ref to two-element list
        my $rht = $repl->[1];
        # \cmd{foo} -> LFT foo RHT
        $string =~ s/\\$cmd${endcw}\{(.*?)\}/$lft$1$rht/g;
        #warn "replaced arg $cmd, yielding $string\n";
    }

    $string;
}

#  Convert url commands in STRING. This is a special case of commands
# with arguments: \url{u} and \href{u}{desc text}. The HTML output
# (generated if $OPTIONS{html} is set) is just too special to be handled
# in a table; further, \href is the only two-argument command we are
# currently handling.
#
sub _convert_urls {
    my ($string,$options) = @_;

    if ($options->{html}) {
        # HTML output.
        # \url{URL} -> URL
        $string =~ s,\\url$endcw\{([^}]*)\}
                    ,$1,gx;
        #
        # \href{URL}{TEXT} -> TEXT
        #warn "html href: $string\n" if $string =~ /href/;
        $string =~ s,\\href$endcw\{([^}]*)\}\s*\{([^}]*)\}
                    ,$2,gx;

    } else {
        # plain text output.
        # \url{URL} -> URL
        $string =~ s/\\url$endcw\{([^}]*)\}/$1/g;
        #
        # \href{URL}{TEXT} -> TEXT (URL)
        # but, as a special case, if URL ends with TEXT, just output URL,
        # as in:
        #   \href{https://doi.org/10/fjzzc8}{10/fjzzc8}
        # ->
        #   https://doi.org/10/fjzzc8
        #
        # Yet more specialness: the TEXT might have extra braces, as in
        #   \href{https://doi.org/10/fjzzc8}{{10/fjzzc8}}
        # left over from previous markup commands (\path) which got
        # removed.  We want to accept and ignore such extra braces,
        # hence the \{+ ... \}+ in recognizing TEXT.
        #
        #warn "txt url: starting with $string\n" if $string =~ /href/;
        if ($string =~ m/\\href$endcw\{([^}]*)\}\s*\{+([^}]*)\}+/) {
          my $url = $1;
          my $text = $2;
          #warn "    url: $url\n";
          #warn "   text: $text\n";
          my $repl = ($url =~ m!$text$!) ? $url : "$text ($url)";
          #warn "   repl: $repl\n";
          $string =~ s/\\href$endcw\{([^}]*)\}\s*\{+([^}]*)\}+/$repl/;
          #warn " result:  $string\n";
        }
    }

    $string;
}

#  Convert control words (not symbols), that is, a backslash and an
# alphabetic sequence of characters terminated by a non-alphabetic
# character. Following whitespace is ignored.
#
sub _convert_control_words {
    my $string = shift;

    foreach my $command ( keys %LaTeX::ToUnicode::Tables::CONTROL_WORDS ) {
        my $repl = $LaTeX::ToUnicode::Tables::CONTROL_WORDS{$command};
        # replace {\CMD}, whitespace ignored after \CMD.
        $string =~ s/\{\\$command$endcw\}/$repl/g;

        # replace \CMD, preceded by not-consumed non-backslash.
        $string =~ s/(?<=[^\\])\\$command$endcw/$repl/g;

        # replace \CMD at beginning of whole string, which otherwise
        # wouldn't be matched. Two separate regexps to avoid
        # variable-length lookbehind.
        $string =~ s/^\\$command$endcw/$repl/g;
    }

    $string;
}

#  Convert control symbols, other than accents. Much simpler than
# control words, since are self-delimiting, don't take arguments, and
# don't consume any following text.
#
sub _convert_control_symbols {
    my $string = shift;

    foreach my $symbol ( keys %LaTeX::ToUnicode::Tables::CONTROL_SYMBOLS ) {
        my $repl = $LaTeX::ToUnicode::Tables::CONTROL_SYMBOLS{$symbol};

        # because these are not alphabetic, we can quotemeta them,
        # and we need to because "\" is one of the symbols.
        my $rx = quotemeta($symbol);

        # the preceding character must not be a backslash, else "\\ "
        # could have the "\ " seen first as a control space, leaving
        # a spurious \ behind. Don't consume the preceding.
        # Or it could be at the beginning of a line.
        #
        $string =~ s/(^|(?<=[^\\]))\\$rx/$repl/g;
        #warn "after sym $symbol (\\$rx -> $repl), have: $string\n";
    }

    $string;
}

# Convert accents.
#
sub _convert_accents {
    my $string = shift;

    # first the non-alphabetic accent commands, like \".
    my %tbl = %LaTeX::ToUnicode::Tables::ACCENT_SYMBOLS;
    $string =~ s/(\{\\(.)\s*\{(\\?\w{1,2})\}\})/$tbl{$2}{$3} || $1/eg; #{\"{a}}
    $string =~ s/(\{\\(.)\s*(\\?\w{1,2})\})/    $tbl{$2}{$3} || $1/eg; # {\"a}
    $string =~ s/(\\(.)\s*(\\?\w{1,1}))/        $tbl{$2}{$3} || $1/eg; # \"a
    $string =~ s/(\\(.)\s*\{(\\?\w{1,2})\})/    $tbl{$2}{$3} || $1/eg; # \"{a}

    # second the alphabetic commands, like \c. They have to be handled
    # differently because \cc is not \c{c}! The only difference in the
    # regular expressions is using $endcw instead of just \s*.
    #
    %tbl = %LaTeX::ToUnicode::Tables::ACCENT_LETTERS;
    $string =~ s/(\{\\(.)$endcw\{(\\?\w{1,2})\}\})/$tbl{$2}{$3} || $1/eg; #{\"{a}}
    $string =~ s/(\{\\(.)$endcw(\\?\w{1,2})\})/    $tbl{$2}{$3} || $1/eg; # {\"a}
    $string =~ s/(\\(.)$endcw(\\?\w{1,1}))/        $tbl{$2}{$3} || $1/eg; # \"a
    $string =~ s/(\\(.)$endcw\{(\\?\w{1,2})\})/    $tbl{$2}{$3} || $1/eg; # \"{a}


    # The argument is just one \w character for the \"a case, not two,
    # because otherwise we might consume a following character that is
    # not part of the accent, e.g., a backslash (\"a\'e).
    #
    # Others can be two because of the \t tie-after accent. Even {\t oo} is ok.
    #
    # Allow whitespace after the \CMD in all cases, e.g., "\c c". Even
    # for the control symbols, it turns out spaces are ignored there
    # (as in \" o), unlike the usual syntax.
    #
    # Some non-word constituents would work, but in practice we hope
    # everyone just uses letters.

    $string;
}

# For the [n]german package.
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;
}

# Control words that produce printed symbols (and letters in languages
# other than English), that is.
#
sub _convert_symbols {
    my $string = shift;

    foreach my $symbol ( keys %LaTeX::ToUnicode::Tables::SYMBOLS ) {
        my $repl = $LaTeX::ToUnicode::Tables::SYMBOLS{$symbol};
        # preceded by a (non-consumed) non-backslash,
        # usual termination for a control word.
        # These commands don't take arguments.
        $string =~ s/(?<=[^\\])\\$symbol$endcw/$repl/g;

        # or the beginning of the whole string:
        $string =~ s/^\\$symbol$endcw/$repl/g;
    }
    $string;
}

# Special character sequences, not \commands. They aren't all
# technically ligatures, but no matter.
#
sub _convert_ligatures {
    my $string = shift;

    # have to convert these in order specified.
    my @ligs = @LaTeX::ToUnicode::Tables::LIGATURES;
    for (my $i = 0; $i < @ligs; $i+=2) {
        my $in = $ligs[$i];
        my $out = $ligs[$i+1];
        $string =~ s/\Q$in\E/$out/g;
    }
    $string;
}


# Remove primitives like \kern, \hskip, \penalty, etc.
#
sub _convert_glue_etc_primitives {
  my ($string) = @_;

  # Remove kerns. Clearly needs generalizing/sharpening to recognize
  # dimens better, and plenty of other commands could use it.
  # Here, we only handle literal dimensions ("+1.3pt"), not dimens
  # referring to control sequences, with or without factors
  # ("1.1\baselineskip").
  #_debug("before kern: $string");
  my $dimen_re = qr/[-+]?[0-9., ]+[a-z][a-z]\s*/;
  $string =~ s!\\kern${endcw}${dimen_re}!!g;

  # Let's do \hfuzz and \vfuzz too. They come up pretty often and it's
  # practically the same thing (just also ignore optional =)..
  $string =~ s!\\[hv]fuzz${endcw}=?\s*${dimen_re}!!g;

  # \hskip and \vskip are dimens possibly preceded by "plus" or "minus".
  # In contrast to the above, output a space as the replacement,
  # to avoid words running together.
  my $glue_re = qr/${dimen_re}((plus|minus)${dimen_re})*/;
  $string =~ s!\\[hv]skip${endcw}\s*${glue_re}! !g;

  # And here is \penalty. natbib outputs \penalty0 sometimes.
  # Similar with $dimen_re, we only handle literal decimal
  # integers here, not things like "0 or `A.
  my $number_re = qr/[-+]?[0-9]+\s*/;
  $string =~ s!\\penalty${endcw}\s*${number_re}!!g;

  # \looseness is almost the same as \penalty; also accept an optional =.
  $string =~ s!\\looseness${endcw}\s*=?\s*${number_re}!!g;


  return $string;
}

#
# Convert LaTeX markup commands in STRING like \textbf{...} and
# {\bfshape ...} and {\bf ...}.
#
# If we're aiming for plain text output, they are just cleared away (the
# braces are not removed).
#
# If we're generating HTML output ("html" key is set in $OPTIONS hash
# ref), we use the value in the hash, so that \textbf{foo} becomes
# foo. Nested markup doesn't work.
#
sub _convert_markups {
    my ($string, $options) = @_;

    # HTML is different.
    return _convert_markups_html($string) if $options->{html};

    # Not HTML, so here we'll "convert" to plain text by removing the
    # markup commands.

    # we can do all the markup commands at once.
    my $markups = join('|', keys %LaTeX::ToUnicode::Tables::MARKUPS);

    #warn "_convert_markups: markups = $markups\n";
    #warn "_convert_markups plain text: starting with $string\n";
    # Remove \textMARKUP{...}, leaving just the {...}
    $string =~ s/\\text($markups)$endcw//g;
    #warn " after \text: $string\n";

    # Similarly remove \MARKUPshape, plus remove \upshape.
    $string =~ s/\\($markups|up)shape$endcw//g;
    #warn " after \...shape: $string\n";

    # Remove braces and \command in: {... \MARKUP ...}
    # where neither ... can contain braces.
    $string =~ s/(\{[^{}]+)\\(?:$markups)$endcw([^{}]+\})/$1$2/g;
    #warn " after ...\\markup...: $string\n";

    # Remove braces and \command in: {\MARKUP ...}
    $string =~ s/\{\\(?:$markups)$endcw([^{}]*)\}/$1/g;
    #warn " after {\\markup...}: $string\n";

    # Remove: {\MARKUP
    # Although this will leave unmatched } chars behind, there's no
    # alternative without full parsing, since the bib entry will often
    # look like: {\em {The TeX{}book}}. Also might, in principle, be
    # at the end of a line.
    $string =~ s/\{\\(?:$markups)$endcw//g;
    #warn " after {\\markup: $string\n";

    # Remove braces and \command in: \MARKUP ...}
    # We might have previously removed some braces, and no longer have
    # the matching {.  Happens with {\sl ... \bf ...}, e.g., Wermuth bbls.
    $string =~ s/\\(?:$markups)$endcw(.*)\}/$1/g;
    #warn " after \\markup...}: $string\n";

    # Ultimately we remove all braces in ltx2crossrefxml SanitizeText fns,
    # so the unmatched braces don't matter ... that code should be moved here.

    $string;
}

# Convert \markup in STRING to html. We can't always figure out where to
# put the end tag, but we always put it somewhere. We don't even attempt
# to handle nested markup.
#
sub _convert_markups_html {
    my ($string) = @_;

    my %MARKUPS = %LaTeX::ToUnicode::Tables::MARKUPS;
    # have to consider each markup \command separately.
    for my $markup (keys %MARKUPS) {
        my $hcmd = $MARKUPS{$markup}; # some TeX commands don't translate
        my $tag = $hcmd ? "<$hcmd>" : "";
        my $end_tag = $hcmd ? "" : "";

        # The easy one: \textMARKUP{...}
        $string =~ s/\\text$markup$endcw\{(.*?)\}/$tag$1$end_tag/g;

        # {x\MARKUP(shape) y} -> xy (leave out braces)
        $string =~ s/\{([^{}]+)\\$markup(shape)?$endcw([^{}]+)\}
                    /$1$tag$3$end_tag/gx;

        # {\MARKUP(shape) y} -> y
        # or
        # \MARKUP(shape) y} -> y (without the {).
        # Same as previous but without the x part. Could do it in one
        # regex but this seems clearer. The { might be missing due to
        # previous brace removals, as above.
        $string =~ s/\{?\s*\\$markup(shape)?$endcw([^{}]+)\}
                    /$tag$2$end_tag/gx;

        # for {\MARKUP(shape) ... with no matching right brace, we don't know
        # where to put the end tag, so seems best to do nothing.
    }

    $string;
}


##############################################################
#  debug_hash_as_string($LABEL, HASH)
#
# Return LABEL followed by HASH elements, followed by a newline, as a
# single string. If HASH is a reference, it is followed (but no recursive
# derefencing).
###############################################################
sub debug_hash_as_string {
    my ($label) = shift;
    my (%hash) = (ref $_[0] && $_[0] =~ /.*HASH.*/) ? %{$_[0]} : @_;

    my $str = "$label: {";
    my @items = ();
    for my $key (sort keys %hash) {
        my $val = $hash{$key};
        $val = ".undef" if ! defined $val;
        $key =~ s/\n/\\n/g;
        $val =~ s/\n/\\n/g;
        push (@items, "$key:$val");
    }
    $str .= join (",", @items);
    $str .= "}";

    return "$str\n";
}

1;

__END__