# ifdef VMS
# include <rms.h>
# include <iodef.h>
# include <ssdef.h>
# include <string.h>
# include <stdlib.h>
# include <stdio.h>
# include <descrip.h>
#include <lbrdef.h>
#include <credef.h>
#include <mhddef.h>
#include <lhidef.h>
#include <lib$routines.h>
#include <starlet.h>
# include "jam.h"
# include "filesys.h"
int lbr$close();
int lbr$get_index();
int lbr$ini_control();
int lbr$open();
int lbr$set_module();
unlink( f )
char *f;
{
remove( f );
}
static void
file_cvttime( curtime, unixtime )
unsigned int *curtime;
time_t *unixtime;
{
static const size_t divisor = 10000000;
static unsigned int bastim[2] = { 0x4BEB4000, 0x007C9567 };
int delta[2], remainder;
lib$subx( curtime, bastim, delta );
lib$ediv( &divisor, delta, unixtime, &remainder );
}
# define DEFAULT_FILE_SPECIFICATION "[]*.*;0"
# define min( a,b ) ((a)<(b)?(a):(b))
void
file_dirscan( char *dir, void (*func)() )
{
struct FAB xfab;
struct NAM xnam;
struct XABDAT xab;
char esa[256];
char filename[256];
char filename2[256];
char dirname[256];
register status;
FILENAME f;
memset( (char *)&f, '\0', sizeof( f ) );
f.f_root.ptr = dir;
f.f_root.len = strlen( dir );
xnam = cc$rms_nam;
xnam.nam$l_esa = esa;
xnam.nam$b_ess = sizeof( esa ) - 1;
xnam.nam$l_rsa = filename;
xnam.nam$b_rss = min( sizeof( filename ) - 1, NAM$C_MAXRSS );
xab = cc$rms_xabdat;
xab.xab$b_cod = XAB$C_DAT;
xab.xab$l_nxt = NULL;
xfab = cc$rms_fab;
xfab.fab$l_dna = DEFAULT_FILE_SPECIFICATION;
xfab.fab$b_dns = sizeof( DEFAULT_FILE_SPECIFICATION ) - 1;
xfab.fab$l_fop = FAB$M_NAM;
xfab.fab$l_fna = dir;
xfab.fab$b_fns = strlen( dir );
xfab.fab$l_nam = &xnam;
xfab.fab$l_xab = (char *)&xab;
status = sys$parse( &xfab );
if( DEBUG_BINDSCAN )
printf( "scan directory %s\n", dir );
if ( !( status & 1 ) )
return;
if( !strcmp( dir, "[000000]" ) )
{
(*func)( "[000000]", 1 , 1 );
}
if( !strcmp( dir, "[]" ) )
{
(*func)( "[]", 1 , 1 );
(*func)( "[-]", 1 , 1 );
}
while ( (status = sys$search( &xfab )) & 1 )
{
char *s;
time_t time;
sys$open( &xfab );
sys$close( &xfab );
file_cvttime( &xab.xab$q_rdt, &time );
filename[xnam.nam$b_rsl] = '\0';
if( xnam.nam$b_type == 4 && !strncmp( xnam.nam$l_type, ".DIR", 4 ) )
{
sprintf( dirname, "[.%.*s]", xnam.nam$b_name, xnam.nam$l_name );
f.f_dir.ptr = dirname;
f.f_dir.len = strlen( dirname );
f.f_base.ptr = 0;
f.f_base.len = 0;
f.f_suffix.ptr = 0;
f.f_suffix.len = 0;
}
else
{
f.f_dir.ptr = 0;
f.f_dir.len = 0;
f.f_base.ptr = xnam.nam$l_name;
f.f_base.len = xnam.nam$b_name;
f.f_suffix.ptr = xnam.nam$l_type;
f.f_suffix.len = xnam.nam$b_type;
}
file_build( &f, filename2, 0 );
(*func)( filename2, 1 , time );
}
if ( status != RMS$_NMF && status != RMS$_FNF )
lib$signal( xfab.fab$l_sts, xfab.fab$l_stv );
}
int
file_time( filename, time )
char *filename;
time_t *time;
{
return -1;
}
static char *VMS_archive = 0;
static void (*VMS_func)() = 0;
static void *context;
static int
file_archmember( module, rfa )
struct dsc$descriptor_s *module;
unsigned long *rfa;
{
static struct dsc$descriptor_s bufdsc =
{0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL};
struct mhddef *mhd;
char filename[128];
char buf[ MAXJPATH ];
int library_date, status;
register int i;
register char *p;
bufdsc.dsc$a_pointer = filename;
bufdsc.dsc$w_length = sizeof( filename );
status = lbr$set_module( &context, rfa, &bufdsc,
&bufdsc.dsc$w_length, NULL );
if ( !(status & 1) )
return ( 1 );
mhd = (struct mhddef *)filename;
file_cvttime( &mhd->mhd$l_datim, &library_date );
for ( i = 0, p = module->dsc$a_pointer; i < module->dsc$w_length; i++, p++ )
filename[i] = *p;
filename[i] = '\0';
sprintf( buf, "%s(%s.obj)", VMS_archive, filename );
(*VMS_func)( buf, 1 , (time_t)library_date );
return ( 1 );
}
void
file_archscan( archive, func )
char *archive;
void (*func)();
{
static struct dsc$descriptor_s library =
{0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL};
unsigned long lfunc = LBR$C_READ;
unsigned long typ = LBR$C_TYP_UNK;
unsigned long index = 1;
register status;
VMS_archive = archive;
VMS_func = func;
status = lbr$ini_control( &context, &lfunc, &typ, NULL );
if ( !( status & 1 ) )
return;
library.dsc$a_pointer = archive;
library.dsc$w_length = strlen( archive );
status = lbr$open( &context, &library, NULL, NULL, NULL, NULL, NULL );
if ( !( status & 1 ) )
return;
(void) lbr$get_index( &context, &index, file_archmember, NULL );
(void) lbr$close( &context );
}
# endif