home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / iiencode.icn < prev    next >
Text File  |  2001-05-02  |  7KB  |  218 lines
  1. ############################################################################
  2. #
  3. #       File:     iiencode.icn
  4. #
  5. #       Subject:  Program to encode text in the style of uuencode
  6. #
  7. #       Author:   Richard L. Goerwitz, enhanced by Frank J. Lhota
  8. #
  9. #       Date:     May 2, 2001
  10. #
  11. ###########################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #       Version:  2.0
  18. #
  19. ###########################################################################
  20. #
  21. #  This is an Icon port of the UNIX/C uuencode utility.  Since
  22. #  uuencode is publicly distributable BSD code, I simply grabbed a
  23. #  copy, and rewrote it in Icon.  The only basic functional changes I
  24. #  made to the program were:  (1) To simplify the notion of file mode
  25. #  (everything is encoded with 0644 permissions), and (2) to add sup-
  26. #  port for xxencode format (which will generally pass unscathed even
  27. #  through EBCDIC sites).
  28. #
  29. #  Iiencode's usage is compatible with that of the UNIX uuencode
  30. #  command, i.e. a first (optional) argument gives the name the file
  31. #  to be encoded.  If this is omitted, iiencode just uses the standard
  32. #  input.  The second argument specifies the name the encoded file
  33. #  should be given when it is ultimately decoded.
  34. #
  35. #  Extensions to the base uuencode command options include -x and -o.
  36. #  An -x tells iiencode to use xxencode (rather than uuencode) format.
  37. #  Option -o causes the following argument to be used as the file
  38. #  iiencode is to write its output to (the default is &output).  Note
  39. #  that, on systems with newline translation (e.g. MS-DOS), the -o
  40. #  argument should always be used.
  41. #
  42. #    iiencode [infile] [-x] remote-filename [-o output-filename]
  43. #
  44. #
  45. #  FIXES: Speeded up substantially (more than twice as fast on my
  46. #  machine) by using a more icon-ish algorithm.  We encode in two
  47. #  steps:
  48. #
  49. #  1)   We first "unpack" the bytes by taking groups of 3 bytes (24
  50. #       bits) and spreading them out by inserting two 0 bits before
  51. #       every block of 6 bits.  The result is that each group of 3     
  52. #       bytes is unpacked to 4 "small bytes", each <<= "\x3F".                          
  53. #  2)   The unpacked bytes are mapped to the coded line by using the
  54. #       Icon map function.                      
  55. #
  56. #  There are numerous advantages to this approach.  The Icon map
  57. #  function is much faster than the 'C'-ish alternatives.  We can
  58. #  process the file one line at a time. Also, the different encoding
  59. #  mechanisms (old BSD, new BSD, xxencode) can be produces by simply
  60. #  using different map parameters.
  61. #
  62. ############################################################################
  63. #
  64. #  See also: iidecode.icn
  65. #
  66. ############################################################################
  67.  
  68. link options
  69.  
  70. procedure main ( a )
  71.  
  72.     local in_filename, out_filename, in, out, is_xx, remotename, opt
  73.  
  74.     # Parse arguments.
  75.  
  76.     opt := options ( a, "-o:-x", Usage )
  77.     is_xx := opt [ "x" ]
  78.     out_filename := opt [ "o" ]
  79.     case *a of {
  80.     1 :
  81.         in_filename := remotename := a [ 1 ]
  82.     2 :
  83.     {
  84.     in_filename := a [ 1 ]
  85.     remotename  := a [ 2 ]
  86.     }
  87.     default :
  88.     Usage ( "", write, 2 )
  89.     }
  90.        
  91.     # If no input filename was supplied, use &input.
  92.     if /in_filename then
  93.     in := &input
  94.     else
  95.     in := open ( in_filename, "ru" ) |
  96.         Usage ( "Can't open input file " || in_filename || "." )
  97.  
  98.     # If an output filename was specified, open it for writing.
  99.     if /out_filename then
  100.     out := &output
  101.     else
  102.     out := open ( out_filename, "w" ) |
  103.         Usage ( "Can't open output file " || out_filename || "." )
  104.  
  105.     # This generic version of uuencode treats file modes in a primitive
  106.     # manner so as to be usable in a number of environments.  Please
  107.     # don't get fancy and change this unless you plan on keeping your
  108.     # modified version on-site (or else modifying the code in such a
  109.     # way as to avoid dependence on a specific operating system).
  110.     write ( out, "begin 644 ", remotename )
  111.     encode ( out, in, is_xx )
  112.     write ( out, "end" )
  113.  
  114.     every close ( ( &input ~=== in ) | ( &output ~=== out ) )
  115.     exit ( 0 )
  116.  
  117. end
  118.  
  119. ###########################################################################
  120. #
  121. # Writes msg and the Usage line to &errout using the output procedure Show,
  122. # which defaults to stop.  If Show does not stop processing and \errcode,
  123. # exit with errcode.
  124. #
  125. ###########################################################################
  126. procedure Usage ( msg, Show, errcode )
  127.     static usage
  128.     initial usage := "usage:  iiencode [infile] [-x] _
  129.     remote-filename [-o output-filename]"
  130.  
  131.     /Show := stop
  132.     Show ( &errout, msg, "\n", usage )
  133.     exit ( \errcode )
  134.     return msg
  135. end
  136.  
  137. ###########################################################################
  138. #
  139. # Reads all of file in, encodes it, and writes the encoded lines to out.
  140. # "uu" encoding is used unless \is_xx, in which case "xx" encoding is used.
  141. #
  142. ###########################################################################
  143. procedure encode ( out, in, is_xx )
  144.  
  145.     # Copy from in to out, encoding as you go along.
  146.  
  147.     local line, coded
  148.     static unpacked
  149.     initial unpacked := "_
  150.     \x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F_
  151.     \x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F_
  152.     \x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2A\x2B\x2C\x2D\x2E\x2F_
  153.     \x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3A\x3B\x3C\x3D\x3E\x3F"
  154.  
  155.     if \is_xx then {
  156.     coded := "_
  157.         +-0123456789ABCD_
  158.         EFGHIJKLMNOPQRST_
  159.         UVWXYZabcdefghij_
  160.         klmnopqrstuvwxyz"
  161.     }
  162.     else {
  163.     # 
  164.     # To get the BSD old code, replace the next 2 lines with:
  165.     #       coded := " _
  166.     #            !\"#$%&'()*+,-./_
  167.     #
  168.     coded := "_
  169.         `!\"#$%&'()*+,-./_
  170.         0123456789:;<=>?_
  171.         @ABCDEFGHIJKLMNO_
  172.         PQRSTUVWXYZ[\\]^_"
  173.     }
  174.  
  175.     # 1 (up to) 45 character segment
  176.     while line := reads ( in, 45 ) do {
  177.     write ( out,
  178.         map ( char ( *line ) || unpack ( line ), unpacked, coded )
  179.     )
  180.     }
  181.  
  182.     # Output a zero-length line.
  183.     write ( out, coded [ 1 ] )
  184.     
  185. end
  186.  
  187. ###########################################################################
  188. #
  189. # Takes groups of 3 bytes in s and expands the groups to 4 bytes.  Each
  190. # byte in the unpacked group has 2 zero high bits, i.e. is <<= "\x3F".
  191. # If *s is not divisible by 3, we pad s with blanks on the right
  192. # to make up the last group.
  193. #
  194. ###########################################################################
  195. procedure unpack ( s )
  196.  
  197.     local n, grp
  198.  
  199.     s ? {
  200.     s := ""
  201.  
  202.     while grp := ( move ( 3 ) | left ( "" ~== tab ( 0 ), 3 ) ) do
  203.         {
  204.         n := 0
  205.         grp ? while n := ord ( move ( 1 ) ) + ( n * 16r100 )
  206.  
  207.         s ||:=
  208.         char ( ishift ( iand ( n, 16rFC0000 ), -18 ) ) ||
  209.         char ( ishift ( iand ( n, 16r03F000 ), -12 ) ) ||
  210.         char ( ishift ( iand ( n, 16r000FC0 ), - 6 ) ) ||
  211.         char (          iand ( n, 16r00003F )        )
  212.         }
  213.     }
  214.  
  215.     return s
  216.  
  217. end
  218.