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 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;
}
