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

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

よく使うマニュアルです

Wiki

updated on 2004.06.23

13.1.1 The Essential CL Style Guide CLP sample

[ HOME ] [ Upper ] [ Next ]


 

    
Figure 1 - Sample CL program
 

    
/*  ================================================================  */
/*  =  From "The Essential CL Style Guide," NEWS/400, July 1999.   =  */
/*  =  Program....... EZChgDftC                                    =  */
/*  =  Type.......... Command processing program for EZChgDft      =  */
/*  =  Description... EZ Change command defaults                   =  */
/*  =                                                              =  */
/*  =                 This program receives a command string and   =  */
/*  =                 for each parameter specified attempts to     =  */
/*  =                 change the command defaults.                 =  */
/*  =                                                              =  */
/*  =                 Because the prompter requires that all       =  */
/*  =                 required parameters be specified, it is not  =  */
/*  =                 possible to omit required parameters from    =  */
/*  =                 the command string this program receives     =  */
/*  =                 as input. Instead, these parameters must     =  */
/*  =                 be stripped from the command string. The     =  */
/*  =                 program monitors for error messages that     =  */
/*  =                 are returned from CHGCMDDFT to identify      =  */
/*  =                 the parameters that must be stripped. This   =  */
/*  =                 also applies not only to those parameters    =  */
/*  =                 that are required but also to errors that    =  */
/*  =                 might result from such actions as trying     =  */
/*  =                 to change the default value for parameters   =  */
/*  =                 that have no default value.                  =  */
/*  =  ----------------------------------------------------------  =  */
/*  =  Parameter interface                                         =  */
/*  =                                                              =  */
/*  =  Parameter       Type      Description                       =  */
/*  =                                                              =  */
/*  =  &CmdStr         Input     Command string for which to       =  */
/*  =                            change command defaults           =  */
/*  ================================================================  */

  Pgm        ( &CmdStr )

/*  ================================================================  */
/*  = Variable declarations                                        =  */
/*  ================================================================  */
 

    

  Dcl        &CmdStr     *Char     ( 2088    )
  Dcl        &CmdStrLenA *Char     (    2    )
  Dcl        &CmdStrLen  *Dec      (    4  0 )
  Dcl        &CmdStrPos  *Dec      (    4  0 )
  Dcl        &ChgStr     *Char     ( 3000    )   ( 'CHGCMDDFT ' )
  Dcl        &ChgStrLen  *Dec      (    4  0 )   ( 10 )
  Dcl        &ChgStrPos  *Dec      (    4  0 )
  Dcl        &Cmd        *Char     (   10    )
  Dcl        &CmdLib     *Char     (   10    )
  Dcl        &CmdPos     *Dec      (    4  0 )
  Dcl        &Len        *Dec      (    4  0 )
  Dcl        &Usr        *Char     (   10    )
  Dcl        &MsgID      *Char     (    7    )
  Dcl        &MsgDta     *Char     (  100    )
  Dcl        &MsgF       *Char     (   10    )
  Dcl        &MsgFLib    *Char     (   10    )
  Dcl        &ErrorSw    *Lgl

A

    

    
 

    
/*  ================================================================  */
/*  = Global error monitor                                         =  */
/*  ================================================================  */
 

    
  MonMsg     ( CPF0000 MCH0000 )                                 Exec( +
    Goto       Error                                                 )

B

    

    
 

    
/*  ================================================================  */
/*  = Set logging options based on user profile                    =  */
/*  ================================================================  */
  RtvJoba    User( &Usr )

 

    
  If         ( &Usr *Eq 'QSECOFR' )                                    +
    Call       EzChgDftC1
  Else                                                                 +
    Call       EzChgDftC2

C

    

    
 

    
/*  ================================================================  */
/*  = Parse command string into length and actual command string   =  */
/*  ================================================================  */

  ChgVar     &CmdStrLenA ( %Sst( &CmdStr 1 2 ) )
  ChgVar     &CmdStrLen  ( %Bin( &CmdStrLenA ) )
  ChgVar     &CmdStr     ( %Sst( &CmdStr 3 &CmdStrLen ) )

/*  ================================================================  */
/*  = Get command name and library name for completion message     =  */
/*  ================================================================  */

  ChgVar     &CmdLib     ( '*LIBL' )
  ChgVar     &CmdPos     ( 1 )
  ChgVar     &CmdStrPos  ( 1 )

GetCmdEnd:

  ChgVar     &CmdStrPos  ( &CmdStrPos + 1 )

 

    
  If         ( %Sst( &CmdStr &CmdStrPos 1 ) *Eq '/' )                  +
    Do
      ChgVar     &Len        ( &CmdStrPos - 1 )
      ChgVar     &CmdLib     ( %Sst( &CmdStr 1 &Len ) )
      ChgVar     &CmdPos     ( &CmdStrPos + 1 )
    EndDo

  If         ( %Sst( &CmdStr &CmdStrPos 1 ) *NE ' ' )                  +
    GoTo       GetCmdEnd
