{

This library extracts column types and convert them to Informix encoded types.
Used by fgldbsch.4gl.

API functions:

   fgldbsch_init() returning integer
      -- initialization function
      -- returns < 0 if problem

   fgldbsch_set_parameter(name string, value string)
      -- set fgldbsch parameters
              dbname   : Data source name
              dbdriver : Database driver name
              username : DB user name (login)
              userpswd : DB user password
              dbowner  : DB table owner
              tabname  : Extract only this table
              cvmeth   : Conversion string (A/B/C sequence)
              casens   : Upper/Lower case conversion (C/U/L)
              systabs  : Extract system tables (Y/N)
              compat   : Old fglschema compat mode
              verbose  : Verbose mode (Y/N)

   fgldbsch_connect() returning integer
      -- connects to the server using parameters for connection info.
      -- returns < 0 if problem

   fgldbsch_disconnect() returning integer
      -- disconnects from the database server
      -- returns < 0 if problem

   fgldbsch_get_db_type() returning string
      -- returns the type of server (IFX, ORA, ADS, DB2, ASA, PGS, MYS)

   fgldbsch_extract() returning integer
      -- extracts schema information
      -- returns < 0 if problem

   fgldbsch_next_table() returning integer
      -- 1 = new table found
      -- 0 = no more tables
      -- returns < 0 if problem

   fgldbsch_get_table_name() returning string
      -- returns name of current table

   fgldbsch_get_column_count() returning integer
      -- returns the number of columns in current table

   fgldbsch_get_column_info(integer)
            returning tabname string, colname string, nattype string,
                      ifxtype integer, ifxleng integer
      -- returns the column info by column position
      -- WARNING: ifxtype can be -1 to indicate an unsupported data type.

}

DEFINE params RECORD
              dbname STRING,
              dbdriver STRING,
              dbowner STRING,
              dbtype CHAR(3),
              username STRING,
              userpswd STRING,
              tabname STRING,
              cvmeth CHAR(40),
              casens CHAR(1),
              systabs CHAR(1),
              compat CHAR(1),
              verbose CHAR(1)
       END RECORD

DEFINE current_tabname STRING

TYPE t_coldef RECORD
              colname STRING,
              nattype STRING,
              ifxtype INTEGER,
              ifxleng INTEGER
       END RECORD
DEFINE coldef DYNAMIC ARRAY OF t_coldef

DEFINE new_tabname STRING
DEFINE new_coldef t_coldef

DEFINE s_msv_identity_prepared SMALLINT

CONSTANT dtiqual_year     = 0
CONSTANT dtiqual_month    = 2
CONSTANT dtiqual_day      = 4
CONSTANT dtiqual_hour     = 6
CONSTANT dtiqual_minute   = 8
CONSTANT dtiqual_second   = 10
CONSTANT dtiqual_frac1    = 11
CONSTANT dtiqual_frac2    = 12
CONSTANT dtiqual_frac3    = 13
CONSTANT dtiqual_frac4    = 14
CONSTANT dtiqual_frac5    = 15

#-------------------------------------------------------------------------------

FUNCTION fgldbsch_display_convtables()
DISPLAY ""
DISPLAY "                   Data type conversion tables"
DISPLAY "                   ---------------------------"
DISPLAY ""
DISPLAY "If you specify X, the columns with the corresponding data type will be"
DISPLAY "ignored and not appear in the schema file."
DISPLAY ""
DISPLAY "Informix to Informix conversion table:"
DISPLAY ""
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    Informix         Informix A     Informix B                        "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "  1 BOOLEAN          BOOLEAN (ns)   CHAR(1)                           "
DISPLAY "  2 INT8             INT8 (ns)      DECIMAL(19,0)                     "
DISPLAY "  3 SERIAL8          SERIAL8 (ns)   DECIMAL(19,0)                     "
DISPLAY "  4 LVARCHAR(m)      LVARCHAR (ns)  VARCHAR2(m)                       "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    (ns) = Not supported in 4gl."
DISPLAY ""
DISPLAY "Oracle conversion table:"
DISPLAY ""
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    Oracle                 Informix A            Informix B           "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "  1 NUMBER(p,s)            DECIMAL(p,s)          DECIMAL(p,s)         "
DISPLAY "  2 CHAR(n)                CHAR(n)               CHAR(n)              "
DISPLAY "  3 VARCHAR(n)             VARCHAR(n,0)          CHAR(n)              "
DISPLAY "  4 VARCHAR2(n)            VARCHAR2(n)           CHAR(n)              "
DISPLAY "  5 DATE                   DATE                  DATETIME Y TO S      "
DISPLAY "  6 NUMBER(5,0)            SMALLINT              DECIMAL(5,0)         "
DISPLAY "  7 NUMBER(10,0)           INTEGER               DECIMAL(10,0)        "
DISPLAY "  8 TIMESTAMP(n>0)         DATETIME Y TO F(n)    DATETIME Y TO F(n)   "
DISPLAY "  9 INTERVAL Y(n) TO M     INTERVAL Y(n) TO M    INTERVAL Y(n) TO M   "
DISPLAY " 10 INTERVAL D(n) TO S(p)  INTERVAL D(n) TO F(p) INTERVAL D(n) TO F(p)"
DISPLAY " 11 FLOAT(p)               DECIMAL(p/3)          FLOAT                "
DISPLAY " 12 TIMESTAMP(0)           DATETIME Y TO S       DATE                 "
DISPLAY " 13 BLOB                   BYTE                  BYTE                 "
DISPLAY " 14 CLOB                   TEXT                  TEXT                 "
DISPLAY " 15 NCHAR(n)               CHAR(n)               NCHAR(n)             "
DISPLAY " 16 NVARCHAR2(n)           VARCHAR2(n)           NVARCHAR2(n)         "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY ""
DISPLAY "IBM DB2 conversion table:"
DISPLAY ""
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    IBM DB2          Informix A                                       "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "  1 DECIMAL(p,s)     DECIMAL(p,s)                                     "
DISPLAY "  2 CHAR(n)          CHAR(n)                                          "
DISPLAY "  3 VARCHAR(n)       VARCHAR(n,0)                                     "
DISPLAY "  4 DATE             DATE                                             "
DISPLAY "  5 TIME             DATETIME H TO S                                  "
DISPLAY "  6 TIMESTAMP        DATETIME Y TO F(5)                               "
DISPLAY "  7 SMALLINT         SMALLINT                                         "
DISPLAY "  8 INTEGER          INTEGER                                          "
DISPLAY "  9 REAL             SMALLFLOAT                                       "
DISPLAY " 10 DOUBLE           FLOAT                                            "
DISPLAY " 11 BLOB             BYTE                                             "
DISPLAY " 12 CLOB             TEXT                                             "
DISPLAY " 13 GRAPHIC(n)       CHAR(n)                                          "
DISPLAY " 14 VARGRAPHIC(n)    VARCHAR2(n)                                      "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY ""
DISPLAY "SQL Server conversion table:"
DISPLAY ""
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    SQL Server       Informix A         Informix B                    "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "  1 DECIMAL(p,s)     DECIMAL(p,s)       DECIMAL(p,s)                  "
DISPLAY "  2 CHAR(n)          CHAR(n)            CHAR(n)                       "
DISPLAY "  3 VARCHAR(n)       VARCHAR(n,0)       CHAR(n)                       "
DISPLAY "  4 SMALLDATETIME    DATE               DATE                          "
DISPLAY "  5 DATETIME         DATETIME Y TO F(3) DATE                          "
DISPLAY "  6 SMALLINT         SMALLINT           SMALLINT                      "
DISPLAY "  7 INTEGER          INTEGER            INTEGER                       "
DISPLAY "  8 REAL             SMALLFLOAT         SMALLFLOAT                    "
DISPLAY "  9 FLOAT            FLOAT              FLOAT                         "
DISPLAY " 10 NCHAR(n)         CHAR(n/2)          NCHAR(n/2)                    "
DISPLAY " 11 NVARCHAR(n)      VARCHAR2(n/2)      NVARCHAR2(n/2)                "
DISPLAY " 12 IMAGE            BYTE               BYTE                          "
DISPLAY " 13 TEXT             TEXT               TEXT                          "
DISPLAY " 14 NTEXT            TEXT               TEXT                          "
DISPLAY " 15 VARCHAR(MAX)     TEXT               TEXT                          "
DISPLAY " 16 NVARCHAR(MAX)    TEXT               TEXT                          "
DISPLAY " 17 VARBINARY(n)     BYTE               BYTE                          "
DISPLAY " 18 VARBINARY(MAX)   BYTE               BYTE                          "
DISPLAY " 19 TINYINT          SMALLINT           SMALLINT                      "
DISPLAY " 20 BIGINT           DECIMAL(19,0)      DECIMAL(19,0)                 "
DISPLAY " 21 UNIQUEIDENTIFIER CHAR(36)           VARCHAR(36)                   "
DISPLAY " 22 BIT              SMALLINT           CHAR(1)                       "
DISPLAY " 23 DATE             DATE               DATE                          "
DISPLAY " 24 DATETIME2(0)     DATETIME Y TO S    DATE                          "
DISPLAY " 25 DATETIME2(n<=5)  DATETIME Y TO F(n) DATE                          "
DISPLAY " 26 DATETIME2(6)     VARCHAR2(26)       VARCHAR2(26)                  "
DISPLAY " 27 DATETIME2(7)     VARCHAR2(27)       VARCHAR2(27)                  "
DISPLAY " 28 TIME(0)          DATETIME H TO S    DATETIME H TO S               "
DISPLAY " 29 TIME(n<=5)       DATETIME H TO F(n) DATETIME H TP F(n)            "
DISPLAY " 30 TIME(6)          VARCHAR(15)        VARCHAR(15)                   "
DISPLAY " 31 TIME(7)          VARCHAR(16)        VARCHAR(16)                   "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY ""
DISPLAY "PostgreSQL conversion table:"
DISPLAY ""
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    PostgreSQL       Informix A                                       "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "  1 DECIMAL(p,s)     DECIMAL(p,s)                                     "
DISPLAY "  2 FLOAT4           SMALLFLOAT                                       "
DISPLAY "  3 FLOAT8           FLOAT                                            "
DISPLAY "  4 CHAR(n)          CHAR(n)                                          "
DISPLAY "  5 VARCHAR(n)       VARCHAR2(n)                                      "
DISPLAY "  6 DATE             DATE                                             "
DISPLAY "  7 TIME             DATETIME H TO S                                  "
DISPLAY "  8 DATETIME         DATETIME Y TO F(5)                               "
DISPLAY "  9 INT2             SMALLINT                                         "
DISPLAY " 10 INT4             INTEGER                                          "
DISPLAY " 11 BOOL             CHAR(1)                                          "
DISPLAY " 12 BIGINT           DECIMAL(19,0)                                    "
DISPLAY " 13 INT8             DECIMAL(19,0)                                    "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY ""
DISPLAY "MySQL conversion table:"
DISPLAY ""
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    MySQL            Informix A         Informix B                    "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "  1 CHAR(n)          CHAR(n)            CHAR(n)                       "
DISPLAY "  2 VARCHAR(n)       VARCHAR2(n)        VARCHAR(n)                    "
DISPLAY "  3 DECIMAL(p,s)     DECIMAL(p,s)       DECIMAL(p,s)                  "
DISPLAY "  4 FLOAT            SMALLFLOAT         SMALLFLOAT                    "
DISPLAY "  5 DOUBLE           FLOAT              FLOAT                         "
DISPLAY "  6 TINYINT          SMALLINT           SMALLINT                      "
DISPLAY "  7 SMALLINT         SMALLINT           SMALLINT                      "
DISPLAY "  8 MEDIUMINT        INTEGER            INTEGER                       "
DISPLAY "  9 INTEGER          INTEGER            INTEGER                       "
DISPLAY " 10 BIGINT           DECIMAL(19,0)      DECIMAL(19,0)                 "
DISPLAY " 11 DATE             DATE               DATE                          "
DISPLAY " 12 TIME             DATETIME H TO S    DATETIME H TO S               "
DISPLAY " 13 DATETIME         DATETIME Y TO S    DATETIME Y TO S               "
DISPLAY " 14 TIMESTAMP        DATETIME Y TO S    DATETIME Y TO S               "
DISPLAY " 15 ENUM(*)          VARCHAR2(255)      VARCHAR2(1024)                "
DISPLAY " 16 TINYTEXT         VARCHAR2(255)      TEXT                          "
DISPLAY " 17 TEXT             VARCHAR2(65535)    TEXT                          "
DISPLAY " 18 MEDIUMTEXT       TEXT               TEXT                          "
DISPLAY " 19 LONGTEXT         TEXT               TEXT                          "
DISPLAY " 20 TINYBLOB         BYTE               BYTE                          "
DISPLAY " 21 BLOB             BYTE               BYTE                          "
DISPLAY " 22 MEDIUMBLOB       BYTE               BYTE                          "
DISPLAY " 23 LONGBLOB         BYTE               BYTE                          "
DISPLAY " 24 BINARY(M)        BYTE               BYTE                          "
DISPLAY " 25 VARBINARY(M)     BYTE               BYTE                          "
DISPLAY " 26 YEAR             DATETIME Y TO Y    SMALLINT                      "
DISPLAY " 27 BIT(M)           SMALLINT           SMALLINT                      "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY ""
DISPLAY "Genero db conversion table:"
DISPLAY ""
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "    Genero db        Informix A                                       "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY "  1 DECIMAL(p,s)     DECIMAL(p,s)                                     "
DISPLAY "  2 NUMERIC(p,s)     DECIMAL(p,s)                                     "
DISPLAY "  3 MONEY(p,s)       MONEY(19,4)                                      "
DISPLAY "  4 CHAR(n)          CHAR(n)                                          "
DISPLAY "  5 VARCHAR(n)       VARCHAR2(n)                                      "
DISPLAY "  6 VARCHAR2(n)      VARCHAR2(n)                                      "
DISPLAY "  7 NCHAR(n)         NCHAR(n)                                         "
DISPLAY "  8 NVARCHAR(n)      NVARCHAR2(n)                                     "
DISPLAY "  9 NVARCHAR2(n)     NVARCHAR2(n)                                     "
DISPLAY " 10 DATE             DATE                                             "
DISPLAY " 11 TIME             DATETIME H TO S                                  "
DISPLAY " 12 TIMESTAMP        DATETIME Y TO F(3)                               "
DISPLAY " 13 DATETIME         DATETIME Y TO F(3)                               "
DISPLAY " 14 BIGINT           DECIMAL(19,0)                                    "
DISPLAY " 15 TINYINT          SMALLINT                                         "
DISPLAY " 16 SMALLINT         SMALLINT                                         "
DISPLAY " 17 INTEGER          INTEGER                                          "
DISPLAY " 18 DOUBLE           SMALLFLOAT                                       "
DISPLAY " 19 REAL             SMALLFLOAT                                       "
DISPLAY " 20 FLOAT            FLOAT                                            "
DISPLAY " 21 BINARY           BYTE                                             "
DISPLAY " 22 VARBINARY        BYTE                                             "
DISPLAY " 23 LONGVARBINARY    BYTE                                             "
DISPLAY " 24 LONGVARCHAR      TEXT                                             "
DISPLAY " 25 DATETIME s TO e  DATETIME s TO e                                  "
DISPLAY " 26 INTERVAL s TO e  INTERVAL s TO e                                  "
DISPLAY "    ------------------------------------------------------------------"
DISPLAY ""
END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION fgldbsch_set_parameter(name, value)
  DEFINE name, value STRING
  CASE name
       WHEN "compat"    LET params.compat = value
       WHEN "dbname"    LET params.dbname = value
       WHEN "dbdriver"  LET params.dbdriver = value
       WHEN "username"  LET params.username = value
       WHEN "userpswd"  LET params.userpswd = value
       WHEN "dbowner"   LET params.dbowner = value
       WHEN "tabname"   LET params.tabname = value
       WHEN "cvmeth"    LET params.cvmeth = value
       WHEN "casens"    LET params.casens = value
       WHEN "systabs"   LET params.systabs = value
       WHEN "verbose"   LET params.verbose = value
  END CASE
