*&---------------------------------------------------------------------*
*& Report  YDKFMTEST_TOOL
*&
*&---------------------------------------------------------------------*
*&
*&
*&---------------------------------------------------------------------*

REPORT  ydkfmtest_tool.

TABLES: sscrfields.

TYPE-POOLS: abap.

SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(40) coment.
SELECTION-SCREEN END   OF LINE.

PARAMETERS: funcname TYPE tfdir-funcname  OBLIGATORY MEMORY ID lib.
PARAMETERS: pdebug AS CHECKBOX.

SELECTION-SCREEN SKIP.
PARAMETERS: pdfmtout RADIOBUTTON GROUP fmt DEFAULT 'X'.
PARAMETERS: pdecsep TYPE c.

SELECTION-SCREEN SKIP.
PARAMETERS: pdfmtint RADIOBUTTON GROUP fmt.

SELECTION-SCREEN FUNCTION KEY: 1.

DATA: BEGIN OF itclip OCCURS 0,
        txt TYPE c LENGTH 1024,
      END   OF itclip.

DATA: itfp TYPE STANDARD TABLE OF fupararef WITH HEADER LINE.

DATA: BEGIN OF itd OCCURS 0,
        parameter TYPE fupararef-parameter,
        d TYPE REF TO data,
      END   OF itd.
FIELD-SYMBOLS <d> LIKE LINE OF itd.

DATA: err TYPE string.

DEFINE break.
  if pdebug = 'X'.
    break-point.
  endif.
END-OF-DEFINITION.

INITIALIZATION.
  DATA: p TYPE p LENGTH 2 DECIMALS 1 VALUE '0.1'.
  DATA: c TYPE c LENGTH 3.
  WRITE p TO c LEFT-JUSTIFIED.
  FIELD-SYMBOLS <fs>.

  pdecsep = c+1(1).

  sscrfields-functxt_01 = 'Скопировать структуру в буфер обмена'.

  LOOP AT SCREEN.
    CHECK screen-input = 0 AND screen-name CA '%'.
    ASSIGN (screen-name) TO <fs>.
    IF screen-name CS 'FUNCNAME'.
      <fs> = 'Функциональный модуль'.
    ENDIF.
    IF screen-name CS 'PDEBUG'.
      <fs> = 'Отладка'.
    ENDIF.
    IF screen-name CS 'PDECSEP'.
      <fs> = 'Разделитель дробной части числ'.
    ENDIF.
    IF screen-name CS 'PDFMTINT'.
      <fs> = 'Данные подаются во внутр. форм'.
    ENDIF.
    IF screen-name CS 'PDFMTOUT'.
      <fs> = 'Данные подаются во внешн. форм'.
    ENDIF.
  ENDLOOP.

  coment = 'Данные загружаются через буфер обмена'.

AT SELECTION-SCREEN.
  CASE sscrfields-ucomm.
    WHEN 'FC01'.
      PERFORM get_datastruct.
  ENDCASE.

START-OF-SELECTION.
  PERFORM get_data.
  CHECK err IS INITIAL.
  PERFORM call_function.


