**********************************************************************************************
      * DBG006R4  Rebuild keyword index for selected document
      * Copyright (C) 2000  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
      **********************************************************************************************
     FDBGDFTD1  IF   E           K DISK
     FDBGDFTH1  IF   E           K DISK
     FDBGDFTK1  UF A E           K DISK
      **********************************************************************************************
      *  Output text 50 lines of upto 132 characters
     D P#Out           S            132    DIM(50)
     D Ignore          S             10    DIM(50) CTDATA PERRCD(10)
      **********************************************************************************************
      *  DATA STRUCTURES
      **********************************************************************************************
     D #wordno         S              3  0
      *
     D Attrib          C                   CONST(X'202122232425262728292A2B2C2D-
     D                                     2E2F303132333435363738393A3B3C3D3E')
     D Blank           C                   CONST('                            ')
     D DoneTitle       S              1
     D Lower           C                   CONST('abcdefghijklmnopqrstuvwxyz')
     D Normal          C                   CONST(X'4040404040404040404040404040-
     D                                     4040404040404040404040404040404040')
     D Other           C                   CONST('!"£%&*()-_=+@''?;:.,#|<>/{}[]-
     D                                     ')
      *  Input data in chunks of entry length
     D P#In            S            132
     D P#RtnEnt        S              3  0
     D String          S             79
     D String2         S             79
     D Upper           C                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
      **********************************************************************************************
      *  ENTRY PARAMETERS
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    DFDOCD
      **********************************************************************************************
     C     IDXKEY        KLIST
     C                   KFLD                    DFDOCD
     C                   KFLD                    DFWORD
      **********************************************************************************************
      * MAINLINE PROGRAM
      **********************************************************************************************
      *  Delete records for this document
B001 C                   DOU       *IN80
     C     DFDOCD        DELETE    DB1DFTK1                           80
E001 C                   ENDDO
      *  Read all text entries for this document
     C     DFDOCD        CHAIN     DBGDFTD1                           80
B001 C                   DOW       *IN80 = *off
      *  Convert to uppercase
     C     Lower:Upper   XLATE     DFTEXT        String
      *  Strip out display attributes
     C     Attrib:Normal XLATE     String        String2
      *  and punctuation, etc.
     C     Other:Blank   XLATE     String2       P#In
      *  Parse the sentence into separate words
     C                   CALL      'DBG041R4'
     C                   PARM                    P#In
     C                   PARM      0             P#RtnEnt
     C                   PARM                    P#Out
      *  Process each of the returned words
B002 C     1             DO        P#RtnEnt      #wordno
     C                   EVAL      DFWORD = P#Out(#wordno)
      *  Ignore words in the ignore list (see compile time data at end of code)
     C     DFWORD        LOOKUP    Ignore                                 70
      *  If not to be ignored
B003 C                   IF        *IN70 = *off
      *  Check if this document/word pair exists already
     C     IDXKEY        CHAIN     DBGDFTK1                           81
      *  and write it if it doesn't
B004 C                   IF        *IN81 = *on
     C                   WRITE     DB1DFTK1
E004 C                   ENDIF
E003 C                   ENDIF
E002 C                   ENDDO
      *  Next text record
     C     DFDOCD        READE     DBGDFTD1                               80
      *  If no more text records, index the title
B002 C                   IF        *IN80 AND DoneTitle = *off
     C                   EVAL      DoneTitle = *on
     C     DFDOCD        CHAIN     DBGDFTH1                           80
B003 C                   IF        *IN80 = *off
     C                   EVAL      DFTEXT = DFDOCH
E003 C                   ENDIF
E002 C                   ENDIF
E001 C                   ENDDO
     C                   EVAL      *INLR = *on
     C                   RETURN
      **********************************************************************************************
** Five lines of 'words' to be ignored
          A         AND       AS        ARE       I         IF        THE       OR        B
C         D         E         TO        ON        NOT       IS        IN        THIS      FOR
OF        HAS       P         BE        FROM      BUT       HAVE      WHEN      WITH      WILL
THAT      WAS       NO        S         AT        SO        AN        NOW       THERE     ON



This topic: DBG400 > SourceCodeList > RpgleSource > RpgleDBG006R4
Topic revision: r1 - 26 May 2005 - 19:05:07 - MartinRowe
 
This site is powered by FoswikiCopyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback