
(********************************************************************)
(*                                                                  *)
(*  encoding.s7i  Encoding and decoding functions                   *)
(*  Copyright (C) 2007, 2008  Thomas Mertes                         *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


const func string: toBase64 (in string: stri) is func
  result
    var string: result is "";
  local
    const string: coding is "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
    var integer: index is 1;
    var integer: subIndex is 1;
    var char: ch is ' ';
    var integer: threeBytes is 0;
    var string: fourBytes is "    ";
    var integer: posToAddNewline is 58;
  begin
    for index range 1 to length(stri) step 3 do
      threeBytes := 0;
      for subIndex range index to index + 2 do
        if subIndex <= length(stri) then
          ch := stri[subIndex];
          if ch >= '\256\' then
            raise RANGE_ERROR;
          end if;
        else
          ch := '\0\';
        end if;
        threeBytes := (threeBytes << 8) + ord(ch);
      end for;
      fourBytes @:= [1] coding[succ( threeBytes >> 18)];
      fourBytes @:= [2] coding[succ((threeBytes >> 12) mod 64)];
      fourBytes @:= [3] coding[succ((threeBytes >>  6) mod 64)];
      fourBytes @:= [4] coding[succ( threeBytes        mod 64)];
      if index = posToAddNewline then
        result &:= "\n";
        posToAddNewline +:= 57;
      end if;
      result &:= fourBytes;
    end for;
    index := length(result);
    if length(stri) rem 3 = 2 then
      result @:= [index] '=';
    elsif length(stri) rem 3 = 1 then
      result @:= [index] '=';
      result @:= [pred(index)] '=';
    end if;
  end func;


const func string: fromBase64 (in string: stri) is func
  result
    var string: result is "";
  local
    const array integer: decode is [] (                      # -1 is illegal
        62, -1, -1, -1, 63,                                  # + /
        52, 53, 54, 55, 56, 57, 58, 59, 60, 61,              # 0 - 9
        -1, -1, -1,  0, -1, -1, -1,                          # =
         0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12,  # A - M
        13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,  # N - Z
        -1, -1, -1, -1, -1, -1,
        26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,  # a - m
        39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51); # n - z
    var integer: index is 1;
    var integer: subIndex is 1;
    var integer: number is 0;
    var integer: fourBytes is 0;
    var string: threeBytes is "   ";
  begin
    while index <= length(stri) - 3 do
      if stri[index] >= '+' then
        fourBytes := 0;
        for subIndex range index to index + 3 do
          number := decode[ord(stri[subIndex]) - ord(pred('+'))];
          if number = -1 then
            raise RANGE_ERROR;
          end if;
          fourBytes := (fourBytes << 6) + number;
        end for;
        threeBytes @:= [1] chr( fourBytes >> 16);
        threeBytes @:= [2] chr((fourBytes >>  8) mod 256);
        threeBytes @:= [3] chr( fourBytes        mod 256);
        result &:= threeBytes;
        index +:= 4;
      elsif stri[index] = '\n' then
        incr(index);
      elsif stri[index] = '\r' or stri[succ(index)] = '\n' then
        index +:= 2;
      else
        raise RANGE_ERROR;
      end if;
    end while;
    if index <> succ(length(stri)) then
      raise RANGE_ERROR;
    end if;
    if stri[length(stri) - 1 len 2] = "==" then
      result := result[.. length(result) - 2];
    elsif length(stri) >= 1 and stri[length(stri)] = '=' then
      result := result[.. pred(length(result))];
    end if;
  end func;


const func string: toQuotedPrintable (in string: stri) is func
  result
    var string: result is "";
  local
    var integer: index is 0;
    var integer: startPos is 1;
    var integer: counter is 1;
    var char: ch is ' ';
  begin
    for index range 1 to length(stri) do
      ch := stri[index];
      if ch >= '\256\' then
        raise RANGE_ERROR;
      elsif ch = '\n' or (ch = '\r' and
          index < length(stri) and stri[succ(index)] = '\n') then
        if index > 1 then
          ch := stri[pred(index)];
          if ch = ' ' or ch = '\t' then
            result &:= stri[startPos .. index - 2];
            if counter >= 76 then
              result &:= "=\n";
              counter := 1;
            end if;
            result &:= "=" <& str(ord(stri[pred(index)]), 16) lpad0 2;
            counter +:= 3;
            startPos := index;
          end if;
        end if;
        counter := 1;
      elsif ch >= '\127\' or ch = '=' or (ch < ' ' and ch <> '\9\') then
        result &:= stri[startPos .. pred(index)];
        if counter >= 74 then
          result &:= "=\n";
          counter := 1;
        end if;
        result &:= "=" <& str(ord(ch), 16) lpad0 2;
        startPos := succ(index);
        counter +:= 3;
      elsif counter >= 76 then
        result &:= stri[startPos .. pred(index)] & "=\n";
        startPos := index;
        counter := 2;
      else
        incr(counter);
      end if;
    end for;
    result &:= stri[startPos ..];
  end func;


const func string: fromQuotedPrintable (in string: stri) is func
  result
    var string: result is "";
  local
    var integer: startPos is 1;
    var integer: equalSignPos is 0;
    var string: twoChars is "";
  begin
    equalSignPos := pos(stri, "=");
    while equalSignPos <> 0 do
      result &:= stri[startPos .. pred(equalSignPos)];
      if equalSignPos < length(stri) and
          stri[succ(equalSignPos)] = '\n' then
        startPos := equalSignPos + 2;
      elsif equalSignPos <= length(stri) - 2 then
        twoChars := stri[succ(equalSignPos) len 2];
        if twoChars <> "\r\n" then
          result &:= str(chr(toInt(twoChars, 16)));
        end if;
        startPos := equalSignPos + 3;
      else
        raise RANGE_ERROR;
      end if;
      equalSignPos := pos(stri, "=", startPos);
    end while;
    result &:= stri[startPos ..];
  end func;


const func string: toUuencoded (in string: stri) is func
  result
    var string: result is "";
  local
    var integer: index is 1;
    var integer: subIndex is 1;
    var char: ch is ' ';
    var integer: threeBytes is 0;
    var string: fourBytes is "    ";
    var integer: posToAddNewline is 43;
  begin
    if length(stri) <> 0 then
      if length(stri) < 45 then
        result &:= str(chr(32 + length(stri)));
      else
        result &:= "M";
      end if;
      for index range 1 to length(stri) step 3 do
        threeBytes := 0;
        for subIndex range index to index + 2 do
          if subIndex <= length(stri) then
            ch := stri[subIndex];
            if ch >= '\256\' then
              raise RANGE_ERROR;
            end if;
          else
            ch := '\0\';
          end if;
          threeBytes := (threeBytes << 8) + ord(ch);
        end for;
        fourBytes @:= [1] chr(32 + (threeBytes >> 18));
        fourBytes @:= [2] chr(32 + (threeBytes >> 12) mod 64);
        fourBytes @:= [3] chr(32 + (threeBytes >>  6) mod 64);
        fourBytes @:= [4] chr(32 +  threeBytes        mod 64);
        result &:= fourBytes;
        if index = posToAddNewline then
          if length(stri) <= index + 2 then
            noop;
          elsif length(stri) - index - 2 < 45 then
            result &:= "\n" & str(chr(32 + length(stri) - index - 2));
          else
            result &:= "\nM";
          end if;
          posToAddNewline +:= 45;
        end if;
      end for;
      result &:= "\n";
    end if;
    result &:= "`\n";
  end func;


const func string: fromUuencoded (in string: stri) is func
  result
    var string: result is "";
  local
    var integer: lineLength is 1;
    var integer: index is 1;
    var integer: subIndex is 1;
    var integer: number is 0;
    var integer: fourBytes is 0;
    var string: threeBytes is "   ";
  begin
    lineLength := ord(stri[1]) - 32;
    while lineLength <> 0 and lineLength <> 64 do
      incr(index);
      while lineLength >= 1 do
        fourBytes := 0;
        for subIndex range index to index + 3 do
          number := ord(stri[subIndex]) - 32;
          if number = 64 then
            number := 0;
          elsif number < 0 or number > 64 then
            raise RANGE_ERROR;
          end if;
          fourBytes := (fourBytes << 6) + number;
        end for;
        threeBytes @:= [1] chr( fourBytes >> 16);
        threeBytes @:= [2] chr((fourBytes >>  8) mod 256);
        threeBytes @:= [3] chr( fourBytes        mod 256);
        result &:= threeBytes[ .. lineLength];
        lineLength -:= 3;
        index +:= 4;
      end while;
      while index <= length(stri) and stri[index] <> '\n' do
        incr(index);
      end while;
      if index < length(stri) then
        incr(index);
        lineLength := ord(stri[index]) - 32;
      else
        lineLength := 0;
      end if;
    end while;
  end func;
