Source code of program: ZPJ_EXPORT_PROGS

Description: Export Programs

************************************************************************
* Name Program/FM :   ZPJ_EXPORT_PROGS
* Created By      :   Pavel Jaros
* Creation Date   :   2008-11-12
* Transaction Code:   ZPJEXP
* Purpose         :   Tool for mass export of program souce code
************************************************************************

REPORT zpj_export_progs.

TABLES: trdir, tadir, tdevc.

TYPES: BEGIN OF gty_rep,
         line(255),
       END OF gty_rep,
       gty_rep_tab TYPE TABLE OF gty_rep.

DATA: BEGIN OF gt_data OCCURS 0,
        name LIKE trdir-name,
        cnam LIKE trdir-cnam,
        cdat LIKE trdir-cdat,
        unam LIKE trdir-unam,
        fugr LIKE tadir-obj_name,
        funcname LIKE enlfdir-funcname,
      END OF gt_data.

DATA: r_users TYPE RANGE OF sy-uname WITH HEADER LINE.

****************************************
* SELECTION-SCREEN                     *
****************************************
SELECTION-SCREEN: BEGIN OF BLOCK b0 WITH FRAME TITLE text-000.
SELECTION-SCREEN: BEGIN OF BLOCK b1 WITH FRAME TITLE text-001.
SELECT-OPTIONS: s_name FOR trdir-name,
                s_cdat FOR trdir-cdat.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN POSITION 1.
PARAMETERS p_xclas AS CHECKBOX USER-COMMAND mod.
SELECTION-SCREEN COMMENT 2(25) text-010 FOR FIELD p_xclas.
SELECTION-SCREEN POSITION 28.
SELECT-OPTIONS s_clas FOR tdevc-devclass MODIF ID dcl.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN POSITION 1.
PARAMETERS p_create AS CHECKBOX DEFAULT 'X' USER-COMMAND mod.
SELECTION-SCREEN COMMENT 2(25) text-011 FOR FIELD p_create.
SELECTION-SCREEN POSITION 28.
SELECT-OPTIONS s_cnam FOR trdir-cnam DEFAULT sy-uname MODIF ID crt.
SELECTION-SCREEN END OF LINE.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN POSITION 1.
PARAMETERS p_change AS CHECKBOX USER-COMMAND mod.
SELECTION-SCREEN COMMENT 2(25) text-012 FOR FIELD p_change.

SELECTION-SCREEN POSITION 28.
SELECT-OPTIONS s_unam FOR trdir-unam DEFAULT sy-uname MODIF ID chg.
SELECTION-SCREEN END OF LINE.
PARAMETERS p_prefix AS CHECKBOX.

SELECTION-SCREEN: END OF BLOCK b1.
PARAMETERS: p_path LIKE ibipparms-path DEFAULT 'C:\temp\'.
SELECTION-SCREEN: END OF BLOCK b0.

AT SELECTION-SCREEN ON VALUE-REQUEST FOR p_path.
  PERFORM f4_folder CHANGING p_path.

****************************************
* INITIALIZATION                       *
****************************************
INITIALIZATION.
  APPEND 'ICPZ*' TO s_name.
  APPEND 'ICPLZ*' TO s_name.

****************************************
* LOAD-OF-PROGRAM                      *
****************************************
LOAD-OF-PROGRAM.
*--- definition of authorized users ---*
  r_users-sign = 'I'. r_users-option = 'EQ'.
  r_users-low = 'JAROS2775'. APPEND r_users.

  IF NOT sy-uname IN r_users.
    MESSAGE s000(xt) WITH 'You are not authorized to run this program'.
    LEAVE PROGRAM.
  ENDIF.

****************************************
* AT SELECTION-SCREEN                  *
****************************************
AT SELECTION-SCREEN OUTPUT.
  PERFORM sel_screen_processing.

****************************************
* START-OF-SELECTION                   *
****************************************
START-OF-SELECTION.
  PERFORM add_back_slash CHANGING p_path.
  PERFORM get_data.
  CHECK NOT gt_data[] IS INITIAL.
  PERFORM export_programs.

