Greetings,

I have just recently also fielded a request to once again allow
for the use of a DCL environment with:

   $ set symbol/scope=noglobal

in effect to also run perl programs that allow backticks to work.
There was an extensive discussion of this topic back in
the archives: With the problem first pointed out by Tom Edelson
Mon, 1 Oct 2001 12:12:03 -0400:

http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/2001-10/msg00000.html

Charles Lane mentions viability of local symbols
Mon, 1 Oct 2001 16:53:29 EDT:

http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/2001-10/msg00003.html

and there were several other posts in the thread.

The enclosed patch taken against the perl 5.8.1 candidate known as
"MAINT19683" implements the local symbol approach for dealing with
communication into vmspipe.com.  Because it uses only local symbols
it removes the C<$ delete/symbol/global> statements both from the loose
vmspipe.com that ships with perl as well as the possible temporary file
that could get written out by vms.c.

[Apart from the possibility of using logical names I am not entirely sure
that there is much of another approach since reading a file would be too
slow and calls to lib$spawn() do not appear to allow for passing parameters
(though I could be mistaken about that).]

I have a regression test for this feature that exploits the new
"SECONDOFYEAR"
output field for DCL's f$cvtime() lexical function (hence the test cannot
be used
on versions of VMS prior to V7.3-1) whose output with this patch built into
perl
appears as:

$ perl vmspipe.t
1..6
ok 1 # '13785921' compared to '13785922'
ok 2 # '13785922' compared to '13785922'
ok 3 # '13785922' compared to '13785922'
ok 4 # '13785922' compared to '13785923'
ok 5 # '13785923' compared to '13785923'
ok 6 # '13785923' compared to '13785923'

This test, and the mod to vms.c, also leaves the DCL global symbol table
clean as verified with:

$ show symbol perl_popen*
%DCL-W-UNDSYM, undefined symbol - check validity and spelling

Here is the patch to affect the change:

diff -ru perl_19683/vms/vms.c perl/vms/vms.c
--- perl_19683/vms/vms.c      2003-04-17 15:30:12.000000000 -0400
+++ perl/vms/vms.c      2003-06-09 13:18:01.000000000 -0400
@@ -2299,7 +2299,7 @@
     }
     if (!fp) return 0;  /* we're hosed */

-    fprintf(fp,"$! 'f$verify(0)\n");
+    fprintf(fp,"$! 'f$verify(0)'\n");
     fprintf(fp,"$!  ---  protect against nonstandard definitions ---\n");
     fprintf(fp,"$ perl_cfile  = f$environment(\"procedure\")\n");
     fprintf(fp,"$ perl_define = \"define/nolog\"\n");
@@ -2318,15 +2318,8 @@
     fprintf(fp,"$x=perl_popen_cmd3\n");
     fprintf(fp,"$c=c+x\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_cmd0\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd1\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd2\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd3\n");
     fprintf(fp,"$ perl_on\n");
-    fprintf(fp,"$ 'c\n");
+    fprintf(fp,"$ 'c'\n");
     fprintf(fp,"$ perl_status = $STATUS\n");
     fprintf(fp,"$ perl_del  'perl_cfile'\n");
     fprintf(fp,"$ perl_exit 'perl_status'\n");
