/*  $Revision$
 *  $Id$
 */

CREATE OR REPLACE PACKAGE adm
AS
   FUNCTION systeminfo RETURN VARCHAR2;
   PROCEDURE systrackscriptId (svnid IN VARCHAR2, force IN NUMBER DEFAULT 1);
   PROCEDURE trydrop (n IN VARCHAR2);
   PROCEDURE tryalter (n IN VARCHAR2);
   FUNCTION scriptspoolfile(custpattern IN VARCHAR2, scriptname IN VARCHAR2) RETURN VARCHAR2;
   FUNCTION getscriptspoolfile(scriptname IN VARCHAR2) RETURN VARCHAR2;
   FUNCTION checkscriptcust(custpattern IN VARCHAR2) RETURN VARCHAR2;
END adm;
/

CREATE OR REPLACE PACKAGE BODY adm
AS
   -- Voor SVN is dit handiger, vereist alleen de svn-id string
   -- ($Id$)
   PROCEDURE systrackscriptId (svnid IN VARCHAR2, force IN NUMBER DEFAULT 1)
   AS
      revisionnr adm_tracking.adm_tracking_revision%TYPE;
      scriptname adm_tracking.adm_tracking_name%TYPE;
      tempstr VARCHAR2 (100);
   BEGIN
      -- op het gemakje ontleden
      tempstr := REPLACE (svnid, '$Id: ', '');
      tempstr := RTRIM(SUBSTR(tempstr, 1, instr(tempstr, ' ', 1, 2)));
      -- is nu: ADM_PAC.SRC 19151
      scriptname := RTRIM(SUBSTR(tempstr, 1, instr(tempstr, ' ', 1, 1)));  -- ADM_PAC
      revisionnr := SUBSTR(tempstr, instr(tempstr, ' ', 1, 1) + 1);   -- 19151
      IF force = 1
      THEN
          INSERT INTO adm_tracking (adm_tracking_name, adm_tracking_revision)
               VALUES (scriptname, revisionnr);
      ELSE
         BEGIN
            UPDATE   adm_tracking
               SET   adm_tracking_date = SYSDATE, adm_tracking_osuser = SYS_CONTEXT ('USERENV', 'OS_USER')
             WHERE   UPPER (adm_tracking_name) = UPPER (scriptname)
                     AND UPPER (adm_tracking_revision) = UPPER (revisionnr);

            IF SQL%ROWCOUNT = 0
            THEN
               INSERT INTO adm_tracking (adm_tracking_name, adm_tracking_revision)
                    VALUES (scriptname, revisionnr);
            END IF;
         END;
    END IF;
   END;

   -- DDL. Probeert een object (TABLE, INDEX e.d.) te droppen, maar moppert niet als die niet bestond
   -- Hiermee voorkomen we foutmeldingen in logfiles die niet erg zijn
   PROCEDURE trydrop (n IN VARCHAR2)
   AS
       stmt VARCHAR2 (1000);
   BEGIN
       stmt := 'DROP ' || n;

       EXECUTE IMMEDIATE stmt;
       DBMS_OUTPUT.put_line ('Found, successfully dropped: ' || n);
   EXCEPTION
       WHEN OTHERS
       THEN
          IF SQLCODE IN (-942, -1418, -2289, -4043, -4080)
          THEN
             -- did not exist, voor table, view, index, sequence, object and trigger
             DBMS_OUTPUT.put_line ('Not found, no need to drop:  ' || n);
             NULL;
          ELSE
             raise_application_error(-20001, 'Error trying to DROP ' || n || ': ' || SQLERRM);
          END IF;
   END;

   -- DDL. Probeert een object (TABLE, INDEX e.d.) te alteren, maar moppert niet als die niet bestond
   -- Hiermee voorkomen we foutmeldingen in logfiles die niet erg zijn
   PROCEDURE tryalter (n IN VARCHAR2)
   AS
       stmt VARCHAR2 (1000);
   BEGIN
       stmt := 'ALTER ' || n;

       EXECUTE IMMEDIATE stmt;
       DBMS_OUTPUT.put_line ('Found, successfully altered: ' || n);
   EXCEPTION
       WHEN OTHERS
       THEN
          IF SQLCODE IN (-904, -942, -1418, -2289, -4043, -4080, -2443)
          THEN
             -- did not exist, voor identifier (column) table, view, index, sequence, object and trigger, constraint
             DBMS_OUTPUT.put_line ('Not found, not altered: ' || n);
             NULL;
          ELSIF SQLCODE IN (-955, -1442)
          THEN
             -- object or not-null property already exist
             DBMS_OUTPUT.put_line ('Already exists, not altered:     ' || n);
             NULL;
          ELSE
             raise_application_error(-20001, 'Error trying to ALTER ' || n || ': ' || SQLERRM);
          END IF;
   END;

  FUNCTION scriptspoolfile (custpattern  IN VARCHAR2, -- eg ^SGGR for 'start with SGGR', ATCH|BONS for two schema
                            scriptname   IN VARCHAR2)
      RETURN VARCHAR2
   IS
      lstname   VARCHAR2(4000);
      tekst     VARCHAR2(4000);
   BEGIN
      tekst := adm.checkscriptcust(custpattern);
      lstname := adm.getscriptspoolfile(scriptname);
      RETURN lstname;
   END;

   FUNCTION getscriptspoolfile(scriptname IN VARCHAR2)
      RETURN VARCHAR2
   IS
      lstname   VARCHAR2 (255);
   BEGIN
      lstname := scriptname
              || '_' ||  USER || '_' || SYS_CONTEXT ('USERENV', 'SERVICE_NAME')
                              || '_' || SYS_CONTEXT ('USERENV', 'SERVER_HOST')
              || '_' || TO_CHAR (SYSDATE, 'YYYYMMDD_HH24MISS')
              || '.lst';
      RETURN UPPER(lstname);
   END;

   FUNCTION systeminfo
    RETURN VARCHAR2
   IS
      tekst     VARCHAR2 (4000);
      TYPE table_varchar IS TABLE OF VARCHAR2 (32);
      var_table_varchar table_varchar;
   BEGIN
      var_table_varchar :=
          table_varchar ('TERMINAL',
                         'HOST',
                         'LANGUAGE',
                         'CURRENT_USER',
                         'SESSION_USER',
                         'DB_DOMAIN',
                         'DB_NAME',
                         'SERVER_HOST',
                         'SERVICE_NAME',
                         'IP_ADDRESS');

      SELECT banner_full
        INTO tekst
        FROM v$version;
      tekst := tekst || CHR(10) ||'Time: ' || TO_CHAR(SYSDATE, 'YYYY-MM-DD HH24:MI:SS');
      tekst := tekst || CHR(10) ||'OS-user: ' || SYS_CONTEXT('USERENV','OS_USER');
      FOR elem IN 1 .. var_table_varchar.COUNT
      LOOP
          tekst := tekst ||
                   CHR(10) ||
                   var_table_varchar (elem) || ': ' ||
                   SYS_CONTEXT ('USERENV', var_table_varchar (elem));
      END LOOP;
      return tekst;
   END;

   FUNCTION checkscriptcust(custpattern IN VARCHAR2)
      RETURN VARCHAR2
   IS
      klant     VARCHAR2(4);
      groep     VARCHAR2(4);
      fout      NUMBER(1) := 0;
      qry       VARCHAR2(4000);
      tekst     VARCHAR2 (4000);
   BEGIN
      -- Wat handige info voor in de SPOOL-file (vooral bij licentieklanten waar we het niet altijd weten)
      tekst := adm.systeminfo;

      BEGIN
         -- EXECUTE IMMEDIATE oplossing omdat in het CREA-script de fac_version_tabel er niet op tijd
         -- is, daardoor deze hele package invalid is en aan het eind de REGISTERRUN faalt
         -- (ook al gebruikt REGISTERRUN deze checkscriptcust niet)
         qry := 'SELECT fac_version_cust'
             || '     , fac_version_group'
             || '  FROM fac_version';
         EXECUTE IMMEDIATE qry INTO klant, groep;
      EXCEPTION
         WHEN OTHERS THEN
            klant := USER;
            groep := USER;
            fout := 1;
      END;
      IF NOT (custpattern = klant OR (custpattern = groep AND groep IS NOT NULL) OR REGEXP_LIKE(USER, custpattern, 'i'))
      THEN
         IF (INSTR(custpattern,'^') = 0 OR fout = 0)
         THEN
            tekst := 'User should be ' || custpattern || ' but is ' || USER;
         ELSE
            tekst := 'User should match ' || custpattern || ' but is ' || USER;
         END IF;
         tekst := CHR(10)
               || '============================================' || CHR(10)
               || 'Wrong user!!!!!!!!!' || CHR(10)
               || tekst || CHR(10)
               || '============================================' || CHR(10);
         raise_application_error(-20001, tekst);
      END IF;

      RETURN tekst;
   END;

   END adm;
/

REGISTERRUN('$Id$')
