分散 DB のコーディング (ILE RPG)

今回は「分散 DB のコーディング (Java)」に続いて、ILE RPG での埋め込み SQL を使用した分散 DB コーディングを見ていきたいと思います。

前回と同じインフォメーション・センターの例からなのですが、もともと載っている RPG のコーディング例が RPG/400 での埋め込み SQL なので、今となってはあまり見習いたいようなものではありません …

そこで、今回はインフォメーション・センターに載っている C のコーディング例を参考にして、ILE RPG で書き換えてみました。

どうせなら、ということで「プログラムの中から強制終了させる (監視用の READ トリガーを例に)」を参考にして、問題発生時には強制終了させるようにもしてみました。

コーディング例

こちらがそのコーディング例です。

      ****************************************************************                              
      *                                                              *                              
      *   DESCRIPTIVE NAME = D-DB SAMPLE APPLICATION                 *                              
      *                      REORDER POINT PROCESSING                *                              
      *                      i5/OS                                   *                              
      *                                                              *                              
      *   FUNCTION =  THIS MODULE PROCESSES THE PART_STOCK TABLE AND *                              
      *               FOR EACH PART BELOW THE ROP (REORDER POINT)    *                              
      *               CREATES A SUPPLY ORDER AND PRINTS A REPORT.    *                              
      *                                                              *                              
      *                                                              *                              
      *   INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION:     *                              
      *                                                              *                              
      *              LOCADB         LOCAL DB NAME                    *                              
      *              REMODB         REMOTE DB NAME                   *                              
      *                                                              *                              
      *   TABLES = PART-STOCK       - LOCAL                          *                              
      *            PART_ORDER       - REMOTE                         *                              
      *            PART_ORDLN       - REMOTE                         *                              
      *            SHIPMENTLN       - REMOTE                         *                              
      *                                                              *                              
      *   INDICATORS =   *IN89       - '0' ORDER HEADER  NOT  DONE   *                              
      *                                '1' ORDER HEADER  IS   DONE   *                              
      *                  *IN99       - '1' ABNORMAL END (SQLCOD<0)   *                              
      *                                                              *                              
      *   TO BE COMPILED WITH COMMIT(*CHG) RDB(remotedbname)         *                              
      *                       RDBCNNMTH(*RUW)                        *                              
      *    (*RUW is required since CONNECT TYPE 1 is presumed)       *                              
      *                                                              *                              
      *   INVOKE BY : CALL DRDA_LE PARM(localdbname remotedbname     *                              
      *                                 remotedbname                 *                              
      *                                 'SQLA' )                     *                              
      *                                                              *                              
      *   CURSORS WILL BE CLOSED IMPLICITLY (BY CONNECT) BECAUSE     *                              
      *   THERE IS NO REASON TO DO IT EXPLICITLY                     *                              
      *                                                              *                              
      ****************************************************************                              
     H DFTACTGRP(*NO) ACTGRP(*NEW)                                                                  
      *                                                                                             
     FQPRINT    O    F   35        PRINTER OFLIND(*inOF)                                            
      *                                                                                             
     D DRDA_LE         PR                                                                           
     D  Local_DB                     18a                                                            
     D  Remote_DB                    18a                                                            
     D  loc                           4a                                                            
      *                                                                                             
     D DRDA_LE         PI                                                                           
     D  Local_DB                     18a                                                            
     D  Remote_DB                    18a                                                            
     D  loc                           4a                                                            
      *                                                                                             
     D dcl_cursors     PR                                                                           
     D reset_tables    PR                                                                           
     D calc_ord_quant  PR                                                                           
     D process_order   PR                                                                           
     D error_function  PR                                                                           
      *                                                                                             
     D ABEND           PR                  extproc('CEE4ABN')                                       
     D  raise_TI                     10i 0 const options(*omit)                                     
     D  cel_rc_mpod                  10i 0 const options(*omit)                                     
     D  user_rc                      10i 0 const options(*omit)                                     
      *                                                                                             
     D  part_table     S              5a   inz(*blanks)                                             
     D  quant_table    S             10i 0 inz(0)                                                   
     D  rop_table      S             10i 0 inz(0)                                                   
     D  eoq_table      S             10i 0 inz(0)                                                   
     D  next_num       S              5i 0 inz(0)                                                   
     D  ord_table      S              5i 0 inz(0)                                                   
     D  orl_table      S              5i 0 inz(0)                                                   
     D  qty_table      S             10i 0 inz(0)                                                   
     D  line_count     S              5i 0 inz(0)                                                   
     D  ind_null       S              5i 0 inz(0)                                                   
     D  contl          S              5i 0 inz(0)                                                   
                                                                                                    
     D  qty_rec        S             10i 0 inz(0)                                                   
     D  qty_req        S             10i 0 inz(0)                                                   
                                                                                                    
      /free                                                                                         
       EXEC SQL WHENEVER SQLERROR GOTO error_tag;                                                   
       EXEC SQL WHENEVER SQLWARNING CONTINUE;                                                       
                                                                                                    
       // Initialization                                                                            
       dcl_cursors();                                                                               
       reset_tables();                                                                              
                                                                                                    
       // Main Work                                                                                 
       dow (sqlcode = 0) ;                                                                          
         calc_ord_quant();                                                                          
         if (rop_table > quant_table + qty_req - qty_rec) ;                                         
           process_order();                                                                         
           quant_table = 0;                                                                         
           qty_req = 0;                                                                             
           qty_rec = 0;                                                                             
         endif ;                                                                                    
       enddo ;    
                                                                                  
       EXEC SQL COMMIT;                                                                             
       //* Reset Current Connection To Local Database */                                            
       // EXEC SQL DISCONNECT :local_db;                                                            
       EXEC SQL RELEASE ALL ;                                                                       
                                                                                                    
      /End-Free                                                                                     
     C                   goto      function_exit                                                    
      *                                                                                             
       // This error tag is required for COMMIT/RELEASE                                             
     C     error_tag     TAG                                                                        
      /Free                                                                                         
         error_function();                                                                          
                                                                                                    
      /End-Free                                                                                     
     C     function_exit TAG                                                                        
      /Free                                                                                         
                                                                                                    
       *inLR = *on ;                                                                                
                                                                                                    
       if ((*inLR = *on) and (*in99 = *off)) ;                                                      
         except FOOTER ;                                                                            
       endif ;                                                                                      
                                                                                                    
       return;                                                                                      
                                                                                                    
      /end-free                                                                                     
      *****************************************************************                             
      * OUTPUT LINES FOR THE REPORT                                   *                             
      *****************************************************************                             
      *                                                                                             
     OQPRINT    E            HEADER            2                                                    
     O                                         +  0 '***** ROP PROCESSING'                          
     O                                         +  1 'REPORT *****'                                  
     O*                                                                                             
     OQPRINT    E            HEADER      2                                                          
     O                                         +  0 '   ORDER NUMBER = '                            
     O                       next_num      Z   +  0                                                 
     O*                                                                                             
     OQPRINT    E            HEADER      1                                                          
     O                                         +  0 '------------------------'                      
     O                                         +  0 '---------'                                     
     O*                                                                                             
     OQPRINT    E            HEADER      1                                                          
     O                                         +  0 '   LINE     '                                  
     O                                         +  0 'PART          '                                
     O                                         +  0 'QTY    '                                       
     O*                                                                                             
     OQPRINT    E            HEADER      1                                                          
     O                                         +  0 '  NUMBER   '                                   
     O                                         +  0 'NUMBER      '                                  
     O                                         +  0 'REQUESTED '                                    
     O*                                                                                             
     OQPRINT    E            HEADER      1  1                                                       
     O                                         +  0 '------------------------'                      
     O                                         +  0 '---------'                                     
     O*                                                                                             
     OQPRINT    EF           DETAIL      1                                                          
     O                       line_count    Z   +  4                                                 
     O                       part_table        +  4                                                 
     O                       eoq_table     1   +  4                                                 
     O*                                                                                             
     OQPRINT    E            FOOTER      2                                                          
     O                                         +  0 '------------------------'                      
     O                                         +  0 '---------'                                     
     OQPRINT    E            FOOTER      1                                                          
     O                                         +  0 'NUMBER OF LINES '                              
     O                                         +  0 'CREATED = '                                    
     O                       line_count    Z   +  0                                                 
     O*                                                                                             
     OQPRINT    E            FOOTER      1                                                          
     O                                         +  0 '------------------------'                      
     O                                         +  0 '---------'                                     
     O*                                                                                             
     OQPRINT    E            FOOTER      2                                                          
     O                                         +  0 '*********'                                     
     O                                         +  0 ' END OF PROGRAM '                              
     O                                         +  0 '********'                                      
     O*                                                                                             
     OQPRINT    E            ERRLIN      2                                                          
     O                                         +  0 '** ERROR **'                                   
     O                                         +  0 '** ERROR **'                                   
     O                                         +  0 '** ERROR **'                                   
     OQPRINT    E            ERRLIN      1                                                          
     O                                         +  0 '* SQLCOD:'                                     
     O                       sqlcod        M   +  0                                                 
     O                                           33 '*'                                             
     OQPRINT    E            ERRLIN      1                                                          
     O                                         +  0 '* SQLSTATE:'                                   
     O                       sqlstt            +  2                                                 
     O                                           33 '*'                                             
     OQPRINT    E            ERRLIN      1                                                          
     O                                         +  0 '** ERROR **'                                   
     O                                         +  0 '** ERROR **'                                   
     O                                         +  0 '** ERROR **'                                   
      *                                                                                             
     P dcl_cursors     B                                                                            
     D dcl_cursors     PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
       //* SQL Cursor declaration and reposition for local UW */                                    
       EXEC SQL DECLARE NEXT_PART CURSOR FOR                                                        
                        SELECT PART_NUM, PART_QUANT, PART_ROP, PART_EOQ                             
                          FROM DRDA/PART_STOCK                                                      
                         WHERE PART_ROP > PART_QUANT AND                                            
                               PART_NUM > :part_table                                               
                         ORDER BY PART_NUM;                                                         
                                                                                                    
       //* SQL Cursor declaration and connect for RUW         */                                    
       EXEC SQL DECLARE NEXT_OLINE CURSOR FOR                                                       
                        SELECT A.ORDER_NUM, ORDER_LINE, QUANT_REQ                                   
                          FROM DRDA/PART_ORDLN A,                                                   
                               DRDA/PART_ORDER B                                                    
                         WHERE PART_NUM  = :part_table AND                                          
                               LINE_STAT  <> 'C' AND                                                
                               A.ORDER_NUM = B.ORDER_NUM AND                                        
                               ORDER_TYPE  = 'R';                                                   
                                                                                                    
       //* upline exit function in connectable state          */                                    
      /End-Free                                                                                     
     C                   goto      function_exit                                                    
      *                                                                                             
     C     error_tag     TAG                                                                        
      /Free                                                                                         
         error_function();                                                                          
                                                                                                    
      /End-Free                                                                                     
     C     function_exit TAG                                                                        
      /Free                                                                                         
         return ;                                                                                   
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P dcl_cursors     E                                                                            
      *                                                                                             
     P reset_tables    B                                                                            
     D reset_tables    PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
       //* Clean up for rerunability in test environment */                                         
       EXEC SQL CONNECT TO :remote_db;                                                              
       EXEC SQL DELETE FROM DRDA/PART_ORDLN                                                         
                      WHERE ORDER_NUM IN                                                            
                        (SELECT ORDER_NUM                                                           
                           FROM DRDA/PART_ORDER                                                     
                          WHERE ORDER_TYPE = 'R');                                                  
       EXEC SQL DELETE FROM DRDA/PART_ORDER                                                         
                      WHERE ORDER_TYPE = 'R';                                                       
       //* Exit function in connectable state            */                                         
       EXEC SQL COMMIT;                                                                             
                                                                                                    
      /End-Free                                                                                     
     C                   goto      function_exit                                                    
      *                                                                                             
     C     error_tag     TAG                                                                        
      /Free                                                                                         
         error_function();                                                                          
                                                                                                    
      /End-Free                                                                                     
     C     function_exit TAG                                                                        
      /Free                                                                                         
         return ;                                                                                   
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P reset_tables    E                                                                            
      *                                                                                             
     P calc_ord_quant  B                                                                            
     D calc_ord_quant  PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
       //* Set current connection to local database                */                               
       EXEC SQL CONNECT TO :local_db;                                                               
       //* available qty = Stock qty + qty in order - qty received */                               
       EXEC SQL OPEN NEXT_PART;                                                                     
       EXEC SQL FETCH NEXT_PART                                                                     
                 INTO :part_table, :quant_table, :rop_table, :eoq_table;                            
                                                                                                    
       if (sqlcode = 100) ;                                                                         
         rop_table = 0;                                                                             
         //* no (more) orders to process                           */                               
       else ;                                                                                       
         qty_rec = 0;                                                                               
         qty_req = 0;                                                                               
         EXEC SQL COMMIT;                                                                           
         EXEC SQL CONNECT TO :remote_db;                                                            
         if (sqlcode = -842) ;                                                                      
           EXEC SQL SET CONNECTION :remote_db ;                                                     
         endif ;                                                                                    
         EXEC SQL OPEN NEXT_OLINE;                                                                  
         dow (sqlcode <> 100) ;                                                                     
           EXEC SQL FETCH NEXT_OLINE                                                                
                     INTO :ord_table, :orl_table, :qty_table;                                       
           qty_rec = qty_rec + qty_table;                                                           
         enddo ;                                                                                    
         EXEC SQL CLOSE NEXT_OLINE;                                                                 
         EXEC SQL SELECT SUM(QUANT_RECV)                                                            
                    INTO :qty_table:ind_null                                                        
                    FROM DRDA/SHIPMENTLN                                                            
                   WHERE ORDER_LOC = :loc AND                                                       
                         ORDER_NUM = :ord_table AND                                                 
                         ORDER_LINE = :orl_table;                                                   
         if (ind_null <> 0) ;                                                                       
           qty_rec = qty_rec + qty_table ;                                                          
         endif ;                                                                                    
       endif ;//* end of else branch */                                                             
                                                                                                    
      /End-Free                                                                                     
     C                   goto      function_exit                                                    
      *                                                                                             
     C     error_tag     TAG                                                                        
      /Free                                                                                         
         error_function();                                                                          
                                                                                                    
      /End-Free                                                                                     
     C     function_exit TAG                                                                        
      /Free                                                                                         
         return ;                                                                                   
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P calc_ord_quant  E                                                                            
      *                                                                                             
     P process_order   B                                                                            
     D process_order   PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
       //* insert order and order_line in remote database */                                        
       if (contl = 0) ;                                                                             
         EXEC SQL SELECT (MAX(ORDER_NUM) + 1)                                                       
                    INTO :next_num                                                                  
                    FROM DRDA/PART_ORDER;                                                           
         EXEC SQL INSERT INTO DRDA/PART_ORDER                                                       
                    (ORDER_NUM, ORIGIN_LOC, ORDER_TYPE, ORDER_STAT, CREAT_TIME)                     
                  VALUES (:next_num, :loc, 'R', 'O', CURRENT TIMESTAMP);                            
         *in89 = *on ;                                                                              
         except HEADER ;                                                                            
         contl = contl + 1;                                                                         
       endif ; //* if contl = 0 */                                                                  
                                                                                                    
       EXEC SQL INSERT INTO DRDA/PART_ORDLN                                                         
                (ORDER_NUM, ORDER_LINE, PART_NUM, QUANT_REQ, LINE_STAT)                             
                VALUES (:next_num, :contl, :part_table, :eoq_table, 'O');                           
       line_count = line_count + 1;                                                                 
                                                                                                    
       if (*inOF) ;                                                                                 
         except HEADER ;                                                                            
       endif ;                                                                                      
       except DETAIL ;                                                                              
                                                                                                    
       contl = contl + 1;                                                                           
       //* Exit function in connectable state    */                                                 
       EXEC SQL COMMIT;                                                                             
                                                                                                    
      /End-Free                                                                                     
     C                   goto      function_exit                                                    
      *                                                                                             
     C     error_tag     TAG                                                                        
      /Free                                                                                         
         error_function();                                                                          
                                                                                                    
      /End-Free                                                                                     
     C     function_exit TAG                                                                        
      /Free                                                                                         
         return ;                                                                                   
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P process_order   E                                                                            
      *                                                                                             
     P error_function  B                                                                            
     D error_function  PI                                                                           
      /Free                                                                                         
                                                                                                    
       except ERRLIN ;                                                                              
       *in99 = *ON ;                                                                                
       EXEC SQL WHENEVER SQLERROR CONTINUE;                                                         
       EXEC SQL ROLLBACK;                                                                           
       //* Reset Current Connection To Local Database */                                            
       EXEC SQL CONNECT RESET;                                                                      
                                                                                                    
       //return     ;                                                                               
       ABEND(*omit: *omit: 0) ;                                                                     
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P error_function  E                                                                           

