*---------------------------INRS-Telecommunications---------------------------
*
*
* MODULE:
*	SUBROUTINE FNSCAN (FNAME, KEYWORD, STRO, NCO)
*
*
* PURPOSE:
*	This routine returns components of a file name.
*
*
* DESCRIPTION:
*	This routine returns the requested components of a file
*	name using the $FILESCAN system service routine. The
*	components desired are specified by a list of keywords.
*	The file name given is treated as given, not logical name
*	translation is given out. If components are missing, a
*	request for that component results in a zero length output.
*
*	Keywords are specified in a string, with multiple keywords
*	separated by commas. The returned string consists of the
*	concatenation of the file name components requested. The
*	returned components are given in the the proper file name
*	sequence. The filename scan of the input string terminates
*	at a character that is invalid in a filename context. For
*	example a blank terminates the file name scan.
*	 keyword          returned string
*	FILESPEC     full file specification
*	NODE         node name, including the double colon (::) as
*	             well as any access control string (if present)
*	DEVICE       device name, including the single colon (:)
*	ROOT         root directory string, including opening and
*	             closing brackets ([]) or angle brackets (<>)
*	DIRECTORY    directory name, including opening and closing
*	             brackets ([]) or angle brackets (<>)
*	NAME         file name or quoted file specification following
*	             a node name
*	TYPE         file type, including the preceding period (.)
*	VERSION      file version number, including the preceding
*	             period (.) or semicolon (;)
*
*
* PARAMETERS:
* ->	FNAME  - Input file name string
* ->	KEYWORD - String containing a list of keywords. Keywords are
*	         separated by commas.
* <-	STRO   - Output string containing the requested file name
*	         components. This string is padded with blanks.
* <-	NCO    - Length of the output string not including padding
*	         blanks.
*
*
* ROUTINES REQUIRED:
*	IZERO  - Zero an integer array
*	KEYUPC - Match a keyword
*	LIB$SCOPY_R_DX - Copy a string
*	LIB$SIGNAL - Signal an error condition
*	SYS$FILESCAN - Scan a file name for components
*	WARN   - Signal a warning message
*
*
* AUTHOR / MAINTAINED BY:
*	P. Kabal
*
*
* DATE CREATED:
*	86/09/08
*
*
* UPDATES:
*	86/10/06  Fix
*	89/02/03  Pad with blanks
*
*
*---------------------------INRS-Telecommunications---------------------------

	SUBROUTINE FNSCAN (FNAME, KEYWORD, STRO, NCO)


	CHARACTER*(*) FNAME,KEYWORD,STRO

	INTEGER SYS$FILESCAN,
     -	        LIB$SCOPY_R_DX

	PARAMETER (NEKEY=8)
	CHARACTER*20 KEYTAB(NEKEY)
	DATA KEYTAB/
     -	  'FILESPEC',  'NODE', 'DEVICE', 'ROOT',
     -	  'DIRECTORY', 'NAME', 'TYPE',   'VERSION'/

	STRUCTURE /ITEM/
	  UNION
	    MAP
	      INTEGER*2 NC
	      INTEGER*2 ITEM_CODE
	    END MAP
	    MAP
	      INTEGER END_OF_LIST_MARK
	    END MAP
	  END UNION
	  INTEGER ADDRESS
	END STRUCTURE
	STRUCTURE /ITEM_LIST/
	  RECORD /ITEM/ REC(NEKEY+1)
	END STRUCTURE
	RECORD /ITEM_LIST/ FSC_ITEM_LIST

	INCLUDE '($FSCNDEF)'

	INTEGER*2 ITEM_CODE(NEKEY)
	INTEGER IC(NEKEY)
	DATA ITEM_CODE/
     -	  FSCN$_FILESPEC,  FSCN$_NODE, FSCN$_DEVICE, FSCN$_ROOT,
     -	  FSCN$_DIRECTORY, FSCN$_NAME, FSCN$_TYPE,   FSCN$_VERSION/


	IST=1
	CALL IZERO(IC,NEKEY)
	DO WHILE (IST.LE.LEN(KEYWORD))

* Find a comma in the keyword string
	  K=INDEX(KEYWORD(IST:),',')
	  IF (K.EQ.0) THEN
	    IEND=LEN(KEYWORD)
	  ELSE
	    IEND=IST+K-2
	  END IF

* Get the next keyword
	  N=KEYUPC(KEYWORD(IST:IEND),KEYTAB,NEKEY)
	  IF (N.EQ.0) THEN
	    CALL WARN('FNSCAN - Invalid keyword: '//KEYWORD(IST:IEND))
	  ELSE
	    IC(N)=1
	  END IF
	  IST=IEND+2

	END DO


* Set up an item list for the items requested
	IF (IC(1).NE.0) THEN
	  NITEM=1
	  FSC_ITEM_LIST.REC(NITEM).ITEM_CODE=ITEM_CODE(1)
	ELSE
          NITEM=0
	  DO I=2,NEKEY
	    IF (IC(I).NE.0) THEN
	      NITEM=NITEM+1
	      FSC_ITEM_LIST.REC(NITEM).ITEM_CODE=ITEM_CODE(I)
	    END IF
	  END DO
	END IF
	FSC_ITEM_LIST.REC(NITEM+1).END_OF_LIST_MARK=0

* Get the items requested
	ISTAT=SYS$FILESCAN(FNAME,FSC_ITEM_LIST,)
	NCO=0

	IF (.NOT.ISTAT) THEN

* Error return
	  CALL LIB$SIGNAL(%VAL(ISTAT))

	ELSE

* Form the output string
	  NCT=0
	  DO I=1,NITEM
	    NC=FSC_ITEM_LIST.REC(I).NC
	    NCT=NCT+NC
	    NCA=MIN(NC,LEN(STRO)-NCO)
	    ISTAT=LIB$SCOPY_R_DX(NCA,%VAL(FSC_ITEM_LIST.REC(I).ADDRESS),
     -	                         STRO(NCO+1:NCO+NCA))
	    IF (.NOT.ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
	    NCO=NCO+NCA
	  END DO
	  IF (NCT.GT.NCO) CALL WARN('FNSCAN - String truncated')
	  IF (NCO.LT.LEN(STRO)) STRO(NCO+1:)=' '

	END IF


	RETURN

	END
