Perl parser works, still needs a little cleanup

This commit is contained in:
KimLS
2013-05-09 14:52:20 -07:00
parent b6c0e7c302
commit 0e4ac63b6b
10 changed files with 4528 additions and 4846 deletions
+37 -64
View File
@@ -21,26 +21,22 @@ Eglin
#define GvCV_set(gv,cv) (GvCV(gv) = (cv))
#endif
//PERL_TODO:
//#ifdef EMBPERL_XS
//EXTERN_C XS(boot_quest);
//#ifdef EMBPERL_XS_CLASSES
//EXTERN_C XS(boot_Mob);
//EXTERN_C XS(boot_NPC);
//EXTERN_C XS(boot_Client);
//EXTERN_C XS(boot_Corpse);
//EXTERN_C XS(boot_EntityList);
//EXTERN_C XS(boot_Group);
//EXTERN_C XS(boot_Raid);
//EXTERN_C XS(boot_QuestItem);
//EXTERN_C XS(boot_HateEntry);
//EXTERN_C XS(boot_Object);
//EXTERN_C XS(boot_Doors);
//EXTERN_C XS(boot_PerlPacket);
//#endif
//#endif
#ifdef EMBPERL_COMMANDS
XS(XS_command_add);
#ifdef EMBPERL_XS
EXTERN_C XS(boot_quest);
#ifdef EMBPERL_XS_CLASSES
EXTERN_C XS(boot_Mob);
EXTERN_C XS(boot_NPC);
EXTERN_C XS(boot_Client);
EXTERN_C XS(boot_Corpse);
EXTERN_C XS(boot_EntityList);
EXTERN_C XS(boot_Group);
EXTERN_C XS(boot_Raid);
EXTERN_C XS(boot_QuestItem);
EXTERN_C XS(boot_HateEntry);
EXTERN_C XS(boot_Object);
EXTERN_C XS(boot_Doors);
EXTERN_C XS(boot_PerlPacket);
#endif
#endif
#ifdef EMBPERL_IO_CAPTURE
@@ -61,33 +57,26 @@ EXTERN_C void xs_init(pTHX)
newXS(strcpy(buf, "DynaLoader::boot_DynaLoader"), boot_DynaLoader, file);
newXS(strcpy(buf, "quest::boot_qc"), boot_qc, file);
//PERL_TODO:
//#ifdef EMBPERL_XS
// newXS(strcpy(buf, "quest::boot_quest"), boot_quest, file);
//#ifdef EMBPERL_XS_CLASSES
// newXS(strcpy(buf, "Mob::boot_Mob"), boot_Mob, file);
// newXS(strcpy(buf, "NPC::boot_Mob"), boot_Mob, file);
// newXS(strcpy(buf, "NPC::boot_NPC"), boot_NPC, file);
///// newXS(strcpy(buf, "NPC::new"), XS_NPC_new, file);
// newXS(strcpy(buf, "Corpse::boot_Mob"), boot_Mob, file);
// newXS(strcpy(buf, "Corpse::boot_Corpse"), boot_Corpse, file);
// newXS(strcpy(buf, "Client::boot_Mob"), boot_Mob, file);
// newXS(strcpy(buf, "Client::boot_Client"), boot_Client, file);
//// newXS(strcpy(buf, "Client::new"), XS_Client_new, file);
// newXS(strcpy(buf, "EntityList::boot_EntityList"), boot_EntityList, file);
//// newXS(strcpy(buf, "EntityList::new"), XS_EntityList_new, file);
// newXS(strcpy(buf, "PerlPacket::boot_PerlPacket"), boot_PerlPacket, file);
// newXS(strcpy(buf, "Group::boot_Group"), boot_Group, file);
// newXS(strcpy(buf, "Raid::boot_Raid"), boot_Raid, file);
// newXS(strcpy(buf, "QuestItem::boot_QuestItem"), boot_QuestItem, file);
// newXS(strcpy(buf, "HateEntry::boot_HateEntry"), boot_HateEntry, file);
// newXS(strcpy(buf, "Object::boot_Object"), boot_Object, file);
// newXS(strcpy(buf, "Doors::boot_Doors"), boot_Doors, file);
//;
//#endif
//#endif
#ifdef EMBPERL_COMMANDS
newXS(strcpy(buf, "commands::command_add"), XS_command_add, file);
#ifdef EMBPERL_XS
newXS(strcpy(buf, "quest::boot_quest"), boot_quest, file);
#ifdef EMBPERL_XS_CLASSES
newXS(strcpy(buf, "Mob::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "NPC::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "NPC::boot_NPC"), boot_NPC, file);
newXS(strcpy(buf, "Corpse::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "Corpse::boot_Corpse"), boot_Corpse, file);
newXS(strcpy(buf, "Client::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "Client::boot_Client"), boot_Client, file);
newXS(strcpy(buf, "EntityList::boot_EntityList"), boot_EntityList, file);
newXS(strcpy(buf, "PerlPacket::boot_PerlPacket"), boot_PerlPacket, file);
newXS(strcpy(buf, "Group::boot_Group"), boot_Group, file);
newXS(strcpy(buf, "Raid::boot_Raid"), boot_Raid, file);
newXS(strcpy(buf, "QuestItem::boot_QuestItem"), boot_QuestItem, file);
newXS(strcpy(buf, "HateEntry::boot_HateEntry"), boot_HateEntry, file);
newXS(strcpy(buf, "Object::boot_Object"), boot_Object, file);
newXS(strcpy(buf, "Doors::boot_Doors"), boot_Doors, file);
;
#endif
#endif
#ifdef EMBPERL_IO_CAPTURE
newXS(strcpy(buf, "EQEmuIO::PRINT"), XS_EQEmuIO_PRINT, file);
@@ -161,14 +150,13 @@ void Embperl::DoInit() {
//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
//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); }"
@@ -211,21 +199,6 @@ void Embperl::DoInit() {
LogFile->write(EQEMuLog::Quest, "Perl warning: %s", err);
}
#endif //EMBPERL_PLUGIN
#ifdef EMBPERL_COMMANDS
LogFile->write(EQEMuLog::Quest, "Loading perl commands...");
try
{
eval_pv(
"package commands;"
"main::eval_file('commands', 'commands.pl');"
"&commands::commands_init();"
, FALSE);
}
catch(const char *err)
{
LogFile->write(EQEMuLog::Quest, "Warning - commands.pl: %s", err);
}
#endif //EMBPERL_COMMANDS
in_use = false;
}