At 12:50 PM -0400 4/19/02, [EMAIL PROTECTED] wrote:
>Craig Berry wrote:
>
>> Otherwise this will very likely not get fixed before 5.8.0.
>> I think I'll go ahead and submit my patch that gets perldoc
>> working since it makes things no worse than they already were.
>
>Your work is much appreciated. I have perl@16005 recently
>(slowly) downloaded and would like to pitch in. So, let's
>see the proposed patch. I take it then that Charles Lanes'
>torture test is not a *.t file in the perl distribution?
OK, there are actually 2, mutually exclusive possible patches here.
Perhaps folks can help me figure out which is better. The idea
behind both of them is that a child process created by system(),
backticks, or opening a pipe may need to get to the SYS$COMMAND of
the parent. This is the case with perldoc, where the pager (such as
TYPE/PAGE) can't do its thing if there is no SYS$COMMAND or if
SYS$COMMAND points to _NLA0: as we currently have it doing.
The first approach is simpler and merely consists of omitting the
input file argument to lib$spawn. This causes the child to inherit
SYS$INPUT and SYS$COMMAND from the parent, but SYS$INPUT will be
explicitly overridden in vmspipe.com. The docs say nothing about
SYS$COMMAND but observation shows that this is what happens. This
approach depends on trusting the docs when they say nothing will be
read from the parent's input when the input file argument is omitted.
I suspect this may not always be true or we wouldn't have been
explicitly passing _NLA0: in the first place.
The second approach passes SYS$COMMAND's equivalence name as a symbol
to the subprocess where the symbol can then be used to define a
logical. This is the same approach we are already using to define
the other PPFs for the subprocess; we just never dealt with
SYS$COMMAND before.
Both approaches seem to get perldoc working again. Let me know what
ya'll think.
--- vms/vms.c;-0 Tue Apr 9 14:26:06 2002
+++ vms/vms.c Thu Apr 18 12:28:40 2002
@@ -2200,7 +2200,7 @@
safe_popen(pTHX_ char *cmd, char *in_mode, int *psts)
{
static int handler_set_up = FALSE;
- unsigned long int sts, flags=1; /* nowait - gnu c doesn't allow &1 */
+ unsigned long int sts, flags = CLI$M_NOWAIT;
unsigned int table = LIB$K_CLI_GLOBAL_SYM;
int j, wait = 0;
char *p, mode[10], symbol[MAX_DCL_SYMBOL+1], *vmspipe;
@@ -2471,7 +2471,11 @@
info->next=open_pipes; /* prepend to list */
open_pipes=info;
_ckvmssts(sys$setast(1));
- _ckvmssts(lib$spawn(&vmspipedsc, &nl_desc, &nl_desc, &flags,
+ /* Omit arg 2 (input file) so the child will get the parent's SYS$INPUT
+ * and SYS$COMMAND. vmspipe.com will redefine SYS$INPUT, but we'll still
+ * have SYS$COMMAND if we need it.
+ */
+ _ckvmssts(lib$spawn(&vmspipedsc, 0, &nl_desc, &flags,
0, &info->pid, &info->completion,
0, popen_completion_ast,info,0,0,0));
[end of patch #1]
--- vms/vms.c;-0 Tue Apr 9 14:26:06 2002
+++ vms/vms.c Thu Apr 18 14:38:35 2002
@@ -2154,6 +2154,7 @@
fprintf(fp,"$ pif perl_popen_in .nes. \"\" then
perl_define/user/name_attributes=confine sys$input 'perl_popen_in'\n");
fprintf(fp,"$ pif perl_popen_err .nes. \"\" then
perl_define/user/name_attributes=confine sys$error 'perl_popen_err'\n");
fprintf(fp,"$ pif perl_popen_out .nes. \"\" then perl_define sys$output
'perl_popen_out'\n");
+ fprintf(fp,"$ pif perl_popen_syscmd .nes. \"\" then perl_define sys$command
+'perl_popen_syscmd'\n");
fprintf(fp,"$! --- build command line to get max possible length\n");
fprintf(fp,"$c=perl_popen_cmd0\n");
fprintf(fp,"$c=c+perl_popen_cmd1\n");
@@ -2164,6 +2165,7 @@
fprintf(fp,"$ perl_del/symbol/global perl_popen_in\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_err\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_out\n");
+ fprintf(fp,"$ perl_del/symbol/global perl_popen_syscmd\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd0\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd1\n");
fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd2\n");
@@ -2200,7 +2202,7 @@
safe_popen(pTHX_ char *cmd, char *in_mode, int *psts)
{
static int handler_set_up = FALSE;
- unsigned long int sts, flags=1; /* nowait - gnu c doesn't allow &1 */
+ unsigned long int sts, flags = CLI$M_NOWAIT;
unsigned int table = LIB$K_CLI_GLOBAL_SYM;
int j, wait = 0;
char *p, mode[10], symbol[MAX_DCL_SYMBOL+1], *vmspipe;
@@ -2219,6 +2221,7 @@
$DESCRIPTOR(d_sym_in ,"PERL_POPEN_IN");
$DESCRIPTOR(d_sym_out,"PERL_POPEN_OUT");
$DESCRIPTOR(d_sym_err,"PERL_POPEN_ERR");
+ $DESCRIPTOR(d_sym_syscmd,"PERL_POPEN_SYSCMD");
if (!head_PLOC) store_pipelocs(aTHX); /* at least TRY to use a static vmspipe
file */
@@ -2445,6 +2448,10 @@
d_symbol.dsc$w_length = strlen(symbol);
_ckvmssts(lib$set_symbol(&d_sym_out, &d_symbol, &table));
+ my_trnlnm("SYS$COMMAND", symbol, 0);
+ d_symbol.dsc$w_length = strlen(symbol);
+ _ckvmssts(lib$set_symbol(&d_sym_syscmd, &d_symbol, &table));
+
p = vmscmd->dsc$a_pointer;
while (*p && *p != '\n') p++;
*p = '\0'; /* truncate on \n */
--- vms/vmspipe.com;-0 Sun Apr 7 11:21:10 2002
+++ vms/vmspipe.com Thu Apr 18 14:38:36 2002
@@ -9,6 +9,7 @@
$ pif perl_popen_in .nes. "" then perl_define/user/name_attributes=confine sys$input
'perl_popen_in'
$ pif perl_popen_err .nes. "" then perl_define/user/name_attributes=confine sys$error
'perl_popen_err'
$ pif perl_popen_out .nes. "" then perl_define sys$output 'perl_popen_out'
+$ pif perl_popen_syscmd .nes. "" then perl_define sys$command 'perl_popen_syscmd'
$! --- build command line to get max possible length
$c=perl_popen_cmd0
$c=c+perl_popen_cmd1
@@ -23,6 +24,7 @@
$ perl_del/symbol/global perl_popen_in
$ perl_del/symbol/global perl_popen_err
$ perl_del/symbol/global perl_popen_out
+$ perl_del/symbol/global perl_popen_syscmd
$ perl_on
$ 'c
$ perl_exit '$STATUS'
[end of patch #2]
--
____________________________________________
Craig A. Berry
mailto:[EMAIL PROTECTED]
"Literary critics usually know what they're
talking about. Even if they're wrong."
-- Perl creator Larry Wall
