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$ = "you-at-your-location@home.com" ! change to your own email address
case "NSR" ! my initials
email_dst$ = "n.rieck@bell.net" ! my email address (res)
custom_page$ = "1" ! see next prompt
case "NEIL","BELL" !
email_dst$ = "neil.rieck@bell.ca" ! 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 ("&")
! note: obviously this must always be done first
!
op$ = find_n_replace(op$, "&", "&") !
!
! replace left caret ("<") with equivalient HTML entity ("<")
!
op$ = find_n_replace(op$, "<", "<") !
!
! replace right caret (">") with equivalient HTML entity (">")
!
! 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$, ">", ">") !
!
! some html parsers stumble on double slashes (so this routine changes every slash)
!
op$ = find_n_replace(op$, "/", "/")
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) +"<"+ "![[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) + "]]" + ">" ! 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) +">" 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 HomeNeil Rieck
Waterloo, Ontario, Canada.