OpenVMS Source Code Demos

TOOL_WEBIFY_SOURCE_CODE

1000	%title "tool_webify_source_code_xxx"					!
	%ident                      "version_112.1"				!
	declare string constant k_version = "112.1"			,	!	&
				k_program = "tool_webify_source_code"		!
	!==============================================================================================================
	! title  : tool_webify_source_code
	! author : Neil Rieck (http://neilrieck.net/)
	! notes  : this program has no commercial value and has been put into public domain for educational use only
	! history:
	! ver who when   what
	! --- --- ------ ----------------------------------------------------------------------------------------------
	! 100 NSR 110415 1. started original effort
	!     NSR 110416 2. much more work
	! 101 NSR 110417 1. removed the path from fs2$ (which is now only a filename)
	!     NSR 110422 2. added an option to remove source code version numbers from the filename
	!     NSR 110423 3. added a tweak (drop trailing whitespace)					bf_101.3
	! 102 NSR 110820 1. improved default logic
	!		 2. added code to allow the use of simpler methods (like CDATA)
	!			(which did not work so I just disabled for now :-) 			bf_102.2
	! 103 NSR 110820 1. replaced lib$spawn (temporary file stuff) with call to lib$find_file
	! 104 NSR 120727 1. added email synonym "neil"
	!     NSR 120825 2. now optionaly also delete the created document
	!		 3. replaced BASIC "kill" statements with calls to lib$spawn
	!     NSR 120910 4. now ask before removing suplerfluous file prefixes 				bf_104.4
	!		 5. now "remove source code number?" defaults to "Y"				bf_104.5
	! 105 NSR 120910 1. now ask client for output file format					bf_105.1
	! 106 NSR 141020 1. now mail attachments the VMS way (to support the new stack)
	!     NSR 141104 2. adding missing documentation
	!     NSR 141105 3. added two logicals so MIME.exe works with TCPWARE and MultiNet		bf_106.3
	! 107 NSR 141205 1. bug fix in directory scan
	! 108 NSR 151107 1. now format the output filename a little differently
	!     NSR 170531 2. dropped the Helvetica and Verdana fonts
	!		 3. changed "10pt" to "15px"
	!     NSR 170603 4. changed "15px" to "90%"
	!		 5. moved to an HTML5 doctype
	!		 6. migrated to the new style sheet
	! 109 NSR 170818 1. bug fix in style sheet logic
	!     NSR 170821 2. now translate filenames to lowercase
	! 110 NSR 170823 1. added a feature for list processing
	!     NSR 170828 2. removed code from the web counter
	!     NSR 170908 3. fixed a few small problems
	!     NSR 190420 4. a few tweaks to make Google's spider a little happier in 2019		bf_110.4
	! 111 NSR 200120 1. changed one of the default parameters for LIST-mode				bf_111.1
	! 112 NSR 201219 1. since some html parsers stumble on double slashes I decided to replace a slashes
	!==============================================================================================================
	option type=explicit							! no kid stuff
	set no prompt								!
	%let %neil=1%								! %neil=0 :general use
										! %neil=1 :enable stuff for neil's app
										! %neil=2 :neil's app requires ODS-5
	!
	!	external libraries
	!
	%include "lib$routines"	%from %library "sys$library:basic$starlet"	! for lib$spawn
	%include "$rmsdef"	%from %library "sys$library:basic$starlet"	! rms$
	!
	!	home brewed functions
	!
	external string function wcsm_upper_to_lower(string)			!
	external string function find_n_replace(string,string,string)		!
	!
	!	variables
	!
	declare	string	fs0$			,				! file spec0 (search)				&
			fs1$			,				! file spec1 (read)				&
			fs1_short$		,				! file spec1 short				&
			fs2$			,				! file spec2 (write)				&
			fs3$			,				!						&
			fs4$			,				!						&
			fs5$			,				!						&
			fs9$			,				!						&
			ext$			,				!						&
			junk$			,				!						&
			title$			,				!						&
			cmd$			,				! DCL command					&
			choice$			,				!						&
			ip$			,				!						&
			op$			,				!						&
			program_mode$		,				!						&
			processing_mode$	,				!						&
			email_dst$		,				!						&
			general_custom_default$	,				!						&
			custom_page$		,				!						&
		long	remove_scvn%		,				!						&
			i%			,				!						&
			j%			,				!						&
			semicolon_pos%		,				! semicolon position				&
			rbracket_pos%		,				! right bracket position			&
			colon_pos%		,				! colon position				&
			sentinel_pos%		,				! sentinel position				&
			dot_pos%		,				! dot position					&
			us_pos%			,				! underscore position				&
			debug%			,				!						&
			junk%			,				!						&
			custom%			,				!						&
			temp%			,				!						&
			open_mode%		,				!						&
			rc%			,				!						&
			count%			,				!						&
			choice%			,				!						&
			source_line%		,				!						&
			dest_line%		,				!						&
			mode%			,				!						&
			stage%							!
	!
	declare string constant exclam = '33'C					! exclamation
	declare string constant	ctag1$ = "<![CDATA["				!
	declare string constant ctag2$ = "]]>"					!
	!
	!====================================================================================================
	!	<<< main >>>
	!====================================================================================================
2000	main:
	junk$ = k_program + "_" + k_version					!
	print string$( len(junk$), ascii("=") )					! print a line
	print junk$								! print program title
	print string$( len(junk$), ascii("=") )					! print a line
	!
	print "============================================================"
	print " Question 0/10"
	print "============================================================"
	input "mode: I/ndividual file or L/ist? (default=I) "; program_mode$	! welcome to the spaghetti zone
	program_mode$ = edit$(program_mode$,32+2)				!
	select program_mode$							!
	    case "L"								!
		input "list file name: ";fs9$					!
	    case else								!
		program_mode$ = "I"						!
		goto get_fs							!
	end select								!
	!
	when error in								!
	    open fs9$ for input as #69						!
	    while 1								!
		linput #69, fs1$						!
		print "##### processing file: ";fs1$				!
		gosub entry_point						!
		print "##### finished processing file: ";fs1$			!
		sleep 5								!
	    next								!
	use									!
	    print "-e-status:";err;"in LIST mode"				!
	end when								!
	goto final_exit								!
	!
	!=======================================================================
	!
	get_fs:									!
	print "============================================================"
	print " Question 1/10"
	print "============================================================"
	print "input filespec to search:"					!
	print "examples: yada*.bas"						!
	print "          yada*.inc"						!
	print "          yada*.fun"						!
	print "          yada*.c"						!
	print "          yada*.cxx"						!
	print "     exact-name.ext"						!
	print " or Q/uit"							!
	input "full/partial file spec? (filespec,Q,default=*.bas) ";fs0$	!
	junk% = 0								! init our test
	junk% = 1 if pos(edit$(fs0$,32),".HTM",1)>0				! .HTM or. HTML ?
	junk% = 1 if pos(edit$(fs0$,32),".XML",1)>0				! .XML ?
	if junk% = 1 > 0 then							!
	    print "-e-error: you may not enter extensions of: .htm or .html or .xml"
	    goto get_fs								!
	end if 									!
	fs0$ = edit$(fs0$,4+2)							! remove controls + white space
	select edit$(fs0$,32)							! upcase for test
	    case "Q","E","X"							!
		goto sortie							!
	    case ""								!
		fs0$ = "*.bas"							!
	end select								!
	if pos(fs0$,"/",0)>0 then						!
	    print "-e-oops: your entry doesn't make sense"			!
	    goto get_fs								!
	end if 									!
	if (pos(fs0$,".",0) = 0) then						!
	    print "-e-oops, you must enter a dot"				!
	    goto get_fs								!
	end if									!
	if (len(fs0$) < 2) then							!
	    print "-e-oops, a filespec must contain at least two characters"	!
	    goto get_fs								!
	end if									!
	if (pos(fs0$,";",0) = 0) then						! if a specific version isn't desired
	    fs0$ = fs0$ +";"							! then only show the most recent version
	end if									!
	print "============================================================"
	print " Question 2/10"
	print "============================================================"
	if  (pos(fs0$,"]",0) = 0) and (pos(fs0$,"[",0) = 0)			! if no directory specs				&
	then									!
	    search_menu_loop:							!
	    print "search menu: "						!
	    print " 1) only search the current directory"			!
	    print " 2) search current and subdirectories" 			!
	    print " Q) quit"							!
	    input "choice? (1-3,default=1) ";choice$				!
	    choice$ = left$( edit$(choice$,4+2), 1)				!
	    select choice$							!
		case "1",""							!
		case "2"							!
		    fs0$ = "[...]"+fs0$						!
		case "Q","X","E"						!
		    goto sortie							!
		case else							!
		    print "-e-oops, bad choice"					!
		    goto search_menu_loop					!
	    end select								!
	end if									!
	!
	print "-i-target fs: "+ fs0$						!
	!
	declare long constant k_max_file_names = 500				!
	declare long file_context%						!
	declare long file_name_pointer%						!
	file_name_pointer% = 0							!
	dim string file_names$(k_max_file_names)				! init
	!
	file_context% = 0							! init (for good form)
	read_loop1:								!
	rc% = lib$find_file(fs0$, junk$, file_context%)				! does the folder/file exist?
	select rc%								!
	    case    RMS$_NORMAL							! found something
		if file_name_pointer% < k_max_file_names then			!
		    file_name_pointer% = file_name_pointer% + 1			!
		    file_names$(file_name_pointer%)=junk$			!
		    goto read_loop1						! yeah, I know, bad form
		end if								!
	    case    RMS$_NMF							! no more files
	    case    RMS$_FNF							! file-not-found
		print "-e- oops, file not found"				!
	    case    RMS$_DNF							! directory-not-found
		print "-e- oops, directory not found"				!
	    case else								! oops
		print "-e-  lib$find_file error: "+ str$(rc%)			!
	end select								!
	!
	if file_name_pointer% = 0 then						!
	    print "-e-no files were detected using your search criteria"	!
	    goto get_fs								!				***--->>>
	end if									!
	!
	print "============================================================"
	print " Question 3/10"
	print "============================================================"
	when error in								!
	    count% = 1								!
	    print "Directory:"							!
	    print "#### File name________________________________________"	!
	    while count% <= file_name_pointer% 					!
		print format$(count%,"#### ") + file_names$(count%)		!
		count% = count% + 1						!
	    next								!
	use									!
	end when								!
	!
	!	now let the user choose a file number
	!
	choice_loop:								!
	print "Note: your original file will not be modified"			!
	print "Webify which file? (1-"+ str$(file_name_pointer%) +", 0=none) ";	!
	input choice$								! get his choice (number)
	when error in								!
	    choice% = integer(choice$)						!
	use									!
	    choice% = -1							!
	end when								!
	select choice%								!
	    case 0								!
		goto sortie							!				***--->>>
	    case -1, > file_name_pointer%					!
		print "-e-bad input"						!
		goto choice_loop						!
	end select								!
	fs1$ = file_names$(choice%)						! this is the filespec he wants
	!
	!	entry pt for LIST mode
	!
	entry_point:
	fs1$ = wcsm_upper_to_lower(fs1$)					!
	!
	!	now get a few options before processing this file
	!
	found_it:								!
	if program_mode$ = "L" then
		junk$ = ""
		goto input04
	end if
	print "============================================================"
	print " Question 4/10"
	print "============================================================"
	print "menu:"								!
	print "  1) minimal cleanup jammed between <pre> and </pre>"		!
	print "  2) full cleanup (builds a full web page)"			!
	print "  Q) quit"							!
	input "choice? (default=2) ";junk$					!
	input04:
	junk$ = edit$(junk$,32+4+2)						!
	select left$(junk$,1)							!
	    case ""								!
		processing_mode$ = "2"						!
	    case "1","2"							!
		processing_mode$ = left$(junk$,1)				!
	    case "Q","E","X"							!
		goto sortie							!
	    case else								!
		print "-e-oops, bad choice..."					!
		goto found_it							!
	end select								!
	!
	get_mode:								!
	print "============================================================"
	print " Question 5/10"
	print "============================================================"
   %let %cdata=0%								!
   %if  %cdata=0% %then								!
	print "-i-question 5 (CDATA) is bypassed for now"			!
	mode% = 2								! HTML entities
   %else									!
	print "mode:"								!
	print "  1) use CDATA method with minimal processing"			!
	print "  2) translate special characters into HTML Entities"		!
	print "  Q) quit"							!
	input "choice? (default=1) ";junk$					!
	junk$ = left$(edit$(junk$,32+4+2),1)					!
	select junk$								!
	    case ""								!
		mode% = 1							!
	    case "1","2"							!
		mode% = integer(junk$)						!
	    case "Q","E","X"							!
		goto sortie							!
	    case else								!
		print "-e-oops, bad choice..."					!
		goto get_mode							!
	end select								!
    %end %if									!
	!
	email_prompt:								!
	if program_mode$ = "L" then						!
!~~~		email_dst$ = "nsr"						x
		email_dst$ = "BELL"						!					bf_111.1
		goto input06							!
	end if
	print "============================================================"
	print " Question 6/10"
	print "============================================================"
	input "-?-email address? (default=none) ";email_dst$			!
	input06:
	email_dst$ = edit$(email_dst$,4+2)					! no white-space
	select edit$(email_dst$,32)						! upcase for tests
	    case ""								!
		email_dst$ = ""							!
	    case "XXX"								! change to your own initials
		email_dst$ = "[email protected]"			! change to your own email address
	    case "NSR"								! my initials
		email_dst$ = "[email protected]"				! my email address (res)
		custom_page$ = "1"						! see next prompt
	    case "NEIL","BELL"							!
		email_dst$ = "[email protected]"				! my email address (biz)
		custom_page$ = "G"						! see next prompt
	    case else								!
!		print "-e-oops, bad email option"				x
!		goto email_prompt						x
	end select								!
	!
	if email_dst$ <> "" then						!
	    sentinel_pos% = pos(email_dst$,"@",0)				!
	    dot_pos% = pos(email_dst$,"@",sentinel_pos%)			!
	    if	sentinel_pos% <= 3	or					! need space for 3 characters (eg. xyz@yada)	&
		dot_pos% > len(email_dst$) -2					! need space for 2 characters (eg. yada.ca)
	    then								!
		print "-e-oops, bad email format"				!
		goto email_prompt						!
	    end if 								!
	    print "-i-email destination: "+ email_dst$				!
	    sleep 1								!
	end if									!
	!
	if program_mode$ = "L" then
		junk$ = "1"
		goto input07
	end if
	print "============================================================"
	print " Question 7/10"
	print "============================================================"
	print "General / Custom HTML:"						!
	print "  G/eneral    : STYLES in HEAD (default)"			!
	print "  1 = Custom-1: STYLES imported via LINK in HEAD (for NSR)"	!
	print "  2 = Custom-2: STYLES imported via LINK in HEAD"		!
	print "  3 = Custom-3: STYLES imported via LINK in HEAD"		!
	if custom_page$ = "" then						! if not yet set
	    general_custom_default$ = "G"					! G/eneral
	else									!
	    general_custom_default$ = custom_page$ 				! custom
	end if									!
	print "General-page or Custom-page? (G,1-3,default="+ general_custom_default$ +") ";
	input junk$								!
	input07:
	junk$ = edit$(junk$,32+4+2)						!
	junk$ = general_custom_default$ if junk$ = ""				!
	when error in								!
	    custom% = integer(junk$)						!
	use									!
	    custom% = 0								!
	end when								!
	!
	if program_mode$ = "L" then
		junk$ = "y"
		goto input08
	end if
	print "============================================================"
	print " Question 8/10"
	print "============================================================"
	print "Note: For file names of the format: program64_123.bas,"		!
	print "'_123' is the source code version number"			!
	print									!
	input "Remove source code version number? (y/n, default=Y) ";junk$	!					bf_104.5
	input08:
	select left$(edit$(junk$,32+2),1)					!
	    case "Y",""								!					bf_104.5
		remove_scvn% = 1						!
	    case else								!
		remove_scvn% = 0						!
	end select								!
	!
	!	now isolate the filename for various purposes
	!	note: vms filenames contain a version number (eg. name.ext;123 where 123 is the version number)
	!
	rbracket_pos% = pos(fs1$,"]",1)						! this might not exist
	colon_pos% = pos(fs1$,":",1)						! this might not exist
	junk% = max(rbracket_pos%,colon_pos%)					!
	fs1_short$ = right$(fs1$, junk%+1)					!
	semicolon_pos% = pos(fs1_short$,";",1)					! this should exist
	fs1_short$ = left$(fs1_short$,semicolon_pos%-1) if semicolon_pos% <> 0	!
	!
	!	Our shop does not have a source code repository so we manage code the old fashioned way:
	!		by appending an underscore and version number to the filename.
	!		(eg. program64_123.bas where 123 is our source code version number)
	!
	goto rscvn_exit	if remove_scvn% = 0					!
	remove_src_code_version_number:						!
	for i% = len(fs1_short$) to 1 step -1					! start scanning from the end
	    if mid$(fs1_short$,i%,1) = "." then					! if this a dot
		dot_pos% = i%							! then Spock says: remember this
		goto rscvn2							! jump to next block
	    end if								!
	next i% 								!
	goto rscvn_exit								! oops; not found so jump
	!
	rscvn2:									! remove_source_code_version_number - step 2
	for i% = dot_pos% to 1 step -1						! start scanning from the final dot
	    if mid$(fs1_short$,i%,1) = "_" then					! underscore?
		us_pos% = i%							! Spock says: remember this
		goto rscvn3							!
	    end if								!
	next i% 								!
	goto rscvn_exit								! oops; not found so jump
	!
	rscvn3:									! remove_source_code_version_number - step 3
	when error in								!
	    junk$ = seg$(fs1_short$, us_pos%+1, dot_pos%-1)			! is the area between "_" and "." numeric?
	    junk% = integer(junk$)						!
	use									!
	    junk% = 0								!
	end when								!
	if junk% > 0 then							! yes
	    !
	    !	entry:	fs1_short$	program64_123.bas
	    !	exit :			program64.bas
	    !
	    fs1_short$ = left$(fs1_short$,us_pos%-1) + right$(fs1_short$,dot_pos%)
	end if									!
	rscvn_exit:
	!
	!	my previously published public-domain demos contained prefixes which I (may) want to remove here
	!	entry: fs1_short$	BASIC_program_name.bas
	!	exit:			program_name.bas
	!
    %if  %neil>0% %then								!
	junk% = 0								! init
	junk$ = edit$(fs1_short$, 32)						! prep for test
	junk% = 2	if pos(junk$,"C-"	,1) = 1				!
	junk% = 2	if pos(junk$,"C_"	,1) = 1				!
	junk% = 4	if pos(junk$,"BAS-"	,1) = 1				!
	junk% = 4	if pos(junk$,"BAS_"	,1) = 1				!
	junk% = 6	if pos(junk$,"BASIC-"	,1) = 1				!
	junk% = 6	if pos(junk$,"BASIC_"	,1) = 1				!
	junk% = 4	if pos(junk$,"COM-"	,1) = 1				!
	junk% = 4	if pos(junk$,"COM_"	,1) = 1				!
	if junk% > 0 then							!
	    if program_mode$ = "L" then
		junk$ = ""
		goto input09
	    end if
	    print "============================================================"
	    print " Question 9/10"
	    print "============================================================"
	    question9:								!
	    print "Remove superfluous file-name prefix? (y/n,default=N) ";	!					bf_104.4
	    input junk$								!					bf_104.4
	    input09:								!
	    select left$(edit$(junk$,32+2),1)					!					bf_104.4
		case "Y"							!
		    fs1_short$ = right$(fs1_short$,junk%+1)			!
		case "N",""
		case else
		    print "-e-Oops! Bad choice."
		    goto question9
	    end select								!
	end if									!
    %end %if
	title$ = fs1_short$
	!
	!========================================================================================================================
	!	now process the selected file
	!========================================================================================================================
3000	process:								!
	close #1								!
	!
	!	entry:	fs1_short$	= program-name.bas
	!		title$		= program-name.bas
	!	exit:	fs2$		= program-name.html	or	(too simple)
	!				= bas_program-name.html	or	(too convoluted)
	!				= program-name_bas.html	or	(better)
	!				= program-name.bas.html	or	(best but requires 'ODS-5 formatted' VMS volume)
	!
	junk% = pos(fs1_short$,".",1)						! find a dot (should always be one)
	if junk% > 0 then							! if "a" dot was found...
	    find_next_dot:							!
	    temp% = pos(fs1_short$,".",junk%+1)					! any more dots?
	    if temp% > 0 then							! if yes...
		junk% = temp%							!
		goto find_next_dot						! loop until we find the last one
	    end if								!
	    !
	    ext$ = right$(fs1_short$, junk%+1)					! isolate extension
	    fs1_short$ = left$(fs1_short$, junk%-1)				! drop the trailing dot
	end if									!
	!
	if ext$ = "" then							! no extension
	    fs2$ = fs1_short$ +".html"						! ...so just tack on an extension
	else
	    get_file_format:							!
	    if program_mode$ = "L" then
		junk$ = ""
		goto input10
	    end if
	    print "============================================================"
	    print " Question 10/10"
	    print "============================================================"
	    print "desired output file format:"					!
	    print " 1. program-name.html"					! too simple
	    print " 2. ext_program-name.html"					! too convoluted
	    print " 3. program-name_ext.html   (<<< default)"			! better
	    print " 4. program-name.ext.html   (requires ODS-5 volume)"		! best
	    input "Output File Format? (1-4, default=3) ";junk$			!
	    input10:
	    select left$(edit$(junk$,4+2),1)					!
		case "1"							!
		    !
		    !	produces: program-name.html
		    !
		    fs2$ = fs1_short$ +".html"					!
		case "2"
		    !
		    !	produces: ext_program-name.html
		    !
		    fs2$ = ext$ +"_"+ fs1_short$ +".html"			!
		case "3",""							! <--- default
		    !
		    !	produces: program-name_ext.html
		    !
		    fs2$ = fs1_short$ +"_"+ ext$ +".html"			!
		case "4"
		    !
		    !	produces: program-name.ext.html
		    !
		    fs2$ = fs1_short$ +".html"					!
		case else							!
		    print "-e-Oops, bad choice"					!
		    goto get_file_format					!
	    end select								!
	end if									!
	!
	fs2$ = wcsm_upper_to_lower(fs2$)					!
	print "======================================================================"
	print " starting webification"
	print "======================================================================"
	when error in								!
	    print "-i-open input : ";fs1$					!
	    open fs1$ for input as #1						! open the source file	&
		,recordsize	999						&
		,recordtype any
	    !
	    print "-i-open output: ";fs2$					!
	    open fs2$ for output as #2						!			&
		,recordsize	999						!
	    !
	    if processing_mode$ = "2" then					!
		print #2, '<!DOCTYPE html>'
		print #2, '<html>'						!
		print #2, '<head>'						!
		print #2, '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">'		!		bf_110.4
		print #2, '<meta name="viewport" content="width=device-width, initial-scale=1">'	!		bf_110.4
		print #2, '<title>'+ title$ + '</title>'			!
		select custom%							!
		    case 1							! Neil's custom style
			print #2, '<link href="../css/demo-20170503.css" rel="stylesheet" type="text/css">'
		    case else							! General style
			print #2, '<style type="text/css">'			!
			print #2, ' body { font-family: Arial, sans-serif; font-size:90%; '+	&
					'background-color: #fff; min-width: 850px }'
			print #2, ' pre { font-family: "Courier New", monospace}'
			print #2, ' a { text-decoration: none; color: blue }'
			print #2, ' a:link { text-decoration: none; color: blue }'
			print #2, ' a:visited { text-decoration: none; color: blue }'
			print #2, ' a:hover { text-decoration: none; color: blue; background-color: #ffb; cursor: pointer }'
			print #2, ' a:active { text-decoration: none; color: blue }'
			print #2, ' h1 { color: red }'
			print #2, ' h2 { color: white; padding: 4px; background-color: green }'
			print #2, ' h3 { color: white; padding: 4px; background-color: #369; width: 98% }'
			print #2, '</style>'
		end select							!
		print #2, '</head>'						!
		print #2, '<body>'						!
		print #2, '<h1>OpenVMS Source-Code Demos</h1>'			!
		print #2, '<h2>'+ fs1_short$ +'</h2>'				!
	    end if								!
	    print #2, '<pre style="font-weight:700">'				!
	    print #2, ctag1$				if mode% = 1		! CDATA opening tag
	    !
	    while 1								!
		linput #1, ip$							! read input
		source_line% = source_line% + 1					!
		if mode% = 1 then						!
		    gosub process_a_line_cdata					!
		else								!
		    gosub process_a_line_html					!
		end if								!
		print #2, op$							! write output
		dest_line% = dest_line% + 1					!
	    next								!
	use									!
	    select err								!
		case 11								!
		    print "-i-status: "+ str$(err)				!
		    print "-i-last line detected"				!
		case else							!
		    print "-e-status: "+ str$(err)				!
		    print "-i-error exit during source file read"		!
	    end select								!
	end when								!
	print #2, ctag2$				if mode% = 1		! CDATA closing tag
	print #2, '</pre>'							!
	!
	goto no_more_html if processing_mode$ <> "2"					!
	select custom%									!
	    case 1									! Neil's custom footer
		print #2, '<hr>'							!
		print #2, '<p><strong>'							!
		print #2, '<a href="../links/openvms_resources.html">'			!
		print #2, '<img src="../images/hand_left.gif" alt="left hand"></a>'	!
		print #2, 'Back to <a href="../links/openvms_resources.html">OpenVMS</a><br>'
		print #2, '<a href="openvms_demo_index.html">'				!
		print #2, '<img src="../images/hand_left.gif" alt="left hand"></a>'	!
		print #2, 'Back to <a href="openvms_demo_index.html">OpenVMS Demo Index</a><br>'
		print #2, '<a href="../index.html">'					!
		print #2, '<img src="../images/home04.gif" alt="home"></a>'		!
		print #2, 'Back to <a href="../index.html">Home</a><br>'		!
		print #2, 'Neil Rieck<br>Kitchener - Waterloo - Cambridge, Ontario, Canada.'
 %let %counter=0
 %if  %counter=1 %then
		print #2, '<br><img alt="counter" '				+					&
			  'src="http://www3.sympatico.ca/cgi-bin/Count.cgi?dd=E|df=nrieck20041019|sh=0|incr=1">'+	&
			  '</strong></p>'					!
 %else
		print #2, '</p>'						!
 %end %if									!
	end select								!
	print #2, '</body>'							!
	print #2, '</html>'							!
	no_more_html:
	print "------------------------------------------------------------"
	print str$(source_line%)+" lines were read"				!
	print str$(dest_line%)+" lines were written"				!
	if source_line% <> dest_line% then					!
	    print "*** Danger: lines read <> lines written ***"+ bel		!
	end if									!
	close #1, #2								!
	!
	if email_dst$ <> "" then						!
	    fs5$ = k_program +"_scratch.zip"
	    cmd$ = "$zip "+ fs5$ +" "+ fs2$					!
	    print "-i-executing DCL cmd: "+ cmd$				!
	    rc% = lib$spawn(cmd$)						! let DCL execute this command
	    if ((rc% and 7%) <> 1%) then					!
		print "-e-lib$spawn error: "+ str$(rc%)				!
		goto sortie							!				***--->>>
	    end if								!
	end if									!
	!
	if email_dst$ <> "" then						!
	    !
	    !	LIB$GET_LOGICAL logical-name [,resultant-string] [,resultant-length] [,table-name]
	    !
 %let %tcpwareonly=0								!
 %if  %tcpwareonly=0 %then							! all stacks
	    fs4$ = k_program +"_scratch.mime"					!
	    fs3$ = k_program +"_scratch.com"					!
	    when error in							!
		print "-i-open output: ";fs3$					!
		open fs3$ for output as #3					&
		    ,recordsize	32700						!
		print #3,"$!==="						!
		print #3,"$! file: ";fs3$					!
		print #3,"$! time: ";date4$(0);" ";time$(0)			!
		print #3,"$ set noon"						!
		print #3,"$ MIME :== $SYS$SYSTEM:MIME.EXE"			!
		print #3,"$ MIME"						!
		print #3,"new/noedit "+ fs4$
		print #3,"add "+fs5$ +" /encode=base64"				!
		print #3,"save"							!
		print #3,"exit"							!
		print #3,"$ define MULTINET_SMTP_ALLOW_MIME_SEND Y"		!					bf_106.3
		print #3,"$ define TCPWARE_SMTP_ALLOW_MIME_SEND  Y"		!					bf_106.3
		print #3,"$ mail/subject="+ k_program +" "+ fs4$ +' "'+ email_dst$ +'"'
		print #3,"$ deas   MULTINET_SMTP_ALLOW_MIME_SEND"		!					bf_106.3
		print #3,"$ deas   TCPWARE_SMTP_ALLOW_MIME_SEND"		!					bf_106.3
		print #3,"$ exit"						!
		print #3,"$!==="						!
		close #3							!
	    use									!
	    end when								!
	    cmd$ = "$@"+ fs3$							!
 %else										! only works for TCPware
	    rc% = lib$get_logical("TCPWARE", junk$,,"LNM$SYSTEM_TABLE")		!
	    if ((rc% and 7%) <> 1%) then					!
		cmd$ = '$mail           /subject='+ k_program + fs5$ +'; "'+ email_dst$ +'"'
	    else								! TCPWARE method to send attachments
		print "-i-TCPWARE detected (the next command only works properly with TCPware 5.7-2 and higher)"
		cmd$ = '$mail/for/type=1/subject='+ k_program + fs5$ +'; "'+ email_dst$ +'"'
	    end if								!
 %end %if
	    print "-i-executing DCL cmd: "+ cmd$				!
	    rc% = lib$spawn(cmd$)						! let DCL execute this command
	    if ((rc% and 7%) <> 1%) then					!
		print "-e-lib$spawn error: "+ str$(rc%)				!
		goto sortie							!				***--->>>
	    end if								!
	end if									!
	!
	goto sortie								!				***--->>>
	!
	!=======================================================================
	!	process a line (xlate into HTML entities)
	!	entry:	ip$ = original data
	!	exit:	op$ = changed data
	!=======================================================================
	declare	long	pos1%	,&
			pos2%
	!
	process_a_line_html:							!
	op$ = edit$(ip$,128)							! drop trailing white space		bf_101.3
	!
	!	replace ampersand ("&") with equivalient HTML entity ("&amp;")
	!	note: obviously this must always be done first
	!
	op$ = find_n_replace(op$, "&",	"&amp;")				!
	!
	!	replace left caret ("<") with equivalient HTML entity ("&lt;")
	!
	op$ = find_n_replace(op$, "<",	"&lt;")					!
	!
	!	replace right caret (">") with equivalient HTML entity ("&gt;")
	!
	!	caveat: many html docs say you do not need to do this, however, many web tools like
	!	MS-FrontPage and MS-Expression-Web are happier with it (see highlighting in code mode)
	!
	op$ = find_n_replace(op$, ">",  "&gt;")					!
	!
	!	some html parsers stumble on double slashes (so this routine changes every slash)
	!
	op$ = find_n_replace(op$, "/",  "&#47;")
	return									!
	!
	!=======================================================================
	!	process a line (CDATA)
	!=======================================================================
	process_a_line_cdata:							!
	ip$ = edit$(ip$,128)							! drop trailing white space		bf_102.2
	op$ = ""								! init output buffer
	!
	!	replace opening CDATA tag with equivalient HTML entities
	!
	o_cdata_init:								!
	pos1% = 0								! init starting ptr
	o_cdata_loop:								!
	pos2% = pos(ip$, ctag1$, pos1%+1)					! find CDATA tag
	if pos2% = 0 then							! if none or no more
	    op$ = op$ + seg$(ip$, pos1%+1, len(ip$))				!
	else									!
	    op$ = op$ + seg$(ip$, pos1%+1, pos2%-1) +"&lt;"+ "![[CDATA["	!
	    pos1% = pos2%							! advance starting pointer
	    goto o_cdata_loop							!
	end if									!
	!
	!	replace closing CDATA tag with equivalient HTML entities
	!
	c_cdata_init:								!
	ip$ = op$								! init
	op$ = ""								!
	pos1% = 0								! init starting ptr
	c_cdata_loop:								!
	pos2% = pos(ip$, ctag2$, pos1%+1)					! find the left caret
	if pos2% = 0 then							! if none or no more
	    op$ = op$ + seg$(ip$, pos1%+1, len(ip$))				!
	else									!
	    op$ = op$ + seg$(ip$, pos1%+1, pos2%-1) + "]]" + "&gt;"		! modified equivalent
	    pos1% = pos2%							! advance starting pointer
	    goto c_cdata_loop							!
	end if									!
	!
	return									!
	!=======================================================================
	!	<<< adios >>>
	!=======================================================================
	sortie:									!
	close #1,2								!
	if program_mode$ = "L" then
	    junk$ = ""
	    goto input11
	end if
	print "<<< cleanup area >>>"						!
	print "  scratch files:"						!
	print "    "+ fs2$	if fs2$ <> ""					!
	print "    "+ fs3$	if fs3$ <> ""					!
	print "    "+ fs4$	if fs4$ <> ""					!
	print "    "+ fs5$	if fs5$ <> ""					!
	input "-?-erase these scratch files? (y/n,default=y) ";junk$		!
	input11:
	select left$(edit$(junk$,32+4+2),1)					! upcase for test
	    case "","Y"								!
		if fs2$ <> "" then						!
		    print "-i-deleting: "+ fs2$					!
		    cmd$ = "delete/log/noconfirm "+ fs2$ +";"			!
		    junk% = lib$spawn(cmd$)					!
		    if (junk% and 7%) <> 1% then				!
			print "-e-lib$spawn-rc: "+str$(junk%)			!
		    end if							!
		end if								!
		!
		if fs3$ <> "" then						!
		    print "-i-deleting: "+ fs3$					!
		    cmd$ = "delete/log/noconfirm "+ fs3$ +";"			!
		    junk% = lib$spawn(cmd$)					!
		    if (junk% and 7%) <> 1% then				!
			print "-e-lib$spawn-rc: "+str$(junk%)			!
		    end if							!
		end if								!
		!
		if fs4$ <> "" then						!
		    print "-i-deleting: "+ fs4$					!
		    cmd$ = "delete/log/noconfirm "+ fs4$ +";"			!
		    junk% = lib$spawn(cmd$)					!
		    if (junk% and 7%) <> 1% then				!
			print "-e-lib$spawn-rc: "+str$(junk%)			!
		    end if							!
		end if								!
		!
		if fs5$ <> "" then						!
		    print "-i-deleting: "+ fs5$					!
		    cmd$ = "delete/log/noconfirm "+ fs5$ +";"			!
		    junk% = lib$spawn(cmd$)					!
		    if (junk% and 7%) <> 1% then				!
			print "-e-lib$spawn-rc: "+str$(junk%)			!
		    end if							!
		end if								!
	end select								!
	return if program_mode$ = "L"						! loop back if this is LIST mode
	!=======================================================================
	!	final exit
	!=======================================================================
32000	final_exit:
	print "Adios..."							!
	end									!
	!#######################################################################
	!
32100	%include "[.fun]WCSM_UPPER_TO_LOWER.FUN"
	!
	!	find and replace
	!
32110	function string find_n_replace(string inbound,a,b)			!
	option type=explicit							!
	declare string	ip$,	op$,		&
		long	pos1,	pos2
	!
	ip$ = inbound								! copy
	op$ = ""								! init
	pos1 = 0								! init starting ptr
	!
	loop:									!
!~~~	pos2 = pos(ip$, ">", pos1+1)						x find the "left caret"
	pos2 = pos(ip$,   a, pos1+1)						! find the
	if pos2 = 0 then							! if none or no more
	    op$ = op$ + seg$(ip$, pos1+1, len(ip$))				!
	else									!
!~~~	    op$ = op$ + seg$(ip$, pos1+1, pos2-1) +"&gt;"			x replace with html entity
	    op$ = op$ + seg$(ip$, pos1+1, pos2-1) +    b			!
	    pos1 = pos2								! advance starting pointer
	    goto loop								!
	end if									!
	!
	find_n_replace = op$							!
	end function								!
	!

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.