D

    

    
 

    
  ChgVar     &Len        ( &CmdStrPos - &CmdPos )

 

    
  ChgVar     &Cmd        ( %Sst( &CmdStr &CmdPos &Len ) )
E

    

    
 

    
  ChgVar     &CmdPos     ( &CmdStrPos )

  RtvObjD    Obj( &CmdLib/&Cmd )                                       +
             ObjType( *CMD )                                           +
             RtnLib( &CmdLib )

 

    
/*  ================================================================  */
/*  = Build change command string one character at a time          =  */
/*  ================================================================  */
F

    

    
 

    
  ChgVar     &ChgStrPos  ( &ChgStrLen )
  ChgVar     &CmdStrPos  ( 0 )

AddNxt:

 

    
/*  ----------------------------------------------------------------  */
/*  - Check to see if end of command has been reached              -  */
/*  ----------------------------------------------------------------  */
G

    

    
 

    
  ChgVar     &CmdStrPos  ( &CmdStrPos + 1 )



  If         ( &CmdStrPos *GT &CmdStrLen )                             +
    GoTo       AddEndDft

/*  ----------------------------------------------------------------  */
/*  - Check to see if within maximum length for change command     -  */
/*  ----------------------------------------------------------------  */

  ChgVar     &ChgStrPos  ( &ChgStrPos + 1 )

  If         ( &ChgStrPos *GT 3000 )                                   +
    GoTo       StrLenErr

