home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / cheklink.zip / chekindx.cmd next >
OS/2 REXX Batch file  |  1998-05-11  |  31KB  |  1,078 lines
  1. /*Make a site index, using a CheckLink linkage file.
  2.   This site index is meant for public display -- it does not
  3.   contain the back and forward links contained in cheklnk2  output.
  4. */
  5. chekindx:
  6.  
  7. /***  BEGIN USER CONFIGURABLE PARAMETERS     */
  8.  
  9. /* used in <BODY back_1> element */
  10. back_1='bgcolor="#aabb99"  '
  11.  
  12. /*  Directory containing link file(s)  */
  13. linkfile_dir=''
  14.  
  15.  
  16. /* A fully qualified file containing "header" information.
  17.   If ='', then a generic header is used 
  18.   If specified, the file MUST contain at least:
  19.        <HTML><HEAD>.... </HEAD> <BODY ...>
  20.    and should contain a replacment for
  21.           <h2>Index of Servername </h2> 
  22.   Note: use of user_intro1  means that back_1 is NOT used 
  23. */
  24. user_intro1=''
  25.  
  26.  
  27. /* list of links to "pictures" that will be displayed alongside the
  28. "titles". 
  29. Syntax is:  pix.n= mimetype1  selector
  30.             pix.0 is the number of pix. entries, (if 0, no pictures included
  31.         and pix.!text is included in the <IMG element
  32. Note that the first (possibly wildcarded) match is used */
  33. pix.0=0
  34. pix.1='text/plain  /imgs/text.gif '
  35. pix.2='image/* /imgs/image.gif '
  36. pix.3='text/html '
  37. pix.!include=' height=18 width=18 ALT="*" align="center" '
  38.  
  39. /* string to use to indent rows of a table. I.e; td_indent='<td> _ </td> '
  40.   Special value: td_indent=integer_value' means: 
  41.     <IMG src="\imgs\1 Pixel.gif" width=iss>
  42.   where iss=td_indent * #_levels
  43. */
  44. td_indent='<td bgcolor="#789966"> <font color="#789966">__</font></td>'
  45. td_indent=25
  46.  
  47. /* <TD modifier when writing title and link; descrip_td='valign="TOP" ' */
  48. td_title='valign="TOP" bgcolor="#a2a9a9" '
  49.  
  50. /* <TD modifier when writing descriptions. I.e.; descrip_td='valign="TOP" ' */
  51. td_descrip='valign="TOP"'
  52.  
  53. /* <TR modifiers: odd and even rows. I.e.; descrip_tr1='Bgcolor="#559988"' */
  54. tr_mod1=''
  55. tr_mod2=''
  56.  
  57. /***  END USER CONFIGURABLE PARAMETERS     */
  58.  
  59.  
  60. parse arg  ddir, tempfile, reqstrg,list,verb ,uri,user, ,
  61.           basedir ,workdir,privset,enmadd,transaction,verbose, ,
  62.          servername,host_nickname,homedir,aparam,semqueue,prog_file
  63.  
  64. crlf='0d0a'x
  65.  
  66.  
  67. call load       /* some dlls */
  68.  
  69. /* check for CGI-BIN call */
  70. is_cgi=0
  71. if verb="" then do    /* is it cgi-bin? */
  72.    method = value("REQUEST_METHOD",,'os2environment')
  73.    if method="" then do
  74.      say "This WWW oriented program is not meant to be run in standalone mode "
  75.      exit
  76.    end  /* Not addon, not cgi check */
  77.  
  78.    is_cgi=1                     /* cgi-bin! */
  79.    if method='GET' then do
  80.           list=value("QUERY_STRING",,'os2environment')
  81.    end
  82.    else do
  83.          tlen = value("CONTENT_LENGTH",,'os2environment')
  84.          list=charin(,,tlen)
  85.    end /* do */
  86.    servername=value("SERVER_NAME",,'os2environment')
  87.    chlink='/CGI-BIN/CHEKINDX'
  88.    say 'Content-Type: text/html'
  89.    say ""
  90. end
  91. else do
  92.    if verb='GET' then parse var uri . '?' list
  93.    chlink='/CHEKINDX'
  94.    fixexpire=value(enmadd||'FIX_EXPIRE',,'os2environment')
  95.    if fixexpire>0 then  fpp=sref_expire_response(fixexpire,0)
  96. end
  97.  
  98. /* get request line info */
  99. linkfile=''
  100. daurl=''
  101. typelist='text/html'
  102. siteonly=1
  103. multishow=0
  104. exclusions=' '
  105. drops=''
  106. cleanup=0
  107. showdesc=0
  108. outtype=1
  109. header=''
  110. doshowul=0
  111.  
  112. do ii=1 to pix.0
  113.    if symbol('PIX.'ii)<>'VAR' then
  114.         pix.ii=''
  115.     else
  116.       parse upper var pix.ii pix.ii pix.ii.!sel 
  117. end /* do */
  118. if symbol('PIX.!INCLUDE')<>'VAR' then pix.!include='ALT="* "'
  119. list00=list
  120. do until list=''
  121.    parse var list a1 '&' list
  122.    parse var a1 avar '=' aval ; avar=translate(avar)
  123.    aaval=packur2(translate(aval,' ','+'))
  124.    select
  125.      when avar='LINKFILE' then linkfile=aaval
  126.      when avar='URL' | avar='SEL' then daurl=translate(aaval)
  127.      when avar='MIME' then typelist=translate(strip(aaval))
  128.      when avar='MULTI' then multishow=strip(aaval)
  129.      when abbrev(avar,'SITE')=1 then siteonly=is_yes_no(aaval,siteonly)
  130.      when abbrev(avar,'EXCLU')=1 then exclusions=translate(aaval)
  131.      when abbrev(avar,'DROP')=1 then drops=translate(aaval)
  132.      when abbrev(avar,'CLEAN')=1 then cleanup=is_yes_no(aaval,cleanup)
  133.      when abbrev(avar,'DESCRIP')=1 then showdesc=is_yes_No(aaval,showdesc)
  134.      when abbrev(avar,'TYPE')=1 then outtype=aaval
  135.      when abbrev(avar,'CUSTOM')=1 then do
  136.         if aaval<>1 then iterate
  137.         if is_cgi=1 then do
  138.                say   ' Indexing customization mode not available when CheckLink is run as a cgi-bin script.'
  139.                return ''
  140.          end /* do */
  141.          call doing_custom
  142.          signal all_done
  143.      end /* do */
  144.      otherwise nop
  145.    end
  146. end
  147. drop list00
  148.  
  149. if linkfile='' | linkfile=0 then do
  150.    if is_cgi=0 then do
  151.      'String   CheckLink Error:  LInkfile not specified '
  152.    end 
  153.    else do 
  154.         say   '  CheckLink Error:  Linkfile not specified '
  155.    end
  156.    return ' '
  157. end /* do */
  158.  
  159. if linkfile_dir=0 then linkfile_dir=''
  160. if linkfile_dir='' then linkfile_dir=value('TEMP',,'os2environment')
  161. lfile=strip(linkfile_dir,'t','\')||'\'||strip(linkfile,'l','\')
  162. if pos('.',lfile)=0 then lfile=lfile'.STM'
  163. if multishow=0 & cleanup=1 then cleanup=0  
  164.  
  165.  
  166. /* else, read/display the requested linkfile */
  167.  
  168. oo=cvread(lfile,bg)
  169.  
  170. if oo=0 then do
  171.     if is_cgi=0 then
  172.        'string  CheckLink Error:  No such link-file: ' lfile
  173.     else
  174.        say  '  CheckLink Error: No such link-file: ' lfile
  175.    return 0
  176. end
  177.  
  178. yow2=cvcopy(bg.!hrefs,hrefs)
  179. yow2=cvcopy(bg.!imgs,imgs)
  180. drop bg.
  181.  
  182. /* we now have the link file. Determine root */
  183.  
  184. parse  var hrefs.1 . '//' onsite '/' rooturl
  185. onsite=translate(onsite)
  186.  
  187. istart=0
  188. tellurl.0=0
  189. if  daurl='' | daurl=0 then do          /* use "starter-url */
  190.   istart.1=1
  191.   tellurl.1=rooturl
  192.   tellurl.0=1
  193. end /* do */
  194. else do                 /* for each of possibly several entries, search for a match to daurl */
  195.    do mmm=1 to words(daurl)
  196.     daurl1=strip(word(daurl,mmm))
  197.     if pos('//',daurl1)>0 then  
  198.               parse var daurl1 . '//' . '/' tt1 /* strip site */
  199.     else
  200.           tt1=strip(daurl1,'l','/')
  201.     tt='/'translate(tt1)                
  202.     do aw=1 to hrefs.0          /* search anchors */
  203.        tt2=is_useable(aw,onsite)    /* only on-site, text/htmls ! */
  204.        if tt2='' then iterate
  205.        if tt<>translate(tt2) then iterate
  206.        iarf=tellurl.0+1 ; tellurl.0=iarf
  207.        istart.iarf=aw ; tellurl.iarf=tt2 ;leave
  208.     end /* do */
  209.   end /* do */
  210. end
  211.  
  212. if tellurl.0=0 then do
  213.     if is_cgi=0 then
  214.        'string CheckLink Error: No such selector:'tt1
  215.     else
  216.        say ' CheckLink Error:  No such selector: ' tt1
  217.    return 0
  218. end /* do */
  219.  
  220. /* we got something.. set up top of file */
  221. outind=''
  222. call ini_outit
  223.  
  224. /* create "thelist." -- contains outputable info */
  225. do igoof=1 to tellurl.0          /* extract from each entry (several indices */
  226.        call write_a_table igoof
  227. end
  228. if cleanup=1 then do                /* cleanup entries */
  229.       thelist.0=0 ; thelist.!levels=0
  230.       call do_cleanup 
  231. end
  232.  
  233. if drops<>'' then do            /* remove "dropped" entries */
  234.   call drop_thelist drops
  235. end
  236.  
  237. select
  238.    when  outtype=3 | outtype="CUSTOM"  then do  /* CUSTOMizer */
  239.        call write_as_custom
  240.    end
  241.  
  242.    when outtype=2 | outtype='TABLE' then do  /* a table */
  243.       call write_as_table
  244.    end /* do */
  245.  
  246.    otherwise do                 /* ul list */
  247.      call write_as_ul
  248.    end   /* otherwise */
  249.  
  250. end     /* select */
  251.  
  252.  
  253. all_done:               /* jump here when done */
  254.    outit=outit||outind||crlf||'</body></html>'crlf
  255.    if is_cgi=1 then do
  256.        call charout,outit
  257.        return ''
  258.    end
  259.    else
  260.       foo=value('SREF_PREFIX',,'os2environment')
  261.       if foo='' then
  262.           'VAR type text/html name outit '
  263.       else
  264.           fooo=sref_gos('VAR type text/html name outit ',outit)
  265.       return '200 '||length(outit)
  266.    end
  267.  
  268.  
  269. /*****************/
  270. /* cleanup? */
  271. do_cleanup:
  272. if cleanup=1 then do
  273.  select
  274.    when multishow=2 then do
  275.      do arc=1 to tellurl.0
  276.         foo=add_thelist(istart.arc,1)
  277.         wow=do_uls2(istart.arc,2)    /* remove higher levels, but allow ties */
  278.      end
  279.    end
  280.    when multishow=1 then do
  281.       do mmx=1 to hrefs.0  /* special hack: allow first tie only */
  282.          hrefs.mmx.!tie=0
  283.       end /* do */
  284.       do mmx=1 to imgs.0
  285.          imgs.mmx.!tie=0
  286.       end /* do */
  287.       multishow=3             /* remove higher levels */
  288.       do arc=1 to tellurl.0
  289.          foo=add_thelist(istart.arc,1)
  290.          wow=do_uls2(istart.arc,2)    /* remove higher levels, but allow ties */
  291.       end /* do */
  292.    end
  293.    otherwise nop
  294.  end
  295. end
  296.  
  297. return 1
  298.  
  299. /*****************************/
  300. /* write thelist to a form */
  301. write_as_custom:procedure expose thelist. outind crlf  showdesc servername header doshowul
  302.  
  303. outind=outind||'<a name="top"><form action="/CHEKINDX" method="POST"></a>' crlf
  304.  
  305. outind=outind||'<input type="HIDDEN" name="CUSTOM" value=1>' crlf
  306. outind=outind||'Header: <TEXTAREA NAME="HEADER" ROWS=2 COLS=50>'header' </TEXTAREA><p>'  crlf
  307. outind=outind||'<TABLE cellspacing=1 cellpadding=1>' crlf
  308. oog=thelist.!levels+2
  309. outind=outind||'<tr><th colspan='oog'><a href="#position">Position  & Level</a></th>'  ,
  310.                '<th><a href="#title">Title</a></th><th><a href="#description">Description</a></th>' crlf
  311.  
  312. do mm=1 to thelist.0
  313.  
  314.    al='<tr> '
  315.    vbase='V'||strip(mm)
  316.    al=al||'<td> <input type="text" size=5 maxlength=12 name="'VBASE'_POS" value="'mm'"></td>'
  317.    foo3=''
  318.  
  319.    ident=copies('__',thelist.mm.!level-1)   /* indentation spacer */
  320.    do nn=1 to thelist.!levels+1                 /* radio buttons to change indentation */
  321.       ischeck=''
  322.       if nn=thelist.mm.!level then  ischeck='CHECKED'
  323.       foo3=foo3'<td><input type="radio" name="'VBASE'_LVL" value="'nn'" 'ischeck '></td> '
  324.    end /* do */
  325.    al=al||crlf||foo3||crlf
  326.  
  327.    alink=strip(thelist.mm.!link)                /* add title */
  328.    goo2=thelist.mm.!title
  329.    i39=39
  330.    if alink='' then i39=60
  331.  
  332.    goo3='<input type="text" size='i39' maxlength=120 name="'VBASE'_TIT" value="'goo2'">'
  333.  
  334.    if alink<>'' then
  335.       al=al||'<td nowrap>'ident' <a href="'alink'">?</a> 'goo3'</td>'
  336.    else
  337.       al=al||'<td nowrap>'ident' <b>:::</b> 'goo3'</td>'
  338.  
  339.  
  340.    if showdesc=1 & alink<>' 'then do            /* description, non comment entry */
  341.         bdesc=strip(space(thelist.mm.!desc))
  342. /* break it up into lines of 35 */
  343.         cdesc='';ddesc='';kr=0
  344.         do forever
  345.             if bdesc='' then leave
  346.             parse var bdesc cw bdesc
  347.             cdesc=cdesc' 'cw
  348.             if length(cdesc)>32 then do
  349.                 ddesc=ddesc||crlf||cdesc
  350.                 cdesc=''
  351.                 kr=kr+1
  352.             end /* do */
  353.         end /* do */
  354.         if cdesc<>'' then  do
  355.              ddesc=ddesc||crlf||cdesc ; kr=kr+1
  356.         end
  357.         al=al||crlf'<td> <TEXTAREA NAME="'VBASE'_DSC" ROWS='kr' COLS=36>'ddesc'</TEXTAREA></td>'
  358.    end /* do */
  359.  
  360.    outind=outind||al||crlf
  361.    outind=outind'<input type="hidden" name="'VBASE'_HREF"  value="'alink'"> 'crlf
  362.    outind=outind'<input type="hidden" name="'VBASE'_PIX"  value="'thelist.mm.!img'">' crlf
  363.   
  364.   
  365. end /* do */
  366.  
  367. outind=outind'</table>'crlf
  368. outind=outind'<h3>Additional  lines  </h3> You can add <em>comment and seperator </em> lines (HTML ' ,
  369.                  ' elements allowed!)<table>'crlf
  370.  
  371. do ll=1 to 2
  372.   outind=outind'<tr><td> <input type="text" size=5 maxlength=12 name="COMMENT_'ll'_POS" value=""></td>' crlf 
  373.    do nn=1 to thelist.!levels+1                 /* radio buttons to change indentation */
  374.       ischeck=''
  375.       if nn=2 then  ischeck='CHECKED'
  376.       outind=outind'<td><input type="radio" name="COMMENT_'ll'_LVL" value="'nn'" 'ischeck '></td> '
  377.    end /* do */
  378.    outind=outind'<td><textarea name="COMMENT_'ll'" rows=1 cols=50></textarea></td> ' crlf
  379. end
  380. outind=outind'</table>' crlf
  381.  
  382. outind=outind'<input type="HIDDEN" name="SERVERNAME" value="'servername'">' crlf
  383.  
  384.  
  385. outind=outind'<p>' crlf ,
  386.   ' <INPUT TYPE="radio" NAME="TYPE" VALUE="3" checked > Re-Edit    ' crlf ,
  387.   ' <em>( <INPUT TYPE="checkbox" NAME="ULSHOW" VALUE="1">also show current index as unordered list) </em> ' crlf ,
  388.   ' <em> or .... </em> <br><b> finalize</b> index as an 'crlf ,
  389.   ' <INPUT TYPE="radio" NAME="TYPE" VALUE="1">unordered List (<UL>), <em> or as a </em>  ' crlf ,
  390.   ' <INPUT TYPE="radio" NAME="TYPE" VALUE="2"> table ' crlf 
  391.  
  392.  
  393. outind=outind'<br><INPUT type="SUBMIT" value="Re-edit, or finalize">' crlf
  394.  
  395. outind=outind || crlf ,
  396.        '<hr><h3>Description of options </h3> ' crlf ,
  397.        '<dl> <dt><a name="position">Position</a> <dd> The row of the index, with 1 the top. To delete ' crlf ,         
  398.        ' an entry, set this either to blank or 0. To insert between existing entries,' crlf ,
  399.        ' use a fraction (i.e.; 10.5 is between current entries 10 and 11) ' crlf ,
  400.        '<dt> Level <dd> Indentation level, with the furthest left button the "least" indentation' crlf ,
  401.        '<dt> <a name="title">Title</a><dd> The title of resource. Should be less then 50 characters. ' crlf ,
  402.        '<dt><a name="description">Description </a> <dd>Optional description. 'crlf ,
  403.        ' Can include HTML elements, and can be up to 300 characters long. 'crlf,
  404.         '</dl> <a href="#top">Top of form</a>'
  405.  
  406. if doshowul=1 then do
  407.   outind=outind'<hr><h3> Current Index (as Unordered List) </h3>'
  408.   call write_as_ul
  409. end
  410.  
  411. return 1
  412.  
  413.  
  414.  
  415. /*****************************/
  416. /* write thelist to a table */
  417. write_as_table:procedure expose thelist. outind crlf table_mod td_title td_descrip td_indent ,
  418.                         tr_mod1 tr_mod2 
  419.  
  420. outind=outind||'<TABLE cellspacing=0 cellpadding=0>' crlf
  421.  
  422. do mm=1 to thelist.0
  423.    if mm//2=0 then 
  424.         oof=tr_mod2
  425.    else
  426.         oof=tr_mod1
  427.    arf=crlf'<tr><table cellpadding=0 cellspacing=0><tr 'oof'>'
  428.    if thelist.mm.!level=1 then arf='<tr> <td> <br> </td>'arf
  429.    if datatype(td_indent)='NUM' then do
  430.       iss=td_indent*(thelist.mm.!level-1)
  431.       arf=arf||'<td><img src="\imgs\1_pixel.gif" height=5 width='iss'> </td>'
  432.    end
  433.    else do
  434.      do mmm=1 to thelist.mm.!level-1
  435.          arf=arf||td_indent
  436.      end /* do */
  437.    end
  438.    if thelist.mm.!Link='' then
  439.       outind=outind||arf' <td nowrap 'td_title'> 'thelist.mm.!title'</td>' crlf
  440.    else
  441.       outind=outind||arf' <td nowrap 'td_title'>'|| ,
  442.            thelist.mm.!img'<a href="'thelist.mm.!link '">'thelist.mm.!title'</a></td>' crlf
  443.  
  444.    if thelist.mm.!desc<>'' then 
  445.           outind=outind'<td 'td_descrip'>'||strip(thelist.mm.!desc)||'</td>'
  446.    outind=outind'</table>' crlf
  447. end /* do */
  448.  
  449. outind=outind'</table>'
  450. return 1
  451.  
  452. /*****************************/
  453. /* write thelist to a ul */
  454. write_as_ul:procedure expose thelist. outind crlf 
  455.  
  456. wasul=0
  457.  
  458. do mm=1 to thelist.0
  459.    newul=thelist.mm.!level
  460.    select 
  461.       when newul=1 then do
  462.          if wasul>1 then do
  463.            do mt=newul+1 to wasul
  464.               outind=outind'</ul>'
  465.            end /* do */
  466.          end
  467.          if thelist.mm.!link='' then
  468.             outind=outind'<br>'thelist.mm.!title||crlf
  469.          else
  470.             outind=outind'<br>'thelist.mm.!img' <a href="'thelist.mm.!link'">'|| ,
  471.                 thelist.mm.!title||'</a>'thelist.mm.!desc||crlf
  472.       end /* do */
  473.  
  474.       when newul=wasul then do
  475.          if thelist.mm.!link='' then
  476.             outind=outind'<li>'thelist.mm.!title||crlf
  477.          else
  478.             outind=outind'<li>'thelist.mm.!img' <a href="'thelist.mm.!link'">'|| ,
  479.                 thelist.mm.!title||'</a>'thelist.mm.!desc||crlf
  480.       end /* do */
  481.  
  482.       when newul>wasul then do
  483.          do mt=wasul+1 to newul
  484.              outind=outind'<ul>'
  485.          end /* do */
  486.          if thelist.mm.!link='' then
  487.             outind=outind' 'crlf'<li>'thelist.mm.!title||crlf
  488.          else
  489.             outind=outind' 'crlf'<li>'thelist.mm.!img' <a href="'thelist.mm.!link'">'|| ,
  490.                 thelist.mm.!title||'</a>'thelist.mm.!desc||crlf
  491.       end
  492.  
  493.       when newul<wasul then do
  494.          do mt=newul+1 to wasul
  495.              outind=outind'</ul>'
  496.          end /* do */
  497.          if thelist.mm.!link='' then
  498.             outind=outind||crlf'<li>'thelist.mm.!title||crlf
  499.          else
  500.             outind=outind||crlf'<li>'thelist.mm.!img' <a href="'thelist.mm.!link'">'|| ,
  501.                   thelist.mm.!title||'</a>'thelist.mm.!desc||crlf
  502.       end
  503.  
  504.       otherwise nop
  505.  
  506.    end  /* select */
  507.    wasul=newul
  508.  
  509. end /* do */
  510. do ii=1 to wasul-1
  511.   outind=outind'</ul>'
  512. end /* do */
  513. return 1
  514.  
  515.  
  516.  
  517.  
  518. /*****************************/
  519. /* create an IMG element, based on pix. and mimetype */
  520. make_pix:procedure expose pix.
  521. parse upper arg atype
  522. if pix.0=0 then return ""
  523.  
  524. do mm=1 to pix.0
  525.   if wild_match(atype,pix.mm)=0 then iterate
  526.   if pix.mm.!sel='' then iterate
  527.   aa='<img src="'pix.mm.!sel'" 'pix.!include '>'
  528.   return aa
  529. end /* do */
  530. return ""
  531.  
  532.  
  533. /*************************/
  534. /* return hrefs.aw if hrefs.aw is "onsite" and ?text/html */
  535. is_useable:procedure expose hrefs. imgs. pix.
  536. parse upper arg aw,onsite,amime,siteonly,isimg
  537.  
  538. parse  var hrefs.aw . '//' acsite '/' acref
  539. if siteonly='' | siteonly=1 then
  540.       if translate(acsite)<>onsite then return ""
  541.  
  542. /* else, allow off siters */ 
  543.    if isimg=1 then
  544.         ac2=strip(translate(imgs.aw.!type))
  545.    else
  546.         ac2=strip(translate(hrefs.aw.!type))
  547.    if amime="" then do
  548.        if ac2<>'TEXT/HTML' then 
  549.            return ""            /* non-html, ignore */
  550.         else
  551.            return  '/'acref
  552.    end
  553.  
  554. /* else compare ac2 to amime */
  555.    ioky=0
  556.    do aw2=1 to words(amime)        /* if found, then we are okay */
  557.       goof=strip(word(amime,aw2))
  558.       if wild_match(ac2,goof)<>0 then ioky=1
  559.       if ioky=1 then leave
  560.    end /* do */
  561.   if ioky=0 then return ""          /* no match */
  562.    return  '/'acref
  563.  
  564.  
  565. /***************/
  566. /* return 0 for no, 1 for yes, default otherwise */
  567. is_yes_no:procedure
  568. parse arg aval,def
  569. tdef=strip(translate(aval))
  570. if wordpos(tdef,'Y YES 1')>0 then return 1
  571. if wordpos(tdef,'N NO 0')>0 then return 0
  572. return def
  573.  
  574.  
  575. /**********************/
  576. /* make top of return file, and initialize some parameters */
  577. ini_outit:
  578. outit=''
  579. if user_intro1<>'' then do
  580.   afil=stream(user_intro1,'c','query exists')
  581.   if afil<>'' then do
  582.      foo=stream(afil,'c','open read')
  583.      outit=charin(afil,1,chars(afil))
  584.      foo=stream(afil,'c','close')
  585.   end
  586. end
  587. if outit='' then do       /* the generic intro */
  588.   outit='<html><head><title>CheckLink: Create An Index </title></head><body ' back_1'> 'crlf 
  589.   outit=outit||'<h2 align=center> Index of 'servername' </h2>' crlf 
  590. end
  591.  
  592. thelist.0=0; thelist.!levels=0
  593. do mm=1 to hrefs.0
  594.        hrefs.mm.!done=0
  595. end /* do */
  596. do mm=1 to imgs.0
  597.        imgs.mm.!done=0
  598. end /* do */
  599.  
  600.  
  601. return 1
  602.  
  603. /************************/
  604. /* extract or create title */
  605. get_title:procedure expose hrefs. onsite imgs. pix.
  606. parse arg ii,isimg
  607.  
  608. if isimg=1 then do
  609.      parse var imgs.ii . '//' bsite '/' aa
  610.      bsite=translate(bsite)
  611.      if bsite<>onsite then
  612.        return '/'aa' <em> on 'bsite '</em>'
  613.      else
  614.         return '/'aa
  615. end
  616.  
  617. if  symbol('HREFS.'ii'.!TITLE')<>'VAR' then do
  618.      parse var hrefs.ii . '//' bsite '/' aa
  619.      bsite=translate(bsite)
  620.      if bsite<>onsite then
  621.        return '/'aa' <em> on 'bsite '</em>'
  622.      else
  623.         return '/'aa
  624. end /* do */
  625. return hrefs.ii.!title
  626.  
  627. /***********/
  628. /* load some dlls */
  629. load:
  630.  
  631. foo=rxfuncquery('sysloadfuncs')
  632. if foo=1 then do
  633.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  634.   call SysLoadFuncs
  635. end
  636.  
  637. foo=rxfuncquery('rexxlibregister')
  638. if foo=1 then do
  639.  call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
  640.  call rexxlibregister
  641. end
  642. foo=rxfuncquery('rexxlibregister')
  643. if foo=1 then do
  644.     say " Could not find REXXLIB "
  645.     exit
  646. end /* do */
  647. return 1
  648.  
  649.  
  650. /*********/
  651. packur2:procedure expose standalone
  652. parse arg a1b0
  653.  
  654. if standalone=0 then
  655.    return packur(translate(a1b0,' ','+'))
  656. else
  657.    return decodekeyval(translate(a1b0,' ','+'))
  658.  
  659.  
  660. /************************************************/
  661. /* procedure from TEST-CGI.CMD by  Frankie Fan <kfan@netcom.com>  7/11/94 */
  662. DecodeKeyVal: procedure
  663.   parse arg Code
  664.   Text=''
  665.   Code=translate(Code, ' ', '+')
  666.   rest='%'
  667.   do while (rest\='')
  668.      Parse var Code T '%' rest
  669.      Text=Text || T
  670.      if (rest\='' ) then
  671.       do
  672.         ch = left( rest,2)
  673.         if verify(ch,'01234567890ABCDEF')=0 then
  674.            c=X2C(ch)
  675.         else
  676.            c=ch
  677.         Text=Text || c
  678.         Code=substr( rest, 3)
  679.       end
  680.   end
  681.   return Text
  682.  
  683.  
  684.  
  685.  
  686. /************************/
  687. /* wild card match, with comparision against prior wild card match */
  688. */
  689.  
  690. wild_match:procedure
  691. parse upper arg needle, haystack,oldresu
  692.  
  693.  
  694.  aresu=awild_match(needle,haystack)
  695.  if strip(aresu)=0 then return 0     /* no match */
  696.  return 1
  697.  
  698. awild_match:procedure
  699. parse upper arg needle, haystack ; haystack=strip(haystack)
  700. needle=strip(needle)
  701.  
  702. if needle=haystack then return -1        /* -1 signals exact match */
  703. ast1=pos('*',haystack)
  704. if ast1=0 then return 0                 /* 0 means no match */
  705. if haystack='*' then  do
  706.    if length(needle)=0 then 
  707.        return 100000
  708.     else 
  709.         return length(needle)
  710. end
  711. ff=haystack
  712. ii=0
  713. do until ff=""
  714.   ii=ii+1
  715.   parse var ff hw.ii '*'  ff
  716.   hw.ii=strip(hw.ii)
  717. end
  718. if hw.ii='' then ii=ii-1
  719. hw.0=ii
  720.  
  721.  
  722. /* check each component of haystackw against needle -- all components
  723. must be there */
  724.  
  725. resu=' '
  726. istart=1 ; ido=2
  727. if ast1>1 then do       /* first check abbrev */
  728.   if abbrev(needle,hw.1)=0 then return 0
  729.   aresu=length(hw.1)
  730.   if hw.0=1 then do
  731.      do nm=1 to aresu
  732.         resu=resu||' '||nm
  733.      end /* do */
  734.      return resu         /* if haystacy of form abc*, we have a match */
  735.   end
  736.   ido=2 ; istart=aresu+1
  737.   do mm=1 to aresu
  738.         resu=resu||' '||mm
  739.   end /* do */
  740. end
  741. /* if here, then first part (a non wildcard) of haystack matches first
  742. part of needle
  743. Now check sequentially that each remaining part also exists
  744. */
  745. do mm=ido to hw.0
  746.   igoo=pos(hw.mm,needle,istart)
  747.   if igoo=0 then return 0
  748.   tres=length(hw.mm)
  749.   istart=igoo+tres
  750.   do nn=igoo to (istart-1)
  751.      resu=resu||' '||nn
  752.   end /* do */
  753. end
  754. if istart >= length(needle) | right(haystack,1)='*' then
  755.    return resu
  756. return 0
  757.  
  758.  
  759. /**********************/
  760. /* write a table */
  761. write_a_table:
  762. parse arg igoof
  763. istart=istart.igoof ; tellurl=tellurl.igoof
  764. foo=add_thelist(istart,1)
  765. hrefs.istart.!done=1                /* in "level 1" */
  766.  
  767. wow=do_uls2(istart,2)    /* the recursive procedure */
  768. return 1
  769.  
  770. /*****************************************/
  771. /* drop from  thelist */
  772. drop_thelist:procedure expose thelist. 
  773.  
  774. parse arg drops
  775.  
  776. oof=0
  777. thelist2.!Levels=0
  778.  
  779. aexs.0=words(drops)
  780. do ii=1 to aexs.0
  781.      aex=strip(word(drops,ii)) ; aexs.ii=strip(aex,'l','/')
  782. end /* do */
  783.  
  784. do mm=1 to thelist.0
  785.    aref0=thelist.mm.!link
  786.    parse var aref0 . '//' . '/' aref
  787.    aref=strip(aref,'l','/')
  788.    do ii=1 to aexs.0
  789.      pp= wild_match(aref,aexs.ii)
  790.      if pp<>0 then do                 /* matched == so exclude from recursion */
  791.          iterate mm
  792.      end /* do */
  793.    end
  794.  
  795. /* else, retain it */
  796.  
  797.   oof=oof+1
  798.   thelist2.oof.!Img=''
  799.   if symbol('THELIST.'mm'.!IMG')='VAR' then do
  800.       thelist2.oof.!img=thelist.mm.!img
  801.   end
  802.   thelist2.oof.!title=thelist.mm.!title
  803.   thelist2.oof.!desc=thelist.mm.!desc
  804.   thelist2.oof.!link=thelist.mm.!link
  805.   llvel=thelist.mm.!level
  806.   thelist2.oof.!level=llvel
  807.   thelist2.!levels=max(thelist2.!levels,llvel)
  808. end
  809.  
  810. thelist2.0=oof
  811.  
  812. drop thelist.
  813. oo=cvcopy(thelist2,thelist)
  814. drop thelist2.
  815. return 1
  816.  
  817.  
  818.  
  819. /*****************************************/
  820. /* add to thelist */
  821. add_thelist:procedure expose thelist. showdesc hrefs. pix.
  822. parse arg ifoo,llvel
  823.  
  824. title1=get_title(ifoo)
  825.  
  826. adesc1=''
  827.   
  828. if showdesc=1 &  symbol('HREFS.'ifoo'.!DESCRIP')='VAR' then 
  829.     adesc1=hrefs.ifoo.!descrip
  830.  
  831. /* we have start of this web index. Create root url */
  832.  
  833. piximg=make_pix(hrefs.ifoo.!type)
  834.  
  835. oof=thelist.0+1
  836. thelist.oof.!img=piximg
  837. thelist.oof.!title=title1
  838. thelist.oof.!desc=adesc1
  839. thelist.oof.!link=hrefs.ifoo
  840. thelist.oof.!level=llvel
  841. thelist.!levels=max(thelist.!levels,llvel)
  842. thelist.0=oof
  843. return 1
  844.  
  845. /*****************************************/
  846. /* for all text/htmls in reflist, display title */
  847. do_uls2:procedure expose onsite hrefs. imgs. pix. showdesc ,
  848.                     crlf multishow typelist siteonly exclusions thelist.
  849. parse arg hii,level
  850.  
  851.  
  852. reflist=hrefs.hii.!reflist
  853. if reflist='' then return 0
  854.  
  855. /* mark the !done field for each entry in this reflist */
  856.  
  857. lvlist=''
  858. do ii=1 to words(reflist)               /* keep all these on this lvel */
  859.    aw=strip(word(reflist,ii))
  860.    alevel=hrefs.aw.!done
  861.    lvlist=lvlist' 'alevel
  862.    if alevel>level | alevel=0 then hrefs.aw.!done=level
  863. end 
  864.  
  865. do mm=1 to words(reflist)               /* for each entry in the reflist */
  866.    aw=strip(word(reflist,mm))
  867.    eek=is_useable(aw,onsite,typelist,siteonly)
  868.    if eek='' then iterate
  869.    bdone=strip(word(lvlist,mm))      /* level BEFORE being "kept on this level */
  870.  
  871.    if bdone<>0 then do                 /* been indexed, do it again? */
  872.         if multishow=0 then iterate     /* no, one appearance per url */
  873.         if multishow=1 then do
  874.            if bdone<=level then iterate /* indexed at a lower or same level-- suppress */
  875.         end
  876.         if multishow=2 then do
  877.           if bdone<level then iterate   /* indexed at a lower level-- suppress */
  878.         end
  879.         if multishow=3 then do          /* used with multi=1, cleanup*/
  880.              if bdone<level  then iterate
  881.              if bdone=level & hrefs.aw.!tie>0 then iterate  /* not first tie */
  882.              hrefs.aw.!tie=1
  883.         end  /* Do */
  884.    end
  885.  
  886.    foo=add_thelist(aw,level)
  887.  
  888. /* recurse! -- but check "exclusions" first */
  889.    if exclusions<>'' then do
  890.       parse var hrefs.aw . '//' . '/' aref
  891.       aref=strip(aref,'l','/')
  892.       do ii=1 to words(exclusions)
  893.            aex=strip(word(exclusions,ii)) ; aex=strip(aex,'l','/')
  894.            pp= wild_match(aref,aex)
  895.            if pp<>0 then do    /* matched == so exclude from recursion */
  896.                iterate mm
  897.            end /* do */
  898.       end
  899.    end
  900.    foo=do_Uls2(aw,level+1)
  901.  
  902. /* do images at end of ul list */
  903.  
  904. end /* do */
  905.  
  906. foo=do_imgs2(hii,level+1)
  907.  
  908. return 1
  909.  
  910. /*****************************************/
  911. /* for all text/htmls in reflist, display title */
  912. do_imgs2:procedure expose onsite hrefs. imgs. pix. thelist. ,
  913.                          crlf multishow typelist siteonly exclusions
  914. parse arg ii,level
  915.  
  916. imglist=hrefs.ii.!imglist
  917. if imglist='' then return 0
  918.  
  919. do mm=1 to words(imglist)               /* for each entry in the reflist */
  920.    aw=strip(word(imglist,mm))
  921.    eek=is_useable(aw,onsite,typelist,siteonly,1) 
  922.    if eek='' then iterate
  923.    bdone=imgs.aw.!done
  924.  
  925.    if bdone<>0 then do                 /* been indexed, do it again? */
  926.         if multishow=0 then iterate     /* no, one appearance per url */
  927.         if multishow=1 then do
  928.            if bdone<=level then iterate /* indexed at a lower or same level-- suppress */
  929.         end
  930.         if multishow=2 then do
  931.           if bdone<level then iterate   /* indexed at a lower level-- suppress */
  932.         end
  933.         if multishow=3 then do          /* used with multi=1, cleanup*/
  934.              if bdone<level  then iterate
  935.              if bdone=level & imgs.aw.!tie>0 then iterate  /* not first tie */
  936.              imgs.aw.!tie=1
  937.         end  /* Do */
  938.    end
  939.  
  940.    piximg=make_pix(imgs.aw.!type)
  941.    if showdesc=1 & symbol('HREFS.'aw'.!DESCRIP')='VAR' then adesc=hrefs.aw.!descrip
  942.  
  943.    oof=thelist.0+1
  944.    thelist.oof.!img=piximg
  945.    thelist.oof.!title=' '
  946.    thelist.oof.!link=imgs.aw
  947.    thelist.oof.!desc=' '
  948.    thelist.oof.!level=level 
  949.    thelist.0=oof
  950.    thelist.!levels=max(thelist.!levels,level)
  951.  
  952.    imgs.aw.!done=level
  953.  
  954. end /* do */
  955. return 1
  956.  
  957. /*******************************/
  958. /* index customization */
  959. doing_custom:
  960. outtype=1
  961. thelist.0=0 ; doshowul=0
  962. header=''
  963. drop cmts.
  964.  
  965. do forever              /* parse out list */
  966.    if list00='' then leave
  967.    parse var list00 a1 '&' list00
  968.  
  969.    parse var a1 a1a '=' a1b
  970.    a1a=strip(translate(a1a))
  971.  
  972.    if a1a='CUSTOM' then iterate
  973.  
  974.    if a1a='SERVERNAME' then do
  975.       servername=a1b
  976.       iterate
  977.    end /* do */
  978.    if a1a='ULSHOW' then do
  979.      doshowul=a1b
  980.      iterate
  981.    end
  982.    if a1a='HEADER' then do
  983.       header=strip(packur2(translate(a1b,' ','+'||'00090d0a'x)))
  984.       iterate
  985.    end /* do */
  986.  
  987.    if a1a='TYPE' then do
  988.       outtype=a1b
  989.       iterate
  990.    end /* do */
  991.  
  992.    if abbrev(a1a,'COMMENT')=1 then do
  993.       parse var a1a  . '_' nth '_' avar
  994.       avar=strip(upper(avar)); nth=strip(nth) 
  995.       if wordpos(nth,'1 2 3 4 5 ')=0 then iterate
  996.       if avar='LVL' then    cmts.nth.!lvl=strip(a1b)
  997.       if avar='POS' then   cmts.nth.!pos=strip(a1b)
  998.       if avar='' then    cmts.nth.!tit=strip(packur2(translate(a1b,' ','+'||'00090d0a'x)))
  999.       iterate
  1000.    end /* do */
  1001.  
  1002.    parse var a1a  a1a1 '_' a1a2
  1003.    iv=substr(a1a1,2)
  1004.    ua='!'a1a2
  1005.    aaval=strip(packur2(translate(a1b,' ','+'||'00090d0a'x)))
  1006.    thelist.iv.ua=aaval
  1007.    thelist.0=max(thelist.0,iv)
  1008. end /* do */
  1009.  
  1010. inm=0
  1011. do mm=1 to thelist.0
  1012.    yeek=thelist.mm.!pos
  1013.    if yeek=0 | yeek=' ' then iterate
  1014.    if datatype(yeek)<>'NUM' then iterate
  1015.    inm=inm+1
  1016.    goob.inm=left(yeek,8)' 'mm
  1017. end /* do */
  1018.  
  1019. /* add comments? */
  1020. do ll=1 to 5
  1021.     if symbol('CMTS.'ll'.!POS')<>'VAR' then iterate
  1022.     if cmts.ll.!Pos='' then iterate
  1023.     else
  1024.     inm=inm+1
  1025.     goob.inm=left(cmts.ll.!POS,8)' -'ll
  1026. end /* do */
  1027.  
  1028. goob.0=inm
  1029. hoy=arraysort(goob,1,goob.0,1,8,'A','N')
  1030.  
  1031. thelist2.0=goob.0; thelist2.!levels=0
  1032.  
  1033. do kk=1 to goob.0
  1034.    parse var goob.kk . newkk ; newkk=strip(newkk)
  1035.  
  1036.    if newkk<0 then do           /* a comment */
  1037.        newkk=-newkk
  1038.        thelist2.kk.!level=cmts.newkk.!lvl
  1039.        thelist2.kk.!title=cmts.newkk.!tit
  1040.        thelist2.kk.!img='' ; thelist2.kk.!link='' ; thelist2.kk.!desc=''
  1041.    end
  1042.    else do        
  1043.      thelist2.kk.!LEVEL=thelist.newkk.!LVL
  1044.      thelist2.!levels=max(thelist2.!levels,thelist2.kk.!level)
  1045.      thelist2.kk.!TITLE=thelist.newkk.!TIT
  1046.      thelist2.kk.!DESC=''
  1047.      if symbol('THELIST.'newkk'.!DSC')='VAR' then
  1048.          thelist2.kk.!DESC=thelist.newkk.!DSC
  1049.      thelist2.kk.!IMG=thelist.newkk.!PIX
  1050.      thelist2.kk.!LINK=thelist.newkk.!HREF
  1051.    end
  1052. end /* do */
  1053. drop thelist.
  1054. foo=cvcopy(thelist2,thelist)
  1055.  
  1056. /* write it out */
  1057. outind=''
  1058. outit='<html><head><title>CheckLink: Create An Index </title></head><body ' back_1'> 'crlf 
  1059. if header='' then
  1060.   header="Index of " servername
  1061. outit=outit||'<h2 align=center>'header' </h2>' crlf 
  1062.  
  1063. select
  1064.    when  outtype=3 | outtype="CUSTOM"  then do  /* CUSTOMizer */
  1065.        call write_as_custom
  1066.    end
  1067.  
  1068.    when outtype=2 | outtype='TABLE' then do  /* a table */
  1069.       call write_as_table
  1070.    end /* do */
  1071.  
  1072.    otherwise do                 /* ul list */
  1073.      call write_as_ul
  1074.    end   /* otherwise */
  1075. end
  1076. return 1
  1077. 
  1078.