Unterprogramme auslagern

Mit diesem Report können Sie Unterprogramme in eigene Includes auslagern. Die Unterprogramme werden gesucht und in jeweils ein Include ausgelagert. Das Programm dient in erster Linie dazu, die SCAN-Funktionen zur automatischen Programmanalyse zu demonstrieren.

Die Verwendung erfolgt auf eigene Gefahr!

Machen Sie zur Sicherheit eine Sicherheitskopie des zu bearbeitenden Programms!

Coding

REPORT zz_move_forms_to_include.
************************************************************************
*
* Auslagern bestimmter Routinen (USEREXIT...) in eigene Includes.
* Speziell für die SAPMV45A:
* Die Userexit-Routinen liegen bereits in Kundenincludes, jedoch
* gibt es nicht für jede Routine ein Include, sondern für alle 57
* Userexitroutinen nur 8 Includes.
* Mit diesem Programm werden die Routinen gesucht und in ein eigenes
* Include ausgelagert. Der Name der Unterroutine ist auch der Name
* des Includes. Es wird jedoch ZV45 anstelle der ersten 4 Zeichen
* gesetzt.
************************************************************************
* zv45exit_check_xvbep_for_delet
* 123456789012345678901234567890
* userexit_check_xvbep_for_delet
*----------------------------------------------------------------------*

TYPE-POOLS: trwbo.

DATA:
  ls_tr_request   TYPE trwbo_request_header,
  ls_tr_task      TYPE trwbo_request_header,
  ls_tr_sel       TYPE trwbo_selection,
  ls_tr_new_prop  TYPE trwbo_new_req_props,
  lv_repid        TYPE syrepid,
  lv_repid_merk   TYPE syrepid,
  lv_formname(30),
  lv_formlen      TYPE i,
  lt_relevant_includes TYPE STANDARD TABLE OF syrepid,
  lv_answer       TYPE c,
  BEGIN OF lt_relevant_forms OCCURS 0,
     incl TYPE syrepid,
     name TYPE syrepid,
     nnew TYPE syrepid,
  END OF lt_relevant_forms,
  ls_trdir        LIKE trdir,
  ls_tadir        LIKE tadir,
  lt_source       TYPE STANDARD TABLE OF text255,
  ls_source       TYPE text255,
  lt_source_new   TYPE TABLE OF text255,
  ls_source_new   TYPE text255,
  lt_source_main  TYPE TABLE OF text255,
  ls_source_main  TYPE text255,
  lt_textpool     LIKE textpool   OCCURS 0 WITH HEADER LINE,
  lt_doku         LIKE tline      OCCURS 0 WITH HEADER LINE,
  lt_compo        LIKE scompo     OCCURS 0 WITH HEADER LINE,
  lr_cross_ref    LIKE cross      OCCURS 0 WITH HEADER LINE,
  lt_includes     LIKE d010inc    OCCURS 0 WITH HEADER LINE.

DATA:
  lt_keywords     TYPE STANDARD TABLE OF char30,
  lt_statements   LIKE sstmnt OCCURS 0 WITH HEADER LINE,
  lt_tokens       LIKE stokex OCCURS 0 WITH HEADER LINE,
  lv_overflow_area(65535),
  lv_row_from     TYPE i,
  lv_row_to       TYPE i,
  lv_object_found TYPE c,
  lv_mess(80)     TYPE c.

*** SELECTION-SCREEN
PARAMETERS: p_repid     TYPE syrepid  DEFAULT ''.
PARAMETERS: p_korr      TYPE trkorr   MEMORY ID kol.
PARAMETERS: p_devcl     TYPE devclass DEFAULT 'ZZ01'.
PARAMETERS: p_prefix(4)               DEFAULT 'ZZ01'.
PARAMETERS: p_update AS CHECKBOX.
PARAMETERS: p_owrite AS CHECKBOX.
SELECT-OPTIONS: s_incl FOR lv_repid.

AT SELECTION-SCREEN ON VALUE-REQUEST FOR p_korr.
*** F4-Auswahl für Transportauftrag
  ls_tr_sel-reqfunctions = 'K'.
  ls_tr_sel-reqstatus    = 'D'.
  ls_tr_new_prop-trfunctions = 'K'.
  CALL FUNCTION 'TR_PRESENT_REQUESTS_SEL_POPUP'
    EXPORTING
      iv_organizer_type    = 'T'
      iv_username          = sy-uname
      is_selection         = ls_tr_sel
      is_new_request_props = ls_tr_new_prop
    IMPORTING
      es_selected_request  = ls_tr_request
      es_selected_task     = ls_tr_task.
  IF ls_tr_task-trkorr <> space.
    p_korr = ls_tr_task-trkorr.
  ENDIF.

  LEAVE SCREEN.

*** Programmstart
START-OF-SELECTION.