END FUNCTION

FUNCTION fgldbsch_get_db_type()
  RETURN params.dbtype
END FUNCTION

FUNCTION _fgldbsch_get_db_type()
  DEFINE dbt CHAR(3)
  INITIALIZE dbt TO NULL
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT user FROM user_users WHERE username=user") THEN
       LET dbt = "ORA"
     END IF
  END IF
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT DISTINCT(@@SERVERNAME) FROM INFORMATION_SCHEMA.TABLES") THEN
       LET dbt = "MSV"
     END IF
  END IF
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT CURRENT USER FROM SYS.SYSCATALOG WHERE TNAME='SYSTABLE'") THEN
       LET dbt = "ASA"
     END IF
  END IF
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT USER FROM sysibm.systables WHERE name='SYSTABLES'") THEN
       LET dbt = "DB2"
     END IF
  END IF
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT USER FROM informix.systables WHERE tabid=1") THEN
       LET dbt = "IFX"
     END IF
  END IF
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT USER FROM pg_type WHERE typname = 'bool'") THEN
       LET dbt = "PGS"
     END IF
  END IF
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT CURDATE()") THEN
       LET dbt = "MYS"
     END IF
  END IF
  IF dbt IS NULL THEN
     IF _fgldbsch_try_select("SELECT USER FROM SYSTEM.TABLE_OF_TABLES WHERE TABLE_NAME = 'TABLE_OF_TABLES'") THEN
       LET dbt = "ADS"
     END IF
  END IF
  RETURN dbt
END FUNCTION

FUNCTION _fgldbsch_try_select(stmt)
  DEFINE stmt STRING
  DEFINE uname CHAR(50)
  WHENEVER ERROR CONTINUE
  DECLARE sTSU CURSOR FROM stmt
  IF sqlca.sqlcode!=0 THEN RETURN FALSE END IF
  OPEN sTSU
  IF sqlca.sqlcode!=0 THEN RETURN FALSE END IF
  FETCH sTSU INTO uname
  IF sqlca.sqlcode!=0 THEN RETURN FALSE END IF
  CLOSE sTSU
  IF sqlca.sqlcode!=0 THEN RETURN FALSE END IF
  FREE sTSU
  IF sqlca.sqlcode!=0 THEN RETURN FALSE END IF
  WHENEVER ERROR STOP
  RETURN TRUE
END FUNCTION

FUNCTION _fgldbsch_uplow(name)
  DEFINE name STRING
  CASE params.casens
       WHEN "U"  RETURN UPSHIFT(name)
       WHEN "L"  RETURN DOWNSHIFT(name)
       OTHERWISE RETURN name
  END CASE
END FUNCTION

FUNCTION fgldbsch_init()
  LET params.systabs  = "N" -- No system tables by default
  LET params.casens = "L" -- lower case by default
  LET params.cvmeth = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
END FUNCTION

FUNCTION fgldbsch_fini()
END FUNCTION

FUNCTION fgldbsch_connect()
  DEFINE dbspec STRING
  DEFINE s INTEGER
  LET s = 0
  WHENEVER ERROR CONTINUE
  LET dbspec = params.dbname
  IF params.dbdriver IS NOT NULL THEN
     LET dbspec = dbspec || "+driver='"||params.dbdriver||"'"
  END IF
  IF params.username IS NOT NULL THEN
     CONNECT TO dbspec AS "fgldbsch" USER params.username USING params.userpswd
  ELSE
     CONNECT TO dbspec AS "fgldbsch"
  END IF
  LET s = STATUS
  WHENEVER ERROR STOP
  IF s == 0 THEN
     LET params.dbtype = _fgldbsch_get_db_type()
     -- Give a chance to DDL transactions...
     WHENEVER ERROR CONTINUE
     SET LOCK MODE TO WAIT 5
     WHENEVER ERROR STOP
  END IF
  RETURN s
END FUNCTION

FUNCTION fgldbsch_disconnect()
  WHENEVER ERROR CONTINUE
  DISCONNECT "fgldbsch"
  WHENEVER ERROR STOP
  RETURN STATUS
END FUNCTION

FUNCTION fgldbsch_extract()
  LET current_tabname = NULL
  CASE params.dbtype
       WHEN "IFX" RETURN _fgldbsch_extract_ifx_start()
       WHEN "ORA" RETURN _fgldbsch_extract_ora_start()
       WHEN "MSV" RETURN _fgldbsch_extract_msv_start()
       WHEN "DB2" RETURN _fgldbsch_extract_db2_start()
       WHEN "PGS" RETURN _fgldbsch_extract_pgs_start()
       WHEN "MYS" RETURN _fgldbsch_extract_mys_start()
       WHEN "ADS" RETURN _fgldbsch_extract_ads_start()
  END CASE
  RETURN -1
END FUNCTION

FUNCTION fgldbsch_next_table()
  CALL coldef.clear()
  IF current_tabname IS NOT NULL THEN
     CALL coldef.appendElement()
     LET coldef[1].* = new_coldef.*
     LET current_tabname = new_tabname
  END IF
  CASE params.dbtype
       WHEN "IFX" RETURN _fgldbsch_extract_ifx_next()
       WHEN "ORA" RETURN _fgldbsch_extract_ora_next()
       WHEN "MSV" RETURN _fgldbsch_extract_msv_next()
       WHEN "DB2" RETURN _fgldbsch_extract_db2_next()
       WHEN "PGS" RETURN _fgldbsch_extract_pgs_next()
       WHEN "MYS" RETURN _fgldbsch_extract_mys_next()
       WHEN "ADS" RETURN _fgldbsch_extract_ads_next()
  END CASE
  RETURN -1
END FUNCTION

FUNCTION fgldbsch_get_table_name()
  RETURN _fgldbsch_uplow(current_tabname)
END FUNCTION

FUNCTION fgldbsch_get_column_count()
  RETURN coldef.getLength()
END FUNCTION

FUNCTION fgldbsch_get_column_info(c)
  DEFINE c INTEGER
  IF c<0 OR c>fgldbsch_get_column_count() THEN
     RETURN NULL, NULL, NULL, -1, -1
  END IF
  RETURN _fgldbsch_uplow(current_tabname),
         _fgldbsch_uplow(coldef[c].colname),
         coldef[c].nattype,
         coldef[c].ifxtype,
         coldef[c].ifxleng
END FUNCTION

FUNCTION _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng)
  DEFINE tabname, colname, nattype STRING
  DEFINE ifxtype, ifxleng INTEGER
  LET new_tabname = tabname CLIPPED
  LET new_coldef.colname = colname CLIPPED
  LET new_coldef.nattype = nattype CLIPPED
  LET new_coldef.ifxtype = ifxtype
  LET new_coldef.ifxleng = ifxleng
  IF current_tabname IS NULL THEN
     LET current_tabname = tabname CLIPPED
  ELSE
     IF tabname != current_tabname THEN
        LET new_tabname = tabname CLIPPED
        RETURN 1
     END IF
  END IF
  CALL coldef.appendElement()
  LET coldef[coldef.getLength()].* = new_coldef.*
  RETURN 0
END FUNCTION

FUNCTION _fgldbsch_owner_warning()
  IF params.verbose = "Y" THEN
     DISPLAY SFMT("WARNING: No owner specified, using %1 as default", params.username CLIPPED)
     DISPLAY ""
  END IF
