最初のページに戻ります。

総合の目次があるページに戻ります。

よく使うマニュアルです

Wiki

updated on 2004.06.23

a.21. 2000年問題 其の弐拾壱

[ Previous ] [ HOME ] [ Upper ] [ Next ]


日付のセパレータは?

JISの規格やISO規格では、YYYYMMDDのセパレータは-です。つまり、YYYY-MM-DDとなります。年が2桁の場合は、YY/MM/DDですが、年4桁だとハイフンになるようです。ところで、年4桁+月って、どうなるのだろう?YYYY-MMかYYYY/MMか?よく分からないけど、年4桁はYYYY/MMにした。年月日はYYYY-MM-DDにした。まあ、いいや。ところで、たとえば顧客のとうろく画面だと、名称や住所、そして、電話番号が入りますよね。これがまた、ハイフンで仕切られる。ぱっとみて、電話番号が増えたような錯覚をしてしまった。でも、市外局番が1999や2000なんてないので、すぐ分かるけど、なんか気になる。まあ、いいや。

CLPのミス多し

CLPの修正で、%SSTや、CVTDAT ... *YYMDなどは、ちゃんとしているのに、DCL文の桁数を修正し忘れているのが多いのに気づきました。まあ、200本近くを、2,3日で修正してしまったので、仕方ないのですが、まずいなあ。でも、どうしよう。フリーカラムなので、DCL文がソースの中に、自由な場所にある。RPGなら、まだなんとかなるのだけどなあ。仕方なく、コンパイルリストを物理ファイルにCPYSPLFして、そのファイルから、桁を定義する部分だけ、ファイルに取りだすことにしました。また、おかしいところを見つけても、どこに有るのか分からなくては、意味がないですよね。なんとかソースメンバーが分かるようにしなくては。できたものは、結構使えました。下がそのソース。こ汚いのはご勘弁を。

PGM                
          DCL &SRCTYPE   *CHAR    10
          DCL &CPFMSG    *CHAR   256                
          DCL &NBRRCDS   *DEC    (10 0)
          DCL &JOB       *CHAR    10
          DCL &USER      *CHAR    10
          DCL &JOBNBR    *CHAR     6                
          DCL &SRCFL     *CHAR    20  'Y2K       TKY2K     'ソースファイル名とライブラリー名。
          DCL &SRCFILE   *CHAR    10
          DCL &SRCLIB    *CHAR    10
          DCL &SRCMBR    *CHAR    10  '*ALL'                
          DCL &SIZE      *CHAR     4
          DCL &W1SEQC    *CHAR     3
          DCL &W1SEQ     *DEC     (3 0)                
          DCL &USRSPC       *CHAR    20   'MBRLIST   QTEMP     '                
          DCL &ERR_BYT      *CHAR     4
          DCL &ERR_AVA      *CHAR     4
          DCL &ERR_ID       *CHAR     7
          DCL &ERR_RSV      *CHAR     1
          DCL &ERR_MSG      *CHAR   100
          DCL &ERRDTA       *CHAR   116                
          DCL &HEADER       *CHAR    16
          DCL &MBRLDTA      *CHAR   100                
          DCL &LSTCNT       *DEC     (9 0)
          DCL &WRKCNT       *DEC     (9 0)                
          DCL &RTVSTRB      *CHAR     4
          DCL &RTVLENB      *CHAR     4                
          MONMSG CPF0000                
     RTVJOBA JOB(&JOB) USER(&USER) NBR(&JOBNBR)                
     CHGVAR &SRCFILE   %SST(&SRCFL    1   10)
     CHGVAR &SRCLIB    %SST(&SRCFL    11  10)                
/*--------------------------------------*/
/* CREATE USER SPACE                    */
/*--------------------------------------*/                
  CHGVAR %BIN(&SIZE) 1024
      CHKOBJ %SST(&USRSPC 11 10)/%SST(&USRSPC 1 10) *USRSPC
    MONMSG CPF9801 *N +
      CALL QUSCRTUS (&USRSPC 'WRK       ' &SIZE ' ' '*ALL' ' ')                
