summaryrefslogtreecommitdiff
path: root/vms
diff options
context:
space:
mode:
Diffstat (limited to 'vms')
-rw-r--r--vms/descrip_mms.template7
-rw-r--r--vms/ext/DCLsym/Makefile.PL2
-rw-r--r--vms/ext/Stdio/Makefile.PL2
-rw-r--r--vms/ext/Stdio/Stdio.pm4
-rw-r--r--vms/ext/Stdio/Stdio.xs1
-rw-r--r--vms/gen_shrfls.pl24
-rw-r--r--vms/genconfig.pl2
-rw-r--r--vms/perlvms.pod8
-rw-r--r--vms/perly_c.vms2
-rw-r--r--vms/test.com12
-rw-r--r--vms/vms.c93
-rw-r--r--vms/vmsish.h1
-rw-r--r--vms/vmspipe.com6
13 files changed, 104 insertions, 60 deletions
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index c34be75e0a..35f66762ef 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -1211,6 +1211,11 @@ cleanlis :
- If F$Search("*.CPP").nes."" Then Delete/NoConfirm/Log *.CPP;*
- If F$Search("*.Map").nes."" Then Delete/NoConfirm/Log *.Map;*
+cleantest :
+ - If F$Search("[.t]Perl.").nes."" Then Delete/NoConfirm/Log [.t]Perl.;*
+ - If F$Search("[.t]VMSPIPE.COM").nes."" Then Delete/NoConfirm/Log [.t]VMSPIPE.COM;*
+ - If F$Search("[.t]Echo.exe").nes."" Then Delete/NoConfirm/Log [.t]Echo.exe;*
+
tidy : cleanlis
- If F$Search("[...]*.Opt;-1").nes."" Then Purge/NoConfirm/Log [...]*.Opt
- If F$Search("[...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [...]*$(O)
@@ -1247,7 +1252,7 @@ tidy : cleanlis
- If F$Search("[.x2p]*.com;-1").nes."" Then Purge/NoConfirm/Log [.x2p]*.com
- If F$Search("[.lib.pod]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*.com
-clean : tidy
+clean : tidy cleantest
- @make_ext "$(dynamic_ext)" "$(MINIPERL_EXE)" "$(MMS)" clean
- If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
- If F$Search("[...]*$(O);*") .nes."" Then Delete/NoConfirm/Log [...]*$(O);*
diff --git a/vms/ext/DCLsym/Makefile.PL b/vms/ext/DCLsym/Makefile.PL
index 84ab2be2b5..28e2fa3758 100644
--- a/vms/ext/DCLsym/Makefile.PL
+++ b/vms/ext/DCLsym/Makefile.PL
@@ -1,4 +1,4 @@
use ExtUtils::MakeMaker;
WriteMakefile( 'VERSION_FROM' => 'DCLsym.pm',
- 'MAN3PODS' => ' ');
+ 'MAN3PODS' => {});
diff --git a/vms/ext/Stdio/Makefile.PL b/vms/ext/Stdio/Makefile.PL
index f5599f8a96..4e17a48082 100644
--- a/vms/ext/Stdio/Makefile.PL
+++ b/vms/ext/Stdio/Makefile.PL
@@ -1,5 +1,5 @@
use ExtUtils::MakeMaker;
WriteMakefile( 'VERSION_FROM' => 'Stdio.pm',
- 'MAN3PODS' => ' ', # pods will be built later
+ 'MAN3PODS' => {}, # pods will be built later
);
diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm
index b51f2c9f15..446b0785e1 100644
--- a/vms/ext/Stdio/Stdio.pm
+++ b/vms/ext/Stdio/Stdio.pm
@@ -134,7 +134,7 @@ This package C<ISA> IO::File, so that you can call IO::File
methods on the handles returned by C<vmsopen> and C<vmssysopen>.
The IO::File package is not initialized, however, until you
actually call a method that VMS::Stdio doesn't provide. This
-is doen to save startup time for users who don't wish to use
+is done to save startup time for users who don't wish to use
the IO::File methods.
B<Note:> In order to conform to naming conventions for Perl
@@ -201,7 +201,7 @@ true value if successful, and C<undef> if it fails.
This function sets the default device and directory for the process.
It is identical to the built-in chdir() operator, except that the change
persists after Perl exits. It returns a true value on success, and
-C<undef> if it encounters and error.
+C<undef> if it encounters an error.
=item sync
diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs
index 22d9a7262c..d82b17dbfa 100644
--- a/vms/ext/Stdio/Stdio.xs
+++ b/vms/ext/Stdio/Stdio.xs
@@ -87,7 +87,6 @@ newFH(FILE *fp, char type) {
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
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index 68bb6e8e60..48499d4a49 100644
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -68,16 +68,21 @@ if ($docc) {
elsif (-f '[-]perl.h') { $dir = '[-]'; }
else { die "$0: Can't find perl.h\n"; }
- # Go see if debugging is enabled in config.h
- $config = $dir . "config.h";
+ $use_threads = $use_mymalloc = $case_about_case = $debugging_enabled = 0;
+ $hide_mymalloc = $isgcc = 0;
+
+ # Go see what is enabled in config.sh
+ $config = $dir . "config.sh";
open CONFIG, "< $config";
while(<CONFIG>) {
- $debugging_enabled++ if /define\s+DEBUGGING/;
- $use_mymalloc++ if /define\s+MYMALLOC/;
- $hide_mymalloc++ if /define\s+EMBEDMYMALLOC/;
- $use_threads++ if /define\s+USE_THREADS/;
- $care_about_case++ if /define\s+VMS_WE_ARE_CASE_SENSITIVE/;
+ $use_threads++ if /usethreads='define'/;
+ $use_mymalloc++ if /usemymalloc='Y'/;
+ $care_about_case++ if /d_vms_case_sensitive_symbols='define'/;
+ $debugging_enabled++ if /usedebugging_perl='Y'/;
+ $hide_mymalloc++ if /embedmymalloc='Y'/;
+ $isgcc++ if /gccversion='[^']/;
}
+ close CONFIG;
# put quotes back onto defines - they were removed by DCL on the way in
if (($prefix,$defines,$suffix) =
@@ -92,8 +97,7 @@ if ($docc) {
# check for gcc - if present, we'll need to use MACRO hack to
# define global symbols for shared variables
- $isgcc = `$cc_cmd _nla0:/Version` =~ /GNU/
- or 0; # make debug output nice
+
print "\$isgcc: $isgcc\n" if $debug;
print "\$debugging_enabled: $debugging_enabled\n" if $debug;
@@ -168,7 +172,7 @@ if ($docc) {
else {
open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
}
-%checkh = map { $_,1 } qw( thread bytecode byterun proto );
+%checkh = map { $_,1 } qw( thread bytecode byterun proto perlio );
$ckfunc = 0;
LINE: while (<CPP>) {
while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
diff --git a/vms/genconfig.pl b/vms/genconfig.pl
index e500e760a2..ef1d5ad4a5 100644
--- a/vms/genconfig.pl
+++ b/vms/genconfig.pl
@@ -229,6 +229,8 @@ foreach (@ARGV) {
d_wcstombs d_wctomb d_mblen d_mktime d_strcoll d_strxfrm ]) {
print OUT "$_='$rtlhas'\n";
}
+ print OUT "d_stdio_ptr_lval_sets_cnt='undef'\n";
+ print OUT "d_stdio_ptr_lval_nochange_cnt='undef'\n";
foreach (qw[ d_gettimeod d_uname d_truncate d_wait4 d_index
d_pathconf d_fpathconf d_sysconf d_sigsetjmp ]) {
print OUT "$_='$rtlnew'\n";
diff --git a/vms/perlvms.pod b/vms/perlvms.pod
index 17e83e5c1b..f43cbb0e46 100644
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -788,6 +788,14 @@ by saying
(You can't just say C<$ENV{$key} = $ENV{$key}>, since the
Perl optimizer is smart enough to elide the expression.)
+Don't try to clear C<%ENV> by saying C<%ENV = ();>, it will throw
+a fatal error. This is equivalent to doing the following from DCL:
+
+ DELETE/LOGICAL *
+
+You can imagine how bad things would be if, for example, the SYS$MANAGER
+or SYS$SYSTEM logicals were deleted.
+
At present, the first time you iterate over %ENV using
C<keys>, or C<values>, you will incur a time penalty as all
logical names are read, in order to fully populate %ENV.
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 0676ebd249..640780af83 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1749,7 +1749,7 @@ case 35:
break;
case 37:
#line 269 "perly.y"
-{ (void)scan_num("1"); yyval.opval = yylval.opval; }
+{ (void)scan_num("1", &yylval); yyval.opval = yylval.opval; }
break;
case 39:
#line 274 "perly.y"
diff --git a/vms/test.com b/vms/test.com
index 7b4ebce510..a0569a6bde 100644
--- a/vms/test.com
+++ b/vms/test.com
@@ -43,7 +43,11 @@ $!
$! Pick up a copy of perl to use for the tests
$ If F$Search("Perl.").nes."" Then Delete/Log/NoConfirm Perl.;*
$ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl.
-$
+$!
+$! Pick up a copy of vmspipe.com to use for the tests
+$ If F$Search("VMSPIPE.COM").nes."" then Delete/Log/Noconfirm VMSPIPE.COM;*
+$ Copy/Log/NoConfirm [-]VMSPIPE.COM []
+$!
$! Make the environment look a little friendlier to tests which assume Unix
$ cat == "Type"
$ Macro/NoDebug/NoList/Object=Echo.Obj Sys$Input
@@ -86,6 +90,7 @@ $ Macro/NoDebug/NoList/Object=Echo.Obj Sys$Input
movl #1,r0
ret
.end echo
+$ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;*
$ Link/NoMap/NoTrace/Exe=Echo.Exe Echo.Obj;
$ Delete/Log/NoConfirm Echo.Obj;*
$ echo == "$" + F$Parse("Echo.Exe")
@@ -114,7 +119,7 @@ use Config;
@libexcl=('db-btree.t','db-hash.t','db-recno.t',
'gdbm.t','io_dup.t', 'io_pipe.t', 'io_poll.t', 'io_sel.t',
'io_sock.t', 'io_unix.t',
- 'ndbm.t','odbm.t','open2.t','open3.t', 'ph.t', 'posix.t', 'dprof.t');
+ 'ndbm.t','odbm.t','open2.t','open3.t', 'ph.t', 'posix.t');
# Note: POSIX is not part of basic build, but can be built
# separately if you're using DECC
@@ -238,7 +243,7 @@ if ($bad == 0) {
}
}
($user,$sys,$cuser,$csys) = times;
-print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n",
+print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n",
$user,$sys,$cuser,$csys,$files,$totmax);
$$END-OF-TEST$$
$ wrapup:
@@ -250,7 +255,6 @@ $ Else
$ Deassign 'dbg'PerlShr
$ EndIf
$ Show Process/Accounting
-$ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;*
$ Set Default &olddef
$ Set Message 'oldmsg'
$ Exit
diff --git a/vms/vms.c b/vms/vms.c
index 8fe4f5f104..7872bddf40 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -98,6 +98,9 @@ struct itmlst_3 {
#define expand_wild_cards(a,b,c,d) mp_expand_wild_cards(aTHX_ a,b,c,d)
#define getredirection(a,b) mp_getredirection(aTHX_ a,b)
+/* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
+#define PERL_LNM_MAX_ALLOWED_INDEX 127
+
static char *__mystrtolower(char *str)
{
if (str) for (; *str; ++str) *str= tolower(*str);
@@ -152,7 +155,7 @@ Perl_vmstrnenv(pTHX_ const char *lnm, char *eqv, unsigned long int idx,
}
#endif
- if (!lnm || !eqv || idx > LNM$_MAX_INDEX) {
+ if (!lnm || !eqv || idx > PERL_LNM_MAX_ALLOWED_INDEX) {
set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return 0;
}
for (cp1 = (char *)lnm, cp2 = uplnm; *cp1; cp1++, cp2++) {
@@ -596,7 +599,7 @@ vmssetenv(char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
if ((cp1 = strchr(environ[i],'=')) &&
!strncmp(environ[i],lnm,cp1 - environ[i])) {
#ifdef HAS_SETENV
- return setenv(lnm,eqv,1) ? vaxc$errno : 0;
+ return setenv(lnm,"",1) ? vaxc$errno : 0;
}
}
ivenv = 1; retsts = SS$_NOLOGNAM;
@@ -730,6 +733,30 @@ Perl_my_setenv(pTHX_ char *lnm,char *eqv)
}
/*}}}*/
+/*{{{static void vmssetuserlnm(char *name, char *eqv);
+/* vmssetuserlnm
+ * sets a user-mode logical in the process logical name table
+ * used for redirection of sys$error
+ */
+void
+Perl_vmssetuserlnm(char *name, char *eqv)
+{
+ $DESCRIPTOR(d_tab, "LNM$PROCESS");
+ struct dsc$descriptor_d d_name = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
+ unsigned long int iss, attr = 0;
+ unsigned char acmode = PSL$C_USER;
+ struct itmlst_3 lnmlst[2] = {{0, LNM$_STRING, 0, 0},
+ {0, 0, 0, 0}};
+ d_name.dsc$a_pointer = name;
+ d_name.dsc$w_length = strlen(name);
+
+ lnmlst[0].buflen = strlen(eqv);
+ lnmlst[0].bufadr = eqv;
+
+ iss = sys$crelnm(&attr,&d_tab,&d_name,&acmode,lnmlst);
+ if (!(iss&1)) lib$signal(iss);
+}
+/*}}}*/
/*{{{ char *my_crypt(const char *textpasswd, const char *usrname)*/
@@ -1843,17 +1870,19 @@ vmspipe_tempfile(void)
fprintf(fp,"$ perl_del = \"delete\"\n");
fprintf(fp,"$ pif = \"if\"\n");
fprintf(fp,"$! --- define i/o redirection (sys$output set by lib$spawn)\n");
- fprintf(fp,"$ pif perl_popen_in .nes. \"\" then perl_define sys$input 'perl_popen_in'\n");
- fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define sys$error 'perl_popen_err'\n");
+ fprintf(fp,"$ pif perl_popen_in .nes. \"\" then perl_define/user sys$input 'perl_popen_in'\n");
+ fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define/user sys$error 'perl_popen_err'\n");
+ fprintf(fp,"$ pif perl_popen_out .nes. \"\" then perl_define sys$output 'perl_popen_out'\n");
fprintf(fp,"$ cmd = perl_popen_cmd\n");
fprintf(fp,"$! --- get rid of global symbols\n");
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_cmd\n");
fprintf(fp,"$ perl_on\n");
fprintf(fp,"$ 'cmd\n");
fprintf(fp,"$ perl_status = $STATUS\n");
- fprintf(fp,"$ perl_del 'perl_cfile'\n");
+ fprintf(fp,"$ perl_del 'perl_cfile'\n");
fprintf(fp,"$ perl_exit 'perl_status'\n");
fsync(fileno(fp));
@@ -1892,12 +1921,12 @@ safe_popen(char *cmd, char *mode)
pInfo info;
struct dsc$descriptor_s d_symbol= {0, DSC$K_DTYPE_T,
DSC$K_CLASS_S, symbol};
- struct dsc$descriptor_s d_out = {0, DSC$K_DTYPE_T,
- DSC$K_CLASS_S, out};
struct dsc$descriptor_s vmspipedsc = {0, DSC$K_DTYPE_T,
DSC$K_CLASS_S, 0};
+
$DESCRIPTOR(d_sym_cmd,"PERL_POPEN_CMD");
$DESCRIPTOR(d_sym_in ,"PERL_POPEN_IN");
+ $DESCRIPTOR(d_sym_out,"PERL_POPEN_OUT");
$DESCRIPTOR(d_sym_err,"PERL_POPEN_ERR");
/* once-per-program initialization...
@@ -1958,9 +1987,9 @@ safe_popen(char *cmd, char *mode)
info->in_done = TRUE;
info->out_done = TRUE;
info->err_done = TRUE;
+ in[0] = out[0] = err[0] = '\0';
if (*mode == 'r') { /* piping from subroutine */
- in[0] = '\0';
info->out = pipe_infromchild_setup(mbx,out);
if (info->out) {
@@ -1979,13 +2008,13 @@ safe_popen(char *cmd, char *mode)
if (!done) _ckvmssts(sys$clref(pipe_ef));
_ckvmssts(sys$setast(1));
if (!done) _ckvmssts(sys$waitfr(pipe_ef));
- }
+ }
if (info->out->buf) Safefree(info->out->buf);
Safefree(info->out);
Safefree(info);
return Nullfp;
- }
+ }
info->err = pipe_mbxtofd_setup(fileno(stderr), err);
if (info->err) {
@@ -1995,7 +2024,6 @@ safe_popen(char *cmd, char *mode)
}
} else { /* piping to subroutine , mode=w*/
- int melded;
info->in = pipe_tochild_setup(in,mbx);
info->fp = PerlIO_open(mbx, mode);
@@ -2023,21 +2051,9 @@ safe_popen(char *cmd, char *mode)
if (info->in->buf) Safefree(info->in->buf);
Safefree(info->in);
Safefree(info);
- return Nullfp;
+ return Nullfp;
}
- /* if SYS$ERROR == SYS$OUTPUT, use only one mbx */
-
- melded = FALSE;
- fgetname(stderr, err);
- if (strncmp(err,"SYS$ERROR:",10) == 0) {
- fgetname(stdout, out);
- if (strncmp(out,"SYS$OUTPUT:",11) == 0) {
- if (popen_translate("SYS$OUTPUT",out) == popen_translate("SYS$ERROR",err)) {
- melded = TRUE;
- }
- }
- }
info->out = pipe_mbxtofd_setup(fileno(stdout), out);
if (info->out) {
@@ -2045,18 +2061,14 @@ safe_popen(char *cmd, char *mode)
info->out_done = FALSE;
info->out->info = info;
}
- if (!melded) {
- info->err = pipe_mbxtofd_setup(fileno(stderr), err);
- if (info->err) {
- info->err->pipe_done = &info->err_done;
- info->err_done = FALSE;
- info->err->info = info;
- }
- } else {
- err[0] = '\0';
- }
+
+ info->err = pipe_mbxtofd_setup(fileno(stderr), err);
+ if (info->err) {
+ info->err->pipe_done = &info->err_done;
+ info->err_done = FALSE;
+ info->err->info = info;
+ }
}
- d_out.dsc$w_length = strlen(out); /* lib$spawn sets SYS$OUTPUT so can meld*/
symbol[MAX_DCL_SYMBOL] = '\0';
@@ -2068,6 +2080,9 @@ safe_popen(char *cmd, char *mode)
d_symbol.dsc$w_length = strlen(symbol);
_ckvmssts(lib$set_symbol(&d_sym_err, &d_symbol, &table));
+ strncpy(symbol, out, MAX_DCL_SYMBOL);
+ d_symbol.dsc$w_length = strlen(symbol);
+ _ckvmssts(lib$set_symbol(&d_sym_out, &d_symbol, &table));
p = VMScmd.dsc$a_pointer;
while (*p && *p != '\n') p++;
@@ -2084,7 +2099,7 @@ safe_popen(char *cmd, char *mode)
info->next=open_pipes; /* prepend to list */
open_pipes=info;
_ckvmssts(sys$setast(1));
- _ckvmssts(lib$spawn(&vmspipedsc, &nl_desc, &d_out, &flags,
+ _ckvmssts(lib$spawn(&vmspipedsc, &nl_desc, &nl_desc, &flags,
0, &info->pid, &info->completion,
0, popen_completion_ast,info,0,0,0));
@@ -2098,7 +2113,7 @@ safe_popen(char *cmd, char *mode)
_ckvmssts(lib$delete_symbol(&d_sym_cmd, &table));
_ckvmssts(lib$delete_symbol(&d_sym_in, &table));
_ckvmssts(lib$delete_symbol(&d_sym_err, &table));
-
+ _ckvmssts(lib$delete_symbol(&d_sym_out, &table));
vms_execfree(aTHX);
PL_forkprocess = info->pid;
@@ -3572,9 +3587,12 @@ mp_getredirection(pTHX_ int *ac, char ***av)
PerlIO_printf(Perl_debug_log,"Can't open output file %s as stdout",out);
exit(vaxc$errno);
}
+ if (out != NULL) Perl_vmssetuserlnm("SYS$OUTPUT",out);
+
if (err != NULL) {
if (strcmp(err,"&1") == 0) {
dup2(fileno(stdout), fileno(Perl_debug_log));
+ Perl_vmssetuserlnm("SYS$ERROR","SYS$OUTPUT");
} else {
FILE *tmperr;
if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
@@ -3587,6 +3605,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
{
exit(vaxc$errno);
}
+ Perl_vmssetuserlnm("SYS$ERROR",err);
}
}
#ifdef ARGPROC_DEBUG
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 8d2a628894..17c5a00ed3 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -709,6 +709,7 @@ int Perl_rmscopy (pTHX_ char *, char *, int);
#endif
char * my_getenv_len (const char *, unsigned long *, bool);
int vmssetenv (char *, char *, struct dsc$descriptor_s **);
+void Perl_vmssetuserlnm(char *name, char *eqv);
char * my_crypt (const char *, const char *);
Pid_t my_waitpid (Pid_t, int *, int);
char * my_gconvert (double, int, int, char *);
diff --git a/vms/vmspipe.com b/vms/vmspipe.com
index bbb4461c72..652783eec5 100644
--- a/vms/vmspipe.com
+++ b/vms/vmspipe.com
@@ -6,12 +6,14 @@ $ perl_exit = "exit"
$ perl_del = "delete"
$ pif = "if"
$! --- define i/o redirection (sys$output set by lib$spawn)
-$ pif perl_popen_in .nes. "" then perl_define sys$input 'perl_popen_in'
-$ pif perl_popen_err .nes. "" then perl_define sys$error 'perl_popen_err'
+$ pif perl_popen_in .nes. "" then perl_define/user sys$input 'perl_popen_in'
+$ pif perl_popen_err .nes. "" then perl_define/user sys$error 'perl_popen_err'
+$ pif perl_popen_out .nes. "" then perl_define sys$output 'perl_popen_out'
$ cmd = perl_popen_cmd
$! --- get rid of global symbols
$ 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_cmd
$ perl_on
$ 'cmd
View Lorry Controller Status