END FUNCTION

FUNCTION _fgldbsch_dtin_qualcode(qname)
  DEFINE qname STRING
  CASE qname
      WHEN "YEAR"        RETURN 0
      WHEN "MONTH"       RETURN 2
      WHEN "DAY"         RETURN 4
      WHEN "HOUR"        RETURN 6
      WHEN "MINUTE"      RETURN 8
      WHEN "SECOND"      RETURN 10
      WHEN "FRACTION"    RETURN 12 -- As first qualifier
      WHEN "FRACTION(1)" RETURN 11 -- Not used with ADS
      WHEN "FRACTION(2)" RETURN 12 -- Not used with ADS
      WHEN "FRACTION(3)" RETURN 13 -- Not used with ADS
      WHEN "FRACTION(4)" RETURN 14 -- Not used with ADS
      WHEN "FRACTION(5)" RETURN 15 -- Not used with ADS
  END CASE
  RETURN -1
END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION _fgldbsch_ifx_decimal(tn,len)
  DEFINE tn STRING
  DEFINE len, prec, scal SMALLINT
  LET prec = len / 256
  LET scal = len mod 256
  IF scal == 255 THEN
     RETURN SFMT("%1(%2)",tn,prec)
  ELSE
     RETURN SFMT("%1(%2,%3)",tn,prec,scal)
  END IF
END FUNCTION

FUNCTION _fgldbsch_ifx_varchar(tn,len)
  DEFINE tn STRING
  DEFINE len, lmin, lmax SMALLINT
  DEFINE xlen INTEGER
  IF len < 0 THEN
     LET xlen = len + 65536
  ELSE
     LET xlen = len
  END IF
  LET lmin = xlen / 256
  LET lmax = xlen mod 256
  IF lmin == 0 THEN
     RETURN SFMT("%1(%2)",tn,lmax)
  ELSE
     RETURN SFMT("%1(%2,%3)",tn,lmax,lmin)
  END IF
END FUNCTION

FUNCTION _fgldbsch_ifx_dtiq(qual,p)
  DEFINE qual,p SMALLINT
  CASE qual
      WHEN dtiqual_year    RETURN "YEAR"
      WHEN dtiqual_month   RETURN "MONTH"
      WHEN dtiqual_day     RETURN "DAY"
      WHEN dtiqual_hour    RETURN "HOUR"
      WHEN dtiqual_minute  RETURN "MINUTE"
      WHEN dtiqual_second  RETURN "SECOND"
  END CASE
  IF p==1 THEN
     RETURN "FRACTION"
  ELSE
     CASE qual
      WHEN dtiqual_frac1   RETURN "FRACTION(1)"
      WHEN dtiqual_frac2   RETURN "FRACTION(2)"
      WHEN dtiqual_frac3   RETURN "FRACTION(3)"
      WHEN dtiqual_frac4   RETURN "FRACTION(4)"
      WHEN dtiqual_frac5   RETURN "FRACTION(5)"
     END CASE
  END IF
END FUNCTION

FUNCTION _fgldbsch_ifx_datetime(len)
  DEFINE len, q1, q2 SMALLINT
  LET q1 = (len MOD 256) / 16
  LET q2 = (len MOD 256) MOD 16
  RETURN SFMT("DATETIME %1 TO %2", _fgldbsch_ifx_dtiq(q1,1), _fgldbsch_ifx_dtiq(q2,2))
END FUNCTION

FUNCTION _fgldbsch_ifx_interval(len)
  DEFINE len, l, q1, q2 SMALLINT
  LET q1 = (len MOD 256) / 16
  LET q2 = (len MOD 256) MOD 16
  LET l  = ( len / 256 ) - ( q2 - q1 )
  IF q1 < dtiqual_frac1 THEN
     RETURN SFMT("INTERVAL %1(%2) TO %3", _fgldbsch_ifx_dtiq(q1,1), l, _fgldbsch_ifx_dtiq(q2,2))
  ELSE
     RETURN SFMT("INTERVAL %1 TO %2", _fgldbsch_ifx_dtiq(q1,1), _fgldbsch_ifx_dtiq(q2,2))
  END IF
END FUNCTION

FUNCTION _fgldbsch_informix_typename(ifxtype, ifxleng, xtdtype)
  DEFINE ifxtype SMALLINT
  DEFINE ifxleng SMALLINT
  DEFINE xtdtype INTEGER
  DEFINE nattype STRING
  DEFINE modv SMALLINT
  LET nattype = SFMT("encoded=(%1,%2)",ifxtype,ifxleng)
  LET modv = ( ifxtype MOD 256 )
  CASE
     WHEN modv<=16
       CASE modv
            WHEN 0  LET nattype = SFMT("CHAR(%1)",ifxleng)
            WHEN 1  LET nattype = "SMALLINT"
            WHEN 2  LET nattype = "INTEGER"
            WHEN 3  LET nattype = "FLOAT"
            WHEN 4  LET nattype = "SMALLFLOAT"
            WHEN 5  LET nattype = _fgldbsch_ifx_decimal("DECIMAL",ifxleng)
            WHEN 6  LET nattype = "SERIAL"
            WHEN 7  LET nattype = "DATE"
            WHEN 8  LET nattype = _fgldbsch_ifx_decimal("DECIMAL",ifxleng)
            WHEN 9  LET nattype = "NULL"
            WHEN 10 LET nattype = _fgldbsch_ifx_datetime(ifxleng)
            WHEN 11 LET nattype = "BYTE"
            WHEN 12 LET nattype = "TEXT"
            WHEN 13 LET nattype = _fgldbsch_ifx_varchar("VARCHAR",ifxleng)
            WHEN 14 LET nattype = _fgldbsch_ifx_interval(ifxleng)
            WHEN 15 LET nattype = SFMT("NCHAR(%1)",ifxleng)
            WHEN 16 LET nattype = _fgldbsch_ifx_varchar("NVARCHAR",ifxleng)
       END CASE
     WHEN modv=41 AND xtdtype==5    LET nattype = "BOOL"
     WHEN modv=17                   LET nattype = "INT8"
     WHEN modv=18                   LET nattype = "SERIAL8"
     WHEN modv=40 AND xtdtype==1    LET nattype = "LVARCHAR"
  END CASE
  RETURN nattype
END FUNCTION
 
-- Converts special Informix database types that are not supported in 4gl...
FUNCTION _fgldbsch_convert_datatype_ifx( tabname, colname, ifxtype, ifxleng, xtdtype )
  DEFINE tabname, colname CHAR(200)
  DEFINE ifxtype SMALLINT
  DEFINE ifxleng SMALLINT
  DEFINE xtdtype INTEGER
  DEFINE nattype STRING

  DEFINE modv SMALLINT
  DEFINE base SMALLINT

  IF ifxtype>=4096 THEN -- Unsupported Informix datatype
    RETURN NULL, -1, 0
  END IF

  LET nattype = _fgldbsch_informix_typename(ifxtype, ifxleng, xtdtype)

  LET modv = ( ifxtype MOD 256 )
  LET ifxtype = ( ifxtype MOD 2048 ) -- Distinct type

  CASE
     WHEN modv=41 AND xtdtype==5 -- BOOL
        IF params.cvmeth[1,1] = "B" THEN
           LET base = ifxtype / 256
           LET ifxtype = ( base * 256 )
           LET ifxleng = 1
           IF params.compat == "Y" THEN
              DISPLAY SFMT("Warning: BOOLEAN type column \"%1.%2\" converted to CHAR(1).",
                      tabname CLIPPED, colname CLIPPED)
           END IF
        ELSE
           LET ifxtype = -1
        END IF
     WHEN modv=17 -- INT8
        IF params.cvmeth[2,2] = "B" THEN
           LET base = ifxtype / 256
           LET ifxtype = ( base * 256 ) + 5
           LET ifxleng = 4864
           IF params.compat == "Y" THEN
              DISPLAY SFMT("Warning: INT8 type column \"%1.%2\" converted to DECIMAL(19,0).",
                      tabname CLIPPED, colname CLIPPED)
           END IF
        ELSE
           LET ifxtype = -1
        END IF
     WHEN modv=18 -- SERIAL8
        IF params.cvmeth[3,3] = "B" THEN
           LET base = ifxtype / 256
           LET ifxtype = ( base * 256 ) + 5
           LET ifxleng = 4864
           IF params.compat == "Y" THEN
              DISPLAY SFMT("Warning: SERIAL8 type column \"%1.%2\" converted to DECIMAL(19,0).",
                      tabname CLIPPED, colname CLIPPED)
           END IF
        ELSE
           LET ifxtype = -1
        END IF
     WHEN modv=40 AND xtdtype==1 -- LVARCHAR
        IF params.cvmeth[4,4] = "B" THEN
           LET base = ifxtype / 256
           -- Type code 201 is VARCHAR2 with size>255 in .sch!
           LET ifxtype = ( base * 256 ) + 201
           IF params.compat == "Y" THEN
              DISPLAY SFMT("Warning: LVARCHAR type column \"%1.%2\" converted to VARCHAR2(%3).",
                      tabname CLIPPED, colname CLIPPED, ifxleng)
           END IF
        ELSE
           LET ifxtype = -1
        END IF
     OTHERWISE
        IF modv<=16 THEN
          LET ifxtype = ifxtype
        ELSE
          LET ifxtype = -1
        END IF
  END CASE

  RETURN nattype, ifxtype, ifxleng

END FUNCTION

FUNCTION _fgldbsch_get_selection_filter_ifx(p)
  DEFINE p STRING
  DEFINE s STRING
  LET s = " "
  IF params.tabname IS NOT NULL THEN
     LET s = s, " AND ",p,".TABNAME = '",params.tabname,"'"
  END IF
  IF params.systabs=="N" THEN
     LET s = s, " AND ",p,".TABID > 99 "
  END IF
  IF params.dbowner IS NOT NULL THEN
     LET s = s, " AND ",p,".OWNER='",params.dbowner,"'"
  END IF
  RETURN s
END FUNCTION

