view release on metacpan or  search on metacpan

gen/perl_callout.c  view on Meta::CPAN

	if(!strlen(a.str))
		return; // die silently
        if((p = strrchr(a.str, '*')))
            *p = 0;
            else
            	return; // die silent
	p = a.str;
	while((p = strchr(p, '\\'))) {	
		*p = '/';
	}
	if((p = strrchr(a.str, '/')))
		*p = '\0';
        kwc_cache_home = strdup(a.str);
#ifdef WDEB
        xxlog("leaving get_kwc_cache_home");
#endif
}

#ifdef WIN32
static void
gen_sub_init(void)
{
	// done. a.str should contain k:/cachesys
	// push this on perl
#ifdef WDEB
	xxlog("entering gen_sub_init");
#endif
        if(!kwc_cache_home)
          	return;
         {
		ZARRAYP za_in, za_out;
		za_in = (ZARRAYP) malloc(strlen(kwc_cache_home) + 512);
		za_out = (ZARRAYP) malloc(512);
		if(!za_in || !za_out) {
			if(za_in)
				free(za_in);
			if(za_out)
				free(za_out);
			return;
		}
#if 0
#ifdef SMALL_PERL
		sprintf(za_in->data,
                    "push @INC, '%s/perl/lib', '%s/perl/site/lib'",
		    kwc_cache_home, kwc_cache_home);
#else
                /*@@@@ stefan hack @@@*/
                //*kwc_cache_home='K';
		sprintf(za_in->data,
                    "push @INC, '%s/perl/5.6.1/lib/MSWin32-x86',"
                    	"'%s/perl/5.6.1/lib',"
                        "'%s/perl/site/5.6.1/lib/MSWin32-x86',"
                        "'%s/perl/site/5.6.1/lib',"
                        "'.',",
                        kwc_cache_home,
                        kwc_cache_home,
                        kwc_cache_home,
                        kwc_cache_home);
#endif
#else
               strcpy(za_in->data, CACEMBED_INC);
#endif           
#ifdef WDEB
        	xxlog(za_in->data);
#endif
		za_in->len = strlen(za_in->data);
		za_out->len = 500;
		zperl(za_in, za_out);
        	free(za_out);
        	free(za_in);
         }
#ifdef WDEB
	xxlog("leaving gen_sub_init");
#endif
}
#endif

static void
cacembed(void)
{
  eval_pv(CACEMBED_INC,1);
}

static int
real_init_perl (int argc, char **argv, char **envp)
{
  int rc;
	if (!my_perl) {
		char *embedding[] = { "", "-e", "0", 0 };

                get_kwc_cache_home();
                
#ifdef WDEB
                xxlog("before perl alloc\n");
#endif
		my_perl = perl_alloc ();
		PL_perl_destruct_level = 1;
#ifdef WDEB
                xxlog("before perl construct\n");
#endif
		perl_construct (my_perl);
                if(perl_is_master) {
                   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
                }

#ifdef WDEB
                xxlog("before perl parse\n");
#endif
                if(perl_is_master) {
                    perl_parse (my_perl, xs_init, argc, argv, 0);
                } else {
		    perl_parse (my_perl, xs_init, 3, embedding, 0);
                }
#ifdef WDEB
                xxlog("before perl run\n");
#endif
		rc = perl_run (my_perl);
		*perl_error = 0;
#ifdef WIN32
		gen_sub_init();
#else
                //cacembed();
#endif
	}
        return rc;
}

static inline void init_perl(void) // called when cache is loaded on demand
{
    real_init_perl(0,0,0);
}
        

static void
delete_perl (void)
{
	if (my_perl) {
          if(perl_is_master) {
            CacheEnd();
          }
	  PL_perl_destruct_level = 1;