Umstellungsbeispiele

Beispiel 1: Speicherplatz reorganisieren

Diese Prozedur reorganisiert den Speicherplatz für alle Dateien einer Benutzerkennung. Wenn eine Datei eine PLAM-Bibliotkek ist, werden alle ihre Elemente in eine neue Bibliothek kopiert.

Die Benutzerkennung muss mit führendem $-Zeichen und abschließendem Punkt angegeben werden. Es gibt keine Defaultwerte.

a) Nicht-S-Prozedur

/BEGIN-PROCEDURE LOGGING=N,    -
/               PARAMETERS=YES(   -
/                 PROCEDURE-PARAMETERS=(  -
/                    &USERID=),   -
/                 ESCAPE-CHARACTER='&')
/REMARK +---------------------------------------------------------------+"
/REMARK |                                                               |
/REMARK | This procedure compacts all files contained on a user-id.     |
/REMARK | If the file is a PLAM library then all elements are           |
/REMARK | duplicated in a new library.                                  |
/REMARK | The user-id must be given with the leading dollar sign        |
/REMARK | and with the trailing point.                                  |
/REMARK | There is no default value.                                    |
/REMARK |                                                               |
/REMARK +---------------------------------------------------------------+"
/REMARK &USERID
/ASSIGN-SYSOUT TO=*DUMMY
/SHOW-FILE-ATTR &USERID,INFO=NAME-AND-SPACE,   -
/              OUTPUT=#LST(FORM-NAME=FILE-NAME)
/ASSIGN-SYSOUT TO=*PRIMARY
/ASSIGN-SYSDTA TO=*SYSCMD
/MOD-JOB-SWITCHES ON=(1,4,5)
/START-EXECUTABLE-PROGRAM $EDT
@@READ '#LST'
@@COL1ON&INSERT'/CALL-PROC #PROC2,P-P=('
@@SUFFIX&WITH')'
@@RENUM
@@CR0.001W'/BEGIN-PROCEDURE LOGGING=N'
@@CR0.002W'/ASSIGN-SYSOUT TO=#OUTBEFORE'
@@CR0.003W'/SHOW-FILE-ATT &USERID,INFO=SPACE-SUMMARY'
@@CR0.004W'/ASSIGN-SYSOUT TO=*PRIMARY'
@@CR$+.01W'/ASSIGN-SYSOUT TO=#OUTAFTER'
@@CR$+.01W'/SHOW-FILE-ATT &USERID,INFO=SPACE-SUMMARY'
@@CR$+.01W'/ASSIGN-SYSOUT TO=*PRIMARY'
@@CR$+.01W'/END-PROCEDURE'
@@WR'#PROC1' OVER
@@DELETE
@@CR$+.01W'/BEGIN-PROC LOGGING=N,  -'
@@CR$+.01W'/          PARAMETERS=YES(  -' 
@@CR$+.01W'/              PROC-PARAM=(&FILE),-'
@@CR$+.01W'/              ESCAPE-CHAR=''&'')'
@@CR$+.01W'/COPY-FILE &FILE,&FILE..WORK,PROTECTION=SAME'
@@CR$+.01W'/SKIP-COMMANDS TO-LABEL=ERASE'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/SKIP-COMMANDS TO-LABEL=END'
@@CR$+.01W'/.ERASE DELETE-FILE &FILE,OPTION=DATA'
@@CR$+.01W'/SKIP-COMMANDS TO-LABEL=FILE'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/DELETE-FILE &FILE..WORK'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/SKIP-COMMANDS TO-LABEL=END'
@@CR$+.01W'/.FILE SET-JOB-STEP'
@@CR$+.01W'/FILE &FILE,SPACE=(100,20),FCBTYPE=PAM'
@@CR$+.01W'/SKIP-COMMANDS TO-LABEL=LMS'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/COPY-FILE &FILE..WORK,&FILE'
@@CR$+.01W'/DELETE-FILE &FILE..WORK,IGNORE-PROTECTION=ACCESS'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/SKIP-COMMANDS TO-LABEL=END'
@@CR$+.01W'/.LMS SET-JOB-STEP'
@@CR$+.01W'/ASSIGN-SYSDTA TO=*SYSCMD'
@@CR$+.01W'/MOD-JOB-SWITCHES ON=(1,2,3,4,5)'
@@CR$+.01W'/START-EXECUTABLE-PROGRAM $LMS,MONJV=#BIDON'
@@CR$+.01W'LIB &FILE..WORK,IN'
@@CR$+.01W'LIB &FILE,OUT,NEW'
@@CR$+.01W'DUP* */*'
@@CR$+.01W'END'
@@CR$+.01W'/MOD-JOB-SWITCHES OFF=(1,2,3,4,5)'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/SKIP-COMMANDS IF=JV(((#BIDON,4,4) = ''0000'')),-'
@@CR$+.01W'/              TO-LABEL=AVEND'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/COPY-FILE &FILE..WORK,&FILE'
@@CR$+.01W'/DELETE-FILE &FILE..WORK'
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/SKIP-COMMANDS TO-LABEL=END'
@@CR$+.01W'/.AVEND SET-JOB-STEP'
@@CR$+.01W'/DELETE-FILE &FILE..WORK'
@@CR$+.01W'/.END SET-JOB-STEP'
@@CR$+.01W'/MOD-FILE-ATT &FILE,SUPPORT=ANY-DISK(RELEASE(9999))
@@CR$+.01W'/W-TEXT ''File &FILE compacted'''
@@CR$+.01W'/SET-JOB-STEP'
@@CR$+.01W'/END-PROCEDURE'
@@WR'#PROC2'OVER
@@H
/CALL-PROCEDURE #PROC1
/START-EXECUTABLE-PROGRAM $EDT
@@REA'#OUTBEFORE'
@@REA'#OUTAFTER'
@@SET #I5 = SUBSTR 1:38-42:
@@SET #I6 = SUBSTR 2:38-42:
@@SET #I7 = #I5 - #I6
@@DELETE
@@SET #S5 = CHAR #I5
@@SET #S6 = CHAR #I6
@@SET #S7 = CHAR #I7
@@CR #S1:'Space before : ',#S5
@@CR #S2:'Space after  : ',#S6
@@CR #S3:'              ------------'
@@CR #S4:'Space won    : ',#S7
@@PRINT #S1 N
@@PRINT #S2 N
@@PRINT #S3 N
@@PRINT #S4 N
@@H
/MOD-JOB-SWITCHES OFF=(1,4,5)
/ASSIGN-SYSDTA TO=*SYSCMD
/END-PROC

b) S-Prozedur

/&* +---------------------------------------------------------------+
/&* |                                                               |
/&* | This procedure compacts all files contained on a user-id.     |
/&* | If the file is a PLAM library then all elements are           |
/&* | duplicated in a new library.                                  |
/&* | The user-id is given in parameters with or without the        |
/&* | leading dollar sign and with or without the trailing point.   |
/&* | If no parameter is given then the current user-id is taken.   |
/&* |                                                               |
/&* +---------------------------------------------------------------+
/DECLARE-PARAMETER USER-ID(INITIAL-VALUE=USER-ID,TRANSFER-TYPE=BY-VALUE)
/IF (SUBSTR(USER-ID,1,1)<>'$')
/   "THEN" USER-ID = '$' // USER-ID
/END-IF
/IF (SUBSTR(USER-ID,LENGTH(USER-ID),1)<>'.')
/   "THEN" USER-ID = USER-ID // '.'
/END-IF
/DECLARE-VARIABLE FS(TYPE=STRUCT(*DYNAMIC)),MULT-ELEM=LIST
/DECLARE-VARIABLE VARLOOP(TYPE=STRUCT(*DYNAMIC))
/EXEC-CMD CMD=(SHOW-FILE-ATTR &USER-ID,INFO=NAME-AND-SPACE),-
/STRUCTURE-OUTPUT=FS,TEXT-OUTPUT=*NONE
/DECLARE-VARIABLE SPACEBEFORE(INIT=O,TYP=*INTEGER)
/FOR VARLOOP = *LIST(FS)
/    SPACEBEFORE = SPACEBEFORE + VARLOOP.F-SIZE
/    IF (IS-LIBRARY(VARLOOP.F-NAME))
/       "THEN" LIBBLOCK: BEGIN-BLOCK DATA-INSERTION=YES
/             COPY-FILE FROM-FILE=&(VARLOOP.F-NAME),/
                       TO-FILE=&(VARLOOP.F-NAME).WORK,PROTECTION=SAME
/             IF-BLOCK-ERROR
/                   EXIT-BLOCK LIBBLOCK
/             END-IF
/             MODIFY-JOB-SWITCHES ON=(1,4)
/             ASSIGN-SYSDTA TO=*SYSCMD
/             DELETE-FILE &(VARLOOP.F-NAME)
/             IF-BLOCK-ERROR
/               DELETE-FILE &(VARLOOP.F-NAME).WORK,OPTION=DATA
/               EXIT-BLOCK LIBBLOCK
/             END-IF
/             START-EXE FROM-FILE=$LMS
/             SEND-DATA 'LIB &(VARLOOP.F-NAME).WORK,IN'
/             SEND-DATA 'LIB &(VARLOOP.F-NAME).NEW.OUT'
/               SEND-DATA 'DUP* */*'
/               SEND-DATA 'END'
/             ASSIGN-SYSDTA TO=*PRIMARY
/             MODIFY-JOB-SWITCHES OFF=(1,4)
/             IF-BLOCK-ERROR
/                COPY-FILE &(VARLOOP.F-NAME).WORK,/
                          &(VARLOOP.F-NAME)
/                ELSE
/               WR-TEXT 'Library &(VARLOOP.F-NAME) compacted'
/             END-IF
/             DELETE-FILE &(VARLOOP.F-NAME).WORK,IGNORE-PROTECTION=ACCESS
/             MOD-FILE-ATTR &(VARLOOP.F-NAME),/
                            SUPPORT=ANY-DISK(SPACE=RELEASE(10000))
/              END-BLOCK
/         ELSE
/              MOD-FILE-ATTR &(VARLOOP.F-NAME),/
                             SUPPORT=ANY-DISK(SPACE=RELEASE(10000))
/              IF-BLOCK-ERROR
/                  ELSE
/                  WR-TEXT 'File &(VARLOOP.F-NAME) compacted'
/              END-IF
/    END-IF
/END-FOR
/IF-BLOCK-ERROR
/END-IF
/DECLARE-VARIABLE FS2(TYP=STRING),MULT-EL=LIST
/EXEC-CMD CMD=(SHOW-FILE-ATTR &USER-ID,INFO=SPACE-SUMMARY),/
         TEXT-OUTPUT=FS2
/SPACEAFTER = INTEGER (SUBSTR (FS2#,37,5))
/WR-TEXT 'Space before : &SPACEBEFORE'
/WR-TEXT 'Space after  : &SPACEAFTER'
/WIN = SPACEBEFORE - SPACEAFTER
/WR-TEXT '                -----'
/WR-TEXT 'Space won : &WIN'
/EXIT-PROC

Beispiel 2: Dateien mithilfe von Mustern kopieren

In der folgenden Prozedur werden zunächst Dateien über Muster ausgewählt. Anschließend werden sie unter eine neue Katalogkennung, eine neue Benutzerkennung oder ein neues Präfix kopiert.

Zur Veranschaulichung:
CALL-PROC copy, PROC-PAR = (SOURCE=xxx, TARGET=yyy)

für xxx kann stehen:
:CAT: ,$USERID., *STRING* oder alles, was von SHOW-FILE-ATTR akzeptiert wird.

für yyy kann stehen:
:CAT: ,$USERID2. oder jedes Präfix mit abschließendem Punkt.

a) Nicht-S-Prozedur

/BEGIN-PROCEDURE LOGGING=N,                      -
/               PARAMETERS=YES(                  -
/                 PROCEDURE-PARAMETERS=(         -
/                      &SOURCE=,                 -
/                      &TARGET=),                -
/                 ESCAPE-CHARACTER='&')
/REMARK +---------------------------------------------------------------+
/REMARK |                                                               |
/REMARK | This procedure enables the user to copy some files selected   |
/REMARK | with wildcards under a new cat-id, a new user-id or a new     |
/REMARK | prefix.                                                       |
/REMARK | Examples :                                                    |
/REMARK |   CALL-PROC copy,PROC-PAR=(SOURCE=xxx,TARGET=yyy)             |
/REMARK |   where xxx could be :CAT: , $USERID. , *STRING* or           |
/REMARK |                       everything accepted by SHOW-FILE-ATT    |
/REMARK |         yyy could be :CAT2: , $USERID2. or any PREFIX with    |
/REMARK |                       a trailing point                        |
/REMARK |                                                               |
/REMARK +---------------------------------------------------------------+
/REMARK &SOURCE
/REMARK &TARGET
/ASSIGN-SYSOUT TO=*DUMMY
/ASSIGN-SYSLST TO=#LST
/SHOW-FILE-ATTR &SOURCE,LIST=((SYSLST),FILENAM)
/ASSIGN-SYSLST TO=*PRIMARY
/ASSIGN-SYSOUT TO=*PRIMARY
/ASSIGN-SYSDTA TO=*SYSCMD
/MODIFY-JOB-SWITCHES ON=(1,4,5)
/START-EXECUTABLE-PROGRAM $EDT
@@PROC 1
@@REA '#LST'
@@PROC 2
@@COPY &(1)
@@ON&FIND '.',1 DELETE PREFIX
@@DELETE&:1-1
@@PREFIX & WITH '/            TO-FILE=&TARGET'
@@RENUM 1.5(1)
@@END
@@SUFFIX & WITH '.-'
@@PREFIX & WITH '/COPY-FILE FROM-FILE  ='
@@COPY &(2)
@@RENUM
@@CR 0.01W'/BEGIN-PROCEDURE LOGGING=N'
@@CR$+.01W'/END-PROCEDURE'
@@WR'#LST' OVER
@@H
/MODIFY-JOB-SWITCHES OFF=(1,4,5)
/ASSIGN-SYSDTA TO=*PRIMARY
/CALL-PROC #LST
/END-PROCEDURE

b) S-Prozedur

/BEGIN-PARAMETER-DECLARATION
/  DECLARE-PARAMETER SOURCE(INIT=*PROMPT, TYPE=*STRING)
/  DECLARE-PAREMETER TARGET(INIT=*PROMPT, TYPE=*STRING)
/END-PARAMETER-DECLARATION
/&*+-------------------------------------------------------------------+
/&*|                                                                   |
/&*| This procedure enables the user to copy some files selected with  |
/&*| wildcards under a new cat-id, a new user-id, or a new prefix.     |
/&*| Examples :                                                        |
/&*|  CALL-PROC copy,PROC-PAR=(SOURCE=xxx,TARGET=yyy)                  |
/&*|  where xxx could be :CAT: , &USERID. , *STRING* or everything     |
/&*|                          accepted by SHOW-FILE-ATTRIBUTES         |
/&*|          yyy could be :CAT2: , &USERID. or any PREFIX with a      |
/&*|                          trailing point.                          |
/&*|                                                                   |
/&*+-------------------------------------------------------------------+
/DECLARE-VARIABLE FS(TYPE=STRUCT(*DYNAMIC)),MULT-ELEM=LIST
/DECLARE-VARIABLE VARLOOP(TYPE=STRUCT(*DYNAMIC))
/DECLARE-VARIABLE TARGET2(TYPE=STRING)
/EXEC-CMD CMD=(SHOW-FILE-ATTR &SOURCE,-
/INFO=NAME-AND-SPACE),-
/STRUCTURE-OUTPUT=FS,TEXT-OUT=*NONE
/FOR VARLOOP = *LIST(FS)
/    TARGET2 = TARGET // -
/              VARLOOP.SHORT-F-NAME
/    COPY-FILE FROM = &(VARLOOP.F-NAME),-
/               TO  = &(TARGET2)
/    IF-BLOCK-ERROR
/      "THEN" WR-TEXT 'File &(VARLOOP.F-NAME) not copied'
/       ELSE
/             WR-TEXT 'File &(VARLOOP.F-NAME) copied on &TARGET2'
/    END-IF
/END-FOR
/EXIT-PROC