ZARCHIVE_DECONSTRUCT_INDEX

Code listing for: ZARCHIVE_DECONSTRUCT_INDEX

Description: Archive deconstruct index table for ZTABLE

REPORT zarchive_deconstruct_index.

TABLES: dd03l,aind_statu,admi_files,arch_txt.

TYPE-POOLS: slis.

DATA:it_files TYPE TABLE OF admi_files WITH HEADER LINE,
     it_statu TYPE TABLE OF aind_statu WITH HEADER LINE,
     it_str2  TYPE TABLE OF aind_str2  WITH HEADER LINE.

DATA: gt_fieldname TYPE typ_t_fieldname,
       gt_fieldcat  TYPE lvc_t_fcat,
       gt_dyn_itab  TYPE REF TO data,
       gt_dyn_index TYPE REF TO data,
       gt_dyn_swap  TYPE REF TO data,
       gs_index     TYPE REF TO data,
       gs_wa        TYPE REF TO data.

DATA: gv_string(18),
       gv_error      TYPE c,
       gv_filename   TYPE localfile,
       gs_fieldcat   TYPE lvc_s_fcat,
       gs_fieldname  TYPE LINE OF typ_t_fieldname.

FIELD-SYMBOLS: <fs_itab> TYPE STANDARD TABLE,
               <fs_itab_swap>  TYPE STANDARD TABLE,
               <fs_itab_index> TYPE STANDARD TABLE,
               <fs_wa>         TYPE any,
               <fs_wa_index>   TYPE any,
               <fs_field> .

************************************************************************
* 选择屏幕参数                                                         *
************************************************************************
*PARAMETERS: P_TAB LIKE DD03L-TABNAME MEMORY ID TABNAME OBLIGATORY.

SELECTION-SCREEN BEGIN OF BLOCK tb1 WITH FRAME TITLE tblock1. " TableN
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(14) tabname.
PARAMETERS: p_tab LIKE dd03l-tabname.
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(14) pmax.
PARAMETERS: p_max TYPE i DEFAULT 10000.
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN END OF BLOCK tb1.

SELECTION-SCREEN BEGIN OF BLOCK b2 WITH FRAME TITLE condit.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (10) scf1 .
PARAMETERS: s_cf1 LIKE dd03l-fieldname.
SELECT-OPTIONS: s_cv1 FOR gv_string.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (10) scf2 .
PARAMETERS: s_cf2 LIKE dd03l-fieldname.
SELECT-OPTIONS: s_cv2 FOR gv_string.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (10) scf3 .
PARAMETERS: s_cf3 LIKE dd03l-fieldname.
SELECT-OPTIONS: s_cv3 FOR gv_string.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (10) scf4 .
PARAMETERS: s_cf4 LIKE dd03l-fieldname.
SELECT-OPTIONS: s_cv4 FOR gv_string.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (10) scf5 .
PARAMETERS: s_cf5 LIKE dd03l-fieldname.
SELECT-OPTIONS: s_cv5 FOR gv_string.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (10) scf6 .
PARAMETERS: s_cf6 LIKE dd03l-fieldname.
SELECT-OPTIONS: s_cv6 FOR gv_string.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (41) object.
SELECT-OPTIONS:s_object FOR arch_txt-object OBLIGATORY NO-EXTENSION NO INTERVALS.
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (41) session.
SELECT-OPTIONS:s_asion FOR admi_files-document OBLIGATORY.
SELECTION-SCREEN END OF LINE.

*SELECTION-SCREEN BEGIN OF LINE.
*SELECTION-SCREEN COMMENT (41) sarkey.

SELECT-OPTIONS:s_arkey FOR aind_statu-archivekey NO-DISPLAY.

*SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT (41) sarinx.
SELECT-OPTIONS:s_arinx FOR aind_statu-archindex.
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN END OF BLOCK b2.

