mirror of
https://github.com/EQEmu/Server.git
synced 2025-12-11 21:01:29 +00:00
b983fac860
- Keeps things tidier.
Perl script was used to get this in order easily.
```pl
my @perl_file_types = (
"bot",
"client",
"doors",
"entity",
"expedition",
"groups",
"hateentry",
"inventory",
"mob",
"npc",
"object",
"perlpacket",
"player_corpse",
"questitem",
"raids",
"spell"
);
foreach my $file_type (sort {$a cmp $b} @perl_file_types) {
my $perl_file = "perl_$file_type.cpp";
open my $client_file, '<', $perl_file or die "Cannot open file_name $perl_file";
{
local $/;
$content = <$client_file>;
}
close $client_file;
open my $perl_data_file, ">", "perl_$file_type\_data.cpp";
my @variables = ();
foreach my $line (split("\n", $content)) {
if ($line=~/newXSproto\(/i) {
$line =~ s/\s+/ /g;
my @line_data = split(/ /, $line);
push(@variables, join(" ", @line_data));
}
}
foreach my $variable (sort {$a cmp $b} @variables) {
$variable =~ s/^ //ig;
print $perl_data_file "\t$variable\n";
}
close $perl_data_file;
}```
421 lines
10 KiB
C++
421 lines
10 KiB
C++
#include "../common/features.h"
|
|
#ifdef EMBPERL_XS_CLASSES
|
|
#include "../common/global_define.h"
|
|
#include "../common/types.h"
|
|
#include "embperl.h"
|
|
|
|
#ifdef seed
|
|
#undef seed
|
|
#endif
|
|
|
|
#include "perlpacket.h"
|
|
|
|
#ifdef THIS /* this macro seems to leak out on some systems */
|
|
#undef THIS
|
|
#endif
|
|
|
|
#define VALIDATE_THIS_IS_PACKET \
|
|
do { \
|
|
if (sv_derived_from(ST(0), "PerlPacket")) { \
|
|
IV tmp = SvIV((SV*)SvRV(ST(0))); \
|
|
THIS = INT2PTR(PerlPacket*, tmp); \
|
|
} else { \
|
|
Perl_croak(aTHX_ "THIS is not of type PerlPacket"); \
|
|
} \
|
|
if (THIS == nullptr) { \
|
|
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
|
|
} \
|
|
} while (0);
|
|
|
|
XS(XS_PerlPacket_new); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_new)
|
|
{
|
|
dXSARGS;
|
|
if (items < 1 || items > 3)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::new(CLASS, opcode= \"OP_Unknown\", len= 0)");
|
|
{
|
|
char *CLASS = (char *)SvPV_nolen(ST(0));
|
|
PerlPacket *RETVAL;
|
|
const char *opcode;
|
|
uint32 len;
|
|
|
|
if (items < 2)
|
|
opcode = "OP_Unknown";
|
|
else {
|
|
opcode = (char *)SvPV_nolen(ST(1));
|
|
}
|
|
|
|
if (items < 3)
|
|
len = 0;
|
|
else {
|
|
len = (uint32)SvUV(ST(2));
|
|
}
|
|
|
|
RETVAL = new PerlPacket(opcode, len);
|
|
ST(0) = sv_newmortal();
|
|
sv_setref_pv(ST(0), "PerlPacket", (void*)RETVAL);
|
|
}
|
|
XSRETURN(1);
|
|
}
|
|
|
|
XS(XS_PerlPacket_DESTROY); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_DESTROY)
|
|
{
|
|
dXSARGS;
|
|
if (items != 1)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::DESTROY(THIS)");
|
|
{
|
|
PerlPacket * THIS;
|
|
VALIDATE_THIS_IS_PACKET;
|
|
delete THIS;
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetOpcode); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetOpcode)
|
|
{
|
|
dXSARGS;
|
|
if (items != 2)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetOpcode(THIS, opcode)");
|
|
{
|
|
PerlPacket * THIS;
|
|
bool RETVAL;
|
|
char * opcode = (char *)SvPV_nolen(ST(1));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
RETVAL = THIS->SetOpcode(opcode);
|
|
ST(0) = boolSV(RETVAL);
|
|
sv_2mortal(ST(0));
|
|
}
|
|
XSRETURN(1);
|
|
}
|
|
|
|
XS(XS_PerlPacket_Resize); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_Resize)
|
|
{
|
|
dXSARGS;
|
|
if (items != 2)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::Resize(THIS, len)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 len = (uint32)SvUV(ST(1));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->Resize(len);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SendTo); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SendTo)
|
|
{
|
|
dXSARGS;
|
|
if (items != 2)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SendTo(THIS, who)");
|
|
{
|
|
PerlPacket * THIS;
|
|
Client * who;
|
|
VALIDATE_THIS_IS_PACKET;
|
|
if (sv_derived_from(ST(1), "Client")) {
|
|
IV tmp = SvIV((SV*)SvRV(ST(1)));
|
|
who = INT2PTR(Client *,tmp);
|
|
}
|
|
else
|
|
Perl_croak(aTHX_ "who is not of type Client");
|
|
if(who == nullptr)
|
|
Perl_croak(aTHX_ "who is nullptr, avoiding crash.");
|
|
|
|
THIS->SendTo(who);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SendToAll); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SendToAll)
|
|
{
|
|
dXSARGS;
|
|
if (items != 1)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SendToAll(THIS)");
|
|
{
|
|
PerlPacket * THIS;
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SendToAll();
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_Zero); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_Zero)
|
|
{
|
|
dXSARGS;
|
|
if (items != 1)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::Zero(THIS)");
|
|
{
|
|
PerlPacket * THIS;
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->Zero();
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_FromArray); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_FromArray)
|
|
{
|
|
dXSARGS;
|
|
if (items != 3)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::FromArray(THIS, numbers, length)");
|
|
{
|
|
PerlPacket * THIS;
|
|
int * numbers;
|
|
uint32 length = (uint32)SvUV(ST(2));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
AV *av_numbers;
|
|
if (SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVAV)
|
|
av_numbers = (AV*)SvRV(ST(1));
|
|
else
|
|
Perl_croak(aTHX_ "numbers is not an array reference");
|
|
I32 len_numbers = av_len(av_numbers) + 1;
|
|
I32 ix_numbers;
|
|
numbers = new int[len_numbers];
|
|
for(ix_numbers = 0; ix_numbers < len_numbers; ix_numbers ++) {
|
|
SV **tmp = av_fetch(av_numbers, ix_numbers, 0);
|
|
if(tmp == nullptr || *tmp == nullptr) {
|
|
numbers[ix_numbers] = 0;
|
|
continue;
|
|
}
|
|
numbers[ix_numbers] = (int)SvIV(*tmp);
|
|
};
|
|
|
|
THIS->FromArray(numbers, length);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetByte); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetByte)
|
|
{
|
|
dXSARGS;
|
|
if (items != 3)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetByte(THIS, pos, val)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
uint8 val = (uint8)SvUV(ST(2));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SetByte(pos, val);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetShort); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetShort)
|
|
{
|
|
dXSARGS;
|
|
if (items != 3)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetShort(THIS, pos, val)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
uint16 val = (uint16)SvUV(ST(2));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SetShort(pos, val);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetLong); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetLong)
|
|
{
|
|
dXSARGS;
|
|
if (items != 3)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetLong(THIS, pos, val)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
uint32 val = (uint32)SvUV(ST(2));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SetLong(pos, val);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetFloat); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetFloat)
|
|
{
|
|
dXSARGS;
|
|
if (items != 3)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetFloat(THIS, pos, val)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
float val = (float)SvNV(ST(2));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SetFloat(pos, val);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetString); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetString)
|
|
{
|
|
dXSARGS;
|
|
if (items != 3)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetString(THIS, pos, str)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
char * str = (char *)SvPV_nolen(ST(2));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SetString(pos, str);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetEQ1319); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetEQ1319)
|
|
{
|
|
dXSARGS;
|
|
if (items != 4)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetEQ1319(THIS, pos, part13, part19)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
float part13 = (float)SvNV(ST(2));
|
|
float part19 = (float)SvNV(ST(3));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SetEQ1319(pos, part13, part19);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_SetEQ1913); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_SetEQ1913)
|
|
{
|
|
dXSARGS;
|
|
if (items != 4)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::SetEQ1913(THIS, pos, part19, part13)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
float part19 = (float)SvNV(ST(2));
|
|
float part13 = (float)SvNV(ST(3));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
THIS->SetEQ1913(pos, part19, part13);
|
|
}
|
|
XSRETURN_EMPTY;
|
|
}
|
|
|
|
XS(XS_PerlPacket_GetByte); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_GetByte)
|
|
{
|
|
dXSARGS;
|
|
if (items != 2)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::GetByte(THIS, pos)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint8 RETVAL;
|
|
dXSTARG;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
RETVAL = THIS->GetByte(pos);
|
|
XSprePUSH; PUSHu((UV)RETVAL);
|
|
}
|
|
XSRETURN(1);
|
|
}
|
|
|
|
XS(XS_PerlPacket_GetShort); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_GetShort)
|
|
{
|
|
dXSARGS;
|
|
if (items != 2)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::GetShort(THIS, pos)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint16 RETVAL;
|
|
dXSTARG;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
RETVAL = THIS->GetShort(pos);
|
|
XSprePUSH; PUSHu((UV)RETVAL);
|
|
}
|
|
XSRETURN(1);
|
|
}
|
|
|
|
XS(XS_PerlPacket_GetLong); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_GetLong)
|
|
{
|
|
dXSARGS;
|
|
if (items != 2)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::GetLong(THIS, pos)");
|
|
{
|
|
PerlPacket * THIS;
|
|
uint32 RETVAL;
|
|
dXSTARG;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
RETVAL = THIS->GetLong(pos);
|
|
XSprePUSH; PUSHu((UV)RETVAL);
|
|
}
|
|
XSRETURN(1);
|
|
}
|
|
|
|
XS(XS_PerlPacket_GetFloat); /* prototype to pass -Wmissing-prototypes */
|
|
XS(XS_PerlPacket_GetFloat)
|
|
{
|
|
dXSARGS;
|
|
if (items != 2)
|
|
Perl_croak(aTHX_ "Usage: PerlPacket::GetFloat(THIS, pos)");
|
|
{
|
|
PerlPacket * THIS;
|
|
float RETVAL;
|
|
dXSTARG;
|
|
uint32 pos = (uint32)SvUV(ST(1));
|
|
VALIDATE_THIS_IS_PACKET;
|
|
RETVAL = THIS->GetFloat(pos);
|
|
XSprePUSH; PUSHn((double)RETVAL);
|
|
}
|
|
XSRETURN(1);
|
|
}
|
|
|
|
#ifdef __cplusplus
|
|
extern "C"
|
|
#endif
|
|
XS(boot_PerlPacket); /* prototype to pass -Wmissing-prototypes */
|
|
XS(boot_PerlPacket)
|
|
{
|
|
dXSARGS;
|
|
char file[256];
|
|
strncpy(file, __FILE__, 256);
|
|
file[255] = 0;
|
|
|
|
if(items != 1)
|
|
fprintf(stderr, "boot_quest does not take any arguments.");
|
|
char buf[128];
|
|
|
|
//add the strcpy stuff to get rid of const warnings....
|
|
|
|
XS_VERSION_BOOTCHECK ;
|
|
newXSproto(strcpy(buf, "DESTROY"), XS_PerlPacket_DESTROY, file, "$");
|
|
newXSproto(strcpy(buf, "FromArray"), XS_PerlPacket_FromArray, file, "$$$");
|
|
newXSproto(strcpy(buf, "GetByte"), XS_PerlPacket_GetByte, file, "$$");
|
|
newXSproto(strcpy(buf, "GetFloat"), XS_PerlPacket_GetFloat, file, "$$");
|
|
newXSproto(strcpy(buf, "GetLong"), XS_PerlPacket_GetLong, file, "$$");
|
|
newXSproto(strcpy(buf, "GetShort"), XS_PerlPacket_GetShort, file, "$$");
|
|
newXSproto(strcpy(buf, "Resize"), XS_PerlPacket_Resize, file, "$$");
|
|
newXSproto(strcpy(buf, "SendTo"), XS_PerlPacket_SendTo, file, "$$");
|
|
newXSproto(strcpy(buf, "SendToAll"), XS_PerlPacket_SendToAll, file, "$");
|
|
newXSproto(strcpy(buf, "SetByte"), XS_PerlPacket_SetByte, file, "$$$");
|
|
newXSproto(strcpy(buf, "SetEQ1319"), XS_PerlPacket_SetEQ1319, file, "$$$$");
|
|
newXSproto(strcpy(buf, "SetEQ1913"), XS_PerlPacket_SetEQ1913, file, "$$$$");
|
|
newXSproto(strcpy(buf, "SetFloat"), XS_PerlPacket_SetFloat, file, "$$$");
|
|
newXSproto(strcpy(buf, "SetLong"), XS_PerlPacket_SetLong, file, "$$$");
|
|
newXSproto(strcpy(buf, "SetOpcode"), XS_PerlPacket_SetOpcode, file, "$$");
|
|
newXSproto(strcpy(buf, "SetShort"), XS_PerlPacket_SetShort, file, "$$$");
|
|
newXSproto(strcpy(buf, "SetString"), XS_PerlPacket_SetString, file, "$$$");
|
|
newXSproto(strcpy(buf, "Zero"), XS_PerlPacket_Zero, file, "$");
|
|
newXSproto(strcpy(buf, "new"), XS_PerlPacket_new, file, "$;$$");
|
|
XSRETURN_YES;
|
|
}
|
|
|
|
#endif //EMBPERL_XS_CLASSES
|
|
|