PROGRAM FLMSRV1 ;
(*********************************************************************)
(* *)
(* This program allows you to call SCLM services from a *)
(* Pascal program. *)
(* *)
(*********************************************************************)
(*********************************************************************)
(******** ALL REQUESTED INPUT PARAMETERS MUST BE ENTERED **********)
(******** IN UPPERCASE. **********)
(*********************************************************************)
(*********************************************************************)
(* *)
(* The function of this program is to register a software component *)
(* with SCLM and then build it. *)
(* The member in the SCLM controlled library (PDS) to be processed *)
(* is referenced by the variables project.group.type(member). *)
(* You must allocate the following ddnames as specified below: *)
(* *)
(* PRSLIST - for parser listings (RECFM=VBA,LRECL=137,BLKSIZE=3120) *)
(* BLDMSGS - for build messages (RECFM=F, LRECL=80, BLKSIZE=80) *)
(* BLDREPT - for build report (RECFM=FBA,LRECL=80, BLKSIZE=3120) *)
(* BLDLIST - for build listings (RECFM=VBA,LRECL=137,BLKSIZE=3120) *)
(* BLDEXIT - for build user exit (RECFM=FB, LRECL=160,BLKSIZE=3200) *)
(*********************************************************************)
(*********************************************************************)
(* Declare program and interface constants *)
(*********************************************************************)
CONST
(* Declare the maximum number of records the accounting record *)
(* list information array can hold. *)
max_list_info_entries = 200 ;
(* Declare the required ddnames as constants. *)
bldmsgs = 'BLDMSGS' ;
bldrept = 'BLDREPT' ;
bldlist = 'BLDLIST' ;
bldexit = 'BLDEXIT' ;
(* Include SCLM Interface common type declarations. *)
%INCLUDE FLMSRV1D ;
(* Include SCLM Interface procedure definitions. *)
%INCLUDE FLMSRV1S ;
(********************************************************************)
(* Declare program local variables *)
(********************************************************************)
VAR
$acct_info : $acct_info_type ;
$list_info : $list_info_type ;
$list_info_copy : $list_info_type ;
$stats_info : $stats_info_type ;
$stats_info_copy : $stats_info_type ;
$msg_array : $msg_array_type ;
breport_check : char24 ;
build_scope : char24 ;
build_mode : char24 ;
access_key : char16 ;
appl_id : char8 ;
authcode : char8 ;
ddname : char8 ;
error_listings_only : char24 ;
found_group : char8 ;
language : char8 ;
group : char8 ;
listing_check : char24 ;
max_prom_group : char8 ;
msg_line : char80 ;
prefix_userid : char17 ;
project : char8 ;
project_def : char8 ;
retncode : INTEGER ;
pds_type : char8 ;
member : char8 ;
SCLM_id : char8 ;
sub_drawdown_mode : char24 ;
userid : char8 ;
verify_cc : char24 ;
(********************************************************************)
(* Define the main program *)
(********************************************************************)
BEGIN
(* Initialize terminal I/O. *)
TERMIN (INPUT) ;
TERMOUT(OUTPUT) ;
(* Initialize some working variables. *)
$stats_info_copy := NIL ;
$list_info_copy := NIL ;
(* Get the PDS/member name of the component to process. *)
WRITELN ('Enter the name of the project to process.' );
READLN (project);
WRITELN ('Enter the name of the project definition to process.' );
READLN (project_def);
IF
(project_def = ' ')
THEN
project_def := project;
WRITELN ('Enter the name of the development group to process.');
READLN (group);
WRITELN ('Enter the name of the type to process.');
READLN (pds_type);
WRITELN ('Enter the name of the member to process.');
READLN (member);
WRITELN ('Enter the language of the source member to register.');
READLN (language);
(* Issue a request to begin an SCLM service session. *)
SRVSTART ( appl_id,
retncode );
(* Continue processing only if the request succeeded. *)
IF
retncode <> 0
THEN
WRITELN ('SCLM service START failed, error code = ', retncode:-3 )
ELSE BEGIN
(* Issue a request to initialize an SCLM ID. *)
msg_line := ' ' ;
SRVINIT ( appl_id,
project,
project_def,
SCLM_id,
msg_line,
retncode );
(* Continue processing only if the request succeeded. *)
IF
retncode <> 0
THEN BEGIN
WRITELN ('SCLM service INIT failed, error code = ', retncode:-3 );
WRITELN ( msg_line );
END
ELSE BEGIN
(* Issue a request to lock the component. *)
authcode := ' ' ;
$acct_info := NIL ;
$list_info := NIL ;
$msg_array := NIL ;
SRVLOCK ( SCLM_id,
group,
pds_type,
member,
authcode,
' ', (* access_key *)
userid,
found_group,
max_prom_group,
$acct_info,
$list_info,
$msg_array,
retncode );
(* If the lock failed, print associated error messages. *)
IF
retncode <> 0
THEN BEGIN
WRITELN ('SCLM service LOCK failed, error code = ', ;
retncode:-3); ;
PUTMSGS ( $msg_array );
END
ELSE BEGIN
(* Display some of the accounting record fields *)
WRITELN ('The component has been locked.' );
WRITELN ('The component last changed date is: ',
$acct_info@.change_date );
WRITELN ('The component last changed time is: ',
$acct_info@.change_time );
WRITELN ('The component change-userid is: ',
$acct_info@.change_userid );
WRITELN ('The component version number is: ',
$acct_info@.member_version:-3 );
END;
(* Continue processing only if the member has been locked. *)
IF
retncode = 0
THEN BEGIN
(* Issue a request to parse the component to obtain *)
(* the statistical information SCLM requires. *)
$stats_info := NIL ;
SRVPARSE ( SCLM_id,
group,
pds_type,
member,
language,
'Y', (* error_listings_only = yes *)
'PRSLIST', (* ddname *)
$stats_info,
$list_info,
$msg_array,
retncode );
(* If the parse failed, print associated error messages. *)
IF
retncode <> 0
THEN BEGIN
WRITELN ('SCLM service PARSE failed, ',
'error code = ',retncode:-3 );
PUTMSGS ( $msg_array );
END
ELSE BEGIN
(* Copy all buffered service output into new buffers so *)
(* subsequent service calls do not delete the information. *)
WRITELN ('The component has been parsed.' );
NEW ( $stats_info_copy );
$stats_info_copy@ := $stats_info@ ;
NEW ( $list_info_copy );
COPYLIST ($list_info, $list_info_copy );
END;
END;
(* Continue processing only if the member has been parsed. *)
IF
retncode = 0
THEN BEGIN
(* Issue a request to register the component with SCLM *)
$stats_info := $stats_info_copy ;
$list_info := $list_info_copy ;
SRVSTORE ( SCLM_id,
group,
pds_type,
member,
' ', (* access_key *)
language,
userid,
'C', (* sub_drawdown_mode = cond. *)
'N', (* verify_cc = no *)
$stats_info,
$list_info,
$msg_array,
retncode );
(* If the store failed, print associated error messages. *)
IF
retncode <> 0
THEN BEGIN
WRITELN ('SCLM service STORE failed, ',
'error code = ',retncode:-3 );
PUTMSGS ( $msg_array );
END;
END;
(* Continue processing only if the member has been stored. *)
IF
retncode = 0
THEN BEGIN
(* Issue a request to build the component *) )
(* registered with SCLM. *) )
WRITELN ('The component has been stored.' );
prefix_userid := STR(userid) ;
SRVBUILD ( SCLM_id,
group,
pds_type,
member,
userid,
'N', (* build_scope = normal *)
'C', (* build_mode = conditional *)
'N', (* listing_check = no *)
'Y', (* breport_check = yes *)
prefix_userid,
bldmsgs, (* dd_bldmsgs *)
bldrept, (* dd_bldrept *)
bldlist, (* dd_bldlist *)
bldexit, (* dd_bldexit *)
retncode );
(* If the build failed, print error messages. *)
IF
retncode <> 0
THEN BEGIN
WRITELN ('SCLM service BUILD failed, ',
'error code = ',retncode:-3 );
WRITELN ('See the data set allocated to ddname=BLDMSGS ',
'for associated error messages.' );
END
ELSE
WRITELN ('The component has been built.' );
END;
(* Issue a request to free the SCLM ID. *)
SRVFREE ( SCLM_id,
msg_line,
retncode );
END; (* INIT succeeded *)
(* Issue a request to end this SCLM service session. *)
SRVEND ( appl_id,
msg_line,
retncode );
END; (* START succeeded *)
(* Free buffer memory if it is still allocated. *)
IF
$stats_info_copy <> NIL
THEN
DISPOSE ( $stats_info_copy );
IF
$list_info_copy <> NIL
THEN
DISPOSE ( $list_info_copy );
END. (* Main Program *)
z/OS ISPF Software Configuration and Library Manager Guide and Reference
Copyright IBM Corporation 1990, 2014