tldm-universe/Ardent/UV/BP/LISTFILES

*******************************************************************************
*
*	List file names in the VOC
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	02/13/97 20074 PEJ Display file details with FMTDP for NLS
*	10/04/96 19345 DJD Fixed REMOTE test.
*	06/28/96 18739 ALC Removed UNIX from messages
*	06/05/96 18438 JC  Port to NT
*	07/11/94 14069 TFH Further improvements to file-open-error messages
*	06/15/94 14069 TFH Improve message if file can't be opened
*	11/27/90 7735  JWT patch LISTFILES per MAB
*	07/25/88   -    -  Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************

$include UNIVERSE.INCLUDE FILENAMES.H

	open "VOC"    to f.voc else stop 'Can not open the "VOC" file'
	open "NEWACC" to f.newacc else stop 'Can not open the "NEWACC" file'

	hush on
	input type

	printer reset

	cmd  = field(trim(@PARASENTENCE), " ", 2, 999)
	lptr = 0
	squawk = 0
	sel  = ""

	loop
	while cmd # "" do
		id  = field(cmd, " ", 1)
		cmd = field(cmd, " ", 2, 999)

		read rec from f.voc, id then
			code = upcase(rec<1>)[1,1]
			begin case
			case code = "F"
				if sel = "" then sel = id else sel := @FM:id
			case code = "K"
				if rec<2> = 33 then lptr = 1
				if rec<2> = 36 then squawk = 1
			end case
		end
	repeat

	begin case
	case sel # ""
	   select sel
	case type = "LOCAL"
	   perform 'SSELECT VOC WITH TYPE = "F" AND F2 NOT.MATCHING ".../..." AND F2 NOT.MATCHING "...\..."'
	case type = "REMOTE"
	   perform 'SSELECT VOC WITH F2 MATCHING ".../..." OR F2 MATCHING "...\..." AND WITH TYPE = "F"' 
	case 1
	   perform 'SSELECT VOC WITH TYPE = "F"'
	end case

	hush off
	if type = "" then sp = 22 else sp = 21-len(type); type:= " "

	if lptr then printer on
h =type:"FILES in your vocabulary":space(sp):"'T' Page 'P2LL'"
h:="Filename........................... Pathname...................... Type Modulo'L'"
	heading h

	kount = 0

10	readnext id else
		print
		print kount:" Files listed."
		heading ""
		stop
	end

	read fitem from f.voc,id else goto 10

	kount += 1

	desc = fitem<1>
	if upcase(trim(desc)) = "F" then
		readv desc from f.newacc,id,1 else desc = "F"
	end

	if upcase(trim(desc)) # "F" then print space(5):desc

	name = "DICT ":id
	path = fitem<3>
	gosub DISPLAY

	if fitem<5> # "" then
		name = "PICK ":id
		path = fitem<5>
		gosub DISPLAY
	end
	if upcase(fitem<4>[1,1]) = "M" then
		top = fitem<2>
		openpath top to f.file then
			sselect f.file to 1

20			readnext sid from 1 else goto 29


			name = "DATA ":id:",":sid
			path = top : UV.FSEP : sid
			gosub DISPLAY
			goto 20
29
		end else
			print "Unable to open top directory of 'M' file"
		end

	end else

		name = "DATA ":id
		path = fitem<2>
		gosub DISPLAY

	end
	print
	goto 10

DISPLAY:
	if path = "" then return

**** Silence possible ugly message if open fails - 6/10/94
	if squawk = 0 then hush on
****
	openpath path to f.file then
		type = status()
		mod  = inmat()
		if type = 1 then mod = ""
		hush off
		print fmtdp( name, "l#35 " ) :
		print fmtdp( path, "l#30 " ) :
		print type     "r#4 ":
		print mod      "r#6 "
		close f.file
		return
	end else
		stat = status()
		hush off
		print fmtdp( name, "l#35 " ) :
		print fmtdp( path, "l#30 " ) :
		if stat = 0 then print "   ?      ? "; return
		    
**** Provide better message if file can't be opened - 6/10/94
****
		print " Can't open "
		begin case
			case stat = -2
				if path matches "...!/..." or path matches "...!\..." then
				    line2 = "Inaccessible uVnet file"
				  end else
				    line2 = "Non-existent file"
				  end
			case stat = -3
				line2 = "No OS permission"
			case stat = -4
				line2 = "No OS permission or invalid file"
			case stat = -5
				line2 = "OS read error"
			case stat = -6
				line2 = "Can't lock file header"
			case stat = -7
				line2 = "Bad file rev or byte-swap"
			case stat = -8
				line2 = "Invalid part-file info"
			case stat = -9
				line2 = "Invalid type 30 info"
			case stat = -10
				line2 = "File marked inconsistent"
			case stat = -11
				line2 = "SQL view  "
			case stat = -12
				line2 = "No SQL permission"
			case stat = -13
				line2 = "Problem with index"
			case 1
				line2 = "status = ":stat
		end case
		numspace = 79 - len(line2)
		print space(numspace):
		print line2
		return
	end
end