view release on metacpan or  search on metacpan

src/speedy_perl.c  view on Meta::CPAN

     * See if cwd_fd is the correct dir - if so fchdir there.
     */
    if (stat_cwd_fd(&devino) && DEVINO_SAME(dest, devino) &&
	fchdir(cwd_fd) != -1)
    {
	return 1;
    }

    /* Stat "." */
    chdir_path(".", &devino);

    /* See if "." is the right directory */
    return DEVINO_SAME(dest, devino);
}

static void *get_perlvar(SpeedyPerlVar *pv) {
    if (!pv->ptr) {
	switch(pv->type) {
	    case SVt_PVIO:
		pv->ptr = gv_fetchpv(pv->name, 1, SVt_PVIO);
		break;
	    case SVt_PVAV:
		pv->ptr = get_av(pv->name, 1);
		break;
	    case SVt_PVHV:
		pv->ptr = get_hv(pv->name, 1);
		break;
	    case SVt_PVCV:
		pv->ptr = get_cv(pv->name, 0);
		break;
	    default:
		pv->ptr = get_sv(pv->name, 1);
		break;
	}
	if (pv->type != SVt_PVCV && !pv->ptr)
	    DIE_QUIET("Cannot create perl variable %s", pv->name);
    }
    return pv->ptr;
}

/* Shutdown and exit. */
static void all_done(void) {
    speedy_file_set_state(FS_CLOSED);

    /* Destroy the interpreter */
    if (my_perl) {

	/* Call any shutdown functions */
	my_call_sv(get_perlvar(&PERLVAR_RUN_SHUTDOWN));

	perl_destruct(my_perl);
    }
    speedy_util_exit(0,0);
}

/* Wait for a connection from a frontend */
static void backend_accept(void) {
    SigList sl;
    int ok;

    /* Set up caught/unblocked signals to exit on */
    speedy_sig_init(&sl, caught_sigs, NUMSIGS, SIG_UNBLOCK);

    /* Wait for an accept or timeout */
    ok = speedy_ipc_accept(OPTVAL_TIMEOUT*1000);

    /* Put signals back to original settings */
    speedy_sig_free(&sl);

    /* If timed out or signal, then finish up */
    if (!ok)
	all_done();
}

/* Read in a string on stdin. */
static char *get_string(register PerlIO *pio_in, int *sz_ret) {
    int sz;
    register char *buf;

    /* Read length of string */
    sz = PerlIO_getc(pio_in);

    switch(sz) {
    case -1:
	DIE_QUIET("protocol error");
    case 0:
	buf = NULL;
	break;
    case MAX_SHORT_STR:
	PerlIO_read(pio_in, &sz, sizeof(int));
	/* Fall through */
    default:
	/* Allocate space */
	speedy_new(buf, sz+1, char);

	/* Read string and terminate */
	PerlIO_read(pio_in, buf, sz);
	buf[sz] = '\0';
	break;
    }
    if (sz_ret)
	*sz_ret = sz;
    return buf;
}

static void do_proto2(char **cwd_path) {
    char c;

    /* Tell the frontend what we need */
    c = cwd_path ? 1 : 0;
    write(PREF_FD_ACCEPT_O, &c, 1);

    if (cwd_path) {
	PerlIO *pio_file = PerlIO_fdopen(dup(PREF_FD_ACCEPT_E), "r");

	/* Get cwd */
	*cwd_path = get_string(pio_file, NULL);

	PerlIO_close(pio_file);
    }
}