Re: Possible angle on JPL failures

[email protected] <[email protected]> wrote:

> However, without knowing what I was doing, I hacked a 
> quick 'n dirty dup of the environment and -- I nearly 
> fell off the chair  -- JPL worked with jdk 1.3 !!. 
 
> 
> At least this proves the theory although I'm sure there's
> a better idiom for the fix.  Anyway I've included the perl.c 
> patch below:

>> You might want to bring this up on perl5-porters.  Tell them the problem,
>> let them know the "hack fix", and see if they have any ideas that would
>> help.  Perhaps there might be some way to turn of %ENV by an option to make
>> JPL work....

>> I don't have time myself to pursue this with p5p.  Hey, JPL pumpking, are
>> you still out there?  ;)

Brad,

Many thanks -- p5p is a good idea. 

I've verified the hack works with Solaris 5.6 too - 
both jdk1.2/1.3. Below is the new patch for anyone 
interested - just a minor change to eliminate a 
variable and an added pre-processor wrap since 
presumably, non-JPL uses wouldn't want the hit from 
an environment dup. Maybe there's a better way
though. 

Rgds,
--
Charles DeRykus


*** perl.c.orig	Tue Jan 23 18:27:52 2001
--- perl.c	Tue Jan 23 19:01:54 2001
***************
*** 11,20 ****
--- 11,32 ----
   * "A ship then new they built for him/of mithril and of elven glass" --Bilbo
   */
  
+ char **my_env;  
+ /* dup environment if JPL */
+ #ifdef JPL
+ char **my_env_base, **env_base;
+ int my_env_count = 0;
+ int jpl = 1;
+ #else
+ int jpl = 0;
+ #endif
+ 
+ 
  #include "EXTERN.h"
  #include "perl.h"
  #include "patchlevel.h"
  
+ 
  /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
  #ifdef I_UNISTD
  #include <unistd.h>
***************
*** 2586,2592 ****
  }
  
  STATIC void
! init_postdump_symbols(register int argc, register char **argv, register char **env)
  {
      dTHR;
      char *s;
--- 2598,2604 ----
  }
  
  STATIC void
! init_postdump_symbols(register int argc, register char **argv, register char **env )
  {
      dTHR;
      char *s;
***************
*** 2644,2666 ****
  	   if the environment has been modified since. To avoid this
  	   problem we treat env==NULL as meaning 'use the default'
  	*/
! 	if (!env)
  	    env = environ;
! 	if (env != environ)
  	    environ[0] = Nullch;
! 	for (; *env; env++) {
! 	    if (!(s = strchr(*env,'=')))
  		continue;
  	    *s++ = '\0';
  #if defined(MSDOS)
! 	    (void)strupr(*env);
  #endif
  	    sv = newSVpv(s--,0);
! 	    (void)hv_store(hv, *env, s - *env, sv, 0);
  	    *s = '=';
  #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
  	    /* Sins of the RTL. See note in my_setenv(). */
! 	    (void)PerlEnv_putenv(savepv(*env));
  #endif
  	}
  #endif
--- 2656,2694 ----
  	   if the environment has been modified since. To avoid this
  	   problem we treat env==NULL as meaning 'use the default'
  	*/
! 	if (!env) {
  	    env = environ;
!         }
! 	if (env != environ) {
  	    environ[0] = Nullch;
!         }
! #ifdef JPL
!         env_base = env;
!         for (; *env; env++) { my_env_count++; }
!         my_env = (char **) safemalloc( sizeof(char **) * (my_env_count+1) );
!         my_env_base = my_env;
!         env = env_base;
! 	for (; *env; env++, my_env++) {
!            *my_env = (char *) safemalloc( sizeof(char) * (strlen(*env)+1) );
!            strcpy( *my_env, *env );
!         }
!         *my_env = '\0';
!         my_env = my_env_base;
! #endif
! 	for (; (jpl ? *my_env : *env) ; (jpl ? my_env++ : env++) ) {
! 	    if ( !(s = strchr((jpl ? *my_env : *env),'=')))
  		continue;
  	    *s++ = '\0';
  #if defined(MSDOS)
! 	    (void)strupr(jpl ? *my_env : env);
  #endif
  	    sv = newSVpv(s--,0);
! 	    (void)hv_store(hv, (jpl ? *my_env : *env) ,  \
!                            s - (jpl ? *my_env : *env), sv, 0);
  	    *s = '=';
  #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
  	    /* Sins of the RTL. See note in my_setenv(). */
! 	    (void)PerlEnv_putenv(savepv( (jpl ? *my_env : env) ) );
  #endif
  	}
  #endif
***************
*** 2669,2676 ****
  #endif
      }
      TAINT_NOT;
