view release on metacpan or  search on metacpan

Redirect.xs  view on Meta::CPAN

	redirected.Close(aTHX_ f);

	if ( ret == 0 )
		return 0;

	errno = ret;
	return -1;
}


static PerlIO*
PerlIOredirect_open(pTHX_ PerlIO_funcs *tab,
			PerlIO_list_t *layers, IV n, const char *mode,
			int fd, int imode, int perm,
			PerlIO *f, int narg, SV **args) {

	SV * handle;
	PerlIO * proxy;
	dSP;

	if ( fd != -1 || narg != 1)
		goto UNIX_OPEN; 

	if ( !is_path_redirected_sv(args[0])) 
		goto UNIX_OPEN;

	ENTER;
	SAVETMPS;
	PUSHMARK( sp);
	XPUSHs( newSVsv( args[0]));
	XPUSHs( newSVpv( mode, PL_na ));
	PUTBACK;
	perl_call_pv("File::Redirect::Open", G_SCALAR);
        SPAGAIN;
	handle = newSVsv(POPs);
	PUTBACK;
	FREETMPS;
	LEAVE;

	if (SvROK(handle)) {
		IO * io;
		PerlIO * proxy = IoIFP(sv_2io(handle)), *p;
		redirected = *(PerlIOBase(proxy)-> tab);

		mapped = *(PerlIOBase(proxy)-> tab);
		mapped.Close = PerlIOredirect_close;
		PerlIOBase(proxy)-> tab = &mapped;

		return proxy;
	} else {
		errno = SvIV(handle);
		return NULL;
	}

UNIX_OPEN:
	return unix.Open(aTHX_ tab, layers, n, mode, fd, imode, perm, f, narg, args);
}

// #define PerlLIO_chmod(file, mode)					\
// 	(*PL_LIO->pChmod)(PL_LIO, (file), (mode))
// #define PerlLIO_chown(file, owner, group)				\
// 	(*PL_LIO->pChown)(PL_LIO, (file), (owner), (group))
// #define PerlLIO_link(oldname, newname)					\
// 	(*PL_LIO->pLink)(PL_LIO, (oldname), (newname))
// #define PerlLIO_lstat(name, buf)					\
// 	(*PL_LIO->pLstat)(PL_LIO, (name), (buf))
// #define PerlLIO_rename(oname, newname)					\
// 	(*PL_LIO->pRename)(PL_LIO, (oname), (newname))
// #define PerlLIO_unlink(file)						\
// 	(*PL_LIO->pUnlink)(PL_LIO, (file))
// #define PerlLIO_utime(file, time)					\
// 	(*PL_LIO->pUtime)(PL_LIO, (file), (time))

// #define PerlDir_mkdir(name, mode)				\
// 	(*PL_Dir->pMakedir)(PL_Dir, (name), (mode))
// #define PerlDir_chdir(name)					\
// 	(*PL_Dir->pChdir)(PL_Dir, (name))
// #define PerlDir_rmdir(name)					\
// 	(*PL_Dir->pRmdir)(PL_Dir, (name))
// #define PerlDir_close(dir)					\
// 	(*PL_Dir->pClose)(PL_Dir, (dir))
// #define PerlDir_open(name)					\
// 	(*PL_Dir->pOpen)(PL_Dir, (name))
// #define PerlDir_read(dir)					\
// 	(*PL_Dir->pRead)(PL_Dir, (dir))
// #define PerlDir_rewind(dir)					\
// 	(*PL_Dir->pRewind)(PL_Dir, (dir))
// #define PerlDir_seek(dir, loc)					\
// 	(*PL_Dir->pSeek)(PL_Dir, (dir), (loc))
// #define PerlDir_tell(dir)					\
// 	(*PL_Dir->pTell)(PL_Dir, (dir))
// #ifdef WIN32
// #define PerlDir_mapA(dir)					\
// 	(*PL_Dir->pMapPathA)(PL_Dir, (dir))
// #define PerlDir_mapW(dir)					\
// 	(*PL_Dir->pMapPathW)(PL_Dir, (dir))
// #endif


MODULE = File::Redirect PACKAGE = File::Redirect

BOOT:
{
	int ok = 1;
	PerlIO_funcs *old = PL_known_layers-> array[0]. funcs;
	if ( strcmp(old-> name, "unix") != 0) {
		warn("this perl is incompatible with redirect: IO layer 'unix' is not found");
		ok = 0;
	}
	unix = *old;

	old_lio = *PL_LIO;
	old_dir = *PL_Dir;

	if ( ok) {
		old-> Open = PerlIOredirect_open;
		PL_LIO-> pNameStat = new_stat;
	}
}

UV