-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X    base = (ENTRY **) malloc(INITSIZE * sizeof(ENTRY *));
X    if (base == (ENTRY **) NULL) `7B
X`09LIB$SIGNAL(SS$_INSFMEM);
X`09exit();
X    `7D
X    size = INITSIZE;
X    status = getfiledates(name, default_name, request, store);
X    if (last > 0) `7B
X`09int index;
X`09qsort(base, last, sizeof(ENTRY *), entry_compare);
X`09for (index = 0; index < last; index++) `7B
X`09    ENTRY *current = base`5Bindex`5D;
X`09    output(current->fnam, current->fnam_len, current->date);
X`09`7D
X`09if (trailer) `7B
X`09    printf("\nTotal of %d files\n\n", last);
X`09`7D
X    `7D
X    /* Should we not free all that malloced memory? */
X`7D
X
X/****************** utilities *******************/
X/*
X * Duplicate a string a la strncpy
X */
Xstatic char    *
Xstrndup(char *s, int max)
X`7B
X    int             count;
X    char           *cp;
X
X    cp = malloc(max + 1);
X    if (cp == NULL) `7B
X`09LIB$SIGNAL(SS$_INSFMEM);
X`09exit();
X    `7D
X    cp`5Bmax`5D = '\0';
X    return (strncpy(cp, s, max));
X`7D
X/***************************************************************************
V**\
X* `09`09`09`09`09`09`09`09`09      *
X* Getfiledates: use LIB$FILE_SCAN to extract the creation or revision dates
V   *
X* of files. Does not open the files but uses ACP QIO to retrieve the`09
V      *
X* information for local files, so`09`09`09`09       `09      *
X* a. the performance should be ok, and`09`09`09`09`09      *
X* b. we will even get dates for files that are locked.`09`09`09      *
X* `09`09`09`09`09`09`09`09`09      *
X\***************************************************************************
V**/
X#include iodef
X#include rms
X#include devdef
X#include fibdef
X#include atrdef
X#include ssdef
X
X/* Static data for communication between getfiledates and error/sucess */
Xstatic int user_request;
Xstatic quad date;
Xstatic struct atrdef attrl`5B3`5D;
X
Xextern unsigned int
XLIB$FILE_SCAN(struct FAB *fab,
X`09      unsigned int success(),
X`09      unsigned int error(),
X`09      unsigned int *context);
X`09     `20
Xextern unsigned int
XLIB$FILE_SCAN_END(struct FAB *fab,
X`09`09  unsigned int *context);
Xextern void
XLIB$SIGNAL(unsigned int status);
X
Xstatic unsigned int error(struct FAB *fab);
X
X#define OK(i) ((i) & 1)
X#define checkstatus(status) \
X    do `7Bif (! OK(status)) `7Bfab->fab$l_stv = status; return(error(fab));`
V7D`7D while (0)
X `20
X/* Success routine, called by LIB$FILE_SCAN */
Xstatic unsigned int success(struct FAB *fab)
X`7B
X    struct NAM *nam = fab->fab$l_nam;
X    void (*user_proc)() = (void (*)()) fab->fab$l_ctx;
X    struct fibdef fib;
X    struct `7B
X        short length;
X        short dummy;
X`09struct fibdef *addr;
X    `7D fib_descr;
X    $DESCRIPTOR(devicename_dsc, "");
X    unsigned short channel;
X    struct `7B
X`09short status;
X`09short len;
X`09int dummy;
X    `7D iosb;
X    unsigned int status1, status2;
X    int i;
X    unsigned char *fib_ptr = (unsigned char *) &fib;
X    char *name_ptr;
X    int name_length;
X   `20
X    /* lacking a cc$rms_fib, we need to init it here */
X    for (i=0; i<FIB$C_LENGTH; i++) `7B
X`09*fib_ptr++ = 0;
X    `7D
X    if (! fab->fab$l_dev & DEV$M_DIR &&
X        ! nam->nam$v_node) `7B
X`09   checkstatus(SS$_NOTFILEDEV);
X    `7D
X    if (fab->fab$l_dev & DEV$M_FOR) `7B
X        checkstatus(SS$_DEVFOREIGN);
X    `7D
X    if (! nam->nam$v_node) `7B
X        fib_descr.length = sizeof(fib);
X        fib_descr.addr = &fib;
X        devicename_dsc.dsc$a_pointer = &nam->nam$t_dvi`5B1`5D;
X        devicename_dsc.dsc$w_length = (short) nam->nam$t_dvi`5B0`5D;
X        status1 = SYS$ASSIGN(&devicename_dsc, &channel, 0, 0);
X        checkstatus(status1);
X        fib.fib$r_fid_overlay.fib$w_fid`5B0`5D = nam->nam$w_fid`5B0`5D;
X        fib.fib$r_fid_overlay.fib$w_fid`5B1`5D = nam->nam$w_fid`5B1`5D;
X        fib.fib$r_fid_overlay.fib$w_fid`5B2`5D = nam->nam$w_fid`5B2`5D;
X        status1 = SYS$QIOW(0, channel, IO$_ACCESS, &iosb,
X        `09`09   0,0,
X `09`09`09   &fib_descr,
X `09`09`09   0,0,0,
X `09`09`09   &attrl,0,0);
X        status2 = SYS$DASSGN(channel);
X        checkstatus(status2);
X        checkstatus(status1);
X        checkstatus(iosb.status);
X    `7D else `7B
X`09/* node present in name - info already in xab */
X        checkstatus(fab->fab$l_sts);
X        if (fab->fab$l_stv != 0) `7B
X`09    checkstatus(fab->fab$l_stv);
X`09`7D
X`09if (user_request == CREDAT)
X`09    date = ((struct XABDAT *)fab->fab$l_xab)->xab$q_cdt;
X`09else
X            date = ((struct XABDAT *)fab->fab$l_xab)->xab$q_rdt;
X    `7D
X    name_ptr = nam->nam$l_name;
X    name_length = nam->nam$b_dev + nam->nam$b_dir;
X    if (name_length) name_ptr = nam->nam$l_dev;
X    name_length += nam->nam$b_name + nam->nam$b_type + nam->nam$b_ver;
X    user_proc(name_ptr, name_length, date);
X    return(SS$_NORMAL); /* keep going */
X`7D
X
Xglobalref CTL$GB_MSGMASK;`09/* Address of current message mask */
X`09`09`09`09/* Needs link with
X`09`09`09`09   sys$system:sys.stb/selective_search */
Xextern int LIB$SYS_GETMSG();
X
X/* Error routine, called by LIB$FILE_SCAN */
Xstatic unsigned int error(struct FAB *fab)
X`7B
X    struct NAM *nam = fab->fab$l_nam;
X    char error_message`5B255`5D;
X    unsigned short message_length;
X    unsigned char message_level = CTL$GB_MSGMASK; /* user preference mask */
X    unsigned long message_flags = (unsigned long) message_level;
X    $DESCRIPTOR(error_message_dsc, error_message);
X
X    message_flags = (unsigned long) 1;`09/* text of message only */
X    strntolower(nam->nam$l_name, (nam->nam$b_name +
X`09`09`09`09  nam->nam$b_type +
X`09`09`09`09  nam->nam$b_ver));
X    fprintf(stderr, "%s - ", nam->nam$l_name);
X
X    /* print the secondary error status message, if any */
X    if (fab->fab$l_stv != 0) `7B
X`09(void) LIB$SYS_GETMSG(&fab->fab$l_stv, &message_length, &error_message_ds
Vc, &message_flags);
X`09fprintf(stderr, "%.*s\n", message_length,
X`09`09`09          error_message_dsc.dsc$a_pointer);
X    `7D else `7B
X`09/* print the primary error status message */
X`09(void) LIB$SYS_GETMSG(&fab->fab$l_sts, &message_length, &error_message_ds
Vc, &message_flags);
X        fprintf(stderr, "%.*s\n", message_length,
X`09`09`09      `09  error_message_dsc.dsc$a_pointer);
X    `7D
X    /* ignore */  `20
X    return(SS$_NORMAL); /* keep going */
X`7D
X
X/* Main routine to retrieve the filedates */
Xstatic unsigned int
Xgetfiledates(char *name, char *default_name, int requesttype, void user_proc
V())
X`7B
X    struct FAB fab = cc$rms_fab;
X    struct NAM nam = cc$rms_nam;
X    struct XABDAT xabdat = cc$rms_xabdat;
X    char esa`5BNAM$C_MAXRSS`5D;
X    char rsa`5BNAM$C_MAXRSS`5D;
X    int context;
X    int status;
X
X    user_request = requesttype;
X    context = 0;
X    fab.fab$l_fna = name;
X    fab.fab$b_fns = strlen(name);
X    fab.fab$l_dna = default_name;
X    fab.fab$b_dns = strlen(default_name);
X    fab.fab$l_nam = &nam;
X    fab.fab$l_xab = &xabdat;
X    fab.fab$l_ctx = user_proc;
X    fab.fab$l_fop = FAB$M_NAM;
X    nam.nam$l_esa = esa;
X    nam.nam$b_ess = sizeof(esa);
X    nam.nam$l_rsa = rsa;
X    nam.nam$b_rss = sizeof(rsa);
X    nam.nam$b_nop = NAM$M_SRCHXABS;
X    /* init attrl for use by success() */
X    if (user_request == CREDAT)
X`09attrl`5B0`5D.atr$w_type = ATR$C_CREDATE;
X    else
X`09attrl`5B0`5D.atr$w_type = ATR$C_REVDATE;
X    attrl`5B0`5D.atr$w_size = sizeof(date);
X    attrl`5B0`5D.atr$l_addr = &date;
X    attrl`5B1`5D.atr$w_type = 0;
X    attrl`5B1`5D.atr$w_size = 0;
X    attrl`5B1`5D.atr$l_addr = (quad *) NULL;
X    status = LIB$FILE_SCAN(&fab, success, error, &context);
X    if (status == RMS$_NMF) status = SS$_NORMAL;
X    if (! OK(status)) `7B
X `09return(status);
X    `7D
X    status = LIB$FILE_SCAN_END(&fab, &context);
X    if (! OK(status)) `7B
X `09return(status);
X    `7D
X    return(SS$_NORMAL);
X`7D
$ CALL UNPACK [.TDIR]TDIR.C;92 1280089862
$ create 'f'
X1 TDIRECTORY
X  Syntax
X
X  `09TDIRECTORY `5Bfiles`5D `5Bqualifiers`5D
X
X  TDIRECTORY will display a list of the specified files (default for files
X  is SYS$DISK:`5B`5D*.*;0) sorted by date. The default date used is the crea
Vtion
X  date, but that may be changed.
X  The output contains the filename and type, and if /SHOW_VERSIONS has been
X  specified the version number, followed by the date. Between filespec and
X  date, just enough spaces will be inserted to get nice columns.
X  In the output, filename and type will be printed in lowercase, the month
X  will be capitalized. The time will be given as hh:mm.
X `20
X2 Qualifiers
X/ARCHAIC
X  Use the output format of the V3.0 TDIR command, in particular:
X  - use SYS$DISK:`5B`5D*.*;* as default file spec
X  - print a header and trailer;
X  - output the date starting in column 30;
X  - keep the seconds in the time-string;
X  - make /SHOW_VERSIONS default.
X  - display filename, type and month in uppercase.
X/SHOW_VERSIONS
X  When printing the filename, include the version number in the output.
X  By default, version numbers will not be shown.
X/CREATION_DATE`20
X  Use the creation date of the files for sorting. Default.
X/MODIFICATION_DATE`20
X  Use the modifcation date of the files for sorting.
X  This is the same as the revision date.
X/REVISION_DATE`20
X  Use the revision date of the files for sorting.
X  This is the same as the modification date. `20
X/ASCENDING
X  Sort the files with the date in ascending order.
X/DESCENDING`20
X  Sort the files with the date in descending order. Default.
X/OUTPUT`20
X  /OUTPUT=<output-file-spec>
X  Use <output-file-spec> for the output. Default output goes to SYS$OUTPUT.
X/PAGE
X  When outputting on a terminal, stop after a full screen and display
X  the prompt
X
X  `09"Press <return> to continue..."
X
X  Any other input than a <return> will terminate the program.
X2 Release_notes
X  This is version 4.0 of the TDIR command. At this time there are no known
X  bugs.
$ CALL UNPACK [.TDIR]TDIR.HLP;11 1499716516
$ create 'f'
Xsys$system:sys.stb/selective_search
Xsys$share:vaxcrtl.exe/share
$ CALL UNPACK [.TDIR]TDIR.OPT;2 390939567
$ create 'f'
X! CLD file to define TDIRECTORY command
X
Xdefine verb TDIR
X   parameter P1, label=INPUT, prompt="File"
X      value (list,impcat,type=$infile)
X   qualifier ARCHAIC, nonnegatable
X   qualifier SHOW_VERSIONS, nonnegatable
X   qualifier CREATION_DATE, nonnegatable
X   qualifier MODIFICATION_DATE, nonnegatable
X   qualifier REVISION_DATE, nonnegatable
X   qualifier ASCENDING,nonnegatable
X   qualifier DESCENDING, nonnegatable
X   qualifier OUTPUT, nonnegatable
X      value (required, type=$outfile)
X   qualifier PAGE
X   disallow any2 (CREATION_DATE, MODIFICATION_DATE, REVISION_DATE)
X   disallow any2 (OUTPUT, PAGE)
X   disallow any2 (ASCENDING, DESCENDING)
$ CALL UNPACK [.TDIR]TDIR_CLD.CLD;11 22567363
$ v=f$verify(v)
$ EXIT