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

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