SQL の WHENEVER でエラー時の飛び先を定義しています。
プログラムの最初に定義していますので、ずっと最後まで有効です。

      /free                                                                                         
       EXEC SQL WHENEVER SQLERROR GOTO error_tag;                                                   
       EXEC SQL WHENEVER SQLWARNING CONTINUE;                                                       

WHENEVER のジャンプ先は RPG では「TAG で定義されたところ」と決まっています。

SQL は最後の COMMIT 以外はすべてサブプロシージャの中で実行されるようにしてあります。
つまり、エラーがキャッチされるのはサブプロシージャの中です。
それぞれのサブプロシージャの中に、ジャンプ先であるところの error_tag の定義が必要になるわけですね。

      /End-Free                                                                                     
     C                   goto      function_exit                                                    
      *                                                                                             
     C     error_tag     TAG                                                                        
      /Free                                                                                         
         error_function();                                                                          
                                                                                                    
      /End-Free                                                                                     
     C     function_exit TAG                                                                        
      /Free                                                                                         
         return ;                                                                                   
                                                                                                    
      /End-Free                                                                                     

ILE RPG のフリー・フォーマット構文には TAG が存在しないので、そこだけ固定フォーマットで書いています。
このエラー用の TAG を除けるために正常終了へジャンプするための TAG もまた必要になってしまうんですよね。

