home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / plum2_33_1.lzh / support / cnvcode < prev    next >
Text File  |  1999-03-24  |  9KB  |  413 lines
  1. #!/bin/perl -w
  2. # $Id: cnvcode,v 2.14 1998/12/19 14:15:22 hasegawa Exp $
  3. # copyright (c)1997-1998 Yoshinori Hasegawa <hasegawa@madoka.org>
  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 >= 0241) {
  113.       if ($kanji != 1) {
  114.         $jis .= "\e\$B";
  115.         $kanji = 1;
  116.       }
  117.       $jis .= pack('C', $n & 0177);
  118.       $i++;
  119.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  120.     } elsif ($n == 0216) {
  121.       if ($kanji != 2) {
  122.         $jis .= "\e(I";
  123.         $kanji = 2;
  124.       }
  125.       $i++;
  126.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  127.     } elsif ($n == 0217) {
  128.       if ($kanji != 3) {
  129.         $jis .= "\e\$(D";
  130.         $kanji = 3;
  131.       }
  132.       $i++;
  133.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  134.       $i++;
  135.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  136.     } else {
  137.       if ($kanji) {
  138.         $jis .= "\e\(B";
  139.         $kanji = 0;
  140.       }
  141.       $jis .= $c;
  142.     }
  143.   }
  144.   $jis .= "\e\(B" if $kanji;
  145.   return $jis;
  146. }
  147.  
  148. sub 'euc_sjis {
  149.   local($euc) = @_;
  150.   local($sjis, $c, $n1, $n2, $i);
  151.   $sjis = '';
  152.   $euc = &'euc_euc($euc);
  153.   for ($i = 0; $i < length($euc); $i++) {
  154.     $c = substr($euc, $i, 1);
  155.     $n1 = ord($c);
  156.     if ($n1 >= 0241) {
  157.       $i++;
  158.       $n2 = ord(substr($euc, $i, 1));
  159.       if (($n1 & 01) == 0) {
  160.         $n2 -= 03;
  161.       } else {
  162.         $n2 -= 0141;
  163.       }
  164.       $n2++ if $n2 >= 0177;
  165.       $n1 = ((($n1 - 0241) >> 1) + 0241) ^ 040;
  166.       $sjis .= pack('CC', $n1, $n2);
  167.     } elsif ($n1 == 0216) {
  168.       $i++;
  169.       $sjis .= substr($euc, $i, 1);
  170.     } elsif ($n1 == 0217) {
  171.       $i += 2;
  172.       $sjis .= "\201\254";
  173.     } else {
  174.       $sjis .= $c;
  175.     }
  176.   }
  177.   return $sjis;
  178. }
  179.  
  180. sub 'jis_euc {
  181.   local($jis) = @_;
  182.   local($euc, $kanji, $i);
  183.   $kanji = 0;
  184.   $euc = '';
  185.   $jis = &'jis_jis($jis);
  186.   for ($i = 0; $i < length($jis); $i++) {
  187.     if (substr($jis, $i, 3) eq "\e\(B") {
  188.       $kanji = 0;
  189.       $i += 2;
  190.       next;
  191.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  192.       $kanji = 1;
  193.       $i += 2;
  194.       next;
  195.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  196.       $kanji = 2;
  197.       $i += 2;
  198.       next;
  199.     } elsif (substr($jis, $i, 4) eq "\e\$(D") {
  200.       $kanji = 3;
  201.       $i += 3;
  202.       next;
  203.     }
  204.     if ($kanji == 0) {
  205.       $euc .= substr($jis, $i, 1);
  206.     } elsif ($kanji == 1) {
  207.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  208.       $i++;
  209.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  210.     } elsif ($kanji == 2) {
  211.       $euc .= "\216" . pack('C', ord(substr($jis, $i, 1)) | 0200);
  212.     } elsif ($kanji == 3) {
  213.       $euc .= "\217" . pack('C', ord(substr($jis, $i, 1)) | 0200);
  214.       $i++;
  215.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  216.     }
  217.   }
  218.   return $euc;
  219. }
  220.  
  221. sub 'jis_jis {
  222.   local($jis) = @_;
  223.   local($ret, $kanji, $last, $seq, $c, $i);
  224.   $kanji = 0;
  225.   $last = 0;
  226.   $ret = '';
  227.   for ($i = 0; $i < length($jis); $i++) {
  228.     $c = substr($jis, $i, 1);
  229.     $seq = substr($jis, $i, 3);
  230.     if ($seq eq "\e\$\@" || $seq eq "\e\$B") {
  231.       $ret .= "\e\$B";
  232.       $kanji = 1;
  233.       $i += 2;
  234.       next;
  235.     } elsif ($seq eq "\e(J" || $seq eq "\e(B") {
  236.       $ret .= "\e(B";
  237.       $kanji = 0;
  238.       $i += 2;
  239.       next;
  240.     } elsif ($seq eq "\e(I") {
  241.       $ret .= "\e(I";
  242.       $kanji = 2;
  243.       $i += 2;
  244.       next;
  245.     } elsif ($c eq "\cN") {
  246.       if ($kanji != 2) {
  247.         $last = $kanji;
  248.         $ret .= "\e(I";
  249.         $kanji = 2;
  250.       }
  251.       next;
  252.     } elsif ($c eq "\cO") {
  253.       if ($kanji != 2) {
  254.         if ($last) {
  255.           $ret .= "\e\$B";
  256.         } else {
  257.           $ret .= "\e(B";
  258.         }
  259.         $kanji = $last;
  260.       }
  261.       next;
  262.     } elsif (substr($jis, $i, 6) eq "\e&\@\e\$B") {
  263.       $ret .= "\e\$B";
  264.       $kanji = 1;
  265.       $i += 5;
  266.       next;
  267.     } elsif (substr($jis, $i, 4) eq "\e\$(D") {
  268.       $ret .= "\e\$(D";
  269.       $kanji = 3;
  270.       $i += 3;
  271.       next;
  272.     }
  273.     if ($kanji == 0) {
  274.       $ret .= $c;
  275.     } elsif ($kanji == 1) {
  276.       $ret .= substr($jis, $i, 2);
  277.       $i++;
  278.     } elsif ($kanji == 2) {
  279.       $ret .= $c;
  280.     } elsif ($kanji == 3) {
  281.       $ret .= substr($jis, $i, 2);
  282.       $i++;
  283.     }
  284.   }
  285.   $ret .= "\e(B" if $kanji;
  286.   return $ret;
  287. }
  288.  
  289. sub 'jis_sjis {
  290.   local($jis) = @_;
  291.   local($sjis, $kanji, $n1, $n2, $i);
  292.   $kanji = 0;
  293.   $sjis = '';
  294.   $jis = &'jis_jis($jis);
  295.   for ($i = 0; $i < length($jis); $i++) {
  296.     if (substr($jis, $i, 3) eq "\e\(B") {
  297.       $kanji = 0;
  298.       $i += 2;
  299.       next;
  300.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  301.       $kanji = 1;
  302.       $i += 2;
  303.       next;
  304.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  305.       $kanji = 2;
  306.       $i += 2;
  307.       next;
  308.     } elsif (substr($jis, $i, 4) eq "\e\$(D") {
  309.       $kanji = 3;
  310.       $i += 3;
  311.       next;
  312.     }
  313.     if ($kanji == 0) {
  314.       $sjis .= substr($jis, $i, 1);
  315.     } elsif ($kanji == 1) {
  316.       $n1 = ord(substr($jis, $i, 1));
  317.       $i++;
  318.       $n2 = ord(substr($jis, $i, 1));
  319.       if (($n1 & 01) == 0) {
  320.         $n2 += 0175;
  321.       } else {
  322.         $n2 += 037;
  323.       }
  324.       $n2++ if $n2 >= 0177;
  325.       $n1 = ((($n1 - 041) >> 1) + 0241) ^ 040;
  326.       $sjis .= pack('CC', $n1, $n2);
  327.     } elsif ($kanji == 2) {
  328.       $sjis .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  329.     } elsif ($kanji == 3) {
  330.       $i++;
  331.       $sjis .= "\201\254";
  332.     }
  333.   }
  334.   return $sjis;
  335. }
  336.  
  337. sub 'sjis_euc {
  338.   local($sjis) = @_;
  339.   local($euc, $c, $n1, $n2, $i);
  340.   $euc = '';
  341.   $sjis = &'sjis_sjis($sjis);
  342.   for ($i = 0; $i < length($sjis); $i++) {
  343.     $c = substr($sjis, $i, 1);
  344.     $n1 = ord($c);
  345.     if ($n1 >= 0240 && $n1 <= 0337) {
  346.       $euc .= "\216$c";
  347.     } elsif ($n1 >= 0201) {
  348.       $i++;
  349.       $n2 = ord(substr($sjis, $i, 1));
  350.       $n2-- if $n2 > 0177;
  351.       if ($n2 >= 0236) {
  352.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 0242;
  353.         $n2 += 03;
  354.       } else {
  355.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 0241;
  356.         $n2 += 0141;
  357.       }
  358.       $euc .= pack('CC', $n1, $n2);
  359.     } else {
  360.       $euc .= $c;
  361.     }
  362.   }
  363.   return $euc;
  364. }
  365.  
  366. sub 'sjis_jis {
  367.   local($sjis) = @_;
  368.   local($jis, $kanji, $c, $n1, $n2, $i);
  369.   $kanji = 0;
  370.   $jis = '';
  371.   $sjis = &'sjis_sjis($sjis);
  372.   for ($i = 0; $i < length($sjis); $i++) {
  373.     $c = substr($sjis, $i, 1);
  374.     $n1 = ord($c);
  375.     if ($n1 >= 0240 && $n1 <= 0337) {
  376.       if ($kanji != 2) {
  377.         $jis .= "\e(I";
  378.         $kanji = 2;
  379.       }
  380.       $jis .= pack('C', $n1 & 0177);
  381.     } elsif ($n1 >= 0201) {
  382.       if ($kanji != 1) {
  383.         $jis .= "\e\$B";
  384.         $kanji = 1;
  385.       }
  386.       $i++;
  387.       $n2 = ord(substr($sjis, $i, 1));
  388.       $n2-- if $n2 > 0177;
  389.       if ($n2 >= 0236) {
  390.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 042;
  391.         $n2 -= 0175;
  392.       } else {
  393.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 041;
  394.         $n2 -= 037;
  395.       }
  396.       $jis .= pack('CC', $n1, $n2);
  397.     } else {
  398.       if ($kanji) {
  399.         $jis .= "\e\(B";
  400.         $kanji = 0;
  401.       }
  402.       $jis .= $c;
  403.     }
  404.   }
  405.   $jis .= "\e\(B" if $kanji;
  406.   return $jis;
  407. }
  408.  
  409. sub 'sjis_sjis {
  410.   local($sjis) = @_;
  411.   return $sjis;
  412. }
  413.