home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_26_1.lzh / support / cnvcode < prev    next >
Text File  |  1998-07-31  |  9KB  |  378 lines
  1. #!/bin/perl -w
  2. # $Id: cnvcode,v 2.12 1998/03/19 02:05:07 hasegawa Exp $
  3. # copyright (c)1997-1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. &main(@ARGV);
  6.  
  7. sub main {
  8.   local(@args) = @_;
  9.   local($input, $output, $return, $arg);
  10.   $input = 'jis';
  11.   $output = 'jis';
  12.   $return = "\n";
  13.  
  14.   if (!@args) {
  15.     &usage();
  16.     exit(1);
  17.   }
  18.   binmode(STDIN);
  19.   binmode(STDOUT);
  20.   while (@args) {
  21.     $arg = shift(@args);
  22.     if ($arg =~ /^\-/) {
  23.       if ($arg eq '-') {
  24.         &convert(shift(@args), $input, $output, $return);
  25.       } elsif ($arg eq '--') {
  26.         &convert($arg, $input, $output, $return);
  27.       } elsif ($arg eq '-l' || $arg eq '--lf') {
  28.         $return = "\n";
  29.       } elsif ($arg eq '-r' || $arg eq '--cr') {
  30.         $return = "\r";
  31.       } elsif ($arg eq '-n' || $arg eq '--crlf') {
  32.         $return = "\r\n";
  33.       } elsif ($arg eq '-i') {
  34.         $input = shift(@args);
  35.       } elsif ($arg =~ /^\-\-input\=/) {
  36.         $input = $';
  37.       } elsif ($arg eq '-o') {
  38.         $output = shift(@args);
  39.       } elsif ($arg =~ /^\-\-output\=/) {
  40.         $output = $';
  41.       } else {
  42.         &usage();
  43.         exit(1);
  44.       }
  45.     } else {
  46.       &convert($arg, $input, $output, $return);
  47.     }
  48.   }
  49. }
  50.  
  51. sub convert {
  52.   local($file, $input, $output, $return) = @_;
  53.   local(@sub, $sub, $tmp, $buf, @item);
  54.   foreach $in (split(/\,/, $input)) {
  55.     $sub = $in . '_' . $output;
  56.     if (!defined(&$sub)) {
  57.       warn 'cannot convert ', $in, ' to ', $output, "\n";
  58.       return;
  59.     }
  60.     push(@sub, $sub);
  61.   }
  62.   if ($file eq '--') {
  63.     open(FILE, '<&STDIN');
  64.   } elsif (open(FILE, $file)) {
  65.     binmode(FILE);
  66.   } else {
  67.     warn $file, ' not found', "\n";
  68.     return;
  69.   }
  70.   $buf = '';
  71.   $tmp = '';
  72.   while (read(FILE, $tmp, 1024)) { 
  73.     $buf .= $tmp;
  74.     while ($buf =~ /(\r\n|\n|\r)/) {
  75.       @item = ($`, $');
  76.       foreach $sub (@sub) {
  77.         $item[0] = &$sub($item[0]);
  78.       }
  79.       print $item[0], $return;
  80.       $buf = $item[1] || '';
  81.     }
  82.   }
  83.   close(FILE);
  84. }
  85.  
  86. sub usage {
  87.   print 'usage: perl cnvcode [<option>] [<file>] ...', "\n";
  88.   print 'options:', "\n";
  89.   print '  -i, --input=<code>[,<code>]  input  kanji codes', "\n";
  90.   print '  -o, --output=<code>          output kanji code', "\n";
  91.   print '  -l, --lf                     line feed only (UNIX)', "\n";
  92.   print '  -r, --cr                     carriage return only (Macintosh)', "\n";
  93.   print '  -n, --crlf                   line feed and carriage return (MS-DOS/Windows)', "\n";
  94.   print 'codes:', "\n";
  95.   print '  jis euc sjis', "\n";
  96. }
  97.  
  98. sub 'euc_euc {
  99.   local($euc) = @_;
  100.   return $euc;
  101. }
  102.  
  103. sub 'euc_jis {
  104.   local($euc) = @_;
  105.   local($jis, $kanji, $c, $n, $i);
  106.   $kanji = 0;
  107.   $jis = '';
  108.   $euc = &'euc_euc($euc);
  109.   for ($i = 0; $i < length($euc); $i++) {
  110.     $c = substr($euc, $i, 1);
  111.     $n = ord($c);
  112.     if ($n >= 0xa1) {
  113.       if ($kanji != 1) {
  114.         $jis .= "\e\$B";
  115.         $kanji = 1;
  116.       }
  117.       $jis .= pack('C', $n & 0x7f);
  118.       $i++;
  119.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0x7f);
  120.     } elsif ($n == 0x8e) {
  121.       if ($kanji != 2) {
  122.         $jis .= "\e(I";
  123.         $kanji = 2;
  124.       }
  125.       $i++;
  126.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0x7f);
  127.     } else {
  128.       if ($kanji) {
  129.         $jis .= "\e\(B";
  130.         $kanji = 0;
  131.       }
  132.       $jis .= $c;
  133.     }
  134.   }
  135.   $jis .= "\e\(B" if $kanji;
  136.   return $jis;
  137. }
  138.  
  139. sub 'euc_sjis {
  140.   local($euc) = @_;
  141.   local($sjis, $c, $n1, $n2, $i);
  142.   $sjis = '';
  143.   $euc = &'euc_euc($euc);
  144.   for ($i = 0; $i < length($euc); $i++) {
  145.     $c = substr($euc, $i, 1);
  146.     $n1 = ord($c);
  147.     if ($n1 >= 0xa1) {
  148.       $i++;
  149.       $n2 = ord(substr($euc, $i, 1));
  150.       if (($n1 & 0x01) == 0) {
  151.         $n2 -= 0x03;
  152.       } else {
  153.         $n2 -= 0x61;
  154.       }
  155.       $n2++ if $n2 >= 0x7f;
  156.       $n1 = ((($n1 - 0xa1) >> 1) + 0xa1) ^ 0x20;
  157.       $sjis .= pack('CC', $n1, $n2);
  158.     } elsif ($n1 == 0x8e) {
  159.       $i++;
  160.       $sjis .= substr($euc, $i, 1);
  161.     } else {
  162.       $sjis .= $c;
  163.     }
  164.   }
  165.   return $sjis;
  166. }
  167.  
  168. sub 'jis_euc {
  169.   local($jis) = @_;
  170.   local($euc, $kanji, $i);
  171.   $kanji = 0;
  172.   $euc = '';
  173.   $jis = &'jis_jis($jis);
  174.   for ($i = 0; $i < length($jis); $i++) {
  175.     if (substr($jis, $i, 3) eq "\e\(B") {
  176.       $kanji = 0;
  177.       $i += 2;
  178.       next;
  179.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  180.       $kanji = 1;
  181.       $i += 2;
  182.       next;
  183.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  184.       $kanji = 2;
  185.       $i += 2;
  186.       next;
  187.     }
  188.     if ($kanji == 0) {
  189.       $euc .= substr($jis, $i, 1);
  190.     } elsif ($kanji == 1) {
  191.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0x80);
  192.       $i++;
  193.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0x80);
  194.     } else {
  195.       $euc .= "\x8e" . pack('C', ord(substr($jis, $i, 1)) | 0x80);
  196.     }
  197.   }
  198.   return $euc;
  199. }
  200.  
  201. sub 'jis_jis {
  202.   local($jis) = @_;
  203.   local($ret, $kanji, $last, $seq, $c, $i);
  204.   $kanji = 0;
  205.   $last = 0;
  206.   $ret = '';
  207.   for ($i = 0; $i < length($jis); $i++) {
  208.     $c = substr($jis, $i, 1);
  209.     $seq = substr($jis, $i, 3);
  210.     if ($seq eq "\e\$\@" || $seq eq "\e\$B") {
  211.       $ret .= "\e\$B";
  212.       $kanji = 1;
  213.       $i += 2;
  214.       next;
  215.     } elsif ($seq eq "\e(J" || $seq eq "\e(B") {
  216.       $ret .= "\e(B";
  217.       $kanji = 0;
  218.       $i += 2;
  219.       next;
  220.     } elsif ($seq eq "\e(I") {
  221.       $ret .= "\e(I";
  222.       $kanji = 2;
  223.       $i += 2;
  224.       next;
  225.     } elsif ($c eq "\cN") {
  226.       if ($kanji != 2) {
  227.         $last = $kanji;
  228.         $ret .= "\e(I";
  229.         $kanji = 2;
  230.       }
  231.       next;
  232.     } elsif ($c eq "\cO") {
  233.       if ($kanji != 2) {
  234.         if ($last) {
  235.           $ret .= "\e\$B";
  236.         } else {
  237.           $ret .= "\e(B";
  238.         }
  239.         $kanji = $last;
  240.       }
  241.       next;
  242.     } elsif (substr($jis, $i, 6) eq "\e&\@\e\$B") {
  243.       $ret .= "\e\$B";
  244.       $kanji = 1;
  245.       $i += 5;
  246.       next;
  247.     }
  248.     if ($kanji == 0) {
  249.       $ret .= $c;
  250.     } elsif ($kanji == 1) {
  251.       $ret .= substr($jis, $i, 2);
  252.       $i++;
  253.     } else {
  254.       $ret .= $c;
  255.     }
  256.   }
  257.   $ret .= "\e(B" if $kanji;
  258.   return $ret;
  259. }
  260.  
  261. sub 'jis_sjis {
  262.   local($jis) = @_;
  263.   local($sjis, $kanji, $n1, $n2, $i);
  264.   $kanji = 0;
  265.   $sjis = '';
  266.   $jis = &'jis_jis($jis);
  267.   for ($i = 0; $i < length($jis); $i++) {
  268.     if (substr($jis, $i, 3) eq "\e\(B") {
  269.       $kanji = 0;
  270.       $i += 2;
  271.       next;
  272.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  273.       $kanji = 1;
  274.       $i += 2;
  275.       next;
  276.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  277.       $kanji = 2;
  278.       $i += 2;
  279.       next;
  280.     }
  281.     if ($kanji == 0) {
  282.       $sjis .= substr($jis, $i, 1);
  283.     } elsif ($kanji == 1) {
  284.       $n1 = ord(substr($jis, $i, 1));
  285.       $i++;
  286.       $n2 = ord(substr($jis, $i, 1));
  287.       if (($n1 & 0x01) == 0) {
  288.         $n2 += 0x7d;
  289.       } else {
  290.         $n2 += 0x1f;
  291.       }
  292.       $n2++ if $n2 >= 0x7f;
  293.       $n1 = ((($n1 - 0x21) >> 1) + 0xa1) ^ 0x20;
  294.       $sjis .= pack('CC', $n1, $n2);
  295.     } else {
  296.       $sjis .= pack('C', ord(substr($jis, $i, 1)) | 0x80);
  297.     }
  298.   }
  299.   return $sjis;
  300. }
  301.  
  302. sub 'sjis_euc {
  303.   local($sjis) = @_;
  304.   local($euc, $c, $n1, $n2, $i);
  305.   $euc = '';
  306.   $sjis = &'sjis_sjis($sjis);
  307.   for ($i = 0; $i < length($sjis); $i++) {
  308.     $c = substr($sjis, $i, 1);
  309.     $n1 = ord($c);
  310.     if ($n1 >= 0xa0 && $n1 <= 0xdf) {
  311.       $euc .= "\x8e$c";
  312.     } elsif ($n1 >= 0x81) {
  313.       $i++;
  314.       $n2 = ord(substr($sjis, $i, 1));
  315.       $n2-- if $n2 > 0x7f;
  316.       if ($n2 >= 0x9e) {
  317.         $n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0xa2;
  318.         $n2 += 0x03;
  319.       } else {
  320.         $n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0xa1;
  321.         $n2 += 0x61
  322.       }
  323.       $euc .= pack('CC', $n1, $n2);
  324.     } else {
  325.       $euc .= $c;
  326.     }
  327.   }
  328.   return $euc;
  329. }
  330.  
  331. sub 'sjis_jis {
  332.   local($sjis) = @_;
  333.   local($jis, $kanji, $c, $n1, $n2, $i);
  334.   $kanji = 0;
  335.   $jis = '';
  336.   $sjis = &'sjis_sjis($sjis);
  337.   for ($i = 0; $i < length($sjis); $i++) {
  338.     $c = substr($sjis, $i, 1);
  339.     $n1 = ord($c);
  340.     if ($n1 >= 0xa0 && $n1 <= 0xdf) {
  341.       if ($kanji != 2) {
  342.         $jis .= "\e(I";
  343.         $kanji = 2;
  344.       }
  345.       $jis .= pack('C', $n1 & 0x7f);
  346.     } elsif ($n1 >= 0x81) {
  347.       if ($kanji != 1) {
  348.         $jis .= "\e\$B";
  349.         $kanji = 1;
  350.       }
  351.       $i++;
  352.       $n2 = ord(substr($sjis, $i, 1));
  353.       $n2-- if $n2 > 0x7f;
  354.       if ($n2 >= 0x9e) {
  355.         $n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0x22;
  356.         $n2 -= 0x7d;
  357.       } else {
  358.         $n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0x21;
  359.         $n2 -= 0x1f;
  360.       }
  361.       $jis .= pack('CC', $n1, $n2);
  362.     } else {
  363.       if ($kanji) {
  364.         $jis .= "\e\(B";
  365.         $kanji = 0;
  366.       }
  367.       $jis .= $c;
  368.     }
  369.   }
  370.   $jis .= "\e\(B" if $kanji;
  371.   return $jis;
  372. }
  373.  
  374. sub 'sjis_sjis {
  375.   local($sjis) = @_;
  376.   return $sjis;
  377. }
  378.