home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / cheklink.zip / CHEKLNK2.CMD < prev   
OS/2 REXX Batch file  |  1998-05-03  |  42KB  |  1,335 lines
  1. /* Examine and traverse the links to URLs in a web tree.
  2.   Uses "linkage" files created by CHEKLINK
  3. */
  4.  
  5. /***  BEGIN USER CONFIGURABLE PARAMETERS     */
  6.  
  7. /* used in <BODY back_1> element */
  8. back_1='bgcolor="#ddaaff"  '
  9.  
  10. /*  Directory containing link file -- MUST be the same as in CHEKLINK.CMD */
  11. linkfile_dir=''
  12.  
  13. /* URL pointing to cheklink.htm (used for a "do it again" option)
  14.    set cheklink_htm='' to not include this option.
  15.    Should be fully qualified */
  16. cheklink_htm='/cheklink.htm'
  17.  
  18.  
  19. /* A fully qualified file containing "header" information.
  20.   If ='', then a generic header is used 
  21.   If specified, the file MUST contain at least:
  22.        <HTML><HEAD>.... </HEAD> <BODY ...> <h1>... </h1> 
  23.   Note: use of user_intro1  means that back_1 is NOT used 
  24. */
  25. user_intro1=''
  26.  
  27. /***  END USER CONFIGURABLE PARAMETERS     */
  28.  
  29.  
  30. parse arg  ddir, tempfile, reqstrg,list,verb ,uri,user, ,
  31.           basedir ,workdir,privset,enmadd,transaction,verbose, ,
  32.          servername,host_nickname,homedir,aparam,semqueue,prog_file
  33.  
  34. crlf='0d0a'x
  35. ny.0='NO' ; ny.1='YES'
  36. nas.1=' no -- server not available '
  37. nas.2=' no -- no such resource on server'
  38. nas.3='unknown -- siteonly violation'
  39. nas.4='reserved'
  40. nas.5='unknown -- excluded URL '
  41.  
  42. call load       /* some dlls */
  43.  
  44. /* check for CGI-BIN call */
  45. is_cgi=0
  46. if verb="" then do    /* is it cgi-bin? */
  47.    method = value("REQUEST_METHOD",,'os2environment')
  48.    if method="" then do
  49.      say "This WWW oriented program is not meant to be run in standalone mode "
  50.      exit
  51.    end  /* Not addon, not cgi check */
  52.  
  53.    is_cgi=1                     /* cgi-bin! */
  54.    if method='GET' then do
  55.           list=value("QUERY_STRING",,'os2environment')
  56.    end
  57.    else do
  58.          tlen = value("CONTENT_LENGTH",,'os2environment')
  59.          list=charin(,,tlen)
  60.    end /* do */                         
  61.    servername=value("SERVER_NAME",,'os2environment')
  62.    chlink='/CGI-BIN/CHEKLNK2'
  63.    say 'Content-Type: text/html'
  64.    say ""
  65. end
  66. else do
  67.    if verb='GET' then parse var uri . '?' list
  68.    chlink='/CHEKLNK2'
  69.    fixexpire=value(enmadd||'FIX_EXPIRE',,'os2environment')
  70.    if fixexpire>0 then  fpp=sref_expire_response(fixexpire,0)
  71. end
  72.  
  73. listori=list
  74.  
  75. linkfile='*'
  76. entrynum=1
  77. isimg=0
  78. listmode=0
  79. via=''
  80. checkmime='*'
  81.  
  82. do until list=''
  83.    parse var list a1 '&' list
  84.    parse var a1 avar '=' aval ; avar=translate(avar)
  85.    aaval=packur2(translate(aval,' ','+'))
  86.    select
  87.      when avar='LINKFILE' then linkfile=aaval
  88.      when avar='ENTRYNUM' then entrynum=aaval
  89.      when avar='ISIMG' then isimg=aaval
  90.      when avar='VIA' then via=aaval
  91.      when avar='LIST' then listmode=aaval
  92.      when avar='MIME' then checkmime=strip(aaval)
  93.      otherwise nop
  94.    end
  95. end
  96.  
  97.  
  98. if entrynum='' then entrynum=1
  99.  
  100. if datatype(entrynum)<>'NUM'   then do
  101.     return ' String Bad Entry number ' entrynum
  102. end /* do */
  103.  
  104. if linkfile_dir=0 then linkfile_dir=''
  105. if linkfile_dir='' then linkfile_dir=value('TEMP',,'os2environment')
  106. lfile=strip(linkfile_dir,'t','\')||'\'||strip(linkfile,'l','\')
  107. if pos('.',lfile)=0 then lfile=lfile'.STM'
  108.  
  109. if pos('*',lfile)>0 then do  
  110.    call list_linkfiles
  111.    return 2
  112. end /* do */
  113.  
  114.  
  115. /* else, read/display the requested linkfile */
  116.  
  117. oo=cvread(lfile,bg)
  118.  
  119. if oo=0 then do
  120.     if is_cgi=0 then
  121.        'string No such link-file: ' lfile
  122.     else
  123.        say 'No such link-file: ' lfile
  124.    return 0
  125. end
  126.  
  127. yow2=cvcopy(bg.!hrefs,hrefs)
  128. yow2=cvcopy(bg.!imgs,imgs)
  129.  
  130.  
  131. /* Make an index ? */
  132. if entrynum=0 | listmode>0 then do
  133.     if listmode=3 then
  134.         call list_all
  135.     else
  136.         call make_index entrynum
  137.     return 1
  138. end /* do */
  139.  
  140.  
  141. /* not an index -- examine one url in this web tree */
  142. if isimg=1 then do
  143.    if entrynum>imgs.0 then do
  144.          if is_cgi=0 then
  145.             'string Image entry number 'entrynum ' > # of entries  ('imgs.0 ')'
  146.          else
  147.             say 'Image entry number 'entrynum ' > # of entries  ('imgs.0 ')'
  148.         return 0
  149.    end /* do */
  150. end
  151. else do
  152.   if entrynum>hrefs.0 then do
  153.      if is_cgi=0 then
  154.         'string Anchor entry number ' entrynum ' > # of entries (' hrefs.0 ')'
  155.      else
  156.         say 'Anchor entry number ' entrynum ' > # of entries (' hrefs.0 ')'
  157.      return 0
  158.   end /* do */
  159. end /* do */
  160.  
  161. outit=''
  162. if user_intro1<>'' then do
  163.   afil=stream(user_intro1,'c','query exists')
  164.   if afil<>'' then do
  165.      foo=stream(afil,'c','open read')
  166.      outit=charin(afil,1,chars(afil))
  167.      foo=stream(afil,'c','close')
  168.   end
  169. end
  170.  
  171. if outit='' then        /* the generic intro */
  172.   outit='<html><head><title>CheckLink: Links Report </title></head><body ' back_1'> 'crlf 
  173.  
  174. outit=outit||make_topbar(entrynum,chlink,linkfile,listmode)'<p>'
  175.  
  176. outit=outit||'<h2 align=center> CheckLink: Examine and Traverse a Web-Tree </h2>' crlf 
  177. if via<>'' then do
  178.     if via<0 then do 
  179.         via=abs(via)
  180.         iimg=1; yoiks=imgs.via
  181.     end /* do */
  182.     else do
  183.         iimg=0 ; yoiks=hrefs.via
  184.     end
  185.     via='<a href="'chlink'?linkfile='linkfile'&isimg='iimg'&entrynum='via'">'yoiks'</a>'
  186.     outit=outit||'<font size=-1><center>... via 'via'</center></font> ' crlf
  187. end /* do */
  188.  
  189. if symbol('HREFS.!NAME')<>'VAR' then do             /* name of this webtree */
  190.    a1=hrefs.1
  191.    parse var a1 . '//' sname '/' rname
  192.    treename='Starting at /'rname ' on  ' sname
  193. end /* do */
  194. else do
  195.    treename=hrefs.!name     
  196. end
  197. outit=outit||' <b>Name of webtree:</b> <tt>' treename '</tt>' crlf
  198. if entrynum=1  then outit=outit'<br>This URL is the <em>starter-URL</em> (the root) of the <b>web-tree</b>!'
  199.  
  200. if isimg=0 then do
  201.    call as_anchor
  202. end                         /* not an image */
  203. else  do               /* an image */
  204.   call as_image
  205. end
  206.  
  207. outit=outit||crlf||make_bottombar(entrynum,chlink,linkfile,listmode)'<p>'
  208.  
  209. outit=outit||'</body></html> 'crlf
  210.  
  211. call govar is_cgi
  212.  
  213. return 1
  214.  
  215.  
  216. /* img fields
  217. .n and .n.!  APPEARIN NREFS SIZE TYPE */
  218.  
  219. /* .n and .n.! APPEARIN  IMGLIST   NLINKS   NREFS
  220.                QUERIED   SIZE      TYPE     REFLIST
  221. */
  222.  
  223.  
  224. /******************/
  225. /* make a link bar for top of document */
  226. make_topbar:procedure expose cheklink_htm
  227. parse arg entrynum,chlink,linkfile,lmode,other
  228. crlf='0d0a'x
  229.  
  230.  /*  lmode=2 : doing= from links
  231.    lmode=0, entrynum>0 :  doing=synopsis 
  232.    lmode=1  : doing=to links
  233.    lmode=0, entrynum=1 :  Root url
  234.    lmode=1 or 2 , entrynum=0 : doing=all htmls
  235.    lmode=3 : doing = all urls
  236. */
  237.  
  238. select
  239.    when lmode=0 & entrynum>0 then doing=2
  240.    when (lmode>0 & lmode<3) & entrynum=0 then doing=4
  241.    when lmode=1 then doing=3 
  242.    when lmode=2 then doing=1
  243.    when lmode=3 then doing=5
  244.    otherwise doing=0
  245. end  /* select */
  246.  
  247.  
  248. outit=crlf
  249.  
  250. if doing<>1 & doing<>4 & doing<>5 then
  251.   outit=outit||'<a href="'chlink'?list=2&linkfile='linkfile'&entrynum='entrynum'"> ',
  252.               'HTML Documents that point here </a> || ' crlf
  253. else 
  254.   outit=outit||'HTML Documents that point here || ' crlf
  255.  
  256.  
  257. if doing<>2 & doing<>4 & doing <> 5 then
  258.   outit=outit||'<a href="'chlink'?linkfile='linkfile'&entrynum='entrynum'"> ',
  259.               'Synopsis </a> || ' crlf
  260. else
  261.   outit=outit||' Synopsis ||'crlf
  262.  
  263. if doing<>3 & doing<>4 & doing<>5 then
  264.   outit=outit||'<a href="'chlink'?list=1&linkfile='linkfile'&entrynum='entrynum'"> ',
  265.               'Links contained in this document </a>   ' crlf
  266. else
  267.   outit=outit||' Links contained in this document ' crlf
  268.  
  269.  
  270. outit=outit||'  ||   <a href="#more">more...</a>'
  271.  
  272. return outit||other
  273.  
  274. /*****************/
  275. /* make a link bar for bottom of document */
  276. make_bottombar:procedure expose cheklink_htm hrefs.
  277. parse arg entrynum,chlink,linkfile,lmode,other
  278. crlf='0d0a'x
  279.  
  280. outit=''
  281. if lmode=1 | lmode=2 then do
  282.   outit='<hr width=50%>'
  283.   if symbol('HREFS.'entrynum'.!TITLE')<>'VAR'  then
  284.          atit=''
  285.    else
  286.         atit=hrefs.entrynum.!title
  287.  
  288.    if symbol('HREFS.'entrynum'.!DESCRIP')<>'VAR' then
  289.          adescrip=' '
  290.    else
  291.         adescrip=hrefs.entrynum.!descrip
  292.  
  293.    if atit<>'' | adescrip<>'' then do
  294.      outit=outit||'<menu>For <u>' hrefs.entrynum'</u><br>' crlf
  295.      if atit<>'' then outit=outit||'<li><b>Title:</b> 'atit || crlf 
  296.      if adescrip<>'' then outit=outit||'<li><b>Description:</b> ' adescrip
  297.      outit=outit'</menu>' crlf
  298.   end
  299. end
  300.  
  301. outit=outit||'<hr><a name="more"><h3>More options</h3> </a><menu>' crlf
  302. if doing<>4 then
  303.   outit=outit'<li> View all <a href="'chlink'?linkfile='linkfile'&list=1&entrynum=0"> ' , 
  304.       ' <b>HTML</b> links </a> in web-tree ' crlf
  305. else
  306.   outit=outit||'<li> HTMLs in web-tree ' crlf
  307.  
  308. if doing<>5 then
  309.   outit=outit'<li> View <b></b> <a href="'chlink'?linkfile='linkfile'&list=3"> ' , 
  310.         '  all links </a> in the web-tree ' crlf
  311. else 
  312.   outit=outit||'<li> URLs in web-tree  ' crlf
  313.  
  314. if \(entrynum=1 & lmode=1) then
  315.   outit=outit||'<li> Links in  <a href="'chlink'?list=1&linkfile='linkfile'&entrynum=1"> ',
  316.               'web-tree root </a>   <tt>('hrefs.1'</tt>)   ' crlf
  317. else 
  318.    outit=outit'<li>  Links in web-tree root ' crlf
  319.  
  320. outit=outit'<li><a href="'cheklink_htm'">Create another web-tree </a> (or hierarchical index) ' crlf
  321. outit=outit||'</menu>'crlf
  322. return outit||other
  323.  
  324.  
  325. /******************************************/
  326. /* return a list of linkfiles */
  327. list_linkfiles:
  328.  
  329. outit='<html><head><title>CheckLink: List of Linkage Files </title></head><body ' back_1'> 'crlf 
  330. outit=outit'<h2>List of Linkage Files</h2> The following <em> linkage files </em> were found: 'crlf
  331. outit=outit||'<ul>' crlf
  332. oo=sysfiletree(lfile,alist,'FO')
  333. do mm=1 to alist.0
  334.    crea=stream(alist.mm,'c','query datetime')
  335.    a1=filespec('n',alist.mm)
  336.    parse var a1 a2 '.' .
  337.    outit=outit||'<li> <a href="'chlink'?linkfile='a2'&entrynum=1">'a2'</a> ('crea ')'crlf
  338. end /* do */
  339.  
  340. call govar outit
  341.  
  342.  
  343. return 1
  344.  
  345.  
  346. /************/
  347. as_anchor:
  348.      daurl=hrefs.entrynum
  349.  
  350. /* scan hrefs and label: 1=own site text/html, 2=off site text/html, 3=other */
  351.     if translate(hrefs.1.!type)<>'TEXT/HTML' then call pmprintf(' ERROR: entry#1 not text/html ')
  352.     aa=upper(hrefs.1)    
  353.     parse var aa a1 '//' onsite '/' .
  354.     onsite='HTTP://'onsite'/'
  355.     nonsites=0 ;noffsites=0 ; nothtmls=0
  356.  
  357.     do mm=1 to words(hrefs.entrynum.!reflist)       /* identify types of urls */
  358.        aw=strip(word(hrefs.entrynum.!reflist,mm))
  359.        ac=translate(hrefs.aw)
  360.        ac2=strip(translate(hrefs.aw.!type))
  361.        if ac2='TEXT/HTML' then do
  362.           if abbrev(ac,onsite)=1 then do
  363.               nonsites=nonsites+1
  364.               hrefs.aw.!ttype=1
  365.           end /* do */
  366.           else do
  367.               hrefs.aw.!ttype=2
  368.               noffsites=noffsites+1
  369.           end
  370.        end /* do */
  371.        else do
  372.           if abbrev(ac,onsite)=1 then do
  373.               hrefs.aw.!ttype=3
  374.           end /* do */
  375.           else do
  376.               hrefs.aw.!ttype=4
  377.           end
  378.           nothtmls=nothtmls+1
  379.        end
  380.     end /* do */
  381.     do mm=1 to words(hrefs.entrynum.!imglist)
  382.        aw=strip(word(hrefs.entrynum.!imglist,mm))
  383.        ac=translate(imgs.aw)
  384.        if abbrev(ac,onsite)=1 then 
  385.               imgs.aw.!ttype=3
  386.        else 
  387.               imgs.aw.!ttype=4
  388.     end                         /* identifying types of urls */
  389.  
  390.     
  391.     qq=hrefs.entrynum.!queried
  392.     ss=hrefs.entrynum.!size
  393.     avail='yes'
  394.     if ss<0 then do
  395.           ipy=abs(ss) ; avail=nas.ipy
  396.           ss='unknown' 
  397.     end
  398.     
  399.     if symbol('HREFS.'entrynum'.!TITLE')<>'VAR' then
  400.          atit=''
  401.     else
  402.         atit=hrefs.entrynum.!title
  403.  
  404.     if symbol('HREFS.'entrynum'.!DESCRIP')<>'VAR' then
  405.          adescrip=' '
  406.     else
  407.         adescrip=hrefs.entrynum.!descrip
  408.    
  409.  
  410.     if qq=1 then
  411.         outit=outit||'<center><h3> For text/html document at 'daurl '</h3></center>' crlf 
  412.     else
  413.         outit=outit||'<h2> For 'daurl '</h2>' crlf 
  414.     outit=outit||'Basic Information on <a href="'daurl'">' daurl'</a><ul>' crlf 
  415.     if atit<>' ' then outit=outit'<li><b>Title:</b> ' atit||crlf   
  416.     if adescrip<>' ' then outit=outit'<li><b>Description:</b> ' adescrip||crlf   
  417.  
  418.     outit=outit'<li> Accessible: ' avail ||crlf 
  419.  
  420.      outit=outit||'<li> Size=' ss ',  and MimeType=' hrefs.entrynum.!type ||crlf ,
  421.        '<li> referenced 'hrefs.entrynum.!nrefs' times  ' crlf 
  422.       if qq=1 then do
  423.          outit=outit||'<li>' crlf 
  424.          outit=outit||' Contains '||words(hrefs.entrynum.!reflist)' <u>anchors</u>: '  crlf 
  425.          outit=outit|| nonsites '<a href="#ONSITES">on-site HTMLs</a> , ' crlf 
  426.          outit=outit||noffsites ' <a href="#OFFSITES">off-site HTMLs</a>, ' crlf 
  427.          outit=outit|| nothtmls ' <a href="#NOTHTMLS">non-HTMLs</a>; ' crlf
  428.      
  429.         outit=outit||'   <em>and </em>   '||words(hrefs.entrynum.!imglist)||' <a href="#IMAGES"> Images </a>. '
  430.       end
  431.       outit=outit'</ul> 'crlf
  432.  
  433.  
  434. /* seperate list of "references to " */
  435.  outit=outit|| ,
  436.      '<hr width=30%><h3>References to: 'daurl '</h3>'|| crlf ,
  437.      'The following HTML documents contain links to <u> 'daurl'</u>'||crlf||'<ol>'
  438.      sortlist=sort_list(hrefs.entrynum.!appearin)
  439.      do i8=1 to words(sortlist)
  440.          aw=word(sortlist,i8)
  441.          if symbol('HREFS.'aw'.!TITLE')<>'VAR' then
  442.              atit=''
  443.          else
  444.              atit=hrefs.aw.!title
  445.          outit=outit'<li><a href="'hrefs.aw'">'hrefs.aw'</a>  '
  446.          yv=chlink'?LINKFILE='linkfile'&isimg=0&ENTRYNUM='aw
  447.          yv=yv||'&via='entrynum
  448.          outit=outit||' <a href="'yv'"> ?</a>    <em>('atit')</em>'||crlf
  449.      end /* do */
  450.  
  451.      outit=outit||'</ol>'crlf
  452.  
  453.  
  454. if qq=0 then return 1
  455.  
  456. anrefs=words(hrefs.entrynum.!reflist)
  457. animgs=words(imgs.entrynum.!imglist)
  458. if anrefs+animgs=0 then return 1
  459.  
  460. outit=outit'<hr width=30%><a name="LINKS"><h3>Links apppearing in 'daurl '</h3></a>' crlf ,
  461.     'The following links appear in  <u>' daurl '</u>'||crlf
  462.  
  463. outit=outit'<p><table border=1> <tr>' crlf
  464.  
  465. outit=outit'<td><center><a name="ONSITES"><b>On-site HTMLs</b></a><br></center> <ol> ' crlf
  466.  
  467. sortlist=sort_list(hrefs.entrynum.!reflist)
  468.  
  469. do i8=1 to words(sortlist)
  470.     aw=strip(word(sortlist,i8))
  471.     if hrefs.aw.!ttype<>1 then iterate   /* On site htmls */
  472.     if symbol('HREFS.'aw'.!TITLE')<>'VAR' then
  473.        atit=''
  474.     else
  475.        atit=hrefs.aw.!title
  476.     outit=outit'<li><a href="'hrefs.aw'">'||breakup(hrefs.aw,45,1)||'</a>   '
  477.     yv=chlink'?LINKFILE='linkfile'&isimg=0&ENTRYNUM='aw'&via='entrynum
  478.     outit=outit||' <a href="'yv'">  ?</a> <em>  ('atit')</em>'||crlf
  479. end /* do */
  480. outit=outit||crlf'</ol></td> 'crlf
  481.  
  482. outit=outit' <td valign="top"> ' crlf 
  483. outit=outit'<center><a name="OFFSITES"><b>Off-site HTMLs</b></a><br></center><ol>'crlf
  484. do i8=1 to words(sortlist)              /* use same sortlist (derived from same !reflist */
  485.     aw=word(sortlist,i8)
  486.     if hrefs.aw.!ttype<>2 then iterate   /* Off site htmls */
  487.     outit=outit'<li><a href="'hrefs.aw'">'||breakup(hrefs.aw,45)'</a>  '
  488.     yv=chlink'?LINKFILE='linkfile'&isimg=0&ENTRYNUM='aw'&via='entrynum
  489.     outit=outit||' <a href="'yv'">  ?</a>'||crlf
  490. end /* do */
  491. outit=outit||crlf'</ol></td> '
  492.  
  493. outit=outit'<tr> 'crlf
  494.  
  495. outit=outit' <td valign="top"> ' crlf 
  496. outit=outit'<center><a name="NOTHTMLS"><b>Non-HTMLs</b></a><br></center><ol>'crlf
  497. outit=outit||'<em>on-site</em><br>'crlf
  498. do i8=1 to words(sortlist)              /* use same sortlist (derived from same !reflist */
  499.     aw=word(sortlist,i8)
  500.     if hrefs.aw.!ttype<>3 then iterate   /* non htmls */
  501.     outit=outit'<li><a href="'hrefs.aw'">'||breakup(hrefs.aw,45,1)'</a>  '
  502.     yv=chlink'?LINKFILE='linkfile'&isimg=0&ENTRYNUM='aw'&via='entrynum
  503.     outit=outit||' <a href="'yv'">  ?</a>'||crlf
  504. end /* do */
  505.  
  506. outit=outit||'</ol><p><ol><em>off-site</em><br>'crlf
  507. do i8=1 to words(sortlist)              /* use same sortlist (derived from same !reflist */
  508.     aw=word(sortlist,i8)
  509.     if hrefs.aw.!ttype<>4 then iterate   /* non htmls */
  510.     outit=outit'<li><a href="'hrefs.aw'">'||breakup(hrefs.aw,45)||'</a>  '
  511.     yv=chlink'?LINKFILE='linkfile'&isimg=0&ENTRYNUM='aw'&via='entrynum
  512.     outit=outit||' <a href="'yv'">  ?</a>'||crlf
  513. end /* do */
  514.  
  515.  
  516. outit=outit||crlf'</ol></td> '
  517.  
  518. outit=outit'<td valign="top"> ' crlf 
  519. outit=outit'<center><a name="IMAGES"><b>Images</b></a><br></center><ol><em>on-site</em>'crlf
  520. sortlist=sort_list(hrefs.entrynum.!imglist,1)
  521. do i8=1 to words(sortlist)              
  522.     aw=word(sortlist,i8)
  523.     if imgs.aw.!ttype<>3 then iterate                /* onsite imagse */
  524.     outit=outit'<li><a href="'imgs.aw'">'||breakup(imgs.aw,45,1)||'</a>  '
  525.     yv=chlink'?LINKFILE='linkfile'&isimg=1&ENTRYNUM='aw
  526.     yv=yv||'&via='entrynum
  527.     outit=outit||' <a href="'yv'">  ?</a>'||crlf
  528. end /* do */
  529.  
  530. outit=outit||'</ol><p><ol><em>off-site</em><br>'crlf
  531. do i8=1 to words(sortlist)              
  532.     aw=word(sortlist,i8)
  533.     if imgs.aw.!ttype<>4 then iterate               /* off site images */
  534.     outit=outit'<li><a href="'imgs.aw'">'||breakup(imgs.aw,45)||'</a>  '
  535.     yv=chlink'?LINKFILE='linkfile'&isimg=1&ENTRYNUM='aw
  536.     yv=yv||'&via='entrynum
  537.     outit=outit||' <a href="'yv'">  ?</a>'||crlf
  538. end /* do */
  539.  
  540. outit=outit||crlf||'</ol></td>'
  541.  
  542. outit=outit'</table>'crlf
  543.  
  544. return 1
  545.  
  546. /************/
  547. breakup:procedure
  548. parse arg aword,alen,nosn
  549.  
  550. parse var aword . '//' aword
  551.  
  552. if nosn=1 then do
  553.    parse var aword '/' aword
  554.    if length(aword)<=alen then return '/'aword
  555.    asn='' ; req='/'aword
  556. end /* do */
  557. else do
  558.    if length(aword)<=alen then do
  559.       if pos('/',aword)=0 then aword=aword'/'
  560.       return aword
  561.    end
  562.    parse var aword asn '/'  req ; req='/'req ;  asn=asn'/<br>'
  563. end   
  564.  
  565. if length(req)<alen then return asn||req
  566.  
  567. parse var req  rq '?' opts
  568. aq='?'; if pos("?",req)=0 then aq=''
  569. if length(rq)>alen then 
  570.    rq=left(rq,alen)||'...'aq'<br>'
  571. else
  572.    rq=rq||aq'<br>'
  573. if length(opts)>alen then opts=left(opts,alen)'...'
  574.  
  575. return asn||rq||opts
  576.  
  577. /************/
  578. /* image links are fairly simple (not much info to be displayed */
  579. as_image:
  580.  
  581.  daurl=imgs.entrynum
  582.  
  583.  ss=imgs.entrynum.!size
  584.  if ss<0 then ss='unknown'
  585.  nr=imgs.entrynum.!nrefs
  586.  outit=outit||'<h2> For image: 'imgs.entrynum '</h2>' crlf 
  587.           outit=outit||'Basic Information on <a href="'daurl'">' daurl'</a>' crlf ,
  588.           '<ul><li> Size='ss ',  and MimeType=' imgs.entrynum.!type|| crlf ,
  589.           '<li> Size and MimeType: ' imgs.entrynum.!size ' ' imgs.entrynum.!type ||crlf ,
  590.           '<li> referenced 'nr' times ' crlf 
  591.  outit=outit||'</ul> '
  592.  
  593. /* seperate list of "references to " */
  594.  outit=outit|| ,
  595.      '<hr width=30%><h3>References to: 'daurl '</h3>'|| crlf ,
  596.      'The following HTML documents contain in-line image references to <u> 'daurl'</u>'||crlf||'<ol>'
  597.      do i8=1 to words(imgs.entrynum.!appearin)
  598.          aw=word(imgs.entrynum.!appearin,i8)
  599.          outit=outit'<li><a href="'hrefs.aw'">'hrefs.aw'</a>  '
  600.          yv=chlink'?LINKFILE='linkfile'&isimg=0&ENTRYNUM='aw
  601.          yv=yv||'&via=-'entrynum
  602.          outit=outit||' <a href="'yv'"> ?</a>'||crlf
  603.      end /* do */
  604.      outit=outit||'</ol>'crlf
  605.  
  606.  return 1
  607.  
  608.  
  609. /*********/
  610. packur2:procedure expose standalone
  611. parse arg a1b0
  612.  
  613. if standalone=0 then
  614.    return packur(translate(a1b0,' ','+'))
  615. else
  616.    return decodekeyval(translate(a1b0,' ','+'))
  617.  
  618.  
  619. /************************************************/
  620. /* procedure from TEST-CGI.CMD by  Frankie Fan <kfan@netcom.com>  7/11/94 */
  621. DecodeKeyVal: procedure
  622.   parse arg Code
  623.   Text=''
  624.   Code=translate(Code, ' ', '+')
  625.   rest='%'
  626.   do while (rest\='')
  627.      Parse var Code T '%' rest
  628.      Text=Text || T
  629.      if (rest\='' ) then
  630.       do
  631.         ch = left( rest,2)
  632.         if verify(ch,'01234567890ABCDEF')=0 then
  633.            c=X2C(ch)
  634.         else
  635.            c=ch
  636.         Text=Text || c
  637.         Code=substr( rest, 3)
  638.       end
  639.   end
  640.   return Text
  641.  
  642.  
  643. /***********/
  644. /* load some dlls */
  645. load:
  646.  
  647. foo=rxfuncquery('sysloadfuncs')
  648. if foo=1 then do
  649.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  650.   call SysLoadFuncs
  651. end
  652.  
  653. foo=rxfuncquery('rexxlibregister')
  654. if foo=1 then do
  655.  call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
  656.  call rexxlibregister
  657. end
  658. foo=rxfuncquery('rexxlibregister')
  659. if foo=1 then do
  660.     say " Could not find REXXLIB "
  661.     exit
  662. end /* do */
  663. return 1
  664.  
  665.  
  666. /***********************************/
  667. /* LIST ALL urls, possibly matching checkmime variable
  668.   Make_index will list only on-site text/htmls */
  669.  
  670. list_all:
  671. parse arg jat
  672. jat=strip(jat)
  673. outit=''
  674. if user_intro1<>'' then do
  675.   afil=stream(user_intro1,'c','query exists')
  676.   if afil<>'' then do
  677.      foo=stream(afil,'c','open read')
  678.      outit=charin(afil,1,chars(afil))
  679.      foo=stream(afil,'c','close')
  680.   end
  681. end
  682. if outit='' then        /* the generic intro */
  683.   outit='<html><head><title>CheckLink: Display Web Index </title></head><body ' back_1'> 'crlf 
  684.  
  685. goo3=' || <a href="#urlspec">By mime</a>'
  686. outit=outit||'<A name="TOP1">|</a>'||make_topbar(jat,chlink,linkfile,listmode,goo3)'<p>'
  687.  
  688. outit=outit||'<h2 align=center> CheckLink: Index of Web Tree </h2>' crlf 
  689.  
  690.  
  691. if is_cgi=0  then do            /* srehttp -- send first part */
  692.    rcode=sref_multi_send(outit,'text/html','1S',0,verbose,fixexpire,'CheckLink2')
  693.    outit=''
  694. end
  695.  
  696. if symbol('HREFS.!NAME')<>'VAR' then do             /* name of this webtree */
  697.    a1=hrefs.1
  698.    parse var a1 . '//' sname '/' rname
  699.    treename='Starting at /'rname ' on  ' sname
  700. end /* do */
  701. else do
  702.    treename=hrefs.!name     
  703. end
  704. outit=outit||'<b>Name of webtree:</b> <tt>' treename '</tt>' crlf
  705.  
  706. if translate(hrefs.1.!type)<>'TEXT/HTML' then call pmprintf(' ERROR: entry#1 not text/html ')
  707. aa=upper(hrefs.1)    
  708. parse var aa a1 '//' thesite '/' .
  709. onsite='HTTP://'thesite'/'
  710.  
  711. /* list all on-site urls first, interminngling sorted anchors and images.
  712. Then include links off-site (also sorted */
  713.  
  714. hoffsites='' ; honsites='' ; ioffsites='' ; ionsites=''
  715. ccm=checkmime
  716. checkmime=translate(checkmime)
  717.  
  718. if is_cgi=0 then do
  719.    maxwait=extract('limittimeinactive')/2
  720.    outit=outit||'<br> <em> Processing time required ...</em>'crlf
  721.    rc=sref_multi_send(outit)
  722.    outit=''
  723. end
  724. else do
  725.   maxwait=1111111111
  726. end
  727. aa=time('r'); aa0=aa ; bb=aa
  728. do aw=1 to hrefs.0                      /* create on and offsite anchors lists */
  729.     ac=translate(hrefs.aw)
  730.     ty=strip(translate(hrefs.aw.!type))  /* look for wildcard match in checkmime */
  731.     if checkmime<>'*' then do
  732.       ioky=0
  733.       do aw2=1 to words(checkmime)        /* if found, then we are okay */
  734.            goof=strip(word(checkmime,aw2))
  735.            if wild_match(ty,goof)<>0 then ioky=1
  736.            if ioky=1 then leave
  737.       end /* do */
  738.       if ioky=0 then iterate
  739.     end
  740.     if abbrev(ac,onsite)=1 then 
  741.          honsites=honsites' 'aw
  742.     else
  743.          hoffsites=hoffsites' 'aw
  744.     if (aw//10)=1 then bb=time('e')
  745.     if bb-aa>maxwait then do                  /* only will happen in sre mode */
  746.         foo=sref_multi_send('.'crlf)
  747.         aa=bb
  748.     end /* do */
  749. end
  750. honsites=sort_list(honsites)            /* sort them */
  751. hoffsites=sort_list(hoffsites)
  752. do aw=1 to imgs.0                               /* on and off site image list */
  753.     ac=translate(imgs.aw)
  754.     if checkmime<>'*' then do
  755.        ty=strip(translate(imgs.aw.!type))
  756.        if wordpos(ty,checkmime)=0 then iterate  /* not in "checkmime" list, so skip */
  757.     end /* do */
  758.     if abbrev(ac,onsite)=1 then 
  759.          ionsites=ionsites' 'aw
  760.     else
  761.          ioffsites=ioffsites' 'aw
  762.     if (aw//10)=1 then bb=time('e')
  763.     if bb-aa>maxwait then do                  /* only will happen in sre mode */
  764.         foo=sref_multi_send('.'crlf)
  765.         aa=bb
  766.     end /* do */
  767.  
  768. end
  769.  
  770. ionsites=sort_list(ionsites,1)          /* sort them */
  771. ioffsites=sort_list(ioffsites,1)
  772.  
  773. tt=hrefs.0+imgs.0
  774. outit=outit'<center><h3>URLs in the web-tree </h3></center> 'crlf
  775.  
  776. if checkmime='*' then          /* constrainted url display ? */
  777.    outit=outit'Total of 'tt ' URLs( 'hrefs.0' <em>anchors</em> and 'imgs.0 '<em>images </em>) 'crlf
  778. else 
  779.   outit=outit' Extracting URLS with mimetype of 'ccm ', from a total of ' ,
  780.    tt ' URLs  ( 'hrefs.0' <em>anchors</em> and 'imgs.0 '<em>images </em>) 'crlf
  781.  
  782. outit=outit'<hr width=35%>'crlf
  783. outit=outit||  ,
  784.       '<table> ' crlf ,
  785.       ' <th nowrap> More info </th> ' crlf ,
  786.       ' <th> / </th> ' crlf ,
  787.       ' <th> _._ </th> ' crlf  ,
  788.       ' <th> <em>Size or<br>status</em> </th> ' crlf  ,
  789.       ' <th> <tt>Mimetype</tt>  & <em>Title</em> </th> 'crlf
  790. call disp_interleave honsites,ionsites,1
  791.  
  792. outit=outit'<tr> <td colspan=5> <center> <b>____________ </b> </center></td> 'crlf
  793. call disp_interleave hoffsites,ioffsites /* now do it again for offsite */
  794. outit=outit'</table>' crlf
  795.  
  796. outit=outit'<hr><a name="urlspec">Display</a> URLs of a particular mimetype: <menu> ' crlf ,
  797.   '<li> <a href="'chlink'?linkfile='linkfile'&list=3&mime=text/plain">text/plain</a> ' ,
  798.   '<li> <a href="'chlink'?linkfile='linkfile'&list=3&mime=text/html">text/html</a> ' ,
  799.   '<li> <a href="'chlink'?linkfile='linkfile'&list=3&mime=image/*">image/* files</a> ' ,
  800.   '<li> <a href="'chlink'?linkfile='linkfile'&list=3&mime=application/*">application/*</a> ' ,
  801.   '<li> <a href="'chlink'?linkfile='linkfile'&list=3&mime=*">all URLs</a> ' ,
  802.   '</menu><bR> <a href="#TOP1">Top of file </a> 'crlf
  803.  
  804.  
  805. outit=outit||crlf||make_bottombar(entrynum,chlink,linkfile,listmode)'<p>'
  806.  
  807.  
  808. outit=outit||'</body></html> 'crlf
  809. if is_cgi=0 then do
  810.  
  811. teps=time('e')-aa0
  812.    if is_cgi=0 then foo=sref_multi_send('<em>'||format(teps,6,2)||' seconds </em><br>')
  813.    foo=sref_multi_send(outit)
  814.    foo=sref_multi_send(' ',,'1E')
  815. end /* do */
  816. else do
  817.   call charout, outit
  818. end
  819.  
  820.  
  821.  
  822. /**************/
  823. /* interleave display of two lists of urls -- anchors and images 
  824.    hlist == pointers to hrefs (internally sorted
  825.    ilist == pointers to images (interanlly sorted0
  826.    ison  == 1 if "thsee are onsites" (hence strip http://xx.yy/ portion */
  827. disp_interleave:
  828. parse arg hlist,ilist,ison
  829.  
  830. codesb.0='not reported '
  831. codesb.1='Server n.a. '
  832. codesb.2='Resource n.a. '
  833. codesb.3='Off-site '
  834. codesb.4=''
  835. codesb.5='Excluded  '
  836.  
  837. hdo=words(hlist)
  838. ido=words(ilist)
  839. ath=1                  /* currently avaiable for comparision (prior ones written */
  840. ati=1
  841.  
  842. oof=1
  843. amy=0
  844. do forever              /* interleave anchor and images, and display */
  845.     amy=amy+1
  846.     if (amy//10)=1 then bb=time('e')
  847.     if bb-aa>maxwait then do                  /* only will happen in sre mode */
  848.         foo=sref_multi_send('.'crlf)
  849.         aa=bb
  850.     end /* do */
  851.  
  852.   
  853.   select
  854.       when ath>hdo & ati>ido then leave       /* got'em all */
  855.       when ati>ido then  do
  856.            doh=1            /* doh=1 -- use anchor */
  857.            iath=word(hlist,ath) ; iat=iath
  858.       end
  859.       when ath>hdo then do   
  860.           doh=0  
  861.           iati=word(ilist,ati)
  862.           iat=iati
  863.       end
  864.       otherwise do                      /* compare */   
  865.         iath=word(hlist,ath)
  866.         iati=word(ilist,ati)
  867.         hurl=lower(hrefs.iath)
  868.         iurl=lower(imgs.iati)
  869.         if hurl>iurl then do
  870.             iat=iati ;    doh=0
  871.         end
  872.         else do
  873.             doh=1 ; iat=iath
  874.         end
  875.       end
  876.   end
  877.  
  878. /* using doh, decide what to write */
  879.   inf1=0
  880.   if doh=1 then do                              /* anchor is next one to show */
  881.       writeme=hrefs.iath ; writeme2='<tt>'hrefs.iath.!type'</tt>' ; writeme3=hrefs.iath.!size
  882.       ath=ath+1 ; 
  883.       if ison=1 then inf1=hrefs.iath.!queried
  884.    end
  885.    else do                      /* image is */
  886.       writeme=imgs.iati ; writeme2='<tt>'imgs.iati.!type'</tt>' ; writeme3=imgs.iati.!size
  887.       ati=ati+1 
  888.    end
  889.    burl=writeme
  890.    writeme=lower(breakup(writeme,36,ison))
  891.    ugl=lastpos('/',writeme)     /* empty line at subdirectory change? */
  892.    ugly=left(writeme,ugl)
  893.    if oof=1 then oldugly=ugly
  894.    oof=0
  895.    if ugly<>oldugly then do
  896.         ncc=compare(ugly,oldugly)
  897.         outit=outit'<tr><td colspan=5>   </td>'
  898.         oldugly=ugly
  899.    end /* do */
  900.  
  901.    ill=lastpos('/',writeme) ; if ill=0 then ill=1
  902.    pt1=substr(writeme,1,ill)
  903.    pt2=substr(writeme,ill+1) ; if pt2='' then pt2='/'
  904.    hh='<a href="'||burl||'">'pt2'</a>'
  905.    if datatype(writeme3)='NUM' then do
  906.        kc=abs(writeme3)
  907.        if writeme3<=0 then writeme3=codesb.kc
  908.    end /* do */
  909.    hod=1-doh
  910.  
  911.    inf2='<a href="'chlink'?linkfile='linkfile'&isimg='hod'&entrynum='iat'">?</a>   '
  912.    if inf1=1 then do
  913.      inf2='<a href="'chlink'?linkfile='linkfile'&list=2&entrynum='iat'"><-</a>  'inf2
  914.      inf2=inf2'<a href="'chlink'?linkfile='linkfile'&list=1&entrynum='iat'">-></a>  '
  915.      if symbol('HREFS.'iath'.!TITLE')<>'VAR' | doh=0 then
  916.          atit=''
  917.      else
  918.         atit=hrefs.iath.!title
  919.      writeme2=writeme2'<br><em>'atit'</em>'
  920.    end
  921.    else do
  922.       inf2='    'inf2'    '
  923.    end /* do */
  924.  
  925.    outit=outit||'<tr><td valign=top><b>'inf2'</b>  </td> ' ,
  926.                    '<td valign=top> 'pt1'</td> ',
  927.                    '<td valign=top>' hh '</td> ',
  928.                    '<td valign=top> <em>'writeme3'</em> </td> ' , 
  929.                    '<td valign=top align=center> 'writeme2' </td>  ' crlf
  930.  
  931. end /* do */
  932.  
  933. return 1
  934.  
  935. /***********************************/
  936. /* make an index (text/html document pointed to by this entry */
  937. make_index:
  938. parse arg jat
  939. jat=strip(jat)
  940. outit=''
  941. if user_intro1<>'' then do
  942.   afil=stream(user_intro1,'c','query exists')
  943.   if afil<>'' then do
  944.      foo=stream(afil,'c','open read')
  945.      outit=charin(afil,1,chars(afil))
  946.      foo=stream(afil,'c','close')
  947.   end
  948. end
  949. if outit='' then        /* the generic intro */
  950.   outit='<html><head><title>CheckLink: Traverse Web Tree </title></head><body ' back_1'> 'crlf 
  951.  
  952. outit=outit||make_topbar(jat,chlink,linkfile,listmode)'<p>'
  953.  
  954. outit=outit||'<h2 align=center> CheckLink: Traversing Web Tree </h2>' crlf 
  955.  
  956. if symbol('HREFS.!NAME')<>'VAR' then do             /* name of this webtree */
  957.    a1=hrefs.1
  958.    parse var a1 . '//' sname '/' rname
  959.    treename='Starting at /'rname ' on  ' sname
  960. end /* do */
  961. else do
  962.    treename=hrefs.!name     
  963. end
  964. outit=outit||'<b>Name of webtree:</b> <tt>' treename '</tt>' crlf
  965.  
  966. if translate(hrefs.1.!type)<>'TEXT/HTML' then call pmprintf(' ERROR: entry#1 not text/html ')
  967. aa=upper(hrefs.1)    
  968. parse var aa a1 '//' thesite '/' .
  969. onsite='HTTP://'thesite'/'
  970.  
  971.  
  972. /* display on-site resources only.  For now, just to htmls */
  973. ndo=0
  974. tmplist=''
  975. if jat=0 then do                 /* all htmls */
  976.   do aw=1 to hrefs.0
  977.     ac=translate(hrefs.aw)
  978.  
  979.     if abbrev(ac,onsite)<>1 then iterate /* off-site resource, ignore */
  980.     ac2=strip(translate(hrefs.aw.!type))
  981.     if ac2<>'TEXT/HTML' then iterate            /* non-html, ignore */
  982.     tmplist=tmplist' 'aw
  983.   end
  984. end
  985. else do                 /* this entrynum  -- either from or to*/
  986.    if listmode=2 then 
  987.         dalist=hrefs.jat.!appearin
  988.    else
  989.        dalist=hrefs.jat.!reflist
  990.  
  991.    do nn=1 to words(dalist)
  992.        aw=strip(word(dalist,nn))
  993.        ac=translate(hrefs.aw)
  994.        if abbrev(ac,onsite)<>1 then iterate /* off-site resource, ignore */
  995.        ac2=strip(translate(hrefs.aw.!type))
  996.        if ac2<>'TEXT/HTML' then iterate            /* non-html, ignore */
  997.        tmplist=tmplist' 'aw
  998.    end
  999. end /* do */
  1000.  
  1001. sortlist=sort_list(tmplist)
  1002. ndo=words(sortlist)
  1003.  
  1004. if jat=0 then do                   /* all on-site htmls in web tree */
  1005.      outit=outit||'<center><h3>text/html documents</h3></center> '
  1006.      outit=outit||'<b>' ndo ' </B> text/html documents on <u>'thesite'</u> ' crlf ,
  1007.       ' <em>(out of 'hrefs.0 ' anchors & 'imgs.0 ' images) </em> ' crlf 
  1008. end
  1009. else do
  1010.   melink='<a href="'chlink'?linkfile='linkfile'&entrynum='jat'">?</a>'
  1011.   backlink='<a href="'chlink'?list=2&linkfile='linkfile'&entrynum='||jat ,
  1012.            '"><-- </a>  '
  1013.   forwardlink=' <a href="'chlink'?list=1&linkfile='linkfile'&entrynum='||jat ,
  1014.            '">--> </a>'
  1015.  
  1016.   gourl='<a href="'hrefs.jat'">'hrefs.jat'</a>'
  1017.  
  1018.   if listmode=2 then do
  1019.     outit=outit||'<center><h3>URLs with links to 'hrefs.jat '</h3></center>' crlf
  1020.     outit=outit||'<b> ' ndo ' </B> links <b>from</b> text/html documents to 'gourl ,
  1021.                 '('melink||' 'forwardlink') ' crlf
  1022.   end /* do */
  1023.   else do
  1024.     outit=outit||'<center><h3>text/html links in 'hrefs.jat '</h3></center>' crlf
  1025.     outit=outit||'('backlink'   'melink')  ' gourl ||' contains <b> ' ndo ,
  1026.                  ' </B> links <em>to </em>   text/html documents ' crlf 
  1027.     outit=outit||' <Em> (out of '||words(hrefs.jat.!reflist)|| ,
  1028.              ' anchors and '||words(hrefs.jat.!imglist) ' images ) </em>' crlf  
  1029.   end
  1030. end
  1031. if jat=1 
  1032.     then outit=outit'<br>This is the <em>starter-URL </em> (the root) of the <B>web-tree</b><br>'crlf
  1033. outit=outit'<hr width=35%>'crlf
  1034. if ndo>0 then do
  1035.        outit=outit||  ,
  1036.       '<table> ' crlf ,
  1037.       ' <th> More info </th> ' crlf ,
  1038.       ' <th> / </th> ' crlf ,
  1039.       ' <th> _._ </th> ' crlf  ,
  1040.       ' <th> <em>size</em> </th> ' crlf  ,
  1041.       ' <th> Title </th> 'crlf
  1042. end
  1043.  
  1044. oldugly='/'
  1045. do mm=1 to ndo
  1046.    mm0=strip(word(sortlist,mm)) ;mm1=mm0
  1047.    mickey=breakup(lower(hrefs.mm0),70,1)
  1048.  
  1049.    ugl=lastpos('/',mickey)     /* empty line at subdirectory change? */
  1050.    ugly=left(mickey,ugl)
  1051.    if mm=1 then oldugly=ugly
  1052.    if ugly<>oldugly then do
  1053.         ncc=compare(ugly,oldugly)
  1054.         outit=outit'<tr><td colspan=5>   </td>'
  1055.         oldugly=ugly
  1056.    end /* do */
  1057.  
  1058.    ill=lastpos('/',mickey) ; if ill=0 then ill=1
  1059.    pt1=substr(mickey,1,ill)
  1060.    pt2=substr(mickey,ill+1) ; if pt2='' then pt2='/'
  1061.    hh='<a href="'||hrefs.mm0||'">'pt2'</a>'
  1062.  
  1063.    if symbol('HREFS.'mm0'.!TITLE')<>'VAR' then
  1064.      atit=''
  1065.    else
  1066.      atit=hrefs.mm0.!title
  1067.    if mm1=1 then atit='<u>'atit'</u>'
  1068.  
  1069.    ll0='<a href="'chlink'?linkfile='linkfile'&list=2&entrynum='mm1'"><-- </a>   '
  1070.    ll='<a href="'chlink'?linkfile='linkfile'&entrynum='mm1'">?</a>   '
  1071.    ll2='<a href="'chlink'?linkfile='linkfile'&list=1&entrynum='mm1'">-- ></a>   '
  1072.    
  1073.    outit=outit'<tr> <td>' ll0 '   ' ll '   'll2 '</td> ' crlf , 
  1074.               '<td> <u> ' pt1 '</u> </td> ' crlf ,  
  1075.               '<td>'hh'</td>  ' crlf , 
  1076.               '<td><em>('hrefs.mm0.!size') </td> ' crlf ,
  1077.               '<td></em>     'atit' </td> ' crlf 
  1078.  
  1079.  
  1080. end /* do */
  1081. if ndo>0 then outit=outit||'</table>'
  1082.  
  1083. outit=outit||crlf||make_bottombar(entrynum,chlink,linkfile,listmode)'<p>'
  1084.  
  1085. outit=outit||'</body></html> 'crlf
  1086.  
  1087. call govar outit
  1088.  
  1089. return 1
  1090.  
  1091. /******************/
  1092. /* VAR outit, or charout */
  1093. govar:
  1094. parse arg iscg
  1095. if iscg=1 then do
  1096.    call charout,iscg
  1097. end /* do */
  1098. else do
  1099.   foox=value('SREF_PREFIX',,'os2environment')
  1100.   if foox='' then
  1101.      'VAR type text/html name outit '
  1102.   else
  1103.     fooo=sref_gos('VAR type text/html name outit ',outit)
  1104. end
  1105. return 0
  1106.  
  1107. /******************/
  1108. /* given list of pointers to hrefs., rearrange it to be sorted on
  1109.   hrefs, and return. Thus, same set of pointers, but rearranged */
  1110. sort_list:procedure expose hrefs. imgs.
  1111. parse arg alist,isimg
  1112.  
  1113. if words(alist)<2 then return alist
  1114.  
  1115. nhrefs.0=words(alist)
  1116.  
  1117. if isimg=1 then do
  1118.  do mm=1 to nhrefs.0
  1119.     aw=strip(word(alist,mm))
  1120.     nhrefs.mm=imgs.aw
  1121.  end
  1122. end /* do */
  1123. else do
  1124.  do mm=1 to nhrefs.0
  1125.     aw=strip(word(alist,mm))
  1126.     nhrefs.mm=hrefs.aw
  1127.  end
  1128. end
  1129.  
  1130. call sort_nhref
  1131.  
  1132. bb=''
  1133. do mm=1 to nhrefs.0
  1134.   gurney=sortlist.mm
  1135.   bb=bb' 'word(alist,gurney)
  1136. end /* do */
  1137. return strip(bb)
  1138.  
  1139.  
  1140. /********************************/
  1141. /* sort nhrefs. list of urls --- subdirectory sensitive */
  1142. sort_nhref:procedure expose nhrefs. sortlist. 
  1143. parse arg alist
  1144.  
  1145. /* make an array with sortable elements in portions of each record
  1146.    the idea: arraysort works on portions of  record -- set up fixed length
  1147.    portion of records, padded with spaces, for each of the severeal directories
  1148.    that may occur in a url  */
  1149.  
  1150. elemsizes.0=0 ; maxfname=0 ; maxssn=0
  1151. do jj=1 to 40           /* elemsizes is the max size dir1 dir2 ... dir_elemsizes.0 */
  1152.    elemsizes.jj=0
  1153. end /* do */
  1154.  
  1155. do is=1 to nhrefs.0                             /* break into dir1 dir2 name */
  1156.      aa1=strip(strip(nhrefs.is,'l','/'))
  1157.      parse var  aa1 . '//' ssn '/' a1
  1158.      biglist.is.!srv=ssn ; maxssn=max(maxssn,length(ssn))
  1159.      h1=lastpos('/',a1)                   /* pluck off "file name" */
  1160.      biglist.is.0=0
  1161.      if h1>0 then do
  1162.         biglist.is=substr(a1,h1+1)
  1163.         maxfname=max(maxfname,length(biglist.is))   /* size of filename portion of record */
  1164.      end
  1165.      else do
  1166.         biglist.is=a1
  1167.         maxfname=max(maxfname,length(biglist.is))
  1168.         iterate         /* no dirs, get net entry */
  1169.      end
  1170.      a1=delstr(a1,h1)           /* the remainder is the path */
  1171.      idirs=0
  1172.      do forever                 /* pluck out directories in path */
  1173.        if a1='' then leave      /* got all directories */
  1174.        parse var a1 dx '/' a1
  1175.        idirs=idirs+1
  1176.        biglist.is.idirs=dx
  1177.        elemsizes.idirs=max(length(dx),elemsizes.idirs)
  1178.      end /* do */
  1179.      biglist.is.0=idirs
  1180.      elemsizes.0=max(elemsizes.0,idirs)
  1181. end
  1182. do ipp=1 to elemsizes.0         /* increase by one (prevent runons */
  1183.    elemsizes.ipp=elemsizes.ipp+1
  1184. end /* do */
  1185.  
  1186. /* make oo -- which will be arraysorted */
  1187. do ii=1 to NHREFS.0
  1188.   oo.ii=left(ii,6)' 'left(biglist.ii.!srv,maxssn+1)   /* first 6chars point to original record # */
  1189.   do mm=1 to ELEMSIZES.0
  1190.       if mm<=biglist.ii.0 then 
  1191.          oo.ii=oo.ii||left(biglist.ii.mm,elemsizes.mm)
  1192.      else
  1193.          oo.ii=oo.ii||left(' ',elemsizes.mm)
  1194.   end /* do */
  1195.   oo.ii=oo.ii||left(biglist.ii,maxfname)
  1196. end /* do */
  1197.  
  1198. OO.0=NHREFS.0           
  1199. EEF=ARRAYSORT(OO,,,7,,'A','I')         /* sort the names (offset past pointer */
  1200.  
  1201. DO MM=1 TO NHREFS.0                  /* split out pointers to original records */
  1202.    sortlist.mm=strip(left(oo.mm,6))     /* save these pointers in a new array */
  1203. end /* do */
  1204. sortlist.0=nhrefs.0
  1205. return 1
  1206.  
  1207.  
  1208.  
  1209. /************************/
  1210. /* wild card match, with comparision against prior wild card match */
  1211. */
  1212.  
  1213. wild_match:procedure
  1214. parse upper arg needle, haystack,oldresu
  1215.  
  1216.  
  1217.  aresu=awild_match(needle,haystack)
  1218.  if aresu=0 then return aresu     /* no match */
  1219.  if aresu=-1 | oldresu=' ' then return aresu  /* exact match, or first wildcard match */
  1220.  
  1221. /* Is this a better WILDCARD MATCH */
  1222.    wrdsnew=words(ARESU);wrdsold=words(oldRESU)
  1223.    useold=1
  1224.    do Nmm=1 to max(wrdsold,wrdsnew)
  1225.        if Nmm>wrdsnew then leave
  1226.        if Nmm>wrdsold then do
  1227.              useold=0; leave
  1228.        end  
  1229.        a1=strip(word(oldresu,Nmm))
  1230.        a2=strip(word(aresu,Nmm))
  1231.        if a1=a2  then iterate
  1232.        if a2>a1 then leave  /* new matching element > old matching element, thus new is worse match */
  1233.        useold=0           /* found a matching element in new < then corresponding element in old*/
  1234.        leave            /* thus, new is better match */
  1235.     end
  1236.  
  1237.     IF USEold=0 THEN return aresu
  1238.      return 0           /* non superior match (might be same, in which case old is used*/
  1239.  
  1240.  
  1241.  
  1242.  
  1243. awild_match:procedure
  1244. parse upper arg needle, haystack ; haystack=strip(haystack)
  1245. needle=strip(needle)
  1246.  
  1247. if needle=haystack then return -1        /* -1 signals exact match */
  1248. ast1=pos('*',haystack)
  1249. if ast1=0 then return 0                 /* 0 means no match */
  1250. if haystack='*' then  do
  1251.    if length(needle)=0 then 
  1252.        return 100000
  1253.     else 
  1254.         return length(needle)
  1255. end
  1256. ff=haystack
  1257. ii=0
  1258. do until ff=""
  1259.   ii=ii+1
  1260.   parse var ff hw.ii '*'  ff
  1261.   hw.ii=strip(hw.ii)
  1262. end
  1263. if hw.ii='' then ii=ii-1
  1264. hw.0=ii
  1265.  
  1266.  
  1267. /* check each component of haystackw against needle -- all components
  1268. must be there */
  1269.  
  1270. resu=' '
  1271. istart=1 ; ido=2
  1272. if ast1>1 then do       /* first check abbrev */
  1273.   if abbrev(needle,hw.1)=0 then return 0
  1274.   aresu=length(hw.1)
  1275.   if hw.0=1 then do
  1276.      do nm=1 to aresu
  1277.         resu=resu||' '||nm
  1278.      end /* do */
  1279.      return resu         /* if haystacy of form abc*, we have a match */
  1280.   end
  1281.   ido=2 ; istart=aresu+1
  1282.   do mm=1 to aresu
  1283.         resu=resu||' '||mm
  1284.   end /* do */
  1285. end
  1286. /* if here, then first part (a non wildcard) of haystack matches first
  1287. part of needle
  1288. Now check sequentially that each remaining part also exists
  1289. */
  1290. do mm=ido to hw.0
  1291.   igoo=pos(hw.mm,needle,istart)
  1292.   if igoo=0 then return 0
  1293.   tres=length(hw.mm)
  1294.   istart=igoo+tres
  1295.   do nn=igoo to (istart-1)
  1296.      resu=resu||' '||nn
  1297.   end /* do */
  1298. end
  1299. if istart >= length(needle) | right(haystack,1)='*' then
  1300.    return resu
  1301. return 0
  1302.  
  1303.  
  1304.  
  1305.  
  1306.  
  1307. /* Example of  use of sref_wild_match */
  1308. /* ==================
  1309. a.1='This is *'
  1310. a.2='This is a *'
  1311. a.3='This is a funny * story'
  1312. a.4='* is * '
  1313. a.5='Th* fun*'
  1314. a.6='This is funny *'
  1315.  
  1316. say "Enter string : "
  1317. parse pull ans
  1318. oldresu=''; isit=0
  1319. do mm=1 to 6
  1320.   resu=sref_wild_match(ans,a.mm,oldresu)
  1321.   if resu=-1 then do
  1322.     isit=mm
  1323.     leave
  1324.   end
  1325.   if resu=0 then iterate
  1326.   isit=mm
  1327.   oldresu=resu
  1328. end
  1329. if isit=0 then
  1330.  say " no match "
  1331. else say
  1332.  say " match= "a.isit
  1333. exit
  1334. ===================== */
  1335.