/*  ----------------------------------------------------------------  */
/*  - If at end of command name, insert beginning delimiter of ('  -  */
/*  - for parameters                                               -  */
/*  ----------------------------------------------------------------  */

  If         ( &CmdStrPos *Eq &CmdPos )                                +
    Do
      ChgVar     &ChgStrPos                        ( &ChgStrPos + 1 )
      ChgVar     ( %Sst( &ChgStr &ChgStrPos 1 ) )  ( '(' )
      ChgVar     &ChgStrPos                        ( &ChgStrPos + 1 )
      ChgVar     ( %Sst( &ChgStr &ChgStrPos 1 ) )  ( '''' )
      GoTo       AddNxt
    EndDo


/*  ----------------------------------------------------------------  */
/*  - Copy character from command to change command. If the        -  */
/*  - character is ' then add another ' character to the change    -  */
/*  - command string. Also, make sure change command is within     -  */
/*  - maximum length.                                              -  */
/*  ----------------------------------------------------------------  */

  ChgVar     ( %Sst( &ChgStr &ChgStrPos 1 ) )                          +
             ( %Sst( &CmdStr &CmdStrPos 1 ) )
  If         ( %Sst( &ChgStr &ChgStrPos 1 ) *Eq '''' )                 +

    Do
      ChgVar     &ChgStrPos  ( &ChgStrPos + 1 )
      If         ( &ChgStrPos *GT 3000 )                               +
        GoTo       StrLenErr
      ChgVar     ( %Sst( &ChgStr &ChgStrPos 1 ) )  ( '''' )
    EndDo

  GoTo       AddNxt

/*  ----------------------------------------------------------------  */
/*  - Insert ending delimiter of ') for parameters and make sure   -  */
/*  - change command is within maximum length                      -  */
/*  ----------------------------------------------------------------  */

AddEndDft:

  ChgVar     &ChgStrPos  ( &ChgStrPos + 1 )



  If         ( &ChgStrPos *GT 3000 )                                   +
    GoTo       StrLenErr
  ChgVar     ( %Sst( &ChgStr &ChgStrPos 1 ) )  ( '''' )
  ChgVar     &ChgStrPos                        ( &ChgStrPos + 1 )

  If         ( &ChgStrPos *GT 3000 )                                   +
    GoTo       StrLenErr

  ChgVar     ( %Sst( &ChgStr &ChgStrPos 1 ) )  ( ')' )



/*  ================================================================  */
/*  = Execute the CHGCMDDFT command                                =  */
/*  ================================================================  */

Execute:

  RmvMsg     Clear( *ALL )
  Call       QCMDEXC                                                   +
             ( &ChgStr 3000 )

  MonMsg     ( CPF0000 )                                         Exec( +
    GoTo       ChgCmdErr                                             )

/*  ----------------------------------------------------------------  */
/*  - CHGCMDDFT command succeeded. Send a completion message and   -  */
/*  - exit.                                                        -  */
/*  ----------------------------------------------------------------  */

  ChgVar     &MsgDta     ( &Cmd *Cat &CmdLib )

  SndPgmMsg  MsgID( CPC6260 )                                          +
             MsgF( QSYS/QCPFMSG )                                      +
             MsgDta( &MsgDta )                                         +
             MsgType( *Comp )
  Return


/*  ================================================================  */
/*  = Generated command string is too long                         =  */
/*  ================================================================  */


StrLenErr:


  RmvMsg     Clear( *ALL )

  SndPgmMsg  MsgID( CPF9897 )                                          +
             MsgF( QSYS/QCPFMSG )                                      +
             MsgDta( 'Command string is too long.' )                   +
             MsgType( *DIAG )
  Return

/*  ================================================================  */
/*  = Error in CHGCMDDFT - try to handle                           =  */
/*  ================================================================  */

ChgCmdErr:

  RcvMsg     MsgType( *DIAG )                                          +
             Rmv( *YES )                                               +
             MsgDta( &MsgDta )                                         +
             MsgID( &MsgID )


/*  ----------------------------------------------------------------  */
/*  - If CHGCMDDFT command fails with one of the following         -  */
/*  - diagnostic messages, strip the parameter out of the command  -  */
/*  - string. This can occur if the parameter does not have a      -  */
/*  - default value (such as a required parameter), for a list     -  */
/*  - item with no default value, or for a qualifier (such as a    -  */
/*  - library name) with no default value. After removing the      -  */
/*  - parameter, execute the CHGCMDDFT command again.              -  */
/*  ----------------------------------------------------------------  */

  If         ( ( &MsgID *Eq 'CPD6260' )                                +
  *Or          ( &MsgID *Eq 'CPD6261' )                                +
  *Or          ( &MsgID *Eq 'CPD6262' ) )                              +
    Do
      Call       EZChgDftC3                                            +
                 ( &ChgStr &MsgDta )
      Goto       Execute
    EndDo

/*  ----------------------------------------------------------------  */
/*  - If CHGCMDDFT command fails with the following diagnostic     -  */
/*  - message, add a null placeholder for the missing entry.       -  */
/*  - This can occur when a single value is specified in a list    -  */
/*  - (such as the SIZE parameter with value *NOMAX specified on   -  */
/*  - the CHGPF command). After adding the null placeholder,       -  */
/*  - execute the CHGCMDDFT command again.                         -  */
/*  ----------------------------------------------------------------  */

  If         ( &MsgID *Eq 'CPD6273' )                                  +

    Do
      Call       EZChgDftC4                                            +
                 ( &ChgStr &MsgDta )
      Goto       Execute
    EndDo

/*  ----------------------------------------------------------------  */
/*  - If CHGCMDDFT command fails with one of the following         -  */
/*  - diagnostic messages, just ignore the change request. This    -  */
/*  - can occur when the request results in no parameters being    -  */
/*  - changed. This can happen due to the data entered by the      -  */
/*  - user or as a result of stripping out parameters with no      -  */
/*  - default value (for instance, all parameters may be stripped  -  */
/*  - out).                                                        -  */
/*  ----------------------------------------------------------------  */
 

    
  If         ( ( &MsgID *Eq 'CPD1013' )                                +
  *Or          ( &MsgID *Eq 'CPD1014' ) )                              +
    Do
      RmvMsg     Clear( *ALL )
      SndPgmMsg  MsgID( CPF9897 )                                      +
                 MsgF( QSYS/QCPFMSG )                                  +
                 MsgDta( 'No parameters selected for change.' )        +
                 MsgType( *DIAG )
      Return
    EndDo

H

    

    
 

    

/*  ----------------------------------------------------------------  */
/*  - CHGCMDDFT command failed for an unknown reason. Let normal   -  */
/*  - error processing take control.                               -  */
/*  ----------------------------------------------------------------  */

  Goto       Error


/*  ================================================================  */
/*  = Error handler                                                =  */
/*  ================================================================  */

Error:

  If         ( &ErrorSw )                                              +
    SndPgmMsg  MsgID( CPF9897 )                                        +
               MsgF( QSYS/QCPFMSG )                                    +
               MsgDta( 'An unexpected error occurred. See job log.' )  +
               MsgType( *Escape )

  ChgVar     &ErrorSw    ( '1' )


 RcvMsg     MsgType( *Excp )                                          +
             MsgDta( &MsgDta )                                         +
             MsgID( &MsgID )                                           +
             MsgF( &MsgF )                                             +
             MsgFLib( &MsgFLib )
  SndPgmMsg  MsgID( &MsgID)                                            +
             MsgF( &MsgFLib/&MsgF )                                    +
             MsgDta( &MsgDta )                                         +
             MsgType( *Diag )

/*  ================================================================  */
/*  = End of program                                               =  */
/*  ================================================================  */

  EndPgm  

[ HOME ] [ Upper ] [ Next ]

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

 

SEO [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送