MP_INLINE static void
modperl_io_perlio_restore_stdhandle(pTHX_ int mode)
{
GV *handle_orig = gv_fetchpv(mode == O_RDONLY ? "STDIN" : "STDOUT",
FALSE, SVt_PVIO);
MP_TRACE_o(MP_FUNC, "start STD%s", mode == O_RDONLY ? "IN" : "OUT");
/* since closing unflushed STDOUT may trigger a subrequest
* (e.g. via mod_include), resulting in potential another response
* handler call, which may try to close STDOUT too. We will
* segfault, if that subrequest doesn't return before the the top
* level STDOUT is attempted to be closed. To prevent this
* situation always explicitly flush STDOUT, before reopening it.
*/
if (mode != O_RDONLY &&
GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig)) &&
(PerlIO_flush(IoOFP(GvIOn(handle_orig))) == -1)) {
Perl_croak(aTHX_ "Failed to flush STDOUT: %" SVf, get_sv("!", TRUE));
}
/* close the overriding filehandle */
do_close(handle_orig, FALSE);
MP_TRACE_o(MP_FUNC, "end STD%s", mode == O_RDONLY ? "IN" : "OUT");
}
HV*
Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
{
char smallbuf[256];
char *tmpbuf;
HV *stash;
GV *tmpgv;
if (namelen + 3 < sizeof smallbuf)
tmpbuf = smallbuf;
else
New(606, tmpbuf, namelen + 3, char);
Copy(name,tmpbuf,namelen,char);
tmpbuf[namelen++] = ':';
tmpbuf[namelen++] = ':';
tmpbuf[namelen] = '\0';
tmpgv = gv_fetchpv(tmpbuf, create, SVt_PVHV);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
if (!tmpgv)
return 0;
if (!GvHV(tmpgv))
GvHV(tmpgv) = newHV();
stash = GvHV(tmpgv);
if (!HvNAME(stash))
HvNAME(stash) = savepv(name);
return stash;
}
ngx_int_t
ngx_http_psgi_perl_init_worker(ngx_cycle_t *cycle)
{
ngx_http_psgi_main_conf_t *psgimcf =
ngx_http_cycle_get_module_main_conf(cycle, ngx_http_psgi_module);
ngx_log_debug1(NGX_LOG_DEBUG_HTTP, cycle->log, 0,
"Init Perl interpreter in worker %d", ngx_pid);
if (psgimcf) {
dTHXa(psgimcf->perl);
PERL_SET_CONTEXT(psgimcf->perl);
/* FIXME: It looks very wrong.
* Has new worker it's own Perl instance?
* I think I should perl_clone() or something like that
* Also $0 (script path) should be set somewhere.
* I don't think it's right place for it. It should be done somewhere in local conf init stuff
* Or, if many handlers share single Perl interpreter - before each handler call
*
* TODO
* Test PID and related stuff
* Test what happens if user try to change
* Test what happens if user does 'fork' inside PSGI app
*/
sv_setiv(GvSV(gv_fetchpv("$$", TRUE, SVt_PV)), (I32) ngx_pid);
} else {
ngx_log_error(NGX_LOG_ALERT, cycle->log, 0, "PSGI panic: no main configuration supplied for init worker %d", ngx_pid);
return NGX_ERROR;
}
return NGX_OK;
}
static void init_perl_variables()
{
dTHX;
GV *exit_gv = gv_fetchpv("CORE::GLOBAL::exit", TRUE, SVt_PVCV);
GvCV(exit_gv) = get_cv("ModPSGI::exit", TRUE);
GvIMPORTED_CV_on(exit_gv);
(void) hv_store(GvHV(PL_envgv), "MOD_PSGI", 8, newSVpv(MOD_PSGI_VERSION, 0), 0);
}
static ngx_int_t
ngx_http_perl_init_worker(ngx_cycle_t *cycle)
{
ngx_http_perl_main_conf_t *pmcf;
pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module);
if (pmcf)
{
dTHXa(pmcf->perl);
PERL_SET_CONTEXT(pmcf->perl);
/* set worker's $$ */
sv_setiv(GvSV(gv_fetchpv("$", TRUE, SVt_PV)), (I32) ngx_pid);
}
return NGX_OK;
}
Glob Interpreter::glob(const char* name) const {
GV* const ret = gv_fetchpv(name, GV_ADD, SVt_PV);
return Glob(raw_interp.get(), ret);
}
void Embperl::DoInit() {
const char *argv_eqemu[] = { "",
#ifdef EMBPERL_IO_CAPTURE
"-w", "-W",
#endif
"-e", "0;", NULL };
int argc = 3;
#ifdef EMBPERL_IO_CAPTURE
argc = 5;
#endif
char **argv = (char **)argv_eqemu;
char **env = { NULL };
PL_perl_destruct_level = 1;
perl_construct(my_perl);
PERL_SYS_INIT3(&argc, &argv, &env);
perl_parse(my_perl, xs_init, argc, argv, env);
perl_run(my_perl);
//a little routine we use a lot.
eval_pv("sub my_eval {eval $_[0];}", TRUE); //dies on error
//ruin the perl exit and command:
eval_pv("sub my_exit {}",TRUE);
eval_pv("sub my_sleep {}",TRUE);
if(gv_stashpv("CORE::GLOBAL", FALSE)) {
GV *exitgp = gv_fetchpv("CORE::GLOBAL::exit", TRUE, SVt_PVCV);
//#if _MSC_VER >= 1600
//GvCV_set(exitgp, perl_get_cv("my_exit", TRUE)); //dies on error
//#else
GvCV(exitgp) = perl_get_cv("my_exit", TRUE); //dies on error
//#endif //dies on error
GvIMPORTED_CV_on(exitgp);
GV *sleepgp = gv_fetchpv("CORE::GLOBAL::sleep", TRUE, SVt_PVCV);
//#if _MSC_VER >= 1600
//GvCV_set(sleepgp, perl_get_cv("my_sleep", TRUE)); //dies on error
//#else
GvCV(sleepgp) = perl_get_cv("my_sleep", TRUE); //dies on error
//#endif
GvIMPORTED_CV_on(sleepgp);
}
//declare our file eval routine.
try {
init_eval_file();
}
catch(const char *err)
{
//remember... lasterr() is no good if we crap out here, in construction
EQC::Common::Log(EQCLog::Error,CP_QUESTS, "perl error: %s", err);
throw "failed to install eval_file hook";
}
#ifdef EMBPERL_IO_CAPTURE
EQC::Common::Log(EQCLog::Debug,CP_QUESTS, "Tying perl output to eqemu logs");
//make a tieable class to capture IO and pass it into EQEMuLog
eval_pv(
"package EQEmuIO; "
// "&boot_EQEmuIO;"
"sub TIEHANDLE { my $me = bless {}, $_[0]; $me->PRINT('Creating '.$me); return($me); } "
"sub WRITE { } "
//dunno why I need to shift off fmt here, but it dosent like without it
"sub PRINTF { my $me = shift; my $fmt = shift; $me->PRINT(sprintf($fmt, @_)); } "
"sub CLOSE { my $me = shift; $me->PRINT('Closing '.$me); } "
"sub DESTROY { my $me = shift; $me->PRINT('Destroying '.$me); } "
//this ties us for all packages, just do it in quest since thats kinda 'our' package
"package quest;"
" if(tied *STDOUT) { untie(*STDOUT); }"
" if(tied *STDERR) { untie(*STDERR); }"
" tie *STDOUT, 'EQEmuIO';"
" tie *STDERR, 'EQEmuIO';"
,FALSE);
#endif //EMBPERL_IO_CAPTURE
#ifdef EMBPERL_PLUGIN
eval_pv(
"package plugin; "
,FALSE
);
#ifdef EMBPERL_EVAL_COMMANDS
try {
eval_pv(
"use IO::Scalar;"
"$plugin::printbuff='';"
"tie *PLUGIN,'IO::Scalar',\\$plugin::printbuff;"
,FALSE);
}
catch(const char *err) {
throw "failed to install plugin printhook, do you lack IO::Scalar?";
}
#endif
EQC::Common::Log(EQCLog::Status,CP_QUESTS, "Loading perlemb plugins.");
try
{
eval_pv("main::eval_file('plugin', 'plugin.pl');", FALSE);
}
catch(const char *err)
{
EQC::Common::Log(EQCLog::Status,CP_QUESTS, "Warning - plugin.pl: %s", err);
}
// Harakiri, this reads all the plugins in \plugins like
// check_handin.pl
// check_hasitem.pl
try
{
//should probably read the directory in c, instead, so that
//I can echo filenames as I do it, but c'mon... I'm lazy and this 1 line reads in all the plugins
eval_pv(
"if(opendir(D,'plugins')) { "
" my @d = readdir(D);"
" closedir(D);"
" foreach(@d){ "
" main::eval_file('plugin','plugins/'.$_)if/\\.pl$/;"
" }"
"}"
,FALSE);
}
catch(const char *err)
{
EQC::Common::Log(EQCLog::Status,CP_QUESTS, "Perl warning while loading plugins : %s", err);
}
// Harakiri, this reads all the plugins in quest\plugins like
try
{
//should probably read the directory in c, instead, so that
//I can echo filenames as I do it, but c'mon... I'm lazy and this 1 line reads in all the plugins
eval_pv(
"if(opendir(D,'quests/plugins/')) { "
" my @d = readdir(D);"
" closedir(D);"
" foreach(@d){ "
" main::eval_file('plugin','quests/plugins/'.$_)if/\\.pl$/;"
" }"
"}"
,FALSE);
}
catch(const char *err)
{
EQC::Common::Log(EQCLog::Status,CP_QUESTS, "Perl warning while loading plugins : %s", err);
}
#endif //EMBPERL_PLUGIN
//Harakiri these are used to create perl bases #commands
#ifdef EMBPERL_COMMANDS
EQC::Common::Log(EQCLog::Normal,CP_QUESTS, "Loading perl commands...");
try
{
eval_pv(
"package commands;"
"main::eval_file('commands', 'commands.pl');"
"&commands::commands_init();"
, FALSE);
}
catch(const char *err)
{
EQC::Common::Log(EQCLog::Error,CP_ZONESERVER, "Warning - commands.pl: %s", err);
}
EQC::Common::Log(EQCLog::Normal,CP_QUESTS, "Perl commands loaded....");
#endif //EMBPERL_COMMANDS
in_use = false;
}
void EQWParser::DoInit() {
const char *argv_eqemu[] = { "",
"-w", "-W",
"-e", "0;", nullptr };
int argc = 5;
char **argv = (char **)argv_eqemu;
char **env = { nullptr };
PL_perl_destruct_level = 1;
perl_construct(my_perl);
PERL_SYS_INIT3(&argc, &argv, &env);
perl_parse(my_perl, xs_init, argc, argv, env);
perl_run(my_perl);
//a little routine we use a lot.
eval_pv("sub my_eval {eval $_[0];}", TRUE); //dies on error
//ruin the perl exit and command:
eval_pv("sub my_exit {}",TRUE);
eval_pv("sub my_sleep {}",TRUE);
if(gv_stashpv("CORE::GLOBAL", FALSE)) {
GV *exitgp = gv_fetchpv("CORE::GLOBAL::exit", TRUE, SVt_PVCV);
GvCV_set(exitgp, perl_get_cv("my_exit", TRUE)); //dies on error
GvIMPORTED_CV_on(exitgp);
GV *sleepgp = gv_fetchpv("CORE::GLOBAL::sleep", TRUE, SVt_PVCV);
GvCV_set(sleepgp, perl_get_cv("my_sleep", TRUE)); //dies on error
GvIMPORTED_CV_on(sleepgp);
}
//setup eval_file
eval_pv(
"our %Cache;"
"use Symbol qw(delete_package);"
"sub eval_file {"
"my($package, $filename) = @_;"
"$filename=~s/\'//g;"
"if(! -r $filename) { print \"Unable to read perl file '$filename'\\n\"; return; }"
"my $mtime = -M $filename;"
"if(defined $Cache{$package}{mtime}&&$Cache{$package}{mtime} <= $mtime && !($package eq 'plugin')){"
" return;"
"} else {"
//we 'my' $filename,$mtime,$package,$sub to prevent them from changing our state up here.
" eval(\"package $package; my(\\$filename,\\$mtime,\\$package,\\$sub); \\$isloaded = 1; require '$filename'; \");"
"}"
"}"
,FALSE);
//make a tie-able class to capture IO and get it where it needs to go
eval_pv(
"package EQWIO; "
// "&boot_EQEmuIO;"
"sub TIEHANDLE { my $me = bless {}, $_[0]; $me->PRINT('Creating '.$me); return($me); } "
"sub WRITE { } "
"sub PRINTF { my $me = shift; my $fmt = shift; $me->PRINT(sprintf($fmt, @_)); } "
"sub CLOSE { my $me = shift; $me->PRINT('Closing '.$me); } "
"sub DESTROY { my $me = shift; $me->PRINT('Destroying '.$me); } "
//this ties us for all packages
"package MAIN;"
" if(tied *STDOUT) { untie(*STDOUT); }"
" if(tied *STDERR) { untie(*STDERR); }"
" tie *STDOUT, 'EQWIO';"
" tie *STDERR, 'EQWIO';"
,FALSE);
eval_pv(
"package world; "
,FALSE
);
//make sure the EQW pointer is set up in this package
EQW *curc = EQW::Singleton();
SV *l = get_sv("world::EQW", true);
if(curc != nullptr) {
sv_setref_pv(l, "EQW", curc);
} else {
//clear out the value, mainly to get rid of blessedness
sv_setsv(l, _empty_sv);
}
//make sure the EQDB pointer is set up in this package
EQDB::SetMySQL(database.getMySQL());
EQDB *curc_db = EQDB::Singleton();
SV *l_db = get_sv("world::EQDB", true);
if(curc_db != nullptr) {
sv_setref_pv(l_db, "EQDB", curc_db);
} else {
//clear out the value, mainly to get rid of blessedness
sv_setsv(l_db, _empty_sv);
}
//load up EQW
eval_pv(
"package EQW;"
"&boot_EQW;" //load our EQW XS
"package EQDB;"
"&boot_EQDB;" //load our EQW XS
"package EQDBRes;"
"&boot_EQDBRes;" //load our EQW XS
"package HTTPRequest;"
"&boot_HTTPRequest;" //load our HTTPRequest XS
"package EQLConfig;"
"&boot_EQLConfig;" //load our EQLConfig XS
, FALSE );
#ifdef EMBPERL_PLUGIN
Log.Out(Logs::Detail, Logs::World_Server, "Loading worldui perl plugins.");
std::string err;
if(!eval_file("world", "worldui.pl", err)) {
Log.Out(Logs::Detail, Logs::World_Server, "Warning - world.pl: %s", err.c_str());
}
eval_pv(
"package world; "
"if(opendir(D,'worldui')) { "
" my @d = readdir(D);"
" closedir(D);"
" foreach(@d){ "
" next unless(/\\.pl$); "
" require 'templates/'.$_;"
" }"
"}"
,FALSE);
#endif //EMBPERL_PLUGIN
}
static int perl_init_aaaa()
{
dTARG;
dSP;
listop_list[0].op_ppaddr = PL_ppaddr[OP_LEAVE];
op_list[0].op_ppaddr = PL_ppaddr[OP_ENTER];
cop_list[0].op_ppaddr = PL_ppaddr[OP_NEXTSTATE];
cop_list[0].cop_warnings = pWARN_STD;
CopFILE_set(&cop_list[0], "hello.p");
CopSTASHPV_set(&cop_list[0], "main");
listop_list[1].op_ppaddr = PL_ppaddr[OP_PRINT];
op_list[1].op_ppaddr = PL_ppaddr[OP_PUSHMARK];
svop_list[0].op_ppaddr = PL_ppaddr[OP_CONST];
gv_list[0] = gv_fetchpv("main::/", TRUE, SVt_PV);
SvFLAGS(gv_list[0]) = 0x600d;
GvFLAGS(gv_list[0]) = 0xa;
GvLINE(gv_list[0]) = 0;
SvPVX(gv_list[0]) = emptystring;
SvREFCNT(gv_list[0]) += 4;
GvREFCNT(gv_list[0]) += 1;
gv_list[1] = gv_fetchpv("main::stderr", TRUE, SVt_PV);
SvFLAGS(gv_list[1]) = 0x600d;
GvFLAGS(gv_list[1]) = 0x2;
GvLINE(gv_list[1]) = 0;
SvPVX(gv_list[1]) = emptystring;
SvREFCNT(gv_list[1]) += 2;
GvREFCNT(gv_list[1]) += 1;
GvSV(gv_list[1]) = &sv_list[0];
GvFILE(gv_list[1]) = "hello.p";
IoIFP((IO*)&sv_list[1])=PerlIO_stderr();
IoOFP((IO*)&sv_list[1])=PerlIO_stderr();
hv0 = gv_stashpv("FileHandle", TRUE);
SvSTASH((IO*)&sv_list[1]) = hv0;
GvIOp(gv_list[1]) = (IO*)&sv_list[1];
gv_list[2] = gv_fetchpv("main::SIG", TRUE, SVt_PV);
SvFLAGS(gv_list[2]) = 0x600d;
GvFLAGS(gv_list[2]) = 0xa;
GvLINE(gv_list[2]) = 62;
SvPVX(gv_list[2]) = emptystring;
SvREFCNT(gv_list[2]) += 12;
GvREFCNT(gv_list[2]) += 1;
gv_list[3] = gv_fetchpv("main::,", TRUE, SVt_PV);
SvFLAGS(gv_list[3]) = 0x600d;
GvFLAGS(gv_list[3]) = 0xa;
GvLINE(gv_list[3]) = 474;
SvPVX(gv_list[3]) = emptystring;
SvREFCNT(gv_list[3]) += 6;
GvREFCNT(gv_list[3]) += 1;
gv_list[4] = gv_fetchpv("utf8::unicode_to_native", TRUE, SVt_PV);
SvFLAGS(gv_list[4]) = 0x600d;
GvFLAGS(gv_list[4]) = 0xa;
GvLINE(gv_list[4]) = 0;
SvPVX(gv_list[4]) = emptystring;
SvREFCNT(gv_list[4]) += 3;
GvREFCNT(gv_list[4]) += 1;
GvSV(gv_list[4]) = &sv_list[2];
GvCV(gv_list[4]) = (CV*)((perl_get_cv("utf8::unicode_to_native",TRUE)));
GvFILE(gv_list[4]) = "hello.p";
gv_list[5] = gv_fetchpv("utf8::encode", TRUE, SVt_PV);
SvFLAGS(gv_list[5]) = 0x600d;
GvFLAGS(gv_list[5]) = 0x2;
GvLINE(gv_list[5]) = 0;
SvPVX(gv_list[5]) = emptystring;
SvREFCNT(gv_list[5]) += 2;
GvREFCNT(gv_list[5]) += 1;
GvSV(gv_list[5]) = &sv_list[3];
GvCV(gv_list[5]) = (CV*)((perl_get_cv("utf8::encode",TRUE)));
GvFILE(gv_list[5]) = "hello.p";
gv_list[6] = gv_fetchpv("utf8::valid", TRUE, SVt_PV);
SvFLAGS(gv_list[6]) = 0x600d;
GvFLAGS(gv_list[6]) = 0x2;
GvLINE(gv_list[6]) = 0;
SvPVX(gv_list[6]) = emptystring;
SvREFCNT(gv_list[6]) += 2;
GvREFCNT(gv_list[6]) += 1;
GvSV(gv_list[6]) = &sv_list[4];
GvCV(gv_list[6]) = (CV*)((perl_get_cv("utf8::valid",TRUE)));
GvFILE(gv_list[6]) = "hello.p";
gv_list[7] = gv_fetchpv("utf8::native_to_unicode", TRUE, SVt_PV);
SvFLAGS(gv_list[7]) = 0x600d;
GvFLAGS(gv_list[7]) = 0x2;
GvLINE(gv_list[7]) = 0;
SvPVX(gv_list[7]) = emptystring;
SvREFCNT(gv_list[7]) += 2;
GvREFCNT(gv_list[7]) += 1;
GvSV(gv_list[7]) = &sv_list[5];
GvCV(gv_list[7]) = (CV*)((perl_get_cv("utf8::native_to_unicode",TRUE)));
GvFILE(gv_list[7]) = "hello.p";
gv_list[8] = gv_fetchpv("utf8::decode", TRUE, SVt_PV);
SvFLAGS(gv_list[8]) = 0x600d;
GvFLAGS(gv_list[8]) = 0x2;
GvLINE(gv_list[8]) = 0;
SvPVX(gv_list[8]) = emptystring;
SvREFCNT(gv_list[8]) += 2;
GvREFCNT(gv_list[8]) += 1;
GvSV(gv_list[8]) = &sv_list[6];
GvCV(gv_list[8]) = (CV*)((perl_get_cv("utf8::decode",TRUE)));
GvFILE(gv_list[8]) = "hello.p";
gv_list[9] = gv_fetchpv("utf8::downgrade", TRUE, SVt_PV);
SvFLAGS(gv_list[9]) = 0x600d;
GvFLAGS(gv_list[9]) = 0x2;
GvLINE(gv_list[9]) = 0;
SvPVX(gv_list[9]) = emptystring;
SvREFCNT(gv_list[9]) += 2;
GvREFCNT(gv_list[9]) += 1;
GvSV(gv_list[9]) = &sv_list[7];
GvCV(gv_list[9]) = (CV*)((perl_get_cv("utf8::downgrade",TRUE)));
GvFILE(gv_list[9]) = "hello.p";
gv_list[10] = gv_fetchpv("utf8::upgrade", TRUE, SVt_PV);
SvFLAGS(gv_list[10]) = 0x600d;
GvFLAGS(gv_list[10]) = 0x2;
GvLINE(gv_list[10]) = 0;
SvPVX(gv_list[10]) = emptystring;
SvREFCNT(gv_list[10]) += 2;
GvREFCNT(gv_list[10]) += 1;
GvSV(gv_list[10]) = &sv_list[8];
GvCV(gv_list[10]) = (CV*)((perl_get_cv("utf8::upgrade",TRUE)));
GvFILE(gv_list[10]) = "hello.p";
gv_list[11] = gv_fetchpv("utf8::is_utf8", TRUE, SVt_PV);
SvFLAGS(gv_list[11]) = 0x600d;
GvFLAGS(gv_list[11]) = 0x2;
GvLINE(gv_list[11]) = 0;
SvPVX(gv_list[11]) = emptystring;
SvREFCNT(gv_list[11]) += 2;
GvREFCNT(gv_list[11]) += 1;
GvSV(gv_list[11]) = &sv_list[9];
GvCV(gv_list[11]) = (CV*)((perl_get_cv("utf8::is_utf8",TRUE)));
GvFILE(gv_list[11]) = "hello.p";
gv_list[12] = gv_fetchpv("main::\"", TRUE, SVt_PV);
SvFLAGS(gv_list[12]) = 0x600d;
GvFLAGS(gv_list[12]) = 0xa;
GvLINE(gv_list[12]) = 0;
SvPVX(gv_list[12]) = emptystring;
SvREFCNT(gv_list[12]) += 10;
GvREFCNT(gv_list[12]) += 1;
gv_list[13] = gv_fetchpv("main::stdout", TRUE, SVt_PV);
SvFLAGS(gv_list[13]) = 0x600d;
GvFLAGS(gv_list[13]) = 0x2;
GvLINE(gv_list[13]) = 0;
SvPVX(gv_list[13]) = emptystring;
SvREFCNT(gv_list[13]) += 2;
GvREFCNT(gv_list[13]) += 1;
GvSV(gv_list[13]) = &sv_list[10];
GvFILE(gv_list[13]) = "hello.p";
IoIFP((IO*)&sv_list[11])=PerlIO_stdout();
IoOFP((IO*)&sv_list[11])=PerlIO_stdout();
SvSTASH((IO*)&sv_list[11]) = hv0;
GvIOp(gv_list[13]) = (IO*)&sv_list[11];
gv_list[14] = gv_fetchpv("main::\022", TRUE, SVt_PV);
SvFLAGS(gv_list[14]) = 0x600d;
GvFLAGS(gv_list[14]) = 0x2;
GvLINE(gv_list[14]) = 0;
SvPVX(gv_list[14]) = emptystring;
SvREFCNT(gv_list[14]) += 2;
GvREFCNT(gv_list[14]) += 1;
gv_list[15] = gv_fetchpv("main::|", TRUE, SVt_PV);
SvFLAGS(gv_list[15]) = 0x600d;
GvFLAGS(gv_list[15]) = 0xa;
GvLINE(gv_list[15]) = 466;
SvPVX(gv_list[15]) = emptystring;
SvREFCNT(gv_list[15]) += 5;
GvREFCNT(gv_list[15]) += 1;
gv_list[16] = gv_fetchpv("Regexp::DESTROY", TRUE, SVt_PV);
SvFLAGS(gv_list[16]) = 0x600d;
GvFLAGS(gv_list[16]) = 0x2;
GvLINE(gv_list[16]) = 0;
SvPVX(gv_list[16]) = emptystring;
SvREFCNT(gv_list[16]) += 2;
GvREFCNT(gv_list[16]) += 1;
GvSV(gv_list[16]) = &sv_list[12];
GvCV(gv_list[16]) = (CV*)((perl_get_cv("Regexp::DESTROY",TRUE)));
GvFILE(gv_list[16]) = "hello.p";
gv_list[17] = gv_fetchpv("main::\f", TRUE, SVt_PV);
SvFLAGS(gv_list[17]) = 0x600d;
GvFLAGS(gv_list[17]) = 0xa;
GvLINE(gv_list[17]) = 554;
SvPVX(gv_list[17]) = emptystring;
SvREFCNT(gv_list[17]) += 4;
GvREFCNT(gv_list[17]) += 1;
gv_list[18] = gv_fetchpv("main::^", TRUE, SVt_PV);
SvFLAGS(gv_list[18]) = 0x600d;
GvFLAGS(gv_list[18]) = 0xa;
GvLINE(gv_list[18]) = 538;
SvPVX(gv_list[18]) = emptystring;
SvREFCNT(gv_list[18]) += 4;
GvREFCNT(gv_list[18]) += 1;
gv_list[19] = gv_fetchpv("main::\001", TRUE, SVt_PV);
SvFLAGS(gv_list[19]) = 0x600d;
GvFLAGS(gv_list[19]) = 0xa;
GvLINE(gv_list[19]) = 562;
SvPVX(gv_list[19]) = emptystring;
SvREFCNT(gv_list[19]) += 5;
GvREFCNT(gv_list[19]) += 1;
gv_list[20] = gv_fetchpv("main::$", TRUE, SVt_PV);
SvFLAGS(gv_list[20]) = 0x600d;
GvFLAGS(gv_list[20]) = 0x2;
GvLINE(gv_list[20]) = 0;
SvPVX(gv_list[20]) = emptystring;
SvREFCNT(gv_list[20]) += 2;
GvREFCNT(gv_list[20]) += 1;
gv_list[21] = gv_fetchpv("main::\\", TRUE, SVt_PV);
SvFLAGS(gv_list[21]) = 0x600d;
GvFLAGS(gv_list[21]) = 0xa;
GvLINE(gv_list[21]) = 441;
SvPVX(gv_list[21]) = emptystring;
SvREFCNT(gv_list[21]) += 9;
GvREFCNT(gv_list[21]) += 1;
gv_list[22] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[22]) = 0x600d;
GvFLAGS(gv_list[22]) = 0x2;
GvLINE(gv_list[22]) = 4294967295;
SvPVX(gv_list[22]) = emptystring;
SvREFCNT(gv_list[22]) += 2;
GvREFCNT(gv_list[22]) += 1;
xpv_list[0].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm", 56);
GvSV(gv_list[22]) = &sv_list[13];
GvFILE(gv_list[22]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[23] = gv_fetchpv("main::~", TRUE, SVt_PV);
SvFLAGS(gv_list[23]) = 0x600d;
GvFLAGS(gv_list[23]) = 0xa;
GvLINE(gv_list[23]) = 530;
SvPVX(gv_list[23]) = emptystring;
SvREFCNT(gv_list[23]) += 4;
GvREFCNT(gv_list[23]) += 1;
gv_list[24] = gv_fetchpv("main::-", TRUE, SVt_PV);
SvFLAGS(gv_list[24]) = 0x600d;
GvFLAGS(gv_list[24]) = 0xa;
GvLINE(gv_list[24]) = 0;
SvPVX(gv_list[24]) = emptystring;
SvREFCNT(gv_list[24]) += 4;
GvREFCNT(gv_list[24]) += 1;
gv_list[25] = gv_fetchpv("main::_<perlmain.c", TRUE, SVt_PV);
SvFLAGS(gv_list[25]) = 0x600d;
GvFLAGS(gv_list[25]) = 0x2;
GvLINE(gv_list[25]) = 0;
SvPVX(gv_list[25]) = emptystring;
SvREFCNT(gv_list[25]) += 2;
GvREFCNT(gv_list[25]) += 1;
xpv_list[1].xpv_pv = savepvn("perlmain.c", 10);
GvSV(gv_list[25]) = &sv_list[14];
GvFILE(gv_list[25]) = "hello.p";
gv_list[26] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/File/Spec/Unix.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[26]) = 0x600d;
GvFLAGS(gv_list[26]) = 0x2;
GvLINE(gv_list[26]) = 98;
SvPVX(gv_list[26]) = emptystring;
SvREFCNT(gv_list[26]) += 2;
GvREFCNT(gv_list[26]) += 1;
xpv_list[2].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/File/Spec/Unix.pm", 38);
GvSV(gv_list[26]) = &sv_list[15];
GvFILE(gv_list[26]) = "x/\031\b q\024\b\332T\305";
gv_list[27] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/C/C.so", TRUE, SVt_PV);
SvFLAGS(gv_list[27]) = 0x600d;
GvFLAGS(gv_list[27]) = 0x2;
GvLINE(gv_list[27]) = 87;
SvPVX(gv_list[27]) = emptystring;
SvREFCNT(gv_list[27]) += 2;
GvREFCNT(gv_list[27]) += 1;
xpv_list[3].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/C/C.so", 58);
GvSV(gv_list[27]) = &sv_list[16];
GvFILE(gv_list[27]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[28] = gv_fetchpv("main::_<universal.c", TRUE, SVt_PV);
SvFLAGS(gv_list[28]) = 0x600d;
GvFLAGS(gv_list[28]) = 0x2;
GvLINE(gv_list[28]) = 0;
SvPVX(gv_list[28]) = emptystring;
SvREFCNT(gv_list[28]) += 2;
GvREFCNT(gv_list[28]) += 1;
xpv_list[4].xpv_pv = savepvn("universal.c", 11);
GvSV(gv_list[28]) = &sv_list[17];
GvFILE(gv_list[28]) = "hello.p";
gv_list[29] = gv_fetchpv("main::BEGIN", TRUE, SVt_PV);
SvFLAGS(gv_list[29]) = 0x600d;
GvFLAGS(gv_list[29]) = 0x2;
GvLINE(gv_list[29]) = 0;
SvPVX(gv_list[29]) = emptystring;
SvREFCNT(gv_list[29]) += 2;
GvREFCNT(gv_list[29]) += 1;
GvSV(gv_list[29]) = &sv_list[18];
GvFILE(gv_list[29]) = "hello.p";
gv_list[30] = gv_fetchpv("main::_<xsutils.c", TRUE, SVt_PV);
SvFLAGS(gv_list[30]) = 0x600d;
GvFLAGS(gv_list[30]) = 0x2;
GvLINE(gv_list[30]) = 0;
SvPVX(gv_list[30]) = emptystring;
SvREFCNT(gv_list[30]) += 2;
GvREFCNT(gv_list[30]) += 1;
xpv_list[5].xpv_pv = savepvn("xsutils.c", 9);
GvSV(gv_list[30]) = &sv_list[19];
GvFILE(gv_list[30]) = "hello.p";
gv_list[31] = gv_fetchpv("main::!", TRUE, SVt_PV);
SvFLAGS(gv_list[31]) = 0x600d;
GvFLAGS(gv_list[31]) = 0xa;
GvLINE(gv_list[31]) = 2054;
SvPVX(gv_list[31]) = emptystring;
SvREFCNT(gv_list[31]) += 3;
GvREFCNT(gv_list[31]) += 1;
GvFILE(gv_list[31]) = "";
gv_list[32] = gv_fetchpv("main::\024AINT", TRUE, SVt_PV);
SvFLAGS(gv_list[32]) = 0x600d;
GvFLAGS(gv_list[32]) = 0xa;
GvLINE(gv_list[32]) = 1589;
SvPVX(gv_list[32]) = emptystring;
SvREFCNT(gv_list[32]) += 3;
GvREFCNT(gv_list[32]) += 1;
sv_magic((SV*)&sv_list[20], (SV*)gv_list[32], '\000', "\024AINT", 5);
GvSV(gv_list[32]) = &sv_list[20];
GvFILE(gv_list[32]) = "";
gv_list[33] = gv_fetchpv("main::\017", TRUE, SVt_PV);
SvFLAGS(gv_list[33]) = 0x600d;
GvFLAGS(gv_list[33]) = 0xa;
GvLINE(gv_list[33]) = 55;
SvPVX(gv_list[33]) = emptystring;
SvREFCNT(gv_list[33]) += 4;
GvREFCNT(gv_list[33]) += 1;
gv_list[34] = gv_fetchpv("main::%", TRUE, SVt_PV);
SvFLAGS(gv_list[34]) = 0x600d;
GvFLAGS(gv_list[34]) = 0xa;
GvLINE(gv_list[34]) = 506;
SvPVX(gv_list[34]) = emptystring;
SvREFCNT(gv_list[34]) += 4;
GvREFCNT(gv_list[34]) += 1;
gv_list[35] = gv_fetchpv("main::\030", TRUE, SVt_PV);
SvFLAGS(gv_list[35]) = 0x600d;
GvFLAGS(gv_list[35]) = 0x2;
GvLINE(gv_list[35]) = 0;
SvPVX(gv_list[35]) = emptystring;
SvREFCNT(gv_list[35]) += 2;
GvREFCNT(gv_list[35]) += 1;
gv_list[36] = gv_fetchpv("main::_", TRUE, SVt_PV);
SvFLAGS(gv_list[36]) = 0x630d;
GvFLAGS(gv_list[36]) = 0xa;
GvLINE(gv_list[36]) = 0;
SvPVX(gv_list[36]) = emptystring;
SvREFCNT(gv_list[36]) += 470;
GvREFCNT(gv_list[36]) += 1;
gv_list[37] = gv_fetchpv("main::+", TRUE, SVt_PV);
SvFLAGS(gv_list[37]) = 0x600d;
GvFLAGS(gv_list[37]) = 0x2;
GvLINE(gv_list[37]) = 0;
SvPVX(gv_list[37]) = emptystring;
SvREFCNT(gv_list[37]) += 2;
GvREFCNT(gv_list[37]) += 1;
gv_list[38] = gv_fetchpv("Internals::SvREFCNT", TRUE, SVt_PV);
SvFLAGS(gv_list[38]) = 0x600d;
GvFLAGS(gv_list[38]) = 0x2;
GvLINE(gv_list[38]) = 0;
SvPVX(gv_list[38]) = emptystring;
SvREFCNT(gv_list[38]) += 2;
GvREFCNT(gv_list[38]) += 1;
GvSV(gv_list[38]) = &sv_list[21];
GvCV(gv_list[38]) = (CV*)((perl_get_cv("Internals::SvREFCNT",TRUE)));
GvFILE(gv_list[38]) = "hello.p";
gv_list[39] = gv_fetchpv("Internals::hv_clear_placeholders", TRUE, SVt_PV);
SvFLAGS(gv_list[39]) = 0x600d;
GvFLAGS(gv_list[39]) = 0x2;
GvLINE(gv_list[39]) = 0;
SvPVX(gv_list[39]) = emptystring;
SvREFCNT(gv_list[39]) += 2;
GvREFCNT(gv_list[39]) += 1;
GvSV(gv_list[39]) = &sv_list[22];
GvCV(gv_list[39]) = (CV*)((perl_get_cv("Internals::hv_clear_placeholders",TRUE)));
GvFILE(gv_list[39]) = "hello.p";
gv_list[40] = gv_fetchpv("Internals::hash_seed", TRUE, SVt_PV);
SvFLAGS(gv_list[40]) = 0x600d;
GvFLAGS(gv_list[40]) = 0x2;
GvLINE(gv_list[40]) = 0;
SvPVX(gv_list[40]) = emptystring;
SvREFCNT(gv_list[40]) += 2;
GvREFCNT(gv_list[40]) += 1;
GvSV(gv_list[40]) = &sv_list[23];
GvCV(gv_list[40]) = (CV*)((perl_get_cv("Internals::hash_seed",TRUE)));
GvFILE(gv_list[40]) = "hello.p";
gv_list[41] = gv_fetchpv("Internals::SvREADONLY", TRUE, SVt_PV);
SvFLAGS(gv_list[41]) = 0x600d;
GvFLAGS(gv_list[41]) = 0x2;
GvLINE(gv_list[41]) = 0;
SvPVX(gv_list[41]) = emptystring;
SvREFCNT(gv_list[41]) += 2;
GvREFCNT(gv_list[41]) += 1;
GvSV(gv_list[41]) = &sv_list[24];
GvCV(gv_list[41]) = (CV*)((perl_get_cv("Internals::SvREADONLY",TRUE)));
GvFILE(gv_list[41]) = "hello.p";
gv_list[42] = gv_fetchpv("Internals::HvREHASH", TRUE, SVt_PV);
SvFLAGS(gv_list[42]) = 0x600d;
GvFLAGS(gv_list[42]) = 0x2;
GvLINE(gv_list[42]) = 0;
SvPVX(gv_list[42]) = emptystring;
SvREFCNT(gv_list[42]) += 2;
GvREFCNT(gv_list[42]) += 1;
GvSV(gv_list[42]) = &sv_list[25];
GvCV(gv_list[42]) = (CV*)((perl_get_cv("Internals::HvREHASH",TRUE)));
GvFILE(gv_list[42]) = "hello.p";
gv_list[43] = gv_fetchpv("Internals::rehash_seed", TRUE, SVt_PV);
SvFLAGS(gv_list[43]) = 0x600d;
GvFLAGS(gv_list[43]) = 0x2;
GvLINE(gv_list[43]) = 0;
SvPVX(gv_list[43]) = emptystring;
SvREFCNT(gv_list[43]) += 2;
GvREFCNT(gv_list[43]) += 1;
GvSV(gv_list[43]) = &sv_list[26];
GvCV(gv_list[43]) = (CV*)((perl_get_cv("Internals::rehash_seed",TRUE)));
GvFILE(gv_list[43]) = "hello.p";
gv_list[44] = gv_fetchpv("main::STDIN", TRUE, SVt_PV);
SvFLAGS(gv_list[44]) = 0x600d;
GvFLAGS(gv_list[44]) = 0xa;
GvLINE(gv_list[44]) = 0;
SvPVX(gv_list[44]) = emptystring;
SvREFCNT(gv_list[44]) += 2;
GvREFCNT(gv_list[44]) += 1;
gv_list[45] = gv_fetchpv("DB::args", TRUE, SVt_PV);
SvFLAGS(gv_list[45]) = 0x600d;
GvFLAGS(gv_list[45]) = 0xa;
GvLINE(gv_list[45]) = 431;
SvPVX(gv_list[45]) = emptystring;
SvREFCNT(gv_list[45]) += 4;
GvREFCNT(gv_list[45]) += 1;
GvSV(gv_list[45]) = &sv_list[27];
GvAV(gv_list[45]) = (AV*)&sv_list[28];
GvFILE(gv_list[45]) = "\260\r\016\b";
gv_list[46] = gv_fetchpv("main::\026", TRUE, SVt_PV);
SvFLAGS(gv_list[46]) = 0x600d;
GvFLAGS(gv_list[46]) = 0xa;
GvLINE(gv_list[46]) = 30;
SvPVX(gv_list[46]) = emptystring;
SvREFCNT(gv_list[46]) += 2;
GvREFCNT(gv_list[46]) += 1;
gv_list[47] = gv_fetchpv("main::=", TRUE, SVt_PV);
SvFLAGS(gv_list[47]) = 0x600d;
GvFLAGS(gv_list[47]) = 0xa;
GvLINE(gv_list[47]) = 514;
SvPVX(gv_list[47]) = emptystring;
SvREFCNT(gv_list[47]) += 4;
GvREFCNT(gv_list[47]) += 1;
gv_list[48] = gv_fetchpv("main::2", TRUE, SVt_PV);
SvFLAGS(gv_list[48]) = 0x600d;
GvFLAGS(gv_list[48]) = 0xa;
GvLINE(gv_list[48]) = 257;
SvPVX(gv_list[48]) = emptystring;
SvREFCNT(gv_list[48]) += 6;
GvREFCNT(gv_list[48]) += 1;
gv_list[49] = gv_fetchpv("main::_<Fcntl.c", TRUE, SVt_PV);
SvFLAGS(gv_list[49]) = 0x600d;
GvFLAGS(gv_list[49]) = 0x2;
GvLINE(gv_list[49]) = 92;
SvPVX(gv_list[49]) = emptystring;
SvREFCNT(gv_list[49]) += 2;
GvREFCNT(gv_list[49]) += 1;
xpv_list[6].xpv_pv = savepvn("Fcntl.c", 7);
GvSV(gv_list[49]) = &sv_list[29];
GvFILE(gv_list[49]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[50] = gv_fetchpv("main::1", TRUE, SVt_PV);
SvFLAGS(gv_list[50]) = 0x600d;
GvFLAGS(gv_list[50]) = 0xa;
GvLINE(gv_list[50]) = 74;
SvPVX(gv_list[50]) = emptystring;
SvREFCNT(gv_list[50]) += 28;
GvREFCNT(gv_list[50]) += 1;
gv_list[51] = gv_fetchpv("main::_<IO.c", TRUE, SVt_PV);
SvFLAGS(gv_list[51]) = 0x600d;
GvFLAGS(gv_list[51]) = 0x2;
GvLINE(gv_list[51]) = 92;
SvPVX(gv_list[51]) = emptystring;
SvREFCNT(gv_list[51]) += 2;
GvREFCNT(gv_list[51]) += 1;
xpv_list[7].xpv_pv = savepvn("IO.c", 4);
GvSV(gv_list[51]) = &sv_list[30];
GvFILE(gv_list[51]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[52] = gv_fetchpv("main::\027ARNING_BITS", TRUE, SVt_PV);
SvFLAGS(gv_list[52]) = 0x600d;
GvFLAGS(gv_list[52]) = 0xa;
GvLINE(gv_list[52]) = 341;
SvPVX(gv_list[52]) = emptystring;
SvREFCNT(gv_list[52]) += 6;
GvREFCNT(gv_list[52]) += 1;
sv_magic((SV*)&sv_list[31], (SV*)gv_list[52], '\000', "\027ARNING_BITS", 12);
GvSV(gv_list[52]) = &sv_list[31];
GvFILE(gv_list[52]) = "\260\r\016\b";
gv_list[53] = gv_fetchpv("main::_<B.c", TRUE, SVt_PV);
SvFLAGS(gv_list[53]) = 0x600d;
GvFLAGS(gv_list[53]) = 0x2;
GvLINE(gv_list[53]) = 92;
SvPVX(gv_list[53]) = emptystring;
SvREFCNT(gv_list[53]) += 2;
GvREFCNT(gv_list[53]) += 1;
xpv_list[8].xpv_pv = savepvn("B.c", 3);
GvSV(gv_list[53]) = &sv_list[32];
GvFILE(gv_list[53]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[54] = gv_fetchpv("main::_<DynaLoader.c", TRUE, SVt_PV);
SvFLAGS(gv_list[54]) = 0x600d;
GvFLAGS(gv_list[54]) = 0x2;
GvLINE(gv_list[54]) = 16;
SvPVX(gv_list[54]) = emptystring;
SvREFCNT(gv_list[54]) += 2;
GvREFCNT(gv_list[54]) += 1;
xpv_list[9].xpv_pv = savepvn("DynaLoader.c", 12);
GvSV(gv_list[54]) = &sv_list[33];
GvFILE(gv_list[54]) = "\335\367\302";
gv_list[55] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/IO/IO.so", TRUE, SVt_PV);
SvFLAGS(gv_list[55]) = 0x600d;
GvFLAGS(gv_list[55]) = 0x2;
GvLINE(gv_list[55]) = 87;
SvPVX(gv_list[55]) = emptystring;
SvREFCNT(gv_list[55]) += 2;
GvREFCNT(gv_list[55]) += 1;
xpv_list[10].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/IO/IO.so", 58);
GvSV(gv_list[55]) = &sv_list[34];
GvFILE(gv_list[55]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[56] = gv_fetchpv("attributes::bootstrap", TRUE, SVt_PV);
SvFLAGS(gv_list[56]) = 0x600d;
GvFLAGS(gv_list[56]) = 0x2;
GvLINE(gv_list[56]) = 0;
SvPVX(gv_list[56]) = emptystring;
SvREFCNT(gv_list[56]) += 2;
GvREFCNT(gv_list[56]) += 1;
GvSV(gv_list[56]) = &sv_list[35];
GvFILE(gv_list[56]) = "hello.p";
gv_list[57] = gv_fetchpv("main::stdin", TRUE, SVt_PV);
SvFLAGS(gv_list[57]) = 0x600d;
GvFLAGS(gv_list[57]) = 0x2;
GvLINE(gv_list[57]) = 0;
SvPVX(gv_list[57]) = emptystring;
SvREFCNT(gv_list[57]) += 2;
GvREFCNT(gv_list[57]) += 1;
GvSV(gv_list[57]) = &sv_list[36];
GvFILE(gv_list[57]) = "hello.p";
IoIFP((IO*)&sv_list[37])=PerlIO_stdin();
IoOFP((IO*)&sv_list[37])=PerlIO_stdin();
SvSTASH((IO*)&sv_list[37]) = hv0;
GvIOp(gv_list[57]) = (IO*)&sv_list[37];
gv_list[58] = gv_fetchpv("main::ARGV", TRUE, SVt_PV);
SvFLAGS(gv_list[58]) = 0x600d;
GvFLAGS(gv_list[58]) = 0x2;
GvLINE(gv_list[58]) = 0;
SvPVX(gv_list[58]) = emptystring;
SvREFCNT(gv_list[58]) += 2;
GvREFCNT(gv_list[58]) += 1;
gv_list[59] = gv_fetchpv("main::INC", TRUE, SVt_PV);
SvFLAGS(gv_list[59]) = 0x600d;
GvFLAGS(gv_list[59]) = 0xa;
GvLINE(gv_list[59]) = 0;
SvPVX(gv_list[59]) = emptystring;
SvREFCNT(gv_list[59]) += 7;
GvREFCNT(gv_list[59]) += 1;
GvSV(gv_list[59]) = &sv_list[38];
xpv_list[11].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi", 44);
xpv_list[12].xpv_pv = savepvn("/usr/lib/perl5/5.8.5", 20);
xpv_list[13].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi", 54);
xpv_list[14].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4/i386-linux-thread-multi", 54);
xpv_list[15].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3/i386-linux-thread-multi", 54);
xpv_list[16].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2/i386-linux-thread-multi", 54);
xpv_list[17].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi", 54);
xpv_list[18].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi", 54);
xpv_list[19].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5", 30);
xpv_list[20].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4", 30);
xpv_list[21].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3", 30);
xpv_list[22].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2", 30);
xpv_list[23].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1", 30);
xpv_list[24].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0", 30);
xpv_list[25].xpv_pv = savepvn("/usr/lib/perl5/site_perl", 24);
xpv_list[26].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi", 56);
xpv_list[27].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4/i386-linux-thread-multi", 56);
xpv_list[28].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3/i386-linux-thread-multi", 56);
xpv_list[29].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2/i386-linux-thread-multi", 56);
xpv_list[30].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi", 56);
xpv_list[31].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi", 56);
xpv_list[32].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5", 32);
xpv_list[33].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4", 32);
xpv_list[34].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3", 32);
xpv_list[35].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2", 32);
xpv_list[36].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1", 32);
xpv_list[37].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0", 32);
xpv_list[38].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl", 26);
xpv_list[39].xpv_pv = savepvn(".", 1);
xpv_list[40].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi", 44);
xpv_list[41].xpv_pv = savepvn("/usr/lib/perl5/5.8.5", 20);
xpv_list[42].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi", 54);
xpv_list[43].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4/i386-linux-thread-multi", 54);
xpv_list[44].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3/i386-linux-thread-multi", 54);
xpv_list[45].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2/i386-linux-thread-multi", 54);
xpv_list[46].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi", 54);
xpv_list[47].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi", 54);
xpv_list[48].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5", 30);
xpv_list[49].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4", 30);
xpv_list[50].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3", 30);
xpv_list[51].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2", 30);
xpv_list[52].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1", 30);
xpv_list[53].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0", 30);
xpv_list[54].xpv_pv = savepvn("/usr/lib/perl5/site_perl", 24);
xpv_list[55].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi", 56);
xpv_list[56].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4/i386-linux-thread-multi", 56);
xpv_list[57].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3/i386-linux-thread-multi", 56);
xpv_list[58].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2/i386-linux-thread-multi", 56);
xpv_list[59].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi", 56);
xpv_list[60].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi", 56);
xpv_list[61].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5", 32);
xpv_list[62].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4", 32);
xpv_list[63].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3", 32);
xpv_list[64].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2", 32);
xpv_list[65].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1", 32);
xpv_list[66].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0", 32);
xpv_list[67].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl", 26);
xpv_list[68].xpv_pv = savepvn(".", 1);
{
SV **svp;
AV *av = (AV*)&sv_list[39];
av_extend(av, 57);
svp = AvARRAY(av);
*svp++ = (SV*)&sv_list[40];
*svp++ = (SV*)&sv_list[41];
*svp++ = (SV*)&sv_list[42];
*svp++ = (SV*)&sv_list[43];
*svp++ = (SV*)&sv_list[44];
*svp++ = (SV*)&sv_list[45];
*svp++ = (SV*)&sv_list[46];
*svp++ = (SV*)&sv_list[47];
*svp++ = (SV*)&sv_list[48];
*svp++ = (SV*)&sv_list[49];
*svp++ = (SV*)&sv_list[50];
*svp++ = (SV*)&sv_list[51];
*svp++ = (SV*)&sv_list[52];
*svp++ = (SV*)&sv_list[53];
*svp++ = (SV*)&sv_list[54];
*svp++ = (SV*)&sv_list[55];
*svp++ = (SV*)&sv_list[56];
*svp++ = (SV*)&sv_list[57];
*svp++ = (SV*)&sv_list[58];
*svp++ = (SV*)&sv_list[59];
*svp++ = (SV*)&sv_list[60];
*svp++ = (SV*)&sv_list[61];
*svp++ = (SV*)&sv_list[62];
*svp++ = (SV*)&sv_list[63];
*svp++ = (SV*)&sv_list[64];
*svp++ = (SV*)&sv_list[65];
*svp++ = (SV*)&sv_list[66];
*svp++ = (SV*)&sv_list[67];
*svp++ = (SV*)&sv_list[68];
*svp++ = (SV*)&sv_list[69];
*svp++ = (SV*)&sv_list[70];
*svp++ = (SV*)&sv_list[71];
*svp++ = (SV*)&sv_list[72];
*svp++ = (SV*)&sv_list[73];
*svp++ = (SV*)&sv_list[74];
*svp++ = (SV*)&sv_list[75];
*svp++ = (SV*)&sv_list[76];
*svp++ = (SV*)&sv_list[77];
*svp++ = (SV*)&sv_list[78];
*svp++ = (SV*)&sv_list[79];
*svp++ = (SV*)&sv_list[80];
*svp++ = (SV*)&sv_list[81];
*svp++ = (SV*)&sv_list[82];
*svp++ = (SV*)&sv_list[83];
*svp++ = (SV*)&sv_list[84];
*svp++ = (SV*)&sv_list[85];
*svp++ = (SV*)&sv_list[86];
*svp++ = (SV*)&sv_list[87];
*svp++ = (SV*)&sv_list[88];
*svp++ = (SV*)&sv_list[89];
*svp++ = (SV*)&sv_list[90];
*svp++ = (SV*)&sv_list[91];
*svp++ = (SV*)&sv_list[92];
*svp++ = (SV*)&sv_list[93];
*svp++ = (SV*)&sv_list[94];
*svp++ = (SV*)&sv_list[95];
*svp++ = (SV*)&sv_list[96];
*svp++ = (SV*)&sv_list[97];
AvFILLp(av) = 57;
}
GvAV(gv_list[59]) = (AV*)&sv_list[39];
GvHV(gv_list[59]) = (HV*)&sv_list[98];
GvFILE(gv_list[59]) = "";
gv_list[60] = gv_fetchpv("main::ENV", TRUE, SVt_PV);
SvFLAGS(gv_list[60]) = 0x600d;
GvFLAGS(gv_list[60]) = 0xa;
GvLINE(gv_list[60]) = 0;
SvPVX(gv_list[60]) = emptystring;
SvREFCNT(gv_list[60]) += 5;
GvREFCNT(gv_list[60]) += 1;
gv_list[61] = gv_fetchpv("main::_<perlio.c", TRUE, SVt_PV);
SvFLAGS(gv_list[61]) = 0x600d;
GvFLAGS(gv_list[61]) = 0x2;
GvLINE(gv_list[61]) = 0;
SvPVX(gv_list[61]) = emptystring;
SvREFCNT(gv_list[61]) += 2;
GvREFCNT(gv_list[61]) += 1;
xpv_list[69].xpv_pv = savepvn("perlio.c", 8);
GvSV(gv_list[61]) = &sv_list[99];
GvFILE(gv_list[61]) = "hello.p";
gv_list[62] = gv_fetchpv("main:::", TRUE, SVt_PV);
SvFLAGS(gv_list[62]) = 0x600d;
GvFLAGS(gv_list[62]) = 0xa;
GvLINE(gv_list[62]) = 546;
SvPVX(gv_list[62]) = emptystring;
SvREFCNT(gv_list[62]) += 4;
GvREFCNT(gv_list[62]) += 1;
gv_list[63] = gv_fetchpv("PerlIO::get_layers", TRUE, SVt_PV);
SvFLAGS(gv_list[63]) = 0x600d;
GvFLAGS(gv_list[63]) = 0x2;
GvLINE(gv_list[63]) = 0;
SvPVX(gv_list[63]) = emptystring;
SvREFCNT(gv_list[63]) += 2;
GvREFCNT(gv_list[63]) += 1;
GvSV(gv_list[63]) = &sv_list[100];
GvCV(gv_list[63]) = (CV*)((perl_get_cv("PerlIO::get_layers",TRUE)));
GvFILE(gv_list[63]) = "hello.p";
gv_list[64] = gv_fetchpv("PerlIO::Layer::NoWarnings", TRUE, SVt_PV);
SvFLAGS(gv_list[64]) = 0x600d;
GvFLAGS(gv_list[64]) = 0x2;
GvLINE(gv_list[64]) = 0;
SvPVX(gv_list[64]) = emptystring;
SvREFCNT(gv_list[64]) += 2;
GvREFCNT(gv_list[64]) += 1;
GvSV(gv_list[64]) = &sv_list[101];
GvCV(gv_list[64]) = (CV*)((perl_get_cv("PerlIO::Layer::NoWarnings",TRUE)));
GvFILE(gv_list[64]) = "hello.p";
gv_list[65] = gv_fetchpv("PerlIO::Layer::find", TRUE, SVt_PV);
SvFLAGS(gv_list[65]) = 0x600d;
GvFLAGS(gv_list[65]) = 0x2;
GvLINE(gv_list[65]) = 0;
SvPVX(gv_list[65]) = emptystring;
SvREFCNT(gv_list[65]) += 2;
GvREFCNT(gv_list[65]) += 1;
GvSV(gv_list[65]) = &sv_list[102];
GvCV(gv_list[65]) = (CV*)((perl_get_cv("PerlIO::Layer::find",TRUE)));
GvFILE(gv_list[65]) = "hello.p";
gv_list[66] = gv_fetchpv("main::0", TRUE, SVt_PV);
SvFLAGS(gv_list[66]) = 0x600d;
GvFLAGS(gv_list[66]) = 0xa;
GvLINE(gv_list[66]) = 0;
SvPVX(gv_list[66]) = emptystring;
SvREFCNT(gv_list[66]) += 5;
GvREFCNT(gv_list[66]) += 1;
gv_list[67] = gv_fetchpv("main::.", TRUE, SVt_PV);
SvFLAGS(gv_list[67]) = 0x600d;
GvFLAGS(gv_list[67]) = 0xa;
GvLINE(gv_list[67]) = 496;
SvPVX(gv_list[67]) = emptystring;
SvREFCNT(gv_list[67]) += 5;
GvREFCNT(gv_list[67]) += 1;
gv_list[68] = gv_fetchpv("main::\b", TRUE, SVt_PV);
SvFLAGS(gv_list[68]) = 0x600d;
GvFLAGS(gv_list[68]) = 0xa;
GvLINE(gv_list[68]) = 0;
SvPVX(gv_list[68]) = emptystring;
SvREFCNT(gv_list[68]) += 5;
GvREFCNT(gv_list[68]) += 1;
gv_list[69] = gv_fetchpv("main::@", TRUE, SVt_PV);
SvFLAGS(gv_list[69]) = 0x600d;
GvFLAGS(gv_list[69]) = 0xa;
GvLINE(gv_list[69]) = 0;
SvPVX(gv_list[69]) = emptystring;
SvREFCNT(gv_list[69]) += 13;
GvREFCNT(gv_list[69]) += 1;
gv_list[70] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/base.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[70]) = 0x600d;
GvFLAGS(gv_list[70]) = 0x2;
GvLINE(gv_list[70]) = 8;
SvPVX(gv_list[70]) = emptystring;
SvREFCNT(gv_list[70]) += 2;
GvREFCNT(gv_list[70]) += 1;
xpv_list[70].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/base.pm", 28);
GvSV(gv_list[70]) = &sv_list[103];
GvFILE(gv_list[70]) = "\270/\r\b";
gv_list[71] = gv_fetchpv("main::STDOUT", TRUE, SVt_PV);
SvFLAGS(gv_list[71]) = 0x630d;
GvFLAGS(gv_list[71]) = 0xa;
GvLINE(gv_list[71]) = 0;
SvPVX(gv_list[71]) = emptystring;
SvREFCNT(gv_list[71]) += 13;
GvREFCNT(gv_list[71]) += 1;
gv_list[72] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/B/C.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[72]) = 0x600d;
GvFLAGS(gv_list[72]) = 0x2;
GvLINE(gv_list[72]) = 1096;
SvPVX(gv_list[72]) = emptystring;
SvREFCNT(gv_list[72]) += 2;
GvREFCNT(gv_list[72]) += 1;
xpv_list[71].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/B/C.pm", 51);
GvSV(gv_list[72]) = &sv_list[104];
GvFILE(gv_list[72]) = "";
gv_list[73] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/B.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[73]) = 0x600d;
GvFLAGS(gv_list[73]) = 0x2;
GvLINE(gv_list[73]) = 87;
SvPVX(gv_list[73]) = emptystring;
SvREFCNT(gv_list[73]) += 2;
GvREFCNT(gv_list[73]) += 1;
xpv_list[72].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/B.pm", 49);
GvSV(gv_list[73]) = &sv_list[105];
GvFILE(gv_list[73]) = "\210\327\a\b\b";
gv_list[74] = gv_fetchpv("main::]", TRUE, SVt_PV);
SvFLAGS(gv_list[74]) = 0x600d;
GvFLAGS(gv_list[74]) = 0xa;
GvLINE(gv_list[74]) = 41;
SvPVX(gv_list[74]) = emptystring;
SvREFCNT(gv_list[74]) += 2;
GvREFCNT(gv_list[74]) += 1;
gv_list[75] = gv_fetchpv("main::\027", TRUE, SVt_PV);
SvFLAGS(gv_list[75]) = 0x600d;
GvFLAGS(gv_list[75]) = 0xa;
GvLINE(gv_list[75]) = 227;
SvPVX(gv_list[75]) = emptystring;
SvREFCNT(gv_list[75]) += 4;
GvREFCNT(gv_list[75]) += 1;
gv_list[76] = gv_fetchpv("main::STDERR", TRUE, SVt_PV);
SvFLAGS(gv_list[76]) = 0x630d;
GvFLAGS(gv_list[76]) = 0xa;
GvLINE(gv_list[76]) = 0;
SvPVX(gv_list[76]) = emptystring;
SvREFCNT(gv_list[76]) += 4;
GvREFCNT(gv_list[76]) += 1;
gv_list[77] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/B.so", TRUE, SVt_PV);
SvFLAGS(gv_list[77]) = 0x600d;
GvFLAGS(gv_list[77]) = 0x2;
GvLINE(gv_list[77]) = 87;
SvPVX(gv_list[77]) = emptystring;
SvREFCNT(gv_list[77]) += 2;
GvREFCNT(gv_list[77]) += 1;
xpv_list[73].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/B.so", 56);
GvSV(gv_list[77]) = &sv_list[106];
GvFILE(gv_list[77]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[78] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/Fcntl/Fcntl.so", TRUE, SVt_PV);
SvFLAGS(gv_list[78]) = 0x600d;
GvFLAGS(gv_list[78]) = 0x2;
GvLINE(gv_list[78]) = 87;
SvPVX(gv_list[78]) = emptystring;
SvREFCNT(gv_list[78]) += 2;
GvREFCNT(gv_list[78]) += 1;
xpv_list[74].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/Fcntl/Fcntl.so", 64);
GvSV(gv_list[78]) = &sv_list[107];
GvFILE(gv_list[78]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
PL_dowarn = ( 0 ) ? G_WARN_ON : G_WARN_OFF;
PL_main_root = (OP*)&listop_list[0];
PL_main_start = &op_list[0];
PL_initav = (AV *) Nullsv;
PL_endav = (AV*) Nullsv;
xpv_list[75].xpv_pv = savepvn("Hello World\n", 12);
{
SV **svp;
AV *av = (AV*)&sv_list[109];
av_extend(av, 2);
svp = AvARRAY(av);
*svp++ = (SV*)&PL_sv_undef;
*svp++ = (SV*)&sv_list[110];
*svp++ = (SV*)&sv_list[111];
AvFILLp(av) = 2;
}
PL_curpad = AvARRAY((AV*)&sv_list[109]);
GvHV(PL_incgv) = (HV*)&sv_list[98];
GvAV(PL_incgv) = (AV*)&sv_list[39];
av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc((AV*)&sv_list[108]));
av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc((AV*)&sv_list[109]));
PL_amagic_generation= 0;
return 0;
}
int
main(int argc, char **argv, char **env)
{
int exitstatus;
int i;
char **fakeargv;
GV* tmpgv;
SV* tmpsv;
int options_count;
PERL_SYS_INIT3(&argc,&argv,&env);
if (!PL_do_undump) {
my_perl = perl_alloc();
if (!my_perl)
exit(1);
perl_construct( my_perl );
PL_perl_destruct_level = 0;
}
#ifdef USE_ITHREADS
for( i = 0; i < 117; ++i ) {
av_push( PL_regex_padav, newSViv(0) );
}
PL_regex_pad = AvARRAY( PL_regex_padav );
#endif
#ifdef CSH
if (!PL_cshlen)
PL_cshlen = strlen(PL_cshname);
#endif
#ifdef ALLOW_PERL_OPTIONS
#define EXTRA_OPTIONS 3
#else
#define EXTRA_OPTIONS 4
#endif /* ALLOW_PERL_OPTIONS */
New(666, fakeargv, argc + EXTRA_OPTIONS + 1, char *);
fakeargv[0] = argv[0];
fakeargv[1] = "-e";
fakeargv[2] = "";
options_count = 3;
if( 0 ) {
fakeargv[options_count] = "-T";
++options_count;
}
#ifndef ALLOW_PERL_OPTIONS
fakeargv[options_count] = "--";
++options_count;
#endif /* ALLOW_PERL_OPTIONS */
for (i = 1; i < argc; i++)
fakeargv[i + options_count - 1] = argv[i];
fakeargv[argc + options_count - 1] = 0;
exitstatus = perl_parse(my_perl, xs_init, argc + options_count - 1,
fakeargv, NULL);
if (exitstatus)
exit( exitstatus );
TAINT;
if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {/* hello.p */
tmpsv = GvSV(tmpgv);
sv_setpv(tmpsv, argv[0]);
SvSETMAGIC(tmpsv);
}
if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */
tmpsv = GvSV(tmpgv);
#ifdef WIN32
sv_setpv(tmpsv,"perl.exe");
#else
sv_setpv(tmpsv,"perl");
#endif
SvSETMAGIC(tmpsv);
}
TAINT_NOT;
/* PL_main_cv = PL_compcv; */
PL_compcv = 0;
exitstatus = perl_init();
if (exitstatus)
exit( exitstatus );
dl_init(aTHX);
exitstatus = perl_run( my_perl );
perl_destruct( my_perl );
perl_free( my_perl );
PERL_SYS_TERM();
exit( exitstatus );
}
if(strEQ("Video", tag))
return SWF_Video_tag;
default:
croak("unknown tag `%s'", tag);
}
}
void export_cv(SV *class, SV *caller, char *sub)
{
GV *gv;
#if 0
fprintf(stderr, "Here is the result: *%s::%s = \\&%s::%s\n",
SvPVX(caller), sub, SvPVX(class), sub);
#endif
gv = gv_fetchpv(form("%s::%s",SvPVX( caller), sub), TRUE, SVt_PVCV);
GvCV(gv) = perl_get_cv(form("%s::%s", SvPVX(class), sub), TRUE);
GvIMPORTED_CV_on(gv);
GvMULTI_on(gv);
}
static void my_import(SV *pclass, SV *caller, SV *sv)
{
char *sym = SvPV(sv,na), **tags;
int i;
switch (*sym) {
case ':':
++sym;
tags = export_tags(sym);
for(i=0; tags[i]; i++) {
void Embperl::DoInit() {
char **argv = (char **)argv_eqemu;
char **env = { nullptr };
my_perl = perl_alloc();
//setup perl...
if(!my_perl)
throw "Failed to init Perl (perl_alloc)";
PERL_SET_CONTEXT(my_perl);
PERL_SET_INTERP(my_perl);
PL_perl_destruct_level = 1;
perl_construct(my_perl);
perl_parse(my_perl, xs_init, argc, argv, nullptr);
perl_run(my_perl);
//a little routine we use a lot.
eval_pv("sub my_eval {eval $_[0];}", TRUE); //dies on error
//ruin the perl exit and command:
eval_pv("sub my_exit {}",TRUE);
eval_pv("sub my_sleep {}",TRUE);
if(gv_stashpv("CORE::GLOBAL", FALSE)) {
GV *exitgp = gv_fetchpv("CORE::GLOBAL::exit", TRUE, SVt_PVCV);
GvCV_set(exitgp, perl_get_cv("my_exit", TRUE)); //dies on error
GvIMPORTED_CV_on(exitgp);
GV *sleepgp = gv_fetchpv("CORE::GLOBAL::sleep", TRUE, SVt_PVCV);
GvCV_set(sleepgp, perl_get_cv("my_sleep", TRUE)); //dies on error
GvIMPORTED_CV_on(sleepgp);
}
//declare our file eval routine.
try {
init_eval_file();
}
catch(const char *err)
{
//remember... lasterr() is no good if we crap out here, in construction
Log.Out(Logs::General, Logs::Quests, "perl error: %s", err);
throw "failed to install eval_file hook";
}
#ifdef EMBPERL_IO_CAPTURE
Log.Out(Logs::General, Logs::Quests, "Tying perl output to eqemu logs");
//make a tieable class to capture IO and pass it into EQEMuLog
eval_pv(
"package EQEmuIO; "
"sub TIEHANDLE { my $me = bless {}, $_[0]; $me->PRINT('Creating '.$me); return($me); } "
"sub WRITE { } "
//dunno why I need to shift off fmt here, but it dosent like without it
"sub PRINTF { my $me = shift; my $fmt = shift; $me->PRINT(sprintf($fmt, @_)); } "
"sub CLOSE { my $me = shift; $me->PRINT('Closing '.$me); } "
"sub DESTROY { my $me = shift; $me->PRINT('Destroying '.$me); } "
//this ties us for all packages, just do it in quest since thats kinda 'our' package
"package quest;"
" if(tied *STDOUT) { untie(*STDOUT); }"
" if(tied *STDERR) { untie(*STDERR); }"
" tie *STDOUT, 'EQEmuIO';"
" tie *STDERR, 'EQEmuIO';"
,FALSE);
#endif //EMBPERL_IO_CAPTURE
#ifdef EMBPERL_PLUGIN
eval_pv(
"package plugin; "
,FALSE
);
Log.Out(Logs::General, Logs::Quests, "Loading perlemb plugins.");
try
{
eval_pv("main::eval_file('plugin', 'plugin.pl');", FALSE);
}
catch(const char *err)
{
Log.Out(Logs::General, Logs::Quests, "Warning - plugin.pl: %s", err);
}
try
{
//should probably read the directory in c, instead, so that
//I can echo filenames as I do it, but c'mon... I'm lazy and this 1 line reads in all the plugins
eval_pv(
"if(opendir(D,'plugins')) { "
" my @d = readdir(D);"
" closedir(D);"
" foreach(@d){ "
" main::eval_file('plugin','plugins/'.$_)if/\\.pl$/;"
" }"
"}"
,FALSE);
}
catch(const char *err)
{
Log.Out(Logs::General, Logs::Quests, "Perl warning: %s", err);
}
#endif //EMBPERL_PLUGIN
in_use = false;
}
