JezK
Edit File: LineBreak.pm
#-*- perl -*- package Unicode::LineBreak; require 5.008; ### Pragmas: use strict; use warnings; use vars qw($VERSION @EXPORT_OK @ISA $Config @Config); ### Exporting: use Exporter; our @EXPORT_OK = qw(UNICODE_VERSION SOMBOK_VERSION context); our %EXPORT_TAGS = ('all' => [@EXPORT_OK]); ### Inheritance: our @ISA = qw(Exporter); ### Other modules: use Carp qw(croak carp); use Encode qw(is_utf8); use MIME::Charset; use Unicode::GCString; ### Globals ### The package version our $VERSION = '2019.001'; ### Public Configuration Attributes our @Config = ( BreakIndent => 'YES', CharMax => 998, ColMax => 76, ColMin => 0, ComplexBreaking => 'YES', Context => 'NONEASTASIAN', EAWidth => undef, Format => 'SIMPLE', HangulAsAL => 'NO', LBClass => undef, LegacyCM => 'YES', Newline => "\n", Prep => undef, Sizing => 'UAX11', Urgent => undef, ViramaAsJoiner => 'YES', ); our $Config = {}; eval { local @INC = @INC; pop @INC if $INC[-1] eq '.'; require Unicode::LineBreak::Defaults; }; push @Config, (%$Config); ### Exportable constants use Unicode::LineBreak::Constants; use constant 1.01; my $package = __PACKAGE__; my @consts = grep { s/^${package}::(\w\w+)$/$1/ } keys %constant::declared; push @EXPORT_OK, @consts; push @{$EXPORT_TAGS{'all'}}, @consts; ### Load XS module require XSLoader; XSLoader::load('Unicode::LineBreak', $VERSION); ### Load dynamic constants foreach my $p ((['EA', EAWidths()], ['LB', LBClasses()])) { my $prop = shift @{$p}; my $idx = 0; foreach my $val (@{$p}) { no strict; my $const = "${prop}_${val}"; *{$const} = eval "sub { $idx }"; push @EXPORT_OK, $const; push @{$EXPORT_TAGS{'all'}}, $const; $idx++; } } ### Privates my $EASTASIAN_CHARSETS = qr{ ^BIG5 | ^CP9\d\d | ^EUC- | ^GB18030 | ^GB2312 | ^GBK | ^HZ | ^ISO-2022- | ^KS_C_5601 | ^SHIFT_JIS }ix; my $EASTASIAN_LANGUAGES = qr{ ^AIN | ^JA\b | ^JPN | ^KO\b | ^KOR | ^ZH\b | ^CHI }ix; use overload '%{}' => \&as_hashref, '${}' => \&as_scalarref, '""' => \&as_string, ; sub new { my $class = shift; my $self = __PACKAGE__->_new(); $self->config(@Config); $self->config(@_); bless $self, $class; } sub config ($@) { my $self = shift; # Get config. if (scalar @_ == 1) { my $k = shift; my $ret; if (uc $k eq uc 'CharactersMax') { return $self->_config('CharMax'); } elsif (uc $k eq uc 'ColumnsMax') { return $self->_config('ColMax'); } elsif (uc $k eq uc 'ColumnsMin') { return $self->_config('ColMin'); } elsif (uc $k eq uc 'SizingMethod') { return $self->_config('Sizing'); } elsif (uc $k eq uc 'TailorEA') { carp "$k is obsoleted. Use EAWidth"; $ret = $self->_config('EAWidth'); if (! defined $ret) { return []; } else { return [map { ($_->[0] => $_->[1]) } @{$ret}]; } } elsif (uc $k eq uc 'TailorLB') { carp "$k is obsoleted. Use LBClass"; $ret = $self->_config('LBClass'); if (! defined $ret) { return []; } else { return [map { ($_->[0] => $_->[1]) } @{$ret}]; } } elsif (uc $k eq uc 'UrgentBreaking') { return $self->_config('Urgent'); } elsif (uc $k eq uc 'UserBreaking') { carp "$k is obsoleted. Use Prep"; $ret = $self->_config('Prep'); if (! defined $ret) { return []; } else { return $ret; } } else { return $self->_config($k); } } # Set config. my @config = (); while (0 < scalar @_) { my $k = shift; my $v = shift; if (uc $k eq uc 'CharactersMax') { push @config, 'CharMax' => $v; } elsif (uc $k eq uc 'ColumnsMax') { push @config, 'ColMax' => $v; } elsif (uc $k eq uc 'ColumnsMin') { push @config, 'ColMin' => $v; } elsif (uc $k eq uc 'SizingMethod') { push @config, 'Sizing' => $v; } elsif (uc $k eq uc 'TailorLB') { carp "$k is obsoleted. Use LBClass"; push @config, 'LBClass' => undef; if (! defined $v) { ; } else { my @v = @{$v}; while (scalar(@v)) { my $k = shift @v; my $v = shift @v; push @config, 'LBClass' => [ $k => $v ]; } } } elsif (uc $k eq uc 'TailorEA') { carp "$k is obsoleted. Use EAWidth"; push @config, 'EAWidth' => undef; if (! defined $v) { ; } else { my @v = @{$v}; while (scalar(@v)) { my $k = shift @v; my $v = shift @v; push @config, 'EAWidth' => [ $k => $v ]; } } } elsif (uc $k eq uc 'UserBreaking') { carp "$k is obsoleted. Use Prep"; push @config, 'Prep' => undef; if (! defined $v) { ; } elsif (ref $v eq 'ARRAY') { push @config, map { ('Prep' => $_) } @{$v}; } else { push @config, 'Prep' => $v; } } elsif (uc $k eq uc 'UrgentBreaking') { push @config, 'Urgent' => $v; } else { push @config, $k => $v; } } $self->_config(@config) if scalar @config; } sub context (@) { my %opts = @_; my $charset; my $language; my $context; foreach my $k (keys %opts) { if (uc $k eq 'CHARSET') { if (ref $opts{$k}) { $charset = $opts{$k}->as_string; } else { $charset = MIME::Charset->new($opts{$k})->as_string; } } elsif (uc $k eq 'LANGUAGE') { $language = uc $opts{$k}; $language =~ s/_/-/; } } if ($charset and $charset =~ /$EASTASIAN_CHARSETS/) { $context = 'EASTASIAN'; } elsif ($language and $language =~ /$EASTASIAN_LANGUAGES/) { $context = 'EASTASIAN'; } else { $context = 'NONEASTASIAN'; } $context; } 1;