File Coverage

blib/lib/TeX/Hyphen.pm

Criterion	Covered	Total	%
statement	144	155	92.9
branch	50	68	73.5
condition	14	15	93.3
subroutine	13	14	92.8
pod	0	5	0.0
total	221	257	85.9

package TeX::Hyphen;

=head1 NAME

TeX::Hyphen -- hyphenate words using TeX's patterns

=head1 SYNOPSIS

	use TeX::Hyphen;
	my $hyp = new TeX::Hyphen 'file' => 'hyphen.tex',
		'style' => 'czech', leftmin => 2,
		rightmin => 2;

	my $hyp = new TeX::Hyphen 'file' => 'hyphen.tex',
		'style' => 'utf8';

	# my $hyp = new TeX::Hyphen "hyphen.tex";

	my $word = "representation";
	my @points = $hyp->hyphenate($word);
	print $hyp->visualize($word), "\n";

=head1 DESCRIPTION

Constructor new() creates a new Hyphen object and loads the file with
patterns into memory. Then you can ask it for hyphenation of a word by
calling a method of this object. If no file is specified, the default
Donald E. Knuth's F, that is included in this module, is
used instead.

=head2 Arguments to constructor

You can pass arguments to the new() call as hash, possible options are

=over 4

=item file

Name of the file with the patters. It will be loaded and the resulting
object will be able to hyphenate according to patterns in that file.

For convenience and backward compatibility, the file name can also be
specified as the first (odd) parameter to new().

=item style

Various languages use special shortcuts to specify the patterns.
Instead of doing the full TeX expansion, we use Perl code to parse the
patterns. The style option loads TeX::Hyphen::name_of_the_style module
and uses the parsing functions found in it.

Currently, the default czech (which also works for English alright),
german, and utf8 are available. See the TeX::Hyphen::czech man page
for more information, especially if you want to support other
languages/styles.

=item leftmin

The minimum starting substring which will not be hyphenated. This
overrides the default specified in the style file.

=item rightmin

The minimum ending substring which will not be hyphenated. This
overrides the default specified in the style file.

=back

=head2 Methods that are supported

Method hyphenate() returns list of places where the word can be
divided, so

	$hyp->visualize('representation')

returns list (3, 5, 8, 10).

Method visualize() can be used to show these points, so

	$hyp->visualize('representation')

should return C, at least for English patterns.

Variables I<$TeX::Hyphen::LEFTMIN> and I<$TeX::Hyphen::RIGHTMIN> can
be used to restrict minimal starting and ending substring where it is
not possible to hyphenate. They both default to 2 but should be
changed to match the paratemers used to generate the patterns.

Variable I<$TeX::Hyphen::DEBUG> can be set to see some statistics and
processing.

The file with hyphenation patterns may contain C<\'> and C<\v> accents,
used in the Czech (and other) languages.

=cut

use strict;
use vars qw( $VERSION $DEBUG $LEFTMIN $RIGHTMIN $errstr );

$VERSION = '1.16';
sub Version ()	{ $VERSION; }

$DEBUG ||= 0;

# To protect beginning and end of the word from hyphenation
$LEFTMIN = 2;
$RIGHTMIN = 2;

my (@DATA, $DATA_LOADED);

