SAP R/3 форум ABAP консультантов
Russian ABAP Developer's Club

Home - FAQ - Search - Memberlist - Usergroups - Profile - Log in to check your private messages - Register - Log in - English
Blogs - Weblogs News

Transport creation from local file



 
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> Transport and Upgrade | Транспорт и Обновления
View previous topic :: View next topic  
Author Message
admin
Администратор
Администратор



Joined: 01 Sep 2007
Posts: 1640
PostPosted: Mon Nov 17, 2008 11:16 pm    Post subject: Transport creation from local file Reply with quote
Code:
*
* DANGER WARNING
* ABSOLUTELY NO WARRANTY
* USE AT OWN RISK
* COPYRIGHT DR. MARTIN ROGGE
* UNAUTHORISED USE PROHIBITED
*
report zpttmxtr_up message-id rp line-size 80.

tables: dd02l, dd03l.

data: e071   like e071  occurs 100 with header line.
data: e071k  like e071k occurs 100 with header line.

*---------------------------------------------------------------------*
constants: datalength type i value 72.

data: begin of file occurs 10,
        key(4),
        data(datalength),
      end of file.

data: begin of worklist occurs 10,
        tab     like dd02l-tabname,
        clidep  like dd02l-clidep,
        mandt   like dd03l-fieldname,
        keylen  type i,
        len     type i,
        selfrom type i,
        selto   type i,
        datfrom type i,
        datto   type i,
        recno   type i,
        format  type i,
      end of worklist.

data: begin of errorlist occurs 10,
        tab      like dd02l-tabname,
        line     type i,
        text(20) type c,
      end of errorlist.

define error.
  move worklist-tab to errorlist-tab.
  move sy-tabix to errorlist-line.
  move &1 to errorlist-text.
  append errorlist.
end-of-definition.

data: begin of errorlist2 occurs 10,
        tab      like dd02l-tabname,
        line     type i,
        text(20) type c,
      end of errorlist2.

define error2.
  move worklist-tab to errorlist2-tab.
  move sy-tabix to errorlist2-line.
  move &1 to errorlist2-text.
  append errorlist2.
end-of-definition.

data: begin of collision occurs 10,
        tabname     like dd02l-tabname,
        recno_db    type i,
        recno_file  type i,
        same_key    type i,
        same_entry  type i,
      end of collision.

data: intensified(1).

data: subrc type i.

*---------------------------------------------------------------------*
selection-screen: begin of block copy with frame title text-p01.
parameters:     srcmandt like t000-mandt.
selection-screen: end of block copy.

selection-screen: begin of block import with frame title text-p02.
parameters:     filename like rlgrap-filename
                         default 'C:\SAPGUI\SAPTABLE.TXT'.
selection-screen: end of block import.

selection-screen: begin of block action with frame title text-p07.
parameters:     trkorr  like e070-trkorr default 'SIMULATION'.
selection-screen: end of block action.

selection-screen: begin of block error with frame title text-p06.
parameters:     p_rel  as checkbox default ' '.
parameters:     p_len  as checkbox default ' '.
selection-screen: end of block error.

selection-screen: begin of block security with frame title text-p04.
parameters:     p_test  as checkbox default 'X'.
parameters:     passwdu  like sy-uname,
                passwds  like sy-uname.
selection-screen: end of block security.

selection-screen: comment /1(80) text-p05.

*---------------------------------------------------------------------*
end-of-selection.
  if ( passwdu  ne sy-uname ) or
     ( passwds  ne 'SECRET' ).
    message e016 with 'Access' 'denied' space space.
    exit.
  endif.
  if trkorr eq 'SIMULATION'.
    move 'X' to p_test.
  endif.
*
  perform upload.
  check sy-subrc eq 0.
  perform parse_file.
  perform process_worklist using subrc.
  if p_test is initial.
    set pf-status 'MAIN'.
  else.
    set pf-status 'MAIN' excluding 'ACT'.
  endif.
  perform protocol.


