Unit uudecod;

INTERFACE
uses Crt, Dos;

  Function UUE_Decod (Name: PathStr) : PathStr;

IMPLEMENTATION

  CONST defaultSuffix = '.uue';
        offset = 32;

Type  UUP = ^UUD;
      UUD = object
      fi    : file of byte;
      outfile: file of byte;
      lineNum: integer;
      outfilename : PathStr;
      size,remaining :real;
      procedure Abort(message: PathStr);  virtual;
      procedure NextLine(var s: PathStr); virtual;
      constructor Init (Name: PathStr);
      Function CheckLine: boolean; virtual;
      procedure DecodeLine;        virtual;
      procedure terminate;         virtual;
      destructor DoneZ;       virtual;
    end;

  VAR infile: text;
      line: PathStr;

  procedure UUD.Abort(message: PathStr);

    begin {abort}
      writeln;
      if lineNum > 0 then write('Line ', lineNum, ': ');
      writeln(message);
{      halt }
    end; {Abort}

  procedure UUD.NextLine(var s: PathStr);

    begin {NextLine}
      LineNum := succ(LineNum);
      {write('.');}
      readln(infile, s);
      remaining:=remaining-length(s)-2;  {-2 is for CR/LF}
      write('bytes remaining: ',remaining:7:0,' (',
            remaining/size*100.0:3:0,'%)',chr(13));
    end; {NextLine}

destructor UUD.DoneZ;
  begin
  end; { Cs.Done }



  constructor UUD.Init (Name: PathStr);

    procedure GetInFile;

      VAR infilename: PathStr;

      begin {GetInFile}
        if Name = '' then abort ('Usage: uudecode <filename>');
        infilename := Name;
        if pos('.', infilename) = 0
          then infilename := concat(infilename, defaultSuffix);
        assign(infile, infilename);
        {$i-}
        reset(infile);
        {$i+}
        if IOresult > 0 then abort (concat('Can''t open ', infilename));
        writeln ('Decoding ', infilename);
        assign(fi,infilename); reset(fi);
        size:=FileSize(fi); close(fi);
        if size < 0 then size:=size+65536.0;
        remaining:=size;
      end; {GetInFile}

    procedure GetOutFile;

      var header, mode: PathStr;
          ch: char;
          p : Word;

      procedure ParseHeader;

        VAR index: integer;

        Procedure NextWord(var word:PathStr; var index: integer);

          begin {nextword}
            word := '';
            while header[index] = ' ' do
              begin
                index := succ(index);
                if index > length(header) then abort ('Incomplete header')
              end;
            while header[index] <> ' ' do
              begin
                word := concat(word, header[index]);
                index := succ(index)
              end
          end; {NextWord}

        begin {ParseHeader}
          header := concat(header, ' ');
          index := 7;
          NextWord(mode, index);
          NextWord(outfilename, index)
        end; {ParseHeader}

      begin {GetOutFile}
        if eof(infile) then abort('Nothing to decode.');
        NextLine (header);
        while not ((copy(header, 1, 6) = 'begin ') or eof(infile)) do
          NextLine(header);
        writeln;
        if eof(infile) then abort('Nothing to decode.');
        ParseHeader;

       while Pos (',', outfilename) <> 0 do
         Delete (outfilename, Pos (',', outfilename), 1);

       while Pos (' ', outfilename) <> 0 do
         Delete (outfilename, Pos (' ', outfilename), 1);

       while Pos ('.', outfilename) <> 0 do begin
         p := Pos ('.', outfilename);
         Delete (outfilename, Pos ('.', outfilename), 1);
         end;
       if p > 0 then insert ('.', outfilename, p);

      if Length (outfilename) > 12 then
        outfilename := Copy (outfilename, 1, 8) +
        Copy (outfilename, p, Length(outfilename));

        assign (outfile, outfilename);
        writeln ('Destination is ', outfilename);
        {$i-}
        reset(outfile);
        {$i+}
        if IOresult = 0 then
          begin
           { write ('Overwrite current ', outfilename, '? [Y/N] ');
            repeat
              read (kbd, ch);
              ch := UpCase(ch)
            until ch in ['Y', 'N'];
            writeln(ch);
            if ch = 'N' then abort ('Overwrite cancelled.')}
          end;


        rewrite (outfile);
      end; {GetOutFile}

    begin {init}
      lineNum := 0;
      GetInFile;
      GetOutFile;
    end; { init}

  Function UUD.CheckLine: boolean;

    begin {CheckLine}
      if line = '' then abort ('Blank line in file');
      CheckLine := not (line[1] in [' ', '`'])
    end; {CheckLine}


  procedure UUD.DecodeLine;

    VAR lineIndex, byteNum, count, i: integer;
        chars: array [0..3] of byte;
        hunk: array [0..2] of byte;

    function nextch: char;

      begin {nextch}
        lineIndex := succ(lineIndex);
        if lineIndex > length(line) then abort('Line too short.');
        if not (line[lineindex] in [' '..'`'])
          then abort('Illegal character in line.');
        if line[lineindex] = '`' then nextch := ' '
                                 else nextch := line[lineIndex]
      end; {nextch}

    procedure DecodeByte;

      procedure GetNextHunk;

        VAR i: integer;

        begin {GetNextHunk}
          for i := 0 to 3 do chars[i] := ord(nextch) - offset;
          hunk[0] := (chars[0] shl 2) + (chars[1] shr 4);
          hunk[1] := (chars[1] shl 4) + (chars[2] shr 2);
          hunk[2] := (chars[2] shl 6) + chars[3];
          byteNum := 0  {;
          debug          }
        end; {GetNextHunk}

      begin {DecodeByte}
        if byteNum = 3 then GetNextHunk;
        write (outfile, hunk[byteNum]);
        {writeln(bytenum, ' ', hunk[byteNum]);}
        byteNum := succ(byteNum)
      end; {DecodeByte}

    begin {DecodeLine}
      lineIndex := 0;
      byteNum := 3;
      count := (ord(nextch) - offset);
      for i := 1 to count do DecodeByte
    end; {DecodeLine}

  procedure UUD.terminate;

    var trailer: PathStr;

    begin {terminate}
      if eof(infile) then abort ('Abnormal end.');
      NextLine (trailer);
      if length (trailer) < 3 then abort ('Abnormal end.');
      if copy (trailer, 1, 3) <> 'end' then abort ('Abnormal end.');
      close (infile);
      close (outfile)
    end;

  function UUE_Decod (Name: PathStr): PathStr;
  var P : UUP;

  begin {uudecode}
    P := New (UUP, init (Name));
    P^.NextLine(line);
    while P^.CheckLine do
      begin
        P^.DecodeLine;
        P^.NextLine(line)
      end;
    P^.terminate;
    UUE_Decod := P^.outfilename;
    Dispose (P, DoneZ);
  end;

end.