SELECTION-SCREEN BEGIN OF BLOCK blk02 WITH FRAME TITLE mode.
SELECTION-SCREEN BEGIN OF LINE.
PARAMETERS:p_test RADIOBUTTON GROUP gp1 DEFAULT 'X'. " 测试运行
SELECTION-SCREEN COMMENT (50) ptest.
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN BEGIN OF LINE.
PARAMETERS:p_prod RADIOBUTTON GROUP gp1. "正式运行
SELECTION-SCREEN COMMENT (50) pprod .
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN END OF BLOCK blk02.

******************************************************************

*----------------------------------------------------------------------
* initialisation
*----------------------------------------------------------------------

INITIALIZATION.
  tblock1  = 'Table Name(Optional)'.
  tabname  = 'Table Name'.
  pmax     = 'Commit No.'.
  condit   = 'SelectCondition'.
  scf1     = 'Sel.Cond.1'.
  scf2     = 'Sel.Cond.2'.
  scf3     = 'Sel.Cond.3'.
  scf4     = 'Sel.Cond.4'.
  scf5     = 'Sel.Cond.5'.
  scf6     = 'Sel.Cond.6'.
  sarinx   = 'Archive Information Structure'.
  object   = 'Archiving Object'.
  session  = 'Archiving Session'.

*  sarkey   = 'Key for Archive File'.

  mode     = 'Mode'.
  pprod    = 'Delete'.
  ptest    = 'Test delete'.

************************************************************************
* at selection screen
************************************************************************

AT SELECTION-SCREEN.
  PERFORM frm_check_input.

************************************************************************
* event Start of Selection
************************************************************************

START-OF-SELECTION.
  PERFORM frm_delete_ztable.  "

************************************************************************
*EVENT End-of selection
************************************************************************

END-OF-SELECTION.
  PERFORM frm_process_status.

*&---------------------------------------------------------------------*
*&      Form  FRM_DELETE_ZTABLE
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*

FORM frm_delete_ztable .

  DATA: lv_condition TYPE string.
  DATA: l_no         TYPE i.
  DATA: l_cursor     TYPE cursor.

*--->condition

  IF s_cf1 IS NOT INITIAL.
    IF lv_condition IS INITIAL.
      CONCATENATE lv_condition
                  s_cf1
                  ` IN s_cv1 `                              "#EC NOTEXT
        INTO lv_condition.
    ELSE.
      CONCATENATE lv_condition
                  ` AND `
                  s_cf1
                  ` IN s_cv1 `                              "#EC NOTEXT
        INTO lv_condition.
    ENDIF.
  ENDIF.

  IF s_cf2 IS NOT INITIAL.
    IF lv_condition IS INITIAL.
      CONCATENATE lv_condition
                  s_cf2
                  ` IN s_cv2 `                              "#EC NOTEXT
        INTO lv_condition.
    ELSE.
      CONCATENATE lv_condition
                  ` AND `
                  s_cf2
                  ` IN s_cv2 `                              "#EC NOTEXT
        INTO lv_condition.
    ENDIF.
  ENDIF.

  IF s_cf3 IS NOT INITIAL.
    IF lv_condition IS INITIAL.
      CONCATENATE lv_condition
                  s_cf3
                  ` IN s_cv3 `                              "#EC NOTEXT
        INTO lv_condition.
    ELSE.
      CONCATENATE lv_condition
                  ` AND `
                  s_cf3
                  ` IN s_cv3 `                              "#EC NOTEXT
        INTO lv_condition.
    ENDIF.
  ENDIF.

  IF s_cf4 IS NOT INITIAL.
    IF lv_condition IS INITIAL.
      CONCATENATE lv_condition
                  s_cf4
                  ` IN s_cv4 `                              "#EC NOTEXT
        INTO lv_condition.
    ELSE.
      CONCATENATE lv_condition
                  ` AND `
                  s_cf4
                  ` IN s_cv4 `                              "#EC NOTEXT
        INTO lv_condition.
    ENDIF.
  ENDIF.

  IF s_cf5 IS NOT INITIAL.
    IF lv_condition IS INITIAL.
      CONCATENATE lv_condition
                  s_cf5
                  ` IN s_cv5 `                              "#EC NOTEXT
        INTO lv_condition.
    ELSE.
      CONCATENATE lv_condition
                  ` AND `
                  s_cf5
                  ` IN s_cv5 `                              "#EC NOTEXT
        INTO lv_condition.
    ENDIF.
  ENDIF.

  IF s_cf6 IS NOT INITIAL.
    IF lv_condition IS INITIAL.
      CONCATENATE lv_condition
                  s_cf6
                  ` IN s_cv6 `                              "#EC NOTEXT
        INTO lv_condition.
    ELSE.
      CONCATENATE lv_condition
                  ` AND `
                  s_cf6
                  ` IN s_cv6 `                              "#EC NOTEXT
        INTO lv_condition.
    ENDIF.
  ENDIF.

  RANGES:lr_object FOR admi_files-archiv_key.
  LOOP AT s_object.
    CLEAR:lr_object.
    lr_object-sign = 'I'.
    lr_object-option = 'CP'.
    CONCATENATE '*' s_object-low INTO lr_object-low.
    APPEND lr_object.
  ENDLOOP.