*** Transportauftrag muss vorhanden sein
  IF p_update = 'X' AND p_korr IS INITIAL.
    MESSAGE s000(oo) WITH 'Bitte Transportauftrag angeben!!!'.
    STOP.
  ENDIF.

*** Ist das Programm vorhanden?
  SELECT SINGLE * FROM tadir INTO ls_tadir
   WHERE pgmid  = 'R3TR'
     AND object = 'PROG'
     AND obj_name = p_repid.
  IF sy-subrc > 0.
*** Programm existiert nicht
    MESSAGE i000(oo) WITH p_repid 'existiert nicht!'.
    STOP.
  ENDIF.

*** Programminformationen holen
  CALL FUNCTION 'RS_PROGRAM_INDEX'
    EXPORTING
      pg_name      = p_repid
      without_tree = ' '
    TABLES
      compo        = lt_compo
      cross_ref    = lr_cross_ref
      inc          = lt_includes
    EXCEPTIONS
      syntax_error = 1
      OTHERS       = 2.

*** Alle Unterroutinen suchen, die mit USEREXIT beginnen
  LOOP AT lt_compo WHERE type = 'U'
*                     AND name(8) = 'USEREXIT'
                     AND incl IN s_incl.
*** Alle gefundenen Includes merken
    COLLECT lt_compo-incl INTO lt_relevant_includes.
    lt_relevant_forms-incl = lt_compo-incl.
    lt_relevant_forms-name = lt_compo-name.
    APPEND lt_relevant_forms.
  ENDLOOP.

*** Init
  CLEAR lt_compo.
  CLEAR lv_repid_merk.
*** Vorbereitung für das Scannen des Quelltextes
  APPEND 'FORM'    TO lt_keywords.
  APPEND 'ENDFORM' TO lt_keywords.

** Sortierung
  SORT lt_relevant_includes.

*** Gefundene Includes bearbeiten
  LOOP AT lt_relevant_includes INTO lv_repid.
*** In LT_Source_Main stehen am Ende die INCLUDE-Anweisungen für
*** die erzeugten Includes
    CLEAR lt_source_main[].

*** Alle gefundenen Unterroutinen auslagern
    LOOP AT lt_relevant_forms WHERE incl = lv_repid.

*** Includenamen basteln
      lt_relevant_forms-nnew = lt_relevant_forms-name.
*** Ausgabe: neues Include in gelb
      lt_relevant_forms-nnew(4)  = p_prefix.
      ULINE.
      FORMAT COLOR COL_TOTAL.
      WRITE: / 'Anlage neues Include:', lt_relevant_forms-nnew.
      FORMAT COLOR OFF.
      MODIFY lt_relevant_forms.

*** Code zusammensuchen und in neues Include auslagern
      PERFORM extract_code USING lt_relevant_forms-incl
                                 lt_relevant_forms-name
                                 lt_relevant_forms-nnew.
    ENDLOOP.

*** Für alle neuen Includes die Include-Anweisungen anlegen
    IF NOT lt_source_main[] IS INITIAL.
      FORMAT COLOR COL_POSITIVE.
      SKIP 2.
      WRITE: / '***** DIESE ZEILEN ANFÜGEN AN:', lv_repid, '******'.
      LOOP AT lt_source_main INTO ls_source.
        WRITE: /6 ls_source.
      ENDLOOP.
      SKIP 2.
      FORMAT COLOR OFF.
    ENDIF.
  ENDLOOP.

*---------------------------------------------------------------------*
*       FORM EXTRACT_CODE                                             *
*---------------------------------------------------------------------*
FORM extract_code USING fi_incl TYPE syrepid
                        fi_name TYPE syrepid
                        fi_nnew TYPE syrepid.

  CHECK fi_incl <> space.
  CLEAR lt_source_new[].

  IF lv_repid_merk <> fi_incl.
*** Reportsource nur nachlesen, wenn erforderlich
    READ REPORT fi_incl INTO lt_source.
    lv_repid_merk = fi_incl.
*** Quelltext analysieren, um die Zeilen zu bekommen, in denen die
***  Unterroutinen stehen
    SCAN ABAP-SOURCE lt_source TOKENS      INTO lt_tokens
                               STATEMENTS  INTO lt_statements
                               OVERFLOW    INTO lv_overflow_area
         KEYWORDS FROM lt_keywords
         MESSAGE  INTO lv_mess
         WITHOUT TRMAC
         WITH ANALYSIS.
  ENDIF.

*** Im Quelltext die Unterroutine suchen und auslagern
  CLEAR lv_object_found.
  LOOP AT lt_statements.
    sy-tabix = lt_statements-from + 1.
    READ TABLE lt_tokens INDEX sy-tabix.
    IF lt_tokens-str = fi_name.
      lv_object_found = 'X'.
      lv_row_from = lt_tokens-row.
      DO.
        ADD 1 TO sy-tabix.
        READ TABLE lt_tokens INDEX sy-tabix.
        IF sy-subrc = 0 AND lt_tokens-str = 'ENDFORM'.
          lv_row_to = lt_tokens-row.
          EXIT.
        ELSEIF sy-subrc > 0.
          EXIT.
        ENDIF.
      ENDDO.
      EXIT.
    ENDIF.
  ENDLOOP.

