# define prv$v_sysprv prv$r_prvdef_bits0.prv$v_sysprv
#endif
+#if defined(NEED_AN_H_ERRNO)
+dEXT int h_errno;
+#endif
struct itmlst_3 {
unsigned short int buflen;
info = open_pipes;
while (info) {
- _ckvmssts(SYS$SETAST(0));
+ int need_eof;
+ _ckvmssts(sys$setast(0));
need_eof = info->mode != 'r' && !info->done;
- _ckvmssts(SYS$SETAST(1));
+ _ckvmssts(sys$setast(1));
if (need_eof) {
if (pipe_eof(info->fp, 1) & 1) did_stuff = 1;
}
did_stuff = 0;
info = open_pipes;
while (info) {
- _ckvmssts(SYS$SETAST(0));
+ _ckvmssts(sys$setast(0));
if (!info->done) { /* Tap them gently on the shoulder . . .*/
sts = sys$forcex(&info->pid,0,&abort);
if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts(sts);
did_stuff = 1;
}
- _ckvmssts(SYS$SETAST(1));
+ _ckvmssts(sys$setast(1));
info = info->next;
}
if (did_stuff) sleep(1); /* wait for them to respond */
info = open_pipes;
while (info) {
- _ckvmssts(SYS$SETAST(0));
+ _ckvmssts(sys$setast(0));
if (!info->done) { /* We tried to be nice . . . */
sts = sys$delprc(&info->pid,0);
if (!(sts&1) && sts != SS$_NONEXPR) _ckvmssts(sts);
info->done = 1; /* so my_pclose doesn't try to write EOF */
}
- _ckvmssts(SYS$SETAST(1));
+ _ckvmssts(sys$setast(1));
info = info->next;
}
/* If we were writing to a subprocess, insure that someone reading from
* the mailbox gets an EOF. It looks like a simple fclose() doesn't
* produce an EOF record in the mailbox. */
- _ckvmssts(SYS$SETAST(0));
+ _ckvmssts(sys$setast(0));
need_eof = info->mode != 'r' && !info->done;
- _ckvmssts(SYS$SETAST(1));
+ _ckvmssts(sys$setast(1));
if (need_eof) pipe_eof(info->fp,0);
PerlIO_close(info->fp);
else waitpid(info->pid,(int *) &retsts,0);
/* remove from list of open pipes */
- _ckvmssts(SYS$SETAST(0));
+ _ckvmssts(sys$setast(0));
if (last) last->next = info->next;
else open_pipes = info->next;
- _ckvmssts(SYS$SETAST(1));
+ _ckvmssts(sys$setast(1));
Safefree(info);
return retsts;
{
char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1];
$DESCRIPTOR(defdsc,".EXE");
+ $DESCRIPTOR(defdsc2,".");
$DESCRIPTOR(resdsc,resspec);
struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL;
imgdsc.dsc$a_pointer = s;
imgdsc.dsc$w_length = wordbreak - s;
retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags);
+ if (!(retsts&1)) {
+ _ckvmssts(lib$find_file_end(&cxt));
+ retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,0,&flags);
if (!(retsts & 1) && *s == '$') {
+ _ckvmssts(lib$find_file_end(&cxt));
imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--;
retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags);
+ if (!(retsts&1)) {
_ckvmssts(lib$find_file_end(&cxt));
+ retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,0,&flags);
+ }
+ }
}
+ _ckvmssts(lib$find_file_end(&cxt));
+
if (retsts & 1) {
+ FILE *fp;
s = resspec;
while (*s && !isspace(*s)) s++;
*s = '\0';
+
+ /* check that it's really not DCL with no file extension */
+ fp = fopen(resspec,"r","ctx=bin,shr=get");
+ if (fp) {
+ char b[4] = {0,0,0,0};
+ read(fileno(fp),b,4);
+ isdcl = isprint(b[0]) && isprint(b[1]) && isprint(b[2]) && isprint(b[3]);
+ fclose(fp);
+ }
+ if (check_img && isdcl) return RMS$_FNF;
+
if (cando_by_name(S_IXUSR,0,resspec)) {
New(402,VMScmd.dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char);
+ if (!isdcl) {
strcpy(VMScmd.dsc$a_pointer,"$ MCR ");
+ } else {
+ strcpy(VMScmd.dsc$a_pointer,"@");
+ }
strcat(VMScmd.dsc$a_pointer,resspec);
if (rest) strcat(VMScmd.dsc$a_pointer,rest);
VMScmd.dsc$w_length = strlen(VMScmd.dsc$a_pointer);