* fetch

  SELECT *
    INTO TABLE it_files
    FROM admi_files
    WHERE document IN s_asion
      AND archiv_key IN lr_object.
  IF it_files[] IS NOT INITIAL.
    SELECT *
      INTO TABLE it_statu
      FROM aind_statu
      FOR ALL ENTRIES IN it_files
      WHERE archindex IN s_arinx
        AND archivekey IN s_arkey
        AND archivekey = it_files-archiv_key.
  ENDIF.

  CHECK it_statu[] IS NOT INITIAL.
  SELECT *
    INTO TABLE it_str2
    FROM aind_str2
    FOR ALL ENTRIES IN it_statu
    WHERE archindex = it_statu-archindex
      AND active = 'X'.
  LOOP AT it_files.
    CLEAR:s_arkey.
    s_arkey-sign = 'I'.
    s_arkey-option = 'EQ'.
    s_arkey-low = it_files-archiv_key.
    APPEND s_arkey.
  ENDLOOP.

  IF p_tab IS NOT INITIAL.

    DELETE FROM (p_tab) WHERE (lv_condition)
                          AND archivekey IN s_arkey.
    IF sy-subrc = 0.
      IF p_test = 'X'.
        ROLLBACK WORK.
        NEW-LINE.
        WRITE:AT 4 'Test delete ', p_tab, ' records :',  sy-dbcnt.
      ELSE.
        COMMIT WORK.
        NEW-LINE.
        WRITE:AT 4 'Delete ', p_tab, ' records :',  sy-dbcnt.
      ENDIF.
    ENDIF.

  ELSE.

    LOOP AT it_str2.

      IF p_test = 'X'.
        CLEAR:l_no.
        SELECT COUNT(*)
          INTO l_no
          FROM (it_str2-gentab)
          WHERE (lv_condition)
            AND archivekey IN s_arkey.
        NEW-LINE.
        WRITE:AT 4 'Test delete ', it_str2-gentab, ' records :',  l_no.
      ELSE.

        PERFORM frm_create_dynamic_table.

        OPEN CURSOR WITH HOLD l_cursor FOR
          SELECT *
            FROM (it_str2-gentab)
            WHERE (lv_condition)
             AND archivekey IN s_arkey.

        DO.

          FETCH NEXT CURSOR l_cursor
            INTO TABLE <fs_itab>
            PACKAGE SIZE p_max.

          IF sy-subrc = 0.
            DELETE (it_str2-gentab) FROM TABLE <fs_itab>.
            IF sy-subrc = 0.
              NEW-LINE.
              WRITE:AT 4 'Delete ', it_str2-gentab, ' records :',  sy-dbcnt.
              CLEAR:<fs_itab>.
            ENDIF.
          ELSE.
            EXIT.
          ENDIF.

        ENDDO.
        CLOSE CURSOR l_cursor.

      ENDIF.
    ENDLOOP.

  ENDIF.