メインルーチンにも COMMIT などがあるので、やっぱり同じロジックが必要になります。

       EXEC SQL COMMIT;                                                                             
       //* Reset Current Connection To Local Database */                                            
       // EXEC SQL DISCONNECT :local_db;                                                            
       EXEC SQL RELEASE ALL ;                                                                       
                                                                                                    
      /End-Free                                                                                     
     C                   goto      function_exit                                                    
      *                                                                                             
       // This error tag is required for COMMIT/RELEASE                                             
     C     error_tag     TAG                                                                        
      /Free                                                                                         
         error_function();                                                                          
                                                                                                    
      /End-Free                                                                                     
     C     function_exit TAG                                                                        
      /Free                                                                                         
                                                                                                    
       *inLR = *on ;                                                                                 

他はそれほど難しいことはないでしょう。
「もともと載っている RPG のコーディング例」での RPG/400 と比較してみるのも面白いと思いますよ。

実行例

実行してみた結果です。

当り前ではありますが、「分散 DB のコーディング (Java)」と同じ結果になっているのがわかりますね。

問題発生時の対応

プログラムの中から強制終了させる (監視用の READ トリガーを例に)」の結果、問題があるときにはきちんと強制終了するのも確認しました。

[Top Pageに戻る]

Ads by TOK2