From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 17-MAY-1989 19:21
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re: Directory Existences

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue, 16 MAY 89 14:25:32 PDT
Received: from EQL.Caltech.Edu by KL.SRI.COM with TCP; Tue, 16 May 89 14:25:29 PDT
Date:     Tue, 16 May 89 14:25:26 PDT
From: rankin@EQL.Caltech.Edu (Pat Rankin)
Message-Id: <890516142444.20200d70@EQL.Caltech.Edu>
Subject:  Re: Directory Existences
To: wilkinson@uclach.chem.ucla.edu
Cc: info-vax@kl.sri.com, ijah400%ivax.decnet@gold.bacs.indiana.edu

> Two related questions regarding determining directory existence from either
> a HLL or Macro.
>
> First, what is the best way to determine whether the default directory in
> a user's context actually exists? How does SHOW DEFAULT do this? As far
> as I can tell it does no disk i/o.

     Use $PARSE (SYS$PARSE from most languages, F$PARSE from DCL).  It
validates device and directory by default.  (There is a SYNTAX_CHECK-only
option to suppress this validation.)

> Next, what is the most efficient way to determine whether an existing file
> is a directory file? In other words, just having the file type "DIR" is
> not adequate. Doubtless there is some simple way to determine this in RMS;
> I would appreciate any pointers to get me going.

     As several people have pointed out, you can assign a channel to the
disk and then use an ACP-CONTROL $QIO to retreive file characteristics.
However, under VMS V5 you can also do this with RMS by using an itemlist
XAB with the $OPEN or $DISPLAY services (both of which require that you
actually open the file).

     The RMS documentation is poor (or "worse than usual" depending on
your perspective), but the following sample program illustrates XABITM.
Note that to get the V5 library modules, you must install Fortran v5.x
or re-install Fortran v4.x after upgrading to VMS 5.0 (the same applies
for Pascal); to get the proper header files for C, you must install
VAXC v3.0.  (The alternative is to generate them yourself from the Macro
versions in sys$library:Starlet.Mlb or from the SDL versions in
sys$library:StarletSD.Tlb.)

     The sample program retreives both the file characteristics longword
(which has bits for directory, contiguous file, contiguous-best-try,
erase-on-delete, marked for delete, marked no-backup, and several other
items) and the directory flag.  In practice, you only need one or the
other since you can easily derive the directory flag from the longword
bitmask.

                                        Pat Rankin
                                    rankin@eql.Caltech.EDU

-----
      program  Dir_Identify_Test
        implicit none
        include '($FABdef)/nolist'              !RMS File Access Block
        include '($XABdef)/nolist'              ! "  eXtended Attributes Blocks
        include '($XABITMdef)/nolist'           ! "  Itemlist XAB defs

        structure /xab/         !combine XABITMdef with XABdef
          union
            map
                record /xabdef/ xabcmn          !common xab fields
            end map
            map
                record /xabitmdef/ xabitm       !item-list xab
            end map
          end union
        end structure !xab

        structure /itm3/        !three longword itemlist for VMS system services
            integer *2  itm_w_length    !length of buffer
            integer *2  itm_w_code      !item code
            integer *4  itm_l_bufadr    !address of buffer
            integer *4  itm_l_retlen    !address of i*2 to receive output length
        end structure !itm3

        byte            fAB_PROTOTYPE(2) / FAB$C_BID, FAB$C_BLN /
        byte            xABITM_PROTOTYPE(2) / XAB$C_ITM, XAB$C_ITMLEN /
        parameter       lONGWORD = 4,  nULL = 0

        record /xab/    xab
        record /fabdef/ fab
        record /itm3/   itemlist(3)
        character *127  filename
        integer *2      ln
        logical *4      is_directory
        integer *4      file_characteristics,  sts
        integer *4      SYS$OPEN

        call LIB$GET_FOREIGN( filename, 'filename: ', ln)
        if ( ln .gt. 0 )  call STR$TRIM( filename, filename(:ln), ln)
        if ( ln .eq. 0 )  stop '% filename required'

C     initialize FAB
        call LIB$MOVC5( 2, fAB_PROTOTYPE, 0, FAB$C_BLN, fab)
        fab.fab$l_fna = %LOC(filename)
        fab.fab$b_fns = ln
        fab.fab$b_fac = FAB$M_GET
        fab.fab$l_xab = %LOC(xab)

C     initialize XAB
        call LIB$MOVC5( 2, XABITM_PROTOTYPE, 0, XAB$C_ITMLEN, xab)
        xab.xabitm.xab$b_mode     = XAB$K_SENSEMODE
        xab.xabitm.xab$l_itemlist = %LOC(itemlist)

C     initialize itemlist
        itemlist(1).itm_w_code   = XAB$_UCHAR
        itemlist(1).itm_w_length = lONGWORD
        itemlist(1).itm_l_bufadr = %LOC(file_characteristics)
        itemlist(1).itm_l_retlen = nULL
        itemlist(2).itm_w_code   = XAB$_UCHAR_DIRECTORY
        itemlist(2).itm_w_length = lONGWORD
        itemlist(2).itm_l_bufadr = %LOC(is_directory)
        itemlist(2).itm_l_retlen = nULL
        itemlist(3).itm_w_code   = 0            !end of list
        itemlist(3).itm_w_length = 0

C     retreive info
        file_characteristics = 0
        is_directory = .false.
        sts = SYS$OPEN( fab)
        type '(x,a,z8.8)', '$open = ', sts

C     check the results
        if ( sts ) then
            type '(x,a,z8.8)', 'uchar = ', file_characteristics
*           is_directory = BTEST( file_characteristics, XAB$V_DIRECTORY)
            if ( is_directory ) then
                type *,' "'//filename(:ln)//'" is a directory'
            else
                type *,' "'//filename(:ln)//'" is NOT a directory'
            end if
            call SYS$CLOSE( fab)                ![or setup RAB and $CONNECT]
            sts = 1     !SS$_NORMAL
        end if

        call EXIT( sts)
      end
-----