/*--------------------------------------*/
/* MAKE ANE ERROR STRUCTURE             */
/*--------------------------------------*/                
  CHGVAR %BIN(&ERR_BYT) 116
  CHGVAR %BIN(&ERR_AVA) 0
  CHGVAR &ERRDTA (&ERR_BYT||&ERR_AVA||&ERR_ID||&ERR_RSV||&ERR_MSG)                
/*--------------------------------------*/
/* SPREAD DATA BY API                   */
/*--------------------------------------*/                
   CALL QUSLMBR (&USRSPC 'MBRL0100' &SRCFL  &SRCMBR '0' &ERRDTA)                
IF (%BIN(&ERRDTA  5  4) *NE 0) DO
      CHGVAR &ERR_BYT  %SST(&ERRDTA  1    4)
      CHGVAR &ERR_ID   %SST(&ERRDTA  9    7)
      CHGVAR &ERR_MSG  %SST(&ERRDTA 17  100)
      SNDPGMMSG  MSGID(&ERR_ID) MSGF(QCPFMSG) +
                                MSGDTA(&ERR_MSG) MSGTYPE(*ESCAPE)
      MONMSG CPF0000
      GOTO \END
ENDDO                
/*--------------------------------------*/
/* RETRIEVE HEADER FROM USER SPACE      */
/*--------------------------------------*/                
      CHGVAR %BIN(&RTVSTRB) 125
      CHGVAR %BIN(&RTVLENB) 16                
      CALL   QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &HEADER)                
      CHGVAR &LSTCNT %BIN(&HEADER  9  4)
      IF (&LSTCNT = 0 ) GOTO \END                
/*--------------------------------------*/
/* PREPARATION OF RETRIEVE LIST DATA    */
/*--------------------------------------*/                
      CHGVAR &WRKCNT         0
      CHGVAR %BIN(&RTVSTRB) (%BIN(&HEADER  1  4) + 1)
      CHGVAR &RTVLENB        %SST(&HEADER 13  4)                
/*--------------------------------------*/
/* RETRIEVE LIST DATA FORM USER SPACE   */
/*--------------------------------------*/                
 \RTVMBRL:                
     CHGVAR &WRKCNT  (&WRKCNT + 1)
     CALL   QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &MBRLDTA)                
/*--------------------------------------*/
/* RETRIEVE MBRNAME LIST                */
/*--------------------------------------*/                
     CHGVAR &SRCMBR  %SST(&MBRLDTA  1 10)                
     CHKOBJ &SRCLIB/&SRCFILE *FILE  MBR(&SRCMBR)
     MONMSG CPF9800 *N GOTO \NEXTENTRY                
     RTVMBRD &SRCLIB/&SRCFILE MBR(&SRCMBR) SRCTYPE(&SRCTYPE)                
IF (&SRCTYPE *EQ 'CLP    ') DO                
     CRTCLPGM &SRCMBR &SRCLIB/&SRCFILE OPTION(*NOGEN)                
             CLRPFM IPLTEMP/CHKCLPGM1
             CLRPFM IPLTEMP/CHKCLPGM2                
             CPYSPLF    FILE(&SRCMBR) TOFILE(IPLTEMP/CHKCLPGM1) +
                          JOB(&JOBNBR/&USER/&JOB) SPLNBR(*LAST)                
             DLTSPLF    FILE(&SRCMBR) JOB(&JOBNBR/&USER/&JOB) +
                          SPLNBR(*LAST)                
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          NBRRCDS(2) FMTOPT(*NOCHK)
                
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*CHAR              2')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*CHAR              4')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*CHAR              6')                
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*DEC               2')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*DEC               4')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*DEC               6')                
     RTVMBRD    FILE(IPLTEMP/CHKCLPGM2) NBRCURRCD(&NBRRCDS)                
     IF (&NBRRCDS > 2) DO
        CPYF IPLTEMP/CHKCLPGM2 IPLTEMP/CHKCLPGM3 MBROPT(*ADD) +
        FMTOPT(*NOCHK)
     ENDDO                