*---------------------------------------------------------------------*
*       FORM sel_screen_processing                                    *
*---------------------------------------------------------------------*
FORM sel_screen_processing.
  LOOP AT SCREEN.
    IF screen-group1 = 'DCL'.
      IF p_xclas = 'X'.
        screen-active = '1'.
      ELSE.
        screen-active = '0'.
      ENDIF.
      MODIFY SCREEN.
    ELSEIF screen-group1 = 'CRT'.
      IF p_create = 'X'.
        screen-active = '1'.
      ELSE.
        screen-active = '0'.
      ENDIF.
      MODIFY SCREEN.
    ELSEIF screen-group1 = 'CHG'.
      IF p_change = 'X'.
        screen-active = '1'.
      ELSE.
        screen-active = '0'.
      ENDIF.
      MODIFY SCREEN.
    ENDIF.
  ENDLOOP.
ENDFORM.                    "sel_screen_processing

*---------------------------------------------------------------------*
*       FORM get_data                                                 *
*---------------------------------------------------------------------*
FORM get_data.
  DATA: l_xclas TYPE xfeld,
        BEGIN OF lt_fmprog OCCURS 100,
          pname LIKE tfdir-pname,
          fugr LIKE tadir-obj_name,
        END OF lt_fmprog,
        l_include LIKE tfdir-include,
        l_len TYPE i.

  IF p_xclas = 'X'.
*   is there positive selection of packages?
    LOOP AT s_clas WHERE sign = 'I'
                     AND ( option = 'EQ' OR option = 'BT' ).
      l_xclas = 'X'.
    ENDLOOP.
  ENDIF.

* vyber podle vyvojove tridy -> tab. TADIR
  IF l_xclas = 'X'.
    SELECT * FROM tadir
    WHERE object IN ('PROG', 'FUGR')
    AND devclass IN s_clas.
      IF tadir-object = 'FUGR'.
        lt_fmprog-fugr = gt_data-fugr = tadir-obj_name.

        CONCATENATE 'SAPL' lt_fmprog-fugr INTO lt_fmprog-pname.
        APPEND lt_fmprog.

        SELECT funcname FROM enlfdir INTO gt_data-funcname
        WHERE area = gt_data-fugr.
          SELECT SINGLE include FROM tfdir INTO l_include
          WHERE funcname = gt_data-funcname.

*         sestavim jmeno includu
          CONCATENATE 'L' tadir-obj_name 'U' l_include
          INTO gt_data-name.

          IF gt_data-name IN s_name.
            SELECT SINGLE * FROM trdir
            INTO CORRESPONDING FIELDS OF gt_data
            WHERE name = gt_data-name
            AND cdat IN s_cdat.

            APPEND gt_data.
          ENDIF.
        ENDSELECT.

        CLEAR gt_data.
      ELSEIF tadir-obj_name IN s_name.
        SELECT SINGLE * FROM trdir
        INTO CORRESPONDING FIELDS OF gt_data
        WHERE name = tadir-obj_name
        AND cdat IN s_cdat.

        APPEND gt_data.
      ENDIF.
    ENDSELECT.
  ELSE.
* vyber podle uzivatele a data -> tab. TRDIR
    IF p_create = 'X' AND p_change = 'X'.
      SELECT * FROM trdir
      INTO CORRESPONDING FIELDS OF TABLE gt_data
      WHERE name IN s_name
      AND ( cnam IN s_cnam OR unam IN s_unam )
      AND cdat IN s_cdat.
    ELSEIF p_create = 'X'.
      SELECT * FROM trdir
      INTO CORRESPONDING FIELDS OF TABLE gt_data
      WHERE name IN s_name
      AND cnam IN s_cnam
      AND cdat IN s_cdat.
    ELSEIF p_change = 'X'.
      SELECT * FROM trdir
      INTO CORRESPONDING FIELDS OF TABLE gt_data
      WHERE name IN s_name
      AND unam IN s_unam
      AND cdat IN s_cdat.
    ELSE.
      SELECT * FROM trdir
      INTO CORRESPONDING FIELDS OF TABLE gt_data
      WHERE name IN s_name
      AND cdat IN s_cdat.
    ENDIF.

*   package filter for progs
    IF p_xclas = 'X' AND s_clas[] IS NOT INITIAL.
      LOOP AT gt_data WHERE name(1) <> 'L'. "progs only
        SELECT SINGLE * FROM tadir
        WHERE object = 'PROG'
        AND obj_name = gt_data-name
        AND devclass IN s_clas.

        IF sy-subrc <> 0.
          DELETE gt_data.
        ENDIF.
      ENDLOOP.
    ENDIF.

*   doplnim skutecne jmeno k funkcnim modulum
    LOOP AT gt_data WHERE name(1) = 'L'.
      l_len = STRLEN( gt_data-name ) - 2.
      l_include = gt_data-name+l_len(2).

      SUBTRACT 2 FROM l_len.
      lt_fmprog-fugr = gt_data-fugr = gt_data-name+1(l_len).