FUNCTION _fgldbsch_extract_ifx_start()
  DEFINE stmt STRING
  DEFINE tabname CHAR(200) -- Warning: Must use CHAR to support SE engines!
  DEFINE hassyno INTEGER
  DEFINE syncount INTEGER
  DEFINE xtdtcol STRING
  DEFINE rsyn RECORD
           ltabname CHAR(64),
           rservername CHAR(64),
           dbname CHAR(64),
           owner CHAR(64),
           rtabname CHAR(64),
           lservername CHAR(64)
         END RECORD

  WHENEVER ERROR CONTINUE
  DROP TABLE FGLDBSCH_COLS
  WHENEVER ERROR STOP
  CREATE TEMP TABLE FGLDBSCH_COLS (
     TABNAME CHAR(200), -- Warning: Must use CHAR to support SE engines!
     COLNAME CHAR(200),
     COLTYPE SMALLINT,
     COLLENGTH SMALLINT,
     COLNO SMALLINT,
     COLEXT INTEGER
  )

  -- Check if synonym table exists
  SELECT t.tabname INTO tabname
    FROM "informix".systables t
   WHERE t.tabname = "syssyntable"
  LET hassyno = (SQLCA.SQLCODE==0)
  -- No check if there are rows in syssyntable
  IF hassyno THEN
     DECLARE cifx_syssyntable CURSOR
             FOR SELECT t.tabname FROM "informix".syssyntable t
     OPEN cifx_syssyntable
     FETCH cifx_syssyntable
     LET hassyno = (SQLCA.SQLCODE==0)
     FREE cifx_syssyntable
  END IF

  -- Check if extended types table exist (IDS)
  -- The coltypes 40 and 41 and OPAQUE types (variable and fixed).
  -- To detect LVARCHAR, BOOLEAN, CLOB and BLOB columns, we must
  -- look in the extended_id column to get the final type!
  -- Extended types are IDS specific types, defined in sysxtdtypes.
  SELECT t.tabname INTO tabname
    FROM "informix".systables t
   WHERE t.tabname = "sysxtdtypes"
  IF SQLCA.SQLCODE == 0 THEN
     LET xtdtcol = " C.EXTENDED_ID"
  ELSE
     LET xtdtcol = " 0"
  END IF

  LET stmt = "INSERT INTO FGLDBSCH_COLS SELECT",
             " T.TABNAME,",
             " C.COLNAME,",
             " C.COLTYPE,",
             " C.COLLENGTH,",
             " C.COLNO,",
               xtdtcol,
             " FROM ""informix"".SYSCOLUMNS C, ""informix"".SYSTABLES T",
             " WHERE C.TABID = T.TABID",
             _fgldbsch_get_selection_filter_ifx("T")

  EXECUTE IMMEDIATE stmt

  IF hassyno THEN
     -- Local PUBLIC/PRIVATE synonyms:
     -- WARNING: We do not manage owners in the schema files!
     -- If no owner is specified, we extract only PUBLIC synonyms.
     -- If an owner is specified, we extract PUBLIC and PRIVATE synonyms.
     LET stmt =
             "INSERT INTO FGLDBSCH_COLS SELECT",
             "  T.TABNAME,", -- Name of the synonym!
             "  C.COLNAME,",
             "  C.COLTYPE,",
             "  C.COLLENGTH,",
             "  C.COLNO,",
                xtdtcol,
             " FROM ""informix"".SYSCOLUMNS C, ""informix"".SYSSYNTABLE S, ""informix"".SYSTABLES T",
             " WHERE S.BTABID = C.TABID",
             " AND T.TABID = S.TABID",
             " AND S.BTABID IS NOT NULL",
             _fgldbsch_get_selection_filter_ifx("T")
     IF params.dbowner IS NOT NULL THEN
        LET stmt = stmt, " AND T.TABTYPE IN ('P','S')"
     ELSE
        LET stmt = stmt, " AND T.TABTYPE = 'S'"  -- ONLY PUBLIC SYNONYMS!!!
     END IF

     EXECUTE IMMEDIATE stmt

  END IF

  IF hassyno THEN
     -- Remove synonyms only exist OnLine and higher engines, which support
     --  the DBSERVERNAME built-in function. So, only try to deal with
     --  remote synonyms if there are any to deal with.
     SELECT COUNT(*) INTO syncount FROM 'informix'.SYSSYNTABLE WHERE btabid IS NULL
     IF syncount>0 THEN
        LET stmt = 
            "SELECT T.TABNAME LTABNAME, S.SERVERNAME RSERVERNAME,",
            "       S.DBNAME, S.OWNER, S.TABNAME RTABNAME, DBSERVERNAME LSERVERNAME",
            "  FROM 'informix'.SYSTABLES T, 'informix'.SYSSYNTABLE S",
            "  WHERE T.TABID = S.TABID",
            "    AND T.TABTYPE = 'S'",  -- ONLY PUBLIC SYNONYMS!!!
            "    AND S.BTABID IS NULL",
            _fgldbsch_get_selection_filter_ifx("T")
        DECLARE c_remsyn CURSOR FROM stmt
        FOREACH c_remsyn INTO rsyn.*
          IF rsyn.rservername IS NULL OR rsyn.rservername = ' ' THEN
            LET rsyn.rservername = rsyn.lservername
          END IF
          LET stmt = "INSERT INTO FGLDBSCH_COLS SELECT ",
               "'", rsyn.ltabname CLIPPED, "',",
               " C.COLNAME, C.COLTYPE, C.COLLENGTH, C.COLNO,", xtdtcol,
               " FROM ",
                  rsyn.dbname CLIPPED, "@", rsyn.rservername CLIPPED, ":'informix'.SYSTABLES T,",
                  rsyn.dbname CLIPPED, "@", rsyn.rservername CLIPPED, ":'informix'.SYSCOLUMNS C",
               " WHERE C.TABID = T.Tabid AND T.TABNAME = '", rsyn.rtabname CLIPPED,
               "' AND T.OWNER = '", rsyn.owner CLIPPED, "'"
          EXECUTE IMMEDIATE stmt
        END FOREACH
     END IF
  END IF

  WHENEVER ERROR CONTINUE
  DECLARE ctc_ifx CURSOR FOR SELECT * FROM FGLDBSCH_COLS ORDER BY 1, 5
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  OPEN ctc_ifx
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  WHENEVER ERROR STOP

  RETURN 0

END FUNCTION

FUNCTION _fgldbsch_extract_ifx_next()
  DEFINE tabname VARCHAR(200)
  DEFINE colname CHAR(200)
  DEFINE coltype INTEGER
  DEFINE coltplen INTEGER
  DEFINE colident SMALLINT
  DEFINE xtdtype INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  WHILE TRUE
    WHENEVER ERROR CONTINUE
    FETCH ctc_ifx INTO
                  tabname,
                  colname,
                  coltype,
                  coltplen,
                  colident,
                  xtdtype

    WHENEVER ERROR STOP
    IF SQLCA.SQLCODE < 0 THEN RETURN SQLCA.SQLCODE END IF

    IF SQLCA.SQLCODE == NOTFOUND THEN
       CLOSE ctc_ifx
       RETURN ( coldef.getLength() > 0 ) 
    END IF

    CALL _fgldbsch_convert_datatype_ifx(
                  tabname,
                  colname,
                  coltype,
                  coltplen,
                  xtdtype
         ) RETURNING
                  nattype,
                  ifxtype,
                  ifxleng

    IF _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng) THEN
       EXIT WHILE
    END IF

  END WHILE

  RETURN 1

END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION _fgldbsch_convert_datatype_ora( oratype, oraleng, oraprec, orascal, oranull )
  DEFINE oratype VARCHAR(100)
  DEFINE oraleng INTEGER
  DEFINE oraprec INTEGER
  DEFINE orascal INTEGER
  DEFINE oranull CHAR(1)
  DEFINE ot VARCHAR(100)
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER
  DEFINE nattype STRING

  LET ifxtype = -1

  LET ot = UPSHIFT(oratype)
  LET nattype = ot
  CASE
       WHEN ot = "CHAR"
            LET ifxtype = 0
            LET ifxleng = oraleng
            LET nattype = SFMT("%1(%2)",ot,oraleng)
       WHEN ot = "VARCHAR"
            CASE params.cvmeth[3,3]
               WHEN "A"
                 LET ifxtype = 201
                 LET ifxleng = oraleng
               WHEN "B"
                 LET ifxtype = 0
                 LET ifxleng = oraleng
            END CASE
            LET nattype = SFMT("%1(%2)",ot,oraleng)
       WHEN ot = "VARCHAR2"
            CASE params.cvmeth[4,4]
               WHEN "A"
                 LET ifxtype = 201
                 LET ifxleng = oraleng
               WHEN "B"
                 LET ifxtype = 0
                 LET ifxleng = oraleng
            END CASE
            LET nattype = SFMT("%1(%2)",ot,oraleng)
       WHEN ot = "NCHAR"
            CASE params.cvmeth[15,15]
               WHEN "A"
                 LET ifxtype = 0
                 LET ifxleng = oraleng
               WHEN "B"
                 LET ifxtype = 15
                 LET ifxleng = oraleng
            END CASE
            LET nattype = SFMT("%1(%2)",ot,oraleng)
       WHEN ot = "NVARCHAR2"
            CASE params.cvmeth[16,16]
               WHEN "A"
                 LET ifxtype = 201
                 LET ifxleng = oraleng
               WHEN "B"
                 LET ifxtype = 202
                 LET ifxleng = oraleng
            END CASE
            LET nattype = SFMT("%1(%2)",ot,oraleng)
       WHEN ot = "NUMBER"
            CASE
                WHEN oraprec=5 AND orascal=0 AND params.cvmeth[6,6]='A'
                     LET ifxtype = 1             -- SMALLINT
                     LET ifxleng = 2
                WHEN oraprec=10 AND orascal=0 AND params.cvmeth[7,7]='A'
                     LET ifxtype = 2             -- INTEGER
                     LET ifxleng = 4
                OTHERWISE
                     LET ifxtype = 5             -- DECIMAL
                     LET ifxleng = oraprec * 256 + orascal
            END CASE
            CASE
               WHEN oraprec IS NOT NULL AND orascal IS NOT NULL
                    LET nattype = SFMT("%1(%2,%3)",ot,oraprec,orascal)
               WHEN oraprec IS NOT NULL
                    LET nattype = SFMT("%1(%2)",ot,oraprec)
                OTHERWISE
                    LET nattype = ot
            END CASE
       WHEN ot = "DATE"
            CASE params.cvmeth[5,5]
               WHEN "A"
                 LET ifxtype = 7
                 LET ifxleng = 4
               WHEN "B"
                 LET ifxtype = 10
                 LET ifxleng = 3594
            END CASE
            LET nattype = ot
       WHEN ot[1,9] = "TIMESTAMP"
            IF orascal==0 THEN -- TIMESTAMP(0) exists in Oracle!
               CASE params.cvmeth[12,12]
                  WHEN "A"
                    LET ifxtype = 10
                    LET ifxleng = 3594
                  WHEN "B"
                    LET ifxtype = 7
                    LET ifxleng = 4
               END CASE
            ELSE
               LET ifxtype = 10
               CASE orascal
                WHEN 1  LET ifxleng = 3851  -- (15*256)+(0*16)+11
                WHEN 2  LET ifxleng = 4108  -- (16*256)+(0*16)+12
                WHEN 3  LET ifxleng = 4365  -- (17*256)+(0*16)+13
                WHEN 4  LET ifxleng = 4622  -- (18*256)+(0*16)+14
                WHEN 5  LET ifxleng = 4879  -- (19*256)+(0*16)+15
                WHEN 6  LET ifxleng = -1    -- Precision of 6 not supported!
               END CASE
            END IF
            LET nattype = SFMT("%1(%2)",ot,orascal)
       WHEN ot[1,8] = "INTERVAL"
            LET ifxtype = 14
            CASE oraleng
               WHEN 5 -- ORACLE INTERVAL YEAR TO MONTH
                  LET ifxleng = ((oraprec+2)*256)+(0*16)+2
                  LET nattype = "INTERVAL YEAR TO MONTH"
               WHEN 11 -- ORACLE INTERVAL DAY TO SECOND (= ifx FRACTION)
                  IF orascal<6 THEN
                     LET ifxleng = ((oraprec+6+orascal)*256)+(4*16)+(10+orascal)
                  ELSE
                     LET ifxtype = -1
                  END IF
                  LET nattype = "INTERVAL DAY TO FRACTION"
               OTHERWISE
                  LET ifxtype = -1
                  LET nattype = NULL
            END CASE
       WHEN ot = "FLOAT"
            CASE params.cvmeth[11,11]
               WHEN "A"
                 LET ifxtype = 5             -- DECIMAL
                 LET ifxleng = oraprec * 0.30103
                 LET ifxleng = (ifxleng+1)*256 + 255
               WHEN "B"
                 LET ifxtype = 3             -- FLOAT
                 LET ifxleng = 8
            END CASE
       WHEN ot = "BLOB"
            LET ifxtype = 11 -- BYTE
            LET ifxleng = 56
       WHEN ot = "CLOB"
            LET ifxtype = 12 -- TEXT
            LET ifxleng = 56
  END CASE

  IF ifxtype>-1 AND oranull="N" THEN
     LET ifxtype = ifxtype + 256
  END IF

  RETURN nattype, ifxtype, ifxleng

END FUNCTION