ENDDO                
\NEXTENTRY:                
/*--------------------------------------*/
/* PREPARATION FOR NEXT LIST ITME       */
/*--------------------------------------*/                
 IF (&LSTCNT = &WRKCNT) GOTO \END                
   CHGVAR %BIN(&RTVSTRB) (%BIN(&RTVSTRB) + %BIN(&RTVLENB))
   GOTO \RTVMBRL                
ERR:                
/* |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~| */
/* |                      MESSGAE  HANDLING                        | */
/* |_______________________________________________________________| */                
 END_MSG:    RCVMSG     MSG(&CPFMSG)
                   MONMSG CPF0000 *N GOTO \END
             IF (&CPFMSG=' ') GOTO \END
             SNDPGMMSG  MSG(&CPFMSG)
                   MONMSG CPF0000 *N GOTO \END                
             GOTO END_MSG                
\END:                
     IF (%SST(&USRSPC 11 10)='QTEMP') DO
         DLTUSRSPC %SST(&USRSPC 11 10)/%SST(&USRSPC 1 10)
     ENDDO                
RETURN
ENDPGM                

ひえー、結構長いなー。すみません。ファイルは、予め、IPLTEMP(任意)に、CHKCLPGM1やCHKCLPGM2やCHKCLPGM3をレコード長200、IGCDTA(*YES)で作成しておきます。ここには、コンパイルリストの1行目と2行目がはいって、さらに、*CHAR,*DECの2桁、4桁、6桁のフィールドの名前が入ります。すると、だいたい、フィールド名から、内容が分かり、あらら、というものに気づくわけです。最終的には、CHKCLPGM3に入っています。また、画面のフィールド名と桁数もでるし、DCLしたけど、使われていないフィールドは、使用行がブランクなので、すぐに気づきます。便利でした。実行に時間がかかりますので、バッチでお願いします。

便利なCMPPFMコマンド

以前紹介した、CMPPFMは活躍しています。実は、AIDをデータエリアにしていたのですが、(システム38から)、RPGの固定情報に修正する作業で、機械的に、追加と削除をしているときに、データエリアのDEFN文を消しているところで、間違って、KFLDを消していることを修正中に、気づきました。「どーしよう」。そこで、CMPPFMの出番です。前日のバックアップから、旧イメージのソースを取り出し、それと比較しながら、変更のみをスプールしました。削除は、スプールの右の方にD-と出ていますので、このスプールをCPYSPLFで物理ファイルに移してから、D-の行だけを、ファイルにコピーしました。ここで見つけた行を、再びスプール検索で探し、ソースメンバー名を特定して、修正出来ました。2個もありました。KFLDの最後の方なので、コンパイルは通ってしまうので、やっかいなものだったのです。よかった。でも、XをYに変えると、Xは削除(D-)、Yは挿入(I-)となって、ここでも、D-が出てくることに注意してください。どうせなら、B-(Before change:変更前)、A-(After change:変更後)にして欲しかったな。尚、メンバー名は*ALLが使えますので、ソースファイル単位にメンバーそっくり全部比較出来ます。(メンバー名が一致するもののみ)。

これに比べると、MRGSRCは、なんか余り気に入らないなぁ。b_debug.gif (316 バイト)とんでもない、間違いでした。結構便利です

長くつらい日々

一日16個くらいテストをして、9月末には、現在のシステム年でテスト完了して、さらに10月から、2000年のシステム値でテストをする予定です。もう、疲れ切っています。バックレようかなぁ。

1998/08/14

続く... 


[ Previous ] [ HOME ] [ Upper ] [ Next ]

You are at K's tips-n-kicks of AS/400

 

Ads by TOK2