// Get everything going...
int __declspec( dllexport ) __stdcall LoadDll( LOADINFO * limIRC ) {
mWnd = limIRC->mHwnd;
limIRC->mKeep = TRUE; // TODO: Set to FALSE if the inline perl fails
if ( my_perl == NULL ) {
/* Get things set for mIRC<=>perl IO */
hMapFile = CreateFileMapping( INVALID_HANDLE_VALUE, 0, PAGE_READWRITE, 0, 4096, NAMESPACE );
mData = ( LPSTR )MapViewOfFile( hMapFile, FILE_MAP_ALL_ACCESS, 0, 0, 0 );
/* Create our persistant interpreter */
char * perl_args[] = { "", "-e", "", "0" };
PERL_SYS_INIT3( NULL, NULL, NULL );
if ( ( my_perl = perl_alloc() ) == NULL ) {
mIRC_execute( "/echo Failed to load DLL: No memory" ); /* TODO: make this an error message */
limIRC->mKeep = FALSE;
return 0;
}
perl_construct( my_perl );
PL_origalen = 1; /* Don't let $0 assignment update the proctitle or perl_args[0] */
perl_parse( my_perl, xs_init, 6, perl_args, NULL );
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_run( my_perl );
{
#ifdef PERLIO_LAYERS /* Layers available */
PerlIO_define_layer( aTHX_ PERLIO_FUNCS_CAST( &PerlIO_mIRC ) );
PerlIO_apply_layers( aTHX_ PerlIO_stderr( ), NULL, ":mIRC" );
PerlIO_apply_layers( aTHX_ PerlIO_stdout( ), NULL, ":mIRC" );
#endif /* PERLIO_LAYERS */
}
SV * result = eval_pv( form(
"use FindBin;" /* CORE */
"use lib qq[$FindBin::Bin/lib];" /* Search %mIRC%/lib for modules */
"use lib qq[$FindBin::Bin/perl];" /* Look for modules in %mIRC%/perl */
"my $mIRC = bless \{ }, 'mIRC';"
void init_idamsg_io(pTHX)
{
tracemsg("init_idamsg_io1\n");
PerlIO_define_layer(aTHX_ &PerlIO_idamsg);
//binmode ":idamsg", stdout;
PerlIO_push(aTHX_ PerlIO_stdout(), &PerlIO_idamsg, "a", NULL);
//binmode ":idamsg", stderr;
PerlIO_push(aTHX_ PerlIO_stderr(), &PerlIO_idamsg, "a", NULL);
}
PerlInterpreter *
ngx_http_psgi_create_interpreter(ngx_conf_t *cf)
{
int n;
PerlInterpreter *perl;
ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cf->log, 0,
"Create PSGI Perl interpreter");
/* FIXME: Some code from ngx_http_perl_module.c I don't understand */
if (ngx_set_environment(cf->cycle, NULL) == NULL) {
return NULL;
}
perl = perl_alloc();
if (perl == NULL) {
ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_alloc() failed");
return NULL;
}
{
char *my_argv[] = { "", "-MIO::Handle", "-e", "0" };
dTHXa(perl);
PERL_SET_CONTEXT(perl);
perl_construct(perl);
n = perl_parse(perl, xs_init, 3, my_argv, NULL);
if (n != 0) {
ngx_log_error(NGX_LOG_ALERT, cf->log, 3, "perl_parse() failed: %d", n);
goto fail;
}
PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_nginx_error));
}
return perl;
fail:
(void) perl_destruct(perl);
perl_free(perl);
return NULL;
}