# #############################################################
# Constructor. Parameter specifies file with patterns.
# File is searched for \patterns{ ... } and \hyphenation{ ... }
# sections and these are used.
#
sub new {
	my $class = shift;
	my ($file, %opts);
	if (scalar(@_) % 2) {
		$file = shift;
		%opts = @_;
	} else {
		%opts = @_;
		$file = $opts{'file'};
	}
	local *FILE;
	if (not defined $file) {
		if (not defined $DATA_LOADED) {
			@DATA = ;
			$DATA_LOADED = 1;
		}
	} else {
		open FILE, $file or do {
			$errstr = "Error opening file `$file': $!";
			return;
		};
	}
	my $self = {};
	bless $self, $class;

	local ($/) = "\n";
	my ($tag, $value);
	my $hyphen = {};
	my $beginhyphen = {};
	my $endhyphen = {};
	my $bothhyphen = {};
	my $exception = {};

	my ($process_patterns, $process_hyphenation);
	my ($leftmin, $rightmin) = ($LEFTMIN, $RIGHTMIN);
	if (not defined $opts{'style'}) {
		$opts{'style'} = 'czech';	# for backward compatibility
	}
	if (defined $opts{'style'}) {
		if ($opts{'style'} eq 'utf8') {
			binmode(FILE,':utf8');
		}
		eval qq!use ${class}::$opts{'style'}!;
		if (not $@) {
			eval "\$process_patterns = \\&${class}::$opts{'style'}::process_patterns";
			eval "\$process_hyphenation = \\&${class}::$opts{'style'}::process_hyphenation";
			eval "\$leftmin = \$${class}::$opts{'style'}::LEFTMIN";
			eval "\$rightmin = \$${class}::$opts{'style'}::RIGHTMIN";
		} else {
			$errstr = "Error loading style module $class::$opts{'style'}: $@";
			return;
		}
	}
	$leftmin = $opts{leftmin} if exists $opts{leftmin};
	$rightmin = $opts{rightmin} if exists $opts{rightmin};

	my ($in_patterns, $in_hyphenation) = (0, 0);
	my $i = 0;
	while ((defined $file and defined($_ = ))
		or (not defined $file and defined($_ = $DATA[$i++]))) {
		s/\%.*$//;			# comment out
		chomp;
		if ($in_patterns) {
			$in_patterns = $process_patterns->($_,
				$bothhyphen, $beginhyphen,
				$endhyphen, $hyphen);
		} elsif ($in_hyphenation) {
			$in_hyphenation = $process_hyphenation->($_, $exception);
		} elsif (/\\patterns{/) {	# find the \patterns section
			$in_patterns = 1;
		} elsif (/\\hyphenation{/) {
			$in_hyphenation = 1;
		}
	}
	close FILE if defined $file;
	$self->{hyphen} = $hyphen;
	$self->{begin} = $beginhyphen;
	$self->{end} = $endhyphen;
	$self->{both} = $bothhyphen;
	$self->{exception} = $exception;
	print STDERR 'Statistics for ', (defined $file ? $file : 'hyphen.tex'),
		': all ' , scalar %$hyphen,
		' (', scalar keys %$hyphen,
		'), exception ', scalar %$exception,
		' (', scalar keys %$exception,
		"),\n\tbegin ", scalar %$beginhyphen,
		' (', scalar keys %$beginhyphen,
		'), end ', scalar %$endhyphen,
		' (', scalar keys %$endhyphen,
		'), both ', scalar %$bothhyphen,
		' (', scalar keys %$bothhyphen, ")\n" if $DEBUG;

	$self->{exact} = { %$exception };
	$self->{leftmin} = $leftmin;
	$self->{rightmin} = $rightmin;
	$self;
}

# ############################################
# For given word finds places for hyphenation.
# Returns an array specifying the places.
#
sub hyphenate {
	my ($self, $word) = (shift, shift);

	print STDERR "Hyphenate `$word'\n" if $DEBUG;

	my $exact = $self->{exact};
	if (defined(my $res = $exact->{$word})) {
		print STDERR "Exact match $res\n" if $DEBUG;
		return $self->make_result_list($res);
	}

	my $hyphen = $self->{hyphen};
	my $beginhyphen = $self->{begin};
	my $endhyphen = $self->{end};
	my $bothhyphen = $self->{both};

	my $totallength = length $word;
	my @result = (0) x ($totallength + 1);

	# walk the word
	my $rightstop = $totallength - $self->{rightmin};
	my $pos;
	for ($pos = 0; $pos <= $rightstop; $pos++) {
			# length of the rest of the word
		my $restlength = $totallength - $pos;
			# length of a substring
		my $length;
		for ($length = 1; $length <= $restlength; $length++) {
			my $substr = substr $word, $pos, $length;
			my $value;
			my $j;
			my $letter;
			if (defined($value = $hyphen->{$substr})) {
				$j = $pos;
				print STDERR "$j: $substr: $value\n" if $DEBUG > 2;
				while ($value =~ /(.)/gs) {
					$result[$j] = $1 if ($1 > $result[$j]);
					$j++;
				}
			}
			if (($pos == 0) and
				defined($value = $beginhyphen->{$substr})) {
				$j = 0;
				print STDERR "$j: .$substr: $value\n" if $DEBUG > 2;
				while ($value =~ /(.)/gs) {
					$result[$j] = $1 if ($1 > $result[$j]);
					$j++;
				}
			}
			if (($restlength == $length) and
				defined($value = $endhyphen->{$substr})) {
				$j = $pos;
				print STDERR "$j: $substr.: $value\n" if $DEBUG > 2;
				while ($value =~ /(.)/gs) {
					$result[$j] = $1 if ($1 > $result[$j]);
					$j++;
				}
			}
		}
	}
	my $value;
	my $letter;
	if (defined($value = $bothhyphen->{$word})) {
		my $j = 0;
		print STDERR "$j: .$word.: $value\n" if $DEBUG > 2;
		while ($value =~ /(.)/gs) {
			$result[$j] = $1 if ($1 > $result[$j]);
			$j++;
		}
	}

	my $result = join '', @result;
	### substr($result, 0, $self->{leftmin} + 1) = '0' x ($self->{leftmin} + 1);
	substr($result, 0, $self->{leftmin}) = '0' x $self->{leftmin};
	substr($result, -$self->{rightmin}) = '0' x $self->{rightmin};

	print STDERR "Result: $result\n" if $DEBUG;
	return $self->make_result_list($result);
}

# ####################
#
#
sub make_result_list {
	my ($self, $result) = @_;
	my @result = ();
	my $i = 0;
	while ($result =~ /(.)/g) {
		push @result, $i if (int($1) % 2);
		$i++;
	}
	@result;
}

# #########################################
# For a word show the result of hyphenation
#
sub visualize {
	my ($self, $word) = (shift, shift);
	my $number = 0;
	my $pos;
	for $pos ($self->hyphenate($word)) {
		substr($word, $pos + $number, 0) = "-";
		$number++;
	}
	$word;
}

=head1 VERSION

1.16

=head1 AVAILABLE FROM

http://www.adelton.com/perl/TeX-Hyphen/

=head1 AUTHOR

(c) 1997--2015 Jan Pazdziora.

All rights reserved. This package is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.

Contact the author at jpx dash perl at adelton dot com.

=head1 SEE ALSO

perl(1), TeX::Hyphen::czech.

=cut

1;

__DATA__