/*
 * OS390::Stdio - MVS extensions to stdio routines 
 *
 * Author:   Peter Prymmer  pvhp@pvhp.best.vwh.net
 * Version:  0.008
 * Revised:  06-Oct-2002
 * Revised:  30-Sep-2002
 * Version:  0.006
 * Revised:  25-May-2001
 * Version:  0.005
 * Revised:  17-May-2001
 * Version:  0.004
 * Revised:  14-Apr-2001
 * Version:  0.003
 * Revised:  10-Apr-1999
 * Version:  0.001
 * Revised:  31-Aug-1998
 *           (based on VMS::Stdio V. 2.1 by Charles Bailey)
 *
 * sync() is primarily POSIX, fsync() only takes an int fildes
 * hence OS390::Stdio::sync() cannot be implemented.
 *
 * stat() tends to deal only with POSIX file structures such as
 * struct stat in <sys/stat.h>, hence OS390::Stdio::stat() cannot be 
 * implemented (use sysdsnr() instead).
 *
 * both opendir() and __opendir2() seem to not like data sets.
 *
 */

/* 
 * We won't need to resort to this pragma if we set _EXT and compile with
 * c89 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE 
 * #pragma LANGLVL(EXTENDED)
 *
 */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
/* allow POSIX extensions (?) */
#define _EXT 1
#include <sys/file.h>
/* O_* constants */
#include <fcntl.h>
#include <stdio.h>
/* dynit.h for __dyn_t, dyninit(), dynalloc(), and dynfree() */
#include <dynit.h>
/* for pds_mem() */
#include <string.h>
#include <stdlib.h>
/* errno.h for __errno2() as used by smf_record */
#include <errno.h>

/*
 *  Note that FILENAME_MAX is defined in stdio.h to be
 *  either 1000 or 64, but this appears to not be quite 
 *  what we want since:
 *
 *  //A2345678.B2345678.C2345678.GxxxxVyy
 *  //A2345678.B2345678.C2345678.D2345678(12345678)
 *  12345678901234567890123456789012345678901234567
 *           1         2         3         4
 *
 * So let us go with:
 *
 */

#define MAXOSFILENAME 100

/*
 * OS390_STDIO_SVC99_TEXT_UNITS is the upper limit on the number 
 * of text units to pass into svc99().
 * OS390_STDIO_SVC99_MASK is involved with an "end of text units" flag.
 */
#define OS390_STDIO_SVC99_TEXT_UNITS 25
#define OS390_STDIO_SVC99_MASK 0x80000000

static bool
constant(name, pval)
char *name;
IV *pval;
{

/*
 * This is where s/^_+// takes place.
 *
 *   while (*name == '_') { name++; }
 */

/*
 * The KEY_* and RBA_* constants are used with vsam type
 * functions such as flocate() et alia.
 * The definitions are "usually" found in /usr/include/stdio.h
 *
 */
    if (strEQ(name, "KEY_FIRST"))
#ifdef __KEY_FIRST
	{ *pval = __KEY_FIRST; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "KEY_LAST"))
#ifdef __KEY_LAST
	{ *pval = __KEY_LAST; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "KEY_EQ"))
#ifdef __KEY_EQ
	{ *pval = __KEY_EQ; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "KEY_EQ_BWD"))
#ifdef __KEY_EQ_BWD
	{ *pval = __KEY_EQ_BWD; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "KEY_GE"))