*     package filter for function groups
      IF p_xclas = 'X' AND s_clas[] IS NOT INITIAL.
        SELECT SINGLE * FROM tadir
        WHERE object = 'FUGR'
        AND obj_name = gt_data-fugr.

        IF sy-subrc = 0 AND NOT tadir-devclass IN s_clas.
          DELETE gt_data.
          CONTINUE.
        ENDIF.
      ENDIF.

      CONCATENATE 'SAPL' lt_fmprog-fugr INTO lt_fmprog-pname.
      COLLECT lt_fmprog.

      IF l_include CO '0123456789'.
        SELECT SINGLE enlfdir~funcname FROM enlfdir
        INNER JOIN tfdir ON tfdir~funcname = enlfdir~funcname
        INTO gt_data-funcname
        WHERE enlfdir~area = gt_data-fugr
        AND tfdir~include = l_include.

        MODIFY gt_data TRANSPORTING fugr funcname.
      ELSE.
        MODIFY gt_data TRANSPORTING fugr.
      ENDIF.
    ENDLOOP.
  ENDIF.

* dohledam nazvy includu ve funkcnich grupach
  CLEAR gt_data.
  LOOP AT lt_fmprog.
    PERFORM get_fugr_includes USING lt_fmprog-pname lt_fmprog-fugr.
  ENDLOOP.

* odmazani programu, ktere nevyhovuji vyberovym kriteriim
  DELETE gt_data WHERE NOT name IN s_name.

  IF p_create = 'X' AND p_change = 'X'.
    DELETE gt_data WHERE NOT cnam IN s_cnam
                     AND NOT unam IN s_unam.
  ELSEIF p_create = 'X'.
    DELETE gt_data WHERE NOT cnam IN s_cnam.
  ELSEIF p_change = 'X'.
    DELETE gt_data WHERE NOT unam IN s_unam.
  ENDIF.

  IF gt_data[] IS INITIAL.
    MESSAGE s000(xt) WITH 'No program meet selection criteria'.
    EXIT.
  ENDIF.

  SORT gt_data BY name.
  DELETE ADJACENT DUPLICATES FROM gt_data COMPARING name.
ENDFORM.                    "get_data

*---------------------------------------------------------------------*
*       FORM get_fugr_includes                                        *
*---------------------------------------------------------------------*
FORM get_fugr_includes USING p_pname p_fugr.
  DATA: lt_rep TYPE gty_rep_tab WITH HEADER LINE,
        l_prog(100) TYPE c,
        l_rest(50) TYPE c.

  PERFORM read_report TABLES lt_rep USING p_pname.

  LOOP AT lt_rep WHERE line(1) <> '*'
                   AND NOT LINE IS INITIAL.
    SPLIT lt_rep-line AT '.' INTO l_prog l_rest.
    TRANSLATE l_prog TO UPPER CASE.
    REPLACE 'INCLUDE' WITH '' INTO l_prog.
    CONDENSE l_prog NO-GAPS.

    IF l_prog IN s_name.
      gt_data-name = l_prog.
      gt_data-fugr = p_fugr.

      SELECT SINGLE * FROM trdir
      INTO CORRESPONDING FIELDS OF gt_data
      WHERE name = gt_data-name.

      IF sy-subrc = 0.
        COLLECT gt_data.
      ENDIF.
    ENDIF.
  ENDLOOP.
ENDFORM.                    "get_fugr_includes

*&---------------------------------------------------------------------*
*&      Form  read_report
*&---------------------------------------------------------------------*
FORM read_report TABLES pt_rep TYPE gty_rep_tab
                 USING p_pname TYPE c.
  DATA: lcx_root TYPE REF TO cx_root.

  FREE pt_rep[].

  TRY.
      READ REPORT p_pname INTO pt_rep.
    CATCH cx_sy_read_src_line_too_long INTO lcx_root.
      WRITE: / 'Failed reading program', p_pname,
       '(source code line is too long)'.
  ENDTRY.
ENDFORM.                    "read_report

