1program uudecode;
2
3  CONST defaultSuffix = '.uue';
4        offset = 32;
5
6  TYPE string80 = string[80];
7
8  VAR infile: text;
9      fi    : file of byte;
10      outfile: file of byte;
11      lineNum: integer;
12      line: string80;
13      size,remaining :real;
14
15  procedure Abort(message: string80);
16
17    begin {abort}
18      writeln;
19      if lineNum > 0 then write('Line ', lineNum, ': ');
20      writeln(message);
21      halt
22    end; {Abort}
23
24  procedure NextLine(var s: string80);
25
26    begin {NextLine}
27      LineNum := succ(LineNum);
28      {write('.');}
29      readln(infile, s);
30      remaining:=remaining-length(s)-2;  {-2 is for CR/LF}
31      write('bytes remaining: ',remaining:7:0,' (',
32            remaining/size*100.0:3:0,'%)',chr(13));
33    end; {NextLine}
34
35  procedure Init;
36
37    procedure GetInFile;
38
39      VAR infilename: string80;
40
41      begin {GetInFile}
42        if ParamCount = 0 then abort ('Usage: uudecode <filename>');
43        infilename := ParamStr(1);
44        if pos('.', infilename) = 0
45          then infilename := concat(infilename, defaultSuffix);
46        assign(infile, infilename);
47        {$i-}
48        reset(infile);
49        {$i+}
50        if IOresult > 0 then abort (concat('Can''t open ', infilename));
51        writeln ('Decoding ', infilename);
52        assign(fi,infilename); reset(fi);
53        size:=FileSize(fi); close(fi);
54        if size < 0 then size:=size+65536.0;
55        remaining:=size;
56      end; {GetInFile}
57
58    procedure GetOutFile;
59
60      var header, mode, outfilename: string80;
61          ch: char;
62
63      procedure ParseHeader;
64
65        VAR index: integer;
66
67        Procedure NextWord(var word:string80; var index: integer);
68
69          begin {nextword}
70            word := '';
71            while header[index] = ' ' do
72              begin
73                index := succ(index);
74                if index > length(header) then abort ('Incomplete header')
75              end;
76            while header[index] <> ' ' do
77              begin
78                word := concat(word, header[index]);
79                index := succ(index)
80              end
81          end; {NextWord}
82
83        begin {ParseHeader}
84          header := concat(header, ' ');
85          index := 7;
86          NextWord(mode, index);
87          NextWord(outfilename, index)
88        end; {ParseHeader}
89
90      begin {GetOutFile}
91        if eof(infile) then abort('Nothing to decode.');
92        NextLine (header);
93        while not ((copy(header, 1, 6) = 'begin ') or eof(infile)) do
94          NextLine(header);
95        writeln;
96        if eof(infile) then abort('Nothing to decode.');
97        ParseHeader;
98        assign(outfile, outfilename);
99        writeln ('Destination is ', outfilename);
100        {$i-}
101        reset(outfile);
102        {$i+}
103        if IOresult = 0 then
104          begin
105            write ('Overwrite current ', outfilename, '? [Y/N] ');
106            repeat
107              read (kbd, ch);
108              ch := UpCase(ch)
109            until ch in ['Y', 'N'];
110            writeln(ch);
111            if ch = 'N' then abort ('Overwrite cancelled.')
112          end;
113        rewrite (outfile);
114      end; {GetOutFile}
115
116    begin {init}
117      lineNum := 0;
118      GetInFile;
119      GetOutFile;
120    end; { init}
121
122  Function CheckLine: boolean;
123
124    begin {CheckLine}
125      if line = '' then abort ('Blank line in file');
126      CheckLine := not (line[1] in [' ', '`'])
127    end; {CheckLine}
128
129
130  procedure DecodeLine;
131
132    VAR lineIndex, byteNum, count, i: integer;
133        chars: array [0..3] of byte;
134        hunk: array [0..2] of byte;
135
136{    procedure debug;
137
138      var i: integer;
139
140      procedure writebin(x: byte);
141
142        var i: integer;
143
144        begin
145          for i := 1 to 8 do
146            begin
147              write ((x and $80) shr 7);
148              x := x shl 1
149            end;
150          write (' ')
151        end;
152
153      begin
154        writeln;
155        for i := 0 to 3 do writebin(chars[i]);
156        writeln;
157        for i := 0 to 2 do writebin(hunk[i]);
158        writeln
159      end;      }
160
161    function nextch: char;
162
163      begin {nextch}
164        lineIndex := succ(lineIndex);
165        if lineIndex > length(line) then abort('Line too short.');
166        if not (line[lineindex] in [' '..'`'])
167          then abort('Illegal character in line.');
168{        write(line[lineindex]:2);}
169        if line[lineindex] = '`' then nextch := ' '
170                                 else nextch := line[lineIndex]
171      end; {nextch}
172
173    procedure DecodeByte;
174
175      procedure GetNextHunk;
176
177        VAR i: integer;
178
179        begin {GetNextHunk}
180          for i := 0 to 3 do chars[i] := ord(nextch) - offset;
181          hunk[0] := (chars[0] shl 2) + (chars[1] shr 4);
182          hunk[1] := (chars[1] shl 4) + (chars[2] shr 2);
183          hunk[2] := (chars[2] shl 6) + chars[3];
184          byteNum := 0  {;
185          debug          }
186        end; {GetNextHunk}
187
188      begin {DecodeByte}
189        if byteNum = 3 then GetNextHunk;
190        write (outfile, hunk[byteNum]);
191        {writeln(bytenum, ' ', hunk[byteNum]);}
192        byteNum := succ(byteNum)
193      end; {DecodeByte}
194
195    begin {DecodeLine}
196      lineIndex := 0;
197      byteNum := 3;
198      count := (ord(nextch) - offset);
199      for i := 1 to count do DecodeByte
200    end; {DecodeLine}
201
202  procedure terminate;
203
204    var trailer: string80;
205
206    begin {terminate}
207      if eof(infile) then abort ('Abnormal end.');
208      NextLine (trailer);
209      if length (trailer) < 3 then abort ('Abnormal end.');
210      if copy (trailer, 1, 3) <> 'end' then abort ('Abnormal end.');
211      close (infile);
212      close (outfile)
213    end;
214
215  begin {uudecode}
216    init;
217    NextLine(line);
218    while CheckLine do
219      begin
220        DecodeLine;
221        NextLine(line)
222      end;
223    terminate
224  end.
225