OpenVMS Source-Code Demos

LOGIN_HELPER.COM

$	set noon						!
$	set nover						!
$!====================================================================
$! title   : csmis_ict_ftp:login_helper.com
$! author  : Neil Rieck
$! created : 2008.06.19
$! edit    : 2011.08.02
$! function:
$! 1. we are trying to emulate an XCOM session (run a job on logout)
$! 2. an FTP/SFTP connection event submits this job
$! 3. the FTP/SFTP client then passes files to the [.data] folder
$! 4. this job loops until the FTP/SFTP client logs off
$! 5. then we process the received file(s)
$!====================================================================
$	set ver							!
$	bel[0,8]=7						!
$	my_debug=1						!
$	say :== write sys$output				!
$!
$	say "-i-scrp: ", f$environment("PROCEDURE")		!
$	sho def							! where are we right now?
$	if f$mode() .nes. "BATCH" then goto sortie		!
$	if p1 .eqs. ""						! name of the queueing process
$	then							!
$		say "-e- no P1, aborting"			!
$		goto sortie					!
$	endif							!
$	if p2 .eqs. ""						! pid of the queueing process
$	then							!
$		say "-e- no P2, aborting"			!
$		goto sortie					!
$	endif							!
$	say "-i-parameter 1: ",p1				! name of the queueing process
$	say "-i-parameter 2: ",p2				! pid of the queueing process
$!
$	on error then goto sortie				! prep for name change/test
$	set on							! enable error handling...
$	set proc/name="IctHelper"				! ...cuz we only want one of these
$	set noon						! ...now disable error handling
$!--------------------------------------------------------------
$! Wait here until the network partner disconnects, or 60 seconds passes
$!--------------------------------------------------------------
$start_count:							!
$	my_loop = 1						! init
$wait_loop:							!
$	if my_debug .gt. 0					!
$	then							!
$		say "=========="				!
$		say "-i-loop ",my_loop				!
$		sh sys/net/bat					!
$	endif							!
$!
$!	see if the target process is still on the system
$!
$	on warning then goto process_files			! jump if warning on next test (he's gone)
$	junk = f$getjpi(my_pid,"PRCNAM")			! is our process still on the system?
$	on error then goto sortie				! something horrible has gone wrong
$!
$!	he is still logged in so do som more testing
$!
$	if junk .nes. p1 then goto process_files		! jump if wrong name (pid already reissued?)
$	wait 0:0:10						! pause for 10 seconds
$	my_loop = my_loop + 1					!
$	if my_loop .lt. 6 then goto wait_loop			! loop if we haven't waited for 60 sec
$	say "-i-looped for 60 seconds so exiting"		!
$!====================================================================
$! The FTP client has disconnected so let's process the received files
$!====================================================================
$process_files:							!
$	set noon						! no stopping now...
$	my_node = f$getsyi("nodename")				!
$	pur/log/noco	*.txt					!
$	del/log		*.tmp;*					!
$	if f$mode() .eqs. "INTERACTIVE" then del/sym/glo mail	!
$	if my_node .eqs. "KAWC09"				!
$	then
$	    dir/width=(display=100,file=50)/nohead/notrail/output=listing.tmp	[.ACCEPTATION]BRT2*.txt
$	else
$	    dir/width=(display=100,file=50)/nohead/notrail/output=listing.tmp	[.ATS]BRT2*.txt
$	endif
$	open/read/error=my_error	my_file	listing.tmp	!
$read_loop:							!
$	read/end_of_file=my_error	my_file	my_buffer	!
$!~~~	my_dev	= f$parse(my_buffer,,,"DEVICE")			!
$!~~~	my_dir	= f$parse(my_buffer,,,"DIRECTORY")		!
$!~~~	my_name = f$parse(my_buffer,,,"NAME")			! yields something like: "AK123400" where 00 is a version number)
$!~~~	my_type = f$parse(my_buffer,,,"TYPE")			! yields: ".TXT"
$!~~~	my_arch = f$extract(f$length(my_name)-3,1,my_name)	! get last digit of order number (but skipping version number)
$	pos%    = f$locate(";",my_buffer)			!
$	my_fs1	= f$extract(0,pos%,my_buffer)			!
$!~~~	my_fs1	= my_dir + my_name + my_type			!
$	mail/subj="ICT-from-login-helper.com"  'my_fs1'  neil	! for debug purposes
$	def/proc CSMIS$ICT_FTP_INBOUND_FILE_INPUT 'my_fs1'	!
$	wait 0:0:01						!
$	stamp	= f$cvtime()					! eg. 2008-07-07 09:32:12.88
$	stamp	= stamp -"-" -"-" -" " -":" -":" -"."		! eg. 2008070709321288
$	my_fs2	= f$trnlnm("CSMIS_ICT_FTP")+"ICT"+ f$extract(0,14,stamp) +".XML"
$	def/proc CSMIS$ICT_FTP_INBOUND_FILE_OUTPUT 'my_fs2'	!
$	r csmis$exe:TRODB_FROM_SYSTEM5.EXE			! run this program
$	saved_status = $STATUS					!
$	say "status: ", saved_status				!
$	if ((saved_status .and. 7) .ne. 1)			!
$	then							!
$	    say "-e-oops, something failed"			!
$	else							!
$	    say "-e-yipee, processing was sucessful"		!
$	endif							!
$	ren/log	'my_fs1' [.archive]				! move this file to the archive below ftp.data
$	yada =	f$trnlnm("CSMIS_ICT_FTP") -"]" +"._archive]"	!
$	ren/log	'my_fs2' 'yada'					! move this file to the archive below sys$login
$	goto read_loop						!
$my_error:							!
$	close my_file						!
$	pur/log/noco/keep=10	*.log				!
$sortie:							!
$	set noon						!
$	del [...]brt20*.*;*/before="-7-0:0:0"/log		!
$!------------------------------------------------------------------------------------
$!	<<< do a little purging here >>>
$!
$!	notes:	1) the current user may not have sufficient privs
$!		2) this is a quick hack which will need a future cleanup
$!		3) should introduce some code so we only do this once per day
$!
$	say f$getjpi("","USERNAME")				!
$	del/log DISK$USER4:[CSMIS.CSMIS_ICT_FTP._ARCHIVE]ict20*.*;*/before="-7-0:0:0"
$!------------------------------------------------------------------------------------
$	exit							!