FUNCTION _fgldbsch_get_selection_filter_ora(p)
  DEFINE p STRING
  DEFINE s STRING
  LET s = " "
  IF params.tabname IS NOT NULL THEN
     LET s = s, " AND UPPER(",p,".TABLE_NAME) = '",UPSHIFT(params.tabname),"'"
  END IF
  IF params.systabs=="N" THEN
     LET s = s, " AND ",p,".OWNER <> 'SYS' AND ",p,".OWNER <> 'SYSTEM'"
  END IF
  IF params.dbowner IS NULL THEN
     CALL _fgldbsch_owner_warning()
     LET params.dbowner = params.username
  END IF
  IF params.dbowner IS NOT NULL THEN
     LET s = s, " AND UPPER(",p,".OWNER)='",UPSHIFT(params.dbowner),"'"
  END IF
  RETURN s
END FUNCTION

FUNCTION _fgldbsch_extract_ora_start()
  DEFINE stmt STRING

  LET stmt = "SELECT",
             "  C.TABLE_NAME,",
             "  C.COLUMN_NAME,",
             "  C.DATA_TYPE,",
             "  C.DATA_LENGTH,",
             "  C.DATA_PRECISION,",
             "  C.DATA_SCALE,",
             "  C.NULLABLE,",
             "  C.COLUMN_ID",
             " FROM ALL_TAB_COLUMNS C",
             " WHERE C.TABLE_NAME NOT LIKE 'BIN$%'",
               _fgldbsch_get_selection_filter_ora("C"),
             " ORDER BY C.TABLE_NAME, C.COLUMN_ID"

  WHENEVER ERROR CONTINUE
  DECLARE ctc_ora CURSOR FROM stmt
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  OPEN ctc_ora
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  WHENEVER ERROR STOP

  RETURN 0

END FUNCTION

FUNCTION _fgldbsch_extract_ora_next()
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE coltype VARCHAR(100)
  DEFINE coltplen INTEGER
  DEFINE coltpprc INTEGER
  DEFINE coltpscl INTEGER
  DEFINE colnullc CHAR(1)
  DEFINE colident INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  WHILE TRUE
    WHENEVER ERROR CONTINUE
    FETCH ctc_ora INTO
                  tabname,
                  colname,
                  coltype,
                  coltplen,
                  coltpprc,
                  coltpscl,
                  colnullc,
                  colident
    WHENEVER ERROR STOP
    IF SQLCA.SQLCODE < 0 THEN RETURN SQLCA.SQLCODE END IF

    IF SQLCA.SQLCODE == NOTFOUND THEN
       CLOSE ctc_ora
       RETURN ( coldef.getLength() > 0 ) 
    END IF

    CALL _fgldbsch_convert_datatype_ora(
                  coltype,
                  coltplen,
                  coltpprc,
                  coltpscl,
                  colnullc
         ) RETURNING
                  nattype,
                  ifxtype,
                  ifxleng

    IF _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng) THEN
       EXIT WHILE
    END IF

  END WHILE

  RETURN 1

END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION _fgldbsch_convert_datatype_db2( db2type, db2leng, db2scal, db2null )
  DEFINE db2type VARCHAR(100)
  DEFINE db2leng INTEGER
  DEFINE db2scal INTEGER
  DEFINE db2null CHAR(1)
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER
  DEFINE tn STRING

  LET ifxtype = -1

  LET tn = UPSHIFT(db2type)
  LET nattype = tn
  CASE tn
       WHEN "CHARACTER"
            LET ifxtype = 0
            LET ifxleng = db2leng
            LET nattype = SFMT("%1(%2)",tn,db2leng)
       WHEN "VARCHAR"
            LET ifxtype = 201
            LET ifxleng = db2leng
            LET nattype = SFMT("%1(%2)",tn,db2leng)
       WHEN "DECIMAL"
            LET ifxtype = 5
            LET ifxleng = db2leng * 256 + db2scal
            LET nattype = SFMT("%1(%2,%3)",tn,db2leng,db2scal)
       WHEN "REAL"
            LET ifxtype = 4
            LET ifxleng = 4
       WHEN "DOUBLE"
            LET ifxtype = 3
            LET ifxleng = 8
       WHEN "SMALLINT"
            LET ifxtype = 1
            LET ifxleng = 2
       WHEN "INTEGER"
            LET ifxtype = 2
            LET ifxleng = 4
       WHEN "DATE"
            LET ifxtype = 7
            LET ifxleng = 4
       WHEN "TIME"
            LET ifxtype = 10
            LET ifxleng = 1642
       WHEN "TIMESTAMP"
            LET ifxtype = 10
            LET ifxleng = 4879
       WHEN "BLOB"
            LET ifxtype = 11
            LET ifxleng = 56
       WHEN "CLOB"
            LET ifxtype = 12
            LET ifxleng = 56
       WHEN "GRAPHIC"
            LET ifxtype = 0
            LET ifxleng = db2leng
            LET nattype = SFMT("%1(%2)",tn,db2leng)
       WHEN "VARGRAPHIC"
            LET ifxtype = 201
            LET ifxleng = db2leng
            LET nattype = SFMT("%1(%2)",tn,db2leng)
       WHEN "XML"
            LET ifxtype = 201
            LET ifxleng = 16384 -- 0x4000 (see driver)
  END CASE

  IF ifxtype>-1 AND db2null="N" THEN
     LET ifxtype = ifxtype + 256
  END IF

  RETURN nattype, ifxtype, ifxleng

END FUNCTION

FUNCTION _fgldbsch_get_selection_filter_db2(t,c)
  DEFINE t,c STRING
  DEFINE s STRING
  LET s = " "
  IF params.tabname IS NOT NULL THEN
     LET s = s, " AND UPPER(",t,") = '",UPSHIFT(params.tabname),"'"
  END IF
  IF params.systabs=="N" THEN
     LET s = s, " AND UPPER(",c,") <> 'SYSIBM'",
                " AND UPPER(",c,") <> 'SYSCAT'",
                " AND UPPER(",c,") <> 'SYSSTAT'"
  END IF
  IF params.dbowner IS NULL THEN
     CALL _fgldbsch_owner_warning()
     LET params.dbowner = params.username
  END IF
  IF params.dbowner IS NOT NULL THEN
     LET s = s, " AND UPPER(",c,")='",UPSHIFT(params.dbowner),"'"
  END IF
  RETURN s
END FUNCTION

FUNCTION _fgldbsch_extract_db2_start()
  DEFINE stmt STRING

  LET stmt = "SELECT",
             "  TBNAME,",
             "  NAME,",
             "  TYPENAME,",
             "  LENGTH,",
             "  SCALE,",
             "  NULLS,",
             "  COLNO",
             " FROM SYSIBM.SYSCOLUMNS",
             " WHERE 1=1",
             _fgldbsch_get_selection_filter_db2("TBNAME","TBCREATOR"),
             " ORDER BY TBNAME, COLNO"

  WHENEVER ERROR CONTINUE
  DECLARE ctc_db2 CURSOR FROM stmt
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  OPEN ctc_db2
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  WHENEVER ERROR STOP

  RETURN 0

END FUNCTION

FUNCTION _fgldbsch_extract_db2_next()
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE coltype VARCHAR(100)
  DEFINE coltplen INTEGER
  DEFINE coltpscl INTEGER
  DEFINE colnullc CHAR(1)
  DEFINE colident INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  WHILE TRUE
    WHENEVER ERROR CONTINUE
    FETCH ctc_db2 INTO
                  tabname,
                  colname,
                  coltype,
                  coltplen,
                  coltpscl,
                  colnullc,
                  colident
    WHENEVER ERROR STOP
    IF SQLCA.SQLCODE < 0 THEN RETURN SQLCA.SQLCODE END IF

    IF SQLCA.SQLCODE == NOTFOUND THEN
       CLOSE ctc_db2
       RETURN ( coldef.getLength() > 0 ) 
    END IF

    CALL _fgldbsch_convert_datatype_db2(
                  coltype,
                  coltplen,
                  coltpscl,
                  colnullc
         ) RETURNING
                  nattype,
                  ifxtype,
                  ifxleng

    IF _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng) THEN
       EXIT WHILE
    END IF

  END WHILE

  RETURN 1

END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION _fgldbsch_msv_is_identity( tabname, colname )
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE r INTEGER

  WHENEVER ERROR CONTINUE
  IF NOT s_msv_identity_prepared THEN
     PREPARE s_msv_identity FROM
      "SELECT CAST(c.is_identity AS INT)" ||
      "   FROM sys.all_objects o, sys.all_columns c" ||
      "  WHERE o.name = ? AND c.name = ?" ||
      "    AND o.object_id = c.object_id" ||
      "    AND o.type = 'U'"
     LET s_msv_identity_prepared = (SQLCA.SQLCODE == 0)
  END IF
  IF s_msv_identity_prepared THEN
     EXECUTE s_msv_identity USING tabname, colname INTO r
  END IF
  WHENEVER ERROR STOP

  RETURN r

END FUNCTION

# Note1:
# When using UTF-8 in FGL applications, we recommend to use the same size
# for the N[VAR]CHAR SQL SERVER column as for the FGL variable:
#     [VAR]CHAR(500) in FGL <=> N[VAR]CHAR(500) in SQL SERVER
# This is to be Informix compatible and store up to 500 ASCII chars...
# So when extracting a DB schema from SQL SERVER, N[VAR]CHAR size (in bytes)
# must be divided by two.
# Warning: We cannot use the CHARACTER_MAXIMUM_LENGTH column in the SELECT,
# because multi-byte applications (BIG5) can store MB chars in [VAR]CHAR,
# and in this case we must use CHARACTER_OCTET_LENGTH as is.

