src/posix/generic/Host/Mod/Lang.cp

   1 MODULE HostLang;
   2
   3   IMPORT S := SYSTEM, Kernel, stdlib := C99stdlib, locale := C99locale,
   4     iconv := C99iconv, errno := C99errno, macro := C99macro;
   5
   6   CONST
   7     maxLen = 32;
   8
   9     (* modes *)
  10     replace* = 0; pep383x* = 1; pep383* = 2;
  11
  12   VAR
  13     lang-, country-, encoding-: ARRAY maxLen OF CHAR;
  14     c2sc, sc2c, invalid: iconv.iconv_t;
  15
  16   PROCEDURE StringToHost* (IN in: ARRAY OF CHAR; OUT out: ARRAY OF SHORTCHAR; mode: INTEGER; OUT res: INTEGER);
  17     VAR i, j, err: INTEGER; maxlen, len, count: iconv.size_t; inadr, outadr: Kernel.ADDRESS; sch: SHORTCHAR;
  18   BEGIN
  19     ASSERT(mode IN {replace..pep383}, 20);
  20     ASSERT(c2sc # invalid, 100);
  21     i := 0; err := 0;
  22     outadr := S.ADR(out[0]);
  23     maxlen := LEN(out) - 1;
  24     WHILE (err = 0) & (in[i] # 0X) DO
  25       j := i;
  26       WHILE (in[i] # 0X) & ((in[i] < 0D800X) OR (in[i] > 0D8FFX)) DO INC(i) END;
  27       len := (i - j) * 2;
  28       WHILE (err = 0) & (len > 0) & (maxlen > 0) DO
  29         inadr := S.ADR(in[j]);
  30         count := iconv.iconv(c2sc, inadr, len, outadr, maxlen);
  31         IF count # 0 THEN
  32           CASE macro.errno() OF
  33           | errno.EILSEQ:
  34                IF mode = replace THEN
  35                  IF maxlen < 1 THEN
  36                    err := 1
  37                  ELSE
  38                    sch := "?";
  39                    S.PUT(outadr, sch); INC(outadr); DEC(maxlen);
  40                    INC(j); DEC(len, 2)
  41                  END
  42                ELSE
  43                  err := 3
  44                END;
  45           | errno.E2BIG: err := 1 (* unexpected end of out *)
  46           | errno.EINVAL: HALT(101) (* unexpected end of input *)
  47           | errno.EBADF: HALT(102) (* invalid iconv descriptor *)
  48           ELSE HALT(103) (* unknown error *)
  49           END
  50         END
  51       END;
  52       WHILE (err = 0) & (in[i] >= 0D800X) & (in[i] <= 0D8FFX) DO
  53         IF maxlen < 1 THEN
  54           err := 1
  55         ELSE
  56           sch := SHORT(CHR(ORD(in[i]) MOD 256));
  57           IF (mode IN {replace, pep383x}) OR (sch > 7FX) THEN
  58             S.PUT(outadr, sch); INC(outadr); DEC(maxlen);
  59             INC(i)
  60           ELSE
  61             err := 3
  62           END
  63         END
  64       END
  65     END;
  66     sch := 0X;
  67     S.PUT(outadr, sch);
  68     res := err
  69   END StringToHost;
  70
  71   PROCEDURE HostToString* (IN in: ARRAY OF SHORTCHAR; OUT out: ARRAY OF CHAR; mode: INTEGER; OUT res: INTEGER);
  72     VAR err: INTEGER; maxin, maxout, count: iconv.size_t; inadr, outadr: Kernel.ADDRESS; sch: SHORTCHAR; ch: CHAR;
  73   BEGIN
  74     ASSERT(mode IN {replace..pep383}, 20);
  75     ASSERT(sc2c # invalid, 100);
  76     err := 0;
  77     inadr := S.ADR(in[0]);
  78     outadr := S.ADR(out[0]);
  79     maxin := LEN(in$); maxout := LEN(out) * 2 - 2;
  80     WHILE (err = 0) & (maxout > 1) & (maxin > 0) DO
  81       count := iconv.iconv(sc2c, inadr, maxin, outadr, maxout);
  82       IF count # 0 THEN
  83         CASE macro.errno() OF
  84         | errno.EILSEQ, errno.EINVAL, errno.E2BIG:
  85             IF maxout < 2 THEN
  86               err := 1 (* unexpected end of output buffer *)
  87             ELSIF maxin < 1 THEN
  88               err := 2 (* unexpected end of input buffer *)
  89             ELSE
  90               IF mode = replace THEN
  91                 sch := "?"; ch := "?"; INC(inadr); DEC(maxin);
  92               ELSE
  93                 S.GET(inadr, sch); INC(inadr); DEC(maxin);
  94                 ch := CHR(0D800H + ORD(sch));
  95               END;
  96               IF (mode IN {replace, pep383x}) OR (sch > 7FX) THEN
  97                 S.PUT(outadr, ch); INC(outadr, 2); DEC(maxout, 2)
  98               ELSE
  99                 err := 3 (* invalid char *)
 100               END
 101             END
 102         | errno.EBADF: HALT(101)
 103         ELSE HALT(102)
 104         END
 105       END
 106     END;
 107     ch := 0X;
 108     S.PUT(outadr, ch);
 109     res := err
 110   END HostToString;
 111
 112   PROCEDURE Init;
 113     VAR p: POINTER TO ARRAY [untagged] OF SHORTCHAR; i, j: INTEGER; enc: ARRAY 32 OF SHORTCHAR;
 114   BEGIN
 115     invalid := S.VAL(iconv.iconv_t, -1);
 116     p := locale.setlocale(locale.LC_ALL, "");
 117     IF p = NIL THEN
 118       p := stdlib.getenv("LANG");
 119       IF p = NIL THEN
 120         p := ""
 121       END
 122     END;
 123     i := 0; j := 0;
 124     WHILE (p[i] # 0X) & (p[i] # "_") & (p[i] # ".") DO
 125       lang[j] := p[i];
 126       INC(i); INC(j)
 127     END;
 128     lang[j] := 0X;
 129     IF p[i] = "_" THEN
 130       INC(i); j := 0;
 131       WHILE (p[i] # 0X) & (p[i] # ".") DO
 132         country[j] := p[i];
 133         INC(i); INC(j)
 134       END;
 135       country[j] := 0X
 136     END;
 137     enc := "ASCII";
 138     IF p[i] = "." THEN
 139       INC(i); j := 0;
 140       WHILE p[i] # 0X DO
 141         enc[j] := p[i];
 142         INC(i); INC(j)
 143       END;
 144       enc[j] := 0X
 145     END;
 146     IF (lang = "C") OR (lang = "POSIX") THEN
 147       lang := ""
 148     END;
 149     sc2c := invalid; c2sc := invalid;
 150     IF Kernel.littleEndian THEN sc2c := iconv.iconv_open("UCS-2LE", enc)
 151     ELSE sc2c := iconv.iconv_open("UCS-2BE", enc)
 152     END;
 153     IF sc2c = invalid THEN enc := "ASCII";
 154       IF Kernel.littleEndian THEN sc2c := iconv.iconv_open("UCS-2LE", enc)
 155       ELSE sc2c := iconv.iconv_open("UCS-2BE", enc)
 156       END;
 157       ASSERT(c2sc # invalid, 100) (* ascii to ucs2 not supported? *)
 158     END;
 159     IF Kernel.littleEndian THEN c2sc := iconv.iconv_open(enc, "UCS-2LE")
 160     ELSE c2sc := iconv.iconv_open(enc, "UCS-2BE");
 161     END;
 162     ASSERT(c2sc # invalid, 101); (* ucs2 to ascii not supported? *)
 163     encoding := enc$
 164   END Init;
 165
 166   (**
 167     Do not close iconv descriptors!
 168     It can lead to quiet traps on program termination and bugs like
 169     not removed temp files.
 170   **)
 171
 172 BEGIN
 173   Init
 174 END HostLang.