#! /usr/bin/perl
#
# Samba Multibyte convert tool
# copyright (c) 2000, Hiroshi MIURA
# All rights reserved by Hiroshi MIURA
#
# Changelog --> see README
#
# TODO:
# - implement UTF-8 and EUC with JIS X0212(so-called 3byte EUC)
#
# usage: commandname [-l][-h][-p </where/to/some/hardlink/path/>][-d]
# </where/to/conv> [ </the/other/to/conv> [ <another/to/conv> .... ]]
#
# -p: default path => same path with original.
#
# Available command name is....
# euctohex, euctocap, euctojis, euctosjis
# jistohex, jistocap, jistoeuc, jistosjis
# captohex, captoeuc, captojis, captosjis
# hextoeuc, hextocap, hextojis, hextosjis
# sjistohex, sjistocap, sjistojis, sjistoeuc
# sjistosjis, captocap, hextohex, euctoeuc, jistojis
#
# these're 25 patterns. :-`)
#
require 5;
use Getopt::Std;
use File::stat;
# now, I use jcode.pl, does someone knows how to use Jcode.pm??
#
#
require "jcode.pl";
$version='2.2';
getopts("dhlp:a:");
&Show_Usage($comn) if ($opt_h);
# -----------------------------------------
# definition of important table and constants, regex.
#
@sjisconv= (
0xfa40, 0xfa49, 0xeeef,
0xfa4a, 0xfa53, 0x8754,
0xfa54, 0xfa54, 0x81ca,
0xfa55, 0xfa57, 0xeefa,
0xfa58, 0xfa58, 0x878a,
0xfa59, 0xfa59, 0x8782,
0xfa5a, 0xfa5a, 0x8784,
0xfa5b, 0xfa5b, 0x81e6,
0xfa5c, 0xfa7e, 0xed40,
0xfa80, 0xfa9b, 0xed63,
0xfa9c, 0xfafc, 0xed80,
0xfb40, 0xfb5b, 0xede1,
0xfb5c, 0xfb7e, 0xee40,
0xfb80, 0xfb9b, 0xee63,
0xfb9c, 0xfbfc, 0xee80,
0xfc40, 0xfc4b, 0xeee1,
);
$sjisconvlen=($#sjisconv+1)/3-1;
@sjisreg = (
# 0x8470, 0x847e, 0x8440, # if Win95 compatible,
# 0x8480, 0x8491, 0x844f, # validate these lines
0x8754, 0x875d, 0xfa4a,
0x8782, 0x8782, 0xfa59,
0x8784, 0x8784, 0xfa5a,
0x878a, 0x878a, 0xfa58,
0x8790, 0x8790, 0x81e0,
0x8791, 0x8791, 0x81df,
0x8792, 0x8792, 0x81e7,
0x8795, 0x8795, 0x81e3,
0x8796, 0x8796, 0x81db,
0x8797, 0x8797, 0x81da,
0x879a, 0x879a, 0x81e6,
0x879b, 0x879b, 0x81bf,
0x879c, 0x879c, 0x81be,
0xed40, 0xed62, 0xfa5c,
0xed63, 0xed7e, 0xfa80,
0xed80, 0xede0, 0xfa9c,
0xede1, 0xedfc, 0xfb40,
0xee40, 0xee62, 0xfb5c,
0xee63, 0xee7e, 0xfb80,
0xee80, 0xeee0, 0xfb9c,
0xeee1, 0xeeec, 0xfc40,
0xeeef, 0xeef8, 0xfa40,
0xeef9, 0xeef9, 0x81ca,
0xeefa, 0xeefc, 0xfa55,
0xfa54, 0xfa54, 0x81ca,
0xfa5b, 0xfa5b, 0x81e6,
);
$sjisreglen=($#sjisreg+1)/3-1;
%match = (
SJIS_C => '[\x80-\x9f\xe0-\xfc][\x40-\xfc]',
SJIS_KANA => '[\xa1-\xdf]',
SJIS_O => '[\x2f\x80-\xfc]',
SJIS_S => '[\x81-\x9f\xe0-\ec][\x40-\xfc]',
SKOS_D => '[\xed-\xfc][\x40-\xfc]'
);
$GETA=sprintf "%c%c",0x81,0xac;
#---------------------------------------------
# check command name which it called.
#
if ($opt_a) {
$comn=$opt_a;
} else {
$comn=$0;
$comn=~s|(.*/)*(.+)|$2|;
}
## who am I? :)
## definition of mb convert
if ($comn eq "euctohex"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::euc2sjis(*nname);
&sjis2rsjis(*nname);
$nname =~ s/($match{SJIS_C})/sprintf ":%2x:%2x",ord($1),ord(substr($1,1))/geo;
$nname =~ s/($match{SJIS_KANA})/sprintf ":%2x",ord($1)/geo;
($name ne $nname);
};
}elsif ($comn eq "euctocap"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::euc2sjis(*nname);
&sjis2rsjis(*nname);
$nname=~s/($match{SJIS_O})/sprintf ":%2x",ord($1)/geo;
($name ne $nname);
};
}elsif ($comn eq "euctojis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::euc2jis(*nname);
($name ne $nname);
};
}elsif ($comn eq "euctosjis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::euc2jis(*nname);
($name ne $nname);
};
}elsif ($comn eq "hextoeuc"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
&sjis2csjis(*nname);
return 0 if ($name eq $nname);
jcode::sjis2euc(*nname);
};
}elsif ($comn eq "hextojis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
&sjis2csjis(*nname);
return 0 if ($name eq $nname);
jcode::sjis2jis(*nname);
};
}elsif (($comn eq "hextocap")||($comn eq "captocap")){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
return 0 if ($name eq $nname);
&sjis2rsjis(*nname);
$nname=~s/($match{SJIS_O})/sprintf ":%2x",ord($1)/geo;
($name ne $nname);
};
}elsif ($comn eq "hextosjis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
&sjis2rsjis(*nname);
($name ne $nname);
};
}elsif ($comn eq "captoeuc"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
&sjis2csjis(*nname);
return 0 if ($name eq $nname);
jcode::sjis2euc(*nname);
};
}elsif ($comn eq "captojis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
&sjis2csjis(*nname);
return 0 if ($name eq $nname);
jcode::sjis2jis(*nname);
};
}elsif ($comn eq "captosjis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
return 0 if ($name eq $nname);
&sjis2rsjis(*nname);
};
}elsif (($comn eq "captohex")||($comn eq "hextohex")){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
$nname=~ s/\:([0-9a-f][0-9a-f])/sprintf "%c",hex($1)/geo;
&sjis2rsjis(*nname);
return 0 if ($name eq $nname);
$nname =~ s/($match{SJIS_C})/sprintf ":%2x:%2x",ord($1),ord(substr($1,1))/geo;
$nname =~ s/($match{SJIS_KANA})/sprintf ":%2x",ord($1)/geo;
};
}elsif ($comn eq "jistocap"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::jis2jis(*nname);
&sjis2rsjis(*nname);
$nname=~s/($match{SJIS_O})/sprintf ":%2x",ord($1)/geo;
($name ne $nname);
};
}elsif ($comn eq "jistohex"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::jis2sjis(*nname);
&sjis2rsjis(*nname);
$nname =~ s/($match{SJIS_C})/sprintf ":%2x:%2x",ord($1),ord(substr($1,1))/geo;
$nname =~ s/($match{SJIS_KANA})/sprintf ":%2x",ord($1)/geo;
($name ne $nname);
};
}elsif ($comn eq "jistoeuc"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::jis2euc(*nname);
($name ne $nname);
};
}elsif ($comn eq "jistosjis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::jis2sjis(*nname);
&sjis2rsjis(*nname);
($name ne $nname);
};
}elsif ($comn eq "sjistocap"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
&sjis2rsjis(*nname);
$nname=~s/($match{SJIS_O})/sprintf ":%2x",ord($1)/geo;
($name ne $nname);
};
}elsif ($comn eq "sjistohex"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
&sjis2rsjis(*nname);
$nname =~ s/($match{SJIS_C})/sprintf ":%2x:%2x",ord($1),ord(substr($1,1))/geo;
$nname =~ s/($match{SJIS_KANA})/sprintf ":%2x",ord($1)/geo;
($name ne $nname);
};
}elsif ($comn eq "sjistoeuc"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
&sjis2csjis(*nname);
jcode::sjis2euc(*nname);
($name ne $nname);
};
}elsif ($comn eq "sjistojis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
&sjis2csjis(*nname);
jcode::sjis2jis(*nname);
($name ne $nname);
};
}elsif ($comn eq "sjistosjis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
&sjis2rsjis(*nname);
($name ne $nname);
};
}elsif ($comn eq "euctoeuc"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::euc2sjis(*nname);
&sjis2csjis(*nname);
jcode::sjis2euc(*nname);
($name ne $nname);
};
}elsif ($comn eq "jistojis"){
$convmb= sub {
local(*nname) = @_;
my $name=$nname;
jcode::jis2sjis(*nname);
&sjis2csjis(*nname);
jcode::sjis2jis(*nname);
($name ne $nname);
};
}else {
&Show_Usage();
exit 1;
}
#========================================================
# main routine.
#
umask 0000;
if ($opt_l || $opt_p) { # when want to link files
&lnconv(@ARGV);
} else { # when rename files
while ($arg = shift @ARGV) {
# $arg =~ s/(\.|\.\.)\/+/\1/o;
&fnconv($arg);
}
}
exit;
#===========================================================
# subroutines.
#
#-------------------------------------------
# link arguments with file name conversion.
#
sub lnconv() {
open(FILEN, "find @_ -print |") or die "Cannot open directories\n";
while (<FILEN>){
chomp();
$nname=$name=$_;
&$convmb(*nname);
$nname="$opt_p/$nname" if ($opt_p);
if ( -l $name ) { # that is link
# only make symbolic link to original pointed.
# it may be convert the linked file/directory name?
$linked = readlink $name;
symlink $linked, $nname;
} elsif ( -d $name ) {
my $st = stat($name);
if ($opt_d) {
printf STDERR "mkdir %s %o\n", $nname, $st->mode & 07777;
} else {
if (mkdir $nname, $st->mode & 07777) {
utime $st->atime, $st->mtime, $nname;
} else {
print STDERR $!;
}
}
} elsif ( -f $name ) {
if ($opt_d) {
print STDERR "convert $name to $nname\n";
} else {
unless (link $name, $nname) {
print STDERR "fail link: operation not permitted.\n";
}
}
} else {
# pipe or device file
# ignore it
}
}
}
#--------------------------------------------------------
# rename argument's basename with &$convmb
#
sub fnconv() {
local($name)=@_;
if ( -l $name ) {
#only ignore it
} elsif ( -d $name ) {
$athash{"$name"}=stat($name)->atime;
$mthash{"$name"}=stat($name)->mtime;
local($dh)="DH_$name";
opendir $dh, $name;
while ($dentory=readdir $dh) {
next if ($dentory eq "." || $dentory eq ".."); # ignore "." and ".."
&fnconv("$name/$dentory"); # recursive call
}
closedir $dh;
$nname = &renfn($name);
if ($opt_d) {
printf "utime %d, %d, %s\n", $athash{"$name"},$mthash{"$name"},$nname unless (($name eq ".") || ($name eq ".."));
} else {
utime $athash{"$name"}, $mthash{"$name"}, $nname unless (($name eq ".") || ($name eq ".."));
}
delete $mthash{"$name"};
delete $athash{"$name"};
} elsif ( -f $name ) { # if name is file then only rename it.
&renfn($name);
} else { # another case
# only ignore it for safety.
}
}
#--------------------------------------------------------
# rename argument's basename with &$convmb
#
#
sub renfn() {
local($name)=@_;
local($basedir, $nname)=("", $name);
if ($name =~ m|(.*/)([^/]*)|o) { # split dir and fname
$basedir="$1";
$nname ="$2";
}
return $name unless (&$convmb(*nname)); # only fname converted
$nname=$basedir . $nname;
if ($opt_d) {
print STDERR "rename $name to $nname\n";
} else {
unless (rename $name, $nname) {
print STDERR "fail rename: operation not permitted.\n";
}
}
$nname;
}
#---------------------------------------------------------
# convert regular sjis to compressed sjis.
# using binary snearch method.
#
sub sjis2csjis {
local(*line) = @_;
$line =~ s/($match{SJIS_C})/&s2c($1)/geo;
}
sub s2c {
local($char) = @_;
$mb=ord($char)*256+ord(substr($char,1));
return $char if ($mb < $sjisconv[0]); # checkk if it is
return $GETA if ($sjisconv[$sjisconvlen*3+1] < $mb); # target to conv?
$min=0;$max=$sjisconvlen; # OK is will be conv
while($max >= $min){
$j=$min+($max-$min)%2;
if ($sjisconv[$j*3+0] > $mb){
$max=$j-1;
} elsif ($mb > $sjisconv[$j*3+1]) {
$min=$j+1;
} else {
$mb=$sjisconv[$j*3+2]+$mb-$sjisconv[$j*3+0];
$char=sprintf "%c%c",($mb >> 8) & 0xff,$mb & 0xff;
break;
}
}
$char=$GETA if ( $mb > 0xf000);
$char;
}
#---------------------------------------------------------
#
# convert regular sjis to regular sjis.
# using binary snearch method.
#
sub sjis2rsjis {
local(*line) = @_;
$line =~ s/($match{SJIS_C})/&s2r($1)/geo;
}
sub s2r {
local($char) = @_;
$mb=ord($char)*256 + ord(substr($char,1));
return $char if ($mb < $sjisreg[0]); # checkk if it is
if ($sjisreg[$sjisreglen*3+1] < $mb){ # target to conv?
$char=$GETA if ($mb > 0xfc4b);
return $char;
};
$min=0;$max=$sjisreglen; # OK is will be conv
while($max >= $min){
$j=$min+($max-$min)%2;
if ($sjisreg[$j*3+0] > $mb){
$max=$j-1;
} elsif ($mb > $sjisreg[$j*3+1]) {
$min=$j+1;
} else { # hit it!
$mb=$sjisreg[$j*3+2]+$mb-$sjisreg[$j*3+0];
$char=sprintf "%c%c",($mb >> 8) & 0xff, $mb & 0xff;
break;
}
}
$char;
}
#---------------------------------------------------------
sub Show_Usage {
printf "This is samba companion tool. smbchartool Ver.%s\n",$version;
print <<__EOL__;
This product is distoributed under the GNU Public License Vertion 2.
Usage: command [-h][-d][-l][-a <action>] [-p <linkpath>] <convpath>
-h: show this help message
-d: debug option. Don't actual move and removing, only display how to do
-l: make hard link, not move it
-p: make link to another directory
(it may be use with -l)
-a: point out an action
Available command names or actions are....
euctohex, euctocap, euctojis, euctosjis
jistohex, jistocap, jistoeuc, jistosjis
captohex, captoeuc, captojis, captosjis
hextoeuc, hextocap, hextojis, hextosjis
sjistohex, sjistocap, sjistojis, sjistoeuc
sjistosjis, captocap, hextohex, euctoeuc, jistojis
Copyright (c) 2000, Hiroshi MIURA <miura\@samba.gr.jp>
__EOL__
exit;
}