*---------------------------------------------------------------------*
at user-command.
  case sy-ucomm.
    when 'FIL'.
      set pf-status space.
      perform print_file.
    when 'SRC'.
      set pf-status space.
      perform print_transport.
    when 'ACT'.
      set pf-status 'MAIN' excluding 'ACT' immediately.
      perform commit_transport.
  endcase.

*---------------------------------------------------------------------*
*       FORM PARSE_FILE                                               *
*---------------------------------------------------------------------*
  constants: nil type i value 0,
             tab type i value 1,
             rel type i value 2,
             len type i value 3,
             cod type i value 4,
             sel type i value 5,
             dat type i value 6,
             nex type i value 7,
             err type i value 8.

  constants: hex  type i value 1100,
             hex2 type i value 1200,
             fix  type i value 2100,
             fixh type i value 2200,
             fixr type i value 2300,
             var  type i value 3100,
             var2 type i value 3200,
             var3 type i value 3300,
             raw  type i value 4100.

form parse_file.
  data: state type i.
  data: length    type i,
        keylength type i.

  refresh worklist.
  refresh errorlist.
  move nil to state.
  loop at file.
    case state.
      when nil.
        case file-key.
          when 'TAB'.
            move tab to state.
        endcase.
      when tab.
        case file-key.
          when 'TAB'.
            error 'unexpected end'.
            move tab to state.
          when 'REL'.
            if ( not p_rel is initial ) or ( file-data eq sy-saprl ).
              move rel to state.
            else.
              error 'wrong release'.
              move nil to state.
            endif.
          when others.
            error 'syntax error'.
            move nil to state.
        endcase.
      when rel.
        case file-key.
          when 'TAB'.
            error 'unexpected end'.
            move tab to state.
          when 'LEN'.
            move file-data to length.
            if ( not p_len is initial ) or ( length eq worklist-len ).
              if length lt worklist-len.
                move length to worklist-len.
              endif.
              move len to state.
            else.
              error 'wrong table length'.
              move nil to state.
            endif.
          when others.
            error 'syntax error'.
            move nil to state.
        endcase.
      when len.
        case file-key.
          when 'TAB'.
            error 'unexpected end'.
            move tab to state.
          when 'COD'.
            case file-data.
              when 'HEX'.
                move hex to worklist-format.
                move cod to state.
              when 'FIX'.
                move fix to worklist-format.
                move cod to state.
              when 'VAR'.
                move var to worklist-format.
                move cod to state.
              when 'RAW'.
                move raw to worklist-format.
                move cod to state.
              when others.
                error 'unknown encoding'.
                move nil to state.
            endcase.
          when others.
            error 'syntax error'.
            move nil to state.
        endcase.
      when cod.
        case file-key.
          when 'TAB'.
            append worklist.
            move tab to state.
          when 'SEL'.
            move sy-tabix to worklist-selfrom.
            move sy-tabix to worklist-selto.
            move sel to state.
          when 'DAT'.
            move sy-tabix to worklist-datfrom.
            move sy-tabix to worklist-datto.
            move 1 to worklist-recno.
            move dat to state.
          when others.
            error 'syntax error'.
            move nil to state.
        endcase.
      when sel.
        case file-key.
          when 'TAB'.
            append worklist.
            move tab to state.
          when 'SEL'.
            move sy-tabix to worklist-selto.
          when 'DAT'.
            move sy-tabix to worklist-datfrom.
            move sy-tabix to worklist-datto.
            move 1 to worklist-recno.
            move dat to state.
          when others.
            error 'syntax error'.
            move nil to state.
        endcase.
      when dat.
        case file-key.
          when 'TAB'.
            append worklist.
            move tab to state.
          when 'DAT'.
            move sy-tabix to worklist-datto.
            add 1 to worklist-recno.
          when 'NEX'.
            move sy-tabix to worklist-datto.
          when others.
            error 'syntax error'.
            move nil to state.
        endcase.
    endcase.
*   beginning of table block
    check state eq tab.
    clear worklist.
    move file-data to worklist-tab.