ENDFORM.

*&---------------------------------------------------------------------*
*&      Form  FRM_PROCESS_STATUS
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*

FORM frm_process_status .

  CHECK s_arinx[] IS NOT INITIAL
     OR s_arkey[] IS NOT INITIAL.

  DELETE FROM aind_statu WHERE archindex IN s_arinx
                           AND archivekey IN s_arkey.
  IF sy-subrc = 0.
    IF p_test = 'X'.
      ROLLBACK WORK.
      NEW-LINE.
      WRITE:AT 4 'Test is OK'.
    ELSE.
      COMMIT WORK.
      NEW-LINE.
      WRITE:AT 4 'Delete AIND_STATU records :',  sy-dbcnt.
    ENDIF.
  ENDIF.

ENDFORM.

*&---------------------------------------------------------------------*
*&      Form  FRM_CHECK_INPUT
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*

FORM frm_check_input .
  RANGES:lr_object FOR admi_files-archiv_key.
  LOOP AT s_object.
    CLEAR:lr_object.
    lr_object-sign = 'I'.
    lr_object-option = 'CP'.
    CONCATENATE '*' s_object-low INTO lr_object-low.
    APPEND lr_object.
  ENDLOOP.

* fetch

  SELECT *
    INTO TABLE it_files
    FROM admi_files
    WHERE document IN s_asion
      AND archiv_key IN lr_object.
  IF it_files[] IS NOT INITIAL.
    SELECT *
      INTO TABLE it_statu
      FROM aind_statu
      FOR ALL ENTRIES IN it_files
      WHERE archindex IN s_arinx
        AND archivekey IN s_arkey
        AND archivekey = it_files-archiv_key.
  ELSE.
    PERFORM frm_error_output USING 'The Archive Session has no File.'.
  ENDIF.

  IF it_statu[] IS NOT INITIAL.
    SELECT *
      INTO TABLE it_str2
      FROM aind_str2
      FOR ALL ENTRIES IN it_statu
      WHERE archindex = it_statu-archindex
        AND active = 'X'.
  ENDIF.

* check

  DESCRIBE TABLE it_str2.
  IF sy-tfill = 0.
    PERFORM frm_error_output USING 'The Archive Key has no active Index Table.'.
  ENDIF.

  IF p_tab IS NOT INITIAL.

    DESCRIBE TABLE it_str2.
    IF sy-tfill = 1.
      READ TABLE it_str2.
      IF p_tab <> it_str2-gentab.
        PERFORM frm_error_output USING 'Table Name does not match Archive Key.'.
      ENDIF.
    ELSE.
      PERFORM frm_error_output USING 'Please clear tabname Because The Archive Key have few index tables.'.
    ENDIF.

  ENDIF.

ENDFORM.

*&---------------------------------------------------------------------*
*&      Form  FRM_ERROR_OUTPUT
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_0167   text
*----------------------------------------------------------------------*

FORM frm_error_output USING VALUE(p_mess).

  MESSAGE p_mess TYPE 'S' DISPLAY LIKE 'E'.
  LEAVE LIST-PROCESSING.

ENDFORM. " FRM_ERROR_OUTPUT

*&---------------------------------------------------------------------*
*&      Form  FRM_CREATE_DYNAMIC_TABLE
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*

FORM frm_create_dynamic_table .

  CREATE DATA gt_dyn_itab TYPE TABLE OF (it_str2-gentab).
  ASSIGN gt_dyn_itab->* TO <fs_itab>.

  CREATE DATA gs_wa LIKE LINE OF <fs_itab>.
  ASSIGN gs_wa->* TO <fs_wa>.

  CREATE DATA gt_dyn_swap LIKE <fs_itab>.
  ASSIGN gt_dyn_swap->* TO <fs_itab_swap>.

ENDFORM.

Extracted by Mass Download version 1.5.0 - E.G.Mellodew. 1998-2017. Sap Release 740