Version 3 of uuencode

Updated 2002-01-16 01:13:30

Here is a preliminary version of a uuencode module for tcllib inclusion. There are two entry points. uuencode::encode and uuencode::decode just encode or decode the input data while uuencode::uuencode and uuencode::uudecode will generate a properly formatted message (lines limited to 67 chars, length encoded into the first character). PT

This is now part of Tcllib in the base64 module as uuencode package. So :

  % package require uuencode
  1.0
  % uuencode::encode ABC
  04)#
  % uuencode::decode "04)#"
  ABC
  % set data [uuencode::uuencode -name sample.dat ABC]
  begin 644 sample.dat
  #04)#
  `
  end
  % uuencode::uudecode $data
  {sample.dat 644 ABC}
  %

 # uuencode - Copyright (C) 2002 Pat Thoyts <[email protected]>
 #
 # Provide a Tcl only implementation of uuencode and uudecode.
 #
 # TODO: use Trf if available.
 #       more test cases
 #       manual page
 #
 # -------------------------------------------------------------------------
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # -------------------------------------------------------------------------
 # @(#)$Id: 2865,v 1.4 2002-06-21 04:28:38 jcw Exp $

 namespace eval uuencode {
     namespace export encode decode uuencode uudecode
 }

 proc uuencode::Enc {c} {
     return [format %c [expr {($c != 0) ? (($c & 0x3f) + 0x20) : 0x60}]]
 }

 proc uuencode::encode {s} {
     set r {}
     binary scan $s c* d
     foreach {c1 c2 c3} $d {
         if {$c1 == {}} {set c1 0}
         if {$c2 == {}} {set c2 0}
         if {$c3 == {}} {set c3 0}
         append r [Enc [expr {$c1 >> 2}]]
         append r [Enc [expr {(($c1 << 4) & 060) | (($c2 >> 4) & 017)}]]
         append r [Enc [expr {(($c2 << 2) & 074) | (($c3 >> 6) & 003)}]]
         append r [Enc [expr {($c3 & 077)}]]
     }
     return $r
 }

 proc uuencode::decode {s} {
     set r {}
     binary scan $s c* d
     if {[expr {[llength $d] % 4}] != 0} {
         return -code error "invalid uuencoded string: length must be a\
               multiple of 4"
     }

     foreach {c0 c1 c2 c3} $d {
         append r [format %c [expr {((($c0-0x20)&0x3F) << 2) & 0xFF
                                    | ((($c1-0x20)&0x3F) >> 4) & 0xFF}]]
         append r [format %c [expr {((($c1-0x20)&0x3F) << 4) & 0xFF
                                    | ((($c2-0x20)&0x3F) >> 2) & 0xFF}]]
         append r [format %c [expr {((($c2-0x20)&0x3F) << 6) & 0xFF
                                    | (($c3-0x20)&0x3F) & 0xFF}]]
     }
     return $r
 }

 # -------------------------------------------------------------------------

 proc uuencode::uuencode {args} {
     array set opts {mode 0644 filename {} name {}}
     while {[string match -* [lindex $args 0]]} {
         switch -glob -- [lindex $args 0] {
             -f* {
                 set opts(filename) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }
             -m* {
                 set opts(mode) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }
             -n* {
                 set opts(name) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }
             -- {
                 set args [lreplace $args 0 0]
                 break
             }
             default {
                 return -code error "bad option [lindex $args 0]:\
                       must be -filename or -mode"
             }
         }
         set args [lreplace $args 0 0]
     }

     if {$opts(name) == {}} {
         set opts(name) $opts(filename)
     }
     if {$opts(name) == {}} {
         set opts(name) "data.dat"
     }

     if {$opts(filename) != {}} {
         set f [open $opts(filename) r]
         fconfigure $f -translation binary
         set data [read $f]
         close $f
     } else {
         if {[llength $args] != 1} {
             return -code error "wrong \# args: should be\
                   \"uuencode ?-mode oct? -file name | data\""
         }
         set data [lindex $args 0]
     }

     set r {}
     append r [format "begin %o %s" $opts(mode) $opts(name)] "\n"
     for {set n 0} {$n < [string length $data]} {incr n 45} {
         set s [string range $data $n [expr {$n + 44}]]
         append r [Enc [string length $s]]
         append r [encode $s] "\n"
     }
     append r "`\nend"
     return $r
 }

 # -------------------------------------------------------------------------
 # Description:
 #  Perform uudecoding of a file or data. A file may contain more than one
 #  encoded data section so the result is a list where each element is a 
 #  three element list of the provided filename, the suggested mode and the 
 #  data itself.
 #
 proc uuencode::uudecode {args} {
     array set opts {mode 0644 filename {}}
     while {[string match -* [lindex $args 0]]} {
         switch -glob -- [lindex $args 0] {
             -f* {
                 set opts(filename) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }
             -- {
                 set args [lreplace $args 0 0]
                 break
             }
             default {
                 return -code error "bad option [lindex $args 0]:\
                       must be -filename or -mode"
             }
         }
         set args [lreplace $args 0 0]
     }

     if {$opts(filename) != {}} {
         set f [open $opts(filename) r]
         fconfigure $f -translation binary
         set data [read $f]
         close $f
     } else {
         if {[llength $args] != 1} {
             return -code error "wrong \# args: should be\
                   \"uudecode -file name | data\""
         }
         set data [lindex $args 0]
     }

     set state false
     set result {}

     foreach {line} [split $data "\n"] {
         switch -exact -- $state {
             false {
                 if {[regexp {^begin ([0-7]+) ([^\s]*)} $line \
                          -> opts(mode) opts(name)]} {
                     set state true
                     set r {}
                 }
             }

             true {
                 if {[string match "end" $line]} {
                     set state false
                     lappend result [list $opts(name) $opts(mode) $r]
                 } else {
                     set n [expr {([scan $line %c] - 0x20) & 0x3F}]
                     append r [string range \
                                   [decode [string range $line 1 end]] 0 $n]
                 }
             }
         }
     }

     return $result
 }

 # -------------------------------------------------------------------------

 package provide uuencode 1.0

 # -------------------------------------------------------------------------
 #
 # Local variables:
 #   mode: tcl
 #   indent-tabs-mode: nil
 # End:

Category Package, subset Tcllib see also uudecode