@@ -2358,7 +2351,8 @@
 {
     static int handler_set_up = FALSE;
     unsigned long int sts, flags = CLI$M_NOWAIT;
-    unsigned int table = LIB$K_CLI_GLOBAL_SYM;
+    /* The use of the LIB$K_CLI_GLOBAL_SYM table renders qx() unworkable under a 
NOGLOBAL symbol scope env. */
+    unsigned int table = LIB$K_CLI_LOCAL_SYM;
     int j, wait = 0;
     char *p, mode[10], symbol[MAX_DCL_SYMBOL+1], *vmspipe;
     char in[512], out[512], err[512], mbx[512];
diff -ru perl_19683/vms/vmspipe.com perl/vms/vmspipe.com
--- perl_19683/vms/vmspipe.com      2003-01-23 09:24:41.000000000 -0500
+++ perl/vms/vmspipe.com      2003-06-09 13:18:07.000000000 -0400
@@ -1,4 +1,4 @@
-$! 'f$verify(0)
+$! 'f$verify(0)'
 $!  ---  protect against nonstandard definitions ---
 $ perl_define = "define/nolog"
 $ perl_on     = "on error then exit $STATUS"
@@ -15,14 +15,6 @@
 $c=c+perl_popen_cmd2
 $x=perl_popen_cmd3
 $c=c+x
-$!  --- get rid of global symbols
-$ perl_del/symbol/global perl_popen_cmd0
-$ perl_del/symbol/global perl_popen_cmd1
-$ perl_del/symbol/global perl_popen_cmd2
-$ perl_del/symbol/global perl_popen_cmd3
-$ perl_del/symbol/global perl_popen_in
-$ perl_del/symbol/global perl_popen_err
-$ perl_del/symbol/global perl_popen_out
 $ perl_on
-$ 'c
+$ 'c'
 $ perl_exit '$STATUS'
End of Patch.

The regression test, which cannot be used in perl since it will not
run on older VMS's looks like:

# vmspipe.t - test out the efficacy of DCL constructs from perl backticks
# under DCL environments that include all combinations of [NO]LOCAL,[NO]GLOBAL
# symbol scopes as well as the initial and a restoration of the initial
# environment.  These tests can only be expected to be of value on VMS.
#
# Note that perl 5.8.0 tries to compare an integer to an error string:
# C<not ok 3 # '13780287' compared to '%LIB-F-UNECLIERR, unexpected CLI error'>
# C<not ok 5 # '13780287' compared to '%LIB-F-UNECLIERR, unexpected CLI error'>
# due to the setting of global symbols perl_popen_* within vms.c for use by
# vmspipe.com.
#
# Peter Prymmer

BEGIN {
    if ( $^O ne 'VMS' ) {
        print "1..0 # skipping vmspipe test on $^O\n";
        exit;
    }
    else {
        print "1..6\n";
    }
}

# How far back (among VMS versions) does the validity of lexical call
# to C<f$environment("SYMBOL_SCOPE")> go?
# How far back does the validity of C<set symbol/scope> go?
open(COMTEST, ">vmspipetest.com") or die "Could not open vmspipetest.com: $!";
print COMTEST << 'EOCOMTEST';
$ set noon
$ exe := .exe
$ initial_symbol_scope = f$environment("SYMBOL_SCOPE")
$ write sys$output f$cvtime(,,"SECONDOFYEAR")
$ mcr sys$disk:[]perl'exe' -e "print `write sys\$output f\$cvtime(,,""SECONDOFYEAR"")`"
$ set symbol/scope=(global,local)
$ write sys$output f$cvtime(,,"SECONDOFYEAR")
$ mcr sys$disk:[]perl'exe' -e "print `write sys\$output f\$cvtime(,,""SECONDOFYEAR"")`"
$ set symbol/scope=(noglobal,local)
$ write sys$output f$cvtime(,,"SECONDOFYEAR")
$ mcr sys$disk:[]perl'exe' -e "print `write sys\$output f\$cvtime(,,""SECONDOFYEAR"")`"
$ set symbol/scope=(global,nolocal)
$ write sys$output f$cvtime(,,"SECONDOFYEAR")
$ mcr sys$disk:[]perl'exe' -e "print `write sys\$output f\$cvtime(,,""SECONDOFYEAR"")`"
$ set symbol/scope=(noglobal,nolocal)
$ write sys$output f$cvtime(,,"SECONDOFYEAR")
$ mcr sys$disk:[]perl'exe' -e "print `write sys\$output f\$cvtime(,,""SECONDOFYEAR"")`"
$ set symbol/scope=(global,local)
$ set symbol/scope=('initial_symbol_scope')
$ write sys$output f$cvtime(,,"SECONDOFYEAR")
$ mcr sys$disk:[]perl'exe' -e "print `write sys\$output f\$cvtime(,,""SECONDOFYEAR"")`"
$ set on
EOCOMTEST

close COMTEST;

# Avoid backticks, use DCL native redirection to a file
# (do not use PIPE for compatability with VMS V < 7.1).

system('@vmspipetest.com/output=vmspipetest.out');
open(OUT, "<vmspipetest.out") or die "Could not open vmspipetest.out: $!";
my @out = (<OUT>);
close(OUT);

unlink('vmspipetest.com');
unlink('vmspipetest.out');

# Allow 5 seconds time slip for very slow machines
# (hopefully noone runs this over midnight on New Year's eve).
# Timing precision here is not important for uncovering integer to
# character string comparison errors.
my $epsilon = 5;
my $t = 0;
while (my $time0 = shift(@out)) {
    my $time1 = shift(@out);
    $t++;
    chomp($time0);
    chomp($time1);
    print +(abs($time0 - $time1) > $epsilon) ? 'not ' : '', "ok $t # '$time0' compared 
to '$time1'\n";
}


Does anyone see any problem with applying the patch to vms.c and vmspipe.com
into perl 5.8.1?  Thanks for feedback.

Note that if I also add a regression test I'd need to parse absolute timestamps,
hence that will take a while to do and may not be included right away.

Peter Prymmer

Reply via email to