#ifdef __KEY_GE
	{ *pval = __KEY_GE; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RBA_EQ"))
#ifdef __RBA_EQ
	{ *pval = __RBA_EQ; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RBA_EQ_BWD"))
#ifdef __RBA_EQ_BWD
	{ *pval = __RBA_EQ_BWD; return TRUE; }
#else
	return FALSE;
#endif

/*
 * The O_ constants are typically used with open() rather than fopen()
 * (hence they may not be too useful here).
 * The definitions are "usually" found in /usr/include/fcntl.h
 *
 */
    if (strEQ(name, "O_APPEND"))
#ifdef O_APPEND
	{ *pval = O_APPEND; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_CREAT"))
#ifdef O_CREAT
	{ *pval = O_CREAT; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_EXCL"))
#ifdef O_EXCL
	{ *pval = O_EXCL; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_NDELAY"))
#ifdef O_NDELAY
	{ *pval = O_NDELAY; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_NOWAIT"))
#ifdef O_NOWAIT
	{ *pval = O_NOWAIT; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_RDONLY"))
#ifdef O_RDONLY
	{ *pval = O_RDONLY; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_RDWR"))
#ifdef O_RDWR
	{ *pval = O_RDWR; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_TRUNC"))
#ifdef O_TRUNC
	{ *pval = O_TRUNC; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "O_WRONLY"))
#ifdef O_WRONLY
	{ *pval = O_WRONLY; return TRUE; }
#else
	return FALSE;
#endif

/*
 * __dyn_t constants for use with dyninit()/dynalloc()/dynfree()
 * The definitions are "usually" found in /usr/include/dynit.h
 *
 */
    if (strEQ(name, "ALCUNIT_CYL"))    /* alcunit CYLINDER */
#ifdef __CYL
	{ *pval = __CYL; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "ALCUNIT_TRK"))    /* alcunit TRACK */
#ifdef __TRK
	{ *pval = __TRK; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "DISP_OLD"))       /* status STATUS=OLD */
#ifdef __DISP_OLD
	{ *pval = __DISP_OLD; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "DISP_MOD"))       /* status STATUS=MOD */
#ifdef __DISP_MOD
	{ *pval = __DISP_MOD; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "DISP_NEW"))       /* status STATUS=NEW */
#ifdef __DISP_NEW
	{ *pval = __DISP_NEW; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "DISP_SHR"))       /* status STATUS=SHR */
#ifdef __DISP_SHR
	{ *pval = __DISP_SHR; return TRUE; }
#else
	return FALSE;
#endif
/* normdisp, conddisp  */
    if (strEQ(name, "DISP_UNCATLG"))   /* normdisp, conddisp  DISP=UNCATALOG */
#ifdef __DISP_UNCATLG
        { *pval = __DISP_UNCATLG; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DISP_CATLG"))     /* normdisp, conddisp  DISP=CATALOG */
#ifdef __DISP_CATLG
        { *pval = __DISP_CATLG; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DISP_DELETE"))    /* normdisp, conddisp  DISP=DELETE */
#ifdef __DISP_DELETE
        { *pval = __DISP_DELETE; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DISP_KEEP"))      /* normdisp, conddisp  DISP=KEEP */
#ifdef __DISP_KEEP
        { *pval = __DISP_KEEP; return TRUE; }
#else
        return FALSE;
#endif
/* dsorg  */
    if (strEQ(name, "DSORG_unknown"))  /* dsorg  DSORG=UNKNOWN */
#ifdef __DSORG_unknown
        { *pval = __DSORG_unknown; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_VSAM"))     /* dsorg  DSORG=VSAM */
#ifdef __DSORG_VSAM
        { *pval = __DSORG_VSAM; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_GS"))       /* dsorg  DSORG=GS */
#ifdef __DSORG_GS
        { *pval = __DSORG_GS; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_PO"))       /* dsorg  DSORG=PO */
#ifdef __DSORG_PO
        { *pval = __DSORG_PO; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_POU"))      /* dsorg  DSORG=POU */
#ifdef __DSORG_POU
        { *pval = __DSORG_POU; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_DA"))       /* dsorg  DSORG=DA */
#ifdef __DSORG_DA
        { *pval = __DSORG_DA; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_DAU"))      /* dsorg  DSORG=DAU */
#ifdef __DSORG_DAU
        { *pval = __DSORG_DAU; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_PS"))       /* dsorg  DSORG=PS */
#ifdef __DSORG_PS
        { *pval = __DSORG_PS; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_PSU"))      /* dsorg  DSORG=PSU */
#ifdef __DSORG_PSU
        { *pval = __DSORG_PSU; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_IS"))       /* dsorg  DSORG=IS */
#ifdef __DSORG_IS
        { *pval = __DSORG_IS; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSORG_ISU"))      /* dsorg  DSORG=ISU */
#ifdef __DSORG_ISU
        { *pval = __DSORG_ISU; return TRUE; }
#else
        return FALSE;
#endif
/* recfm */
    if (strEQ(name, "RECFM_M"))        /* recfm  M */
#ifdef _M_
	{ *pval = _M_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_A"))        /* recfm  A */
#ifdef _A_
	{ *pval = _A_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_S"))        /* recfm  S */
#ifdef _S_
	{ *pval = _S_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_B"))        /* recfm  B */
#ifdef _B_
	{ *pval = _B_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_D"))        /* recfm  D */
#ifdef _D_
	{ *pval = _D_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_V"))        /* recfm  V */
#ifdef _V_
	{ *pval = _V_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_F"))        /* recfm  FIXED */
#ifdef _F_
	{ *pval = _F_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_U"))        /* recfm  U */
#ifdef _U_
	{ *pval = _U_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_FB"))       /* recfm  FIXED BLOCK */
#ifdef _FB_
	{ *pval = _FB_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_VB"))       /* recfm  VB */
#ifdef _VB_
	{ *pval = _VB_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_FBS"))      /* recfm  FBS */
#ifdef _FBS_
	{ *pval = _FBS_; return TRUE; }
#else
	return FALSE;
#endif
    if (strEQ(name, "RECFM_VBS"))      /* recfm  VBS */
#ifdef _VBS_
	{ *pval = _VBS_; return TRUE; }
#else
	return FALSE;
#endif
/* miscflags  */
    if (strEQ(name, "MISCFL_CLOSE"))   /* miscflags  CLOSE */
#ifdef __CLOSE
        { *pval = __CLOSE; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "MISCFL_RELEASE")) /* miscflags  RELEASE */
#ifdef __RELEASE
        { *pval = __RELEASE; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "MISCFL_PERM"))    /* miscflags  PERM */
#ifdef __PERM
        { *pval = __PERM; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "MISCFL_CONTIG"))  /* miscflags  CONTIG */
#ifdef __CONTIG
        { *pval = __CONTIG; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "MISCFL_ROUND"))   /* miscflags  ROUND */
#ifdef __ROUND
        { *pval = __ROUND; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "MISCFL_TERM"))    /* miscflags  TERM */
#ifdef __TERM
        { *pval = __TERM; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "MISCFL_DUMMY_DSN")) /* miscflags  DUMMY_DSN */
#ifdef __DUMMY_DSN
        { *pval = __DUMMY_DSN; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "MISCFL_HOLDQ"))   /* miscflags  HOLDQ */
#ifdef __HOLDQ
        { *pval = __HOLDQ; return TRUE; }
#else
        return FALSE;
#endif
/* vsam record organization  */
    if (strEQ(name, "VSAM_KS"))        /* vsam record organization  KS */
#ifdef __KS
        { *pval = __KS; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "VSAM_ES"))        /* vsam record organization  ES */
#ifdef __ES
        { *pval = __ES; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "VSAM_RR"))        /* vsam record organization  RR */
#ifdef __RR
        { *pval = __RR; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "VSAM_LS"))        /* vsam record organization  LS */
#ifdef __LS
        { *pval = __LS; return TRUE; }
#else
        return FALSE;
#endif
/* pds type attributes  */
    if (strEQ(name, "DSNT_HFS"))       /* pds type attributes  DSNT_HFS */
#ifdef __DSNT_HFS
        { *pval = __DSNT_HFS; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSNT_PIPE"))      /* pds type attributes  DSNT_PIPE */
#ifdef __DSNT_PIPE
        { *pval = __DSNT_PIPE; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSNT_PDS"))       /* pds type attributes  DSNT_PDS */
#ifdef __DSNT_PDS
        { *pval = __DSNT_PDS; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "DSNT_LIBRARY"))   /* pds type attributes  DSNT_LIBRARY */
#ifdef __DSNT_LIBRARY
        { *pval = __DSNT_LIBRARY; return TRUE; }
#else
        return FALSE;
#endif
/* path options */
    if (strEQ(name, "PATH_OCREAT"))    /* path options  PATH_OCREAT */
#ifdef __PATH_OCREAT
        { *pval = __PATH_OCREAT; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_OEXCL"))     /* path options  PATH_OEXCL */
#ifdef __PATH_OEXCL
        { *pval = __PATH_OEXCL; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_ONOCTTY"))   /* path options  PATH_ONOCTTY */
#ifdef __PATH_ONOCTTY
        { *pval = __PATH_ONOCTTY; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_OTRUNC"))    /* path options  PATH_OTRUNC */
#ifdef __PATH_OTRUNC
        { *pval = __PATH_OTRUNC; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_OAPPEND"))   /* path options  PATH_OAPPEND */
#ifdef __PATH_OAPPEND
        { *pval = __PATH_OAPPEND; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_ONONBLOCK")) /* path options  PATH_ONONBLOCK */
#ifdef __PATH_ONONBLOCK
        { *pval = __PATH_ONONBLOCK; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_ORDWR"))     /* path options  PATH_ORDWR */
#ifdef __PATH_ORDWR
        { *pval = __PATH_ORDWR; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_ORDONLY"))   /* path options  PATH_ORDONLY */
#ifdef __PATH_ORDONLY
        { *pval = __PATH_ORDONLY; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_OWRONLY"))   /* path options  PATH_OWRONLY */
#ifdef __PATH_OWRONLY
        { *pval = __PATH_OWRONLY; return TRUE; }
#else
        return FALSE;
#endif
/* path attributes  */
    if (strEQ(name, "PATH_SISUID"))    /* path attributes  PATH_SISUID */
#ifdef __PATH_SISUID
        { *pval = __PATH_SISUID; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SISGID"))    /* path attributes  PATH_SISGID */
#ifdef __PATH_SISGID
        { *pval = __PATH_SISGID; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIRUSR"))    /* path attributes  PATH_SIRUSR */
#ifdef __PATH_SIRUSR
        { *pval = __PATH_SIRUSR; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIWUSR"))    /* path attributes  PATH_SIWUSR */
#ifdef __PATH_SIWUSR
        { *pval = __PATH_SIWUSR; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIXUSR"))    /* path attributes  PATH_SIXUSR */
#ifdef __PATH_SIXUSR
        { *pval = __PATH_SIXUSR; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIRWXU"))    /* path attributes  PATH_SIRWXU */
#ifdef __PATH_SIRWXU
        { *pval = __PATH_SIRWXU; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIRGRP"))    /* path attributes  PATH_SIRGRP */
#ifdef __PATH_SIRGRP
        { *pval = __PATH_SIRGRP; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIWGRP"))    /* path attributes  PATH_SIWGRP */
#ifdef __PATH_SIWGRP
        { *pval = __PATH_SIWGRP; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIXGRP"))    /* path attributes  PATH_SIXGRP */
#ifdef __PATH_SIXGRP
        { *pval = __PATH_SIXGRP; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIRWXG"))    /* path attributes  PATH_SIRWXG */
#ifdef __PATH_SIRWXG
        { *pval = __PATH_SIRWXG; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIROTH"))    /* path attributes  PATH_SIROTH */
#ifdef __PATH_SIROTH
        { *pval = __PATH_SIROTH; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIWOTH"))    /* path attributes  PATH_SIWOTH */
#ifdef __PATH_SIWOTH
        { *pval = __PATH_SIWOTH; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIXOTH"))    /* path attributes  PATH_SIXOTH */
#ifdef __PATH_SIXOTH
        { *pval = __PATH_SIXOTH; return TRUE; }
#else
        return FALSE;
#endif
    if (strEQ(name, "PATH_SIRWXO"))    /* path attributes  PATH_SIRWXO */
#ifdef __PATH_SIRWXO
        { *pval = __PATH_SIRWXO; return TRUE; }
#else
        return FALSE;
#endif

/*
 * default fall through is FALSE
 */
    return FALSE;
}


#ifdef USE_PERLIO
static SV *
newFH(PerlIO *fp, char type) {
#else
static SV *
newFH(FILE *fp, char type) {
#endif
    SV *rv;
    GV **stashp, *gv = (GV *)NEWSV(0,0);
    HV *stash;
    IO *io;

    /* dTHR; */
    /* Find stash for VMS::Stdio.  We don't do this once at boot
     * to allow for possibility of threaded Perl with per-thread
     * symbol tables.  This code (through io = ...) is really
     * equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO),
     * with a little less overhead, and good exercise for me. :-) 
     */
    /*
     ** Well thanks Chuck :-) , er, s/VMS/OS390/g 8-)
     */
    stashp = (GV **)hv_fetch(PL_defstash,"OS390::",7,TRUE);
    if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
    if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
    stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE);
    if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
    if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();

    /* Set up GV to point to IO, and then take reference */
    gv_init(gv,stash,"__FH__",6,0);
    io = GvIOp(gv) = newIO();
    IoIFP(io) = fp;
    if (type != '<') IoOFP(io) = fp;
    IoTYPE(io) = type;
    rv = newRV((SV *)gv);
    SvREFCNT_dec(gv);
    return sv_bless(rv,stash);
}

int 
#ifdef _EXT
h2dyn_t(__dyn_t *ip, HV *hip, int free_flag) {
#else
h2dyn_t(struct __dyn_t *ip, HV *hip, int free_flag) {
#endif
    /*
     * __dyn_t structure Table 16, pp 218-220 C/C++ MVS Library Reference
     */
    HE * entry;
    I32 retlen;
    SV * hval;
    STRLEN len;
    char * key;
    int got_free = 0;
    int got_any  = 0;
    int i = 0;

    /* Iterate over hip setting *ip elements. */
        /* Strictly this "miscitems" is not char ** but char * instead. */
    (void)hv_iterinit(hip);
    while ((entry = hv_iternext(hip)))  {
        key = hv_iterkey(entry, &retlen); 
        while (*key == '_') { key++; }   /* This is where s/^_+// takes place. */
        hval  = hv_iterval(hip, entry);
             if (strEQ(key,"ddname"))     { ip -> __ddname = SvPV(hval,len);       got_any++; got_free++; }
        else if (strEQ(key,"dsname"))     { ip -> __dsname = SvPV(hval,len);       got_any++; got_free++; }
        else if (strEQ(key,"sysout") )    { ip -> __sysout = (char)SvIV(hval);     got_any++; }
        else if (strEQ(key,"sysoutname")) { ip -> __sysoutname = SvPV(hval,len);   got_any++; }
        else if (strEQ(key,"member"))     { ip -> __member = SvPV(hval,len);       got_any++; got_free++; }
        else if (strEQ(key,"status"))     { ip -> __status = (char)SvIV(hval);     got_any++; }
        else if (strEQ(key,"normdisp"))   { ip -> __normdisp = (char)SvIV(hval);   got_any++; got_free++; }
        else if (strEQ(key,"conddisp"))   { ip -> __conddisp = (char)SvIV(hval);   got_any++; }
        else if (strEQ(key,"unit"))       { ip -> __unit = SvPV(hval,len);         got_any++; }
        else if (strEQ(key,"volser"))     { ip -> __volser = SvPV(hval,len);       got_any++; }
        else if (strEQ(key,"dsorg"))      { ip -> __dsorg = (short)SvIV(hval);     got_any++; } 
        else if (strEQ(key,"alcunit"))    { ip -> __alcunit = (char)SvIV(hval);    got_any++; }
        else if (strEQ(key,"primary"))    { ip -> __primary = SvIV(hval);          got_any++; }
        else if (strEQ(key,"secondary"))  { ip -> __secondary = SvIV(hval);        got_any++; }
        else if (strEQ(key,"dirblk"))     { ip -> __dirblk = SvIV(hval);           got_any++; }
        else if (strEQ(key,"avgblk"))     { ip -> __avgblk = SvIV(hval);           got_any++; }
        else if (strEQ(key,"recfm"))      { ip -> __recfm  = (short)SvIV(hval);    got_any++; }
        else if (strEQ(key,"blksize"))    { ip -> __blksize = (short)SvIV(hval);   got_any++; }
        else if (strEQ(key,"lrecl"))      { ip -> __lrecl = (unsigned short)SvIV(hval); got_any++; }
        else if (strEQ(key,"volrefds"))   { ip -> __volrefds = SvPV(hval,len);     got_any++; }
        else if (strEQ(key,"dcbrefds"))   { ip -> __dcbrefds = SvPV(hval,len);     got_any++; }
        else if (strEQ(key,"dcbrefdd"))   { ip -> __dcbrefdd = SvPV(hval,len);     got_any++; }
        else if (strEQ(key,"misc_flags")) { ip -> __misc_flags = (unsigned char)SvIV(hval); got_any++; }
        else if (strEQ(key,"password"))   { ip -> __password = SvPV(hval,len);     got_any++; }
        else if (strEQ(key,"miscitems"))  { ip -> __miscitems = (char **)SvPV(hval,len);  got_any++; got_free++; }
        else if (strEQ(key,"infocode"))   { ip -> __infocode = (short)SvIV(hval);  got_any++; }
        else if (strEQ(key,"errcode"))    { ip -> __errcode = (short)SvIV(hval);   got_any++; }
        else if (strEQ(key,"storclass"))  { ip -> __storclass = SvPV(hval,len);    got_any++; }
        else if (strEQ(key,"mgntclass"))  { ip -> __mgntclass = SvPV(hval,len);    got_any++; }
        else if (strEQ(key,"dataclass"))  { ip -> __dataclass = SvPV(hval,len);    got_any++; }
        else if (strEQ(key,"recorg"))     { ip -> __recorg = (char)SvIV(hval);     got_any++; }
        else if (strEQ(key,"keyoffset"))  { ip -> __keyoffset = (short)SvIV(hval); got_any++; }
        else if (strEQ(key,"keylength"))  { ip -> __keylength = (short)SvIV(hval); got_any++; }
        else if (strEQ(key,"refdd"))      { ip -> __refdd = SvPV(hval,len);        got_any++; }
        else if (strEQ(key,"like"))       { ip -> __like = SvPV(hval,len);         got_any++; }
        else if (strEQ(key,"dsntype"))    { ip -> __dsntype = (char)SvIV(hval);    got_any++; }
        else if (strEQ(key,"pathname"))   { ip -> __pathname = SvPV(hval,len);     got_any++; got_free++; }
        else if (strEQ(key,"pathopts"))   { ip -> __pathopts = SvIV(hval);         got_any++; }
        else if (strEQ(key,"pathmode"))   { ip -> __pathmode = SvIV(hval);         got_any++; }
        else if (strEQ(key,"pathndisp"))  { ip -> __pathndisp = (char)SvIV(hval);  got_any++; got_free++; }
        else if (strEQ(key,"pathcdisp"))  { ip -> __pathcdisp = (char)SvIV(hval);  got_any++; }
        i++;
#ifdef WARN_DYN_T_KEY
        if (!free_flag && got_any != i) { 
            warn("h2dyn_t warning key '%s' not recognized.\n",key);
            got_any = i; /* avoid war-ning for more than one unrecognized key */
        }
#endif    /* WARN_DYN_T_KEY */
    }
    return(i);
}

/***************/
/*
 *******************************************************************
 ********* begin code borrowed from IBM's            ***************
 ********* B<C/C++ MVS Programming Guide>            ***************
 ********* Document number SCO9-2164-00              ***************
 ********* copyright 1995 IBM                        ***************
 ********* APPENDIX 1.8 Appendix H.                  ***************
 ********* which comes with a note that reads:       ***************
 ********* "This information is included to aid you  ***************
 *********  in such a task and is B<not> programming ***************
 *********  interface information."                  ***************
 ********* Among other possible problems it does not ***************
 ********* return ALIAS members (sigh).              ***************
 *********  - caveat scriptor.                       ***************
 *******************************************************************
 */

/*
 * NODE: a pointer to this structure is returned from the call to _pds_mem().
 * It is a linked list of character arrays - each array contains a member
 * name. Each next pointer points * to the next member, except the last
 * next member which points to NULL.
 */
#define NAMELEN 8      /* Length of an MVS member name */
typedef struct node {
                      struct node *next;
                      char name[NAMELEN+1];
                    } NODE, *NODE_PTR;

/*
 * NODE_PTR _pds_mem(const char *pds, int *member_number, int alias_flag):
 *
 * pds must be a fully qualified pds name, for example,
 * ID.PDS.DATASET * returns a * pointer to a linked list of
 * nodes.  Each node contains a member of the * pds and a
 * pointer to the next node.  If no members exist, or the
 * pds is the name of a sequential file, the pointer
 * is NULL.
 *
 * Note:  Warnings will apear on STDERR if pds is the name 
 * of a sequential file.
 */
/*
 * RECORD:
 * each record of a pds will be read into one of these structures.
 * The first 2 bytes is the record length, which is put into 'count',
 * the remaining 254 bytes are put into rest.
 * Hence, each record is 256 bytes long.
 */
#define RECLEN  254
typedef struct {
    unsigned short int count;
    char rest[RECLEN];
} RECORD;

/*
 * static int gen_node(NODE_PTR *node, RECORD *rec, NODE_PTR *last_ptr, int * count, int want_alias);
 */
static char *pm_add_name(NODE_PTR *node, char *name, NODE_PTR *last_ptr);

/* the heart of the beast */
NODE_PTR _pds_mem(const char *pds, int *member_number, int alias_flag) {
    FILE *fp;
    int bytes;
    NODE_PTR node, last_ptr;
    RECORD rec;
    int list_end;
    int member_count = -1;
    char *qual_pds;
    char filename[MAXOSFILENAME+1];
    fldata_t fileinfo;
    int rc;
    /*
     * initialize the linked list
     */
    node = NULL;
    last_ptr = NULL;
/*
 * Open the pds in binary read mode. The PDS directory will be read one
 * record at a time until either the end of the directory or end-of-file
 * is detected. Call up gen_node() with every record read, to add member
 * names to the linked list
 */
    fp = fopen(pds,"rb");
    if (fp == NULL) {
        warn("fopen(%s,\"rb\") returned NULL.\n",pds);
        return((NODE_PTR)(-1));
    }
    rc = fldata(fp, filename, &fileinfo);
    if (rc != 0) {
        warn("fldata() failed on %s.\n",pds);
        return((NODE_PTR)(-1));
    }
    if (fileinfo.__dsorgPO != 1) {
#ifndef NO_WARN_IF_NOT_PDS
        warn("Data set %s [filename %s] does not appear to be a PDS.\n",
                pds,filename);
#endif
        return((NODE_PTR)(-1));
    }
    if (fileinfo.__dsorgPDSdir != 1) {
#ifndef NO_WARN_IF_NOT_PDS
        warn("Data set %s [filename %s] does not appear to be a PDS directory.\n",
                pds, filename);
#endif
        return((NODE_PTR)(-1));
    }
    member_count = 0;
    do {
        bytes = fread(&rec, 1, sizeof(rec), fp);
        if ((bytes != sizeof(rec)) && !feof(fp)) {
            warn("fread(): failed in %s, line %d\nExpected to read %d bytes but read %d bytes\n",
                __FILE__,__LINE__,sizeof(rec), bytes);
#ifdef H_PERL
            croak("EFREAD\n");
#endif
            return((NODE_PTR)(-1));
        }
 /*       list_end = gen_node(&node, &rec, &last_ptr, &member_count, 0); */
        list_end = gen_node(&node, &rec, &last_ptr, &member_count, alias_flag);
    } while (!feof(fp) && !list_end);
    fclose(fp);
    *member_number = member_count;
    return(node);
}
/*
 * GEN_NODE() processes the record passed. The main loop scans through the
 * record until it has read at least rec->count bytes, or a directory end
 * marker is detected.
 *
 * Each record has the form:
 *
 * +------------+------+------+------+------+----------------+
 * + # of bytes _Member_Member_......_Member_  Unused        +
 * + in record  _  1   _  2   _      _  n   _                +
 * +------------+------+------+------+------+----------------+
 *  _--count---__-----------------rest-----------------------_
 *  (Note that the number stored in count includes its own
 *   two bytes)
 *
 * And, each member has the form:
 *
 * +--------+-------+----+-----------------------------------+
 * + Member _TTR    _info_                                   +
 * + Name   _       _byte_  User Data TTRN's (halfwords)     +
 * + 8 bytes_3 bytes_    _                                   +
 * +--------+-------+----+-----------------------------------+
 */
#define TTRLEN 3      /* The TTR's are 3 bytes long */
/*
 * bit 0 of the info-byte is '1' if the member is an alias,
 * 0 otherwise. ALIAS_MASK is used to extract this information
 */
#define ALIAS_MASK ((unsigned int) 0x80)
/*
 * The number of user data half-words is in bits 3-7 of the info byte.
 * SKIP_MASK is used to extract this information.  Since this number is
 * in half-words, it needs to be double to obtain the number of bytes.
 */
#define SKIP_MASK ((unsigned int) 0x1F)

static int gen_node(NODE_PTR *node, RECORD *rec, NODE_PTR *last_ptr, int *member_count, int want_alias) {
    char *ptr, *name;
    int skip, count = 2;
    int member_number;
    unsigned int info_byte, alias, ttrn;
    char ttr[TTRLEN];
    int list_end = 0;
    member_number = *member_count;
    ptr = rec->rest;
    while(count < rec->count) {
        /*
         * 8 hex FF's mark the end of the directory
         */
        if (!memcmp(ptr,"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF",NAMELEN)) {
            list_end = 1;
            break;
        }
        /* member name */
        name = ptr;
        ptr += NAMELEN;
        /* ttr */
        memcpy(ttr,ptr,TTRLEN);
        ptr += TTRLEN;
        /* info_byte */
        info_byte = (unsigned int) (*ptr);
        alias = info_byte & ALIAS_MASK;
        switch (want_alias) {
	case 0:
            if (!alias) {
                 pm_add_name(node,name,last_ptr);
                 member_number++;
            }
            break;
	case 1:
            if (alias) {
                 pm_add_name(node,name,last_ptr);
                 member_number++;
            }
            break;
	case 2:
            pm_add_name(node,name,last_ptr);
            member_number++;
            break;
        }
        skip = (info_byte & SKIP_MASK) * 2 + 1;
        ptr += skip;
        count += (TTRLEN + NAMELEN + skip);
    }
    *member_count = member_number;
    return(list_end);
}
/*
 * ADD_NAME: Add a new member name to the linked node. The new member is
 * added to the end so that the original ordering is maintained.
 */
static char *pm_add_name(NODE_PTR *node, char *name, NODE_PTR *last_ptr) {
    NODE_PTR newnode;
    /*
     * malloc space for the new node
     */
    newnode = (NODE_PTR)malloc(sizeof(NODE));
    if (newnode == NULL) {
        warn("malloc failed for %d bytes\n",sizeof(NODE));
#ifdef H_PERL
        croak("ENONMEM\n");
#endif
        return(NULL);
    }
    /* copy the name into the node and NULL terminate it */
    memcpy(newnode->name,name,NAMELEN);
    newnode->name[NAMELEN] = '\0';
    newnode->next = NULL;
    /*
     * add the new node to the linked list
     */
    if (*last_ptr != NULL) {
        (*last_ptr)->next = newnode;
        *last_ptr = newnode;
    }
    else {
        *node = newnode;
        *last_ptr = newnode;
    }
    return(newnode->name);
}

/*
 *******************************************************************
 ********* end code borrowed from IBM's              ***************
 ********* B<C/C++ MVS Programming Guide>            ***************
 *******************************************************************
 */
/***************/

MODULE = OS390::Stdio  PACKAGE = OS390::Stdio

void
constant(name)
	char * name
	PROTOTYPE: $
	CODE:
	IV i;
	if (constant(name, &i))
	    ST(0) = sv_2mortal(newSViv(i));
	else
	    ST(0) = &PL_sv_undef;

void
dsname_level(fp)
	FILE * fp
	PROTOTYPE: $
	CODE:
	    char vmsdef[8], es[8], sep;
	    unsigned long int retsts;
	    /* catalogs and VTOCS are tough :-} */
	    croak("dsname_level() not yet implemented.\n");
	    if (fsync(fileno(fp))) { ST(0) = &PL_sv_undef; }
	    else                   { clearerr(fp); ST(0) = &PL_sv_yes; }

SV *
dynalloc(dyn_t_hash_ref)
	SV * dyn_t_hash_ref
	PROTOTYPE: $
	INIT:
	    HV * myhash;
	    __dyn_t dip;
	    int rc;
	    if ( dyn_t_hash_ref != &PL_sv_undef) {
		/* valid hash ref? */
		if ( SvROK(dyn_t_hash_ref) ) {
		    if ( SvTYPE(SvRV(dyn_t_hash_ref)) != SVt_PVHV ) {
		        /* it is not a hashref */
		        warn("dynalloc() requires a hash reference");
	                XSRETURN_UNDEF;
		    }
		}
		else {
		    warn("dynalloc() requires a hash reference");
	            XSRETURN_UNDEF;
		}
	    } 
	    else {
	        warn("dynalloc() called with undefined value.\n");
	        XSRETURN_UNDEF;
	    }
	CODE:
	    dyninit( &dip );
	    myhash = (HV *)SvRV(dyn_t_hash_ref);
	    rc = h2dyn_t( &dip, myhash, 0 );
	    ST(0) = sv_newmortal();
	    if ( rc ) {
	        if (dynalloc(&dip) == 0) { 
	            ST(0) = &PL_sv_yes;
	        }
	        else { 
	            warn("dynalloc() failed with error code %hX, info code %hX",
                          dip.__errcode, dip.__infocode);
	            ST(0) = &PL_sv_undef;
	        }
	    }
	    else {
	        warn("dynalloc() unable to initialize struct __dyn_t");
	        ST(0) = &PL_sv_undef;
	    }

SV *
dynfree(dyn_t_hash_ref)
	SV * dyn_t_hash_ref
	PROTOTYPE: $
	INIT:
	    HV * myhash;
	    __dyn_t dip;
	    int rc;
	    if ( dyn_t_hash_ref != &PL_sv_undef) {
		/* valid hash ref? */
		if ( SvROK(dyn_t_hash_ref) ) {
		    if ( SvTYPE(SvRV(dyn_t_hash_ref)) != SVt_PVHV ) {
		        /* it is not a hashref */
		        warn("dynfree() requires a hash reference");
	                XSRETURN_UNDEF;
		    }
		}
		else {
		    warn("dynfree() requires a hash reference");
	            XSRETURN_UNDEF;
		}
	    } 
	    else {
	        warn("dynfree() called with undefined value.\n");
	        XSRETURN_UNDEF;
	    }
	CODE:
	    dyninit( &dip );
	    myhash = (HV *)SvRV(dyn_t_hash_ref);
	    rc = h2dyn_t( &dip, myhash, 1 );
	    ST(0) = sv_newmortal();
	    if ( rc ) {
	        if (dynfree(&dip) == 0) { 
	            ST(0) = &PL_sv_yes;
	        }
	        else { 
	            warn("dynfree() failed with error code %hX, info code %hX",
                          dip.__errcode, dip.__infocode);
	            ST(0) = &PL_sv_undef;
	        }
	    }
	    else {
	        warn("dynfree() unable to initialize struct __dyn_t");
	        ST(0) = &PL_sv_undef;
	    }

void
flush(fp)
	FILE * fp
	PROTOTYPE: $
	CODE:
	    if (fflush(fp)) { ST(0) = &PL_sv_undef; }
	    else            { clearerr(fp); ST(0) = &PL_sv_yes; }

void
forward(fp)
	FILE * fp
	PROTOTYPE: $
	CODE:
	    ST(0) = fseek(fp, 0L, SEEK_END) ? &PL_sv_undef : &PL_sv_yes;

char *
get_dcb(sv)
 	SV * sv
	PROTOTYPE: $
	INIT:
	    /*
	     * distillation of the fldata_t structure 
	     * Table 17, pg 310 C/C++ MVS Library Reference
	     */
	    char recfm[12] = ""; /* "F","V","U","S","Blk","ASA","M" */
	    char dsorg[42] = ""; /* "PO", "PDSmem","PDSdir","PS",  "Concat",
                                      "Mem","Hiper", "Temp",  "VSAM","HFS" */
	    char openmode[17] = ""; /* "TEXT","BINARY","RECORD" */
	    char modeflag[22] = ""; /* "APPEND","READ","UPDATE","WRITE" 
                                       + combos */
	    /* unsigned int reserve2; */
	    char device[11] = ""; /* "DISK","TERMINAL","PRINTER","TAPE",
	                             "TDQ", "DUMMY",   "OTHER",  "MEMORY",
                                     "MSGFILE","HFS", "HIPERSPACE" */
	    char vsamtype[10] = ""; /* "NOTVSAM","ESDS","KSDS","RRDS",
	                               "ESDS_PATH","KSDS_PATH" */
	    /* unsigned long reserve4; */
	    int i;
	    char filename[MAXOSFILENAME+1];
	    fldata_t fileinfo;
	    FILE *	fp;
	    STRLEN len;
	    int needs_closing = 0;
	    if ( sv != &PL_sv_undef) {
		if ( SvROK(sv) ) { /* a reference */
		    if ( SvTYPE(SvRV(sv)) == SVt_PVGV ) { /* valid filehandle ref? */
#ifdef USE_PERLIO
	                fp = PerlIO_findFILE(IoIFP(sv_2io(ST(0))));
#else
	                fp = IoIFP(sv_2io(ST(0)));
#endif
	            }
                    else {
	                XSRETURN_UNDEF;
                    }
	        }
 	        else {
	            if (SvTYPE(sv) == SVt_PV) { /* if a plain scalar then try to fopen() */
	                fp = fopen(SvPV(sv,len),"r");
	                if (fp != Nullfp) {
	                    needs_closing = 1;
                        }
                        else {
	                    XSRETURN_UNDEF;
                        }
                    }
                    else {
	                XSRETURN_UNDEF;
                    }
	        }
	    }
	    else {
	        XSRETURN_UNDEF;
	    }
	CODE:
	    for (i=0; i<24; i++) {
	        ST(i) = sv_newmortal();
	    }
	    if ((fldata(fp,filename,&fileinfo)) == 0) {
                sv_setpv(ST(0),"filename");
                sv_setpv(ST(1),filename);
	        /* "F","V","U","S","Blk","ASA","M" */
	        if (fileinfo.__recfmF)
	            strcat(recfm,"F");
	        if (fileinfo.__recfmS)
	            strcat(recfm,"S");
	        if (fileinfo.__recfmU)
	            strcat(recfm,"U");
	        if (fileinfo.__recfmBlk)
	            strcat(recfm,"Blk");
	        if (fileinfo.__recfmASA)
	            strcat(recfm,"ASA");
                sv_setpv(ST(2),"recfm");
                sv_setpv(ST(3),recfm);
	        /* "PO", "PDSmem","PDSdir","PS",  "Concat",
                   "Mem","Hiper", "Temp",  "VSAM","HFS" */
	        if (fileinfo.__dsorgPO)
	            strcat(dsorg,"PO");
	        if (fileinfo.__dsorgPDSmem)
	            strcat(dsorg,"PDSmem");
	        if (fileinfo.__dsorgPDSdir)
	            strcat(dsorg,"PDSdir");
	        if (fileinfo.__dsorgPS)
	            strcat(dsorg,"PS");
	        if (fileinfo.__dsorgConcat)
	            strcat(dsorg,"Concat");
	        if (fileinfo.__dsorgMem)
	            strcat(dsorg,"Mem");
	        if (fileinfo.__dsorgHiper)
	            strcat(dsorg,"Hiper");
	        if (fileinfo.__dsorgTemp)
	            strcat(dsorg,"Temp");
	        if (fileinfo.__dsorgVSAM)
	            strcat(dsorg,"VSAM");
	        if (fileinfo.__dsorgHFS)
	            strcat(dsorg,"HFS");
                sv_setpv(ST(4),"dsorg");
                sv_setpv(ST(5),dsorg);
	        /* "TEXT","BINARY","RECORD" */
	        if (fileinfo.__openmode == __TEXT)
	            strcat(openmode,"TEXT");
	        if (fileinfo.__openmode == __BINARY)
	            strcat(openmode,"BINARY");
	        if (fileinfo.__openmode == __RECORD)
	            strcat(openmode,"RECORD");
                sv_setpv(ST(6),"openmode");
                sv_setpv(ST(7),openmode);
	        /* "APPEND","READ","UPDATE","WRITE" + combos */
	        if ((fileinfo.__modeflag & __APPEND) == __APPEND)
	            strcat(modeflag,"APPEND");
	        if ((fileinfo.__modeflag & __READ) == __READ)
	            strcat(modeflag,"READ");
	        if ((fileinfo.__modeflag & __UPDATE) == __UPDATE)
	            strcat(modeflag,"UPDATE");
	        if ((fileinfo.__modeflag & __WRITE) == __WRITE)
	            strcat(modeflag,"WRITE");
                sv_setpv(ST(8),"modeflag");
                sv_setpv(ST(9),modeflag);
	        /* "DISK","TERMINAL","PRINTER","TAPE",
	           "TDQ", "DUMMY",   "OTHER",  "MEMORY",
                   "MSGFILE","HFS", "HIPERSPACE" */
	        if (fileinfo.__device == __DISK)
	            strcat(device,"DISK");
	        if (fileinfo.__device == __TERMINAL)
	            strcat(device,"TERMINAL");
	        if (fileinfo.__device == __PRINTER)
	            strcat(device,"PRINTER");
	        if (fileinfo.__device == __TAPE)
	            strcat(device,"TAPE");
	        if (fileinfo.__device == __TDQ)
	            strcat(device,"TDQ");
	        if (fileinfo.__device == __DUMMY)
	            strcat(device,"DUMMY");
	        if (fileinfo.__device == __OTHER)
	            strcat(device,"OTHER");
	        if (fileinfo.__device == __MEMORY)
	            strcat(device,"MEMORY");
                sv_setpv(ST(10),"device");
                sv_setpv(ST(11),device);
	        /* unsigned long */
                sv_setpv(ST(12),"blksize");
                sv_setiv(ST(13),fileinfo.__blksize);
	        /* unsigned long */
                sv_setpv(ST(14),"maxreclen");
                sv_setiv(ST(15),fileinfo.__maxreclen);
	        /* "NOTVSAM","ESDS","KSDS","RRDS",
	           "ESDS_PATH","KSDS_PATH" */
	        if (fileinfo.__vsamtype == __NOTVSAM)
	            strcat(vsamtype,"NOTVSAM");
	        if (fileinfo.__vsamtype == __ESDS)
	            strcat(vsamtype,"ESDS");
	        if (fileinfo.__vsamtype == __KSDS)
	            strcat(vsamtype,"KSDS");
	        if (fileinfo.__vsamtype == __RRDS)
	            strcat(vsamtype,"RRDS");
	        if (fileinfo.__vsamtype == __ESDS_PATH)
	            strcat(vsamtype,"ESDS_PATH");
	        if (fileinfo.__vsamtype == __KSDS_PATH)
	            strcat(vsamtype,"KSDS_PATH");
                sv_setpv(ST(16),"vsamtype");
                sv_setpv(ST(17),vsamtype);
	        /* unsigned long */
                sv_setpv(ST(18),"vsamkeylen");
                sv_setiv(ST(19),fileinfo.__vsamkeylen);
	        /* unsigned long */
                sv_setpv(ST(20),"vsamRKP");
                sv_setiv(ST(21),fileinfo.__vsamRKP);
                sv_setpv(ST(22),"dsname");
                sv_setpv(ST(23),fileinfo.__dsname);
	        if (needs_closing)
	            fclose(fp);
	        XSRETURN(24);
            }
            else {
	        ST(0) = &PL_sv_undef;
            }

char *
getname(sv)
 	SV * sv
	PROTOTYPE: $
	INIT:
	    int needs_closing = 0;
	    FILE * fp;
	    char filename[MAXOSFILENAME+10];
	    fldata_t fileinfo;
	    STRLEN len;
	    if ( sv != &PL_sv_undef) {
		if ( SvROK(sv) ) { /* a reference */
		    if ( SvTYPE(SvRV(sv)) == SVt_PVGV ) { /* valid filehandle ref? */
#ifdef USE_PERLIO
	                fp = PerlIO_findFILE(IoIFP(sv_2io(ST(0))));
#else
	                fp = IoIFP(sv_2io(ST(0)));
#endif
	            }
                    else {
	                XSRETURN_UNDEF;
                    }
	        }
 	        else {
	            if (SvTYPE(sv) == SVt_PV) { /* if a plain scalar then try to fopen() */
	                fp = fopen(SvPV(sv,len),"r");
	                if (fp != Nullfp) {
	                    needs_closing = 1;
                        }
                        else {
	                    XSRETURN_UNDEF;
                        }
                    }
                    else {
	                XSRETURN_UNDEF;
                    }
	        }
	    }
	    else {
	        XSRETURN_UNDEF;
	    }
	CODE:
	    ST(0) = sv_newmortal();
	    if ((fldata(fp,filename,&fileinfo)) == 0) {
                sv_setpv(ST(0),filename);
            }
            else {
	        ST(0) = &PL_sv_undef;
            }
	    if (needs_closing)
	        fclose(fp);

void
mvsopen(name,mode)
	char * name
	char * mode
	PROTOTYPE: @
	CODE:
	    FILE * fp;
#ifdef USE_PERLIO
	    PerlIO * pio_fp;
              SV *fh;
#endif

	    fp = fopen(name,mode);
#ifdef USE_PERLIO
	    if (fp != Null(FILE *)) {
              pio_fp = PerlIO_importFILE(fp,mode);
              fh = newFH(pio_fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>'))));
	      ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
	    }
	    else { ST(0) = &PL_sv_undef; }
#else
	    if (fp != Nullfp) {
	      SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>'))));
	      ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
	    }
	    else { ST(0) = &PL_sv_undef; }
#endif

int
mvswrite(fp,buffer,count)
	FILE * fp
	char * buffer
	unsigned int count
	PROTOTYPE: @
	CODE:
	    /* use sizeof(char) til we get wchar_t's here && buffer */
	    RETVAL = fwrite((void *)buffer, sizeof(char), count, fp);
	OUTPUT:
	    RETVAL

char * 
pds_mem(pds,...)
	char * pds
	PROTOTYPE: @
	CODE:
	    NODE_PTR my_mem;
	    NODE_PTR next_mem;
	    char * member_name;
	    char * blank;
	    int i = 0;
	    int alias_flag;
	    if (items > 2) croak("too many args");
	    if (items == 2) {
	        if (!SvIOK(ST(1))) croak("alias flag must be an integer");
	        alias_flag = SvIV(ST(1));
	    }
	    if (alias_flag < 0) 
	        alias_flag = 0;
	    if (alias_flag > 2)
	        alias_flag = 0;
	    my_mem = _pds_mem(pds,&i,alias_flag);
	    next_mem = my_mem;
	    if (next_mem == (NODE_PTR)(-1)) {
	        ST(0) = sv_newmortal();
	        ST(0) = &PL_sv_undef;
	    }
	    else if (next_mem == NULL) {
	        ST(0) = sv_newmortal();
	        sv_setpv(ST(0),"");
	        XSRETURN(1);  
	    }
	    else {
                /* extend perl return ST-ack by an appropriate amount */
                if (i >= 0)
		    EXTEND(sp,i+2);
                /*
                 * put linked list names onto ST array, sans blank characters.
                 * free the mallocs too.
                 */
	        while (next_mem != NULL) {
		    member_name = my_mem->name;
		    blank = strchr(member_name,' ');
                    if (blank != NULL)
		        *blank = '\0';
                    PUSHs(sv_2mortal(newSVpvn(member_name,strlen(member_name))));
	            next_mem = my_mem->next;
	            free(my_mem);
	            my_mem = next_mem;
	        }
	        XSRETURN(i+2);
	    }

void
remove(name)
	char *name
	PROTOTYPE: $
	CODE:
	    ST(0) = remove(name) ? &PL_sv_undef : &PL_sv_yes;

void
resetpos(fp)
	FILE* fp
	PROTOTYPE: $
	CODE:
	    ST(0) = fseek(fp, 0L, SEEK_CUR) ? &PL_sv_undef : &PL_sv_yes;

void
rewind(fp)
	FILE* fp
	PROTOTYPE: $
	CODE:
	    /*
	     *  Unfortunately rewind() does not appear 
             *  to work on OE R2.5.  errno indicates only:
	     **  "EDC5129I No such file or directory."
	     * rewind(fp);
	     **   if (errno) printf("%s\n",strerror(errno));
	     * ST(0) = errno ? &PL_sv_undef : &PL_sv_yes;
	     *  hence we use fseek() instead.
             */
	    ST(0) = fseek(fp, 0L, SEEK_SET) ? &PL_sv_undef : &PL_sv_yes;

int
smf_record(smf_record_type,smf_record_subtype,smf_record)
	int smf_record_type
	int smf_record_subtype
	char * smf_record
	PROTOTYPE: @
	INIT:
	    int smf_record_length,rc;
	CODE:
            smf_record_length = strlen(smf_record);
	    ST(0) = sv_newmortal();
	    rc = __smf_record(smf_record_type,smf_record_subtype,smf_record_length,smf_record);
	    switch (rc) {
	        case 0:
		    ST(0) = &PL_sv_yes;
		    break;
		case EINVAL:
		    warn("smf_record() value specified of length '%d' was incorrect",smf_record_length);
	            ST(0) = &PL_sv_undef;
		    break;
		case ENOMEM:
		    warn("smf_record() not enough storage to complete __smf_record() call");
	            ST(0) = &PL_sv_undef;
		    break;
		case EPERM:
		    warn("smf_record() The calling process is not permitted access to the BPX.SMF facility class");
	            ST(0) = &PL_sv_undef;
		    break;
		case EMVSERR:
		    warn("smf_record() The SMF service returned '%d', __errno2 = %08x",rc,__errno2());
	            ST(0) = &PL_sv_undef;
		    break;
		default:
		    warn("smf_record() The SMF service returned '%d'",rc);
	            ST(0) = &PL_sv_undef;
		    break;
	    }

SV *
svc99(S99struc_hash_ref)
	SV * S99struc_hash_ref
	PROTOTYPE: $
	INIT:
	    HV * my99hash;
	    __S99parms parmstring;
	    HE * entry;
	    I32 retlen;
	    SV * hval;
	    STRLEN len;
	    char * key;
	    int got_any = 0;
	    int warnings = 0;
	    int i = 0;
	    int j = 0;
	    I32 num_tu = 0;
	    char *tu[OS390_STDIO_SVC99_TEXT_UNITS] = { 
	    	"", "", "", "", "", "", "", "", "", "", "", "",
	    	"", "", "", "", "", "", "", "", "", "", "", ""
	                                             };
	    if ( S99struc_hash_ref != &PL_sv_undef) {
		/* valid hash ref? */
		if ( SvROK(S99struc_hash_ref) ) {
		    if ( SvTYPE(SvRV(S99struc_hash_ref)) != SVt_PVHV ) {
		        /* it is not a hashref */
		        warn("svc99() requires a hash reference");
	                XSRETURN_UNDEF;
		    }
		}
		else {
		    warn("svc99() requires a hash reference");
	            XSRETURN_UNDEF;
		}
	    } 
	    else {
	        warn("svc99() called with undefined value.\n");
	        XSRETURN_UNDEF;
	    }
	CODE:
	    my99hash = (HV *)SvRV(S99struc_hash_ref);
	    /* Initialize parmstring to '0'. */
	    memset(&parmstring,0,sizeof(parmstring)); 
	    /* Iterate over my99hash setting *parmstring elements. */
	    (void)hv_iterinit(my99hash);
	    while ((entry = hv_iternext(my99hash)))  {
	        /* This is where s/^_+// takes place. */
	        key = hv_iterkey(entry, &retlen); 
	        while (*key == '_') { key++; }
	        hval  = hv_iterval(my99hash, entry);
	        if (strEQ(key,"S99VERB"))    { parmstring.__S99VERB = (unsigned char)SvIV(hval);        got_any++; }
	   else if (strEQ(key,"S99FLAG1"))   { parmstring.__S99FLAG1 = (unsigned short)SvIV(hval);      got_any++; }
	   /* note that FLAG2
	    * "can only be filled in by APF authorized programs" */
	   else if (strEQ(key,"S99FLAG2"))   { parmstring.__S99FLAG2 = (unsigned short)SvIV(hval);      got_any++; }
	   else if (strEQ(key,"S99RBLN"))    { parmstring.__S99RBLN = (unsigned char)SvIV(hval);        got_any++; }
	   else if (strEQ(key,"S99S99X"))    { parmstring.__S99S99X = (void * )SvPV(hval,len);          got_any++; }
	    /* Treat "S99INFO" and "S99ERROR" as read only for now, 
	     * do not even attempt to assign. */
	    /* "S99TXTPP" should be an array ref and we ought to loop 
	     * through an AV: */
	   else if (strEQ(key,"S99TXTPP"))   {
	       if ((!SvROK(hval))) {
	           warn("value of S99TXTPP was not a reference.");
	           warnings++;
	           XSRETURN_UNDEF;
	       }
	       else if ( (SvTYPE(SvRV(hval)) != SVt_PVAV) ) {
	           warn("value of S99TXTPP was not an array reference.");
	           warnings++;
	           XSRETURN_UNDEF;
	       }
	       num_tu = av_len((AV *)SvRV(hval));
	       /* Arrary too large?  Is there a clever way not to do this? */
	       if (  num_tu >= (OS390_STDIO_SVC99_TEXT_UNITS - 1) ) {
	           warn("array reference passed into S99TXTPP too large, %d elements.",(num_tu+1));
	           warnings++;
	           XSRETURN_UNDEF;
	       }
	       for ( j=0; j<=num_tu; j++ ) {
	           tu[j] = (char *)SvPV(*av_fetch((AV *)SvRV(hval), j, 0),len);
	       }
	       /* signal end */
	       tu[num_tu] = (char *)((long unsigned) ( tu[num_tu] ) | OS390_STDIO_SVC99_MASK );
	       parmstring.__S99TXTPP = (void * )tu; 
	       got_any++;
	   }
	   /* rbx identifier           */
/*        else if (strEQ(key,"S99EID"))    { rbxstring -> __S99EID = (char * )SvPV(hval,len);          got_any++; }
 *      __S99EVER;  __S99EOPTS; __S99ESUBP; __S99EKEY; __S99EMGSV; __S99ENMSG; __S99ECPPL; __reserved;
 *      __S99ERES; __S99ERCO; __S99ERCF; __S99EWRC; __S99EMSGP; __S99EERR; __S99EINFO; __reserv2;
 */
	   i++;
	   if (got_any != i) {
	       warn("svc99() warning key '%s' not recognized.\n",key);
	       XSRETURN_UNDEF;
	       warnings++;
	       got_any = i; /* avoid war-ning for more than one unrecognized key */
	   }
	    }
	    ST(0) = sv_newmortal();
	    if ( !warnings ) {
	        if (svc99(&parmstring) == 0) { 
	            ST(0) = &PL_sv_yes;
	        }
	        else { 
	            warn("svc99() failed with error code %hX, info code %hX", 
                          parmstring.__S99ERROR, parmstring.__S99INFO);
	            ST(0) = &PL_sv_undef;
	        }
	    }
	    else {
	        warn("svc99() unable to initialize struct __S99parms");
	        ST(0) = &PL_sv_undef;
	    }

char *
sysdsnr(name)
	char *	name
	PROTOTYPE: $
	CODE:
	    FILE * fp;
	    fp = fopen(name,"r");
	    if (fp != Nullfp && (fclose(fp) == 0)) { ST(0) = &PL_sv_yes; }
	    else { ST(0) = &PL_sv_undef; }

char *
tmpnam()
	PROTOTYPE:
	CODE:
	    char fname[L_tmpnam];
	    ST(0) = sv_newmortal();
	    if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname);

char *
vol_ser(fp)
	FILE *	fp
	PROTOTYPE: $
	CODE:
	    /* catalogs and VTOCS are tough :-} */
	    croak("vol_ser() not yet implemented.\n");
	    ST(0) = sv_newmortal();
	    ST(0) = &PL_sv_undef;

void
vsamdelrec(fp)
	FILE *	fp
	PROTOTYPE: $
	CODE:
	    int rc = fdelrec(fp);
	    ST(0) = rc ? &PL_sv_undef : &PL_sv_yes;

void
vsamlocate(fp, key, key_len, options)
	FILE *	fp
	void* key
	unsigned int key_len
	int options
	PROTOTYPE: @
	CODE:
	    int rc = flocate(fp, key, key_len, options);
	    ST(0) = rc ? &PL_sv_undef : &PL_sv_yes;

int
vsamupdate(fp,buffer,size)
	FILE *	fp
	void* buffer
	size_t size
	PROTOTYPE: @
	CODE:
	    RETVAL = fupdate(buffer, size, fp);
	OUTPUT:
	    RETVAL