File Coverage

blib/lib/TeX/Encode.pm

Criterion	Covered	Total	%
statement	99	124	79.8
branch	55	82	67.0
condition	6	12	50.0
subroutine	19	23	82.6
pod	3	3	100.0
total	182	244	74.5

package TeX::Encode;

use 5.008;
use strict;

#use AutoLoader qw(AUTOLOAD);

use Encode::Encoding 0.1;
use Carp;

use TeX::Encode::charmap;
use TeX::Encode::BibTeX;

our @ISA = qw(Encode::Encoding);

our $VERSION = '2.010'; # VERSION

__PACKAGE__->Define(qw(LaTeX latex));

sub _bad_cp
{
	return sprintf("Unsupported character code point 0x%04x\n", ord($_[0]));
}

sub encode
{
	my( undef, $string, $check ) = @_;

	my $bad_cp = 0;

	# set up a "check" sub that will determine how we handle unsupported code
	# points
	$check = Encode::FB_DEFAULT if !defined $check;
	if( $check eq Encode::FB_DEFAULT or $check eq "")
	{
		$check = sub { '?' };
	}
	elsif( $check eq Encode::FB_CROAK )
	{
		$check = sub { Carp::croak(&_bad_cp(@_)) };
	}
	elsif( $check eq Encode::FB_QUIET )
	{
		$check = sub { $bad_cp = 1; '' };
	}
	elsif( $check eq Encode::FB_WARN )
	{
		$check = sub { Carp::carp(&_bad_cp(@_)); $bad_cp = 1; '' };
	}
	else
	{
		Carp::confess( "Unknown check argument: expected one of undef, FB_DEFAULT, FB_CROAK, FB_QUIET or FB_WARN" );
	}

	my $tex = "";

	pos($string) = 0;

	for($string)
	{
		while(!$bad_cp) {
		last if pos($_) == length($_);

		# escape reserved characters
		/\G($TeX::Encode::charmap::RESERVED_RE)/gc and ($tex .= $TeX::Encode::charmap::RESERVED{$1}, next);

		# escape all characters supported by tex
		if( /\G($TeX::Encode::charmap::CHAR_MAP_RE)/gc )
		{
			$tex .= $TeX::Encode::charmap::CHAR_MAP{$1};
			if( /\G[a-zA-Z_]/gc )
			{
				--pos($_);
				$tex =~ /[a-zA-Z_]$/ and $tex .= '{}';
			}
			next;
		}

		# basic unreserved characters
		/\G([\sa-zA-Z0-9\.,:;'"\(\)=\-\/\[\]\*\+!]+)/gc and ($tex .= $1, next);

		# unsupported code point (may set $bad_cp)
		/\G(.)/gc and ($tex .= &$check(ord($1)), next);

		Carp::confess "Shouldn't happen";
		}
	}

	if( $bad_cp )
	{
		$_[1] = substr($string,pos($string)-1);
	}

	return $tex;
}

# decode($octets [,$check])
sub decode
{
	my( undef, $tex, $check ) = @_;

	pos($tex) = 0;

	my $str = "";

	while(pos($tex) < length($tex))
	{
		$str .= _decode( $tex, $check );
	}

	return $str;
}

sub _decode
{
	my $str = Encode::decode_utf8( "" );

	for($_[0])
	{
		/\G\%([^\n]+\n)?/gc and next; # comment
# not sure about this:
#		/\G\\ensuremath/gc and ($str .= _decode_mathmode(_decode_bracket($_)), next); # mathmode
		/\G\$/gc and ($str .= _decode_mathmode($_), next); # mathmode
		/\G($TeX::Encode::charmap::MACROS_RE)/gc and ($str .= $TeX::Encode::charmap::MACROS{$1}, next); # macro
		/\G\\(.)/gc and ($str .= _decode_macro($1,$_), next); # unknown macro
		/\G\{/gc and ($str .= _decode_brace($_), next); # {foo}
		/\G\[/gc and ($str .= _decode_bracket($_), next); # [foo]
		/\G_/gc and ($str .= _subscript(&_decode), next); # _ (subscript)
		/\G\^/gc and ($str .= _superscript(&_decode), next); # ^ (superscript)
		/\G([^_\^\%\$\\\{\[ \t\n\r]+)/gc and $str .= $1, next;
		/\G([ \t\n\r])+/gc and $str .= $1, next;

		Carp::confess "Shouldn't happen: ".substr($_,0,10)." ...".substr($_,pos($_),10)." [".pos($_)."/".length($_)."]";
	}

	return $str;
}

sub _subscript
{
	my( $tex ) = @_;
	return $tex if $tex =~ /[^0-9+\-]/;
	return _subscript_digits( $tex );
}

sub _superscript
{
	my( $tex ) = @_;
	return $tex if $tex =~ /[^0-9+\-]/;
	return _superscript_digits( $tex );
}

my %SUBSCRIPTS = (
	'+' => chr(0x208a),
	'-' => chr(0x208b),
);
$SUBSCRIPTS{''.$_} = chr(0x2080+$_) for 0..9;
sub _subscript_digits
{
	my( $tex ) = @_;
	$tex =~ s/(.)/$SUBSCRIPTS{$1}/g;
	return $tex;
}

my %SUPERSCRIPTS = (
	'0' => chr(0x2070),
	'1' => chr(0xb9),
	'2' => chr(0xb2),
	'3' => chr(0xb3),
	'4' => chr(0x2074),
	'5' => chr(0x2075),
	'6' => chr(0x2076),
	'7' => chr(0x2077),
	'8' => chr(0x2078),
	'9' => chr(0x2079),
	'+' => chr(0x207a),
	'-' => chr(0x207b),
);
sub _superscript_digits
{
	my( $tex ) = @_;
	$tex =~ s/(.)/$SUPERSCRIPTS{$1}/g;
	return $tex;
}

sub perlio_ok { 0 }

sub _decode_mathmode
{
	my $str = "";

	for($_[0])
	{
		while(1) {
		last if pos($_) == length($_);

		/\G(\\.)/gc and ($str .= $1, next);
		/\G\$/gc and last;
		/\G($TeX::Encode::charmap::MATH_CHARS_RE)/gc and ($str .= $TeX::Encode::charmap::MATH_CHARS{$1}, next);
		/\G([^\\\$]+)/gc and ($str .= $1, next);

		Carp::confess "Shouldn't happen";
		}
	}

	return decode(undef, $str);
}

# try again to expand a macro
sub _decode_macro
{
	my( $c ) = @_;

	my $str = "\\$c";

	for($_[1])
	{
		# expand \'{e} to \'e
		/\G\{/ and ($str .= _decode_brace( $_ ), next);
		last;
	}

	return $TeX::Encode::charmap::MACROS{$str} || $str;
}

sub _decode_bracket
{
	my $str = "";

	my $depth = 1;
	for($_[0])
	{
		while(1) {
		last if pos($_) == length($_) or $depth == 0;

		/\G(\\.)/gc and ($str .= $1, next);
		/\G\[/gc and (--$depth, next);
		/\G\]/gc and (++$depth, next);
		/\G([^\\\[\]]+)/gc and ($str .= $1, next);

		Carp::confess "Shouldn't happen";
		}
	}

	return $str;
}

sub _decode_brace
{
	my $str = "";

	my $depth = 1;
	for($_[0])
	{
		while(1) {
		last if pos($_) == length($_) or $depth == 0;

		/\G(\\.)/gc and ($str .= $1, next);
		/\G\}/gc and ($str .= '}', --$depth, next);
		/\G\{/gc and ($str .= '{', ++$depth, next);
		/\G([^\\\{\}]+)/gc and ($str .= $1, next);

		Carp::confess "Shouldn't happen";
		}
	}

	chop($str); # remove trailing '}'

	return decode(undef, $str);
}

1;
__END__