From rfine@vnet.IBM.COM Thu Oct 10 23:06:22 1996 Date: Thu, 10 Oct 96 14:53:22 EDT From: Richard Fine To: edjaffe@netcom.com Subject: Tape Label REXX exec Hi Ed, here's the REXX exec: /*REXX*/ signal on novalue arg p1 p2 /*--------------------------------------------------------------*/ /* This exec builds JCL to label a tape and submits it to the */ /* internal reader. The two paramerers are OUT(unit) and */ /* SER(serial|NL). NL indicates a non-label tape and anything */ /* else indicates a standard label tape. */ /*--------------------------------------------------------------*/ false = 0 true = 1 CALL get_parameters CALL validate IF ^error THEN DO CALL job_prolog IF sername = "NL" THEN CALL build_non_label_step ELSE CALL build_standard_label_step CALL submit END Return 0 /*******************************************************************/ get_parameters: /*--------------------------------------------------------------*/ /* */ /* The parameter must be OUT(uuuu) or SER(ssssss). Either way, */ /* at least 5 for the parameter shell are required. If it's */ /* not there, the parameter will remain blank and fail the */ /* validate routine. */ /* */ /* Note that the way the parameter is passed to this exec is */ /* slightly different from the way the parameter is passed from */ /* the operator to the started task. The start syntax is */ /* S TL,OUT=uuuu,SER=ssssss. The started task JCL, in turn, */ /* invokes this exec by the following call: */ /* */ /* //TL PROC OUT=,SER= */ /* //STEPNAME EXEC PGM=IKJEFT01, */ /* // PARM='TLEXEC OUT(&OUT) SER(&SER)' */ /* //SYSTSPRT DD DUMMY */ /* //SYSTSIN DD DUMMY */ /* //SYSEXEC DD DSN=pds.containing.tlexec.member,DISP=SHR */ /* */ /* The exec also allows SER(&SER) OUT(&OUT); i.e. the */ /* parameters can be specified in either order. */ /* */ /*--------------------------------------------------------------*/ unitout = "" sername = "" /*--------------------------------------------------------------*/ /* Extract the first parameter. */ /*--------------------------------------------------------------*/ p1_len = length(p1) IF p1_len > 5 THEN DO IF right(p1,1) = ")" &, left(p1,4) = "OUT(" THEN unitout = substr(p1,5,p1_len - 5) ELSE IF right(p1,1) = ")" &, left(p1,4) = "SER(" THEN sername = substr(p1,5,p1_len - 5) ELSE "SE 'Illegal parameter specification - "p1" - ignored'" END /*--------------------------------------------------------------*/ /* Extract the second parameter. */ /*--------------------------------------------------------------*/ p2_len = length(p2) IF p2_len > 5 THEN DO IF right(p2,1) = ")" &, left(p2,4) = "OUT(" THEN DO IF unitout = "" THEN unitout = substr(p2,5,p2_len - 5) ELSE "SE '''OUT'' parameter duplicated'" END ELSE IF right(p2,1) = ")" &, left(p2,4) = "SER(" THEN DO IF sername = "" THEN sername = substr(p2,5,p2_len - 5) ELSE "SE '''SER'' parameter duplicated'" END ELSE "SE 'Illegal parameter specification - "p2" - ignored'" END /*--------------------------------------------------------------*/ /* Build a unit variable for the JCL generation based on the */ /* specified unit. If the unit is four characters, include the */ /* special symbol "/" to distinguish it from a possible four */ /* character device name. */ /* */ /* The reason for two copies of the unit, with and without the */ /* potential slash, is because the unit will also be used to */ /* construct the job name for operator convenience and */ /* readability but the slash is not allowed in a job name. */ /*--------------------------------------------------------------*/ unitjcl = unitout IF length(unitjcl) = 4 THEN unitjcl = "/" || unitjcl Return 0 /*******************************************************************/ validate: /*--------------------------------------------------------------*/ /* This routine enforces the following restrictions: */ /* */ /* UNIT= must be 3-4 characters and must be hexadecimal. */ /* SER= must be 1-6 characters and must be composed only of */ /* alphanumeric or national characters. */ /* */ /* It is implied that you cannot have a tape volume called NL. */ /*--------------------------------------------------------------*/ /*--------------------------------------------------------------*/ /* Assume that the parameters are innocent until proven guilty. */ /*--------------------------------------------------------------*/ error = false unit_missing = false unit_illegal = false ser_missing = false ser_illegal = false /*--------------------------------------------------------------*/ /* Place the unit on trial. */ /*--------------------------------------------------------------*/ IF unitout = "" THEN unit_missing = true ELSE IF length(unitout) > 4 THEN DO unit_illegal = true unit_error_text = "exceeds four characters." END ELSE IF length(unitout) < 3 THEN DO unit_illegal = true unit_error_text = "has fewer then three characters." END ELSE IF ^DATATYPE(unitout,"X") THEN DO unit_illegal = true unit_error_text = "is not a hexadecimal device number." END /*--------------------------------------------------------------*/ /* Place the volume serial on trial. */ /*--------------------------------------------------------------*/ IF sername = "" THEN ser_missing = true ELSE IF length(sername) > 6 THEN DO ser_illegal = true ser_error_text = "exceeds six characters." END ELSE DO ser_num = 1 to length(sername) WHILE ^ser_illegal ser_char = substr(sername,ser_num,1) IF index("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@#$",ser_char) = 0 THEN DO ser_illegal = true ser_error_text = "contains an invalid character " || ser_char || "." END END /*--------------------------------------------------------------*/ /* If one of the parameters is missing or illegal, send the */ /* operator a message saying which parameter had the error and */ /* what the error is. */ /*--------------------------------------------------------------*/ error = unit_missing |, unit_illegal |, ser_missing |, ser_illegal IF error THEN DO CALL blank_message IF unit_missing THEN "SE '''OUT=device'' parameter missing.'" IF ser_missing THEN "SE '''SER=volume|NL'' parameter missing.'" IF unit_illegal THEN "SE '''OUT="unitout"'' "unit_error_text"'" IF ser_illegal THEN "SE '''SER="sername"'' "ser_error_text"'" CALL blank_message END Return 0 /*******************************************************************/ add_line: /*--------------------------------------------------------------*/ /* This routine places another line into the stem variable JCL. */ /*--------------------------------------------------------------*/ lines = lines + 1 jcl.lines = line Return 0 /*******************************************************************/ job_prolog: /*--------------------------------------------------------------*/ /* This routine creates the introductory JCL statements for the */ /* tape label job. */ /*--------------------------------------------------------------*/ lines = 0 line = "//LABL" || unitout " JOB MSGCLASS=A" CALL add_line line = "//*MAIN RINGCHK=NO" CALL add_line Return 0 /*******************************************************************/ build_non_label_step: /*--------------------------------------------------------------*/ /* This is a non-label invocation. This is accomplished by */ /* writing an EOF mark and nothing else on the tape. The way */ /* this is done is that the tape is simply opened for output */ /* and then closed. The easiest way to do this is by running */ /* an IEBGENER to the tape without providing any data. */ /*--------------------------------------------------------------*/ line = "//TL EXEC PGM=IEBGENER" CALL add_line line = "//SYSPRINT DD SYSOUT=*" CALL add_line line = "//SYSIN DD DUMMY" CALL add_line line = "//SYSUT1 DD DUMMY,DCB=(RECFM=FB,LRECL=80,BLKSIZE=80)" CALL add_line line = "//SYSUT2 DD DISP=(NEW,PASS),LABEL=(,BLP)," CALL add_line line = "// UNIT=" || unitjcl CALL add_line Return 0 /*******************************************************************/ build_standard_label_step: /*--------------------------------------------------------------*/ /* This is a standard-label invocation. This is accomplished */ /* by invoking IEHINITT and supplying the volume serial as */ /* input to IEHINITT. The unit is used to construct the output */ /* DD. */ /*--------------------------------------------------------------*/ line = "//TL EXEC PGM=IEHINITT" CALL add_line line = "//TAPE DD DISP=(NEW,PASS),LABEL=(,BLP)," CALL add_line line = "// UNIT=(" || unitjcl || ",,DEFER)" CALL add_line line = "//SYSPRINT DD SYSOUT=*" CALL add_line line = "//SYSIN DD *" CALL add_line line = "TAPE INITT SER=" || sername CALL add_line line = "/*" CALL add_line CALL blank_message "SE 'When message IEC701D appears, reply M to it '" /*--------------------------------------------------------------*/ /* The following two operator messages apply only to second */ /* level systems on VM. */ /*--------------------------------------------------------------*/ "SE 'and then enter the MVS command V "unitout",ONLINE '" "SE '(even if it is already online!) '" CALL blank_message Return 0 /*******************************************************************/ blank_message: /*--------------------------------------------------------------*/ /* This routine sends a blank line to the console. It is used */ /* to separate other messages making them easier to read. */ /*--------------------------------------------------------------*/ "SE ' '" Return 0 /*******************************************************************/ submit: /*--------------------------------------------------------------*/ /* This routine submits the JCL by writing it to the internal */ /* reader. */ /*--------------------------------------------------------------*/ jcl.0 = lines "ALLOC F(SUBFILE) SYSOUT(A) WRITER(INTRDR) REUS" "EXECIO * DISKW SUBFILE (STEM jcl. FINIS" "FREE F(SUBFILE)" Return 0