*** Unterprogramm wurde auch tatsächlich gefunden
  CHECK lv_object_found <> space.

*** Der Zeilen-Pointer zeigt auf den Anfang der Form-Routine;
*** Ich möchte aber auch die Kommentarzeilen vorher haben:
  DO.
    IF lv_row_from > 1.
      SUBTRACT 1 FROM lv_row_from.
      READ TABLE lt_source INTO ls_source INDEX lv_row_from.
      IF ls_source(1) <> '*'.
        ADD 1 TO lv_row_from.
        EXIT.
      ENDIF.
    ELSE.
      EXIT. "From DO
    ENDIF.
  ENDDO.

*** Quelltext der Unterroutine lesen, ausgeben und auslagern
  LOOP AT lt_source INTO ls_source FROM lv_row_from TO lv_row_to.
*** Kommentarzeilen hervorheben
    CASE ls_source(1).
      WHEN '*'. FORMAT INTENSIFIED ON.
      WHEN OTHERS. FORMAT INTENSIFIED OFF.
    ENDCASE.
*** Ausgabe der Zeile
    WRITE: /4 ls_source.
*** Merken der Zeile für neuen Include
    APPEND ls_source TO lt_source_new.
  ENDLOOP.

*** Include-Anweisung für das augelagerte Include erzeugen:
  IF sy-subrc = 0.
    CONCATENATE '*** Neues Include für'
                fi_name INTO ls_source SEPARATED BY space.
    APPEND ls_source TO lt_source_main.
    CONCATENATE 'INCLUDE'
                fi_nnew '.' INTO ls_source SEPARATED BY space.
    APPEND ls_source TO lt_source_main.
    APPEND '*' TO lt_source_main.
  ENDIF.


*** prüfen, ob der Include schon vorhanden ist.
  SELECT SINGLE * FROM trdir INTO ls_trdir
   WHERE name = fi_nnew.
  IF sy-subrc = 0.
*** Include ist vorhanden
    FORMAT COLOR COL_NEGATIVE.
    WRITE: / 'Programm', fi_nnew, 'ist vorhanden!'.
    FORMAT COLOR OFF.
    IF p_owrite = 'X'.
*** Include soll überschrieben werden
      WRITE: 'Wird überschrieben...' COLOR COL_TOTAL.
    ELSE.
      EXIT.
    ENDIF.
  ENDIF.

  IF p_update = 'X'.
*** Erzeugen des Includes
    CLEAR ls_trdir.
    ls_trdir-subc = 'I'.
    ls_trdir-appl = 'V'.

*** Beschreibung des Includes erzeugen
    CLEAR lt_textpool[].
    lt_textpool-id     = 'R'. "Reportbeschreibung
    lt_textpool-key    = space.
    CONCATENATE fi_incl ' - FORM "'
                fi_name '"'
           INTO lt_textpool-entry.
    APPEND lt_textpool.
*** Includebeschreibung und Quelltext auf die Datenbank schreiben
    CALL FUNCTION 'RV_REPORT_WRITE'
      EXPORTING
        rw_langu      = sy-langu
        rw_reportname = fi_nnew
        rw_trdir      = ls_trdir
      TABLES
        rw_coding     = lt_source_new
        rw_docu       = lt_doku
        rw_textpool   = lt_textpool.
*** Include in Transportauftrag aufnehmen
    PERFORM tr_append USING fi_nnew.
    IF sy-subrc = 0.
      WRITE: / 'Include angelegt:', fi_nnew.
    ENDIF.

  ENDIF. "Update?

ENDFORM.                    "EXTRACT_CODE


*&---------------------------------------------------------------------*
*&      Form  TR_APPEND
*&---------------------------------------------------------------------*
FORM tr_append USING    fi_report TYPE syrepid.

  CHECK p_update = 'X'.

  CALL FUNCTION 'RS_CORR_INSERT'
    EXPORTING
      object              = fi_report
      object_class        = 'ABAP'
      mode                = 'INSERT'
      global_lock         = 'X'
      devclass            = p_devcl
      korrnum             = p_korr
      author              = sy-uname
      master_language     = sy-langu
    EXCEPTIONS
      cancelled           = 1
      permission_failure  = 2
      unknown_objectclass = 3
      OTHERS              = 4.
  IF sy-subrc <> 0.
    FORMAT COLOR COL_NEGATIVE.
    WRITE: / 'Report', fi_report,
             'wurde nicht in Korrektur', p_korr,
             'aufgenommen!!!! Fehler:', sy-subrc.
    FORMAT COLOR OFF.
  ENDIF.

ENDFORM.                    " TR_APPEND

 

 

Enno Wulff