*&---------------------------------------------------------------------*
*&      Form  get_data
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM get_data.
  DATA: fld  TYPE string.
  DATA: val  TYPE string.
  DATA: tail TYPE string.

  DATA: len TYPE i.

  DATA: ittf TYPE TABLE OF string WITH HEADER LINE.
  DATA: ittv TYPE TABLE OF string WITH HEADER LINE.

  FIELD-SYMBOLS <tab> TYPE STANDARD TABLE.
  FIELD-SYMBOLS <wa>.

  FIELD-SYMBOLS <fs>.

  CLEAR err.

  CALL METHOD cl_gui_frontend_services=>clipboard_import
    IMPORTING
      data                 = itclip[]
    EXCEPTIONS
      cntl_error           = 1
      error_no_gui         = 2
      not_supported_by_gui = 3
      OTHERS               = 4.

  CHECK NOT itclip[] IS INITIAL.

  SELECT * INTO TABLE itfp
    FROM fupararef
   WHERE funcname = funcname
     AND r3state  = 'A'.

  DELETE itfp WHERE paramtype NA 'EITC'.

  LOOP AT itclip.
    SPLIT itclip-txt AT cl_abap_char_utilities=>horizontal_tab INTO fld val.

    TRANSLATE fld TO UPPER CASE.
    CONDENSE fld NO-GAPS.

    IF fld CS 'TAB@'.
      REFRESH ittf.

      SHIFT fld BY 4 PLACES.
      CONDENSE fld NO-GAPS.

      READ TABLE itfp WITH KEY parameter = fld paramtype = 'T'.
      IF sy-subrc <> 0.
        CONCATENATE 'Табличный параметр' fld 'в интерфейсе ФМ отсутствует' INTO err SEPARATED BY space.
        EXIT.
      ENDIF.

      READ TABLE itd ASSIGNING <d> WITH KEY parameter = itfp-parameter.
      IF sy-subrc <> 0.
        APPEND INITIAL LINE TO itd ASSIGNING <d>.
        <d>-parameter = itfp-parameter.

        CREATE DATA <d>-d TYPE STANDARD TABLE OF (itfp-structure).
      ENDIF.

      ASSIGN <d>-d->* TO <tab>.

      TRANSLATE val TO UPPER CASE.
      CONDENSE val NO-GAPS.
      SPLIT val AT cl_abap_char_utilities=>horizontal_tab INTO TABLE ittf.
      DELETE ittf WHERE table_line IS INITIAL.
      DELETE ittf WHERE table_line CO space.
    ELSEIF fld = '@ROW'.
      IF ittf[] IS INITIAL.
        err = 'Перед строкой @ROW должна быть строка TAB@<имя табличного параметра>'.
        EXIT.
      ENDIF.

      APPEND INITIAL LINE TO <tab> ASSIGNING <wa>.
      SPLIT val AT cl_abap_char_utilities=>horizontal_tab INTO TABLE ittv.

      LOOP AT ittf.
        READ TABLE ittv INDEX sy-tabix.
        CHECK sy-subrc = 0.

        ASSIGN COMPONENT ittf OF STRUCTURE <wa> TO <fs>.
        IF sy-subrc <> 0.
          CONCATENATE 'Поле' ittf 'в таблице' <d>-parameter 'отсутствует' INTO err SEPARATED BY space.
          EXIT.
        ENDIF.

        PERFORM set_val USING <fs> ittv.
      ENDLOOP.

      IF NOT err IS INITIAL.
        EXIT.
      ENDIF.
    ELSEIF fld CS 'STRUCT@'.
      REFRESH ittf.

      SHIFT fld BY 7 PLACES.
      CONDENSE fld NO-GAPS.

      READ TABLE itfp WITH KEY parameter = fld.
      IF sy-subrc <> 0.
        CONCATENATE 'Параметр' fld 'в интерфейсе ФМ отсутствует' INTO err SEPARATED BY space.
        EXIT.
      ENDIF.

      APPEND INITIAL LINE TO itd ASSIGNING <d>.
      <d>-parameter = itfp-parameter.

      CREATE DATA <d>-d TYPE (itfp-structure).

      ASSIGN <d>-d->* TO <wa>.

      TRANSLATE val TO UPPER CASE.
      CONDENSE val NO-GAPS.
      SPLIT val AT cl_abap_char_utilities=>horizontal_tab INTO TABLE ittf.
    ELSEIF fld = '@DATA'.
      IF ittf[] IS INITIAL.
        err = 'Перед строкой @DATA должна быть строка STRUCT@<имя параметра>'.
        EXIT.
      ENDIF.

      SPLIT val AT cl_abap_char_utilities=>horizontal_tab INTO TABLE ittv.

      LOOP AT ittf.
        READ TABLE ittv INDEX sy-tabix.
        CHECK sy-subrc = 0.

        ASSIGN COMPONENT ittf OF STRUCTURE <wa> TO <fs>.
        IF sy-subrc <> 0.
          CONCATENATE 'Поле' ittf 'в структуре' <d>-parameter 'отсутствует' INTO err SEPARATED BY space.
          EXIT.
        ENDIF.

        PERFORM set_val USING <fs> ittv.
      ENDLOOP.

      IF NOT err IS INITIAL.
        EXIT.
      ENDIF.
    ELSE.
      REFRESH ittf.

      READ TABLE itfp WITH KEY parameter = fld.
      IF sy-subrc <> 0.
        CONCATENATE 'Параметр' fld 'в интерфейсе ФМ отсутствует' INTO err SEPARATED BY space.
        EXIT.
      ENDIF.

      CASE itfp-structure.
        WHEN 'C' OR 'N'. len = 255.
        WHEN 'P'. len = 16.
      ENDCASE.

      APPEND INITIAL LINE TO itd ASSIGNING <d>.
      <d>-parameter = itfp-parameter.

      IF len IS INITIAL.
        CREATE DATA <d>-d TYPE (itfp-structure).
      ELSE.
        CREATE DATA <d>-d TYPE (itfp-structure) LENGTH len.
      ENDIF.

      ASSIGN <d>-d->* TO <fs>.

      SPLIT val AT cl_abap_char_utilities=>horizontal_tab INTO val tail.
      PERFORM set_val USING <fs> val.
    ENDIF.
  ENDLOOP.

  IF itd[] IS INITIAL.
    err = 'Ни один параметр ФМ не заполнен'.
  ENDIF.

  LOOP AT itfp WHERE optional IS INITIAL AND paramtype NA 'ECT'.
    READ TABLE itd ASSIGNING <d> WITH KEY parameter = itfp-parameter.
    IF sy-subrc <> 0.
      CONCATENATE 'Не заполнен обязательный параметр' itfp-parameter INTO err SEPARATED BY space.
      EXIT.
    ENDIF.

    ASSIGN <d>-d->* TO <fs>.
    IF <fs> IS INITIAL.
      CONCATENATE 'В обязательный параметр' itfp-parameter 'передаётся пустое значение' INTO err SEPARATED BY space.
      EXIT.
    ENDIF.
  ENDLOOP.

  IF NOT err IS INITIAL.
    WRITE: / 'Ошибка', err.
    EXIT.
  ENDIF.

  LOOP AT itfp.
    READ TABLE itd WITH KEY parameter = itfp-parameter TRANSPORTING NO FIELDS.
    CHECK sy-subrc <> 0.

    APPEND INITIAL LINE TO itd ASSIGNING <d>.

    <d>-parameter = itfp-parameter.

    IF itfp-paramtype = 'T'.
      CREATE DATA <d>-d TYPE STANDARD TABLE OF (itfp-structure).
    ELSE.
      CASE itfp-structure.
        WHEN 'C' OR 'N'. len = 255.
        WHEN 'P'. len = 16.
      ENDCASE.

      IF len IS INITIAL.
        CREATE DATA <d>-d TYPE (itfp-structure).
      ELSE.
        CREATE DATA <d>-d TYPE (itfp-structure) LENGTH len.
      ENDIF.
    ENDIF.
  ENDLOOP.