!     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
  	sv_setiv(GvSV(tmpgv), (IV)getpid());
  }
  
  STATIC void
--- 2697,2705 ----
  #endif
      }
      TAINT_NOT;
!     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV)) {
  	sv_setiv(GvSV(tmpgv), (IV)getpid());
+     }
  }
  
  STATIC void





*** perl.c.orig	Tue Jan 23 18:27:52 2001
--- perl.c	Tue Jan 23 19:01:54 2001
***************
*** 11,20 ****
--- 11,32 ----
   * "A ship then new they built for him/of mithril and of elven glass" --Bilbo
   */
  
+ char **my_env;  
+ /* dup environment if JPL */
+ #ifdef JPL
+ char **my_env_base, **env_base;
+ int my_env_count = 0;
+ int jpl = 1;
+ #else
+ int jpl = 0;
+ #endif
+ 
+ 
  #include "EXTERN.h"
  #include "perl.h"
  #include "patchlevel.h"
  
+ 
  /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
  #ifdef I_UNISTD
  #include <unistd.h>
***************
*** 2586,2592 ****
  }
  
  STATIC void
! init_postdump_symbols(register int argc, register char **argv, register char **env)
  {
      dTHR;
      char *s;
--- 2598,2604 ----
  }
  
  STATIC void
! init_postdump_symbols(register int argc, register char **argv, register char **env )
  {
      dTHR;
      char *s;
***************
*** 2644,2666 ****
  	   if the environment has been modified since. To avoid this
  	   problem we treat env==NULL as meaning 'use the default'
  	*/
! 	if (!env)
  	    env = environ;
! 	if (env != environ)
  	    environ[0] = Nullch;
! 	for (; *env; env++) {
! 	    if (!(s = strchr(*env,'=')))
  		continue;
  	    *s++ = '\0';
  #if defined(MSDOS)
! 	    (void)strupr(*env);
  #endif
  	    sv = newSVpv(s--,0);
! 	    (void)hv_store(hv, *env, s - *env, sv, 0);
  	    *s = '=';
  #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
  	    /* Sins of the RTL. See note in my_setenv(). */
! 	    (void)PerlEnv_putenv(savepv(*env));
  #endif
  	}
  #endif
--- 2656,2694 ----
  	   if the environment has been modified since. To avoid this
  	   problem we treat env==NULL as meaning 'use the default'
  	*/
! 	if (!env) {
  	    env = environ;
!         }
! 	if (env != environ) {
  	    environ[0] = Nullch;
!         }
! #ifdef JPL
!         env_base = env;
!         for (; *env; env++) { my_env_count++; }
!         my_env = (char **) safemalloc( sizeof(char **) * (my_env_count+1) );
!         my_env_base = my_env;
!         env = env_base;
! 	for (; *env; env++, my_env++) {
!            *my_env = (char *) safemalloc( sizeof(char) * (strlen(*env)+1) );
!            strcpy( *my_env, *env );
!         }
!         *my_env = '\0';
!         my_env = my_env_base;
! #endif
! 	for (; (jpl ? *my_env : *env) ; (jpl ? my_env++ : env++) ) {
! 	    if ( !(s = strchr((jpl ? *my_env : *env),'=')))
  		continue;
  	    *s++ = '\0';
  #if defined(MSDOS)
! 	    (void)strupr(jpl ? *my_env : env);
  #endif
  	    sv = newSVpv(s--,0);
! 	    (void)hv_store(hv, (jpl ? *my_env : *env) ,  \
!                            s - (jpl ? *my_env : *env), sv, 0);
  	    *s = '=';
  #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
  	    /* Sins of the RTL. See note in my_setenv(). */
! 	    (void)PerlEnv_putenv(savepv( (jpl ? *my_env : env) ) );
  #endif
  	}
  #endif
***************
*** 2669,2676 ****
  #endif
      }
      TAINT_NOT;
!     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
  	sv_setiv(GvSV(tmpgv), (IV)getpid());
  }
  
  STATIC void
--- 2697,2705 ----
  #endif
      }
      TAINT_NOT;
!     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV)) {
  	sv_setiv(GvSV(tmpgv), (IV)getpid());
+     }
  }
  
  STATIC void