#!/usr/bin/perl
######################################################################
# eg/tw/mb_tr.pl - ç¨ mb::tr ä»¥å­åçºå®ä½è½å¯«
#
# æ­¤ä¾å±ç¤ºï¼
#   mb::tr(STRING, SEARCH, REPLACE [, MODIFIER]) ä»¥æ´åå¤ä½åçµ
#   å­åçºå®ä½è½å¯«ãä¸å  /r æå°ç¬¬ä¸å¼æ¸å°±å°æ¹
#   åä¸¦åå³æ¸éï¼å  /r æåå³çµæä¸ä¸åå¼æ¸ã
#
# è CORE çåå¥ï¼
#   CORE tr/// éä½åçµéä½ï¼æå¯è½æå£ DAMEMOJI --
#   ç¬¬äºå byte æ¯ ASCII åå­åçéä½åçµå­åï¼
#   ä¾å¦ So(\x83\x5C)ï¼å¶å°¾ byte \x5C æ¯åæç·ãå° \x5C
#   å·è¡ CORE tr ææå°é£åå°¾ byteï¼mb::tr å° So è¦çº
#   ä¸åå­åèä¸åå®ã
#
# æ³¨ï¼mb::tr ä¸­çé£å­èç¯å(a-z)åå° US-ASCII ç«¯é»
# å±éï¼SEARCH ä¸­çå¤ä½åçµå­åå¿é éä¸ååº
# ï¼éæ­£æ¯è½è­¯å¨å±é MBCS tr/// çæ¹å¼ï¼ã
#
# æ³¨ï¼åå§ç¢¼è \xHH è³æç¶­æ US-ASCIIï¼æ¬æªçº
# UTF-8ï¼åè¨»è§£å¨å°åçºç¹é«ä¸­æï¼ã
#
#     perl eg/tw/mb_tr.pl
#
######################################################################
use strict;
use vars qw($fw $zenkaku $n $dame $core $cn $safe $sn $keep $out);

use FindBin;
use lib "$FindBin::Bin/../../lib";
use mb;
mb::set_script_encoding('sjis');

# Shift_JIS å¨å½¢æ¸å­ï¼ 0(\x82\x4F) .. 9(\x82\x58)ã
# SEARCH éä¸ååºååå¨å½¢æ¸å­ï¼REPLACE æ¯ US-ASCII ç¯
# å "0-9"ï¼mb::tr æå±éç ASCII é£å­èç¯åï¼ã
$zenkaku = "\x82\x4F\x82\x50\x82\x51\x82\x52\x82\x53"
         . "\x82\x54\x82\x55\x82\x56\x82\x57\x82\x58";

# å¨å½¢ "1" "3" "6" -> åå½¢ "136"ã
$fw = "\x82\x50\x82\x52\x82\x55";
$n  = mb::tr($fw, $zenkaku, "0-9");
print "full->half count : $n\n";        # 3
print "full->half result: $fw\n";        # 136

# DAMEMOJI å®å¨æ§ãå­ä¸²çº A So(\x83\x5C) Bãéå®åæç·
# byte \x5C ç CORE tr ææå£å­åï¼åæ å° ASCII å­æ¯ç
# mb::tr åä¿æ So å®æ´ã
$dame = "A\x83\x5CB";

$core = $dame;
$cn   = ($core =~ tr/\x5C/#/);   # CORE tr æå° So çå°¾ byte
print "CORE tr on \\x5C  : count=$cn (corrupts DAMEMOJI)\n";   # 1

$safe = $dame;
$sn   = mb::tr($safe, "AB", "ab");
print "mb::tr letters   : count=$sn, DAMEMOJI kept=",
      (substr($safe, 1, 2) eq "\x83\x5C" ? 1 : 0), "\n";       # 2, 1

# /r ä¿®é£¾ç¬¦ï¼éç ´å£ï¼åå³è½å¯«å¾çå¯æ¬ã
$keep = "\x82\x50\x82\x51";                 # å¨å½¢ 1 2
$out  = mb::tr($keep, $zenkaku, "0-9", "r");
print "/r result        : $out\n";                            # 12
print "/r original kept : ",
      ($keep eq "\x82\x50\x82\x51" ? 1 : 0), "\n";            # 1

exit 0;