ENDFORM.                    "get_data

*&---------------------------------------------------------------------*
*&      Form  set_val
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->FS         text
*      -->VAL        text
*----------------------------------------------------------------------*
FORM set_val USING fs val.
  DATA: mask TYPE c LENGTH 7.
  DATA: cfm TYPE c LENGTH 30.
  DATA: typ TYPE c.
  DATA: str TYPE string.

  IF val IS INITIAL.
    CLEAR fs.
    EXIT.
  ENDIF.

  IF pdfmtint = 'X'.
    fs = val.
    EXIT.
  ENDIF.

  DESCRIBE FIELD fs EDIT MASK mask.
  IF mask(2) = '=='.
    CONCATENATE 'CONVERSION_EXIT_' mask+2 '_INPUT' INTO cfm.
    CALL FUNCTION cfm
      EXPORTING
        input  = val
      IMPORTING
        output = fs.
  ELSE.
    DESCRIBE FIELD fs TYPE typ.
    CASE typ.
      WHEN 'D'.
        CALL FUNCTION 'CONVERSION_EXIT_PDATE_INPUT'
          EXPORTING
            input  = val
          IMPORTING
            output = fs.
      WHEN 'I' OR 'P' OR 'F'.
        CONCATENATE pdecsep '|' INTO str.
        TRANSLATE val USING str.
        TRANSLATE val USING ', . '.
        CONDENSE val NO-GAPS.
        TRANSLATE val USING '|.'.
        fs = val.
      WHEN OTHERS.
        fs = val.
    ENDCASE.
  ENDIF.
ENDFORM.                    "set_val

