#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "perliol.h"


PerlIO_funcs unix, mapped, redirected;
struct IPerlLIO old_lio;
struct IPerlDir old_dir;

static void
fill_stat_t( AV * av_stat, Stat_t *st)
{
	if ( av_len(av_stat) != 12 ) croak("panic: stat array is not 12-long:%d", av_len(av_stat));

#define AVx(n) (*(av_fetch(av_stat,n,0)))
	st-> st_dev   = SvIV(AVx(0));
	st-> st_ino   = SvIV(AVx(1));
	st-> st_mode  = SvUV(AVx(2));
	st-> st_nlink = SvUV(AVx(3));
#if Uid_t_size > IVSIZE
	st-> st_uid = SvNV(AVx(4));
#else
#   if Uid_t_sign <= 0
	st-> st_uid = SvIV(AVx(4));
#   else
	st-> st_uid = SvUV(AVx(4));
#   endif
#endif
#if Gid_t_size > IVSIZE
	st-> st_uid = SvNV(AVx(5));
#else
#   if Gid_t_sign <= 0
	st-> st_uid = SvIV(AVx(5));
#   else
	st-> st_uid = SvUV(AVx(5));
#   endif
#endif
#ifdef USE_STAT_RDEV
	st-> st_rdev = SvUV(AVx(6));
#endif
#if Off_t_size > IVSIZE
	st-> st_size = SvUV(AVx(7));
#else
	st-> st_size = SvIV(AVx(7));
#endif
#ifdef BIG_TIME
	st-> st_atime = SvNV(AVx(8));
	st-> st_mtime = SvNV(AVx(8));
	st-> st_ctime = SvNV(AVx(8));
#else
	st-> st_atime = SvIV(AVx(8));
	st-> st_mtime = SvIV(AVx(8));
	st-> st_ctime = SvIV(AVx(8));
#endif
#ifdef USE_STAT_BLOCKS
	st-> st_blksize = SvUV(AVx(9));
	st-> st_blocks  = SvUV(AVx(9));
#endif
#undef AVx
}

static int
is_path_redirected_sv( SV * path )
{
	int result;
	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK( sp);
	XPUSHs( path );
	PUTBACK;
	perl_call_pv("File::Redirect::is_path_redirected", G_SCALAR);
	result = POPi;
	PUTBACK;
	FREETMPS;
	LEAVE;
	return result;
}

#define is_path_redirected_pv(pv) is_path_redirected_sv(sv_2mortal(newSVpv(pv,PL_na)))

static int
new_stat(struct IPerlLIO* lio, const char* path, Stat_t* st)
{
	int ret;
	SV * result;
	dSP;

	if (!is_path_redirected_pv(path)) 
		return old_lio.pNameStat(lio,path,st);

	ENTER;
	SAVETMPS;
	PUSHMARK( sp);
	XPUSHs( newSVpv( path, PL_na ));
	PUTBACK;
	perl_call_pv("File::Redirect::Stat", G_SCALAR);
	result = POPs;
	if ( !result && SvOK( result )) 
		croak("bad return type");

	if ( SvROK(result)) {
		switch ( SvTYPE(SvRV(result))) {
		case SVt_PVAV:
			fill_stat_t((AV*) SvRV(result), st);
			ret = 0;
			break;
		default:
			croak("bad return type:%d", SvTYPE(SvRV(result)));
		}
	} else {
		errno = SvIV( result);
		ret = -1;
	}

	PUTBACK;
	FREETMPS;
	LEAVE;

	return ret;
}

static IV
PerlIOredirect_close(pTHX_ PerlIO * f)
{
	SV * handle;
	IV ret;
	
	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK( sp);
	XPUSHs(newSVuv( PTR2UV( PerlIOBase( f))));
	PUTBACK;
	perl_call_pv("File::Redirect::Close", G_SCALAR);
	SPAGAIN;
	ret = POPi;
	PUTBACK;
	FREETMPS;
	LEAVE;

	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
handle2iobase(fh)
SV* fh;
  CODE:
    RETVAL = PTR2UV(PerlIOBase(IoIFP(sv_2io(fh))));
  OUTPUT:
    RETVAL