FUNCTION _fgldbsch_convert_datatype_msv( tabname, colname, msvtype, msvchrl, msvprec, msvscal, msvdtpr, msvnull )
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE msvtype VARCHAR(100)
  DEFINE msvchrl INTEGER
  DEFINE msvprec INTEGER
  DEFINE msvscal INTEGER
  DEFINE msvdtpr INTEGER
  DEFINE msvnull CHAR(4)
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  LET ifxtype = -1

  LET nattype = msvtype
  CASE
       WHEN msvtype = "CHAR"
            LET ifxtype = 0
            LET ifxleng = msvchrl
            LET nattype = SFMT("%1(%2)",msvtype,msvchrl)
       WHEN msvtype = "VARCHAR" AND msvchrl == -1 -- VARCHAR(MAX)
            LET ifxtype = 12 -- TEXT
            LET ifxleng = 56
            LET nattype = "VARCHAR(MAX)"
       WHEN msvtype = "VARCHAR" AND msvchrl > 0 -- VARCHAR(n)
            CASE params.cvmeth[3,3]
                 WHEN "A"
                   LET ifxtype = 201
                   LET ifxleng = msvchrl
                 WHEN "B"
                   LET ifxtype = 0
                   LET ifxleng = msvchrl
            END CASE
            LET nattype = SFMT("%1(%2)",msvtype,msvchrl)
       WHEN msvtype = "NCHAR"
            CASE params.cvmeth[10,10]
                 WHEN "A"
                   LET ifxtype = 0
                   LET ifxleng = msvchrl / 2 -- See Note1
                 WHEN "B"
                   LET ifxtype = 15
                   LET ifxleng = msvchrl / 2 -- See Note1
            END CASE
            LET nattype = SFMT("%1(%2)",msvtype,msvchrl)
       WHEN msvtype = "NVARCHAR" AND msvchrl == -1 -- NVARCHAR(MAX)
            LET ifxtype = 12 -- TEXT
            LET ifxleng = 56
            LET nattype = "NVARCHAR(MAX)"
       WHEN msvtype = "NVARCHAR" AND msvchrl > 0 -- NVARCHAR(n)
            CASE params.cvmeth[11,11]
                 WHEN "A"
                   LET ifxtype = 201
                   LET ifxleng = msvchrl / 2 -- See Note1
                 WHEN "B"
                   LET ifxtype = 202
                   LET ifxleng = msvchrl / 2 -- See Note1
            END CASE
            LET nattype = SFMT("%1(%2)",msvtype,msvchrl)
       WHEN msvtype = "NUMERIC"
            LET ifxtype = 5
            LET ifxleng = msvprec * 256 + msvscal
            LET nattype = SFMT("%1(%2,%3)",msvtype,msvprec,msvscal)
       WHEN msvtype = "DECIMAL"
            LET ifxtype = 5
            LET ifxleng = msvprec * 256 + msvscal
            LET nattype = SFMT("%1(%2,%3)",msvtype,msvprec,msvscal)
       WHEN msvtype = "FLOAT"
            LET ifxtype = 3
            LET ifxleng = 8
       WHEN msvtype = "REAL"
            LET ifxtype = 4
            LET ifxleng = 4
       WHEN msvtype = "TINYINT"
            LET ifxtype = 1
            LET ifxleng = 2
       WHEN msvtype = "SMALLINT"
            LET ifxtype = 1
            LET ifxleng = 2
       WHEN msvtype = "INT"
            IF _fgldbsch_msv_is_identity( tabname, colname ) THEN
               LET ifxtype = 6
            ELSE
               LET ifxtype = 2
            END IF
            LET ifxleng = 4
       WHEN msvtype = "BIGINT"
            LET ifxtype = 5
            LET ifxleng = 19 * 256
       WHEN msvtype = "SMALLDATETIME"
            LET ifxtype = 7
            LET ifxleng = 4
       WHEN msvtype = "DATETIME"
            CASE params.cvmeth[5,5]
               WHEN "A"
                 LET ifxtype = 10
                 LET ifxleng = 4365
               WHEN "B"
                 LET ifxtype = 7
                 LET ifxleng = 4
            END CASE
       WHEN msvtype = "IMAGE"
            LET ifxtype = 11 -- BYTE
            LET ifxleng = 56
       WHEN msvtype = "TEXT"
            LET ifxtype = 12 -- TEXT
            LET ifxleng = 56
       WHEN msvtype = "NTEXT"
            LET ifxtype = 12 -- TEXT
            LET ifxleng = 56
       WHEN msvtype = "VARBINARY" AND msvchrl == -1 -- VARBINARY(MAX)
            LET ifxtype = 11 -- BYTE
            LET ifxleng = 56
            LET nattype = "VARBINARY(MAX)"
       WHEN msvtype = "VARBINARY" AND msvchrl > 0 -- VARBINARY(n)
            LET ifxtype = 11 -- BYTE
            LET ifxleng = 56
            LET nattype = SFMT("%1(%2)",msvtype,msvchrl)
       WHEN msvtype = "UNIQUEIDENTIFIER"
            CASE params.cvmeth[21,21]
               WHEN "A"
                 LET ifxtype = 0
                 LET ifxleng = 36
               WHEN "B"
                 LET ifxtype = 201
                 LET ifxleng = 36
               WHEN "X"
                 -- Column will be ignored!
                 LET ifxtype = -2
            END CASE
       WHEN msvtype = "BIT"
            CASE params.cvmeth[22,22]
               WHEN "A"
                 LET ifxtype = 1
                 LET ifxleng = 2
               WHEN "B"
                 LET ifxtype = 0
                 LET ifxleng = 1
            END CASE
       WHEN msvtype = "DATE"
            LET ifxtype = 7
            LET ifxleng = 4
       WHEN msvtype = "DATETIME2" AND msvdtpr == 0
            CASE params.cvmeth[24,24]
               WHEN "A"
                 LET ifxtype = 10
                 LET ifxleng = 3594  -- DATETIME YEAR TO SECOND
               WHEN "B"
                 LET ifxtype = 7
                 LET ifxleng = 4
            END CASE
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
       WHEN msvtype = "DATETIME2" AND msvdtpr <= 5
            CASE params.cvmeth[25,25]
               WHEN "A"
                 LET ifxtype = 10
                 CASE msvdtpr
                   WHEN 1 LET ifxleng = 3851  -- DATETIME YEAR TO FRACTION(1)
                   WHEN 2 LET ifxleng = 4108  -- DATETIME YEAR TO FRACTION(2)
                   WHEN 3 LET ifxleng = 4365  -- DATETIME YEAR TO FRACTION(3)
                   WHEN 4 LET ifxleng = 4622  -- DATETIME YEAR TO FRACTION(4)
                   WHEN 5 LET ifxleng = 4879  -- DATETIME YEAR TO FRACTION(5)
                 END CASE
               WHEN "B"
                 LET ifxtype = 7
                 LET ifxleng = 4
            END CASE
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
       WHEN msvtype = "DATETIME2" AND msvdtpr == 6
            LET ifxtype = 201
            LET ifxleng = 26
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
       WHEN msvtype = "DATETIME2" AND msvdtpr == 7
            LET ifxtype = 201
            LET ifxleng = 27
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
       WHEN msvtype = "TIME" AND msvdtpr == 0
            LET ifxtype = 10
            LET ifxleng = 1642  -- DATETIME HOUR TO SECOND
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
       WHEN msvtype = "TIME" AND msvdtpr <= 5
            LET ifxtype = 10
            CASE msvdtpr
              WHEN 1 LET ifxleng = 1899  -- DATETIME HOUR TO FRACTION(1)
              WHEN 2 LET ifxleng = 2156  -- DATETIME HOUR TO FRACTION(2)
              WHEN 3 LET ifxleng = 2413  -- DATETIME HOUR TO FRACTION(3)
              WHEN 4 LET ifxleng = 2670  -- DATETIME HOUR TO FRACTION(4)
              WHEN 5 LET ifxleng = 2927  -- DATETIME HOUR TO FRACTION(5)
            END CASE
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
       WHEN msvtype = "TIME" AND msvdtpr == 6
            LET ifxtype = 201
            LET ifxleng = 15
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
       WHEN msvtype = "TIME" AND msvdtpr == 7
            LET ifxtype = 201
            LET ifxleng = 16
            LET nattype = SFMT("%1(%2)",msvtype,msvdtpr)
  END CASE

  IF ifxtype>-1 AND UPSHIFT(msvnull)=="NO" THEN
     LET ifxtype = ifxtype + 256
  END IF

  RETURN nattype, ifxtype, ifxleng

END FUNCTION

FUNCTION _fgldbsch_get_selection_filter_msv()
  DEFINE s STRING
  LET s = " AND T.TABLE_NAME != 'dtproperties'"
  IF params.tabname IS NOT NULL THEN
     LET s = s, " AND UPPER(T.TABLE_NAME) = '",UPSHIFT(params.tabname),"'"
  END IF
  IF params.dbowner IS NOT NULL THEN
     LET s = s, " AND UPPER(T.TABLE_SCHEMA)='",UPSHIFT(params.dbowner),"'"
  END IF
  RETURN s
END FUNCTION

FUNCTION _fgldbsch_extract_msv_start()
  DEFINE stmt STRING

  LET stmt = "SELECT",
             "  C.TABLE_NAME,",
             "  C.COLUMN_NAME,",
             "  UPPER(C.DATA_TYPE),",
             "  C.CHARACTER_OCTET_LENGTH,",
             "  C.NUMERIC_PRECISION,",
             "  C.NUMERIC_SCALE,",
             "  C.DATETIME_PRECISION,",
             "  C.IS_NULLABLE,",
             "  C.ORDINAL_POSITION",
             " FROM INFORMATION_SCHEMA.COLUMNS C, INFORMATION_SCHEMA.TABLES T",
             " WHERE T.TABLE_SCHEMA = C.TABLE_SCHEMA",
             "   AND T.TABLE_NAME = C.TABLE_NAME",
             "   AND T.TABLE_TYPE IN ( 'BASE TABLE', 'VIEW' )",
             _fgldbsch_get_selection_filter_msv(),
             " ORDER BY C.TABLE_NAME, C.ORDINAL_POSITION"

  WHENEVER ERROR CONTINUE
  DECLARE ctc_msv CURSOR FROM stmt
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  OPEN ctc_msv
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  WHENEVER ERROR STOP

  RETURN 0

END FUNCTION

FUNCTION _fgldbsch_extract_msv_next()
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE coltype VARCHAR(100)
  DEFINE colcharl INTEGER
  DEFINE coltpprc INTEGER
  DEFINE coltpscl INTEGER
  DEFINE coldtprc INTEGER
  DEFINE colnullc VARCHAR(10)
  DEFINE colident INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  WHILE TRUE
    WHENEVER ERROR CONTINUE
    FETCH ctc_msv INTO
                  tabname,
                  colname,
                  coltype,
                  colcharl,
                  coltpprc,
                  coltpscl,
                  coldtprc,
                  colnullc,
                  colident

    WHENEVER ERROR STOP
    IF SQLCA.SQLCODE < 0 THEN RETURN SQLCA.SQLCODE END IF

    IF SQLCA.SQLCODE == NOTFOUND THEN
       CLOSE ctc_msv
       RETURN ( coldef.getLength() > 0 ) 
    END IF

    CALL _fgldbsch_convert_datatype_msv(
                  tabname,
                  colname,
                  coltype,
                  colcharl,
                  coltpprc,
                  coltpscl,
                  coldtprc,
                  colnullc
         ) RETURNING
                  nattype,
                  ifxtype,
                  ifxleng

    IF ifxtype == -2 THEN
       DISPLAY SFMT("Warning: %1 column \"%2.%3\" is ignored.",
                      nattype CLIPPED, tabname CLIPPED, colname CLIPPED)
       CONTINUE WHILE
    END IF

    IF _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng) THEN
       EXIT WHILE
    END IF

  END WHILE

  RETURN 1

END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION _fgldbsch_convert_datatype_pgs( pgstype, pgsleng, pgstmod, pgsnull )
  DEFINE pgstype VARCHAR(100)
  DEFINE pgsleng INTEGER
  DEFINE pgstmod INTEGER
  DEFINE pgsnull CHAR(1)
  DEFINE tmbase INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER
  DEFINE tn STRING

  LET ifxtype = -1
  LET tmbase = pgstmod-4  -- This is atttypmod - sizeof(int4)

  LET tn = UPSHIFT(pgstype)
  LET nattype = tn
  CASE tn
       WHEN "BOOL"
            LET ifxtype = 0
            LET ifxleng = 1
       WHEN "BPCHAR"
            LET ifxtype = 0
            LET ifxleng = tmbase
            LET nattype = SFMT("%1(%2)",tn,tmbase)
       WHEN "VARCHAR"
            LET ifxtype = 201
            LET ifxleng = tmbase
            LET nattype = SFMT("%1(%2)",tn,tmbase)
       WHEN "NUMERIC"
            LET ifxtype = 5
            LET ifxleng = ( tmbase / 65536 ) * 256 + ( tmbase mod 65536 )
            LET nattype = SFMT("%1(%2,%3)",tn, tmbase / 65536, tmbase mod 65536)
       WHEN "FLOAT4"
            LET ifxtype = 4
            LET ifxleng = 4
       WHEN "FLOAT8"
            LET ifxtype = 3
            LET ifxleng = 8
       WHEN "INT2"
            LET ifxtype = 1
            LET ifxleng = 2
       WHEN "INT4"
            LET ifxtype = 2
            LET ifxleng = 4
       WHEN "DATE"
            LET ifxtype = 7
            LET ifxleng = 4
       WHEN "TIME"
            LET ifxtype = 10
            LET ifxleng = 1642
       WHEN "TIMESTAMP"
            LET ifxtype = 10
            LET ifxleng = 4879
       WHEN "BIGINT"
            LET ifxtype = 5
            LET ifxleng = 19 * 256
       WHEN "INT8"
            LET ifxtype = 5
            LET ifxleng = 19 * 256
  END CASE

  IF ifxtype>-1 AND pgsnull="t" THEN
     LET ifxtype = ifxtype + 256
  END IF

  RETURN nattype, ifxtype, ifxleng