*   find table in DDIC
    select single * from dd02l where tabname  eq worklist-tab
                                 and as4local eq 'A'.
    if sy-subrc ne 0.
      error 'not found in DDIC'.
      move nil to state.
      continue.
    endif.
    move dd02l-clidep to worklist-clidep.
*   check assumptions on client field (if applicable)
    if not worklist-clidep is initial.
      select single * from dd03l where tabname  eq worklist-tab
                                   and as4local eq 'A'
                                   and rollname eq 'MANDT'.
      if ( sy-subrc ne 0 )
      or ( dd03l-position ne 1 )
      or ( dd03l-intlen ne 3 ).
        error 'bad client field'.
        move nil to state.
        continue.
      endif.
      move dd03l-fieldname to worklist-mandt.
    endif.
*   determine internal length of work area and key
    perform getlength using worklist-tab length keylength.
    if length le 0.
      error 'nametab error'.
      move nil to state.
      continue.
    endif.
    move keylength to worklist-keylen.
    move length to worklist-len.
  endloop.
* last record still in process?
  check ( state eq cod )
     or ( state eq sel )
     or ( state eq dat ).
  append worklist.
endform.

*---------------------------------------------------------------------*
*       FORM PROCESS_WORKLIST                                         *
*---------------------------------------------------------------------*
define putbyte.
  if pointer lt worklist-keylen.
    move &1 to tabkey+pointer(1).
  endif.
  add 1 to pointer.
end-of-definition.

form process_worklist using $subrc type i.
  data: state type i.
  data: convstate type i.
  data: pointer type i.
  data: begin of conv,
          x(1) type x,
        end of conv.
  data: buffer(2) type c.

  data: tabkey like e071k-tabkey.

  loop at worklist.
    move 0 to $subrc.
    check worklist-recno gt 0.
    pointer = 0.
    move space to tabkey.
    move nil to state.
    loop at file from worklist-datfrom to worklist-datto.
      case state.
        when nil.
          if pointer ne 0.
            error2 'incomplete data'.
            move err to state.
            exit.
          endif.
          case file-key.
            when 'DAT'.
              move dat to state.
              move worklist-format to convstate.
            when others.
              error2 'syntax error'.
              move err to state.
              exit.
          endcase.
        when dat.
          case file-key.
            when 'DAT'.
            when 'NEX'.
              move nex to state.
            when others.
              error2 'syntax error'.
              move err to state.
              exit.
          endcase.
        when nex.
          case file-key.
            when 'DAT'.
              error2 'incomplete record'.
              move err to state.
              exit.
            when 'NEX'.
            when others.
              error2 'syntax error'.
              move err to state.
              exit.
          endcase.
      endcase.
      do datalength times.
*       no check on data format currently
        case convstate.
          when hex.
            move file-data(1) to buffer(1).
            move hex2 to convstate.
          when hex2.
            move file-data(1) to buffer+1(1).
            move buffer to conv-x.
            putbyte conv.
            move hex to convstate.
          when fix.
            if file-data(1) eq '.'.
              move fixr to convstate.
            else.
              move file-data(1) to buffer(1).
              move fixh to convstate.
            endif.
          when fixh.
            move file-data(1) to buffer+1(1).
            move buffer to conv-x.
            putbyte conv.
            move fix to convstate.
          when fixr.
            putbyte file-data(1).
            move fix to convstate.
          when var.
            if file-data(1) eq '^'.
              move var2 to convstate.
            else.
              putbyte file-data(1).
            endif.
          when var2.
            move file-data(1) to buffer(1).
            move var3 to convstate.
          when var3.
            move file-data(1) to buffer+1(1).
            move buffer to conv-x.
            putbyte conv.
            move var to convstate.
          when raw.
            putbyte file-data(1).
        endcase.
        shift file-data left by 1 places.
        check pointer ge worklist-len.     "otherwise continue
