MBS/PROYECTO/otrodir/dbadministrator/fgldbutl.4gl

#+ Database utility functions
#+

DEFINE     m_transcount   SMALLINT

#+ Returns the current database type identifier (ORA,IFX,DB2,MSV).
#+ @returnType String
FUNCTION db_get_database_type()

   DEFINE uname  CHAR(30)
   DEFINE dbtype CHAR(3)
   DEFINE s INTEGER

   WHENEVER ERROR CONTINUE

   INITIALIZE dbtype TO NULL

   IF dbtype IS NULL THEN
      # Try INFORMIX specific statement
      SELECT USER INTO uname FROM systables WHERE tabid=1
      IF STATUS=0 THEN LET dbtype = "IFX" END IF
   END IF

   IF dbtype IS NULL THEN
      # Try MS SQL Server specific statement
      # MUST use a string because INFORMATION_SCHEMA.TABLES is case-sensitive!!!
      EXECUTE IMMEDIATE "SELECT DISTINCT(@@SERVERNAME) FROM INFORMATION_SCHEMA.TABLES"
      IF STATUS=0 THEN LET dbtype = "MSV" END IF
   END IF

   IF dbtype IS NULL THEN
      # Try IBM DB2 specific statement
      SELECT USER INTO uname FROM sysibm.systables WHERE name='SYSTABLES' 
      IF STATUS=0 THEN LET dbtype = "DB2" END IF
   END IF

   IF dbtype IS NULL THEN
      # Try ORACLE specific statement
      SELECT USER INTO uname FROM all_tables WHERE table_name='DUAL' AND pct_free IS NOT NULL
      IF STATUS=0 THEN LET dbtype = "ORA" END IF
   END IF

   IF dbtype IS NULL THEN
      # Try SYBASE ASA specific statement
      SELECT USER INTO uname FROM systable WHERE table_id=1 AND file_id IS NOT NULL
      IF STATUS=0 THEN LET dbtype = "ASA" END IF
   END IF

   IF dbtype IS NULL THEN
      # Try POSTGRESQL specific statement
      SELECT USER INTO uname FROM pg_class WHERE relname='pg_class'
      IF STATUS=0 THEN LET dbtype = "PGS" END IF
   END IF

   IF dbtype IS NULL THEN
      # Try MySQL specific statement
      DECLARE cdbt1 CURSOR FROM "SELECT CURDATE()"
      OPEN cdbt1
      LET s=STATUS
      CLOSE cdbt1
      FREE cdbt1
      IF s=0 THEN LET dbtype = "MYS" END IF
   END IF

   IF dbtype IS NULL THEN
      SELECT USER INTO uname FROM SYSTEM.TABLE_OF_TABLES
            WHERE TABLE_NAME = 'TABLE_OF_TABLES'
      IF STATUS=0 THEN LET dbtype = "ADS" END IF
   END IF

   WHENEVER ERROR STOP

   IF dbtype IS NULL THEN
      DISPLAY "FATAL ERROR: db_get_database_type() could not identify database type."
      EXIT PROGRAM 1
   END IF

   RETURN dbtype

END FUNCTION

#+ Generates a new sequence from seqreg table.
#+ @param sname The name of the sequence.
FUNCTION db_get_sequence( sname )

   DEFINE sname    VARCHAR(30)
   DEFINE nlast    INTEGER

   -- Table must have the following structure:
   --    CREATE TABLE seqreg (
   --        sr_name VARCHAR(30) NOT NULL,
   --        sr_last INTEGER     NOT NULL,
   --        PRIMARY KEY (sr_name)
   --    )

   WHENEVER ERROR CONTINUE

   -- First statement must be the UPDATE to set an exclusive lock
   UPDATE seqreg SET sr_last = sr_last + 1 WHERE sr_name = sname
   IF status<0 THEN RETURN -1 END IF

   -- If the number of processed row is zero, insert missing record
   SELECT sr_last INTO nlast FROM seqreg WHERE sr_name = sname
   IF status<0 THEN RETURN -1 END IF

   -- If nothing was found, insert missing record
   IF status = NOTFOUND THEN
      LET nlast = 1      
      INSERT INTO seqreg ( sr_name, sr_last ) VALUES ( sname, nlast )
      IF status<0 THEN RETURN -1 END IF
   END IF

   WHENEVER ERROR STOP

   RETURN nlast

END FUNCTION

#+ Starts a new transaction.
#+ @returnType INTEGER
FUNCTION db_start_transaction( )
   DEFINE s INTEGER
   LET s = 0
   IF m_transcount IS NULL OR m_transcount < 0 THEN
      LET m_transcount = 0
   END IF
   IF m_transcount = 0 THEN
      WHENEVER ERROR CONTINUE
      BEGIN WORK
      LET s = STATUS
      WHENEVER ERROR STOP
   END IF
   IF s = 0 THEN
      LET m_transcount = m_transcount + 1
   END IF
   RETURN s
END FUNCTION

#+ Terminates a transaction with COMMIT or ROLLBACK.
#+ @returnType INTEGER
#+ @param c TRUE=COMMIT, FALSE=ROLLBACK.
FUNCTION db_finish_transaction( c )
   DEFINE c SMALLINT
   DEFINE s INTEGER
   LET s = 0
   IF m_transcount IS NULL OR m_transcount < 0 THEN
      LET m_transcount = 0
   END IF
   IF m_transcount <= 0 THEN
      LET s = -1
   ELSE
      IF m_transcount = 1 THEN
         WHENEVER ERROR CONTINUE
         IF c THEN
            COMMIT WORK
         ELSE
            ROLLBACK WORK
         END IF
         LET s = STATUS
         WHENEVER ERROR STOP
       END IF
   END IF
   IF s = 0 THEN
      LET m_transcount = m_transcount - 1
   END IF
   RETURN s
END FUNCTION

#+ Has a transaction been started with db_start_transaction?
#+ @returnType INTEGER
#+ @return TRUE if a transaction was started with db_start_transaction.
FUNCTION db_is_transaction_started( )
   IF m_transcount > 0 THEN
      RETURN TRUE
   ELSE
      RETURN FALSE
   END IF
END FUNCTION

#+ Renames a database table.
#+ @returnType INTEGER
#+ @param oldname Old table name.
#+ @param newname New table name.
FUNCTION db_rename_table( oldname, newname )
  DEFINE oldname   CHAR(200)
  DEFINE newname   CHAR(200)
  DEFINE dbtype    CHAR(3)
  DEFINE sqltxt    CHAR(500)
  LET dbtype = db_get_database_type()
  CASE dbtype
       WHEN "ORA"
            LET sqltxt = "RENAME ", oldname CLIPPED,
                         " TO ", newname CLIPPED
       WHEN "MSV"
            LET sqltxt = "sp_rename ", oldname CLIPPED,
                         ", ", newname CLIPPED
       WHEN "PGS"
            LET sqltxt = "ALTER TABLE ", oldname CLIPPED,
                         " RENAME TO ", newname CLIPPED
       OTHERWISE
            LET sqltxt = "RENAME TABLE ", oldname CLIPPED,
                         " TO ", newname CLIPPED
  END CASE
  WHENEVER ERROR CONTINUE
  PREPARE stmt_rename_table FROM sqltxt
  IF sqlca.sqlcode<0 THEN RETURN sqlca.sqlcode END IF
  EXECUTE stmt_rename_table
  WHENEVER ERROR STOP
  RETURN sqlca.sqlcode
END FUNCTION