END FUNCTION


FUNCTION _fgldbsch_get_selection_filter_pgs(p)
  DEFINE p STRING
  DEFINE s STRING
  LET s = " "
  IF params.tabname IS NOT NULL THEN
     LET s = s, " AND UPPER(",p,".RELNAME) = '",UPSHIFT(params.tabname),"'"
  END IF
  IF params.systabs=="N" THEN
     LET s = s, " AND ",p,".RELNAMESPACE IN ",
                " (SELECT OID FROM PG_NAMESPACE ",
                "   WHERE NSPNAME NOT LIKE 'pg%' ",
                "     AND NSPNAME <> 'information_schema')"
  END IF
  IF params.dbowner IS NOT NULL THEN
     LET s = s, " AND UPPER(PG_GET_USERBYID(",p,".RELOWNER))='",UPSHIFT(params.dbowner),"'"
  END IF
  RETURN s
END FUNCTION

FUNCTION _fgldbsch_extract_pgs_start()
  DEFINE stmt STRING

  LET stmt = "SELECT",
             "  C.OID,",
             "  C.RELNAME,",
             "  A.ATTNAME,",
             "  T.TYPNAME,",
             "  A.ATTLEN,",
             "  A.ATTTYPMOD,",
             "  A.ATTNOTNULL,",
             "  A.ATTNUM",
             " FROM PG_CLASS C, PG_ATTRIBUTE A, PG_TYPE T",
             " WHERE A.ATTRELID = C.OID",
             "  AND A.ATTTYPID = T.OID",
             "  AND ((C.RELKIND='r') OR (C.RELKIND='s') OR (C.RELKIND='v'))",
             "  AND (A.ATTNUM>0)",
             _fgldbsch_get_selection_filter_pgs("C"),
             " ORDER BY C.RELNAME, A.ATTNUM"

  WHENEVER ERROR CONTINUE
  DECLARE ctc_pgs CURSOR FROM stmt
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  OPEN ctc_pgs
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  WHENEVER ERROR STOP

  RETURN 0

END FUNCTION

FUNCTION _fgldbsch_extract_pgs_next()
  DEFINE tabid INTEGER
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE coltype VARCHAR(100)
  DEFINE coltplen INTEGER
  DEFINE coltpmod INTEGER
  DEFINE colnullc CHAR(1)
  DEFINE colident INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  WHILE TRUE
    WHENEVER ERROR CONTINUE
    FETCH ctc_pgs INTO
                  tabid,
                  tabname,
                  colname,
                  coltype,
                  coltplen,
                  coltpmod,
                  colnullc,
                  colident

    WHENEVER ERROR STOP
    IF SQLCA.SQLCODE < 0 THEN RETURN SQLCA.SQLCODE END IF

    IF SQLCA.SQLCODE == NOTFOUND THEN
       CLOSE ctc_pgs
       RETURN ( coldef.getLength() > 0 ) 
    END IF

    CALL _fgldbsch_convert_datatype_pgs(
                  coltype,
                  coltplen,
                  coltpmod,
                  colnullc
         ) RETURNING
                  nattype,
                  ifxtype,
                  ifxleng

    IF _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng) THEN
       EXIT WHILE
    END IF

  END WHILE

  RETURN 1

END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION _fgldbsch_convert_datatype_mys( coltype, colcharl, coltpprc, coltpscl, colnullc, colextra, coltname )
  DEFINE coltype  VARCHAR(100)
  DEFINE colcharl INTEGER
  DEFINE coltpprc INTEGER
  DEFINE coltpscl INTEGER
  DEFINE colnullc VARCHAR(10)
  DEFINE colextra VARCHAR(20)
  DEFINE coltname VARCHAR(100)
  DEFINE qual1    INTEGER
  DEFINE qual2    INTEGER
  DEFINE ifxtype  INTEGER
  DEFINE ifxleng  INTEGER

  LET ifxtype = -1

  CASE
       WHEN coltype == "CHAR"
            LET ifxtype = 0
            LET ifxleng = colcharl
       WHEN coltype == "VARCHAR"
            LET ifxtype = 201
            LET ifxleng = colcharl
       WHEN coltype == "DECIMAL"
            LET ifxtype = 5
            LET ifxleng = coltpprc * 256 + coltpscl
       WHEN coltype == "FLOAT"
            LET ifxtype = 4
            LET ifxleng = 4
       WHEN coltype == "DOUBLE"
            LET ifxtype = 3
            LET ifxleng = 8
       WHEN coltype == "TINYINT"
            LET ifxtype = 1
            LET ifxleng = 2
       WHEN coltype == "SMALLINT" 
            LET ifxtype = 1
            LET ifxleng = 2
       WHEN coltype == "MEDIUMINT"
         OR coltype == "INT"
            IF colextra == "auto_increment" THEN
               LET ifxtype = 6
            ELSE
               LET ifxtype = 2
            END IF
            LET ifxleng = 4
       WHEN coltype == "BIGINT"
            LET ifxtype = 5
            LET ifxleng = 19 * 256
       WHEN coltype == "DATE"
            LET ifxtype = 7
            LET ifxleng = 4
       WHEN coltype == "TIME"
            LET ifxtype = 10
            LET ifxleng = 1642
       WHEN coltype == "DATETIME"
            LET ifxtype = 10
            LET ifxleng = 3594
       WHEN coltype == "TIMESTAMP"
            LET ifxtype = 10
            LET ifxleng = 3594
       WHEN coltype == "ENUM"
            CASE params.cvmeth[15,15]
                WHEN "A"
                     LET ifxtype = 201
                     LET ifxleng = 255
                WHEN "B"
                     LET ifxtype = 201
                     LET ifxleng = 1024
            END CASE
       WHEN coltype == "TINYTEXT" -- 256c (2^8)
            CASE params.cvmeth[16,16]
                WHEN "A"
                     LET ifxtype = 201
                     LET ifxleng = 255
                WHEN "B"
                     LET ifxtype = 12
                     LET ifxleng = 56
            END CASE
       WHEN coltype == "TEXT" -- 65536c (2^16)
            CASE params.cvmeth[17,17]
                WHEN "A"
                     LET ifxtype = 201
                     LET ifxleng = 65535
                WHEN "B"
                     LET ifxtype = 12
                     LET ifxleng = 56
            END CASE
       WHEN coltype == "MEDIUMTEXT" -- 16777216c (2^24)
            LET ifxtype = 12
            LET ifxleng = 56
       WHEN coltype == "LONGTEXT" -- 4294967296c (2^32)
            LET ifxtype = 12
            LET ifxleng = 56
       WHEN coltype == "TINYBLOB"
         OR coltype == "BLOB"
         OR coltype == "MEDIUMBLOB"
         OR coltype == "LONGBLOB"
         OR coltype == "BINARY"
         OR coltype == "VARBINARY"
            LET ifxtype = 11
            LET ifxleng = 56
       WHEN coltype == "YEAR"
            CASE params.cvmeth[26,26]
                WHEN "A"
                     LET ifxtype = 10 -- DATETIME
                     LET ifxleng = 1024 -- YEAR TO YEAR
                WHEN "B"
                     LET ifxtype = 1
                     LET ifxleng = 2
            END CASE
       WHEN coltype == "BIT"
            LET ifxtype = 1
            LET ifxleng = 2
  END CASE

  IF ifxtype>-1 AND colnullc = "NO" THEN
     LET ifxtype = ifxtype + 256
  END IF

  RETURN coltname, ifxtype, ifxleng

END FUNCTION

FUNCTION _fgldbsch_get_selection_filter_mys()
  DEFINE s STRING
  IF params.tabname IS NOT NULL THEN
     LET s = s, " AND UPPER(T.TABLE_NAME) = '",UPSHIFT(params.tabname),"'"
  END IF
  # Warning:
  # In MySQL (6.0.4), TABLE_CATALOG is NULL: TABLE_SCHEMA is the DB name!!!
  # => We must use TABLE_SCHEMA = DBNAME, and no way to filter by dbowner.
  IF params.systabs=="N" THEN
     LET s = s, " AND T.TABLE_SCHEMA=DATABASE()"
  ELSE
     LET s = s, " AND (T.TABLE_SCHEMA=DATABASE() OR T.TABLE_SCHEMA='mysql')"
  END IF
  RETURN s
END FUNCTION

FUNCTION _fgldbsch_extract_mys_start()
  DEFINE stmt STRING

  LET stmt = "SELECT",
             "  C.TABLE_NAME,",
             "  C.COLUMN_NAME,",
             "  UPPER(C.DATA_TYPE),",
             "  C.CHARACTER_OCTET_LENGTH,",
             "  C.NUMERIC_PRECISION,",
             "  C.NUMERIC_SCALE,",
             "  C.IS_NULLABLE,",
             "  C.EXTRA,",
             -- COLUMN_TYPE is complete type name, must use substring() to not get CLOB!
             "  SUBSTRING(C.COLUMN_TYPE,1,100),",
             "  C.ORDINAL_POSITION",
             " FROM INFORMATION_SCHEMA.COLUMNS C, INFORMATION_SCHEMA.TABLES T",
             " WHERE T.TABLE_SCHEMA = C.TABLE_SCHEMA",
             "   AND T.TABLE_NAME = C.TABLE_NAME",
             "   AND T.TABLE_TYPE IN ( 'BASE TABLE', 'VIEW' )",
             _fgldbsch_get_selection_filter_mys(),
             " ORDER BY C.TABLE_NAME, C.ORDINAL_POSITION"

  WHENEVER ERROR CONTINUE
  DECLARE ctc_mys CURSOR FROM stmt
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  OPEN ctc_mys
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  WHENEVER ERROR STOP

  RETURN 0

END FUNCTION

FUNCTION _fgldbsch_extract_mys_next()
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE coltype VARCHAR(100)
  DEFINE colcharl INTEGER
  DEFINE coltpprc INTEGER
  DEFINE coltpscl INTEGER
  DEFINE colnullc VARCHAR(10)
  DEFINE colextra VARCHAR(20)
  DEFINE coltname VARCHAR(100)
  DEFINE colident INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  WHILE TRUE
    WHENEVER ERROR CONTINUE
    FETCH ctc_mys INTO
                  tabname,
                  colname,
                  coltype,
                  colcharl,
                  coltpprc,
                  coltpscl,
                  colnullc,
                  colextra,
                  coltname,
                  colident

    WHENEVER ERROR STOP
    IF SQLCA.SQLCODE < 0 THEN RETURN SQLCA.SQLCODE END IF

    IF SQLCA.SQLCODE == NOTFOUND THEN
       CLOSE ctc_mys
       RETURN ( coldef.getLength() > 0 ) 
    END IF

    CALL _fgldbsch_convert_datatype_mys(
                  coltype,
                  colcharl,
                  coltpprc,
                  coltpscl,
                  colnullc,
                  colextra,
                  coltname
         ) RETURNING
                  nattype,
                  ifxtype,
                  ifxleng

    IF ifxtype == -2 THEN
       DISPLAY SFMT("Warning: %1 column \"%2.%3\" is ignored.",
                      nattype CLIPPED, tabname CLIPPED, colname CLIPPED)
       CONTINUE WHILE
    END IF

    IF _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng) THEN
       EXIT WHILE
    END IF

  END WHILE

  RETURN 1

END FUNCTION

#-------------------------------------------------------------------------------