*       adjust client (if applicable)
        if ( not worklist-clidep is initial ) and
           ( not srcmandt is initial ).
           move srcmandt(3) to tabkey(3).
        endif.
        perform add_tabu_to_transport using worklist-tab tabkey.
        pointer = 0.
        move space to tabkey.
        if convstate ne worklist-format.
          error2 'incomplete data'.
          move err to state.
        else.
          move nil to state.
        endif.
        exit.
      enddo.
      check state eq err.                  "otherwise continue
      move 4 to $subrc.
      exit.
    endloop.
  endloop.
endform.

*---------------------------------------------------------------------*
*       FORM PROTOCOL                                                 *
*---------------------------------------------------------------------*
form protocol.
  data: tabno type i.

  format reset.
  describe table errorlist lines tabno.
  if tabno gt 0.
    write: /(76) 'Tables parsed with errors'(013)
                 color col_negative intensified.
    loop at errorlist.
      write: /(20) errorlist-tab, 24(6) errorlist-line,
                40 errorlist-text.
    endloop.
    skip.
  endif.
  describe table worklist lines tabno.
  if tabno gt 0.
    write: /(76) 'Tables parsed with OK'(014)
                 color col_positive intensified.
    loop at worklist.
      write: /(20) worklist-tab,     22(1) worklist-clidep,
             24(6) worklist-keylen,  32(6) worklist-len,
             40(6) worklist-selfrom, 48(6) worklist-selto,
             56(6) worklist-datfrom, 64(6) worklist-datto,
             72(6) worklist-recno.
    endloop.
  endif.
  skip 2.
  format reset.
  describe table errorlist2 lines tabno.
  if tabno gt 0.
    write: /(76) 'Tables with errors during second phase'(015)
                 color col_negative intensified.
    loop at errorlist2.
      write: /(20) errorlist2-tab, 24(6) errorlist2-line,
                40 errorlist2-text.
    endloop.
  else.
    write: / 'No errors in second phase.'(016)
             color col_positive intensified.
  endif.
endform.

*---------------------------------------------------------------------*
*       FORM PRINT_FILE                                               *
*---------------------------------------------------------------------*
define set_colour.
  if intensified is initial.
    format color col_normal intensified on.
    move 'X' to intensified.
  else.
    format color col_normal intensified off.
    clear intensified.
  endif.
end-of-definition.

form print_file.
  format color col_heading intensified.
  write: /(76) 'Contents of download file'(012).
  loop at file.
    case file-key.
      when 'TAB'.
        clear intensified.
        format color col_total intensified on.
      when 'REL'.
        clear intensified.
        format color col_total intensified off.
      when 'LEN'.
        clear intensified.
        format color col_total intensified off.
      when 'COD'.
        clear intensified.
        format color col_total intensified off.
      when 'SEL'.
        clear intensified.
        format color col_total intensified off.
      when 'DAT'.
        set_colour.
      when 'NEX'.
    endcase.
    write: / file(76).
  endloop.
  format reset.
endform.

*---------------------------------------------------------------------*
*       FORM PRINT_TRANSPORT                                          *
*---------------------------------------------------------------------*
form print_transport.
  format color col_heading intensified.
  write: /(76) 'Transport tables and keys'.
  loop at e071k.
    at new objname.
      clear intensified.
      format color col_total intensified on.
      write: /(76) e071k-objname.
    endat.
    set_colour.
    write: /(76) e071k-tabkey(76).
  endloop.
endform.

*---------------------------------------------------------------------*
*       FORM UPLOAD                                                   *
*---------------------------------------------------------------------*
form upload.
  call function 'WS_UPLOAD'
       EXPORTING
            filename            = filename
            filetype            = 'ASC'
       TABLES
            data_tab            = file
       EXCEPTIONS
            conversion_error    = 1
            file_open_error     = 2
            file_read_error     = 3
            invalid_table_width = 4
            invalid_type        = 5
            no_batch            = 6
            unknown_error       = 7
            others              = 8.
  check sy-subrc ne 0.
  message e016 with 'Error' 'uploading' 'file' space.
endform.