*---------------------------------------------------------------------*
*       FORM export_programs                                          *
*---------------------------------------------------------------------*
FORM export_programs.
  DATA: ls_rep TYPE gty_rep,
        lt_rep TYPE gty_rep_tab,
        l_fname TYPE string,
        l_name LIKE trdir-name,
        l_ptype(80) TYPE c,
        l_len TYPE i,
        l_cnt TYPE i.

  l_len = STRLEN( p_path ).
  SUBTRACT 1 FROM l_len.
  IF p_path+l_len(1) <> '\'.
    ADD 1 TO l_len.
    p_path+l_len(1) = '\'.
  ENDIF.

  SORT gt_data BY cnam.

  LOOP AT gt_data.
    FREE lt_rep[].

    IF gt_data-funcname IS INITIAL.
      l_name = gt_data-name.
    ELSE.
*     pouziji skutecne jmeno funkce, pokud je k dispozici
      l_name = gt_data-funcname.
    ENDIF.

    IF gt_data-name(1) = 'L'.
      l_ptype = 'FUNC'.

      IF NOT gt_data-fugr IS INITIAL.
        CONCATENATE l_ptype '\' gt_data-fugr
        INTO l_ptype.
      ENDIF.
    ELSE.
      l_ptype = 'PROG'.
    ENDIF.

    PERFORM read_report TABLES lt_rep USING gt_data-name.
    IF lt_rep[] IS NOT INITIAL.
      IF p_prefix = 'X'.
        CONCATENATE p_path gt_data-cnam '\' l_ptype '\'
         gt_data-cdat '_' l_name '.abp' INTO l_fname.
      ELSE.
        CONCATENATE p_path gt_data-cnam '\' l_ptype '\'
         l_name '.abp' INTO l_fname.
      ENDIF.

      CALL METHOD cl_gui_frontend_services=>gui_download
        EXPORTING
          filename                = l_fname
          filetype                = 'ASC'
          append                  = ' '
        CHANGING
          data_tab                = lt_rep
        EXCEPTIONS
          file_write_error        = 1
          no_batch                = 2
          gui_refuse_filetransfer = 3
          invalid_type            = 4
          no_authority            = 5
          unknown_error           = 6
          header_not_allowed      = 7
          separator_not_allowed   = 8
          filesize_not_allowed    = 9
          header_too_long         = 10
          dp_error_create         = 11
          dp_error_send           = 12
          dp_error_write          = 13
          unknown_dp_error        = 14
          access_denied           = 15
          dp_out_of_memory        = 16
          disk_full               = 17
          dp_timeout              = 18
          file_not_found          = 19
          dataprovider_exception  = 20
          control_flush_error     = 21
          OTHERS                  = 24.

      IF sy-subrc = 0.
        ADD 1 TO l_cnt.
      ENDIF.
    ENDIF.
  ENDLOOP.

  IF l_cnt = 0.
    MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  ELSE.
    MESSAGE s000(xt) WITH l_cnt 'program(s) exported successfully'.
  ENDIF.
ENDFORM.                    "export_programs

*&---------------------------------------------------------------------*
*&      Form  f4_folder
*&---------------------------------------------------------------------*
FORM f4_folder CHANGING p_path TYPE c.
  DATA: l_folder TYPE string,
        l_title TYPE string.

  l_folder = p_path.
  l_title = 'Choose folder'(fld).

  CALL METHOD cl_gui_frontend_services=>directory_browse
    EXPORTING
      window_title    = l_title
      initial_folder  = l_folder
    CHANGING
      selected_folder = l_folder.

  p_path = l_folder.
  PERFORM add_back_slash CHANGING p_path.
ENDFORM.                                                    "f4_folder

*&---------------------------------------------------------------------*
*&      Form  add_back_slash
*&---------------------------------------------------------------------*
FORM add_back_slash CHANGING pc_file TYPE c.
  CONSTANTS lc_bslash TYPE c VALUE '\'.
  DATA l_len TYPE i.

  CHECK NOT pc_file IS INITIAL.

  l_len = STRLEN( pc_file ) - 1.
  IF pc_file+l_len(1) <> lc_bslash.
    CONCATENATE pc_file lc_bslash INTO pc_file.
  ENDIF.
ENDFORM.                    "add_back_slash

*Text elements
*----------------------------------------------------------
* 001 Selection Criteria
* 010 Package (Dev. class)
* 011 Created by
* 012 Changed by


*Selection texts
*----------------------------------------------------------
* P_CHANGE         Changed by
* P_CREATE         Created by
* P_PATH         Output folder
* P_PREFIX         Add date creation prefix
* P_XCLAS         Package (Dev. class)
* S_CDAT D       .
* S_CLAS D       .
* S_CNAM D       .
* S_NAME D       .
* S_UNAM D       .


*Messages
*----------------------------------------------------------
*
* Message class: XT
*000   &1 &2 &3 &4