software/tcl/ucat.tcl

   1 #!/usr/bin/tclsh8.4
   2 array set defaults {
   3 acat {-s cp866 -d koi8-r -l crlf}
   4 wcat {-s cp1251 -d koi8-r -l crlf}
   5 mcat {-s macCyrillic -d koi8-r -l cr}
   6 icat {-s iso8859-5 -d koi8-r -l lf}
   7 }
   8
   9 proc help {} {
  10   puts "Usage ucat options \[files\]
  11   where options may be:
  12   -s charset  - set source charset
  13   -d charset - set destination charset
  14   -l mode - set input eol translation mode (one of cr, crlf, lf)
  15   -r - reverese input output
  16   Allowed charset:
  17   [encoding names]"
  18   exit 1
  19 }
  20
  21 if [info exists defaults([file tail $argv0])] {
  22   set argv [concat $defaults([file tail $argv0]) $argv]
  23 }
  24 set index 0
  25
  26 proc next_key {list raise_Error} {
  27   upvar $list l
  28   if {$raise_Error && ![llength $l]} {
  29     puts stderr "Option requires an argument"
  30     exit 1
  31   }
  32   set val [lindex $l 0]
  33   set l [lrange $l 1 end]
  34
  35   return $val
  36 }
  37
  38 proc do_file {f} {
  39   global incharset outcharset inlf outlf
  40   fconfigure $f -encoding $incharset -translation $inlf
  41   while {![eof $f]} {
  42     puts -nonewline  [read $f 4096]
  43   }
  44 }
  45 set reverse 0
  46 set incharset utf-8
  47 set outcharset [encoding system]
  48 set inlf auto
  49 switch $tcl_platform(platform) {
  50   unix { set outlf lf }
  51   windows {set outlf crlf}
  52   mac {set outlf cr}
  53   default {set outlf lf}
  54 }
  55 while {[llength [set key [next_key argv 0]]]} {
  56    if {$key=="-" || ![string match -* $key]} {
  57       set argv [concat $key $argv]
  58       break
  59    }
  60    switch -exact -- $key {
  61      -s { set incharset [next_key argv 1] }
  62      -d {set outcharset [next_key argv 1]}
  63      -r {set reverse 1}
  64      -l {set inlf [next_key argv 1]}
  65      default {
  66        puts stderr "Invalid option $key"
  67        help
  68      }
  69    }
  70 }
  71
  72 if $reverse {
  73   set tmp $incharset
  74   set incharset $outcharset
  75   set outcharset $tmp
  76   set tmp $inlf
  77   set inlf $outlf
  78   set outlf $tmp
  79 }
  80
  81 fconfigure stdout -encoding $outcharset -translation $outlf
  82 if {$outcharset=="unicode"} {
  83   puts -nonewline "\uFEFF"
  84 }
  85 if {![llength $argv]} {
  86    do_file stdin
  87 } else {
  88   foreach file $argv {
  89      if {$file=="-"} {
  90        do_file stdin
  91      } else {
  92        if [catch {open $file} f] {
  93           puts stderr "$file: $f"
  94           exit 1
  95        }
  96        do_file $f
  97        close $f
  98      }
  99   }
 100 }