#include <uicdef.h>
#include <stsdef.h>
#include <rmsdef.h>
-#include <smgdef.h>
#if __CRTL_VER >= 70000000 /* FIXME to earliest version */
#include <efndef.h>
#define NO_EFN EFN$C_ENF
(char *outspec, const char *inspec, int *output_cnt, const int * utf8_fl)
{
int count;
-int scnt;
int utf8_flag;
utf8_flag = 0;
if (scnt == 4) {
unsigned int c1, c2;
scnt = sscanf(inspec, "%2x%2x", &c1, &c2);
- outspec[0] == c1 & 0xff;
- outspec[1] == c2 & 0xff;
+ outspec[0] = c1 & 0xff;
+ outspec[1] = c2 & 0xff;
if (scnt > 1) {
(*output_cnt) += 2;
count += 4;
*root = NULL;
*root_len = 0;
*dir = NULL;
- *dir_len;
*name = NULL;
*name_len = 0;
*ext = NULL;
item_list[devspec].component = NULL;
/* root is a special case, adding it to either the directory or
- * the device components will probalby complicate things for the
+ * the device components will probably complicate things for the
* callers of this routine, so leave it separate.
*/
item_list[rootspec].itmcode = FSCN$_ROOT;
for (curtab = 0; tabvec[curtab]; curtab++) {
if (!str$case_blind_compare(tabvec[curtab],&crtlenv)) {
if (!ivenv && !secure) {
- char *eq, *end;
+ char *eq;
int i;
if (!environ) {
ivenv = 1;
if (!ivsym && !secure) {
unsigned short int deflen = LNM$C_NAMLENGTH;
struct dsc$descriptor_d eqvdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
- /* dynamic dsc to accomodate possible long value */
+ /* dynamic dsc to accommodate possible long value */
_ckvmssts_noperl(lib$sget1_dd(&deflen,&eqvdsc));
retsts = lib$get_symbol(&lnmdsc,&eqvdsc,&eqvlen,0);
if (retsts & 1) {
static char *__my_getenv_eqv = NULL;
char uplnm[LNM$C_NAMLENGTH+1], *cp2, *eqv;
unsigned long int idx = 0;
- int trnsuccess, success, secure, saverr, savvmserr;
+ int success, secure, saverr, savvmserr;
int midx, flags;
SV *tmpsv;
# define CLI$M_TRUSTED 0x40 /* Missing from VAXC headers */
#endif
unsigned long int defflags = CLI$M_NOWAIT | CLI$M_NOKEYPAD | CLI$M_TRUSTED;
- unsigned long int mbxbufsiz, flags, retsts, subpid = 0, substs = 0, wakect = 0;
+ unsigned long int mbxbufsiz, flags, retsts, subpid = 0, substs = 0;
long int i;
bool have_sym = FALSE, have_lnm = FALSE;
struct dsc$descriptor_s tmpdsc = {6,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
/* fixup barenames that are directories for internal use.
* There have been problems with the consistent handling of UNIX
* style directory names when routines are presented with a name that
- * has no directory delimitors at all. So this routine will eventually
+ * has no directory delimiters at all. So this routine will eventually
* fix the issue.
*/
static char * fixup_bare_dirnames(const char * name)
/* mp_do_kill_file
- * A little hack to get around a bug in some implemenation of remove()
+ * A little hack to get around a bug in some implementation of remove()
* that do not know how to delete a directory
*
* Delete any file to which user has control access, regardless of whether
int
Perl_my_kill(int pid, int sig)
{
- dTHX;
int iss;
unsigned int code;
#define sys$sigprc SYS$SIGPRC
default:
return SS$_ABORT; /* punt */
}
-
- return SS$_ABORT; /* Should not get here */
}
{
pInfo info;
unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT;
- int sts, did_stuff, need_eof, j;
+ int sts, did_stuff, j;
/*
* Flush any pending i/o, but since we are in process run-down, be
info = open_pipes;
while (info) {
- int need_eof;
_ckvmssts_noperl(sys$setast(0));
if (info->in && !info->in->shut_on_empty) {
_ckvmssts_noperl(sys$qio(0,info->in->chan_in,IO$_WRITEOF,0,0,0,
{
pInfo i = open_pipes;
int iss;
- int sts;
- pXpipe x;
info->completion &= 0x0FFFFFFF; /* strip off "control" field */
closed_list[closed_index].pid = info->pid;
static unsigned long int setup_cmddsc(pTHX_ const char *cmd, int check_img, int *suggest_quote, struct dsc$descriptor_s **pvmscmd);
static void vms_execfree(struct dsc$descriptor_s *vmscmd);
-
-/*
- we actually differ from vmstrnenv since we use this to
- get the RMS IFI to check if SYS$OUTPUT and SYS$ERROR *really*
- are pointing to the same thing
-*/
-
-static unsigned short
-popen_translate(pTHX_ char *logical, char *result)
-{
- int iss;
- $DESCRIPTOR(d_table,"LNM$PROCESS_TABLE");
- $DESCRIPTOR(d_log,"");
- struct _il3 {
- unsigned short length;
- unsigned short code;
- char * buffer_addr;
- unsigned short *retlenaddr;
- } itmlst[2];
- unsigned short l, ifi;
-
- d_log.dsc$a_pointer = logical;
- d_log.dsc$w_length = strlen(logical);
-
- itmlst[0].code = LNM$_STRING;
- itmlst[0].length = 255;
- itmlst[0].buffer_addr = result;
- itmlst[0].retlenaddr = &l;
-
- itmlst[1].code = 0;
- itmlst[1].length = 0;
- itmlst[1].buffer_addr = 0;
- itmlst[1].retlenaddr = 0;
-
- iss = sys$trnlnm(0, &d_table, &d_log, 0, itmlst);
- if (iss == SS$_NOLOGNAM) {
- iss = SS$_NORMAL;
- l = 0;
- }
- if (!(iss&1)) lib$signal(iss);
- result[l] = '\0';
-/*
- logicals for PPFs have a 4 byte prefix ESC+NUL+(RMS IFI)
- strip it off and return the ifi, if any
-*/
- ifi = 0;
- if (result[0] == 0x1b && result[1] == 0x00) {
- memmove(&ifi,result+2,2);
- strcpy(result,result+4);
- }
- return ifi; /* this is the RMS internal file id */
-}
-
static void pipe_infromchild_ast(pPipe p);
/*
/* things like terminals and mbx's don't need this filter */
if (fd && fstat(fd,&s) == 0) {
- unsigned long dviitm = DVI$_DEVCHAR, devchar;
+ unsigned long devchar;
char device[65];
unsigned short dev_len;
struct dsc$descriptor_s d_dev;
pPLOC p;
AV *av = 0;
SV *dirsv;
- GV *gv;
char *dir, *x;
char *unixdir;
char temp[NAM$C_MAXRSS+1];
struct dsc$descriptor_s customization_dsc;
struct dsc$descriptor_s device_name_dsc;
const char * cptr;
- char * tptr;
char customization[200];
char title[40];
pInfo info = NULL;
unsigned short p_chan;
int n;
unsigned short iosb[4];
- struct item_list_3 items[2];
const char * cust_str =
"DECW$TERMINAL.iconName:\tPerl Dbg\nDECW$TERMINAL.title:\t%40s\n";
struct dsc$descriptor_s d_mbx1 = {sizeof mbx1, DSC$K_DTYPE_T,
title[n] = *cptr;
n++;
if (n == 39) {
- title[39] == 0;
+ title[39] = 0;
break;
}
cptr++;
static I32 my_pclose_pinfo(pTHX_ pInfo info) {
unsigned long int retsts;
- int done, iss, n;
- int status;
+ int done, n;
pInfo next, last;
/* If we were writing to a subprocess, insure that someone reading from
$DESCRIPTOR(obj_file_dsc,"FILE");
char *vmsname;
char *rslt;
-unsigned long int jpicode = JPI$_UIC, type = ACL$C_FILE;
+unsigned long int jpicode = JPI$_UIC;
int aclsts, fndsts, rnsts = -1;
unsigned int ctx = 0;
struct dsc$descriptor_s fildsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
{
/* Is the source and dest both in VMS format */
/* if the source is a directory, then need to fileify */
- /* and dest must be a directory or non-existant. */
+ /* and dest must be a directory or non-existent. */
char * vms_dst;
int sts;
}
/* The source must be a file specification */
- vms_dir_file = PerlMem_malloc(VMS_MAXRSS);
- if (vms_dir_file == NULL)
- _ckvmssts_noperl(SS$_INSFMEM);
-
ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL);
if (ret_str == NULL) {
PerlMem_free(vms_dst);
static char *
int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
{
- unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0;
+ unsigned long int dirlen, retlen, hasfilename = 0;
char *cp1, *cp2, *lastdir;
char *trndir, *vmsdir;
unsigned short int trnlnm_iter_count;
char *esa, *esal, term, *cp;
char *my_esa;
int my_esa_len;
- unsigned long int sts, cmplen, haslower = 0;
- unsigned int nam_fnb;
- char * nam_type;
+ unsigned long int cmplen, haslower = 0;
struct FAB dirfab = cc$rms_fab;
rms_setup_nam(savnam);
rms_setup_nam(dirnam);
/* then pathify is simple */
if (!decc_efs_charset) {
- /* Have to deal with traiing '.dir' or extra '.' */
+ /* Have to deal with trailing '.dir' or extra '.' */
/* that should not be there in legacy mode, but is */
char * lastdot;
{
char *dirend, *cp1, *cp3, *tmp;
const char *cp2;
- int devlen, dirlen, retlen = VMS_MAXRSS;
- int expand = 1; /* guarantee room for leading and trailing slashes */
+ int dirlen;
unsigned short int trnlnm_iter_count;
int cmp_rslt;
if (utf8_fl != NULL)
cp1 = cp1 + 9;
cp2 = cp2 + 5;
if (spec[6] != '\0') {
- cp1[9] == '/';
+ cp1[9] = '/';
cp1++;
cp2++;
}
cp1 = cp1 + 4;
cp2 = cp2 + 12;
if (spec[12] != '\0') {
- cp1[4] == '/';
+ cp1[4] = '/';
cp1++;
cp2++;
}
struct dsc$descriptor_s dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
char * esa, * esal, * rsa, * rsal;
-char *vms_delim;
int dir_flag;
int unixlen;
char * nextslash;
int len;
int cmp;
-int islnm;
unixptr += 4;
nextslash = strchr(unixptr, '/');
return SS$_NORMAL;
}
}
+ return 0;
}
lastslash = unixptr + unixlen;
}
- /* Watch out for traiing ".." after last slash, still a directory */
+ /* Watch out for trailing ".." after last slash, still a directory */
if ((lastslash[1] == '.')&&(lastslash[2] == '.')&&(lastslash[3] == '\0')) {
lastslash = unixptr + unixlen;
}
&vs_len);
while (sts == 0) {
- char * strt;
int cmp;
/* A logical name must be a directory or the full
else {
if (dotdir_seen) {
/* Perl wants an empty directory here to tell the difference
- * between a DCL commmand and a filename
+ * between a DCL command and a filename
*/
*vmsptr++ = '[';
*vmsptr++ = ']';
cmp = strncmp(vmspath, "dev", 4);
if (cmp == 0) {
sts = slash_dev_special_to_vms(unixptr, vmspath, vmspath_len);
- if (sts = SS$_NORMAL)
+ if (sts == SS$_NORMAL)
return SS$_NORMAL;
}
}
(const char *path, char *rslt, int dir_flag, int * utf8_flag) {
char *dirend;
char *lastdot;
- char *vms_delim;
register char *cp1;
const char *cp2;
unsigned long int infront = 0, hasdir = 1;
{ return do_tovmsspec(path,buf,1,utf8_fl); }
/*{{{ char *int_tovmspath(char *path, char *buf, const int *)*/
-/* Internal routine for use with out an explict context present */
+/* Internal routine for use with out an explicit context present */
static char * int_tovmspath(const char *path, char *buf, int * utf8_fl) {
char * ret_spec, *pathified;
*/
had_version = strchr(item, ';');
/*
- * Only return device and directory specs, if the caller specifed either.
+ * Only return device and directory specs, if the caller specified either.
*/
had_device = strchr(item, ':');
had_directory = (isunix || NULL != strchr(item, '[')) || (NULL != strchr(item, '<'));
PerlMem_free(unixwild);
PerlMem_free(lcres);
return 1;
- ellipsis = nextell;
}
} /* end of trim_unixpath() */
{
struct dsc$descriptor_s name_desc;
union uicdef uic;
- unsigned long int status, sts;
+ unsigned long int sts;
__pwdcache = __passwd_empty;
if (!fillpasswd(aTHX_ name, &__pwdcache)) {
struct tm *tm_p;
if (gmtime_emulation_type == 0) {
- int dstnow;
time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between */
/* results of calls to gmtime() and localtime() */
/* for same &base */
struct tm *
Perl_my_gmtime(pTHX_ const time_t *timep)
{
- char *p;
time_t when;
struct tm *rsltmp;
#endif
static int
-is_null_device(name)
- const char *name;
+is_null_device(const char *name)
{
if (decc_bug_devnull != 0) {
if (strncmp("/dev/null", name, 9) == 0)
{
char *vmsin, * vmsout, *esa, *esal, *esa_out, *esal_out,
*rsa, *rsal, *rsa_out, *rsal_out, *ubf;
- unsigned long int i, sts, sts2;
+ unsigned long int sts;
int dna_len;
struct FAB fab_in, fab_out;
struct RAB rab_in, rab_out;
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
Newx(fspec, VMS_MAXRSS, char);
if (fspec == NULL) _ckvmssts(SS$_INSFMEM);
- if (SvTYPE(mysv) == SVt_PVGV) {
+ if (isGV_with_GP(mysv)) {
if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),fspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
dXSARGS;
char *inspec, *outspec, *inp, *outp;
int date_flag;
- struct dsc$descriptor indsc = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
- outdsc = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
- unsigned long int sts;
SV *mysv;
IO *io;
STRLEN n_a;
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
Newx(inspec, VMS_MAXRSS, char);
- if (SvTYPE(mysv) == SVt_PVGV) {
+ if (isGV_with_GP(mysv)) {
if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),inspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = sv_2mortal(newSViv(0));
}
mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
Newx(outspec, VMS_MAXRSS, char);
- if (SvTYPE(mysv) == SVt_PVGV) {
+ if (isGV_with_GP(mysv)) {
if (!(io = GvIOp(mysv)) || !PerlIO_getname(IoIFP(io),outspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = sv_2mortal(newSViv(0));
dXSARGS;
char ultimate_name[NAM$C_MAXRSS+1], work_name[NAM$C_MAXRSS*8 + 1],
workbuff[NAM$C_MAXRSS*1 + 1];
- int total_namelen = 3, counter, num_entries;
+ int counter, num_entries;
/* ODS-5 ups this, but we want to be consistent, so... */
int max_name_len = 39;
AV *in_array = (AV *)SvRV(ST(0));
/* Test to see if SvPVX_const(tmpglob) ends with a VMS */
/* path delimiter of ':>]', if so, then the old behavior has */
- /* obviously been specificially requested */
+ /* obviously been specifically requested */
fname = SvPVX_const(tmpglob);
fname_len = strlen(fname);
if (mode) {
*mode = statbuf.old_st_mode;
}
- return 0;
}
}
+ PerlMem_free(temp_fspec);
+ PerlMem_free(fileified);
return sts;
}
char * vms_spec;
char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
- int file_len;
mode_t my_mode;
/* Fall back to fid_to_name */
} else {
/* Now for some hacks to deal with backwards and forward */
- /* compatibilty */
+ /* compatibility */
if (!decc_efs_charset) {
/* 1. ODS-2 mode wants to do a syntax only translation */
{
char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
- int file_len;
/* Fall back to fid_to_name */
/* Start of DECC RTL Feature handling */
-static int sys_trnlnm
- (const char * logname,
- char * value,
- int value_len)
-{
- const $DESCRIPTOR(table_dsc, "LNM$FILE_DEV");
- const unsigned long attr = LNM$M_CASE_BLIND;
- struct dsc$descriptor_s name_dsc;
- int status;
- unsigned short result;
- struct itmlst_3 itlst[2] = {{value_len, LNM$_STRING, value, &result},
- {0, 0, 0, 0}};
-
- name_dsc.dsc$w_length = strlen(logname);
- name_dsc.dsc$a_pointer = (char *)logname;
- name_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
- name_dsc.dsc$b_class = DSC$K_CLASS_S;
-
- status = sys$trnlnm(&attr, &table_dsc, &name_dsc, 0, itlst);
-
- if ($VMS_STATUS_SUCCESS(status)) {
-
- /* Null terminate and return the string */
- /*--------------------------------------*/
- value[result] = 0;
- }
-
- return status;
-}
-
-static int sys_crelnm
- (const char * logname,
- const char * value)
-{
- int ret_val;
- const char * proc_table = "LNM$PROCESS_TABLE";
- struct dsc$descriptor_s proc_table_dsc;
- struct dsc$descriptor_s logname_dsc;
- struct itmlst_3 item_list[2];
-
- proc_table_dsc.dsc$a_pointer = (char *) proc_table;
- proc_table_dsc.dsc$w_length = strlen(proc_table);
- proc_table_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
- proc_table_dsc.dsc$b_class = DSC$K_CLASS_S;
-
- logname_dsc.dsc$a_pointer = (char *) logname;
- logname_dsc.dsc$w_length = strlen(logname);
- logname_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
- logname_dsc.dsc$b_class = DSC$K_CLASS_S;
-
- item_list[0].buflen = strlen(value);
- item_list[0].itmcode = LNM$_STRING;
- item_list[0].bufadr = (char *)value;
- item_list[0].retlen = NULL;
-
- item_list[1].buflen = 0;
- item_list[1].itmcode = 0;
-
- ret_val = sys$crelnm
- (NULL,
- (const struct dsc$descriptor_s *)&proc_table_dsc,
- (const struct dsc$descriptor_s *)&logname_dsc,
- NULL,
- (const struct item_list_3 *) item_list);
-
- return ret_val;
-}
/* C RTL Feature settings */
{
int status;
int s;
- char* str;
char val_str[10];
#if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
const unsigned long int jpicode1 = JPI$_CASE_LOOKUP_PERM;
/* Allow an exception to bring Perl into the VMS debugger */
vms_debug_on_exception = 0;
- status = sys_trnlnm("PERL_VMS_EXCEPTION_DEBUG", val_str, sizeof(val_str));
+ status = simple_trnlnm("PERL_VMS_EXCEPTION_DEBUG", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
/* Debug unix/vms file translation routines */
vms_debug_fileify = 0;
- status = sys_trnlnm("PERL_VMS_FILEIFY_DEBUG", val_str, sizeof(val_str));
+ status = simple_trnlnm("PERL_VMS_FILEIFY_DEBUG", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
/* This should really be fixed, but for now, set up a feature to */
/* enable it so that the impact can be studied. */
vms_bug_stat_filename = 0;
- status = sys_trnlnm("PERL_VMS_BUG_STAT_FILENAME", val_str, sizeof(val_str));
+ status = simple_trnlnm("PERL_VMS_BUG_STAT_FILENAME", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
/* Create VTF-7 filenames from Unicode instead of UTF-8 */
vms_vtf7_filenames = 0;
- status = sys_trnlnm("PERL_VMS_VTF7_FILENAMES", val_str, sizeof(val_str));
+ status = simple_trnlnm("PERL_VMS_VTF7_FILENAMES", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
/* unlink all versions on unlink() or rename() */
vms_unlink_all_versions = 0;
- status = sys_trnlnm
+ status = simple_trnlnm
("PERL_VMS_UNLINK_ALL_VERSIONS", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
/* Dectect running under GNV Bash or other UNIX like shell */
#if __CRTL_VER >= 70300000 && !defined(__VAX)
gnv_unix_shell = 0;
- status = sys_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str));
+ status = simple_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
gnv_unix_shell = 1;
set_feature_default("DECC$EFS_CASE_PRESERVE", 1);
/* PCP mode requires creating /dev/null special device file */
decc_bug_devnull = 0;
- status = sys_trnlnm("DECC_BUG_DEVNULL", val_str, sizeof(val_str));
+ status = simple_trnlnm("DECC_BUG_DEVNULL", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
/* UNIX directory names with no paths are broken in a lot of places */
decc_dir_barename = 1;
- status = sys_trnlnm("DECC_DIR_BARENAME", val_str, sizeof(val_str));
+ status = simple_trnlnm("DECC_DIR_BARENAME", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
#endif
#else
- status = sys_trnlnm
+ status = simple_trnlnm
("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
}
#ifndef __VAX
- status = sys_trnlnm("DECC$EFS_CASE_PRESERVE", val_str, sizeof(val_str));
+ status = simple_trnlnm("DECC$EFS_CASE_PRESERVE", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
}
#endif
- status = sys_trnlnm("DECC$FILENAME_UNIX_REPORT", val_str, sizeof(val_str));
+ status = simple_trnlnm("DECC$FILENAME_UNIX_REPORT", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_filename_unix_report = 1;
}
}
- status = sys_trnlnm("DECC$FILENAME_UNIX_ONLY", val_str, sizeof(val_str));
+ status = simple_trnlnm("DECC$FILENAME_UNIX_ONLY", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_filename_unix_report = 1;
}
}
- status = sys_trnlnm("DECC$FILENAME_UNIX_NO_VERSION", val_str, sizeof(val_str));
+ status = simple_trnlnm("DECC$FILENAME_UNIX_NO_VERSION", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_filename_unix_no_version = 1;
}
}
- status = sys_trnlnm("DECC$READDIR_DROPDOTNOTYPE", val_str, sizeof(val_str));
+ status = simple_trnlnm("DECC$READDIR_DROPDOTNOTYPE", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
#endif
/* USE POSIX/DCL Exit codes - Recommended, but needs to default to */
- /* for strict backward compatibilty */
- status = sys_trnlnm
+ /* for strict backward compatibility */
+ status = simple_trnlnm
("PERL_VMS_POSIX_EXIT", val_str, sizeof(val_str));
if ($VMS_STATUS_SUCCESS(status)) {
val_str[0] = _toupper(val_str[0]);
https://perl5.git.perl.org / perl5.git / blobdiff