home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / wwwcount.zip / wwwcount.cmd < prev    next >
OS/2 REXX Batch file  |  1997-12-31  |  17KB  |  573 lines
  1. /**********************
  2.   15 Nov 1997. danielh@econ.ag.gov
  3.  
  4.   WWW-Count: A Graphical Counter for OS/2 Web Servers.
  5.  
  6.   See WWWCOUNT.DOC for details on installation and use.
  7.  
  8. Summary:
  9.    WWW-Count can be invoked either as a CGI-BIN script, or as an EXEC server side
  10.    include (assuming your server understands the NCSA HTTPD server side include
  11.    syntax).
  12.  
  13. 1) To use as a cgi-bin script, include URLS of the form:
  14.         <IMG src="/cgi-bin/wwwcount/dirname/file.ext?options">
  15.   THIS MODE REQUIRES  THE RXGDUTIL LIBRARY, from  
  16.   http://www.bearsoft.com/abs/rexxgd.html
  17.  
  18. 2) To use as an EXEC server side include, include SSI elements of the form:
  19.           <!-- #exec CMD=jcount?&options-->
  20.  You can this mode to generate a text counter, or a sequence of IMG elements that link to
  21.  graphical digits.
  22.  
  23. *****************************************************/
  24.  
  25. signal on syntax name anerr ; signal on error name anerr
  26. /*    ---- BEGIN USER CONFIGURABLE PARAMETERS SECTION ----------  
  27.        ---- BEGIN USER CONFIGURABLE PARAMETERS SECTION ----------
  28.  
  29.    WWW-Count is controlled by the options included in the request, and by the
  30.    user configurable parameters set below.  
  31. */
  32.  
  33. /* Fully qualified name of directory in which to store .cnt files. 
  34.    This is used when the CGI-BIN PATH_TRANSLATED variable is unspecified */
  35. counter_dir='\www'
  36.  
  37. /* If you want to ignore PATH_TRANSLATED, and always put .CNT files in
  38. the counter_dir (this may be a security/privacy measure), set no_path_translated=1 */
  39. no_path_translated=0
  40.  
  41. /* Set the RELATIVE directory that contains the "digit images". This
  42.    is used when an EXEC SSI call is used to create a graphics counter.
  43.    REL_COUNTER_IMAGE_DIR is used to form IMG SRC=...   urls to be 
  44.    included in the html document
  45.    Note that each different set of "digits"  should  be in it's own directory.
  46.    under the rel_counter_image_dir. */
  47. rel_counter_image_dir ='/digits'
  48.  
  49. /* Set the FULLY QUALIFIED directory that contains the digit images.
  50.    This is used when an IMG src=... is used to create a graphics counter.*/
  51. abs_counter_image_dir ='\www\digits'
  52.  
  53. /* 1=create a .cnt file if none exists, 0=do not
  54.    if the counter file (passed to counter.rxx) does not exist,
  55.    and create_file=0, counter.rxx will exit without doing anything */
  56. create_file=1
  57.  
  58. /* 1 = do NOT allow line breaks in strings of  "graphical digits". 
  59.    0 = Allow line breaks within the string of "graphical digits"
  60.      Note: if =1, the <NOBR>  element is used -- but note that webex 
  61.             and other html 2.0  browsers ignore <NOBR>.*/
  62. digits_nobr=1
  63.  
  64. /* store info on each request. 0=no, 1=yes. Can be overridded by a LOGUSERS option */
  65. write_users=0
  66.  
  67. /* 1 = Supress the "log users" option (a logusers option will override write_users)
  68.     0= do not suppress  */
  69. suppress_logusers=0
  70.  
  71. /* suppress inrementing if request is from a same client within
  72.    suppress_recent minutes. If 0, or if write_users=0, this is ignored */
  73. suppress_recent=0
  74.  
  75.  
  76. /* END of user-configurable parameters ***********************************/
  77. /* END of user-configurable parameters ***********************************/
  78. /* END of user-configurable parameters ***********************************/
  79.  
  80. /* Load up advanced REXX functions */
  81. foo=rxfuncquery('sysloadfuncs')
  82. if foo=1 then do
  83.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  84.   call SysLoadFuncs
  85. end
  86.  
  87. if counter_dir=0 then counter_dir=' '
  88.  
  89. if no_path_translated<>1 then do
  90.   pinfot=value('PATH_TRANSLATED',,'os2environment')
  91.   if pinfot<>'' then
  92.      counter_dir=pinfot
  93. end
  94.  
  95. if counter_dir=' ' then foo=is_done('Error: no COUNTER_DIR  ') /* is error will exit */
  96. counter_dir=strip(translate(counter_dir,'\','/'),'t','\')||'\'
  97.  
  98. method=value('REQUEST_METHOD',,'os2environment')
  99. optlist=''
  100. if method='GET' then do
  101.     optlist=value('QUERY_STRING',,'os2environment')
  102. end
  103. else do
  104.    len = value("CONTENT_LENGTH",,'os2environment')
  105.    if len<>"" then optlist = charin(,,len)
  106. end
  107. optlist=translate(optlist,' ','+&')
  108. if optlist="" then foo=is_done('Error: no option list ')
  109.  
  110. if write_users<>1 then suppress_recent=0
  111. if datatype(suppress_recent)<>'NUM' then suppress_recent=0
  112.  
  113.  
  114. issilent=0 ; nocommas=0; maxval=21740000 ; ndigits=0 ; minval=0
  115. rollover=0 ; doith=0 ; incit=1 ; dographic=0 ; writesel=' ' ; duration=0
  116. align_type=0 ; suppress_logusers=0; cfile=0 ;workdir=abs_counter_image_dir
  117. frameit=0
  118. is_img=0 ; numval=""
  119. do until optlist=""
  120.   parse var optlist anarg optlist
  121.   if pos('=',anarg)=0 then do
  122.       avar='FILE' ; aval=strip(translate(anarg))
  123.   end
  124.   else do
  125.      parse var anarg avar '=' aval ;                             
  126.      avar=strip(translate(avar)); aval=strip(strip(aval),,'"')
  127.   end
  128.   select
  129.      when abbrev(avar,"FIL")=1 then do
  130.           foo=lastpos('.',aval) 
  131.           if foo=0 then
  132.              cfile=counter_dir||aval
  133.           else
  134.              cfile=counter_dir||delstr(aval,foo)
  135.      end
  136.      when avar="SILENT" then issilent=1
  137.      when abbrev(avar,"NOCOM")=1 then nocommas=1
  138.      when avar="MAX" then
  139.         if datatype(aval)='NUM' then maxval=aval
  140.      when abbrev(avar,"WID")=1 then
  141.         if datatype(aval)='NUM' then ndigits=aval
  142.      when avar="MIN" then
  143.         if datatype(aval)='NUM' then minval=aval
  144.      when avar="ROLLOVER" then rollover=1
  145.  
  146.      when abbrev(avar,"FR")=1 then frameit=1
  147.  
  148.      when abbrev(avar,"DUR")=1 then do
  149.         if datatype(aval)='NUM' then duration=aval
  150.      end
  151.  
  152.      when avar="ITH" then  doith=1
  153.  
  154.      when abbrev(avar,'VAL')=1 then do
  155.            if datatype(strip(aval))='NUM' then numval=strip(aval)
  156.      end /* do */
  157.  
  158.      when avar="IMGALIGN" then align_type=strip(aval)
  159.  
  160.      when avar="LOGUSERS" & suppress_logusers<>1 then do
  161.          select
  162.            when wordpos(translate(aval),'Y YES 1')>0 then write_users = 1
  163.            when wordpos(translate(aval),'N NO 0')>0 then write_users = 0
  164.            otherwise nop
  165.          end
  166.      end
  167.      when abbrev(avar,"GRAPHIC")=1 | abbrev(avar,'DIGIT')=1 | abbrev(avar,'FONT')=1 then do
  168.         select
  169.           when aval=0 then dographic=0
  170.           otherwise do
  171.              dographic=9
  172.              rel_counter_image_dir = strip(rel_counter_image_dir,'t','/')||'/'||strip(aval,,'/')
  173.              abs_counter_image_dir=translate(abs_counter_image_dir,'\','/')||'\'
  174.              aval=strip(translate(aval,'\','/'),,'\')||'\'
  175.              abs_counter_image_dir =abs_counter_image_dir||aval
  176.           end
  177.         end
  178.      end
  179.      when abbrev(avar,'IMG') then is_img=1
  180.  
  181.      when abbrev(avar,"INC")=1 then do
  182.         if datatype(aval)="NUM" then incit=aval
  183.      end
  184.      otherwise nop
  185.    end
  186. end
  187. if dographic>0 then do
  188.    nocommas=0 ;
  189.    doith=0 ;
  190. end
  191.  
  192. if  ndigits>0 then nocommas=1
  193.  
  194. if numval<>'' then do
  195.     ctval=numval
  196.     signal writenow
  197. end /* do */
  198.  
  199.  
  200.  
  201. if cfile=0 then foo=is_done(' Error: no file name given ')
  202.  
  203. if pos('.',cfile)=0 then cfile=cfile||'.cnt'
  204. cfile=translate(cfile,'\','/')
  205.  
  206. /* if create_file=1, then check for existence of cfile, and create
  207. if missing */
  208. if create_file=1 then do
  209.   if stream(cfile,'c','query exists')=' ' then do
  210.      foo=charout(cfile,'0  ',1)
  211.      if foo>0 then fo=is_done(" Error creating counter file: " cfile)
  212.      foo=stream(cfile,'c','close')
  213.   end
  214. end
  215.  
  216. /* read it in */
  217. crlf = '0d0a'x
  218. ause=open_read(cfile,30,'BOTH')
  219. if ause<0 then fo=is_done(" Error opening counter file: " cfile)
  220.  
  221. lily=chars(cfile)
  222. ause=strip(charin(cfile,1,lily),'t','1a'x)
  223.  
  224. /* got a file, let's parse it */
  225. filelins.0=0
  226. iz=0
  227. do until ause=""
  228.       parse  var ause eeo (crlf) ause
  229.      iz=iz+1
  230.      filelins.iz=strip(eeo)
  231. end
  232. if iz=0 then do
  233.    iz=1
  234.    filelins.1=0
  235. end
  236. filelins.0=iz
  237. opstat=iz
  238.  
  239.  
  240. /* find count */
  241. ctval=0
  242. do ip=1 to opstat
  243.   aline0=translate(filelins.ip,' ','00090d0a'x)
  244.   select
  245.      when aline0=' ' then iterate
  246.      when  abbrev(aline0,';') then iterate
  247.      when datatype(aline0)='NUM' then do
  248.           ctval0=aline0
  249.           ctval=ctval0+INCIT
  250.           CTVAL=Max(CTVAL,MINVAL) ;
  251.           IF ROLLOVER=1 & CTVAL>MAXVAL THEN CTVAL=MINVAL
  252.           CTVAL=Min(CTVAL,MAXVAL)
  253.           ct_line=ip
  254.           leave
  255.      end
  256.      otherwise iterate
  257.    end
  258. end
  259. if ctval=0 then do
  260.      ctval=minval+incit
  261.      ctval0=ctval
  262.      itmp=filelins.0+1
  263.      filelins.0=itmp
  264.      ct_line=itmp
  265. end
  266.  
  267. numeric digits 12
  268. d1=date('b')
  269. t1=time('m')/(24*60)
  270. nowtime=d1+t1
  271. anaddr=value('REMOTE_ADDR',,'os2environment')
  272. nowrite=0
  273.  
  274.  
  275. /* no augment? */
  276. if noaugment=1 then do
  277.   nowrite=1 ; write_users=0
  278.   ctval=ctval0
  279. end
  280.  
  281.  
  282. /* if suppress_recent, check before incrementing */
  283. if suppress_recent>0 & write_users=1 then do
  284.   chktime=nowtime-(suppress_recent/(24*60))
  285.   do iy=filelins.0 to ct_line+1 by -1
  286.      aline00=filelins.iy
  287.      if aline00=' ' then iterate
  288.      if abbrev(aline00,';') then iterate
  289.      parse var aline00 anip  ajulian  .
  290.      ajulian=strip(ajulian)
  291.      if datatype(ajulian)<>"NUM" then iterate
  292.      if ajulian < chktime then leave
  293.      if strip(anip)=anaddr then do
  294.          nowrite=1 ; ctval=ctval0; leave
  295.      end
  296.   end
  297. end
  298. if incit=0 then nowrite=1   /* increment=0 is a "no augment" signal */
  299.  
  300. filelins.ct_line=ctval          /* record "augmented?" count */
  301.  
  302. /* if "duration" is <> 0, then check entries (this is used to report
  303. "hits in last week" */
  304.  
  305. if duration>0  then do
  306.   if write_users<>1 then do
  307.       ctval="000"
  308.    end
  309.    else do
  310.      ctval=0
  311.      chkdate=trunc(1+nowtime-duration)
  312.      do iy=filelins.0 to ct_line+1 by -1
  313.          aline00=filelins.iy
  314.          if aline00=' ' then iterate
  315.          if abbrev(aline00,';') then iterate
  316.          parse var aline00 anip ',' ajulian ',' poop
  317.          ajulian=trunc(strip(ajulian))
  318.          if datatype(ajulian)<>"NUM" then iterate
  319.          if ajulian < chkdate then leave
  320.          ctval=ctval+1
  321.       end
  322.   end   /* write_users */
  323. end  /* duration>0 */
  324.  
  325. if write_users>0 then do
  326.    d1=space(strip(date('n')));
  327.       parse var d1 d1a d1b d1c
  328.       if d1a<10 then d1a='0'||d1a
  329.       d1=d1a||'/'||d1b||'/'||d1c
  330.    t1=time('n')
  331.    d1t1=d1||':'||t1
  332.    aline=anaddr||'  '||nowtime||' ['||d1t1||']'
  333.    if write_users=1 then do
  334.       ll=filelins.0+1
  335.       filelins.ll=aline
  336.       filelins.0=ll
  337.    end  /* Do */
  338. end
  339.  
  340. /* write out stuff */ 
  341.  
  342. if nowrite=0 then do
  343.   stuff=filelins.1
  344.   do mm=2 to filelins.0
  345.      stuff=stuff||crlf||filelins.mm
  346.   end
  347.   stuff=stuff||'             '
  348.   wow=charout(cfile,stuff,1)
  349.   if wow>0 & verbose>0 then say " Warning: problem writing .CNT file: " wow
  350. end
  351. foo=stream(cfile,'c','close')
  352.  
  353. if issilent=1 then fo=is_done(' ')   /* just record, do not display */
  354.  
  355. writenow: nop            /* skip here if numval specified */
  356.  
  357. /* format ctval */
  358. ctval=strip(ctval)
  359. ctlen=length(ctval)
  360.  
  361. if ndigits>0 then do
  362.     if ctlen<ndigits then do
  363.         ctval=copies('0',ndigits-ctlen)||ctval
  364.     end
  365. end
  366.  
  367. if nocommas=0 then do
  368.   il=length(ctval)
  369.   if il>3 then do
  370.       oop=""
  371.       do mm=il to 3 by -3
  372.          tt=substr(ctval,mm-2,3)
  373.          if mm=il then
  374.             oop=tt
  375.          else
  376.             oop=tt||','||oop
  377.       end /* do */
  378.       if mm<>0 then oop=substr(ctval,1,mm)||','||oop
  379.       ctval=oop
  380.   end
  381. end
  382.  
  383. if doith=1 then do
  384.   lval2=right(strip(ctval),2)
  385.   if lval2>10 & lval2<20 then
  386.         ctval=ctval||'th'
  387.   else do
  388.      lval=right(strip(ctval),1)
  389.      select
  390.        when lval=0 then  ctval=ctval||'th'
  391.        when lval=1 then ctval=ctval||'st'
  392.        when lval=2 then ctval=ctval||'nd'
  393.        when lval=3 then ctval=ctval||'rd'
  394.        otherwise ctval=ctval||'th'
  395.      end
  396.   end
  397. end
  398.  
  399. if dographic=0 then fo=is_done(ctval)
  400.  
  401. /*  Ship image tags to the browser ?    */
  402.  
  403. if dographic=9 then do
  404.  
  405.  
  406.    minlen = 5
  407.    totalreads = ctval
  408.    len = Length(totalreads)
  409.    if ndigits > 0 then minlen = ndigits
  410.    if len < minLen Then len = minlen
  411.    formattedcount = right(totalreads, len, '0')
  412.    if is_img=1 then do                  /*make_image will EXIT */
  413.        foo=make_image(abs_counter_image_dir,formattedcount,len,workdir)
  414.    end  /* Do */
  415.    todo=''              /* else, it's an ssi */
  416.    if digits_nobr=1 then todo='<NOBR>'
  417.    if align_type="CENTER"  then align_type='MIDDLE'
  418.    if wordpos(translate(align_type),"TOP BOTTOM MIDDLE")=0 then align_type='MIDDLE'
  419.  
  420.    if frameit=1 then 
  421.         todo=todo||'<img src="'rel_counter_image_dir'/l.gif" alt="|" align="'align_type'">'
  422.    do x = 1 to len
  423.       digit = substr(formattedCount,x,1)
  424.       if datatype(digit)='NUM' then 
  425.         todo=todo||'<img src="'rel_counter_image_dir'/'digit'.gif" alt="'digit'" align="'align_type'">'
  426.    end
  427.    if frameit=1 then 
  428.         todo=todo||'<img src="'rel_counter_image_dir'/r.gif" alt="|" align="'align_type'">'
  429.  
  430.    if digits_Nobr=1 then todo=todo||' </nobr>'
  431.    fo=is_done(todo)
  432. end
  433.  
  434. /******/
  435. is_done:procedure
  436. parse arg aval
  437. say aval
  438. exit 0
  439.  
  440.  
  441. /* ----------------------------------------------------------------------- */
  442. /* OPEN_READ: keep trying to open a file (for msec seconds
  443. . Argumentes:
  444.         afile == file to open
  445.         msec == quit trying after msec seconds
  446.         howopen = open mode (READ WRITE BOTH READ ) -- default is READ
  447.   Returns
  448.     Status, with values
  449.         -1 = no such file
  450.         -2 = error opening (say, NEW specified but file exists), or timeout
  451.         >0 = seconds it took to open
  452. */
  453. /* ----------------------------------------------------------------------- */
  454.  
  455. open_read:procedure
  456. parse upper arg afile , msec , howopen .
  457. debug=0
  458.  
  459. howopen=translate(howopen)
  460.  
  461. if afile=0 | afile="" then do
  462.    if debug=1 then   say "OPEN_READ: No file name provided "
  463.    return -1             /*no such file flat */
  464. end
  465.  
  466. /* DISALLOW wildcarded files (they cause trouble below */
  467. if pos('*',afile)>0 | pos('?',afile)>0 then do
  468.     if debug=1 then  say "OPEN_READ: No wildcards allowed "
  469.     return -1
  470. end
  471.  
  472. isfile=stream(afile,'c','query exists') ;
  473. if howopen="NEW"  then do
  474.     if isfile="" then
  475.         isfile=afile
  476.     else do
  477.         if debug=1 then  say "OPEN_READ: NEW file already exists "
  478.        return -1
  479.     end  /* Do */
  480. end
  481. else do
  482.    if isfile=""  then do
  483.        if debug=1 then  say 'OPEN_READ: Could not find ' afile
  484.       return -1             /*no such file */
  485.    end 
  486. end
  487.  
  488. sec1=time('RESET')
  489. foy=time('ELAPSED')
  490.  
  491. do until time('ELAPSED') > msec
  492.     select
  493.     when howopen='BOTH' then
  494.        inuse=stream(isfile,'c','open')
  495.     when howopen='WRITE'| howopen="NEW" then do
  496.          inuse=stream(isfile,'c','open write')
  497.     end
  498.     otherwise do
  499.         inuse=stream(isfile,'c','open read')
  500.     end
  501.     end
  502.     if inuse<>'READY:' then do
  503.         foo=syssleep(1)                  /* wait a second, and try again */
  504.         iterate
  505.       end
  506. /* Else, it's openable */
  507.     gog=time('ELAPSED')
  508.     return gog+0.01
  509. end
  510.  if debug=1 then  say " OPEN_READ: no time "
  511. return -2                /* could not open in alloted time */
  512.  
  513.  
  514. /*****************/
  515. /* create img/gif for return to IMG SRC=...  url */
  516. make_image:procedure
  517.  
  518. parse arg cdir,ict,len,workdir
  519. foo=rxfuncquery('rxgdloadfuncs')
  520. if foo=1 then do
  521.   Call RxFuncAdd 'RxgdLoadFuncs', 'RXGDUTIL', 'RxgdLoadFuncs'
  522.   Call RxgdLoadFuncs
  523. end
  524. ii=rxfuncquery('rxgdimagecreate')
  525. if ii<>0 then fo=is_done(' Error: RXGDUTIL not available')
  526.  
  527. nx=0; ny=0 ; igot=0
  528. do x = 1 to len
  529.    digit = substr(ict,x,1)
  530.    afile=cdir||digit||'.gif'
  531.  
  532.    if stream(afile,'c','query exists')=' ' then iterate
  533.  
  534.    im=rxgdimagecreatefromgif(afile)
  535.  
  536.    if im=1 | im=0 then iterate
  537.    igot=igot+1
  538.    imlist.igot=im 
  539.    imlist.igot.!x=rxgdimagesx(im)
  540.    nx=nx+imlist.igot.!x
  541.    imlist.igot.!y=rxgdimagesy(im)
  542.    ny=max(ny,imlist.igot.!y)
  543. end
  544. /* ready to append */
  545. if igot=0 then fo=is_done(' Error: no digits found ')
  546. im2=rxgdimagecreate(nx,ny)
  547. xat=0
  548. do mm=1 to igot
  549.     im1=imlist.mm
  550.     xs=imlist.mm.!x ; ys=imlist.mm.!y
  551.     foo=rxgdimagecopy(im2,im1,xat,0,0,0,xs,ys)
  552.     xat=xat+xs
  553.     oo=rxgdimagedestroy(im1)
  554. end /* do */
  555.  
  556. gfile=systempfilename(strip(translate(workdir,'\','/'),'t','\')||'\TMP?????.GIF')
  557.  
  558. foo=rxgdimagegif(im2,gfile)
  559. oo=rxgdimagedestroy(im2)
  560. arf=charin(gfile,1,chars(gfile))
  561. a=stream(gfile,'c','close')
  562. a=sysfiledelete(gfile)
  563.  
  564. crlf='0d0a'x
  565. arf='Content-type:image/gif'||crlf||'Content-length:'||length(arf)||crlf||crlf||arf
  566. call charout,arf
  567. exit 0
  568.  
  569.  
  570. anerr:
  571. say " error at " sigl
  572. exit 0
  573.