PL_origalen = strlen(argv[0]) + 1; sv_setpv_mg(get_sv("0",0), argv[0]);
PerlInterpreter *modperl_startup(server_rec *s, apr_pool_t *p){    AV *endav;    dTHXa(NULL);    MP_dSCFG(s);    PerlInterpreter *perl;    int status;    char **argv;    int argc;#ifndef USE_ITHREADS    modperl_cleanup_data_t *cdata;#endif    /* ensure that we start the base server's perl, before vhost's     * one, if modperl_startup was called by vhost before the former     * was started */    if (MP_init_status != 2) {        server_rec *base_server = modperl_global_get_server_rec();        PerlInterpreter *base_perl;        MP_init_status = 2; /* calls itself, so set the flag early */        base_perl = modperl_startup(base_server, p);        if (base_server == s ) {            return base_perl;        }    }#ifdef MP_TRACE    {        server_rec *base_server = modperl_global_get_server_rec();        const char *desc = modperl_server_desc(s, p);        if (base_server == s) {                    MP_TRACE_i(MP_FUNC,                       "starting the parent perl for the base server\n", desc);        }        else {            MP_TRACE_i(MP_FUNC,                       "starting the parent perl for vhost %s\n", desc);        }    }#endif#ifdef MP_USE_GTOP    MP_TRACE_m_do(        modperl_gtop_do_proc_mem_before(MP_FUNC, "perl_parse");    );#endif    argv = modperl_config_srv_argv_init(scfg, &argc);    if (!(perl = perl_alloc())) {        perror("perl_alloc");        exit(1);    }#ifdef USE_ITHREADS    aTHX = perl;#endif    perl_construct(perl);    modperl_hash_seed_set(aTHX);    modperl_io_apache_init(aTHX);    PL_perl_destruct_level = 2;    MP_boot_data_set(p, s);    status = perl_parse(perl, modperl_xs_init, argc, argv, NULL);    MP_boot_data_set(NULL, NULL);    if (status) {        perror("perl_parse");        exit(1);    }    /* suspend END blocks to be run at server shutdown */    endav = PL_endav;    PL_endav = Nullav;/* This was fixed in 5.9.0/5.8.1 (17775), but won't compile after 19122 */#if PERL_REVISION == 5 && PERL_VERSION == 8 && PERL_SUBVERSION == 0 && \    defined(USE_REENTRANT_API) && defined(HAS_CRYPT_R) && defined(__GLIBC__)    /* workaround perl5.8.0/glibc bug */    PL_reentrant_buffer->_crypt_struct.current_saltbits = 0;#endif    perl_run(perl);#ifdef USE_ITHREADS    /* base server / virtual host w/ +Parent gets its own mip */    modperl_interp_init(s, p, perl);    /* mark the parent perl to be destroyed */    MpInterpBASE_On(scfg->mip->parent);#endif    PL_endav = endav;    set_taint_var(perl);    MP_TRACE_i(MP_FUNC, "constructed interpreter=0x%lx\n",               (unsigned long)perl);#ifdef MP_USE_GTOP    MP_TRACE_m_do(        modperl_gtop_do_proc_mem_after(MP_FUNC, "perl_parse");    );#endif#ifdef MP_COMPAT_1X    {        char *path, *path1;        apr_finfo_t finfo;        /* 1) push @INC, $ServerRoot */        av_push(GvAV(PL_incgv), newSVpv(ap_server_root, 0));        /* 2) push @INC, $ServerRoot/lib/perl only if it exists */        apr_filepath_merge(&path, ap_server_root, "lib",                           APR_FILEPATH_NATIVE, p);        apr_filepath_merge(&path1, path, "perl",                           APR_FILEPATH_NATIVE, p);        if (APR_SUCCESS == apr_stat(&finfo, path1, APR_FINFO_TYPE, p)) {            if (finfo.filetype == APR_DIR) {                av_push(GvAV(PL_incgv), newSVpv(path1, 0));            }        }    }#endif /* MP_COMPAT_1X */    /* base perl and each vhost +Parent should have this init'ed */    modperl_handler_anon_init(aTHX_ p);    if (!modperl_config_apply_PerlRequire(s, scfg, perl, p)) {        exit(1);    }    if (!modperl_config_apply_PerlModule(s, scfg, perl, p)) {        exit(1);    }#ifndef USE_ITHREADS    cdata = modperl_cleanup_data_new(server_pool, (void*)perl);    apr_pool_cleanup_register(server_pool, cdata,                              modperl_shutdown, apr_pool_cleanup_null);#endif    return perl;}