package ShiftJIS::String;
use Carp;
use strict;
use vars qw($VERSION $PACKAGE @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = '1.11';
$PACKAGE = 'ShiftJIS::String'; # __PACKAGE__
require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
%EXPORT_TAGS = (
    issjis => [qw/issjis/],
    string => [qw/length index rindex strspn strcspn strrev substr strsplit/],
    'span' => [qw/strspn strcspn rspan rcspan/],
    'trim' => [qw/trim ltrim rtrim/],
    'cmp'  => [qw/strcmp strEQ strNE strLT strLE strGT strGE strxfrm/],
    ctype  => [qw/toupper tolower/],
    'tr'   => [qw/mkrange strtr trclosure/],
    'kana' => [qw/hi2ka ka2hi hiXka/],
    'H2Z'  => [qw/kataH2Z kanaH2Z hiraH2Z spaceH2Z/],
    'Z2H'  => [qw/kataZ2H kanaZ2H hiraZ2H spaceZ2H/],
);
$EXPORT_TAGS{all}  = [ map @$_, values %EXPORT_TAGS ];
$EXPORT_TAGS{core} = [ map @$_, @EXPORT_TAGS{qw/issjis string cmp ctype tr/} ];
@EXPORT_OK = @{ $EXPORT_TAGS{all} };
@EXPORT = ();
bootstrap ShiftJIS::String $VERSION;
my $Char = '(?:[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[\x00-\xFF])';
##
## substr(STRING or SCALAR REF, OFFSET; LENGTH)
## substr(SCALAR, OFFSET, LENGTH, REPLACEMENT)
##
sub substr ($$;$$) {
    my($plen, $clen) = possubstr(@_);
    return if ! defined $plen;
    return (@_ > 3)
        ? CORE::substr($_[0], $plen, $clen, $_[3])
        : (ref $_[0])
        ? \ CORE::substr(${ $_[0] }, $plen, $clen)
        :   CORE::substr($_[0],  $plen, $clen);
}
##
## strtr(STRING or SCALAR REF, SEARCHLIST, REPLACEMENTLIST;
##       MODIFIER, PATTERN, TOPATTERN)
##
my %Cache;
sub getStrtrCache { wantarray ? %Cache : \%Cache }
sub strtr($$$;$$$)
{
    my $str = shift;
    my $coderef = (defined $_[2] && $_[2] =~ /o/)
        ? ( $Cache{ join "\xFF", @_ } ||= trclosure(@_) )
        : trclosure(@_);
    &$coderef($str);
}
##
## trclosure(SEARCHLIST, REPLACEMENTLIST; MODIFIER, PATTERN, TOPATTERN)
##
sub trclosure($$;$$$) {
    my(@fr, @to, $noxs, $r, $R, $c, $d, $s, $h, $i, %hash);
    my($fr, $to, $mod, $re, $tore) = @_;
    $mod ||= ''; # '0' is not supposed.
    $noxs = $[ <= CORE::index($mod, 'n');
    $h = $[ <= CORE::index($mod, 'h');
    $r = $[ <= CORE::index($mod, 'r');
    $R = $[ <= CORE::index($mod, 'R');
    if (@_ <= 3 && !$h && !$noxs && !ref $fr && !ref $to) {
        if (!$R) {
            $fr = mkrange($fr, $r);
            $to = mkrange($to, $r);
        }
        my $trans = mktrans($fr, $to, $mod);
        return sub {
            strtr_light($_[0], $trans, $mod);
        };
    }
    if (ref $fr) {
        @fr = @$fr;
        $re = defined $re
            ? "$re|$Char"
            : join('|', map(quotemeta($_), @$fr), $Char);
    } else {
        $fr = mkrange($fr, $r) unless $R;
        $re = defined $re ? "$re|$Char" : $Char;
        @fr = $fr =~ /\G$re/g;
    }
    if (ref $to) {
        @to = @$to;
        $tore = defined $tore
            ? "$tore|$Char"
            : join('|', map(quotemeta($_), @$to), $Char);
    } else {
        $to = mkrange($to, $r) unless $R;
        $tore = defined $tore ? "$tore|$Char" : $re;
        @to = $to =~ /\G$tore/g;
    }
    $c = $[ <= CORE::index($mod, 'c');
    $d = $[ <= CORE::index($mod, 'd');
    $s = $[ <= CORE::index($mod, 's');
    my $modes = $s * 4 + $d * 2 + $c;
    for ($i = 0; $i < @fr; $i++) {
        next if exists $hash{ $fr[$i] };
        $hash{ $fr[$i] } = @to
            ? defined $to[$i] ? $to[$i] : $d ? '' : $to[-1]
            : $d && !$c ? '' : $fr[$i];
    }
    return
        $modes == 0 || $modes == 2 ?
            sub { # $c: false, $d: true/false, $s: false, $mod:  0 or 2
                my $str = shift;
                my $cnt = 0; my %cnt = ();
                (ref $str ? $$str : $str) =~ s{($re)}{
                    exists $hash{$1}
                        ? ($h ? ++$cnt{$1} : ++$cnt, $hash{$1})
                        : $1;
                }ge;
                return $h
                    ? wantarray ? %cnt : \%cnt
                    : ref $str  ? $cnt : $str;
            } :
        $modes == 1 ?
            sub { # $c: true, $d: false, $s: false, $mod: 1
                my $str = shift;
                my $cnt = 0; my %cnt = ();
                (ref $str ? $$str : $str) =~ s{($re)}{
                    exists $hash{$1} ? $1
                        : ($h ? ++$cnt{$1} : ++$cnt, @to) ? $to[-1] : $1;
                }ge;
                return $h
                    ? wantarray ? %cnt : \%cnt
                    : ref $str  ? $cnt : $str;
            } :
        $modes == 3 || $modes == 7 ?
            sub { # $c: true, $d: true, $s: true/false, $mod: 3 or 7
                my $str = shift;
                my $cnt = 0; my %cnt = ();
                (ref $str ? $$str : $str) =~ s{($re)}{
                    exists $hash{$1} ? $1 : ($h ? ++$cnt{$1} : ++$cnt, '');
                }ge;
                return $h
                    ? wantarray ? %cnt : \%cnt
                    : ref $str  ? $cnt : $str;
            } :
        $modes == 4 || $modes == 6 ?
            sub { # $c: false, $d: true/false, $s: true, $mod: 4 or 6
                my $str = shift;
                my $cnt = 0; my %cnt = ();
                my $pre = '';
                (ref $str ? $$str : $str) =~ s{($re)}{
                    exists $hash{$1} ? ($h ? ++$cnt{$1} : ++$cnt,
                        $hash{$1} eq '' || $hash{$1} eq $pre
                            ? '' : ($pre = $hash{$1})
                    ) : ($pre = '', $1);
                }ge;
                return $h
                    ? wantarray ? %cnt : \%cnt
                    : ref $str  ? $cnt : $str;
            } :
        $modes == 5 ?
            sub { # $c: true, $d: false, $s: true, $mod: 5
                my $str = shift;
                my $cnt = 0; my %cnt = ();
                my $pre = '';
                my $tmp;
                (ref $str ? $$str : $str) =~ s{($re)}{
                    exists $hash{$1}
                        ? ($pre = '', $1)
                        : ($h ? ++$cnt{$1} : ++$cnt,
                            $tmp = @to ? $to[-1] : $1,
                                $tmp eq $pre ? '' : ($pre = $tmp)
                    );
                }ge;
                return $h
                    ? wantarray ? %cnt : \%cnt
                    : ref $str  ? $cnt : $str;
            } :
            sub { croak "$PACKAGE Panic! Invalid closure in trclosure!\n" }
}
1;
__END__