From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 16-OCT-1989 19:33
To:	MRGATE::"ARISIA::EVERHART"
Subj:	LIBSEARCH SEARCH for VMS libraries 3/7

Message-Id:  <8910161907.AA00929@crdgw1.ge.com>
Received: From NSFNET-RELAY.AC.UK by CRVAX.SRI.COM with TCP; Mon, 16 OCT 89 11:32:09 PDT
Received: from ncdlab.ulcc.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
           id aa10644; 16 Oct 89 17:15 BST
Date:           Mon, 16 Oct 89  17:22 BST
From: "Kevin Ashley - ULCC Networks Development." <KEVIN%ncdlab.ulcc.ac.uk@NSFnet-Relay.AC.UK>
To: INFO-VAX <@NSFnet-Relay.AC.UK:INFO-VAX@crvax.sri.com>
Subject:        LIBSEARCH SEARCH for VMS libraries 3/7

-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X`009`009Status = Cli$Get_Value('MODULES',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Modquals(Nfiles) = Temp(1:Tlen)
X`009`009Modqlen(Nfiles) = Tlen
X`009     Else If(.Not.GlobalMod) Then
X`009`009Modquals(Nfiles) = '*'
X`009`009Modqlen(Nfiles) = 1
X`009     Endif`009`009`009!test for /MODULE
X*
X*`009Look for /HELP,/TEXT,/MACRO
X*
X`009     Call PrslibTyp(.False.,Temp)
X`009     If(Temp(1:3) .ne. ' ') Deftyps(Nfiles) = Temp(1:3)
X*
X*`009Look for local /MEXCLUDE
X*
X`009     Call PrsMExcl(.False.,Temp,Tlen)
X`009     If(Tlen .ne. 0) Then
X`009`009Modexcl(Nfiles) = Temp(1:Tlen)
X`009`009LModexcl(Nfiles) = Tlen
X`009     Endif
X
X`009   Else
X`009    Call Lib$Signal(LIBSEARCH_TOOMNYFIL,%val(1),%Val(Maxfiles))
X`009   Endif
X
X`009  Enddo
X*
X*`009Now we have all the names, start parsing the first one.
X*
X`009Endif
X
X*
X*`009Get next matching name
X*
X20`009Tlen = Fnamlen(Cfile)
X`009Status = Lib$Find_File(Filnams(Cfile)(1:Tlen),
X     $                         Current_File,Context,
X     $                         '.'//Deftyps(Cfile),,Stv,2)
X`009If(Status) Then
X`009`009Call Str$Trim(File,Current_File,Cfilnaml)
X`009`009Flen = Cfilnaml
X`009`009Cmodqual = Modquals(Cfile)
X`009`009Cmodqlen = Modqlen(Cfile)
X*
X*`009If any excludes have been set, check them.
X*
X*`009`009If(Nexcl .ne. 0) Then
X*`009`009  If(Excludeit(File(1:Flen),Excluded,Lexcl,Nexcl)) Goto 20
X*`009`009Endif
X
X*
X*`009If /BEFORE or /SINCE has been used, and they are to apply to
X*`009files, check this file for exclusion.
X*
X`009`009If((Before .or. Since) .and.`032
X     $                 (Time_Type .ne. Module_Time)) Then
X`009`009  If(Bad_Timing(File(1:Flen))) Goto 20
X`009`009Endif
X*
X*`009If /CONFIRM, check to see if they want this file.
X*
X`009`009If(Confirm) Then
X`009`009   If(.Not. Confirmed(File(1:Flen),.True.)) Goto 20
X`009`009Endif
X`009`009Return
X*
X*`009If file not found, see if we have any more file specs
X*
X`009Else If(Status .eq. %Loc(Rms$_NMF)) Then
X`009`009Cfile = Cfile + 1
X`009`009If(Cfile .le. Nfiles) Goto 20
X*
X*`009No, so say there is nothing left.
X*
X`009`009Flen = 0
X`009`009File = ' '
X`009`009Return
X`009Else
X*
X*`009If here, there is some problem parsing the filespec
X*`009Signal a warning, and move to the next
X*
X`009`009Call Lib$Signal(LIBSEARCH_OPENIN,%Val(1),
X     $                             Filnams(Cfile)(1:Tlen),
X     $                             %Val(Status),%Val(Stv))
X`009`009Goto 20
X`009Endif
X`009End
X
X`009Subroutine PrsLibTyp(GlobalType,Typstr)
X*
X*`009Check for qualifiers of the /Macro type, return a text string.
X*`009Globaltype is true if we are looking for global qualifiers
X*
X`009Implicit None
X
X`009Integer Status,Cli$Present,Status1
X`009External Cli$_Absent,Cli$_Present,Cli$_LocPres
X`009Integer I,Type
X`009Logical Globaltype
X`009Character*3 Typstr,Types(3)
X`009Data Types/'MLB','HLB','TLB'/
X*
X*`009Look for /HELP,/TEXT,/MACRO
X*
X`009Type = 0
X`009Typstr = ' '
X
X`009If(Globaltype) Then
X`009`009Status1 = %Loc(Cli$_Present)
X`009`009Type = 2`009`009!Default /HELP globally
X`009Else
X`009`009Status1 = %Loc(Cli$_LocPres)
X`009Endif
X
X`009Status = Cli$Present('MACRO')
X`009If(Status.eq.Status1) Then
X`009`009Type = 1
X`009Else
X`009 Status = Cli$Present('HELP')
X`009 If(Status.eq.Status1) Then
X`009`009Type = 2
X`009 Else
X`009   Status = Cli$Present('TEXT')
X`009   If(Status.eq.Status1) Then
X`009`009Type = 3
X`009   Endif
X`009 Endif
X`009Endif
X
X`009If(Type .ne. 0) Typstr = Types(Type)
X`009Return
X`009End
X
X`009Subroutine PrsExcl(Excluded,Lexcl,Nexcl,Maxfiles)
X*
X*`009Check for /EXCLUDE files
X*
X`009Implicit None
X`009Integer Maxfiles,Nexcl
X`009Integer Lexcl(Maxfiles)
X`009Character*(*) Excluded(Maxfiles)
X
X`009Integer Status,Cli$Present,Cli$Get_Value
X`009External Cli$_Absent,Cli$_Present
X`009External LIBSEARCH_TOOMNYEXC
X`009Character*160 Name
X`009Integer Lnam
X
X`009Status = Cli$Present('EXCLUDE')
X`009Nexcl = 0
X`009If(Status .ne. %Loc(Cli$_Present)) Return
X
X`009Status = Cli$Get_Value('EXCLUDE',Name,Lnam)
X
X`009Do While (Status)
X`009  If(Nexcl .eq. Maxfiles) Then
X`009`009Call Lib$Signal(LIBSEARCH_TOOMNYEXC,%Val(1),Maxfiles)
X`009`009Return
X`009  Endif
X`009  Nexcl = Nexcl + 1
X`009  Excluded(Nexcl) = Name(1:Lnam)
X`009  Lexcl(Nexcl)    = Lnam
X`009  Status = Cli$Get_Value('EXCLUDE',Name,Lnam)
X`009Enddo
X
X`009If(Nexcl .eq. 0 .or. Status .ne. %Loc(Cli$_Absent)) Then
X`009  Call Stchek(Status)
X`009Endif
X
X`009Return
X`009End
X
X`009Subroutine PrsMExcl(GlobalType,Name,Lnam)
X*
X*`009Check for /MEXCLUDE modules
X*`009Globaltype is true if we are looking for global qualifiers
X*
X`009Implicit None
X
X`009Character*(*) Name
X`009Logical Globaltype
X`009Integer Lnam
X
X`009Integer Status,Cli$Present,Status1,Cli$Get_Value
X`009External Cli$_Absent,Cli$_Present,Cli$_LocPres
X`009Integer I,Type
X
X`009If(Globaltype) Then
X`009`009Status1 = %Loc(Cli$_Present)
X`009Else
X`009`009Status1 = %Loc(Cli$_LocPres)
X`009Endif
X
X`009Status = Cli$Present('MEXCLUDE')
X
X`009If(Status.eq.Status1) Then
X`009  Status = Cli$Get_Value('MEXCLUDE',Name,Lnam)
X`009  Call Stchek(Status)
X`009Else
X`009  Name = ' '
X`009  Lnam = 0
X`009Endif
X
X`009Return
X`009End
X
X`009Logical Function Confirmed(Name,Type)
X*
X*`009Called to ask a user to confirm a search for a module or a file.
X*`009Type is TRUE for files. Accept YES,NO,TRUE,FALSE or 0 or 1.
X*
X*`009Also accepts ALL, and asks no more questions, or control-z or quit
X*`009to stop.
X*
X*`009Default is no.
X*
X`009Implicit None
X`009Character*(*) Name
X`009Logical Type
X*---
X`009Character*80 Ans
X`009Integer Alen
X*---
X`009Include 'QUALCOM.INC'
X`009Logical Abbrev
X`009External LIBSEARCH_INVLANS
X
X10`009If(Type) Then
X`009`009Write(*,'(1x,A,A,A,$)') 'Search file ',Name,' ? `091N`093: '
X`009Else
X`009`009Write(*,'(1x,A,A,A,$)') 'Search module ',Name,' ? `091N`093: '
X`009Endif
X
X`009Read(*,End=99,Fmt='(Q,A)') Alen,Ans
X
X`009If(Alen .eq. 0) Then
X`009`009Confirmed = .False.
X`009`009Return
X`009Endif
X
X`009Call Str$Upcase(Ans,Ans(1:Alen))
X`009If(Abbrev(Ans(1:Alen),'TRUE') .or.`032
X     $     Abbrev(Ans(1:Alen),'YES') .or.
X     $     Abbrev(Ans(1:Alen),'1')) Then
X`009`009Confirmed = .True.
X`009`009Return
X`009Else If(Abbrev(Ans(1:Alen),'FALSE') .or.
X     $          Abbrev(Ans(1:Alen),'NO') .or.
X     $          Abbrev(Ans(1:Alen),'0')) Then
X`009`009Confirmed = .False.
X`009`009Return
X`009Else If(Abbrev(Ans(1:Alen),'QUIT')) Then
X`009`009Goto 99
X`009Else If(Abbrev(Ans(1:Alen),'ALL')) Then
X`009`009Confirm_Module = .False.
X`009`009If(Type) Confirm = .False.
X`009`009Confirmed = .True.
X`009`009Return
X`009Else
X`009`009Call Lib$Signal(LIBSEARCH_INVLANS,%Val(1),Ans(1:Alen))
X`009`009Goto 10
X`009Endif
X
X99`009Call Exit(1)
X`009End
X
X`009Logical Function Abbrev(A,B)
X`009Implicit None
X`009Character*(*) A,B
X
X`009Abbrev = Len(A) .le. Len(B) .and. A .eq. B(1:Len(A))
X`009Return
X`009End
X
X`009Logical Function Excludeit(File,Excludes,Lexcl,Nexcl)
X*
X*`009Returns true if a filename matches one in the list of
X*`009things to exclude.
X*
X`009Implicit None
X`009Integer Nexcl
X`009Character*(*) File,Excludes(Nexcl)
X`009Integer Lexcl(Nexcl)
X
X`009Excludeit = .False.
X`009Return
X`009End
X
X`009Logical Function Bad_Timing(File)
X*
X*`009Returns TRUE if a file is to be excluded due to /BEFORE or /SINCE
X*`009qualifiers.
X*
X`009Implicit None
X`009Character*(*) File
X`009Include 'QUALCOM.INC'
X`009Include '($FABDEF)'
X`009Include '($XABDATDEF)'
X*-----
X`009Structure /Time/
X`009`009Integer T(2)
X`009End Structure
X`009Record /TIME/ Rtime,Ftime
X`009Integer Status
X`009Structure /XABTIM/
X`009`009Byte B_cod
X`009`009Byte B_BLN
X`009`009Integer*2 Fill1
X`009`009Integer L_Nxt
X`009`009Integer*2 W_RVN
X`009`009Integer*2 Fill2
X`009`009Record /Time/ Q_RDT
X`009`009Record /Time/ Q_CDT
X`009`009Record /Time/ Q_EDT
X`009`009Record /Time/ Q_BDT
X`009End Structure
X`009Record /XABTIM/ XAB
X`009Record /FABDEF/ FAB
X
X`009Integer Lib$Sub_Times,Sys$open,Sys$Close
X`009External Lib$_Negtim
X*
X*`009Initialize the block headers
X*
X`009XAB.B_Cod = XAB$C_DAT
X`009XAB.B_BLN = XAB$C_DATLEN
X`009fab.fab$b_BID = FAB$C_BID
X`009fab.fab$b_BLN = FAB$C_BLN
X*
X*`009Plug in some data
X*
X`009Fab.Fab$L_Fna = %Loc(File)
X`009Fab.Fab$B_Fns = Len(File)
X`009Fab.Fab$L_Xab = %Loc(XAB)
X
X`009Call Stchek(Sys$Open(FAB))
X*
X*`009Now we have some dates in the FAB, so copy the appropriate
X*`009one to FTIME for comparison.
X*
X`009If(Time_Type .eq. Created) Then
X`009`009Ftime = XAB.Q_CDT
X`009Else If(Time_Type .eq. Modified) Then
X`009`009Ftime = XAB.Q_RDT
X`009Else If(Time_Type .eq. Expired) Then
X`009`009Ftime = XAB.Q_EDT
X`009Else If(Time_Type .eq. Backup) Then
X`009`009Ftime = XAB.Q_BDT
X`009Endif
X
X`009Call Stchek(Sys$Close(Fab))
X
X`009If(Before) Then
X`009`009Status = Lib$Sub_times(Btime,Ftime,Rtime)
X`009`009If(Status .eq. %loc(Lib$_Negtim)) Then
X`009`009`009Bad_Timing = .True.
X`009`009`009Return
X`009`009Endif
X`009Endif
X
X`009If(Since) Then
X`009`009Status = Lib$Sub_times(Stime,Ftime,Rtime)
X`009`009If(Status .ne. %loc(Lib$_Negtim)) Then
X`009`009`009Bad_Timing = .True.
X`009`009`009Return
X`009`009Endif
X`009Endif
X
X`009Bad_timing = .False.
X`009Return
X`009End
$ CALL UNPACK PRSFIL.FOR;51 788895053
$ create/nolog 'f'
X`009Subroutine PrsTarget
X*
X*`009Routine to pick up strings which are search targets.
X*`009We allocate dynamic strings for each one as it is parsed,
X*`009and store the descriptors in a common block array.
X*`009Following suggestion of Pat Rankins, we check to see whether
X*`009all strings are non-alphabetic, and if so, force exact matching
X*`009because of its greater speed.
X*
X`009Implicit None
X`009Include 'TRGCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Character*128 Temp
X`009Integer Tlen,I
X`009Logical Ignore_Case,Swapd
X`009Record /DSCDEF1/ Ttarg
X`009Integer Status,Cli$Get_Value,Str$Copy_Dx,Str$Find_First_In_Set
X`009Character*(*) Alphabet
X`009Parameter (Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ')
X`009External CLI$_Absent
X`009External LIBSEARCH_TOOMNYTRG
X
X`009Ntargets = 0
X`009Status = 1
X`009Ignore_Case = .True.
X
X`009Do While(Status)
X`009  Status = Cli$Get_Value('STRING',Temp,Tlen)
X`009  If(.Not. Status) Then
X`009`009Continue
X`009  Else If(Ntargets .ge. Maxtarget) Then
X`009    Call Lib$Signal(LIBSEARCH_TOOMNYTRG,%val(1),%Val(Maxtarget))
X`009  Else
X*
X*`009We have a string. Check for alphabeticness
X*`009If we don't want exact matching, uppercase the target.
X*
X`009    If(.Not.Exact) Then
X`009`009Call Str$Upcase(Temp,Temp(1:Tlen))
X`009`009If(Ignore_Case) Ignore_Case =
X     $             (Str$Find_First_In_Set(Temp(1:Tlen),Alphabet) .eq. 0)
X`009    Endif
X
X`009    Ntargets = Ntargets + 1
X`009    Call DynIni(Target(Ntargets))
X`009    Status = Str$Copy_Dx(Target(Ntargets),Temp(1:Tlen))
X`009    Call Stchek(Status)
X`009  Endif
X
X`009Enddo
X
X`009If(Status .ne. %Loc(Cli$_Absent) .or. Ntargets .eq. 0)
X     $`009`009Call Stchek(Status)
X
X`009If(Ignore_Case) Exact = .True.
X*
X*`009Now sort the targets in length order, longest first. This is to allow
X*`009highlighting to work correctly later on output.
X*
X`009If(Ntargets .eq. 1) Return
X
X`009Swapd = .True.
X
X`009Do While (Swapd)
X`009 Swapd = .False.
X`009 Do I = 1,Ntargets-1
X`009  If(Target(I).Dsc$W_Maxstrlen .lt.
X     $             Target(I+1).Dsc$W_Maxstrlen) Then
X`009`009Ttarg = Target(I)
X`009`009Target(I) = Target(I+1)
X`009`009Target(I+1) = Ttarg
X`009`009Swapd = .True.
X`009  Endif
X`009 Enddo
X`009Enddo
X
X`009Return
X
X`009End
X
X`009Subroutine Dynini(Des)
X*
X*`009Initialize a dynamic string descriptor
X*
X`009Implicit None
X`009Include '($dscdef)'
X`009Record /DSCDEF1/ Des
X
X`009Des.DSC$W_MAXSTRLEN = 0
X`009Des.DSC$B_DTYPE = DSC$K_DTYPE_T
X`009Des.DSC$B_CLASS = DSC$K_CLASS_D
X`009Des.DSC$A_POINTER = 0
X
X`009Return
X`009End
$ CALL UNPACK PRSTARGET.FOR;13 34236863
$ create/nolog 'f'
X`009Integer Function Search_Module(Key,Rfa)
X`009Implicit None
X`009Character*(*) Key
X`009Integer RFA(2),TxtRfa(2)
X*
X*`009We now have the RFA of a particular key. Now we
X*`009call up a search routine once for each record,
X*`009outputting any records we find. We output the module name
X*`009if this is the first time we have found the target in this module.
X*`009We output the filename if this is the first hit in the file.
X*`009These are suppressed if header is false. Asterisks are included if
X*`009WINDOW is true.
X*
X`009Include '($LBRDEF)'
X`009Include 'FILCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Include 'TOPICS.INC'
X`009Include '($STRDEF)'
X
X`009External RMS$_EOF
X`009Integer Status,Lbr$Lookup_Key,Lbr$Find,Getrec,Str$Match_Wild
X`009Integer Lbr$Set_Module,Lib$Sub_Times
X`009Integer Mhl
X`009Integer Mhead(100),Rtime(2)
X`009Character*400 Mheadc
X`009Equivalence (Mhead,Mheadc)
X`009Logical Search_Rec,Sstat
X`009Structure /DESCRIP/
X`009`009Integer*2 Len
X`009`009Byte Type
X`009`009Byte Class
X`009`009Integer Address
X`009End Structure
X`009Record /DESCRIP/ Rec_Descriptor
X`009Include 'STATCOM.INC'
X`009Character*(*) Hfm1,Hfm2,Hfm3,Hfm4
X`009Parameter (Hfm1 = '(40(''*''))')
X`009Parameter (Hfm2 = '(30(''*''))')
X`009Parameter (Hfm3 = '(15(''*''))')
X`009Parameter (Hfm4 = '(20(''*''))')
X`009Logical Typerest`009`009!True after first hit if /REMAINING
X`009Logical Inwindow`009`009!True while outputting in window
X`009Logical Nsub`009`009`009!True when help subtopic changes
X`009Logical SubHelp`009`009`009!Subtopic in HELP library
X`009Integer I,Wincnt,Smatch
X`009Logical Confirmed
X`009External Lib$_NEGTIM
X*
X*`009Check to see if we want to handle this module first.
X*
X`009Search_Module = 1
X*
X*`009First check for /MEXCLUDE switches, and apply.
X*
X`009If(LModexcl(Cfile) .ne. 0) Then
X`009`009Status = Str$Match_Wild(Key,
X     $                       Modexcl(Cfile)(1:Lmodexcl(Cfile)))
X`009`009If(Status .eq. Str$_Match) Return
X`009Endif
X*
X*`009Then check for date/time exclusion.
X*
X`009If(Before .or. Since .and. (Time_Type .eq. Module_Time)) Then
X`009    Status = Lbr$Set_Module(Filidx,Rfa,Mheadc,Mhl)
X`009    Call Stchek(Status)
X`009    If(Before) Then
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-