*&---------------------------------------------------------------------*
*&      Form  call_function
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM call_function.
  DATA: ptab TYPE abap_func_parmbind_tab.
  DATA: ptab_wa TYPE abap_func_parmbind.
  DATA: etab TYPE abap_func_excpbind_tab.
  DATA: etab_wa TYPE abap_func_excpbind.

  LOOP AT itd ASSIGNING <d>.
    READ TABLE itfp WITH KEY parameter = <d>-parameter.

    CLEAR ptab_wa.

    CASE itfp-paramtype.
      WHEN 'I'. ptab_wa-kind = abap_func_exporting.
      WHEN 'E'. ptab_wa-kind = abap_func_importing.
      WHEN 'T'. ptab_wa-kind = abap_func_tables.
      WHEN 'C'. ptab_wa-kind = abap_func_changing.
      WHEN OTHERS.
        CONTINUE.
    ENDCASE.

    ptab_wa-name  = <d>-parameter.
    ptab_wa-value = <d>-d.

    INSERT ptab_wa INTO TABLE ptab.
  ENDLOOP.

  etab_wa-name = 'OTHERS'.
  etab_wa-value = 10.
  INSERT etab_wa INTO TABLE etab.

  break.

  CALL FUNCTION funcname
    PARAMETER-TABLE
      ptab
    EXCEPTION-TABLE
      etab.

  break.
ENDFORM.                    "call_function

*&---------------------------------------------------------------------*
*&      Form  get_datastruct
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM get_datastruct.
  DATA: tab_descr TYPE REF TO cl_abap_structdescr.
  DATA: data_descr TYPE REF TO cl_abap_datadescr.
  DATA: comp_wa TYPE abap_compdescr.
  DATA: rc TYPE i.
  FIELD-SYMBOLS <fp> LIKE LINE OF itfp.

  REFRESH itclip.

  SELECT * INTO TABLE itfp
    FROM fupararef
   WHERE funcname = funcname
     AND r3state  = 'A'.

  DELETE itfp WHERE paramtype NA 'EITC'.

  LOOP AT itfp ASSIGNING <fp>.
    CASE <fp>-paramtype.
      WHEN 'E'. <fp>-paramtype = '2'.
      WHEN 'I'. <fp>-paramtype = '1'.
      WHEN 'T'. <fp>-paramtype = '4'.
      WHEN 'C'. <fp>-paramtype = '3'.
    ENDCASE.
  ENDLOOP.

  SORT itfp BY paramtype pposition parameter.

  LOOP AT itfp.
    IF itfp-paramtype = '4'.
      CONCATENATE 'TAB@' itfp-parameter INTO itclip.

      tab_descr ?= cl_abap_typedescr=>describe_by_name( itfp-structure ).
      LOOP AT tab_descr->components INTO comp_wa.
        CONCATENATE itclip cl_abap_char_utilities=>horizontal_tab comp_wa-name INTO itclip.
      ENDLOOP.
      APPEND itclip.
      CLEAR itclip.
      APPEND '@ROW' TO itclip.

      CONTINUE.
    ENDIF.

    IF STRLEN( itfp-structure ) = 1 AND itfp-structure CA 'CNIPFDTX'.
      APPEND itfp-parameter TO itclip.
      CONTINUE.
    ENDIF.

    data_descr ?= cl_abap_typedescr=>describe_by_name( itfp-structure ).
    IF data_descr->kind =  cl_abap_datadescr=>kind_struct.

      tab_descr ?= cl_abap_typedescr=>describe_by_name( itfp-structure ).
      IF LINES( tab_descr->components[] ) > 1.
        CONCATENATE 'STRUCT@' itfp-parameter INTO itclip.
        LOOP AT tab_descr->components INTO comp_wa.
          CONCATENATE itclip cl_abap_char_utilities=>horizontal_tab comp_wa-name INTO itclip.
        ENDLOOP.
        APPEND itclip.
        CLEAR itclip.
        APPEND '@DATA' TO itclip.

        CONTINUE.
      ENDIF.
    ENDIF.

    APPEND itfp-parameter TO itclip.
  ENDLOOP.

  CALL METHOD cl_gui_frontend_services=>clipboard_export
    IMPORTING
      data                 = itclip[]
    CHANGING
      rc                   = rc
    EXCEPTIONS
      cntl_error           = 1
      error_no_gui         = 2
      not_supported_by_gui = 3
      no_authority         = 4
      OTHERS               = 5.

  IF sy-subrc = 0 AND rc = 0.
    MESSAGE 'Структура скопирована в буфер обмена' TYPE 'I'.
  ELSE.
    MESSAGE 'Ошибка при копировании структуры в буфер обмена' TYPE 'E'.
  ENDIF.
ENDFORM.                    "get_datastruct