FUNCTION _fgldbsch_ads_encode_datetime(adstype, adsdtpr, adsscal)
  DEFINE adstype STRING, adsdtpr, adsscal INTEGER
  DEFINE tmp STRING
  DEFINE tok base.StringTokenizer
  DEFINE q1, q2 STRING
  DEFINE vq1, vq2, len, x SMALLINT
  DEFINE code INTEGER

  LET tmp = adstype.subString(10, adstype.getLength()) -- "DATETIME "
  LET tok = base.StringTokenizer.create(tmp," ")
  LET q1 = tok.nextToken() -- qualifier 1
  IF q1 IS NULL THEN RETURN -1, 0 END IF
  LET tmp = tok.nextToken() -- TO
  IF tmp IS NULL THEN RETURN -1, 0 END IF
  LET q2 = tok.nextToken() -- qualifier 2
  IF q2 IS NULL THEN RETURN -1, 0 END IF

  LET vq1 = _fgldbsch_dtin_qualcode(q1)
  LET x = vq1
  IF q2 == "FRACTION" THEN
     LET vq2 = 10 + adsscal
     IF q1 = "FRACTION" THEN
        LET x = 12
     END IF
  ELSE
     LET vq2 = _fgldbsch_dtin_qualcode(q2)
  END IF
  IF q1 == "YEAR" THEN LET len=4 ELSE LET len=2 END IF
  LET code = ((vq2 - x + len) * 256 ) + (vq1 * 16) + vq2

  RETURN 10, code
END FUNCTION

FUNCTION _fgldbsch_ads_encode_interval(adstype, adsivpr, adsscal)
  DEFINE adstype STRING, adsivpr, adsscal INTEGER
  DEFINE tmp STRING
  DEFINE tok base.StringTokenizer
  DEFINE q1, q2 STRING
  DEFINE vq1, vq2, len, x SMALLINT
  DEFINE code INTEGER

  LET tmp = adstype.subString(10, adstype.getLength()) -- "INTERVAL "
  LET tok = base.StringTokenizer.create(tmp," ")
  LET q1 = tok.nextToken() -- qualifier 1
  IF q1 IS NULL THEN RETURN -1, 0 END IF
  LET tmp = tok.nextToken() -- TO
  IF tmp IS NULL THEN RETURN -1, 0 END IF
  LET q2 = tok.nextToken() -- qualifier 2
  IF q2 IS NULL THEN RETURN -1, 0 END IF

  LET vq1 = _fgldbsch_dtin_qualcode(q1)
  LET x = vq1
  IF q2 == "FRACTION" THEN
     LET vq2 = 10 + adsscal
     IF q1 = "FRACTION" THEN
        LET x = 10 + adsivpr
     END IF
  ELSE
     LET vq2 = _fgldbsch_dtin_qualcode(q2)
  END IF
  LET len = (vq2 - x + adsivpr)
  LET code = (len * 256 ) + (vq1 * 16) + vq2

  RETURN 14, code
END FUNCTION

FUNCTION _fgldbsch_convert_datatype_ads( adstype, adssize, adsprec, adsscal, adsdtpr, adsivpr, adsnull )
  DEFINE adstype VARCHAR(100)
  DEFINE adssize INTEGER
  DEFINE adsprec INTEGER
  DEFINE adsscal INTEGER
  DEFINE adsdtpr INTEGER
  DEFINE adsivpr INTEGER
  DEFINE adsnull CHAR(3)
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  LET ifxtype = -1

  -- ADS 3.61
  CASE adsnull
       WHEN '1' LET adsnull = 'YES'
       WHEN '0' LET adsnull = 'NO'
  END CASE

  LET nattype = adstype
  CASE
       WHEN adstype == "MONEY"
         OR adstype == "NUMERIC"
         OR adstype == "DECIMAL"
            LET ifxtype = 5
            IF adstype == "MONEY" THEN
               LET ifxtype = 8
            END IF
            LET ifxleng = adsprec * 256 + adsscal
            CASE
                WHEN adsprec IS NOT NULL AND adsscal IS NOT NULL
                     LET nattype = SFMT("%1(%2,%3)", adstype, adsprec, adsscal)
                WHEN adsprec IS NOT NULL AND adsscal IS NOT NULL
                     LET nattype = SFMT("%1(%2)", adstype, adsprec)
                OTHERWISE
                     LET nattype = adstype
            END CASE
       WHEN adstype == "CHAR"
            LET ifxtype = 0
            LET ifxleng = adssize
            LET nattype = SFMT("%1(%2)", adstype, adssize)
       WHEN adstype == "VARCHAR"
         OR adstype == "VARCHAR2"
            LET ifxtype = 201
            LET ifxleng = adssize
            LET nattype = SFMT("%1(%2)", adstype, adssize)
       WHEN adstype == "NCHAR"
            LET ifxtype = 15
            LET ifxleng = adssize
            LET nattype = SFMT("%1(%2)", adstype, adssize)
       WHEN adstype == "NVARCHAR"
         OR adstype == "NVARCHAR2"
            LET ifxtype = 202
            LET ifxleng = adssize
            LET nattype = SFMT("%1(%2)", adstype, adssize)
       WHEN adstype == "DATE"
            LET ifxtype = 7
            LET ifxleng = 4
       WHEN adstype == "TIME"
            LET ifxtype = 10
            LET ifxleng = 1642
       WHEN adstype == "TIMESTAMP"
         OR adstype == "DATETIME"
            LET ifxtype = 10
            LET ifxleng = 4365
       WHEN adstype == "BIGINT"
            LET ifxtype = 5
            LET ifxleng = 19 * 256
       WHEN adstype == "TINYINT"
         OR adstype == "SMALLINT"
            LET ifxtype = 1
            LET ifxleng = 2
       WHEN adstype == "INTEGER"
            LET ifxtype = 2
            LET ifxleng = 4
       WHEN adstype == "SERIAL"
            LET ifxtype = 6
            LET ifxleng = 4
       WHEN adstype == "DOUBLE"
         OR adstype == "REAL"
         OR adstype == "SMALLFLOAT"
            LET ifxtype = 4
            LET ifxleng = 4
       WHEN adstype == "FLOAT"
         OR adstype == "DOUBLE PRECISION"
            LET ifxtype = 3
            LET ifxleng = 8
       WHEN adstype = "BINARY"
         OR adstype = "VARBINARY"
         OR adstype = "LONGVARBINARY"
         OR adstype = "BYTE"
            LET ifxtype = 11
            LET ifxleng = 56
       WHEN adstype = "LONGVARCHAR"
         OR adstype = "TEXT"
            LET ifxtype = 12
            LET ifxleng = 56
       WHEN adstype MATCHES "DATETIME *"
            CALL _fgldbsch_ads_encode_datetime(adstype, adsdtpr, adsscal)
                 RETURNING ifxtype, ifxleng
       WHEN adstype MATCHES "INTERVAL *"
            CALL _fgldbsch_ads_encode_interval(adstype, adsivpr, adsscal)
                 RETURNING ifxtype, ifxleng
  END CASE

  IF ifxtype>-1 AND adsnull=="NO" THEN
     LET ifxtype = ifxtype + 256
  END IF

  RETURN nattype, ifxtype, ifxleng

END FUNCTION

FUNCTION _fgldbsch_get_selection_filter_ads(t,c)
  DEFINE t,c STRING
  DEFINE s STRING
  LET s = " "
  IF params.tabname IS NOT NULL THEN
     LET s = s, " AND UPPER(",t,") = '",UPSHIFT(params.tabname),"'"
  END IF
  IF params.systabs=="N" THEN
     LET s = s, " AND ", c, " != 'SYSTEM'"
  END IF
  IF params.dbowner IS NULL THEN
     CALL _fgldbsch_owner_warning()
     LET params.dbowner = params.username
  END IF
  IF params.dbowner IS NOT NULL THEN
     LET s = s, " AND UPPER(",c,")='",UPSHIFT(params.dbowner),"'"
  END IF
  RETURN s
END FUNCTION

FUNCTION _fgldbsch_extract_ads_start()
  DEFINE stmt STRING
  DEFINE dum CHAR(100)

  WHENEVER ERROR CONTINUE
  SELECT ORIGINAL_TYPE_NAME INTO dum FROM SYSTEM.TABLE_OF_COLUMNS WHERE 1=0
  WHENEVER ERROR STOP
  IF sqlca.sqlcode == 100 THEN
     -- Since ADS 3.80 only!
     LET stmt = "SELECT",
                "  TABLE_NAME,",
                "  COLUMN_NAME,",
                "  ORIGINAL_TYPE_NAME,",
                "  CHARACTER_MAXIMUM_LENGTH,",
                "  NUMERIC_PRECISION,",
                "  NUMERIC_SCALE,",
                "  DATETIME_PRECISION,",
                "  INTERVAL_PRECISION,",
                "  IS_NULLABLE,",
                "  ORDINAL_POSITION",
                " FROM INFORMATION_SCHEMA.COLUMNS",
                " WHERE COLUMN_NAME NOT LIKE '$%'",
                _fgldbsch_get_selection_filter_ads("TABLE_NAME","TABLE_SCHEMA"),
                " ORDER BY TABLE_NAME, ORDINAL_POSITION"
  ELSE
     LET stmt = "SELECT",
                "  TABLE_NAME,",
                "  COLUMN_NAME,",
                "  TYPE_NAME,",
                "  COLUMN_SIZE,",
                "  COLUMN_SIZE,",
                "  DECIMAL_DIGITS,",
                "  -1,",
                "  -1,",
                "  NULLABLE,",
                "  ORDINAL_POSITION",
                " FROM SYSTEM.TABLE_OF_COLUMNS",
                " WHERE COLUMN_NAME NOT LIKE '$%'",
                _fgldbsch_get_selection_filter_ads("TABLE_NAME","TABLE_SCHEM"),
                " ORDER BY TABLE_NAME, ORDINAL_POSITION"
  END IF

  WHENEVER ERROR CONTINUE
  DECLARE ctc_ads CURSOR FROM stmt
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  OPEN ctc_ads
  IF SQLCA.SQLCODE<0 THEN RETURN SQLCA.SQLCODE END IF
  WHENEVER ERROR STOP

  RETURN 0

END FUNCTION

FUNCTION _fgldbsch_extract_ads_next()
  DEFINE tabname VARCHAR(200)
  DEFINE colname VARCHAR(200)
  DEFINE coltype VARCHAR(100)
  DEFINE colchsze INTEGER
  DEFINE colnmpre INTEGER
  DEFINE colnmscl INTEGER
  DEFINE coldtpre INTEGER
  DEFINE colivpre INTEGER
  DEFINE colnullc CHAR(3)
  DEFINE colident INTEGER
  DEFINE nattype STRING
  DEFINE ifxtype INTEGER
  DEFINE ifxleng INTEGER

  WHILE TRUE
    WHENEVER ERROR CONTINUE
    FETCH ctc_ads INTO
                  tabname,
                  colname,
                  coltype,
                  colchsze,
                  colnmpre,
                  colnmscl,
                  coldtpre,
                  colivpre,
                  colnullc,
                  colident

    WHENEVER ERROR STOP
    IF SQLCA.SQLCODE < 0 THEN RETURN SQLCA.SQLCODE END IF

    IF SQLCA.SQLCODE == NOTFOUND THEN
       CLOSE ctc_ads
       RETURN ( coldef.getLength() > 0 ) 
    END IF

    CALL _fgldbsch_convert_datatype_ads(
                  coltype,
                  colchsze,
                  colnmpre,
                  colnmscl,
                  coldtpre,
                  colivpre,
                  colnullc
         ) RETURNING
                  nattype,
                  ifxtype,
                  ifxleng

    IF _fgldbsch_register_column(tabname, colname, nattype, ifxtype, ifxleng) THEN
       EXIT WHILE
    END IF

  END WHILE

  RETURN 1

END FUNCTION