*---------------------------------------------------------------------*
*       FORM GETLENGTH                                                *
*---------------------------------------------------------------------*
form getlength using tabname like dd02l-tabname
                     tablen  type i
                     keylen  type i.

  data: x030l_wa  like x030l.
  data: x031l_tab like x031l occurs 10 with header line.

  move 0 to: tablen, keylen.

  call function 'DD_GET_NAMETAB'
       EXPORTING
            status    = 'A'
            tabname   = tabname
            get_all   = ' '
       IMPORTING
            x030l_wa  = x030l_wa
       TABLES
            x031l_tab = x031l_tab
       EXCEPTIONS
            not_found = 1
            no_fields = 2
            others    = 3.

  check sy-subrc eq 0.
  move x030l_wa-tablen to tablen.
  move x030l_wa-keylen to keylen.
endform.

*---------------------------------------------------------------------*
*       FORM ADD_ENTRY_TO_TRANSPORT                                   *
*---------------------------------------------------------------------*
form add_entry_to_transport using pgmid     like e071-pgmid
                                  object    like e071-object
                                  obj_name
                                  objfunc   like e071-objfunc
                                  .
* add object to transport if necessary
  clear e071.
  move trkorr   to e071-trkorr.
  move pgmid    to e071-pgmid.
  move object   to e071-object.
  move obj_name to e071-obj_name.
  move objfunc  to e071-objfunc.
  read table e071 with key e071 binary search transporting no fields.
  check sy-subrc ne 0.
  insert e071 into e071 index sy-tabix.
endform.

*---------------------------------------------------------------------*
*       FORM ADD_KEY_TO_TRANSPORT                                     *
*---------------------------------------------------------------------*
form add_key_to_transport using pgmid       like e071k-pgmid
                                object      like e071k-object
                                objname
                                mastertype  like e071k-mastertype
                                mastername
                                tabkey
                                .
* add single key if necessary
  clear e071k.
  move trkorr     to e071k-trkorr.
  move pgmid      to e071k-pgmid.
  move object     to e071k-object.
  move objname    to e071k-objname.
  move mastertype to e071k-mastertype.
  move mastername to e071k-mastername.
  move tabkey     to e071k-tabkey.
  read table e071k with key e071k binary search transporting no fields.
  check sy-subrc ne 0.
  insert e071k into e071k index sy-tabix.
endform.

*---------------------------------------------------------------------*
*       FORM ADD_TABU_TO_TRANSPORT                                    *
*---------------------------------------------------------------------*
form add_tabu_to_transport using objname tabkey.
* add TABU object to transport
  perform add_entry_to_transport using 'R3TR' 'TABU' objname 'K'.
* add key to transport
  perform add_key_to_transport using 'R3TR' 'TABU' objname
                                     'TABU' objname tabkey.
endform.

*---------------------------------------------------------------------*
*       FORM COMMIT_TRANSPORT                                         *
*---------------------------------------------------------------------*
form commit_transport.
  data: keys_appended like trpari-w_append,
        objs_appended like trpari-w_append.
*
  check p_test is initial.
*
  call function 'TRINT_APPEND_COMM'
       EXPORTING
            wi_exclusive                 = 'X'
            wi_sel_e071                  = 'X'
            wi_sel_e071k                 = 'X'
            wi_trkorr                    = trkorr
       IMPORTING
            we_keys_physical_appended    = keys_appended
            we_objects_physical_appended = objs_appended
       TABLES
            wt_e071                      = e071
            wt_e071k                     = e071k
       EXCEPTIONS
            e071k_append_error           = 1
            e071_append_error            = 2
            trkorr_empty                 = 3
            others                       = 4.
*
  uline.
  write: / 'return code   =', sy-subrc.
  write: / 'objs appended =', objs_appended.
  write: / 'keys appended =', keys_appended.
endform.

*---------------------------------------------------------------------*
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> Transport and Upgrade | Транспорт и Обновления All times are GMT + 4 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


All product names are trademarks of their respective companies. SAPNET.RU websites are in no way affiliated with SAP AG.
SAP, SAP R/3, R/3 software, mySAP, ABAP, BAPI, xApps, SAP NetWeaver and any other are registered trademarks of SAP AG.
Every effort is made to ensure content integrity. Use information on this site at your own risk.