UNIT PCatGetS;

(* Functions that emulate UNIX catgets *)

(* Copyright (C) 1999,2000 Jim Hall <jhall1@isd.net> 
   Translated to Pascal: Aitor Santamar¡a <aitor.sm@terra.es> *)

(*
  This unit 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.

  This unit 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 unit; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)


INTERFACE

(* Data types *)

TYPE
    nl_catd = integer;

(* Symbolic constants *)

CONST
     MCLoadBySet = 0;                   (* not implemented *)
     MCLoadAll   = 0;                   (* not implemented *)


(* Functions *)

FUNCTION CatGetS (cat: nl_catd; set_number, message_number: integer;
                  message: string): string;
FUNCTION CatOpen (name: string; flag: integer): nl_catd;
PROCEDURE CatClose (cat: nl_catd);


IMPLEMENTATION

USES DOS{,crt},  (* GetEnv *)
     db;   (* all of it *)


FUNCTION CatRead (catfile: string): nl_catd; forward;

(* Globals *)

VAR
   Catalog : nl_catd;


(* Functions *)

(* This is new in Pascal version *)
FUNCTION StrInt (value: integer): string;
VAR
   ResStr: string;
BEGIN
     Str (value, ResStr);
     StrInt := ResStr
END;

(* This is new in Pascal version*)
FUNCTION StrTok (VAR Str1: string; sep: char): string;
VAR
   Ind : byte;
   Tok : string;
BEGIN
    Ind := Pos (sep, str1);
    IF Ind=0 THEN
       BEGIN
           Tok := Str1;
           Ind := length(tok)
       END
    ELSE
       Tok := Copy (Str1,1,Ind-1);
    Delete (Str1, 1, Ind);
    StrTok := Tok
END;


FUNCTION CatGetS (cat: nl_catd; set_number, message_number: integer;
                  message: string): string;
  (* get message from a message catalog *)

  (* 'message' should really be const, but not when it is returned *)

  (* On success, catgets() returns the message string.  On failure,
     catgets() returns the value 'message'.  *)
VAR
   key  : string[10];
   pntr : Pdb_t;
   (* Note for Pascal: Original was ptr, which clashes with Pascal's Ptr *)

BEGIN
  (* Is this the same catalog we have in memory? *)

  IF cat <> catalog THEN
     BEGIN
         CatGetS := message;
         exit
     END;

  (* fetch the message that goes with the set/message number *)

  key  := StrInt (set_number) + '.' + StrInt (message_number);
  pntr := db_fetch (key);

  IF assigned (pntr) THEN
     CatGetS := pntr^.Value
  ELSE
     CatGetS := message
END;


FUNCTION CatOpen (name: string; flag: integer): nl_catd;
  (* catopen() returns a message catalog descriptor of type nl_catd on
     success.  On failure, it returns -1. *)

  (* 'flag' is completely ignored. *)

VAR
  (* I'm not sure 128 is a good value to use here... *)
  (* In Pascal, the 128 was omitted, so limit will be 255 as usual *)
  Catfile, NLSPath, NLSPath_lang : string;
  Lang, tok : string;
  lang_2    : string[3];

BEGIN
  (* Open the catalog file *)

  (* The value of `catalog' will be set based on catread *)

      (* Already one open *)
  IF catalog<>0 THEN
    BEGIN
      CatOpen := -1;
      Exit
    END;

  (* If the message catalog file name contains a directory separator,
     assume that this is a real path to the catalog file.  Note that
     catread will return a true or false value based on its ability
     to read the catfile. *)

  IF Pos('\', name) > 0 THEN
     BEGIN
     
        (* first approximation: 'name' is a filename *)
        catfile := name;
        catalog := catread (catfile);
        CatOpen := catalog;
        Exit
     END;

  (* If the message catalog file name does not contain a directory
     separator, then we need to try to locate the message catalog on
     our own.  We will use several methods to find it. *)

  (* We will need the value of LANG, and may need a 2-letter abbrev of
     LANG later on, so get it now. *)

  lang := getenv ('LANG');
  lang_2 := Copy (lang, 1, 2);

  (* step through NLSPATH *)

  NLSPath := getenv('NLSPATH');

  tok := strtok (nlspath, ';');
  WHILE length(tok)>0 DO
     BEGIN
        (* Try to find the catalog file in each path from NLSPATH *)

        (* Rule #1: %NLSPATH%\%LANG%\cat *)

      NLSPath_lang := tok + '\' + lang;
      catfile := NLSpath_lang + '\' + name;

      catalog := catread (catfile);
      IF catalog<>0 THEN
         BEGIN
             CatOpen := catalog;
             Exit
         END;

        (* Rule #2: %NLSPATH%\cat.%LANG% *)

      catfile := tok + '\' + name + '.' + lang;

      catalog := catread (catfile);
      IF catalog<>0 THEN
         BEGIN
             CatOpen := catalog;
             Exit
         END;

        (* Rule #3: if LANG looks to be in format "en-uk" then
         %NLSPATH%\cat.EN *)

      IF lang[3] = '-' THEN
         BEGIN
             CatFile := tok + '\' + name + '.' + lang_2;
             catalog := catread (catfile);
             IF catalog>0 THEN
                BEGIN
                    CatOpen := catalog;
                    Exit
                END;
         END;
     
      (* Grab next tok for the next while iteration *)

      tok := strtok (nlspath, ';');
     END; (* while tok *)

  (* We could not find it.  Return failure. *)

  CatOpen := 0

END;


FUNCTION CatRead (catfile: string): nl_catd;
VAR
   PFile: {file of} text;
   Key, value, strg: string;
   (* Pascal note: original str replaced by strg, as str clashes with Pascal's str *)

BEGIN
  (* Open the catfile for reading *)

  Assign (PFile, catfile);
  {$I-}              (* Disable I/O checking *)
  Reset  (PFile);    (* Open to read *)

  IF IOResult<>0 THEN
     BEGIN
        (* Cannot open the file.  Return failure *)
        CatRead := 0;
        Exit
     END;
  {$I+}               (* Enable I/O cheking *)


  (* Read the file into memory *)

  WHILE NOT Eof (PFile) DO
      BEGIN
          ReadLn (PFile, strg);

      (* Break into parts.  Entries should be of the form:
         "1.2:This is a message" *)

      (* A line that starts with '#' is considered a comment, and will
         be thrown away without reading it. *)

      (* Assumes no blank lines *)

      IF (strg[1] <> '#') THEN
        BEGIN
           key := strtok (strg, ':');
           value := strg;

           db_insert (key, value);
        END; (* if comment *)

    END; (* while *)

  Close (pfile);

  (* Return success *)

  CatRead := 1;

END;


PROCEDURE CatClose (cat: nl_catd);
BEGIN
  (* close a message catalog *)

  catalog := 0;
END;



BEGIN
     catalog := 0;              (* Catalog descriptor, either 0 or 1 *)
END.

