Big5HKSCS
view release on metacpan or search on metacpan
- created by INABA Hitoshi
0.39 2009-08-06 00:00:00
- support Sjis::length, Sjis::substr, Sjis::index, and Sjis::rindex
- created by INABA Hitoshi
0.38 2009-08-05 00:00:00
- improve qw
- filetest operator before parenthesis '-X ('
- escape sequence of hexadecimal number of one digit
- fix bugs of function charlist_not_qr
- created by INABA Hitoshi
0.37 2009-07-09 00:00:00
- separate Tk modules, make-*.pl, and test scripts
- remove perl55.bat, and perl56.bat
- created by INABA Hitoshi
0.36 2009-05-17 00:00:00
- do local $@ before eval
- support Tk::getOpenFile and Tk::getSaveFile
lib/Big5HKSCS.pm view on Meta::CPAN
Big5HKSCS software clusters multiple-octet character with quantifier, makes cluster from
multiple-octet custom character classes. And makes multiple-octet version metasymbol
from classic Perl character class shortcuts and POSIX-style character classes.
--------------------------------------------------------------------------------
Before After
--------------------------------------------------------------------------------
m/...MULTIOCT+.../ m/...(?:MULTIOCT)+.../
m/...[AN-EM].../ m/...(?:A[N-Z]|[B-D][A-Z]|E[A-M]).../
m/...\D.../ m/...(?:${Ebig5hkscs::eD}).../
m/...[[:^digit:]].../ m/...(?:${Ebig5hkscs::not_digit}).../
--------------------------------------------------------------------------------
=head1 Calling 'Ebig5hkscs::ignorecase()' (Big5HKSCS software provides)
Big5HKSCS software applies calling 'Ebig5hkscs::ignorecase()' instead of /i modifier.
--------------------------------------------------------------------------------
Before After
--------------------------------------------------------------------------------
m/...$var.../i m/...@{[Ebig5hkscs::ignorecase($var)]}.../
lib/Big5HKSCS.pm view on Meta::CPAN
[:graph:] [\x21-\x7F]
[:lower:] [\x61-\x7A]
[\x41-\x5A\x61-\x7A] (/i modifier)
[:print:] [\x20-\x7F]
[:punct:] [\x21-\x2F\x3A-\x3F\x40\x5B-\x5F\x60\x7B-\x7E]
[:space:] [\s\x0B]
[:upper:] [\x41-\x5A]
[\x41-\x5A\x61-\x7A] (/i modifier)
[:word:] [\x30-\x39\x41-\x5A\x5F\x61-\x7A]
[:xdigit:] [\x30-\x39\x41-\x46\x61-\x66]
[:^alnum:] ${Ebig5hkscs::not_alnum}
[:^alpha:] ${Ebig5hkscs::not_alpha}
[:^ascii:] ${Ebig5hkscs::not_ascii}
[:^blank:] ${Ebig5hkscs::not_blank}
[:^cntrl:] ${Ebig5hkscs::not_cntrl}
[:^digit:] ${Ebig5hkscs::not_digit}
[:^graph:] ${Ebig5hkscs::not_graph}
[:^lower:] ${Ebig5hkscs::not_lower}
${Ebig5hkscs::not_lower_i} (/i modifier)
[:^print:] ${Ebig5hkscs::not_print}
[:^punct:] ${Ebig5hkscs::not_punct}
[:^space:] ${Ebig5hkscs::not_space}
[:^upper:] ${Ebig5hkscs::not_upper}
${Ebig5hkscs::not_upper_i} (/i modifier)
[:^word:] ${Ebig5hkscs::not_word}
[:^xdigit:] ${Ebig5hkscs::not_xdigit}
---------------------------------------------------------------
\b and \B are redefined as follows to backward compatibility.
---------------------------------------------------------------
Before After
---------------------------------------------------------------
\b ${Ebig5hkscs::eb}
\B ${Ebig5hkscs::eB}
---------------------------------------------------------------
lib/Big5HKSCS.pm view on Meta::CPAN
qr{\G(?(?=.{0,32766}\z)\G(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])*?|(?(?=[$sbcs]+\z).*?|(?:.*?[$sbcs](?:[^$sbcs][^$sbcs])*?)))}oxms
${Ebig5hkscs::dot} qr{(?>[^\x81-\xFE\x0A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::dot_s} qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eD} qr{(?>[^\x81-\xFE0-9]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eS} qr{(?>[^\x81-\xFE\s]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eW} qr{(?>[^\x81-\xFE0-9A-Z_a-z]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eH} qr{(?>[^\x81-\xFE\x09\x20]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eV} qr{(?>[^\x81-\xFE\x0A\x0B\x0C\x0D]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eR} qr{(?>\x0D\x0A|[\x0A\x0D])};
${Ebig5hkscs::eN} qr{(?>[^\x81-\xFE\x0A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_alnum} qr{(?>[^\x81-\xFE\x30-\x39\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_alpha} qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_ascii} qr{(?>[^\x81-\xFE\x00-\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_blank} qr{(?>[^\x81-\xFE\x09\x20]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_cntrl} qr{(?>[^\x81-\xFE\x00-\x1F\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_digit} qr{(?>[^\x81-\xFE\x30-\x39]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_graph} qr{(?>[^\x81-\xFE\x21-\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_lower} qr{(?>[^\x81-\xFE\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_lower_i} qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; # Perl 5.16 compatible
# ${Ebig5hkscs::not_lower_i} qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])}; # older Perl compatible
${Ebig5hkscs::not_print} qr{(?>[^\x81-\xFE\x20-\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_punct} qr{(?>[^\x81-\xFE\x21-\x2F\x3A-\x3F\x40\x5B-\x5F\x60\x7B-\x7E]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_space} qr{(?>[^\x81-\xFE\s\x0B]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_upper} qr{(?>[^\x81-\xFE\x41-\x5A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_upper_i} qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; # Perl 5.16 compatible
# ${Ebig5hkscs::not_upper_i} qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])}; # older Perl compatible
${Ebig5hkscs::not_word} qr{(?>[^\x81-\xFE\x30-\x39\x41-\x5A\x5F\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_xdigit} qr{(?>[^\x81-\xFE\x30-\x39\x41-\x46\x61-\x66]|[\x81-\xFE][\x00-\xFF])};
# This solution is not perfect. I beg better solution from you who are reading this.
${Ebig5hkscs::eb} qr{(?:\A(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[0-9A-Z_a-z])|(?<=[0-9A-Z_a-z])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]|\z))};
${Ebig5hkscs::eB} qr{(?:(?<=[0-9A-Z_a-z])(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]))};
---------------------------------------------------------------------------------------------------------------------------------------------------------
=head1 Un-Escaping \ of \b{}, \B{}, \N{}, \p{}, \P{}, and \X (Big5HKSCS software provides)
Big5HKSCS software removes '\' at head of alphanumeric regexp metasymbols \b{}, \B{},
\N{}, \p{}, \P{} and \X. By this method, you can avoid the trap of the abstraction.
lib/Ebig5hkscs.pm view on Meta::CPAN
use vars qw(
$dot
$dot_s
$eD
$eS
$eW
$eH
$eV
$eR
$eN
$not_alnum
$not_alpha
$not_ascii
$not_blank
$not_cntrl
$not_digit
$not_graph
$not_lower
$not_lower_i
$not_print
$not_punct
$not_space
$not_upper
$not_upper_i
$not_word
$not_xdigit
$eb
$eB
);
use vars qw(
$anchor
$matched
);
${Ebig5hkscs::anchor} = qr{\G(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])*?}oxms;
my $q_char_SADAHIRO_Tomoyuki_2002_01_17 = '';
lib/Ebig5hkscs.pm view on Meta::CPAN
# http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#Vertical_tabs_are_now_whitespace
# ${Ebig5hkscs::eS} = qr{(?>[^\x81-\xFE\x09\x0A \x0C\x0D\x20]|[\x81-\xFE][\x00-\xFF])};
# ${Ebig5hkscs::eS} = qr{(?>[^\x81-\xFE\x09\x0A\x0B\x0C\x0D\x20]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eS} = qr{(?>[^\x81-\xFE\s]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eW} = qr{(?>[^\x81-\xFE0-9A-Z_a-z]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eH} = qr{(?>[^\x81-\xFE\x09\x20]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eV} = qr{(?>[^\x81-\xFE\x0A\x0B\x0C\x0D]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eR} = qr{(?>\x0D\x0A|[\x0A\x0D])};
${Ebig5hkscs::eN} = qr{(?>[^\x81-\xFE\x0A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_alnum} = qr{(?>[^\x81-\xFE\x30-\x39\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_alpha} = qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_ascii} = qr{(?>[^\x81-\xFE\x00-\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_blank} = qr{(?>[^\x81-\xFE\x09\x20]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_cntrl} = qr{(?>[^\x81-\xFE\x00-\x1F\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_digit} = qr{(?>[^\x81-\xFE\x30-\x39]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_graph} = qr{(?>[^\x81-\xFE\x21-\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_lower} = qr{(?>[^\x81-\xFE\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_lower_i} = qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; # Perl 5.16 compatible
# ${Ebig5hkscs::not_lower_i} = qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])}; # older Perl compatible
${Ebig5hkscs::not_print} = qr{(?>[^\x81-\xFE\x20-\x7F]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_punct} = qr{(?>[^\x81-\xFE\x21-\x2F\x3A-\x3F\x40\x5B-\x5F\x60\x7B-\x7E]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_space} = qr{(?>[^\x81-\xFE\s\x0B]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_upper} = qr{(?>[^\x81-\xFE\x41-\x5A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_upper_i} = qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; # Perl 5.16 compatible
# ${Ebig5hkscs::not_upper_i} = qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])}; # older Perl compatible
${Ebig5hkscs::not_word} = qr{(?>[^\x81-\xFE\x30-\x39\x41-\x5A\x5F\x61-\x7A]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::not_xdigit} = qr{(?>[^\x81-\xFE\x30-\x39\x41-\x46\x61-\x66]|[\x81-\xFE][\x00-\xFF])};
${Ebig5hkscs::eb} = qr{(?:\A(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[0-9A-Z_a-z])|(?<=[0-9A-Z_a-z])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]|\z))};
${Ebig5hkscs::eB} = qr{(?:(?<=[0-9A-Z_a-z])(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]))};
# avoid: Name "Ebig5hkscs::foo" used only once: possible typo at here.
${Ebig5hkscs::dot} = ${Ebig5hkscs::dot};
${Ebig5hkscs::dot_s} = ${Ebig5hkscs::dot_s};
${Ebig5hkscs::eD} = ${Ebig5hkscs::eD};
${Ebig5hkscs::eS} = ${Ebig5hkscs::eS};
${Ebig5hkscs::eW} = ${Ebig5hkscs::eW};
${Ebig5hkscs::eH} = ${Ebig5hkscs::eH};
${Ebig5hkscs::eV} = ${Ebig5hkscs::eV};
${Ebig5hkscs::eR} = ${Ebig5hkscs::eR};
${Ebig5hkscs::eN} = ${Ebig5hkscs::eN};
${Ebig5hkscs::not_alnum} = ${Ebig5hkscs::not_alnum};
${Ebig5hkscs::not_alpha} = ${Ebig5hkscs::not_alpha};
${Ebig5hkscs::not_ascii} = ${Ebig5hkscs::not_ascii};
${Ebig5hkscs::not_blank} = ${Ebig5hkscs::not_blank};
${Ebig5hkscs::not_cntrl} = ${Ebig5hkscs::not_cntrl};
${Ebig5hkscs::not_digit} = ${Ebig5hkscs::not_digit};
${Ebig5hkscs::not_graph} = ${Ebig5hkscs::not_graph};
${Ebig5hkscs::not_lower} = ${Ebig5hkscs::not_lower};
${Ebig5hkscs::not_lower_i} = ${Ebig5hkscs::not_lower_i};
${Ebig5hkscs::not_print} = ${Ebig5hkscs::not_print};
${Ebig5hkscs::not_punct} = ${Ebig5hkscs::not_punct};
${Ebig5hkscs::not_space} = ${Ebig5hkscs::not_space};
${Ebig5hkscs::not_upper} = ${Ebig5hkscs::not_upper};
${Ebig5hkscs::not_upper_i} = ${Ebig5hkscs::not_upper_i};
${Ebig5hkscs::not_word} = ${Ebig5hkscs::not_word};
${Ebig5hkscs::not_xdigit} = ${Ebig5hkscs::not_xdigit};
${Ebig5hkscs::eb} = ${Ebig5hkscs::eb};
${Ebig5hkscs::eB} = ${Ebig5hkscs::eB};
#
# Big5-HKSCS split
#
sub Ebig5hkscs::split(;$$$) {
# P.794 29.2.161. split
# in Chapter 29: Functions
lib/Ebig5hkscs.pm view on Meta::CPAN
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
croak "Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
my @charlist = charlist_not_qr(@char[$left+1..$right-1], 'i');
# escape character
for my $char (@charlist) {
if (0) {
}
# do not use quotemeta here
elsif ($char =~ /\A ([\x80-\xFF].*) ($metachar) \z/oxms) {
$char = $1 . '\\' . $2;
}
lib/Ebig5hkscs.pm view on Meta::CPAN
}->{$1};
}
# POSIX-style character classes
elsif ($ignorecase and ($char[$i] =~ /\A ( \[\: \^? (?:lower|upper) :\] ) \z/oxms)) {
$char[$i] = {
'[:lower:]' => '[\x41-\x5A\x61-\x7A]',
'[:upper:]' => '[\x41-\x5A\x61-\x7A]',
'[:^lower:]' => '${Ebig5hkscs::not_lower_i}',
'[:^upper:]' => '${Ebig5hkscs::not_upper_i}',
}->{$1};
}
elsif ($char[$i] =~ /\A ( \[\: \^? (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] ) \z/oxms) {
$char[$i] = {
'[:alnum:]' => '[\x30-\x39\x41-\x5A\x61-\x7A]',
'[:alpha:]' => '[\x41-\x5A\x61-\x7A]',
'[:ascii:]' => '[\x00-\x7F]',
'[:blank:]' => '[\x09\x20]',
lib/Ebig5hkscs.pm view on Meta::CPAN
# P.210 POSIX-Style Character Classes
# in Chapter 5: Pattern Matching
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition.
'[:space:]' => '[\s\x0B]', # "\s" plus vertical tab ("\cK")
'[:upper:]' => '[\x41-\x5A]',
'[:word:]' => '[\x30-\x39\x41-\x5A\x5F\x61-\x7A]',
'[:xdigit:]' => '[\x30-\x39\x41-\x46\x61-\x66]',
'[:^alnum:]' => '${Ebig5hkscs::not_alnum}',
'[:^alpha:]' => '${Ebig5hkscs::not_alpha}',
'[:^ascii:]' => '${Ebig5hkscs::not_ascii}',
'[:^blank:]' => '${Ebig5hkscs::not_blank}',
'[:^cntrl:]' => '${Ebig5hkscs::not_cntrl}',
'[:^digit:]' => '${Ebig5hkscs::not_digit}',
'[:^graph:]' => '${Ebig5hkscs::not_graph}',
'[:^lower:]' => '${Ebig5hkscs::not_lower}',
'[:^print:]' => '${Ebig5hkscs::not_print}',
'[:^punct:]' => '${Ebig5hkscs::not_punct}',
'[:^space:]' => '${Ebig5hkscs::not_space}',
'[:^upper:]' => '${Ebig5hkscs::not_upper}',
'[:^word:]' => '${Ebig5hkscs::not_word}',
'[:^xdigit:]' => '${Ebig5hkscs::not_xdigit}',
}->{$1};
}
elsif ($char[$i] =~ /\A \\ ($q_char) \z/oxms) {
$char[$i] = $1;
}
}
# open character list
my @singleoctet = ();
lib/Ebig5hkscs.pm view on Meta::CPAN
elsif (scalar(@{$range}) == 2) {
push @singleoctet, sprintf('\x%02X\x%02X', @{$range}[0], @{$range}[-1]);
}
else {
push @singleoctet, sprintf('\x%02X-\x%02X', @{$range}[0], @{$range}[-1]);
}
}
}
}
my $not_anchor = '';
$not_anchor = '(?![\x81-\xFE])';
push @multipleoctet, join('', $not_anchor, '[', @singleoctet, ']' );
}
if (scalar(@multipleoctet) >= 2) {
return '(?:' . join('|', @multipleoctet) . ')';
}
else {
return $multipleoctet[0];
}
}
#
# Big5-HKSCS open character list for not qr
#
sub charlist_not_qr {
my $modifier = pop @_;
my @char = @_;
my($singleoctet, $multipleoctet) = _charlist(@char, $modifier);
my @singleoctet = @$singleoctet;
my @multipleoctet = @$multipleoctet;
# with /i modifier
if ($modifier =~ m/i/oxms) {
lib/Ebig5hkscs.pm view on Meta::CPAN
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp\n";
}
if ($char[$i] eq ']') {
my $right = $i;
# [^...]
if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) {
splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier);
}
else {
splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier);
}
$i = $left;
last;
}
}
}
# rewrite character class or escape character
elsif (my $char = character_class($char[$i],$modifier)) {
lib/Ebig5hkscs.pm view on Meta::CPAN
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp\n";
}
if ($char[$i] eq ']') {
my $right = $i;
# [^...]
splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
# escape $ @ / and \
elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) {
$char[$i] = '\\' . $char[$i];
lib/Ebig5hkscs.pm view on Meta::CPAN
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp\n";
}
if ($char[$i] eq ']') {
my $right = $i;
# [^...]
if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) {
splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier);
}
else {
splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier);
}
$i = $left;
last;
}
}
}
# rewrite character class or escape character
elsif (my $char = character_class($char[$i],$modifier)) {
lib/Ebig5hkscs.pm view on Meta::CPAN
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp\n";
}
if ($char[$i] eq ']') {
my $right = $i;
# [^...]
splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
# escape $ @ / and \
elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) {
$char[$i] = '\\' . $char[$i];
lib/Ebig5hkscs.pm view on Meta::CPAN
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp\n";
}
if ($char[$i] eq ']') {
my $right = $i;
# [^...]
if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) {
splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier);
}
else {
splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier);
}
$i = $left;
last;
}
}
}
# rewrite character class or escape character
elsif (my $char = character_class($char[$i],$modifier)) {
lib/Ebig5hkscs.pm view on Meta::CPAN
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp\n";
}
if ($char[$i] eq ']') {
my $right = $i;
# [^...]
splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
# rewrite character class or escape character
elsif (my $char = character_class($char[$i],$modifier)) {
$char[$i] = $char;
lib/Ebig5hkscs.pm view on Meta::CPAN
to lowercase, use:
$titlecase = Ebig5hkscs::ucfirst(substr($word,0,1)) . Ebig5hkscs::lc(substr($word,1));
or
$string =~ s/(\w)((?>\w*))/\u$1\L$2/g;
Do not use:
$do_not_use = Ebig5hkscs::ucfirst(Ebig5hkscs::lc($word));
or "\u\L$word", because that can produce a different and incorrect answer with
certain characters. The titlecase of something that's been lowercased doesn't
always produce the same thing titlecasing the original produces.
Because titlecasing only makes sense at the start of a string that's followed
by lowercase characters, we can't think of any reason you might want to titlecase
every character in a string.
See also P.287 A Case of Mistaken Identity
#-----------------------------------------------------------------------------
# $tar->add_files("$tardir/$file");
#-----------------------------------------------------------------------------
open(FH, $file) || die "Can't open file: $file\n"; #'
binmode FH;
local $/ = undef; # slurp mode
my $data = <FH>;
close FH;
#-----------------------------------------------------------------------------
# Kwalitee Indicator: buildtool_not_executable core
# The build tool (Build.PL/Makefile.PL) is executable. This is bad because
# you should specify which perl you want to use while installing.
#
# How to fix
# Change the permissions of Build.PL/Makefile.PL to not-executable.
#-----------------------------------------------------------------------------
my $tar = Archive::Tar->new;
if ($file =~ m/ (?: Build\.PL | Makefile\.PL ) \z/oxmsi) {
$tar->add_data("$tardir/$file", $data, {'mode' => 0664});
}
return $_[0];
}
}
# Test::Harness::runtests cannot work heavy load.
sub _runtests {
my @script = @_;
my @fail_testno = ();
my $ok_script = 0;
my $not_ok_script = 0;
my $total_ok = 0;
my $total_not_ok = 0;
# cygwin warning:
# MS-DOS style path detected: C:/cpan/Char-X.XX
# Preferred POSIX equivalent is: /cygdrive/c/cpan/Char-X.XX
# CYGWIN environment variable option "nodosfilewarning" turns off this warning.
# Consult the user's guide for more details about POSIX paths: #'
# http://cygwin.com/cygwin-ug-net/using.html#using-pathnames
if (exists $ENV{'CYGWIN'}) {
if ($ENV{'CYGWIN'} !~ /\b nodosfilewarning \b/x) {
}
my $scriptno = 0;
for my $script (@script) {
next if not -e $script;
my @result = qx{$^X $script};
my($tests) = shift(@result) =~ /^1..([0-9]+)/;
my $testno = 1;
my $ok = 0;
my $not_ok = 0;
for my $result (@result) {
if ($result =~ /^ok /) {
$ok++;
}
elsif ($result =~ /^not ok /) {
push @{$fail_testno[$scriptno]}, $testno;
$not_ok++;
}
$testno++;
}
if ($ok == $tests) {
printf("$script ok\n");
$ok_script++;
}
else {
printf("$script Failed %d/%d subtests\n", $not_ok, $ok+$not_ok);
$not_ok_script++;
}
$total_ok += $ok;
$total_not_ok += $not_ok;
$scriptno++;
}
if (scalar(@script) == $ok_script) {
printf <<'END', scalar(@script), $total_ok + $total_not_ok;
All tests successful.
Files=%d, Tests=%d
Result: PASS
END
}
else {
print <<'END';
Test Summary Report
-------------------
END
my $scriptno = 0;
for my $fail_testno (@fail_testno) {
if (defined $fail_testno) {
print $script[$scriptno], "\n";
print ' Failed test: ', join(', ', @{$fail_testno[$scriptno]}), "\n";
}
$scriptno++;
}
printf("Files=%d, Tests=%d\n", scalar(@script), $total_ok + $total_not_ok);
printf("Result: FAIL\n");
printf("Failed %d/%d test programs. %d/%d subtests failed.\n", $not_ok_script, scalar(@script), $total_not_ok, $total_ok + $total_not_ok);
}
}
sub check_usascii {
my($file) = @_;
if (open(FILE,$file)) {
while (<FILE>) {
if (not /^[\x0A\x20-\x7E]+$/) {
die "error not US-ASCII: $file, q(;_;)bad!!";
}
( run in 0.362 second using v1.01-cache-2.11-cpan-0a987023a57 )