home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / alt / sources / 2903 / rn100src.exe / RNINDEX.PRG < prev   
Encoding:
Text File  |  1992-12-16  |  7.5 KB  |  298 lines
  1. #include "rn.ch"
  2. #include "inkey.ch"
  3. #include "fileio.ch"
  4.  
  5.  
  6. ? "RNindex version 1.0"
  7. ?
  8.  
  9. if ! empty(gete("WAFFLE"))
  10.    WafDir(strtran(upper(gete("WAFFLE")), "\STATIC"))
  11. else
  12.    ask(" Error ", "Environment variable WAFFLE not set", {" OK "}, CLR_ERR)
  13.    quit
  14. endif
  15.  
  16. ReadJoin()
  17.  
  18. ?
  19. ? "Finished!"
  20.  
  21. RETURN
  22.  
  23.  
  24. PROCEDURE ReadJoin()     // read join file
  25.       LOCAL nChoice                         // selected newsgroup
  26.       LOCAL cPath                           // path of newsgroup
  27.       LOCAL aDir := {}                      // contains dir entries
  28.       LOCAL nNgPtr := 1                     // initial pos in ng array
  29.       LOCAl aHdr
  30.       LOCAL cSavDir                         // hold current dir
  31.       LOCAL n
  32.       LOCAL f
  33.       LOCAl aGroups := NwsGrData()
  34.       LOCAL aMsg := {}
  35.  
  36.       ? "Indexing "
  37.  
  38.       for nChoice := 1 to len(aGroups)
  39.          nNgPtr := aGroups[nChoice,4]
  40.  
  41.          ?? token(alltrim(aGroups[nChoice,1])," ",1) + ", "
  42.  
  43.          cPath := NwsGrPath(token(ltrim(aGroups[nChoice,1])," ",1))
  44.  
  45.          if isdir(cPath)  // goto newsgroup's dir
  46.  
  47.             asize(aDir, adir(cPath + "\*.*"))
  48.             adir(cPath + "\*.*", aDir)
  49.  
  50.  
  51.             // Read header info into array
  52.  
  53.             aMsg := {}
  54.  
  55.  
  56.             for n := 1 to len( aDir )
  57.  
  58.                if aDir[n] != "INDEX.RN"
  59.  
  60.                   aHdr := ReadHeader(cPath + "\" + aDir[n])
  61.  
  62.  
  63.                   aadd(aMsg, { aDir[n], aHdr[MSG_SUBJ], aHdr[MSG_FROM], ;
  64.                                  aHdr[MSG_MSGID], aHdr[MSG_DATE] })
  65.  
  66.                endif
  67.             next
  68.  
  69.             if len(aMsg) > 0
  70.                asort(aMsg,,,{|x, y | ;
  71.                strtran(lower(trim(x[2])), "re: ") + SortableDate(x[5]) ;
  72.                < strtran(lower(trim(y[2])), "re: ") + SortableDate(y[5]) })
  73.  
  74.                f = fcreate( cPath + "\" + "index.rn" )
  75.  
  76.                for n := 1 to len(aMsg)
  77.                   fwriteline( f, aMsg[n, 1] + chr(K_TAB) +;
  78.                         aMsg[n, 2] + chr(K_TAB) + ;
  79.                         aMsg[n, 3] + chr(K_TAB) + ;
  80.                         aMsg[n, 4] + chr(K_TAB) + ;
  81.                         aMsg[n, 5] ;
  82.                      )
  83.                next
  84.  
  85.                fclose( f )
  86.             endif
  87.          endif
  88.  
  89.       next
  90.  
  91. RETURN
  92.  
  93.  
  94.  
  95. FUNCTION ReadHeader(cFile)    // read header and return as array
  96.    LOCAL cLine
  97.    LOCAL nMsg
  98.    LOCAL aHeader := {cFile}
  99.    LOCAL n := 0
  100.    LOCAL cBuf := space(1024)
  101.  
  102.    asize(aHeader,11)           // make an array
  103.    afill(aHeader,"",2)          // and initialize with spaces
  104.  
  105.    nMsg = fopen(cFile, FO_READ)
  106.    fread(nMsg, cBuf, len(cBuf))
  107.    fclose(nMsg)
  108.  
  109.    cBuf := strtran(cBuf, chr(9), space(4))
  110.  
  111.    aHeader[MSG_SUBJ]    := GetLine("subject:", cBuf)
  112.    aHeader[MSG_FROM]    := GetLine("from:", cBuf)
  113.    aHeader[MSG_PATH]    := GetLine("path:", cBuf)
  114.    aHeader[MSG_LINE]    := GetLine("lines:", cBuf)
  115.    aHeader[MSG_MSGID]   := GetLine("message-id:", cBuf)
  116.    aHeader[MSG_NWSG]    := GetLine("newsgroups:", cBuf)
  117.    aHeader[MSG_DATE]    := GetLine("date:", cBuf)
  118.    aHeader[MSG_ORG]     := GetLine("organization:", cBuf)
  119.    aHeader[MSG_FUT]     := GetLine("followup-to:", cBuf)
  120.    aHeader[MSG_REF]     := GetLine("references:", cBuf)
  121.  
  122. RETURN(aHeader)
  123.  
  124.  
  125. FUNCTION GetLine(cSrch, cBuf)
  126.    LOCAL cStr := ""
  127.    LOCAl nPos
  128.  
  129.    if (nPos := at(lower(cSrch), lower(cBuf))) > 0
  130.       cStr := substr(substr(cBuf, nPos, at(CR_LF, substr(cBuf, nPos))-1), len(cSrch)+1)
  131.    endif
  132. RETURN cStr
  133.  
  134.  
  135. FUNCTION NwsGrData
  136.    STATIC aGroups := {}             // array for groups
  137.    LOCAL cLine
  138.    LOCAL nUsenet
  139.    LOCAl cNwsgr
  140.  
  141.    if len(aGroups) < 1
  142.  
  143.       ? "Retrieving newsgroups information"
  144.  
  145.       if (nUsenet := fopen(WafDir() + "\usenet")) # -1
  146.          while ! feof(nUsenet)
  147.  
  148.             cNwsgr := alltrim(token(freadline( nUsenet ), " ", 1))
  149.  
  150.             if left(cNwsgr, 1) # "#" .and. ! empty(cNwsgr) .and. at("default", lower(cNwsgr)) # 1
  151.                aadd(aGroups, {cNwsgr,{},0,0 })
  152.             endif
  153.          enddo
  154.       endif
  155.  
  156.       fclose(nUsenet )
  157.       ?
  158.    endif
  159.  
  160.  
  161. RETURN (aGroups)
  162.  
  163.  
  164. FUNCTION NwsGrPath(cNwsGrp)
  165.    LOCAL cPath := ""
  166.    LOCAL n
  167.    LOCAL fHandle
  168.    LOCAL c
  169.    LOCAL nPos
  170.    STATIC aPath
  171.  
  172.    if aPath == NIL
  173.       aPath := {}
  174.    endif
  175.  
  176.    nPos := ascan(aPath, {|x| x[1] == cNwsGrp } )
  177.  
  178.    if nPos > 0
  179.       cPath := aPath[nPos, 2]
  180.    else
  181.       fHandle := fopen ( WafDir() + "\usenet", FO_READ + FO_DENYWRITE)
  182.       while ! feof( fHandle )
  183.          c := freadline( fHandle )
  184.          if left(c, 1) # "#"
  185.             if token(c," ",1) == cNwsGrp
  186.                if "/dir=" $ lower(c)
  187.                   nPos := at("/dir=", lower(c)) + 5
  188.                   cPath := token(substr(c, nPos), " ", 1)
  189.                   aadd(aPath, {cNwsGrp, cPath})
  190.                   exit
  191.                else
  192.                   cPath := NewsDir()
  193.                   for n := 1 to numtoken(trim(cNwsGrp), ".")
  194.                      cPath += "\" + left(token(trim(cNwsGrp),".", n),8)
  195.                   next
  196.                   if right(cPath,1) == "\"
  197.                      cPath = substr(cPath, 1, len(cPath)-1)
  198.                   endif
  199.                   aadd(aPath, {cNwsGrp, cPath})
  200.                   exit
  201.                endif
  202.             endif
  203.          endif
  204.       enddo
  205.       fClose ( fHandle )
  206.    endif
  207.  
  208. RETURN(cPath)
  209.  
  210.  
  211. FUNCTION NewsDir()     // function to make the NEWS dir 'PUBLIC'
  212.    STATIC cNewsDir
  213.    LOCAL nUsenet
  214.    LOCAL cLine := ""
  215.  
  216.    if cNewsDir == NIL
  217.       nUsenet := fopen(WafDir()+"\usenet")
  218.  
  219.       while  ! feof(nUsenet)  ;
  220.              .and. ! ("default /dir=" $ (cLine := lower(freadline(nUsenet))))
  221.       enddo
  222.  
  223.       fclose(nUsenet)
  224.  
  225.       if "default /dir=" $ cLine
  226.          cNewsDir := ltrim(strtran(strtran(cLine, "default /dir="),'"'))
  227.       else
  228.          ask(" Error ", " 'DEFAULT /dir='-line not found in  " + WafDir() + "\usenet", { "OK" }, CLR_ERR)
  229.          QUIT
  230.       endif
  231.  
  232.    endif
  233. RETURN (cNewsDir)
  234.  
  235.  
  236.  
  237. FUNCTION WafDir (cWaffle)     // function to make the WAFFLE dir 'PUBLIC'
  238.    STATIC cWafDir
  239.    if cWaffle != NIL
  240.       cWafDir := cWaffle
  241.    endif
  242. RETURN (cWafDir)
  243.  
  244. FUNCTION GetStatic(c)
  245.    LOCAL cRet := ""
  246.    LOCAL nStatic 
  247.    LOCAL cLine := ""
  248.    STATIC aStatic := {}
  249.    LOCAL nPos
  250.  
  251.    if (nStatic := fopen(WafDir() + "\static")) == -1
  252.       ask("Error", "Error opening file " + WafDir() + "\static", {" OK "}, CLR_ERR)
  253.       QUIT
  254.    endif
  255.  
  256.    c:= lower(c)
  257.  
  258.    if (nPos := ascan(aStatic, {|x|x[1] == c})) > 0
  259.       cRet := aStatic[nPos, 2]
  260.    else
  261.       while ! feof(nStatic)
  262.          cLine := lower(freadline(nStatic))
  263.          if substr(cLine,1,len(c)) == c
  264.             EXIT
  265.          endif
  266.       enddo
  267.  
  268.       fclose(nStatic)
  269.  
  270.       if substr(cLine,1,len(c)) == c
  271.          cRet := ltrim(strtran(substr(cLine, at(":",cLine)+1),"/","\"))
  272.          aadd(aStatic, {c, cRet})
  273.       else
  274.          ask(" Error ", "'" +c + "'-line not found in  " + WafDir() + "\static", { " OK " }, CLR_ERR)
  275.          QUIT
  276.       endif
  277.    endif
  278.  
  279.    fclose(nStatic)
  280.  
  281. RETURN cRet
  282.  
  283. FUNCTION SortableDate ( cDate )
  284.    LOCAL cRet
  285.  
  286.    if ! "," $ token(cDate, " ", 1)
  287.       cDate := "# " + cDate
  288.    endif
  289.  
  290.    cRet := if(len(token(cDate, " ", 4)) == 2, "19" + token(cDate, " ", 4), token(cDate, " ", 4) ) + ;
  291.            strzero(ascan({ "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", ;
  292.                      "Sep", "Oct", "Nov", "Dec"}, left(token(cDate, " ", 3), 3)), 2) + ;
  293.            strzero(val(token(cDate, " ", 2)), 2) + ;
  294.            strtran(token(cDate, " ", 5), ":")
  295.  
  296. RETURN ( cRet )
  297.  
  298.