pa/eqemu-server
2
0
Fork 0
mirror of https://github.com/EQEmu/Server.git synced 2025-12-11 12:41:30 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

[Quest API] Use binding library for perl apis (#2216)

Browse Source 
* Add perlbind library

* Convert perl apis to perlbind
This commit is contained in:
hg 2022-07-03 22:33:45 -04:00 committed by GitHub
parent 2829d21057
commit 7e8a24fcec
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
50 changed files with 14324 additions and 31962 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CMakeLists.txt
View File

@ -373,7 +373,7 @@ ENDIF()
IF(PERL_LIBRARY_ENABLED)
OPTION(EQEMU_BUILD_PERL "Build Perl parser." ON)
IF(EQEMU_BUILD_PERL)
SET(SERVER_LIBS ${SERVER_LIBS} ${PERL_LIBRARY_LIBS})
SET(SERVER_LIBS ${SERVER_LIBS} ${PERL_LIBRARY_LIBS} perlbind)
INCLUDE_DIRECTORIES(SYSTEM "${PERL_LIBRARY_INCLUDE}")
ADD_DEFINITIONS(-DEMBPERL)
ADD_DEFINITIONS(-DEMBPERL_PLUGIN)

4
libs/CMakeLists.txt
View File

@ -1,3 +1,7 @@
IF(EQEMU_BUILD_LUA)
ADD_SUBDIRECTORY(luabind)
ENDIF(EQEMU_BUILD_LUA)
IF(EQEMU_BUILD_PERL)
ADD_SUBDIRECTORY(perlbind)
ENDIF(EQEMU_BUILD_PERL)

21
libs/perlbind/.gitignore vendored Normal file
View File

@ -0,0 +1,21 @@
*
!.gitignore
!.editorconfig
!CMakeLists.txt
!LICENSE
!README.md
!.github/
!.github/**
!doc/
!doc/**
!include/
!include/**
!src/
!src/*
!test/
!test/*

64
libs/perlbind/CMakeLists.txt Normal file
View File

@ -0,0 +1,64 @@
cmake_minimum_required(VERSION 3.7)
project(perlbind LANGUAGES CXX)
set(CMAKE_FIND_LIBRARY_SUFFIXES ".lib" ".so" ".a")
find_package(PerlLibs)
set(PERLBIND_HEADERS
include/perlbind/array.h
include/perlbind/forward.h
include/perlbind/function.h
include/perlbind/hash.h
include/perlbind/interpreter.h
include/perlbind/iterator.h
include/perlbind/package.h
include/perlbind/perlbind.h
include/perlbind/scalar.h
include/perlbind/stack.h
include/perlbind/stack_push.h
include/perlbind/stack_read.h
include/perlbind/subcaller.h
include/perlbind/traits.h
include/perlbind/typemap.h
include/perlbind/types.h
include/perlbind/util.h
include/perlbind/version.h
)
set(PERLBIND_SOURCES
src/function.cpp
src/hash.cpp
src/interpreter.cpp
src/package.cpp
)
if(MSVC)
set(PERLBIND_SOURCES ${PERLBIND_SOURCES} src/perlbind.natvis)
endif()
add_library(perlbind ${PERLBIND_SOURCES} ${PERLBIND_HEADERS})
target_include_directories(perlbind PUBLIC
${PERL_INCLUDE_PATH}
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
$<INSTALL_INTERFACE:include>)
option(PERLBIND_BUILD_TESTS "Build tests" OFF)
option(PERLBIND_ENABLE_ASAN "Build with address sanitizer" OFF)
if(PERLBIND_ENABLE_ASAN)
target_compile_options(perlbind PRIVATE -fsanitize=address -fno-omit-frame-pointer)
target_link_options(perlbind PRIVATE -fsanitize=address -fno-omit-frame-pointer)
endif()
if(PERLBIND_BUILD_TESTS)
enable_testing()
add_subdirectory(test)
set_property(DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} PROPERTY VS_STARTUP_PROJECT tests)
target_include_directories(tests PRIVATE
${PERL_INCLUDE_PATH}
${CMAKE_CURRENT_SOURCE_DIR}/include)
endif()

19
libs/perlbind/LICENSE Normal file
View File

@ -0,0 +1,19 @@
Copyright (c) 2022 hg
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

119
libs/perlbind/include/perlbind/array.h Normal file
View File

@ -0,0 +1,119 @@
#pragma once
#include "types.h"
#include "iterator.h"
#include <stdexcept>
namespace perlbind {
struct array : public type_base
{
using iterator = detail::array_iterator;
~array() noexcept
{
SvREFCNT_dec(m_av);
}
array() noexcept
: type_base(), m_av(newAV()) {}
array(PerlInterpreter* interp) noexcept
: type_base(interp), m_av(newAV()) {}
array(const array& other) noexcept
: type_base(other.my_perl), m_av(copy_array(other.m_av)) {}
array(array&& other) noexcept
: type_base(other.my_perl), m_av(other.m_av)
{
other.m_av = newAV();
}
array(AV*& value) noexcept
: type_base(), m_av(copy_array(value)) {}
array(AV*&& value) noexcept
: type_base(), m_av(value) {} // take ownership
array(scalar ref)
: type_base(ref.my_perl)
{
if (!ref.is_array_ref())
throw std::runtime_error("cannot construct array from non-array reference");
reset(reinterpret_cast<AV*>(SvREFCNT_inc(*ref)));
}
array(scalar_proxy proxy)
: array(scalar(SvREFCNT_inc(proxy.sv()))) {}
array& operator=(const array& other) noexcept
{
if (this != &other)
m_av = copy_array(other.m_av);
return *this;
}
array& operator=(array&& other) noexcept
{
if (this != &other)
std::swap(m_av, other.m_av);
return *this;
}
array& operator=(AV*& value) noexcept
{
if (m_av != value)
m_av = copy_array(value);
return *this;
}
array& operator=(AV*&& value) noexcept
{
reset(value);
return *this;
}
operator AV*() const { return m_av; }
operator SV*() const { return reinterpret_cast<SV*>(m_av); }
AV* release() noexcept
{
AV* tmp = m_av;
m_av = newAV();
return tmp;
}
void reset(AV* value) noexcept
{
SvREFCNT_dec(m_av);
m_av = value;
}
void clear() noexcept { av_clear(m_av); } // decreases refcnt of all SV elements
scalar pop_back() noexcept { return av_pop(m_av); }
scalar pop_front() noexcept { return av_shift(m_av); }
void push_back(const scalar& value) { av_push(m_av, newSVsv(value)); }
void push_back(scalar&& value) { av_push(m_av, value.release()); }
void reserve(size_t count) { av_extend(m_av, count > 0 ? count - 1 : 0); }
size_t size() const { return av_len(m_av) + 1; }
SV* sv() const { return reinterpret_cast<SV*>(m_av); }
// returns a proxy that takes ownership of one reference to the SV element
// extends the array and creates an undef SV if index out of range
scalar_proxy operator[](size_t index)
{
SV** sv = av_fetch(m_av, index, 1);
return scalar_proxy(my_perl, SvREFCNT_inc(*sv));
}
iterator begin() const noexcept { return { my_perl, m_av, 0 }; }
iterator end() const noexcept { return { my_perl, m_av, size() }; }
private:
AV* copy_array(AV* other)
{
return av_make(av_len(other)+1, AvARRAY(other));
}
AV* m_av = nullptr;
};
} // namespace perlbind

22
libs/perlbind/include/perlbind/forward.h Normal file
View File

@ -0,0 +1,22 @@
#pragma once
namespace perlbind {
namespace detail {
class xsub_stack;
struct function_base;
struct array_iterator;
struct hash_iterator;
} // namespace detail
class interpreter;
class package;
struct scalar;
struct scalar_proxy;
struct reference;
struct array;
struct hash;
} // namespace perlbind

144
libs/perlbind/include/perlbind/function.h Normal file
View File

@ -0,0 +1,144 @@
#pragma once
namespace perlbind { namespace detail {
// traits for function and class method exports
template <typename Ret, typename Class, typename... Args>
struct base_traits
{
using return_t = Ret;
using sig_t = util::type_name<Args...>;
using stack_tuple = std::conditional_t<std::is_void<Class>::value,
std::tuple<Args...>,
std::tuple<Class*, Args...>>;
static constexpr int arity = sizeof...(Args);
static constexpr int stack_arity = sizeof...(Args) + (std::is_void<Class>::value ? 0 : 1);
static constexpr int vararg_count = count_of<array, Args...>::value +
count_of<hash, Args...>::value;
static constexpr bool is_vararg = vararg_count > 0;
static constexpr bool is_vararg_last = is_last<array, Args...>::value ||
is_last<hash, Args...>::value;
static_assert(!is_vararg || (vararg_count == 1 && is_vararg_last),
"A function may only accept a single array or hash and it must be "
"be the last parameter. Prefer using reference parameters instead.");
};
template <typename T, bool = std::is_class<T>::value>
struct function_traits : public function_traits<decltype(&T::operator()), true> {};
template <typename Ret, typename... Args>
struct function_traits<Ret(*)(Args...), false> : base_traits<Ret, void, Args...>
{
using type = Ret(*)(Args...);
};
template <typename Ret, typename Class, typename... Args>
struct function_traits<Ret(Class::*)(Args...), false> : base_traits<Ret, Class, Args...>
{
using type = Ret(Class::*)(Args...);
};
template <typename Ret, typename Class, typename... Args>
struct function_traits<Ret(Class::*)(Args...) const, false> : base_traits<Ret, Class, Args...>
{
using type = Ret(Class::*)(Args...) const;
};
template <typename Ret, typename Class, typename... Args>
struct function_traits<Ret(Class::*)(Args...) const, true> : base_traits<Ret, void, Args...>
{
using type = Ret(*)(Args...);
};
// represents a bound native function
struct function_base
{
virtual ~function_base() = default;
virtual std::string get_signature() const = 0;
virtual bool is_compatible(xsub_stack&) const = 0;
virtual void call(xsub_stack&) const = 0;
static const MGVTBL mgvtbl;
};
template <typename T>
struct function : public function_base, function_traits<T>
{
using target_t = typename function::type;
using return_t = typename function::return_t;
function() = delete;
function(PerlInterpreter* interp, T func)
: my_perl(interp), m_func(func) {}
std::string get_signature() const override
{
return util::type_name<target_t>::str();
};
bool is_compatible(xsub_stack& stack) const override
{
return function::is_vararg || stack.check_types(typename function::stack_tuple{});
}
void call(xsub_stack& stack) const override
{
if (!function::is_vararg && stack.size() != function::stack_arity)
{
using sig = typename function::sig_t;
int count = std::is_member_function_pointer<T>::value ? stack.size() - 1 : stack.size();
SV* err = newSVpvf("'%s(%s)' called with %d argument(s), expected %d\n argument(s): (%s)\n",
stack.name().c_str(), sig::str().c_str(), count, function::arity, stack.types().c_str());
err = sv_2mortal(err);
throw std::runtime_error(SvPV_nolen(err));
}
call_impl(stack, std::is_void<function::return_t>());
}
private:
void call_impl(xsub_stack& stack, std::false_type) const
{
return_t result = apply(m_func, stack.convert_stack(typename function::stack_tuple{}));
stack.push_return(std::move(result));
}
void call_impl(xsub_stack& stack, std::true_type) const
{
apply(m_func, stack.convert_stack(typename function::stack_tuple{}));
}
// c++14 call function template with tuple arg unpacking (c++17 can use std::apply())
template <typename F, typename Tuple, size_t... I>
auto call_func(F func, Tuple&& t, std::index_sequence<I...>) const
{
return func(std::get<I>(std::forward<Tuple>(t))...);
}
template <typename F, typename Tuple, size_t... I>
auto call_member(F method, Tuple&& t, std::index_sequence<I...>) const
{
return (std::get<0>(t)->*method)(std::get<I + 1>(std::forward<Tuple>(t))...);
}
template <typename F, typename Tuple, std::enable_if_t<!std::is_member_function_pointer<F>::value, bool> = true>
auto apply(F func, Tuple&& t) const
{
using make_sequence = std::make_index_sequence<std::tuple_size<Tuple>::value>;
return call_func(func, std::forward<Tuple>(t), make_sequence{});
}
template <typename F, typename Tuple, std::enable_if_t<std::is_member_function_pointer<F>::value, bool> = true>
auto apply(F func, Tuple&& t) const
{
using make_sequence = std::make_index_sequence<std::tuple_size<Tuple>::value - 1>;
return call_member(func, std::forward<Tuple>(t), make_sequence{});
}
PerlInterpreter* my_perl = nullptr;
T m_func;
};
} // namespace detail
} // namespace perlbind

124
libs/perlbind/include/perlbind/hash.h Normal file
View File

@ -0,0 +1,124 @@
#pragma once
#include "types.h"
#include <string>
namespace perlbind {
struct hash : public type_base
{
using iterator = detail::hash_iterator;
~hash() noexcept
{
SvREFCNT_dec(m_hv);
}
hash() noexcept
: type_base(), m_hv(newHV()) {}
hash(PerlInterpreter* interp) noexcept
: type_base(interp), m_hv(newHV()) {}
hash(const hash& other) noexcept
: type_base(other.my_perl), m_hv(copy_hash(other.m_hv)) {}
hash(hash&& other) noexcept
: type_base(other.my_perl), m_hv(other.m_hv)
{
other.m_hv = newHV();
}
hash(HV*& value) noexcept
: type_base(), m_hv(copy_hash(value)) {}
hash(HV*&& value) noexcept
: type_base(), m_hv(value) {} // take ownership
hash(scalar ref);
hash(scalar_proxy proxy);
hash& operator=(const hash& other) noexcept
{
if (this != &other)
m_hv = copy_hash(other.m_hv);
return *this;
}
hash& operator=(hash&& other) noexcept
{
if (this != &other)
std::swap(m_hv, other.m_hv);
return *this;
}
hash& operator=(HV*& value) noexcept
{
if (m_hv != value)
m_hv = copy_hash(value);
return *this;
}
hash& operator=(HV*&& value) noexcept
{
reset(value);
return *this;
}
operator HV*() const { return m_hv; }
operator SV*() const { return reinterpret_cast<SV*>(m_hv); }
HV* release() noexcept
{
HV* tmp = m_hv;
m_hv = newHV();
return tmp;
}
void reset(HV* value) noexcept
{
SvREFCNT_dec(m_hv);
m_hv = value;
}
scalar at(const char* key);
scalar at(const std::string& key);
void clear() noexcept { hv_clear(m_hv); }
bool exists(const char* key) const
{
return hv_exists(m_hv, key, static_cast<I32>(strlen(key)));
}
bool exists(const std::string& key) const
{
return hv_exists(m_hv, key.c_str(), static_cast<I32>(key.size()));
}
void insert(const char* key, scalar value);
void insert(const std::string& key, scalar value);
void remove(const char* key)
{
hv_delete(m_hv, key, static_cast<I32>(strlen(key)), 0);
}
void remove(const std::string& key)
{
hv_delete(m_hv, key.c_str(), static_cast<I32>(key.size()), 0);
}
size_t size() const { return HvTOTALKEYS(m_hv); }
SV* sv() const { return reinterpret_cast<SV*>(m_hv); }
// returns a proxy that takes ownership of one reference to the SV value
// creates an undef SV entry for the key if it doesn't exist
scalar_proxy operator[](const std::string& key);
iterator begin() const noexcept;
iterator end() const noexcept;
iterator find(const char* key);
iterator find(const std::string& key);
private:
scalar at(const char* key, size_t size);
iterator find(const char* key, size_t size);
void insert(const char* key, size_t size, scalar value);
HV* copy_hash(HV* other) noexcept;
HV* m_hv = nullptr;
};
} // namespace perlbind

63
libs/perlbind/include/perlbind/interpreter.h Normal file
View File

@ -0,0 +1,63 @@
#pragma once
namespace perlbind {
class interpreter
{
public:
interpreter();
interpreter(PerlInterpreter* interp) : my_perl(interp) {}
interpreter(int argc, const char** argv);
interpreter(const interpreter& other) = delete;
interpreter(interpreter&& other) = delete;
interpreter& operator=(const interpreter& other) = delete;
interpreter& operator=(interpreter&& other) = delete;
~interpreter();
PerlInterpreter* get() const { return my_perl; }
void load_script(std::string packagename, std::string filename);
void eval(const char* str);
template <typename T, typename... Args>
T call_sub(const char* subname, Args&&... args) const
{
detail::sub_caller caller(my_perl);
return caller.call_sub<T>(subname, std::forward<Args>(args)...);
}
// returns interface to add bindings to package name
package new_package(const char* name)
{
return package(my_perl, name);
}
// registers type for blessing objects, returns interface
template <typename T>
class_<T> new_class(const char* name)
{
static_assert(!std::is_pointer<T>::value && !std::is_reference<T>::value,
"new_class<T> 'T' should not be a pointer or reference");
auto typemap = detail::typemap::get(my_perl);
auto type_id = detail::usertype<T*>::id();
typemap[type_id] = name;
return class_<T>(my_perl, name);
}
// helper to bind functions in default main:: package
template <typename T>
void add(const char* name, T&& func)
{
new_package("main").add(name, std::forward<T>(func));
}
private:
void init(int argc, const char** argv);
bool m_is_owner = false;
PerlInterpreter* my_perl = nullptr;
};
} // namespace perlbind

100
libs/perlbind/include/perlbind/iterator.h Normal file
View File

@ -0,0 +1,100 @@
#pragma once
namespace perlbind { namespace detail {
struct array_iterator
{
array_iterator() = default;
array_iterator(PerlInterpreter* interp, AV* av, size_t index)
: my_perl(interp), m_av(av), m_index(index), m_scalar(interp)
{
fetch();
}
bool operator!=(const array_iterator& other) const
{
return m_index != other.m_index;
}
array_iterator& operator++()
{
++m_index;
fetch();
return *this;
}
scalar* operator->()
{
return &m_scalar;
}
scalar& operator*()
{
return m_scalar;
}
private:
void fetch()
{
SV** sv = av_fetch(m_av, m_index, 0);
if (sv)
m_scalar = SvREFCNT_inc(*sv);
}
PerlInterpreter* my_perl;
AV* m_av;
size_t m_index;
scalar m_scalar;
};
struct hash_iterator
{
hash_iterator() = default;
hash_iterator(PerlInterpreter* interp, HV* hv, HE* he)
: my_perl(interp), m_hv(hv), m_he(he)
{
fetch();
}
bool operator==(const hash_iterator& other) const
{
return m_he == other.m_he;
}
bool operator!=(const hash_iterator& other) const
{
return !(*this == other);
}
hash_iterator& operator++()
{
m_he = hv_iternext(m_hv);
fetch();
return *this;
}
std::pair<const char*, scalar>* operator->()
{
return &m_pair;
}
std::pair<const char*, scalar>& operator*()
{
return m_pair;
}
private:
void fetch()
{
if (m_he)
m_pair = { HePV(m_he, PL_na), scalar(my_perl, SvREFCNT_inc(HeVAL(m_he))) };
}
PerlInterpreter* my_perl;
HV* m_hv;
HE* m_he;
std::pair<const char*, scalar> m_pair;
};
} // namespace detail
} // namespace perlbind

59
libs/perlbind/include/perlbind/package.h Normal file
View File

@ -0,0 +1,59 @@
#pragma once
#include <string>
namespace perlbind {
class package
{
public:
virtual ~package() = default;
package() = delete;
package(PerlInterpreter* interp, const char* name)
: my_perl(interp), m_name(name), m_stash(gv_stashpv(name, GV_ADD))
{}
// bind a function pointer to a function name in the package
// overloads with same name must be explicit (default parameters not supported)
// overloads have a runtime lookup cost and chooses the first compatible overload
template <typename T>
void add(const char* name, T func)
{
// ownership of function object is given to perl
auto function = new detail::function<T>(my_perl, func);
add_impl(name, static_cast<detail::function_base*>(function));
}
// specify a base class name for object inheritance (must be registered)
// calling object methods missing from the package will search parent classes
// base classes are searched in registered order and include any grandparents
void add_base_class(const char* name)
{
std::string package_isa = m_name + "::ISA";
AV* av = get_av(package_isa.c_str(), GV_ADD);
array isa_array = reinterpret_cast<AV*>(SvREFCNT_inc(av));
isa_array.push_back(name);
}
// add a constant value to this package namespace
template <typename T>
void add_const(const char* name, T&& value)
{
newCONSTSUB(m_stash, name, scalar(value).release());
}
private:
void add_impl(const char* name, detail::function_base* function);
std::string m_name;
PerlInterpreter* my_perl = nullptr;
HV* m_stash = nullptr;
};
template <typename T>
struct class_ : public package
{
using package::package;
};
} // namespace perlbind

55
libs/perlbind/include/perlbind/perlbind.h Normal file
View File

@ -0,0 +1,55 @@
#pragma once
// Defining PERLBIND_STRICT_NUMERIC_TYPES will enable strict type checks
// for integers and floats.This is required for overloads that depend on
// int and float type differences.
// #define PERLBIND_STRICT_NUMERIC_TYPES
// Defining PERLBIND_NO_STRICT_SCALAR_TYPES will disable strict type checks
// for all int, float, and string function arguments. These types will only
// be checked for scalar validity and converted to the function's expected
// paramter type. This will break overloads that depend on distinct types.
// This option overrides PERLBIND_STRICT_NUMERIC_TYPES.
//#define PERLBIND_NO_STRICT_SCALAR_TYPES
// defining PERL_NO_GET_CONTEXT gets context from local variable "my_perl"
// instead of calling Perl_get_context() in macros
#define PERL_NO_GET_CONTEXT
#define WIN32IO_IS_STDIO
#if _MSC_VER
#define __inline__ __inline
// perl 5.30+ defines HAS_BUILTIN_EXPECT for msvc which breaks builds
#define __builtin_expect(expr,val) (expr)
// avoid INT64_C and UINT64_C redefinition warnings
#if PERL_VERSION < 28
#include <cstdint>
#endif
#endif
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
// short name perl macros that cause issues
#undef Move
#undef Copy
#undef Zero
#undef list
#undef seed
#undef do_open
#undef do_close
#include <perlbind/version.h>
#include <perlbind/forward.h>
#include <perlbind/util.h>
#include <perlbind/traits.h>
#include <perlbind/hash.h>
#include <perlbind/typemap.h>
#include <perlbind/scalar.h>
#include <perlbind/array.h>
#include <perlbind/stack.h>
#include <perlbind/subcaller.h>
#include <perlbind/function.h>
#include <perlbind/package.h>
#include <perlbind/interpreter.h>

254
libs/perlbind/include/perlbind/scalar.h Normal file
View File

@ -0,0 +1,254 @@
#pragma once
#include "types.h"
#include <string>
#include <type_traits>
namespace perlbind {
struct scalar : type_base
{
virtual ~scalar() noexcept
{
SvREFCNT_dec(m_sv);
}
scalar() noexcept
: type_base(), m_sv(newSV(0)) {} // nothing allocated
scalar(PerlInterpreter* interp) noexcept
: type_base(interp), m_sv(newSV(0)) {}
scalar(PerlInterpreter* interp, SV*&& sv) noexcept
: type_base(interp), m_sv(sv) {}
scalar(const scalar& other) noexcept
: type_base(other.my_perl), m_sv(newSVsv(other.m_sv)) {}
scalar(scalar&& other) noexcept
: type_base(other.my_perl), m_sv(other.m_sv)
{
other.m_sv = newSV(0);
}
scalar(SV*& value) noexcept
: type_base(), m_sv(newSVsv(value)) {}
scalar(SV*&& value) noexcept
: type_base(), m_sv(value) {}
scalar(const char* value) noexcept
: type_base(), m_sv(newSVpv(value, 0)) {}
scalar(const std::string& value) noexcept
: type_base(), m_sv(newSVpvn(value.c_str(), value.size())) {}
template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
scalar(T value) noexcept : type_base(), m_sv(newSViv(static_cast<IV>(value))) {}
template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
scalar(T value) noexcept : type_base(), m_sv(newSVuv(value)) {}
template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
scalar(T value) noexcept : type_base(), m_sv(newSVnv(value)) {}
template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
scalar(T value) noexcept : type_base(), m_sv(newSV(0))
{
*this = std::move(value);
}
scalar& operator=(const scalar& other) noexcept
{
if (this != &other)
sv_setsv(m_sv, other.m_sv);
return *this;
}
scalar& operator=(scalar&& other) noexcept
{
if (this != &other)
std::swap(m_sv, other.m_sv);
return *this;
}
scalar& operator=(SV*& value) noexcept
{
sv_setsv(m_sv, value);
return *this;
}
scalar& operator=(SV*&& value) noexcept
{
reset(value);
return *this;
}
scalar& operator=(const char* value) noexcept
{
sv_setpv(m_sv, value);
return *this;
}
scalar& operator=(const std::string& value) noexcept
{
sv_setpvn(m_sv, value.c_str(), value.size());
return *this;
}
template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
scalar& operator=(T value) noexcept
{
sv_setiv(m_sv, static_cast<IV>(value));
return *this;
}
template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
scalar& operator=(T value) noexcept
{
sv_setuv(m_sv, value);
return *this;
}
template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
scalar& operator=(T value) noexcept
{
sv_setnv(m_sv, value);
return *this;
}
template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
scalar& operator=(T value) noexcept
{
// bless if it's in the typemap
const char* type_name = detail::typemap::template get_name<T>(my_perl);
sv_setref_pv(m_sv, type_name, static_cast<void*>(value));
return *this;
}
operator SV*() const { return m_sv; }
operator void*() const { return m_sv; }
operator const char*() const { return SvPV_nolen(m_sv); }
operator std::string() const { return SvPV_nolen(m_sv); }
template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
operator T() const { return static_cast<T>(SvIV(m_sv)); }
template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
operator T() const { return static_cast<T>(SvUV(m_sv)); }
template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
operator T() const { return static_cast<T>(SvNV(m_sv)); }
template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
operator T() const
{
const char* type_name = detail::typemap::template get_name<T>(my_perl);
if (type_name && sv_isobject(m_sv) && sv_derived_from(m_sv, type_name))
{
IV tmp = SvIV(SvRV(m_sv));
return INT2PTR(T, tmp);
}
return nullptr;
}
template <typename T>
T as() const { return static_cast<T>(*this); }
// release ownership of SV
SV* release() noexcept
{
SV* tmp = m_sv;
m_sv = newSV(0);
return tmp;
}
// take ownership of an SV
void reset(SV* value) noexcept
{
SvREFCNT_dec(m_sv);
m_sv = value;
}
SV* sv() const { return m_sv; }
SV* deref() const { return SvRV(m_sv); }
size_t size() const { return SvPOK(m_sv) ? sv_len(m_sv) : 0; }
svtype type() const { return SvTYPE(m_sv); }
const char* c_str() const { return SvPV_nolen(m_sv); }
SV* operator*() { return SvRV(m_sv); }
bool is_null() const { return type() == SVt_NULL; } //SvOK(m_sv)
bool is_integer() const { return SvIOK(m_sv); }
bool is_float() const { return SvNOK(m_sv); }
bool is_string() const { return SvPOK(m_sv); }
bool is_reference() const { return SvROK(m_sv); }
bool is_scalar_ref() const { return SvROK(m_sv) && SvTYPE(SvRV(m_sv)) < SVt_PVAV; }
bool is_array_ref() const { return SvROK(m_sv) && SvTYPE(SvRV(m_sv)) == SVt_PVAV; }
bool is_hash_ref() const { return SvROK(m_sv) && SvTYPE(SvRV(m_sv)) == SVt_PVHV; }
protected:
SV* m_sv = nullptr;
};
// references are scalars that take ownership of one new reference to a value
// use reset() to take ownership of an existing RV
struct reference : public scalar
{
reference() = default;
template <typename T, std::enable_if_t<std::is_base_of<type_base, T>::value, bool> = true>
reference(T& value) noexcept : scalar(value.my_perl, nullptr) { m_sv = newRV_inc(value); }
// increments referent for rvalues of scalar objects (not raw SVs) since they dec on destruct
template <typename T, std::enable_if_t<std::is_base_of<type_base, T>::value, bool> = true>
reference(T&& value) noexcept : scalar(value.my_perl, nullptr) { m_sv = newRV_inc(value); }
template <typename T, std::enable_if_t<detail::is_any<T, SV*, AV*, HV*>::value, bool> = true>
reference(T& value) noexcept { reset(newRV_inc(reinterpret_cast<SV*>(value))); }
template <typename T, std::enable_if_t<detail::is_any<T, SV*, AV*, HV*>::value, bool> = true>
reference(T&& value) noexcept { reset(newRV_noinc(reinterpret_cast<SV*>(value))); }
SV* operator*() { return SvRV(m_sv); }
};
// scalar proxy reference is used for array and hash index operator[] overloads
struct scalar_proxy
{
scalar_proxy() = delete;
scalar_proxy(PerlInterpreter* interp, scalar&& value) noexcept
: my_perl(interp), m_value(std::move(value)) {}
SV* sv() const { return m_value; }
const char* c_str() const { return static_cast<const char*>(m_value); }
template <typename T>
T as() const { return m_value.as<T>(); }
operator std::string() const { return m_value; }
// copying value to supported conversion types (e.g. int val = arr[i])
template <typename T, std::enable_if_t<!std::is_base_of<type_base, T>::value, bool> = true>
operator T() const
{
return static_cast<T>(m_value);
}
// taking a reference to the source SV (e.g. scalar val = arr[i])
template <typename T, std::enable_if_t<std::is_same<T, scalar>::value, bool> = true>
operator T() const
{
return SvREFCNT_inc(m_value);
}
// assigning scalar to proxy, the source SV is modified (arr[i] = "new value")
scalar_proxy& operator=(scalar value)
{
m_value = value;
return *this;
}
scalar_proxy& operator=(const scalar_proxy& other)
{
m_value = other.m_value;
return *this;
}
// todo: nested proxy[]
private:
PerlInterpreter* my_perl = nullptr;
scalar m_value;
};
} // namespace perlbind

137
libs/perlbind/include/perlbind/stack.h Normal file
View File

@ -0,0 +1,137 @@
#pragma once
#include "stack_push.h"
#include "stack_read.h"
#include <algorithm>
#include <string>
#include <tuple>
namespace perlbind { namespace detail {
// handles xsub call stack from perl, inherits stack::pusher to push return values
class xsub_stack : public stack::pusher
{
public:
xsub_stack() = delete;
xsub_stack(PerlInterpreter* my_perl, CV* cv)
: stack::pusher(my_perl)
{
GV* gv = CvGV(cv);
m_sub_name = GvNAME(gv);
m_pkg_name = HvNAME(GvSTASH(gv));
dXSARGS;
this->sp = sp;
this->ax = ax;
this->mark = mark;
this->items = items;
}
~xsub_stack() { XSRETURN(m_pushed); }
int size() const { return items; }
std::string name() const { return std::string(pkg_name()) + "::" + sub_name(); }
const char* pkg_name() const { return m_pkg_name; }
const char* sub_name() const { return m_sub_name; }
template <typename T>
void push_return(T&& value)
{
XSprePUSH;
push(std::forward<T>(value));
}
// returns true if all perl stack arguments are compatible with expected native arg types
template <typename Tuple>
bool check_types(Tuple&& types)
{
static constexpr int count = std::tuple_size<Tuple>::value;
if (items != count)
return false;
else if (count == 0)
return true;
using make_sequence = std::make_index_sequence<count>;
return check_stack(std::forward<Tuple>(types), make_sequence());
}
// returns tuple of converted perl stack arguments, throws on an incompatible type
template <typename Tuple>
auto convert_stack(Tuple&& types)
{
using make_sequence = std::make_index_sequence<std::tuple_size<Tuple>::value>;
return get_stack(std::forward<Tuple>(types), make_sequence());
}
std::string types()
{
std::string args;
for (int i = 0; i < items; ++i)
{
args += get_type_name(ST(i));
if (i < (items - 1))
args += ", ";
}
return args.empty() ? "void" : args;
}
protected:
int ax = 0;
int items = 0;
SV** mark = nullptr;
const char* m_pkg_name = nullptr;
const char* m_sub_name = nullptr;
std::string get_type_name(SV* item)
{
switch (SvTYPE(item))
{
case SVt_NULL: return "<undefined>";
case SVt_NV: return "double";
case SVt_PV: return "string";
case SVt_PVAV: return "array";
case SVt_PVHV: return "hash";
case SVt_IV:
if (sv_isobject(item))
return std::string(sv_reftype(SvRV(item), true)) + "*";
else if (SvROK(item))
return "ref";
else
return "int";
default:
return sv_reftype(item, true);
}
}
private:
template <typename T>
bool check_index(T t, size_t index)
{
return stack::read_as<T>::check(my_perl, static_cast<int>(index), ax, items);
}
// return true if perl stack matches all expected argument types in tuple
template <typename Tuple, size_t... I>
bool check_stack(Tuple&& t, std::index_sequence<I...>)
{
// lists compatibility of each expected arg type (no short-circuit)
std::initializer_list<bool> res = {
check_index(std::get<I>(std::forward<Tuple>(t)), I)... };
return std::all_of(res.begin(), res.end(), [](bool same) { return same; });
}
template <typename T>
T get_stack_index(T t, size_t index)
{
return stack::read_as<T>::get(my_perl, static_cast<int>(index), ax, items);
}
template <typename Tuple, size_t... I>
auto get_stack(Tuple&& t, std::index_sequence<I...>)
{
return Tuple{ get_stack_index(std::get<I>(std::forward<Tuple>(t)), I)... };
}
};
} // namespace detail
} // namespace perlbind

118
libs/perlbind/include/perlbind/stack_push.h Normal file
View File

@ -0,0 +1,118 @@
#pragma once
#include <string>
namespace perlbind { namespace stack {
// base class for pushing value types to perl stack
// methods use macros that push new mortalized SVs but do not extend the stack
// the stack is only extended when pushing an array, hash, or using push_args().
// this is because for xsubs the "stack is always large enough to take one return value"
struct pusher
{
virtual ~pusher() = default;
pusher() = delete;
pusher(PerlInterpreter* interp) : my_perl(interp), sp(PL_stack_sp) {}
SV* pop() { return POPs; }
void push(bool value) { PUSHs(boolSV(value)); ++m_pushed; }
void push(const char* value)
{
if (!value)
PUSHs(&PL_sv_undef);
else
mPUSHp(value, strlen(value));
++m_pushed;
}
void push(const std::string& value) { mPUSHp(value.c_str(), value.size()); ++m_pushed; }
void push(scalar value) { mPUSHs(value.release()); ++m_pushed; };
void push(reference value) { mPUSHs(value.release()); ++m_pushed; };
void push(array value)
{
int count = static_cast<int>(value.size());
EXTEND(sp, count);
for (int i = 0; i < count; ++i)
{
// mortalizes one reference to array element to avoid copying
PUSHs(sv_2mortal(SvREFCNT_inc(value[i].sv())));
}
m_pushed += count;
}
void push(hash value)
{
// hashes are pushed to the perl stack as alternating keys and values
// this is less efficient than pushing a reference to the hash
auto count = hv_iterinit(value) * 2;
EXTEND(sp, count);
while (HE* entry = hv_iternext(value))
{
auto val = HeVAL(entry);
PUSHs(hv_iterkeysv(entry)); // mortalizes new key sv (keys are not stored as sv)
PUSHs(sv_2mortal(SvREFCNT_inc(val)));
}
m_pushed += count;
}
template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
void push(T value) { mPUSHi(static_cast<IV>(value)); ++m_pushed; }
template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
void push(T value) { mPUSHu(value); ++m_pushed; }
template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
void push(T value) { mPUSHn(value); ++m_pushed; }
template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
void push(T value)
{
const char* type_name = detail::typemap::get_name<T>(my_perl);
if (!type_name)
{
throw std::runtime_error("cannot push unregistered pointer of type '" + util::type_name<T>::str() + "'");
}
SV* sv = sv_newmortal();
sv_setref_pv(sv, type_name, static_cast<void*>(value));
PUSHs(sv);
++m_pushed;
};
void push(void* value)
{
SV* sv = sv_newmortal();
sv_setref_pv(sv, nullptr, value); // unblessed
PUSHs(sv);
++m_pushed;
}
template <typename... Args>
void push_args(Args&&... args)
{
EXTEND(sp, sizeof...(Args));
push_args_impl(std::forward<Args>(args)...);
};
protected:
PerlInterpreter* my_perl = nullptr;
SV** sp = nullptr;
int m_pushed = 0;
private:
template <typename... Args>
void push_args_impl(Args&&... args) {}
template <typename T, typename... Args>
void push_args_impl(T&& value, Args&&... args)
{
push(std::forward<T>(value));
push_args_impl(std::forward<Args>(args)...);
}
};
} // namespace stack
} // namespace perlbind

266
libs/perlbind/include/perlbind/stack_read.h Normal file
View File

@ -0,0 +1,266 @@
#pragma once
#include <string>
namespace perlbind { namespace stack {
// perl stack reader to convert types, throws if perl stack value isn't type compatible
template <typename T, typename = void>
struct read_as;
template <typename T>
struct read_as<T, std::enable_if_t<std::is_integral<T>::value || std::is_enum<T>::value>>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
#ifdef PERLBIND_NO_STRICT_SCALAR_TYPES
return SvTYPE(ST(i)) < SVt_PVAV;
#elif !defined PERLBIND_STRICT_NUMERIC_TYPES
return SvNIOK(ST(i));
#else
return SvIOK(ST(i));
#endif
}
static T get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be an integer");
}
return static_cast<T>(SvIV(ST(i))); // unsigned and bools casted
}
};
template <typename T>
struct read_as<T, std::enable_if_t<std::is_floating_point<T>::value>>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
#ifdef PERLBIND_NO_STRICT_SCALAR_TYPES
return SvTYPE(ST(i)) < SVt_PVAV;
#elif !defined PERLBIND_STRICT_NUMERIC_TYPES
return SvNIOK(ST(i));
#else
return SvNOK(ST(i));
#endif
}
static T get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a floating point");
}
return static_cast<T>(SvNV(ST(i)));
}
};
template <>
struct read_as<const char*>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
#ifdef PERLBIND_NO_STRICT_SCALAR_TYPES
return SvTYPE(ST(i)) < SVt_PVAV;
#else
return SvPOK(ST(i));
#endif
}
static const char* get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a string");
}
return static_cast<const char*>(SvPV_nolen(ST(i)));
}
};
template <>
struct read_as<std::string> : read_as<const char*>
{
};
template <>
struct read_as<void*>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
return sv_isobject(ST(i));
}
static void* get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference to an object");
}
IV tmp = SvIV(SvRV(ST(i)));
return INT2PTR(void*, tmp);
}
};
template <typename T>
struct read_as<T, std::enable_if_t<std::is_pointer<T>::value>>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
const char* type_name = detail::typemap::get_name<T>(my_perl);
return type_name && sv_isobject(ST(i)) && sv_derived_from(ST(i), type_name);
}
static T get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
// would prefer to check for unregistered types at compile time (not possible?)
const char* type_name = detail::typemap::get_name<T>(my_perl);
if (!type_name)
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference to an unregistered type (method unusable)");
}
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference to an object of type '" + type_name + "'");
}
IV tmp = SvIV(SvRV(ST(i)));
return INT2PTR(T, tmp);
}
};
template <typename T>
struct read_as<nullable<T>>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
return true;
}
static nullable<T> get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (sv_isobject(ST(i)))
{
const char* type_name = detail::typemap::get_name<T>(my_perl);
if (type_name && sv_derived_from(ST(i), type_name))
{
IV tmp = SvIV(SvRV(ST(i)));
return INT2PTR(T, tmp);
}
}
return nullptr;
}
};
template <>
struct read_as<SV*>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
return i < items;
}
static SV* get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be valid scalar value");
}
return ST(i);
}
};
// scalar, array, and hash readers return reference to stack items (not copies)
template <>
struct read_as<scalar>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
return (SvROK(ST(i)) && SvTYPE(SvRV(ST(i))) < SVt_PVAV) || SvTYPE(ST(i)) < SVt_PVAV;
}
static scalar get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a scalar or reference to a scalar");
}
return SvROK(ST(i)) ? SvREFCNT_inc(SvRV(ST(i))) : SvREFCNT_inc(ST(i));
}
};
template <>
struct read_as<reference>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
return SvROK(ST(i));
}
static reference get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference");
}
// take ownership of a reference to the RV itself (avoid reference to a reference)
reference result;
result.reset(SvREFCNT_inc(ST(i)));
return result;
}
};
template <>
struct read_as<array>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
return items > i;
}
static array get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be start of a perl array");
}
array result;
result.reserve(items - i);
for (int index = i; index < items; ++index)
{
result.push_back(SvREFCNT_inc(ST(index)));
}
return result;
}
};
template <>
struct read_as<hash>
{
static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
{
int remaining = items - i;
return remaining > 0 && remaining % 2 == 0 && SvTYPE(ST(i)) == SVt_PV;
}
static hash get(PerlInterpreter* my_perl, int i, int ax, int items)
{
if (!check(my_perl, i, ax, items))
{
throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be start of a perl hash");
}
hash result;
for (int index = i; index < items; index += 2)
{
const char* key = SvPV_nolen(ST(index));
result[key] = SvREFCNT_inc(ST(index + 1));
}
return result;
}
};
} // namespace stack
} // namespace perlbind

78
libs/perlbind/include/perlbind/subcaller.h Normal file
View File

@ -0,0 +1,78 @@
#pragma once
#include <stdexcept>
namespace perlbind { namespace detail {
// handles calls to perl, inherits stack::pusher to push args to perl sub
class sub_caller : public stack::pusher
{
public:
sub_caller() = delete;
sub_caller(PerlInterpreter* my_perl) : stack::pusher(my_perl)
{
ENTER; // enter scope boundary for any mortals we create
SAVETMPS;
}
~sub_caller()
{
PUTBACK; // set global sp back to local for any popped return values
FREETMPS;
LEAVE; // leave scope, decref mortals and values returned by perl
}
template <typename T, typename... Args, std::enable_if_t<std::is_void<T>::value, bool> = true>
auto call_sub(const char* subname, Args&&... args)
{
call_sub_impl(subname, G_EVAL|G_VOID, std::forward<Args>(args)...);
}
template <typename T, typename... Args, std::enable_if_t<std::is_integral<T>::value, bool> = true>
auto call_sub(const char* subname, Args&&... args)
{
T result = 0;
try
{
int count = call_sub_impl(subname, G_EVAL|G_SCALAR, std::forward<Args>(args)...);
if (count == 1)
{
SV* sv_result = pop();
result = static_cast<T>(SvIV(sv_result));
}
}
catch (...)
{
pop(); // top of stack holds undef on error when called with these flags
throw;
}
return result;
}
private:
template <typename... Args>
int call_sub_impl(const char* subname, int flags, Args&&... args)
{
PUSHMARK(SP); // notify perl of local sp (required even if not pushing args)
push_args(std::forward<Args>(args)...);
PUTBACK; // set global sp back to local so call will know pushed arg count
int result_count = call_pv(subname, flags);
SPAGAIN; // refresh local sp since call may reallocate stack for scalar returns
// ERRSV doesn't work in perl 5.28+ here for unknown reasons
SV* err = get_sv("@", 0);
if (SvTRUE(err))
{
throw std::runtime_error("Perl error: " + std::string(SvPV_nolen(err)));
}
return result_count;
}
};
} //namespace detail
} // namespace perlbind

33
libs/perlbind/include/perlbind/traits.h Normal file
View File

@ -0,0 +1,33 @@
#pragma once
namespace perlbind { namespace detail {
template<typename T, typename... Rest>
struct is_any : std::false_type {};
template<typename T, typename Last>
struct is_any<T, Last> : std::is_same<T, Last> {};
template<typename T, typename First, typename... Rest>
struct is_any<T, First, Rest...> : std::integral_constant<bool, std::is_same<T, First>::value || is_any<T, Rest...>::value> {};
template <typename T>
struct is_signed_integral : std::integral_constant<bool, std::is_integral<T>::value && std::is_signed<T>::value> {};
template <typename T>
struct is_signed_integral_or_enum : std::integral_constant<bool, is_signed_integral<T>::value || std::is_enum<T>::value> {};
template <typename T, typename... Rest>
struct count_of : std::integral_constant<size_t, 0> {};
template <typename T, typename Last>
struct count_of<T, Last> : std::integral_constant<size_t, std::is_same<T, Last>::value ? 1 : 0> {};
template <typename T, typename Next, typename... Rest>
struct count_of<T, Next, Rest...> : std::integral_constant<size_t, count_of<T, Next>::value + count_of<T, Rest...>::value> {};
template <typename T, typename... Args>
struct is_last : std::false_type {};
template <typename T, typename Last>
struct is_last<T, Last> : std::is_same<T, Last> {};
template <typename T, typename Next, typename... Args>
struct is_last<T, Next, Args...> : std::integral_constant<bool, is_last<T, Args...>::value> {};
} // namespace detail
} // namespace perlbind

45
libs/perlbind/include/perlbind/typemap.h Normal file
View File

@ -0,0 +1,45 @@
#pragma once
namespace perlbind { namespace detail {
struct usertype_counter
{
static std::size_t next_id()
{
static std::size_t counter = 0;
return counter++;
}
};
template <typename T>
struct usertype
{
static std::string id()
{
static std::size_t id = usertype_counter::next_id();
return std::to_string(id);
}
};
namespace typemap
{
// type names are stored in a hash on interpreter when registered with
// unique id keys generated by usertype counter
inline hash get(PerlInterpreter* my_perl)
{
HV* hv = get_hv("__perlbind::typemap", GV_ADD);
return reinterpret_cast<HV*>(SvREFCNT_inc(hv));
}
template <typename T>
const char* get_name(PerlInterpreter* my_perl)
{
auto typemap = detail::typemap::get(my_perl);
auto type_id = detail::template usertype<T>::id();
return typemap.exists(type_id) ? typemap[type_id].c_str() : nullptr;
}
} // namespace typemap
} // namespace detail
} // namespace perlbind

25
libs/perlbind/include/perlbind/types.h Normal file
View File

@ -0,0 +1,25 @@
#pragma once
namespace perlbind {
struct type_base
{
type_base() : my_perl(PERL_GET_THX) {}
type_base(PerlInterpreter* interp) : my_perl(interp) {}
PerlInterpreter* my_perl = nullptr;
};
// helper type to allow null object reference arguments in bindings
template <typename T>
struct nullable
{
static_assert(std::is_pointer<T>::value, "nullable<T> 'T' must be pointer");
nullable() = default;
nullable(T ptr) : m_ptr(ptr) {}
T get() { return m_ptr; }
private:
T m_ptr = nullptr;
};
} // namespace perlbind

50
libs/perlbind/include/perlbind/util.h Normal file
View File

@ -0,0 +1,50 @@
#pragma once
#include <string>
#include <typeinfo>
#ifndef _MSC_VER
#include <cxxabi.h>
#endif
namespace perlbind { namespace util {
inline std::string demangle(const char* name)
{
#ifndef _MSC_VER
int status = 0;
char* res = abi::__cxa_demangle(name, nullptr, nullptr, &status);
if (res)
{
std::string demangled = res;
free(res);
return demangled;
}
return "<unknown>";
#else
return name;
#endif
}
template <typename... Args>
struct type_name;
template <>
struct type_name<>
{
static std::string str() { return "void"; }
};
template <typename T>
struct type_name<T>
{
static std::string str() { return demangle(typeid(T).name()); }
};
template <typename T, typename... Args>
struct type_name<T, Args...>
{
static std::string str() { return type_name<T>::str() + "," + type_name<Args...>::str(); }
};
} // namespace util
} // namespace perlbind

10
libs/perlbind/include/perlbind/version.h Normal file
View File

@ -0,0 +1,10 @@
#pragma once
constexpr int perlbind_version_major = 1;
constexpr int perlbind_version_minor = 0;
constexpr int perlbind_version_patch = 0;
constexpr int perlbind_version()
{
return perlbind_version_major * 10000 + perlbind_version_minor * 100 + perlbind_version_patch;
}

15
libs/perlbind/src/function.cpp Normal file
View File

@ -0,0 +1,15 @@
#include <perlbind/perlbind.h>
namespace perlbind { namespace detail {
extern "C" int gc(pTHX_ SV* sv, MAGIC* mg)
{
auto pfunc = INT2PTR(perlbind::detail::function_base*, SvIV(sv));
delete pfunc;
return 1;
}
const MGVTBL function_base::mgvtbl = { 0, 0, 0, 0, gc, 0, 0, 0 };
} // namespace detail
} // namespace perlbind

107
libs/perlbind/src/hash.cpp Normal file
View File

@ -0,0 +1,107 @@
#include <perlbind/perlbind.h>
#include <perlbind/iterator.h>
#include <stdexcept>
namespace perlbind {
hash::hash(scalar ref)
: type_base(ref.my_perl)
{
if (!ref.is_hash_ref())
throw std::runtime_error("cannot construct hash from non-hash reference");
reset(reinterpret_cast<HV*>(SvREFCNT_inc(*ref)));
}
hash::hash(scalar_proxy proxy)
: hash(scalar(SvREFCNT_inc(proxy.sv())))
{}
scalar hash::at(const char* key)
{
return at(key, strlen(key));
}
scalar hash::at(const std::string& key)
{
return at(key.c_str(), key.size());
}
scalar hash::at(const char* key, size_t size)
{
SV** sv = hv_fetch(m_hv, key, static_cast<I32>(size), 1);
return SvREFCNT_inc(*sv);
}
void hash::insert(const char* key, scalar value)
{
insert(key, strlen(key), value);
}
void hash::insert(const std::string& key, scalar value)
{
insert(key.c_str(), key.size(), value);
}
scalar_proxy hash::operator[](const std::string& key)
{
return scalar_proxy(my_perl, at(key.c_str(), key.size()));
}
hash::iterator hash::begin() const noexcept
{
hv_iterinit(m_hv);
return { my_perl, m_hv, hv_iternext(m_hv) };
}
hash::iterator hash::end() const noexcept
{
return { my_perl, m_hv, nullptr };
}
hash::iterator hash::find(const char* key)
{
return find(key, static_cast<I32>(strlen(key)));
}
hash::iterator hash::find(const std::string& key)
{
return find(key.c_str(), static_cast<I32>(key.size()));
}
hash::iterator hash::find(const char* key, size_t size)
{
// key sv made mortal with SVs_TEMP flag
SV* keysv = newSVpvn_flags(key, static_cast<I32>(size), SVs_TEMP);
HE* he = hv_fetch_ent(m_hv, keysv, 0, 0);
return { my_perl, m_hv, he };
}
void hash::insert(const char* key, size_t size, scalar value)
{
if (!hv_store(m_hv, key, static_cast<I32>(size), SvREFCNT_inc(value), 0))
{
SvREFCNT_dec(value);
}
}
HV* hash::copy_hash(HV* other) noexcept
{
HV* hv = newHV();
hv_iterinit(other);
while (HE* entry = hv_iternext(other))
{
size_t key_size;
auto key = HePV(entry, key_size);
auto value = newSVsv(HeVAL(entry));
if (!hv_store(hv, key, static_cast<I32>(key_size), value, HeHASH(entry)))
{
SvREFCNT_dec(value);
}
}
return hv;
}
} // namespace perlbind

98
libs/perlbind/src/interpreter.cpp Normal file
View File

@ -0,0 +1,98 @@
#include <perlbind/perlbind.h>
#include <fstream>
#include <sstream>
#include <stdexcept>
EXTERN_C
{
void boot_DynaLoader(pTHX_ CV* cv);
static void xs_init(pTHX)
{
newXS(const_cast<char*>("DynaLoader::boot_DynaLoader"), boot_DynaLoader, const_cast<char*>(__FILE__));
}
}
namespace perlbind {
interpreter::interpreter()
: m_is_owner(true)
{
const char* argv[] = { "", "-ew", "0", nullptr };
constexpr int argc = (sizeof(argv) / sizeof(*argv)) - 1;
init(argc, argv);
}
interpreter::interpreter(int argc, const char** argv)
: m_is_owner(true)
{
init(argc, argv);
}
void interpreter::init(int argc, const char** argv)
{
char** argvs = const_cast<char**>(argv);
char** env = { nullptr };
// PERL_SYS_INIT3 and PERL_SYS_TERM should only be called once per program
PERL_SYS_INIT3(&argc, &argvs, &env);
my_perl = perl_alloc();
PERL_SET_CONTEXT(my_perl);
PL_perl_destruct_level = 1;
perl_construct(my_perl);
perl_parse(my_perl, xs_init, argc, argvs, nullptr);
perl_run(my_perl);
}
interpreter::~interpreter()
{
if (m_is_owner)
{
PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
}
void interpreter::load_script(std::string packagename, std::string filename)
{
struct stat st{};
if (stat(filename.c_str(), &st) != 0)
{
throw std::runtime_error("Unable to read perl file '" + filename + "'");
}
std::ifstream ifs(filename);
std::stringstream buffer;
buffer << "package " << packagename << "; " << ifs.rdbuf();
try
{
eval(buffer.str().c_str());
}
catch (std::exception& e)
{
throw std::runtime_error("Error loading script '" + filename + "':\n " + e.what());
}
}
void interpreter::eval(const char* str)
{
SV* sv = eval_pv(str, 0);
if (sv == &PL_sv_undef)
{
SV* err = get_sv("@", 0);
if (err && err->sv_u.svu_pv[0])
{
throw std::runtime_error(err->sv_u.svu_pv);
}
throw std::runtime_error("unknown error in eval()");
}
}
} // namespace perlbind

88
libs/perlbind/src/package.cpp Normal file
View File

@ -0,0 +1,88 @@
#include <perlbind/perlbind.h>
namespace perlbind {
namespace detail {
extern "C" void xsub(PerlInterpreter* my_perl, CV* cv);
} // namespace detail
void package::add_impl(const char* name, detail::function_base* function)
{
std::string export_name = m_name + "::" + name;
// the sv is assigned a magic metamethod table to delete the function
// object when perl frees the sv
SV* sv = newSViv(PTR2IV(function));
sv_magicext(sv, nullptr, PERL_MAGIC_ext, &detail::function_base::mgvtbl, nullptr, 0);
CV* cv = get_cv(export_name.c_str(), 0);
if (!cv)
{
cv = newXS(export_name.c_str(), &detail::xsub, __FILE__);
CvXSUBANY(cv).any_ptr = function;
}
else // function exists, remove target to search overloads when called
{
CvXSUBANY(cv).any_ptr = nullptr;
}
// create an array with same name to store overloads in the CV's GV
AV* av = GvAV(CvGV(cv));
if (!av)
{
av = get_av(export_name.c_str(), GV_ADD);
}
array overloads = reinterpret_cast<AV*>(SvREFCNT_inc(av));
overloads.push_back(sv); // giving only ref to GV array
}
extern "C" void detail::xsub(PerlInterpreter* my_perl, CV* cv)
{
// croak does not unwind so inner calls throw exceptions to prevent leaks
try
{
detail::xsub_stack stack(my_perl, cv);
auto target = static_cast<detail::function_base*>(CvXSUBANY(cv).any_ptr);
if (target)
{
return target->call(stack);
}
// find first compatible overload
AV* av = GvAV(CvGV(cv));
array functions = reinterpret_cast<AV*>(SvREFCNT_inc(av));
for (const auto& function : functions)
{
auto func = INT2PTR(detail::function_base*, SvIV(function.sv()));
if (func->is_compatible(stack))
{
return func->call(stack);
}
}
SV* err = newSVpvf("no overload of '%s' matched the %d argument(s):\n (%s)\ncandidates:\n ",
stack.name().c_str(), stack.size(), stack.types().c_str());
for (const auto& function : functions)
{
auto func = INT2PTR(detail::function_base*, SvIV(function.sv()));
Perl_sv_catpvf(aTHX_ err, "%s\n ", func->get_signature().c_str());
}
err = sv_2mortal(err);
throw std::runtime_error(SvPV_nolen(err));
}
catch (std::exception& e)
{
Perl_croak(aTHX_ "%s", e.what());
}
catch (...)
{
Perl_croak(aTHX_ "unhandled exception");
}
}
} // namespace perlbind

112
libs/perlbind/src/perlbind.natvis Normal file
View File

@ -0,0 +1,112 @@
<?xml version="1.0" encoding="utf-8"?>
<AutoVisualizer xmlns="http://schemas.microsoft.com/vstudio/debugger/natvis/2010">
<Type Name="perlbind::scalar">
<AlternativeType Name="perlbind::reference" />
<DisplayString>{{ m_sv={(void*)m_sv} refcnt={m_sv->sv_refcnt,d} type={(svtype)(m_sv->sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<ExpandedItem>m_sv</ExpandedItem>
</Expand>
</Type>
<Type Name="perlbind::array">
<DisplayString Condition="m_av != nullptr">{{ size={(m_av->sv_any)->xav_fill + 1,d} refcnt={m_av->sv_refcnt,d} }</DisplayString>
<Expand>
<ExpandedItem>m_av</ExpandedItem>
</Expand>
</Type>
<Type Name="perlbind::hash">
<DisplayString Condition="m_hv != nullptr">{{ size={(m_hv->sv_any)->xhv_keys,d} refcnt={m_hv->sv_refcnt,d} }}</DisplayString>
<Expand>
<ExpandedItem>m_hv</ExpandedItem>
</Expand>
</Type>
<Type Name="sv">
<AlternativeType Name="cv" />
<DisplayString>{{ refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[type]">(svtype)(sv_flags &amp; 0xff),d</Item>
<Item Name="[reference]" Condition="(sv_flags &amp; 0x00000800)">sv_u.svu_rv</Item>
<!-- SVt_PVAV -->
<Item Name="[array]" Condition="((svtype)(sv_flags &amp; 0xff)) == 11">(av*)this</Item>
<!-- SVt_PVHV -->
<Item Name="[hash]" Condition="((svtype)(sv_flags &amp; 0xff)) == 12">(hv*)this</Item>
<!-- SVt_PVGV -->
<Item Name="[glob]" Condition="((svtype)(sv_flags &amp; 0xff)) == 9">(gv*)this</Item>
<!-- SVt_PVMG -->
<Item Name="[magic]" Condition="((svtype)(sv_flags &amp; 0xff)) == 7">((XPVMG*)(sv_any))</Item>
<!--<ExpandedItem>sv_u</ExpandedItem>-->
<Item Name="svu_pv">sv_u.svu_pv,na</Item>
<Item Name="svu_iv">sv_u.svu_iv,i</Item>
<Item Name="svu_uv">sv_u.svu_uv</Item>
<Item Name="svu_nv">sv_u.svu_nv,f</Item>
<Item Name="svu_rv">sv_u.svu_rv</Item>
</Expand>
</Type>
<Type Name="av">
<!--
These might be dependent on perl version
#define AvARRAY(av) ((av)->sv_u.svu_array)
#define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc
#define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max
#define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill
-->
<DisplayString>{{ size={(sv_any)->xav_fill + 1,d} refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[size]">(sv_any)->xav_fill + 1</Item>
<Item Name="[capacity]">(sv_any)->xav_max</Item>
<ArrayItems>
<Size>(sv_any)->xav_fill + 1</Size>
<ValuePointer>(sv_u).svu_array</ValuePointer>
</ArrayItems>
</Expand>
</Type>
<Type Name="hv">
<!--
These might be dependent on perl version
SvANY(hv): (m_hv->sv_any)
HvMAX(hv): ((m_hv->sv_any)->xhv_max
HvARRAY(hv): ((m_hv->sv_u).svu_hash
HvAUX(hv): (xpvhv_aux*)&(((m_hv->sv_u)->svu_hash)[((m_hv->sv_any)->xhv_max + 1]
-->
<DisplayString>{{ size={(sv_any)->xhv_keys,d} refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[size]">(sv_any)->xhv_keys</Item>
<Item Name="[capacity]">(sv_any)->xhv_max</Item>
<CustomListItems MaxItemsPerView="5000">
<Variable Name="index" InitialValue="0"/>
<Variable Name="bucket_inc" InitialValue="0"/>
<Variable Name="max_index" InitialValue="(sv_any)->xhv_max"/>
<Variable Name="bucket_array" InitialValue="(sv_u).svu_hash"/>
<Variable Name="entry" InitialValue="(sv_u).svu_hash[0]"/>
<Loop>
<If Condition="entry == nullptr">
<Exec>index++</Exec>
<Exec>bucket_inc = __findnonnull(bucket_array + index, max_index - index)</Exec>
<Break Condition="bucket_inc == -1" />
<Exec>index += bucket_inc</Exec>
<Exec>entry = bucket_array[index]</Exec>
</If>
<Item Name="[{ (entry->hent_hek)->hek_key,na }]">(entry->he_valu).hent_val</Item>
<Exec>entry = entry->hent_next</Exec>
</Loop>
</CustomListItems>
</Expand>
</Type>
<Type Name="gv">
<DisplayString>{{ refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[type]">(svtype)(sv_flags &amp; 0xff),d</Item>
<Item Name="[sv]" Condition="(sv_u.svu_gp)->gp_sv != nullptr">(sv_u.svu_gp)->gp_sv</Item>
<Item Name="[cv]" Condition="(sv_u.svu_gp)->gp_cv != nullptr">(sv_u.svu_gp)->gp_cv</Item>
<Item Name="[array]" Condition="(sv_u.svu_gp)->gp_av != nullptr">(sv_u.svu_gp)->gp_av</Item>
<Item Name="[hash]" Condition="(sv_u.svu_gp)->gp_hv != nullptr">(sv_u.svu_gp)->gp_hv</Item>
<Item Name="svu_gp">(sv_u.svu_gp)</Item>
</Expand>
</Type>
</AutoVisualizer>

116
zone/embparser.cpp
View File

@ -33,6 +33,31 @@
extern Zone *zone;
#ifdef EMBPERL_XS
void perl_register_quest();
#ifdef EMBPERL_XS_CLASSES
void perl_register_mob();
void perl_register_npc();
void perl_register_client();
void perl_register_corpse();
void perl_register_entitylist();
void perl_register_perlpacket();
void perl_register_group();
void perl_register_raid();
void perl_register_inventory();
void perl_register_questitem();
void perl_register_spell();
void perl_register_hateentry();
void perl_register_object();
void perl_register_doors();
void perl_register_expedition();
void perl_register_expedition_lock_messages();
#ifdef BOTS
void perl_register_bot();
#endif // BOTS
#endif // EMBPERL_XS_CLASSES
#endif // EMBPERL_XS
const char *QuestEventSubroutines[_LargestEventID] = {
"EVENT_SAY",
"EVENT_ITEM",
@ -804,7 +829,7 @@ int PerlembParser::SendCommands(
perl->eval(cmd.c_str());
#ifdef EMBPERL_XS_CLASSES
dTHX;
{
std::string cl = (std::string) "$" + (std::string) pkgprefix + (std::string) "::client";
std::string np = (std::string) "$" + (std::string) pkgprefix + (std::string) "::npc";
@ -946,76 +971,31 @@ int PerlembParser::SendCommands(
void PerlembParser::MapFunctions()
{
dTHX;
_empty_sv = newSV(0);
perl->eval(
"{"
"package quest;"
"&boot_quest;" //load our quest XS
#ifdef EMBPERL_XS_CLASSES
"package Mob;"
"&boot_Mob;" //load our Mob XS
"package Client;"
"our @ISA = qw(Mob);" //client inherits mob.
"&boot_Mob;" //load our Mob XS
"&boot_Client;" //load our Client XS
"package NPC;"
"our @ISA = qw(Mob);" //NPC inherits mob.
"&boot_Mob;" //load our Mob XS
"&boot_NPC;" //load our NPC XS
"package Corpse;"
"our @ISA = qw(Mob);" //Corpse inherits mob.
"&boot_Mob;" //load our Mob XS
"&boot_Corpse;" //load our Mob XS
"package EntityList;"
"&boot_EntityList;" //load our EntityList XS
"package PerlPacket;"
"&boot_PerlPacket;" //load our PerlPacket XS
"package Group;"
"&boot_Group;" //load our Group XS
"package Raid;"
"&boot_Raid;" //load our Raid XS
"package Inventory;"
"&boot_Inventory;" // load inventory XS
"package QuestItem;"
"&boot_QuestItem;" // load quest Item XS
"package Spell;"
"&boot_Spell;" // load quest Spell XS
"package HateEntry;"
"&boot_HateEntry;" // load quest Hate XS
"package Object;"
"&boot_Object;" // load quest Object XS
"package Doors;"
"&boot_Doors;" // load quest Doors XS
"package Expedition;"
"&boot_Expedition;"
perl_register_quest();
#ifdef EMBPERL_XS_CLASSES
perl_register_mob();
perl_register_npc();
perl_register_client();
perl_register_corpse();
perl_register_entitylist();
perl_register_perlpacket();
perl_register_group();
perl_register_raid();
perl_register_inventory();
perl_register_questitem();
perl_register_spell();
perl_register_hateentry();
perl_register_object();
perl_register_doors();
perl_register_expedition();
perl_register_expedition_lock_messages();
#ifdef BOTS
"package Bot;"
"our @ISA = qw(NPC);" // Bot inherits NPC
"&boot_Mob;" // load our Mob XS
"&boot_NPC;" // load our NPC XS
"&boot_Bot;" // load our Bot XS
#endif
#endif
"package main;"
"}"
);
perl_register_bot();
#endif // BOTS
#endif // EMBPERL_XS_CLASSES
}
void PerlembParser::GetQuestTypes(

12444
zone/embparser_api.cpp
View File

File diff suppressed because it is too large Load Diff

54
zone/embperl.cpp
View File

@ -22,30 +22,6 @@ Eglin
#define GvCV_set(gv,cv) (GvCV(gv) = (cv))
#endif
#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_Inventory);
EXTERN_C XS(boot_QuestItem);
EXTERN_C XS(boot_Spell);
EXTERN_C XS(boot_HateEntry);
EXTERN_C XS(boot_Object);
EXTERN_C XS(boot_Doors);
EXTERN_C XS(boot_PerlPacket);
EXTERN_C XS(boot_Expedition);
#ifdef BOTS
EXTERN_C XS(boot_Bot);
#endif
#endif
#endif
#ifdef EMBPERL_IO_CAPTURE
XS(XS_EQEmuIO_PRINT);
#endif //EMBPERL_IO_CAPTURE
@ -74,36 +50,6 @@ EXTERN_C void xs_init(pTHX)
//add the strcpy stuff to get rid of const warnings....
newXS(strcpy(buf, "DynaLoader::boot_DynaLoader"), boot_DynaLoader, file);
newXS(strcpy(buf, "quest::boot_qc"), boot_qc, 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, "Inventory::boot_Inventory"), boot_Inventory, file);
newXS(strcpy(buf, "QuestItem::boot_QuestItem"), boot_QuestItem, file);
newXS(strcpy(buf, "Spell::boot_Spell"), boot_Spell, 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);
newXS(strcpy(buf, "Expedition::boot_Expedition"), boot_Expedition, file);
#ifdef BOTS
newXS(strcpy(buf, "Bot::boot_Mob"), boot_Mob, file);
newXS(strcpy(buf, "Bot::boot_NPC"), boot_NPC, file);
newXS(strcpy(buf, "Bot::boot_Bot"), boot_Bot, file);
#endif
;
#endif
#endif
#ifdef EMBPERL_IO_CAPTURE
newXS(strcpy(buf, "EQEmuIO::PRINT"), XS_EQEmuIO_PRINT, file);
#endif

21
zone/embperl.h
View File

@ -18,22 +18,13 @@ Eglin
#include <stdio.h>
#include <string.h>
//headers from the Perl distribution
#include <EXTERN.h>
#define WIN32IO_IS_STDIO
// this option disables distinct int/float/string function argument types for
// backwards compatibility with current perl api usage
// e.g. quest::settimer(0, 1) using number for timer name instead of string
#define PERLBIND_NO_STRICT_SCALAR_TYPES
#include <perlbind/perlbind.h>
namespace perl = perlbind;
#ifndef WIN32
extern "C" { //the perl headers dont do this for us...
#endif
#if _MSC_VER
#define __inline__ __inline
#define __builtin_expect
#endif
#include <perl.h>
#include <XSUB.h>
#ifndef WIN32
};
#endif
#ifdef WIN32
#define snprintf _snprintf
#endif

47
zone/embxs.cpp
View File

@ -20,17 +20,14 @@
#include "../common/global_define.h"
#include "../common/eqemu_logsys.h"
#include "embxs.h"
#include "embperl.h"
#include "masterentity.h"
#include "command.h"
#ifdef BOTS
#include "bot_command.h"
#endif
#include "embperl.h"
#include "embxs.h"
const char *getItemName(unsigned itemid)
{
const EQ::ItemData* item = nullptr;
@ -42,43 +39,9 @@ const char *getItemName(unsigned itemid)
return nullptr;
}
XS(XS_qc_getItemName); /* prototype to pass -Wmissing-prototypes */
XS(XS_qc_getItemName)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: quest::getItemName(itemid)");
{
unsigned itemid = (unsigned)SvUV(ST(0));
const char * RETVAL;
dXSTARG;
RETVAL = getItemName(itemid);
sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG;
}
XSRETURN(1);
}
EXTERN_C XS(boot_qc); /* prototype to pass -Wmissing-prototypes */
EXTERN_C XS(boot_qc)
{
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = '\0';
if(items != 1)
LogError("boot_qc does not take any arguments");
char buf[128]; //shouldent have any function names longer than this.
//add the strcpy stuff to get rid of const warnings....
XS_VERSION_BOOTCHECK ;
newXS(strcpy(buf, "quest::getItemName"), XS_qc_getItemName, file);
XSRETURN_YES;
const char* Perl__qc_getItemName(unsigned itemid)
{
return getItemName(itemid); // possible nullptr return
}
#ifdef EMBPERL_IO_CAPTURE

21
zone/embxs.h
View File

@ -1,24 +1,7 @@
#ifndef EMBXS_H
#define EMBXS_H
//headers from the Perl distribution
#include <EXTERN.h>
#define WIN32IO_IS_STDIO
#ifndef WIN32
extern "C" { //the perl headers dont do this for us...
#endif
#if _MSC_VER
#define __inline__ __inline
#define __builtin_expect
#endif
#include <perl.h>
#include <XSUB.h>
#ifndef WIN32
};
#endif
const char *getItemName(unsigned itemid);
XS(XS_qc_getItemName); /* prototype to pass -Wmissing-prototypes */
EXTERN_C XS(boot_qc); /* prototype to pass -Wmissing-prototypes */
const char* Perl__qc_getItemName(unsigned itemid);
#endif // EMBXS_H

239
zone/perl_bot.cpp
View File

@ -3,176 +3,93 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "bot.h"
#ifdef THIS
#undef THIS
#endif
#define VALIDATE_THIS_IS_BOT \
do { \
if (sv_derived_from(ST(0), "Bot")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Bot*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Bot"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Bot_GetOwner);
XS(XS_Bot_GetOwner)
Mob* Perl_Bot_GetOwner(Bot* self) // @categories Script Utility, Bot
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Bot::GetOwner(THIS)"); // @categories Script Utility, Bot
{
Bot* THIS;
Mob* bot_owner;
VALIDATE_THIS_IS_BOT;
bot_owner = THIS->GetBotOwner();
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Mob", (void*)bot_owner);
}
XSRETURN(1);
return self->GetBotOwner();
}
XS(XS_Bot_AddBotItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Bot_AddBotItem) {
dXSARGS;
if (items < 3 || items > 11)
Perl_croak(aTHX_ "Usage: Bot::AddBotItem(THIS, uint16 slot_id, uint32 item_id, [int16 charges = -1], [bool attuned = false], [uint32 augment_one = 0], [uint32 augment_two = 0], [uint32 augment_three = 0], [uint32 augment_four = 0], [uint32 augment_five = 0], [uint32 augment_six = 0])"); // @categories Inventory and Items, Script Utility
{
Bot* THIS;
uint16 slot_id = (uint16) SvUV(ST(1));
uint32 item_id = (uint32) SvUV(ST(2));
int16 charges = -1;
bool attuned = false;
uint32 augment_one = 0;
uint32 augment_two = 0;
uint32 augment_three = 0;
uint32 augment_four = 0;
uint32 augment_five = 0;
uint32 augment_six = 0;
VALIDATE_THIS_IS_BOT;
if (items > 3) {
charges = (int16) SvIV(ST(3));
}
if (items > 4) {
attuned = (bool) SvTRUE(ST(4));
}
if (items > 5) {
augment_one = (uint32) SvUV(ST(5));
}
if (items > 6) {
augment_two = (uint32) SvUV(ST(6));
}
if (items > 7) {
augment_three = (uint32) SvUV(ST(7));
}
if (items > 8) {
augment_four = (uint32) SvUV(ST(8));
}
if (items > 9) {
augment_five = (uint32) SvUV(ST(9));
}
if (items > 10) {
augment_six = (uint32) SvUV(ST(10));
}
THIS->AddBotItem(slot_id, item_id, charges, attuned, augment_one, augment_two, augment_three, augment_four, augment_five, augment_six);
}
XSRETURN_EMPTY;
}
XS(XS_Bot_CountBotItem);
XS(XS_Bot_CountBotItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Bot::CountBotItem(THIS, uint32 item_id)");
{
Bot* THIS;
int item_count = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_BOT;
item_count = THIS->CountBotItem(item_id);
XSprePUSH;
PUSHu((UV) item_count);
}
XSRETURN(1);
}
XS(XS_Bot_HasBotItem);
XS(XS_Bot_HasBotItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Bot:HasBotItem(THIS, uint32 item_id)");
{
Bot* THIS;
bool has_item = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_BOT;
has_item = THIS->HasBotItem(item_id);
ST(0) = boolSV(has_item);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Bot_RemoveBotItem);
XS(XS_Bot_RemoveBotItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Bot::RemoveBotItem(THIS, uint32 item_id)"); // @categories Spells and Disciplines
{
Bot* THIS;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_BOT;
THIS->RemoveBotItem(item_id);
}
XSRETURN_EMPTY;
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Bot);
XS(boot_Bot)
// todo: should just take a hash instead of all these overloads
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id) // @categories Inventory and Items
{
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
self->AddBotItem(slot_id, item_id);
}
if (items != 1)
fprintf(stderr, "boot_Bot does not take any arguments.");
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges);
}
char buf[128];
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned);
}
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "AddBotItem"), XS_Bot_AddBotItem, file, "$$$;$$$$$$$$");
newXSproto(strcpy(buf, "CountBotItem"), XS_Bot_CountBotItem, file, "$$");
newXSproto(strcpy(buf, "GetOwner"), XS_Bot_GetOwner, file, "$");
newXSproto(strcpy(buf, "HasBotItem"), XS_Bot_HasBotItem, file, "$$");
newXSproto(strcpy(buf, "RemoveBotItem"), XS_Bot_RemoveBotItem, file, "$$");
XSRETURN_YES;
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3, uint32 aug4) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3, aug4);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3, uint32 aug4, uint32 aug5) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3, aug4, aug5);
}
void Perl_Bot_AddBotItem(Bot* self, uint16 slot_id, uint32 item_id, uint16 charges, bool attuned, uint32 aug1, uint32 aug2, uint32 aug3, uint32 aug4, uint32 aug5, uint32 aug6) // @categories Inventory and Items
{
self->AddBotItem(slot_id, item_id, charges, attuned, aug1, aug2, aug3, aug4, aug5, aug6);
}
uint32 Perl_Bot_CountBotItem(Bot* self, uint32 item_id)
{
return self->CountBotItem(item_id);
}
bool Perl_Bot_HasBotItem(Bot* self, uint32 item_id)
{
return self->HasBotItem(item_id);
}
void Perl_Bot_RemoveBotItem(Bot* self, uint32 item_id)
{
return self->RemoveBotItem(item_id);
}
void perl_register_bot()
{
perl::interpreter state(PERL_GET_THX);
auto package = state.new_class<Bot>("Bot");
package.add_base_class("NPC");
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("AddBotItem", (void(*)(Bot*, uint16, uint32, uint16, bool, uint32, uint32, uint32, uint32, uint32, uint32))&Perl_Bot_AddBotItem);
package.add("CountBotItem", &Perl_Bot_CountBotItem);
package.add("GetOwner", &Perl_Bot_GetOwner);
package.add("HasBotItem", &Perl_Bot_HasBotItem);
package.add("RemoveBotItem", &Perl_Bot_RemoveBotItem);
}
#endif //EMBPERL_XS_CLASSES

8646
zone/perl_client.cpp
View File

File diff suppressed because it is too large Load Diff

569
zone/perl_doors.cpp
View File

@ -4,504 +4,183 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "doors.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_DOOR \
do { \
if (sv_derived_from(ST(0), "Doors")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Doors*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Doors"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Doors_GetDoorDBID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetDoorDBID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetDoorDBID(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetDoorDBID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetDoorDBID(Doors* self) // @categories Doors
{
return self->GetDoorDBID();
}
XS(XS_Doors_GetDoorID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetDoorID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetDoorID(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetDoorID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetDoorID(Doors* self) // @categories Doors
{
return self->GetDoorID();
}
XS(XS_Doors_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetID(THIS)"); // @categories Doors
{
Doors *THIS;
uint16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetEntityID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetID(Doors* self) // @categories Doors
{
return self->GetEntityID();
}
XS(XS_Doors_GetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetX) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetX(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().x;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetX(Doors* self) // @categories Doors
{
return self->GetPosition().x;
}
XS(XS_Doors_GetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetY) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetY(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().y;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetY(Doors* self) // @categories Doors
{
return self->GetPosition().y;
}
XS(XS_Doors_GetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetZ) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetZ(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().z;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetZ(Doors* self) // @categories Doors
{
return self->GetPosition().z;
}
XS(XS_Doors_GetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetHeading) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetHeading(THIS)"); // @categories Doors
{
Doors *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetPosition().w;
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Doors_GetHeading(Doors* self) // @categories Doors
{
return self->GetPosition().w;
}
XS(XS_Doors_GetOpenType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetOpenType) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetOpenType(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetOpenType();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetOpenType(Doors* self) // @categories Doors
{
return self->GetOpenType();
}
XS(XS_Doors_GetLockpick); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetLockpick) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetLockpick(THIS)"); // @categories Doors, Skills and Recipes
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetLockpick();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetLockpick(Doors* self) // @categories Doors, Skills and Recipes
{
return self->GetLockpick();
}
XS(XS_Doors_GetKeyItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetKeyItem) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetKeyItem(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetKeyItem();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetKeyItem(Doors* self) // @categories Doors
{
return self->GetKeyItem();
}
XS(XS_Doors_GetNoKeyring); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetNoKeyring) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::GetNoKeyring(THIS, uint8 type)"); // @categories Doors
{
Doors *THIS;
uint8 type = (uint8) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->GetNoKeyring();
}
XSRETURN_EMPTY;
uint8_t Perl_Doors_GetNoKeyring(Doors* self) // @categories Doors
{
return self->GetNoKeyring();
}
XS(XS_Doors_GetIncline); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetIncline) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetIncline(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetIncline();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
int Perl_Doors_GetIncline(Doors* self) // @categories Doors
{
return self->GetIncline();
}
XS(XS_Doors_GetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetSize) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetSize(THIS)"); // @categories Doors
{
Doors *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetSize();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Doors_GetSize(Doors* self) // @categories Doors
{
return self->GetSize();
}
XS(XS_Doors_SetOpenType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetOpenType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetOpenType(THIS, uint32 open_type)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetOpenType(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetOpenType(Doors* self, uint32_t open_type) // @categories Doors
{
self->SetOpenType(open_type);
}
XS(XS_Doors_SetLockpick); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetLockpick) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetLockpick(THIS, uint32 lockpick_type)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetLockpick(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetLockpick(Doors* self, uint32_t lockpick_type) // @categories Doors
{
self->SetLockpick(lockpick_type);
}
XS(XS_Doors_SetKeyItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetKeyItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetKeyItem(THIS, uint32 key_item_id)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetKeyItem(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetKeyItem(Doors* self, uint32_t key_item_id) // @categories Doors
{
self->SetKeyItem(key_item_id);
}
XS(XS_Doors_SetNoKeyring); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetNoKeyring) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetNoKeyring(THIS, uint8 no_key_ring)"); // @categories Doors
{
Doors *THIS;
uint8 type = (uint8) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetNoKeyring(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetNoKeyring(Doors* self, uint8_t no_key_ring) // @categories Doors
{
self->SetNoKeyring(no_key_ring);
}
XS(XS_Doors_SetIncline); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetIncline) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetIncline(THIS, uint32 incline)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetIncline(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetIncline(Doors* self, uint32_t incline) // @categories Doors
{
self->SetIncline(incline);
}
XS(XS_Doors_SetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetSize) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetSize(THIS, uint32 size)"); // @categories Doors
{
Doors *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_DOOR;
THIS->SetSize(type);
}
XSRETURN_EMPTY;
void Perl_Doors_SetSize(Doors* self, uint32_t size) // @categories Doors
{
self->SetSize(size);
}
XS(XS_Doors_SetLocation); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetLocation) {
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: Doors::SetLocation(THIS, float x, float y, float z)"); // @categories Doors
{
Doors *THIS;
float x = (float) SvNV(ST(1));
float y = (float) SvNV(ST(2));
float z = (float) SvNV(ST(3));
VALIDATE_THIS_IS_DOOR;
THIS->SetLocation(x, y, z);
}
XSRETURN_EMPTY;
void Perl_Doors_SetLocation(Doors* self, float x, float y, float z) // @categories Doors
{
self->SetLocation(x, y, z);
}
XS(XS_Doors_SetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetX) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetX(THIS, float x)"); // @categories Doors
{
Doors *THIS;
float x = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.x = x;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetX(Doors* self, float x) // @categories Doors
{
auto position = self->GetPosition();
position.x = x;
self->SetPosition(position);
}
XS(XS_Doors_SetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetY) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetY(THIS, float y)"); // @categories Doors
{
Doors *THIS;
float y = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.y = y;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetY(Doors* self, float y) // @categories Doors
{
auto position = self->GetPosition();
position.y = y;
self->SetPosition(position);
}
XS(XS_Doors_SetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetZ) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetZ(THIS, float z)"); // @categories Doors
{
Doors *THIS;
float z = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.z = z;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetZ(Doors* self, float z) // @categories Doors
{
auto position = self->GetPosition();
position.z = z;
self->SetPosition(position);
}
XS(XS_Doors_SetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetHeading) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Doors::SetHeading(THIS, float heading)"); // @categories Doors
{
Doors *THIS;
float heading = (float) SvNV(ST(1));
VALIDATE_THIS_IS_DOOR;
auto position = THIS->GetPosition();
position.w = heading;
THIS->SetPosition(position);
}
XSRETURN_EMPTY;
void Perl_Doors_SetHeading(Doors* self, float heading) // @categories Doors
{
auto position = self->GetPosition();
position.w = heading;
self->SetPosition(position);
}
XS(XS_Doors_SetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_SetModelName) {
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: Doors::SetModelName(THIS, string name)"); // @categories Doors
{
Doors *THIS;
char *name = nullptr;
VALIDATE_THIS_IS_DOOR;
if (items > 1) { name = (char *) SvPV_nolen(ST(1)); }
THIS->SetDoorName(name);
}
XSRETURN_EMPTY;
}
XS(XS_Doors_GetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_GetModelName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::GetModelName(THIS)"); // @categories Doors
{
Doors *THIS;
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_DOOR;
RETVAL = THIS->GetDoorName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
void Perl_Doors_SetModelName(Doors* self, const char* name) // @categories Doors
{
self->SetDoorName(name);
}
XS(XS_Doors_CreateDatabaseEntry); /* prototype to pass -Wmissing-prototypes */
XS(XS_Doors_CreateDatabaseEntry) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Doors::InsertDoor(THIS)"); // @categories Doors
{
Doors *THIS;
VALIDATE_THIS_IS_DOOR;
THIS->CreateDatabaseEntry();
}
XSRETURN_EMPTY;
std::string Perl_Doors_GetModelName(Doors* self) // @categories Doors
{
return self->GetDoorName();
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Doors); /* prototype to pass -Wmissing-prototypes */
XS(boot_Doors) {
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, "CreateDatabaseEntry"), XS_Doors_CreateDatabaseEntry, file, "$");
newXSproto(strcpy(buf, "GetDoorDBID"), XS_Doors_GetDoorDBID, file, "$");
newXSproto(strcpy(buf, "GetDoorID"), XS_Doors_GetDoorID, file, "$");
newXSproto(strcpy(buf, "GetHeading"), XS_Doors_GetHeading, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Doors_GetID, file, "$");
newXSproto(strcpy(buf, "GetIncline"), XS_Doors_GetIncline, file, "$");
newXSproto(strcpy(buf, "GetKeyItem"), XS_Doors_GetKeyItem, file, "$");
newXSproto(strcpy(buf, "GetLockPick"), XS_Doors_GetLockpick, file, "$");
newXSproto(strcpy(buf, "GetModelName"), XS_Doors_GetModelName, file, "$");
newXSproto(strcpy(buf, "GetNoKeyring"), XS_Doors_GetNoKeyring, file, "$");
newXSproto(strcpy(buf, "GetOpenType"), XS_Doors_GetOpenType, file, "$");
newXSproto(strcpy(buf, "GetSize"), XS_Doors_GetSize, file, "$");
newXSproto(strcpy(buf, "GetX"), XS_Doors_GetX, file, "$");
newXSproto(strcpy(buf, "GetY"), XS_Doors_GetY, file, "$");
newXSproto(strcpy(buf, "GetZ"), XS_Doors_GetZ, file, "$");
newXSproto(strcpy(buf, "SetHeading"), XS_Doors_SetHeading, file, "$$");
newXSproto(strcpy(buf, "SetIncline"), XS_Doors_SetIncline, file, "$$");
newXSproto(strcpy(buf, "SetKeyItem"), XS_Doors_SetKeyItem, file, "$$");
newXSproto(strcpy(buf, "SetLocation"), XS_Doors_SetLocation, file, "$$$$");
newXSproto(strcpy(buf, "SetLockPick"), XS_Doors_SetLockpick, file, "$$");
newXSproto(strcpy(buf, "SetModelName"), XS_Doors_SetModelName, file, "$$");
newXSproto(strcpy(buf, "SetNoKeyring"), XS_Doors_SetNoKeyring, file, "$$");
newXSproto(strcpy(buf, "SetOpenType"), XS_Doors_SetOpenType, file, "$$");
newXSproto(strcpy(buf, "SetSize"), XS_Doors_SetSize, file, "$$");
newXSproto(strcpy(buf, "SetX"), XS_Doors_SetX, file, "$$");
newXSproto(strcpy(buf, "SetY"), XS_Doors_SetY, file, "$$");
newXSproto(strcpy(buf, "SetZ"), XS_Doors_SetZ, file, "$$");
XSRETURN_YES;
void Perl_Doors_CreateDatabaseEntry(Doors* self) // @categories Doors
{
self->CreateDatabaseEntry();
}
void perl_register_doors()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<Doors>("Doors");
package.add("CreateDatabaseEntry", &Perl_Doors_CreateDatabaseEntry);
package.add("GetDoorDBID", &Perl_Doors_GetDoorDBID);
package.add("GetDoorID", &Perl_Doors_GetDoorID);
package.add("GetHeading", &Perl_Doors_GetHeading);
package.add("GetID", &Perl_Doors_GetID);
package.add("GetIncline", &Perl_Doors_GetIncline);
package.add("GetKeyItem", &Perl_Doors_GetKeyItem);
package.add("GetLockPick", &Perl_Doors_GetLockpick);
package.add("GetModelName", &Perl_Doors_GetModelName);
package.add("GetNoKeyring", &Perl_Doors_GetNoKeyring);
package.add("GetOpenType", &Perl_Doors_GetOpenType);
package.add("GetSize", &Perl_Doors_GetSize);
package.add("GetX", &Perl_Doors_GetX);
package.add("GetY", &Perl_Doors_GetY);
package.add("GetZ", &Perl_Doors_GetZ);
package.add("SetHeading", &Perl_Doors_SetHeading);
package.add("SetIncline", &Perl_Doors_SetIncline);
package.add("SetKeyItem", &Perl_Doors_SetKeyItem);
package.add("SetLocation", &Perl_Doors_SetLocation);
package.add("SetLockPick", &Perl_Doors_SetLockpick);
package.add("SetModelName", &Perl_Doors_SetModelName);
package.add("SetNoKeyring", &Perl_Doors_SetNoKeyring);
package.add("SetOpenType", &Perl_Doors_SetOpenType);
package.add("SetSize", &Perl_Doors_SetSize);
package.add("SetX", &Perl_Doors_SetX);
package.add("SetY", &Perl_Doors_SetY);
package.add("SetZ", &Perl_Doors_SetZ);
}
#endif //EMBPERL_XS_CLASSES

1900
zone/perl_entity.cpp
View File

File diff suppressed because it is too large Load Diff

762
zone/perl_expedition.cpp
View File

@ -2,669 +2,267 @@
#ifdef EMBPERL_XS_CLASSES
#include "embperl.h"
#include "expedition.h"
#include "zone_store.h"
#include "embperl.h"
#include "../common/global_define.h"
#ifdef seed
#undef seed
#endif
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_EXPEDITION \
do { \
if (sv_derived_from(ST(0), "Expedition")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Expedition*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Expedition"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Expedition_AddLockout);
XS(XS_Expedition_AddLockout) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::AddLockout(THIS, string event_name, uint32 seconds)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
uint32_t seconds = static_cast<uint32_t>(SvUV(ST(2)));
THIS->AddLockout(event_name, seconds);
XSRETURN_EMPTY;
void Perl_Expedition_AddLockout(Expedition* self, std::string event_name, uint32_t seconds)
{
self->AddLockout(event_name, seconds);
}
XS(XS_Expedition_AddLockoutDuration);
XS(XS_Expedition_AddLockoutDuration) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Expedition::AddLockout(THIS, string event_name, int seconds, [bool members_only = true])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
int seconds = static_cast<int>(SvUV(ST(2)));
if (items == 4)
{
bool members_only = (bool)SvTRUE(ST(3));
THIS->AddLockoutDuration(event_name, seconds, members_only);
}
else
{
THIS->AddLockoutDuration(event_name, seconds);
}
XSRETURN_EMPTY;
void Perl_Expedition_AddLockoutDuration(Expedition* self, std::string event_name, int seconds)
{
self->AddLockoutDuration(event_name, seconds);
}
XS(XS_Expedition_AddReplayLockout);
XS(XS_Expedition_AddReplayLockout) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::AddReplayLockout(THIS, uint32 seconds)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t seconds = static_cast<uint32_t>(SvUV(ST(1)));
THIS->AddReplayLockout(seconds);
XSRETURN_EMPTY;
void Perl_Expedition_AddLockoutDuration(Expedition* self, std::string event_name, int seconds, bool members_only)
{
self->AddLockoutDuration(event_name, seconds, members_only);
}
XS(XS_Expedition_AddReplayLockoutDuration);
XS(XS_Expedition_AddReplayLockoutDuration) {
dXSARGS;
if (items != 2 && items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::AddReplayLockoutDuration(THIS, int seconds, [bool members_only = true])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
int seconds = static_cast<int>(SvUV(ST(1)));
if (items == 3)
{
bool members_only = (bool)SvTRUE(ST(2));
THIS->AddReplayLockoutDuration(seconds, members_only);
}
else
{
THIS->AddReplayLockoutDuration(seconds);
}
XSRETURN_EMPTY;
void Perl_Expedition_AddReplayLockout(Expedition* self, uint32_t seconds)
{
self->AddReplayLockout(seconds);
}
XS(XS_Expedition_GetDynamicZoneID);
XS(XS_Expedition_GetDynamicZoneID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetDynamicZoneID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetID());
void Perl_Expedition_AddReplayLockoutDuration(Expedition* self, int seconds)
{
self->AddReplayLockoutDuration(seconds);
}
XS(XS_Expedition_GetID);
XS(XS_Expedition_GetID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetID());
void Perl_Expedition_AddReplayLockoutDuration(Expedition* self, int seconds, bool members_only)
{
self->AddReplayLockoutDuration(seconds, members_only);
}
XS(XS_Expedition_GetInstanceID);
XS(XS_Expedition_GetInstanceID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetInstanceID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetInstanceID());
uint32_t Perl_Expedition_GetDynamicZoneID(Expedition* self)
{
return self->GetDynamicZone()->GetID();
}
XS(XS_Expedition_GetLeaderName);
XS(XS_Expedition_GetLeaderName) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetLeaderName(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(THIS->GetLeaderName().c_str());
uint32_t Perl_Expedition_GetID(Expedition* self)
{
return self->GetID();
}
XS(XS_Expedition_GetLockouts);
XS(XS_Expedition_GetLockouts) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetLockouts(THIS)");
}
uint16_t Perl_Expedition_GetInstanceID(Expedition* self)
{
return self->GetDynamicZone()->GetInstanceID();
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string Perl_Expedition_GetLeaderName(Expedition* self)
{
return self->GetLeaderName();
}
HV* hash = newHV();
auto lockouts = THIS->GetLockouts();
perl::reference Perl_Expedition_GetLockouts(Expedition* self)
{
perl::hash table;
auto lockouts = self->GetLockouts();
for (const auto& lockout : lockouts)
{
hv_store(hash, lockout.first.c_str(), static_cast<uint32_t>(lockout.first.size()),
newSVuv(lockout.second.GetSecondsRemaining()), 0);
table[lockout.first] = lockout.second.GetSecondsRemaining();
}
ST(0) = sv_2mortal(newRV_noinc((SV*)hash)); // take ownership of hash (refcnt remains 1)
XSRETURN(1);
return perl::reference(table);
}
XS(XS_Expedition_GetLootEventByNPCTypeID);
XS(XS_Expedition_GetLootEventByNPCTypeID) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::GetLootEventByNPCTypeID(THIS, uint32 npc_type_id)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t npc_type_id = static_cast<uint32_t>(SvUV(ST(1)));
XSRETURN_PV(THIS->GetLootEventByNPCTypeID(npc_type_id).c_str());
std::string Perl_Expedition_GetLootEventByNPCTypeID(Expedition* self, uint32_t npc_type_id)
{
return self->GetLootEventByNPCTypeID(npc_type_id);
}
XS(XS_Expedition_GetLootEventBySpawnID);
XS(XS_Expedition_GetLootEventBySpawnID) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::GetLootEventBySpawnID(THIS, uint32 spawn_id)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t spawn_id = static_cast<uint32_t>(SvUV(ST(1)));
XSRETURN_PV(THIS->GetLootEventBySpawnID(spawn_id).c_str());
std::string Perl_Expedition_GetLootEventBySpawnID(Expedition* self, uint32_t spawn_id)
{
return self->GetLootEventBySpawnID(spawn_id);
}
XS(XS_Expedition_GetMemberCount);
XS(XS_Expedition_GetMemberCount) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetMemberCount(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetMemberCount());
uint32_t Perl_Expedition_GetMemberCount(Expedition* self)
{
return self->GetDynamicZone()->GetMemberCount();
}
XS(XS_Expedition_GetMembers);
XS(XS_Expedition_GetMembers) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetMembers(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
HV* hash = newHV();
for (const auto& member : THIS->GetDynamicZone()->GetMembers())
perl::reference Perl_Expedition_GetMembers(Expedition* self)
{
perl::hash table;
for (const auto& member : self->GetDynamicZone()->GetMembers())
{
hv_store(hash, member.name.c_str(), static_cast<uint32_t>(member.name.size()),
newSVuv(member.id), 0);
table[member.name] = member.id;
}
ST(0) = sv_2mortal(newRV_noinc((SV*)hash));
XSRETURN(1);
return perl::reference(table);
}
XS(XS_Expedition_GetName);
XS(XS_Expedition_GetName) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetName(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(THIS->GetName().c_str());
std::string Perl_Expedition_GetName(Expedition* self)
{
return self->GetName();
}
XS(XS_Expedition_GetSecondsRemaining);
XS(XS_Expedition_GetSecondsRemaining) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetSecondsRemaining(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetSecondsRemaining());
uint32_t Perl_Expedition_GetSecondsRemaining(Expedition* self)
{
return self->GetDynamicZone()->GetSecondsRemaining();
}
XS(XS_Expedition_GetUUID);
XS(XS_Expedition_GetUUID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetUUID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(THIS->GetDynamicZone()->GetUUID().c_str());
std::string Perl_Expedition_GetUUID(Expedition* self)
{
return self->GetDynamicZone()->GetUUID();
}
XS(XS_Expedition_GetZoneID);
XS(XS_Expedition_GetZoneID) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetZoneID(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetZoneID());
uint16_t Perl_Expedition_GetZoneID(Expedition* self)
{
return self->GetDynamicZone()->GetZoneID();
}
XS(XS_Expedition_GetZoneName);
XS(XS_Expedition_GetZoneName) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetZoneName(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_PV(ZoneName(THIS->GetDynamicZone()->GetZoneID()));
std::string Perl_Expedition_GetZoneName(Expedition* self)
{
return ZoneName(self->GetDynamicZone()->GetZoneID());
}
XS(XS_Expedition_GetZoneVersion);
XS(XS_Expedition_GetZoneVersion) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::GetZoneVersion(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
XSRETURN_UV(THIS->GetDynamicZone()->GetZoneVersion());
uint32_t Perl_Expedition_GetZoneVersion(Expedition* self)
{
return self->GetDynamicZone()->GetZoneVersion();
}
XS(XS_Expedition_HasLockout);
XS(XS_Expedition_HasLockout) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::HasLockout(THIS, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
bool result = THIS->HasLockout(event_name);
ST(0) = boolSV(result);
XSRETURN(1);
bool Perl_Expedition_HasLockout(Expedition* self, std::string event_name)
{
return self->HasLockout(event_name);
}
XS(XS_Expedition_HasReplayLockout);
XS(XS_Expedition_HasReplayLockout) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::HasReplayLockout(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
bool result = THIS->HasReplayLockout();
ST(0) = boolSV(result);
XSRETURN(1);
bool Perl_Expedition_HasReplayLockout(Expedition* self)
{
return self->HasReplayLockout();
}
XS(XS_Expedition_IsLocked);
XS(XS_Expedition_IsLocked) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::IsLocked(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
ST(0) = boolSV(THIS->IsLocked());
XSRETURN(1);
bool Perl_Expedition_IsLocked(Expedition* self)
{
return self->IsLocked();
}
XS(XS_Expedition_RemoveCompass);
XS(XS_Expedition_RemoveCompass) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Expedition::RemoveCompass(THIS)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
THIS->GetDynamicZone()->SetCompass(0, 0, 0, 0, true);
XSRETURN_EMPTY;
void Perl_Expedition_RemoveCompass(Expedition* self)
{
self->GetDynamicZone()->SetCompass(0, 0, 0, 0, true);
}
XS(XS_Expedition_RemoveLockout);
XS(XS_Expedition_RemoveLockout) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::RemoveLockout(THIS, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
THIS->RemoveLockout(event_name);
XSRETURN_EMPTY;
void Perl_Expedition_RemoveLockout(Expedition* self, std::string event_name)
{
self->RemoveLockout(event_name);
}
XS(XS_Expedition_SetCompass);
XS(XS_Expedition_SetCompass) {
dXSARGS;
if (items != 5) {
Perl_croak(aTHX_ "Usage: Expedition::SetCompass(THIS, uint32 zone_id | string zone_name, float x, float y, float z)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
float x = static_cast<float>(SvNV(ST(2)));
float y = static_cast<float>(SvNV(ST(3)));
float z = static_cast<float>(SvNV(ST(4)));
if (SvTYPE(ST(1)) == SVt_PV)
{
std::string zone_name(SvPV_nolen(ST(1)));
THIS->GetDynamicZone()->SetCompass(ZoneID(zone_name), x, y, z, true);
}
else if (SvTYPE(ST(1)) == SVt_IV)
{
uint32_t zone_id = static_cast<uint32_t>(SvUV(ST(1)));
THIS->GetDynamicZone()->SetCompass(zone_id, x, y, z, true);
}
else
{
Perl_croak(aTHX_ "Expedition::SetCompass expected an integer or string");
}
XSRETURN_EMPTY;
void Perl_Expedition_SetCompass(Expedition* self, perl::scalar zone, float x, float y, float z)
{
uint32_t zone_id = zone.is_string() ? ZoneID(zone.c_str()) : zone.as<uint32_t>();
self->GetDynamicZone()->SetCompass(zone_id, x, y, z, true);
}
XS(XS_Expedition_SetLocked);
XS(XS_Expedition_SetLocked) {
dXSARGS;
if (items != 2 && items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Expedition::SetLocked(THIS, bool locked, [int lock_msg = 0], [uint32 color = 15])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
bool locked = (bool)SvTRUE(ST(1));
int lock_msg = (items == 3) ? static_cast<int>(SvIV(ST(2))) : 0;
if (items == 4)
{
THIS->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true, (uint32)SvUV(ST(3)));
}
else
{
THIS->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true);
}
XSRETURN_EMPTY;
void Perl_Expedition_SetLocked(Expedition* self, bool locked)
{
self->SetLocked(locked, ExpeditionLockMessage::None);
}
XS(XS_Expedition_SetLootEventByNPCTypeID);
XS(XS_Expedition_SetLootEventByNPCTypeID) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::SetLootEventByNPCTypeID(THIS, uint32 npc_type_id, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t npc_type_id = static_cast<uint32_t>(SvUV(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
THIS->SetLootEventByNPCTypeID(npc_type_id, event_name);
XSRETURN_EMPTY;
void Perl_Expedition_SetLocked(Expedition* self, bool locked, int lock_msg)
{
self->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true);
}
XS(XS_Expedition_SetLootEventBySpawnID);
XS(XS_Expedition_SetLootEventBySpawnID) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: Expedition::SetLootEventBySpawnID(THIS, uint32 spawn_id, string event_name)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t spawn_id = static_cast<uint32_t>(SvUV(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
THIS->SetLootEventBySpawnID(spawn_id, event_name);
XSRETURN_EMPTY;
void Perl_Expedition_SetLocked(Expedition* self, bool locked, int lock_msg, uint32_t color)
{
self->SetLocked(locked, static_cast<ExpeditionLockMessage>(lock_msg), true, color);
}
XS(XS_Expedition_SetReplayLockoutOnMemberJoin);
XS(XS_Expedition_SetReplayLockoutOnMemberJoin) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::SetReplayLockoutOnMemberJoin(THIS, bool enable)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
bool enable = (bool)SvTRUE(ST(1));
THIS->SetReplayLockoutOnMemberJoin(enable, true);
XSRETURN_EMPTY;
void Perl_Expedition_SetLootEventByNPCTypeID(Expedition* self, uint32_t npc_type_id, std::string event_name)
{
self->SetLootEventByNPCTypeID(npc_type_id, event_name);
}
XS(XS_Expedition_SetSafeReturn);
XS(XS_Expedition_SetSafeReturn) {
dXSARGS;
if (items != 6) {
Perl_croak(aTHX_ "Usage: Expedition::SetSafeReturn(THIS, uint32 zone_id | string zone_name, float x, float y, float z, float heading)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
float x = static_cast<float>(SvNV(ST(2)));
float y = static_cast<float>(SvNV(ST(3)));
float z = static_cast<float>(SvNV(ST(4)));
float heading = static_cast<float>(SvNV(ST(5)));
if (SvTYPE(ST(1)) == SVt_PV)
{
std::string zone_name(SvPV_nolen(ST(1)));
THIS->GetDynamicZone()->SetSafeReturn(ZoneID(zone_name), x, y, z, heading, true);
}
else if (SvTYPE(ST(1)) == SVt_IV)
{
uint32_t zone_id = static_cast<uint32_t>(SvUV(ST(1)));
THIS->GetDynamicZone()->SetSafeReturn(zone_id, x, y, z, heading, true);
}
else
{
Perl_croak(aTHX_ "Expedition::SetSafeReturn expected an integer or string");
}
XSRETURN_EMPTY;
void Perl_Expedition_SetLootEventBySpawnID(Expedition* self, uint32_t entity_id, std::string event_name)
{
self->SetLootEventBySpawnID(entity_id, event_name);
}
XS(XS_Expedition_SetSecondsRemaining);
XS(XS_Expedition_SetSecondsRemaining) {
dXSARGS;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Expedition::SetSecondsRemaining(THIS, uint32 seconds_remaining)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
uint32_t seconds_remaining = static_cast<uint32_t>(SvUV(ST(1)));
THIS->GetDynamicZone()->SetSecondsRemaining(seconds_remaining);
XSRETURN_EMPTY;
void Perl_Expedition_SetReplayLockoutOnMemberJoin(Expedition* self, bool enable)
{
self->SetReplayLockoutOnMemberJoin(enable, true);
}
XS(XS_Expedition_SetZoneInLocation);
XS(XS_Expedition_SetZoneInLocation) {
dXSARGS;
if (items != 5) {
Perl_croak(aTHX_ "Usage: Expedition::SetZoneInLocation(THIS, float x, float y, float z, float heading)");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
float x = static_cast<float>(SvNV(ST(1)));
float y = static_cast<float>(SvNV(ST(2)));
float z = static_cast<float>(SvNV(ST(3)));
float heading = static_cast<float>(SvNV(ST(4)));
THIS->GetDynamicZone()->SetZoneInLocation(x, y, z, heading, true);
XSRETURN_EMPTY;
void Perl_Expedition_SetSafeReturn(Expedition* self, perl::scalar zone, float x, float y, float z, float heading)
{
uint32_t zone_id = zone.is_string() ? ZoneID(zone.c_str()) : zone.as<uint32_t>();
self->GetDynamicZone()->SetSafeReturn(zone_id, x, y, z, heading, true);
}
XS(XS_Expedition_UpdateLockoutDuration);
XS(XS_Expedition_UpdateLockoutDuration) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Expedition::UpdateLockoutDuration(THIS, string event_name, uint32 seconds, [bool members_only = true])");
}
Expedition* THIS = nullptr;
VALIDATE_THIS_IS_EXPEDITION;
std::string event_name(SvPV_nolen(ST(1)));
uint32_t seconds = static_cast<uint32_t>(SvUV(ST(2)));
if (items == 4)
{
bool members_only = (bool)SvTRUE(ST(3));
THIS->UpdateLockoutDuration(event_name, seconds, members_only);
}
else
{
THIS->UpdateLockoutDuration(event_name, seconds);
}
XSRETURN_EMPTY;
void Perl_Expedition_SetSecondsRemaining(Expedition* self, uint32_t seconds_remaining)
{
self->GetDynamicZone()->SetSecondsRemaining(seconds_remaining);
}
XS(boot_Expedition);
XS(boot_Expedition) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
void Perl_Expedition_SetZoneInLocation(Expedition* self, float x, float y, float z, float heading)
{
self->GetDynamicZone()->SetZoneInLocation(x, y, z, heading, true);
}
if (items != 1) {
fprintf(stderr, "boot_Expedition does not take any arguments.");
}
char buf[128];
void Perl_Expedition_UpdateLockoutDuration(Expedition* self, std::string event_name, uint32_t seconds)
{
self->UpdateLockoutDuration(event_name, seconds);
}
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "AddLockout"), XS_Expedition_AddLockout, file, "$$$");
newXSproto(strcpy(buf, "AddLockoutDuration"), XS_Expedition_AddLockoutDuration, file, "$$$;$");
newXSproto(strcpy(buf, "AddReplayLockout"), XS_Expedition_AddReplayLockout, file, "$$");
newXSproto(strcpy(buf, "AddReplayLockoutDuration"), XS_Expedition_AddReplayLockoutDuration, file, "$$;$");
newXSproto(strcpy(buf, "GetDynamicZoneID"), XS_Expedition_GetDynamicZoneID, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Expedition_GetID, file, "$");
newXSproto(strcpy(buf, "GetInstanceID"), XS_Expedition_GetInstanceID, file, "$");
newXSproto(strcpy(buf, "GetLeaderName"), XS_Expedition_GetLeaderName, file, "$");
newXSproto(strcpy(buf, "GetLockouts"), XS_Expedition_GetLockouts, file, "$");
newXSproto(strcpy(buf, "GetLootEventByNPCTypeID"), XS_Expedition_GetLootEventByNPCTypeID, file, "$$");
newXSproto(strcpy(buf, "GetLootEventBySpawnID"), XS_Expedition_GetLootEventBySpawnID, file, "$$");
newXSproto(strcpy(buf, "GetMemberCount"), XS_Expedition_GetMemberCount, file, "$");
newXSproto(strcpy(buf, "GetMembers"), XS_Expedition_GetMembers, file, "$");
newXSproto(strcpy(buf, "GetName"), XS_Expedition_GetName, file, "$");
newXSproto(strcpy(buf, "GetSecondsRemaining"), XS_Expedition_GetSecondsRemaining, file, "$");
newXSproto(strcpy(buf, "GetUUID"), XS_Expedition_GetUUID, file, "$");
newXSproto(strcpy(buf, "GetZoneID"), XS_Expedition_GetZoneID, file, "$");
newXSproto(strcpy(buf, "GetZoneName"), XS_Expedition_GetZoneName, file, "$");
newXSproto(strcpy(buf, "GetZoneVersion"), XS_Expedition_GetZoneVersion, file, "$");
newXSproto(strcpy(buf, "HasLockout"), XS_Expedition_HasLockout, file, "$$");
newXSproto(strcpy(buf, "HasReplayLockout"), XS_Expedition_HasReplayLockout, file, "$");
newXSproto(strcpy(buf, "IsLocked"), XS_Expedition_IsLocked, file, "$");
newXSproto(strcpy(buf, "RemoveCompass"), XS_Expedition_RemoveCompass, file, "$");
newXSproto(strcpy(buf, "RemoveLockout"), XS_Expedition_RemoveLockout, file, "$$");
newXSproto(strcpy(buf, "SetCompass"), XS_Expedition_SetCompass, file, "$$$$$");
newXSproto(strcpy(buf, "SetLocked"), XS_Expedition_SetLocked, file, "$$;$$");
newXSproto(strcpy(buf, "SetLootEventByNPCTypeID"), XS_Expedition_SetLootEventByNPCTypeID, file, "$$$");
newXSproto(strcpy(buf, "SetLootEventBySpawnID"), XS_Expedition_SetLootEventBySpawnID, file, "$$$");
newXSproto(strcpy(buf, "SetReplayLockoutOnMemberJoin"), XS_Expedition_SetReplayLockoutOnMemberJoin, file, "$$");
newXSproto(strcpy(buf, "SetSafeReturn"), XS_Expedition_SetSafeReturn, file, "$$$$$$");
newXSproto(strcpy(buf, "SetSecondsRemaining"), XS_Expedition_SetSecondsRemaining, file, "$$");
newXSproto(strcpy(buf, "SetZoneInLocation"), XS_Expedition_SetZoneInLocation, file, "$$$$$");
newXSproto(strcpy(buf, "UpdateLockoutDuration"), XS_Expedition_UpdateLockoutDuration, file, "$$$;$");
void Perl_Expedition_UpdateLockoutDuration(Expedition* self, std::string event_name, uint32_t seconds, bool members_only)
{
self->UpdateLockoutDuration(event_name, seconds, members_only);
}
HV* stash = gv_stashpvs("ExpeditionLockMessage", GV_ADD);
newCONSTSUB(stash, "None", newSViv(static_cast<int>(ExpeditionLockMessage::None)));
newCONSTSUB(stash, "Close", newSViv(static_cast<int>(ExpeditionLockMessage::Close)));
newCONSTSUB(stash, "Begin", newSViv(static_cast<int>(ExpeditionLockMessage::Begin)));
void perl_register_expedition()
{
perl::interpreter perl(PERL_GET_THX);
XSRETURN_YES;
auto package = perl.new_class<Expedition>("Expedition");
package.add("AddLockout", &Perl_Expedition_AddLockout);
package.add("AddLockoutDuration", (void(*)(Expedition*, std::string, int))&Perl_Expedition_AddLockoutDuration);
package.add("AddLockoutDuration", (void(*)(Expedition*, std::string, int, bool))&Perl_Expedition_AddLockoutDuration);
package.add("AddReplayLockout", &Perl_Expedition_AddReplayLockout);
package.add("AddReplayLockoutDuration", (void(*)(Expedition*, int))&Perl_Expedition_AddReplayLockoutDuration);
package.add("AddReplayLockoutDuration", (void(*)(Expedition*, int, bool))&Perl_Expedition_AddReplayLockoutDuration);
package.add("GetDynamicZoneID", &Perl_Expedition_GetDynamicZoneID);
package.add("GetID", &Perl_Expedition_GetID);
package.add("GetInstanceID", &Perl_Expedition_GetInstanceID);
package.add("GetLeaderName", &Perl_Expedition_GetLeaderName);
package.add("GetLockouts", &Perl_Expedition_GetLockouts);
package.add("GetLootEventByNPCTypeID", &Perl_Expedition_GetLootEventByNPCTypeID);
package.add("GetLootEventBySpawnID", &Perl_Expedition_GetLootEventBySpawnID);
package.add("GetMemberCount", &Perl_Expedition_GetMemberCount);
package.add("GetMembers", &Perl_Expedition_GetMembers);
package.add("GetName", &Perl_Expedition_GetName);
package.add("GetSecondsRemaining", &Perl_Expedition_GetSecondsRemaining);
package.add("GetUUID", &Perl_Expedition_GetUUID);
package.add("GetZoneID", &Perl_Expedition_GetZoneID);
package.add("GetZoneName", &Perl_Expedition_GetZoneName);
package.add("GetZoneVersion", &Perl_Expedition_GetZoneVersion);
package.add("HasLockout", &Perl_Expedition_HasLockout);
package.add("HasReplayLockout", &Perl_Expedition_HasReplayLockout);
package.add("IsLocked", &Perl_Expedition_IsLocked);
package.add("RemoveCompass", &Perl_Expedition_RemoveCompass);
package.add("RemoveLockout", &Perl_Expedition_RemoveLockout);
package.add("SetCompass", &Perl_Expedition_SetCompass);
package.add("SetLocked", (void(*)(Expedition*, bool))&Perl_Expedition_SetLocked);
package.add("SetLocked", (void(*)(Expedition*, bool, int))&Perl_Expedition_SetLocked);
package.add("SetLocked", (void(*)(Expedition*, bool, int, uint32_t))&Perl_Expedition_SetLocked);
package.add("SetLootEventByNPCTypeID", &Perl_Expedition_SetLootEventByNPCTypeID);
package.add("SetLootEventBySpawnID", &Perl_Expedition_SetLootEventBySpawnID);
package.add("SetReplayLockoutOnMemberJoin", &Perl_Expedition_SetReplayLockoutOnMemberJoin);
package.add("SetSafeReturn", &Perl_Expedition_SetSafeReturn);
package.add("SetSecondsRemaining", &Perl_Expedition_SetSecondsRemaining);
package.add("SetZoneInLocation", &Perl_Expedition_SetZoneInLocation);
package.add("UpdateLockoutDuration", (void(*)(Expedition*, std::string, uint32_t))&Perl_Expedition_UpdateLockoutDuration);
package.add("UpdateLockoutDuration", (void(*)(Expedition*, std::string, uint32_t, bool))&Perl_Expedition_UpdateLockoutDuration);
}
void perl_register_expedition_lock_messages()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_package("ExpeditionLockMessage");
package.add_const("None", static_cast<int>(ExpeditionLockMessage::None));
package.add_const("Close", static_cast<int>(ExpeditionLockMessage::Close));
package.add_const("Begin", static_cast<int>(ExpeditionLockMessage::Begin));
}
#endif //EMBPERL_XS_CLASSES

578
zone/perl_groups.cpp
View File

@ -4,475 +4,149 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "groups.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
void Perl_Group_DisbandGroup(Group* self) // @categories Script Utility, Group
{
self->DisbandGroup();
}
#define VALIDATE_THIS_IS_GROUP \
do { \
if (sv_derived_from(ST(0), "Group")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Group*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Group"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
bool Perl_Group_IsGroupMember(Group* self, Mob* client) // @categories Account and Character, Script Utility, Group
{
return self->IsGroupMember(client);
}
XS(XS_Group_DisbandGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_DisbandGroup) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::DisbandGroup(THIS)"); // @categories Script Utility, Group
void Perl_Group_CastGroupSpell(Group* self, Mob* caster, uint16 spell_id) // @categories Account and Character, Script Utility, Group
{
self->CastGroupSpell(caster, spell_id);
}
void Perl_Group_SplitExp(Group* self, uint32_t exp, Mob* other) // @categories Account and Character, Script Utility, Group
{
self->SplitExp(exp, other);
}
void Perl_Group_GroupMessage(Group* self, Mob* sender, const char* message) // @categories Script Utility, Group
{
// if no language is specificed, send it in common
self->GroupMessage(sender, 0, 100, message);
}
void Perl_Group_GroupMessage(Group* self, Mob* sender, uint8_t language, const char* message) // @categories Script Utility, Group
{
if ((language >= MAX_PP_LANGUAGE) || (language < 0))
{
Group *THIS;
VALIDATE_THIS_IS_GROUP;
THIS->DisbandGroup();
language = 0;
}
XSRETURN_EMPTY;
self->GroupMessage(sender, language, 100, message);
}
XS(XS_Group_IsGroupMember); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_IsGroupMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::IsGroupMember(THIS, client)"); // @categories Account and Character, Script Utility, Group
uint32_t Perl_Group_GetTotalGroupDamage(Group* self, Mob* other) // @categories Script Utility, Group
{
return self->GetTotalGroupDamage(other);
}
void Perl_Group_SplitMoney(Group* self, uint32 copper, uint32 silver, uint32 gold, uint32 platinum) // @categories Currency and Points, Script Utility, Group
{
self->SplitMoney(copper, silver, gold, platinum);
}
void Perl_Group_SetLeader(Group* self, Mob* new_leader) // @categories Account and Character, Script Utility, Group
{
self->SetLeader(new_leader);
}
Mob* Perl_Group_GetLeader(Group* self) // @categories Account and Character, Script Utility, Group
{
return self->GetLeader();
}
std::string Perl_Group_GetLeaderName(Group* self) // @categories Account and Character, Script Utility, Group
{
return self->GetLeaderName();
}
void Perl_Group_SendHPPacketsTo(Group* self, Mob* new_member) // @categories Script Utility, Group
{
self->SendHPManaEndPacketsTo(new_member);
}
void Perl_Group_SendHPPacketsFrom(Group* self, Mob* new_member) // @categories Script Utility, Group
{
self->SendHPPacketsFrom(new_member);
}
bool Perl_Group_IsLeader(Group* self, Mob* leadertest) // @categories Account and Character, Script Utility, Group
{
return self->IsLeader(leadertest);
}
int Perl_Group_GroupCount(Group* self) // @categories Script Utility, Group
{
return self->GroupCount();
}
uint32_t Perl_Group_GetHighestLevel(Group* self) // @categories Script Utility, Group
{
return self->GetHighestLevel();
}
void Perl_Group_TeleportGroup(Group* self, Mob* sender, uint32 zone_id, float x, float y, float z, float heading) // @categories Script Utility, Group
{
self->TeleportGroup(sender, zone_id, 0, x, y, z, heading);
}
uint32_t Perl_Group_GetID(Group* self) // @categories Script Utility, Group
{
return self->GetID();
}
Client* Perl_Group_GetMember(Group* self, int group_index) // @categories Account and Character, Script Utility, Group
{
Mob* member = nullptr;
if (group_index >= 0 && group_index < 6)
{
Group *THIS;
bool RETVAL;
Mob *client;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
client = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "client is not of type Mob");
if (client == nullptr)
Perl_croak(aTHX_ "client is nullptr, avoiding crash.");
RETVAL = THIS->IsGroupMember(client);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
member = self->members[group_index];
}
XSRETURN(1);
return member ? member->CastToClient() : nullptr;
}
XS(XS_Group_CastGroupSpell); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_CastGroupSpell) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Group::CastGroupSpell(THIS, Mob* caster, uint16 spell_id)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *caster;
uint16 spellid = (uint16) SvUV(ST(2));
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
caster = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "caster is not of type Mob");
if (caster == nullptr)
Perl_croak(aTHX_ "caster is nullptr, avoiding crash.");
THIS->CastGroupSpell(caster, spellid);
}
XSRETURN_EMPTY;
bool Perl_Group_DoesAnyMemberHaveExpeditionLockout(Group* self, std::string expedition_name, std::string event_name)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name);
}
XS(XS_Group_SplitExp); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SplitExp) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Group::SplitExp(THIS, uint32 exp, Mob* other)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
uint32 exp = (uint32) SvUV(ST(1));
Mob *other;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(2), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(2)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
THIS->SplitExp(exp, other);
}
XSRETURN_EMPTY;
bool Perl_Group_DoesAnyMemberHaveExpeditionLockout(Group* self, std::string expedition_name, std::string event_name, int max_check_count)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
}
XS(XS_Group_GroupMessage); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GroupMessage) {
dXSARGS;
if ((items != 3) && (items != 4)) // the 3 item version is kept for backwards compatability
Perl_croak(aTHX_ "Usage: Group::GroupMessage(THIS, Mob* sender, uint8 language, string message)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *sender;
uint8 language;
char *message;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
void perl_register_group()
{
perl::interpreter perl(PERL_GET_THX);
if (items == 4) {
language = (uint8) SvUV(ST(2));
if ((language >= MAX_PP_LANGUAGE) || (language < 0))
language = 0;
message = (char *) SvPV_nolen(ST(3));
THIS->GroupMessage(sender, language, 100, message);
} else { // if no language is specificed, send it in common
message = (char *) SvPV_nolen(ST(2));
THIS->GroupMessage(sender, 0, 100, message);
}
}
XSRETURN_EMPTY;
}
XS(XS_Group_GetTotalGroupDamage); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetTotalGroupDamage) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::GetTotalGroupDamage(THIS, Mob* other)"); // @categories Script Utility, Group
{
Group *THIS;
uint32 RETVAL;
dXSTARG;
Mob *other;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
RETVAL = THIS->GetTotalGroupDamage(other);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_SplitMoney); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SplitMoney) {
dXSARGS;
if (items != 5)
Perl_croak(aTHX_ "Usage: Group::SplitMoney(THIS, uint32 copper, uint32 silver, uint32 gold, uint32 platinum)"); // @categories Currency and Points, Script Utility, Group
{
Group *THIS;
uint32 copper = (uint32) SvUV(ST(1));
uint32 silver = (uint32) SvUV(ST(2));
uint32 gold = (uint32) SvUV(ST(3));
uint32 platinum = (uint32) SvUV(ST(4));
VALIDATE_THIS_IS_GROUP;
THIS->SplitMoney(copper, silver, gold, platinum);
}
XSRETURN_EMPTY;
}
XS(XS_Group_SetLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SetLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::SetLeader(THIS, Mob* new_leader)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *newleader;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
newleader = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "newleader is not of type Mob");
if (newleader == nullptr)
Perl_croak(aTHX_ "newleader is nullptr, avoiding crash.");
THIS->SetLeader(newleader);
}
XSRETURN_EMPTY;
}
XS(XS_Group_GetLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetLeader) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetLeader(THIS)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *RETVAL;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetLeader();
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Mob", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_GetLeaderName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetLeaderName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetLeaderName(THIS)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
const char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetLeaderName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
}
XS(XS_Group_SendHPPacketsTo); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SendHPPacketsTo) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::SendHPPacketsTo(THIS, Mob* new_member)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *newmember;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
newmember = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "newmember is not of type Mob");
if (newmember == nullptr)
Perl_croak(aTHX_ "newmember is nullptr, avoiding crash.");
THIS->SendHPManaEndPacketsTo(newmember);
}
XSRETURN_EMPTY;
}
XS(XS_Group_SendHPPacketsFrom); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_SendHPPacketsFrom) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::SendHPPacketsFrom(THIS, Mob* new_member)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *newmember;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
newmember = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "newmember is not of type Mob");
if (newmember == nullptr)
Perl_croak(aTHX_ "newmember is nullptr, avoiding crash.");
THIS->SendHPPacketsFrom(newmember);
}
XSRETURN_EMPTY;
}
XS(XS_Group_IsLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_IsLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::IsLeader(THIS, Mob* target)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
bool RETVAL;
Mob *leadertest;
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
leadertest = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "leadertest is not of type Mob");
if (leadertest == nullptr)
Perl_croak(aTHX_ "leadertest is nullptr, avoiding crash.");
RETVAL = THIS->IsLeader(leadertest);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Group_GroupCount); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GroupCount) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GroupCount(THIS)"); // @categories Script Utility, Group
{
Group *THIS;
uint8 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GroupCount();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_GetHighestLevel); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetHighestLevel) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetHighestLevel(THIS)"); // @categories Script Utility, Group
{
Group *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetHighestLevel();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_TeleportGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_TeleportGroup) {
dXSARGS;
if (items != 7)
Perl_croak(aTHX_ "Usage: Group::TeleportGroup(THIS, Mob* sender, uint32 zone_id, float x, float y, float z, float heading)"); // @categories Script Utility, Group
{
Group *THIS;
Mob *sender;
uint32 zoneID = (uint32) SvUV(ST(2));
float x = (float) SvNV(ST(3));
float y = (float) SvNV(ST(4));
float z = (float) SvNV(ST(5));
float heading = (float) SvNV(ST(6));
VALIDATE_THIS_IS_GROUP;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
THIS->TeleportGroup(sender, zoneID, 0, x, y, z, heading);
}
XSRETURN_EMPTY;
}
XS(XS_Group_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Group_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Group::GetID(THIS)"); // @categories Script Utility, Group
{
Group *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
RETVAL = THIS->GetID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_GetMember);
XS(XS_Group_GetMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Group::GetMember(THIS, int group_index)"); // @categories Account and Character, Script Utility, Group
{
Group *THIS;
Mob *member;
Client *RETVAL = nullptr;
dXSTARG;
VALIDATE_THIS_IS_GROUP;
int index = (int) SvUV(ST(1));
if (index < 0 || index > 5)
RETVAL = nullptr;
else {
member = THIS->members[index];
if (member != nullptr)
RETVAL = member->CastToClient();
}
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Client", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Group_DoesAnyMemberHaveExpeditionLockout);
XS(XS_Group_DoesAnyMemberHaveExpeditionLockout) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Group::DoesAnyMemberHaveExpeditionLockout(THIS, string expedition_name, string event_name, [int max_check_count = 0])");
}
Group* THIS = nullptr;
VALIDATE_THIS_IS_GROUP;
std::string expedition_name(SvPV_nolen(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
int max_check_count = (items == 4) ? static_cast<int>(SvIV(ST(3))) : 0;
bool result = THIS->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
ST(0) = boolSV(result);
XSRETURN(1);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Group); /* prototype to pass -Wmissing-prototypes */
XS(boot_Group) {
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, "CastGroupSpell"), XS_Group_CastGroupSpell, file, "$$$");
newXSproto(strcpy(buf, "DisbandGroup"), XS_Group_DisbandGroup, file, "$");
newXSproto(strcpy(buf, "DoesAnyMemberHaveExpeditionLockout"), XS_Group_DoesAnyMemberHaveExpeditionLockout, file, "$$$;$");
newXSproto(strcpy(buf, "GetHighestLevel"), XS_Group_GetHighestLevel, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Group_GetID, file, "$");
newXSproto(strcpy(buf, "GetLeader"), XS_Group_GetLeader, file, "$");
newXSproto(strcpy(buf, "GetLeaderName"), XS_Group_GetLeaderName, file, "$");
newXSproto(strcpy(buf, "GetMember"), XS_Group_GetMember, file, "$$");
newXSproto(strcpy(buf, "GetTotalGroupDamage"), XS_Group_GetTotalGroupDamage, file, "$$");
newXSproto(strcpy(buf, "GroupCount"), XS_Group_GroupCount, file, "$");
newXSproto(strcpy(buf, "GroupMessage"), XS_Group_GroupMessage, file, "$$$");
newXSproto(strcpy(buf, "IsGroupMember"), XS_Group_IsGroupMember, file, "$$");
newXSproto(strcpy(buf, "IsLeader"), XS_Group_IsLeader, file, "$$");
newXSproto(strcpy(buf, "SendHPPacketsFrom"), XS_Group_SendHPPacketsFrom, file, "$$");
newXSproto(strcpy(buf, "SendHPPacketsTo"), XS_Group_SendHPPacketsTo, file, "$$");
newXSproto(strcpy(buf, "SetLeader"), XS_Group_SetLeader, file, "$$");
newXSproto(strcpy(buf, "SplitExp"), XS_Group_SplitExp, file, "$$$");
newXSproto(strcpy(buf, "SplitMoney"), XS_Group_SplitMoney, file, "$$$$$");
newXSproto(strcpy(buf, "TeleportGroup"), XS_Group_TeleportGroup, file, "$$$$$$$");
XSRETURN_YES;
auto package = perl.new_class<Group>("Group");
package.add("CastGroupSpell", &Perl_Group_CastGroupSpell);
package.add("DisbandGroup", &Perl_Group_DisbandGroup);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Group*, std::string, std::string))&Perl_Group_DoesAnyMemberHaveExpeditionLockout);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Group*, std::string, std::string, int))&Perl_Group_DoesAnyMemberHaveExpeditionLockout);
package.add("GetHighestLevel", &Perl_Group_GetHighestLevel);
package.add("GetID", &Perl_Group_GetID);
package.add("GetLeader", &Perl_Group_GetLeader);
package.add("GetLeaderName", &Perl_Group_GetLeaderName);
package.add("GetMember", &Perl_Group_GetMember);
package.add("GetTotalGroupDamage", &Perl_Group_GetTotalGroupDamage);
package.add("GroupCount", &Perl_Group_GroupCount);
package.add("GroupMessage", (void(*)(Group*, Mob*, const char*))&Perl_Group_GroupMessage);
package.add("GroupMessage", (void(*)(Group*, Mob*, uint8_t, const char*))&Perl_Group_GroupMessage);
package.add("IsGroupMember", &Perl_Group_IsGroupMember);
package.add("IsLeader", &Perl_Group_IsLeader);
package.add("SendHPPacketsFrom", &Perl_Group_SendHPPacketsFrom);
package.add("SendHPPacketsTo", &Perl_Group_SendHPPacketsTo);
package.add("SetLeader", &Perl_Group_SetLeader);
package.add("SplitExp", &Perl_Group_SplitExp);
package.add("SplitMoney", &Perl_Group_SplitMoney);
package.add("TeleportGroup", &Perl_Group_TeleportGroup);
}
#endif //EMBPERL_XS_CLASSES

105
zone/perl_hateentry.cpp
View File

@ -4,104 +4,33 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "../common/linked_list.h"
#include "embperl.h"
#include "hate_list.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_HATE \
do { \
if (sv_derived_from(ST(0), "HateEntry")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(struct_HateList*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type HateEntry"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_HateEntry_GetEnt); /* prototype to pass -Wmissing-prototypes */
XS(XS_HateEntry_GetEnt) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: HateEntry::GetEnt(THIS)"); // @categories Script Utility, Hate and Aggro
{
struct_HateList *THIS;
Mob *RETVAL;
VALIDATE_THIS_IS_HATE;
RETVAL = THIS->entity_on_hatelist;
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Mob", (void *) RETVAL);
}
XSRETURN(1);
Mob* Perl_HateEntry_GetEnt(struct_HateList* self) // @categories Script Utility, Hate and Aggro
{
return self->entity_on_hatelist;
}
XS(XS_HateEntry_GetHate); /* prototype to pass -Wmissing-prototypes */
XS(XS_HateEntry_GetHate) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: HateEntry::GetHate(THIS)"); // @categories Script Utility, Hate and Aggro
{
struct_HateList *THIS;
int64 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_HATE;
RETVAL = THIS->stored_hate_amount;
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
int64_t Perl_HateEntry_GetHate(struct_HateList* self) // @categories Script Utility, Hate and Aggro
{
return self->stored_hate_amount;
}
XS(XS_HateEntry_GetDamage); /* prototype to pass -Wmissing-prototypes */
XS(XS_HateEntry_GetDamage) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: HateEntry::GetDamage(THIS)"); // @categories Script Utility, Hate and Aggro
{
struct_HateList *THIS;
int64 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_HATE;
RETVAL = THIS->hatelist_damage;
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
int64_t Perl_HateEntry_GetDamage(struct_HateList* self) // @categories Script Utility, Hate and Aggro
{
return self->hatelist_damage;
}
#ifdef __cplusplus
extern "C"
#endif
void perl_register_hateentry()
{
perl::interpreter perl(PERL_GET_THX);
XS(boot_HateEntry);
XS(boot_HateEntry) {
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, "GetDamage"), XS_HateEntry_GetDamage, file, "$");
newXSproto(strcpy(buf, "GetEnt"), XS_HateEntry_GetEnt, file, "$");
newXSproto(strcpy(buf, "GetHate"), XS_HateEntry_GetHate, file, "$");
XSRETURN_YES;
auto package = perl.new_class<struct_HateList>("HateEntry");
package.add("GetDamage", &Perl_HateEntry_GetDamage);
package.add("GetEnt", &Perl_HateEntry_GetEnt);
package.add("GetHate", &Perl_HateEntry_GetHate);
}
#endif //EMBPERL_XS_CLASSES

617
zone/perl_inventory.cpp
View File

@ -4,525 +4,204 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "../common/inventory_profile.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "../common/inventory_profile.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_INVENTORY \
do { \
if (sv_derived_from(ST(0), "Inventory")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(EQ::InventoryProfile*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type EQ::InventoryProfile"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Inventory_CanItemFitInContainer);
XS(XS_Inventory_CanItemFitInContainer) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::CanItemFitInContainer(THIS, ItemInstance item_to_check, ItemInstance container_to_check)");
{
EQ::InventoryProfile* THIS;
bool can_fit = false;
EQ::ItemInstance* item_to_check = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
EQ::ItemInstance* container_to_check = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(2)));
const EQ::ItemData* item_data = item_to_check->GetItem();
const EQ::ItemData* container_data = container_to_check->GetItem();
VALIDATE_THIS_IS_INVENTORY;
can_fit = THIS->CanItemFitInContainer(item_data, container_data);
ST(0) = boolSV(can_fit);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_CanItemFitInContainer(EQ::InventoryProfile* self, EQ::ItemInstance* item_to_check, EQ::ItemInstance* container_to_check)
{
const EQ::ItemData* item_data = item_to_check->GetItem();
const EQ::ItemData* container_data = container_to_check->GetItem();
return self->CanItemFitInContainer(item_data, container_data);
}
XS(XS_Inventory_CheckNoDrop);
XS(XS_Inventory_CheckNoDrop) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::CheckNoDrop(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
bool no_drop = false;
int16 slot_id = (int16)SvIV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
no_drop = THIS->CheckNoDrop(slot_id);
ST(0) = boolSV(no_drop);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_CheckNoDrop(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CheckNoDrop(slot_id);
}
XS(XS_Inventory_DeleteItem);
XS(XS_Inventory_DeleteItem) {
dXSARGS;
if (items < 2 || items > 3)
Perl_croak(aTHX_ "Usage: Inventory::DeleteItem(THIS, int16 slot_id, [uint8 quantity = 0])");
{
EQ::InventoryProfile* THIS;
bool item_deleted = false;
int16 slot_id = (int16)SvIV(ST(1));
uint8 quantity = 0;
VALIDATE_THIS_IS_INVENTORY;
if (items > 2)
quantity = (uint8)SvUV(ST(2));
item_deleted = THIS->DeleteItem(slot_id, quantity);
ST(0) = boolSV(item_deleted);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_DeleteItem(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->DeleteItem(slot_id);
}
XS(XS_Inventory_FindFreeSlot);
XS(XS_Inventory_FindFreeSlot) {
dXSARGS;
if (items < 3 || items > 5)
Perl_croak(aTHX_ "Usage: Inventory::FindFreeSlot(THIS, bool is_for_bag, bool try_cursor, [uint8 min_size = 0, bool is_arrow = false])");
{
EQ::InventoryProfile* THIS;
int16 free_slot;
bool is_for_bag = (bool)SvNV(ST(1));
bool try_cursor = (bool)SvNV(ST(2));
uint8 min_size = 0;
bool is_arrow = false;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 3)
min_size = (uint8)SvUV(ST(3));
if (items > 4)
is_arrow = (bool)SvNV(ST(4));
free_slot = THIS->FindFreeSlot(is_for_bag, try_cursor, min_size, is_arrow);
XSprePUSH;
PUSHi((IV)free_slot);
}
XSRETURN(1);
bool Perl_Inventory_DeleteItem(EQ::InventoryProfile* self, int16_t slot_id, uint8_t quantity)
{
return self->DeleteItem(slot_id, quantity);
}
XS(XS_Inventory_GetBagIndex);
XS(XS_Inventory_GetBagIndex) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetBagIndex(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
uint8 bag_index;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
bag_index = THIS->CalcBagIdx(slot_id);
XSprePUSH;
PUSHu((UV) bag_index);
}
XSRETURN(1);
int Perl_Inventory_FindFreeSlot(EQ::InventoryProfile* self, bool is_for_bag, bool try_cursor)
{
return self->FindFreeSlot(is_for_bag, try_cursor);
}
XS(XS_Inventory_GetItem);
XS(XS_Inventory_GetItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetItem(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
EQ::ItemInstance* item;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
item = THIS->GetItem(slot_id);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "QuestItem", (void*)item);
}
XSRETURN(1);
int Perl_Inventory_FindFreeSlot(EQ::InventoryProfile* self, bool is_for_bag, bool try_cursor, uint8_t min_size)
{
return self->FindFreeSlot(is_for_bag, try_cursor, min_size);
}
XS(XS_Inventory_GetMaterialFromSlot);
XS(XS_Inventory_GetMaterialFromSlot) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetMaterialFromSlot(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
uint8 material;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
material = THIS->CalcMaterialFromSlot(slot_id);
XSprePUSH;
PUSHu((UV) material);
}
XSRETURN(1);
int Perl_Inventory_FindFreeSlot(EQ::InventoryProfile* self, bool is_for_bag, bool try_cursor, uint8_t min_size, bool is_arrow)
{
return self->FindFreeSlot(is_for_bag, try_cursor, min_size, is_arrow);
}
XS(XS_Inventory_GetSlotByItemInst);
XS(XS_Inventory_GetSlotByItemInst) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetSlotByItemInst(THIS, ItemInstance item)");
{
EQ::InventoryProfile* THIS;
int slot_id;
EQ::ItemInstance* item = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
slot_id = THIS->GetSlotByItemInst(item);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetBagIndex(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CalcBagIdx(slot_id);
}
XS(XS_Inventory_GetSlotFromMaterial);
XS(XS_Inventory_GetSlotFromMaterial) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::GetSlotFromMaterial(THIS, uint8 material)");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint8 material = (uint8)SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
slot_id = THIS->CalcSlotFromMaterial(material);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
EQ::ItemInstance* Perl_Inventory_GetItem(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->GetItem(slot_id);
}
XS(XS_Inventory_GetSlotID);
XS(XS_Inventory_GetSlotID) {
dXSARGS;
if (items < 2 || items > 3)
Perl_croak(aTHX_ "Usage: Inventory::GetSlotID(THIS, int16 slot_id, [uint8 bag_index])");
{
EQ::InventoryProfile* THIS;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items == 2)
slot_id = THIS->CalcSlotId(slot_id);
if (items == 3) {
uint8 bag_index = (uint8)SvUV(ST(2));
slot_id = THIS->CalcSlotId(slot_id, bag_index);
}
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetMaterialFromSlot(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CalcMaterialFromSlot(slot_id);
}
XS(XS_Inventory_HasItem);
XS(XS_Inventory_HasItem) {
dXSARGS;
if (items < 2 || items > 4)
Perl_croak(aTHX_ "Usage: Inventory::HasItem(THIS, uint32 item_id, [uint8 quantity, uint8 where])");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint32 item_id = (uint32)SvUV(ST(1));
uint8 quantity = 0;
uint8 where_to_look = 0xFF;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 2)
quantity = (uint8)SvUV(ST(2));
if (items > 3)
where_to_look = (uint8)SvUV(ST(3));
slot_id = THIS->HasItem(item_id, quantity, where_to_look);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetSlotByItemInst(EQ::InventoryProfile* self, EQ::ItemInstance* item)
{
return self->GetSlotByItemInst(item);
}
XS(XS_Inventory_HasItemByLoreGroup);
XS(XS_Inventory_HasItemByLoreGroup) {
dXSARGS;
if (items < 2 || items > 3)
Perl_croak(aTHX_ "Usage: Inventory::HasItemByLoreGroup(THIS, uint32 loregroup, [uint8 where])");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint32 loregroup = (uint32)SvUV(ST(1));
uint8 where_to_look = 0xFF;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 2)
where_to_look = (uint8)SvUV(ST(2));
slot_id = THIS->HasItemByLoreGroup(loregroup, where_to_look);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetSlotFromMaterial(EQ::InventoryProfile* self, uint8_t material)
{
return self->CalcSlotFromMaterial(material);
}
XS(XS_Inventory_HasItemByUse);
XS(XS_Inventory_HasItemByUse) {
dXSARGS;
if (items < 3 || items > 4)
Perl_croak(aTHX_ "Usage: Inventory::HasItemByUse(THIS, uint8 use, uint8 quantity, [uint8 where])");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
uint8 item_use = (uint8)SvUV(ST(1));
uint8 quantity = (uint8)SvUV(ST(2));
uint8 where_to_look = 0xFF;
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (items > 3)
where_to_look = (uint8)SvUV(ST(3));
slot_id = THIS->HasItemByUse(item_use, quantity, where_to_look);
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_GetSlotID(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->CalcSlotId(slot_id);
}
XS(XS_Inventory_HasSpaceForItem);
XS(XS_Inventory_HasSpaceForItem) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::HasSpaceForItem(THIS, ItemInstance item_to_check, uint8 quantity)");
{
EQ::InventoryProfile* THIS;
bool has_space = false;
EQ::ItemInstance* item_to_check = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
uint8 quantity = (uint8)SvUV(ST(2));
const EQ::ItemData* item_data = item_to_check->GetItem();
VALIDATE_THIS_IS_INVENTORY;
has_space = THIS->HasSpaceForItem(item_data, quantity);
ST(0) = boolSV(has_space);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_GetSlotID(EQ::InventoryProfile* self, int16_t slot_id, uint8_t bag_index)
{
return self->CalcSlotId(slot_id, bag_index);
}
XS(XS_Inventory_PopItem);
XS(XS_Inventory_PopItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::PopItem(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
EQ::ItemInstance* item;
int16 slot_id = (int16)SvIV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
item = THIS->PopItem(slot_id);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "QuestItem", (void*)item);
}
XSRETURN(1);
int Perl_Inventory_HasItem(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->HasItem(item_id);
}
XS(XS_Inventory_SupportsContainers);
XS(XS_Inventory_SupportsContainers) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::SupportsContainers(THIS, int16 slot_id)");
{
EQ::InventoryProfile* THIS;
bool supports_containers = false;
int16 slot_id = (int16)SvIV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
supports_containers = THIS->SupportsContainers(slot_id);
ST(0) = boolSV(supports_containers);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_HasItem(EQ::InventoryProfile* self, uint32_t item_id, uint8_t quantity)
{
return self->HasItem(item_id, quantity);
}
XS(XS_Inventory_SwapItem);
XS(XS_Inventory_SwapItem) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::SwapItem(THIS, int16 source_slot_id, int16 destination_slot_id)");
{
EQ::InventoryProfile* THIS;
bool item_swapped = false;
int16 source_slot_id = (int16)SvIV(ST(1));
int16 destination_slot_id = (int16)SvIV(ST(2));
EQ::InventoryProfile::SwapItemFailState fail_state = EQ::InventoryProfile::swapInvalid;
VALIDATE_THIS_IS_INVENTORY;
item_swapped = THIS->SwapItem(source_slot_id, destination_slot_id, fail_state);
ST(0) = boolSV(item_swapped);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_HasItem(EQ::InventoryProfile* self, uint32_t item_id, uint8_t quantity, uint8_t where_to_look)
{
return self->HasItem(item_id, quantity, where_to_look);
}
XS(XS_Inventory_PushCursor);
XS(XS_Inventory_PushCursor) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::PushCursor(THIS, ItemInstance item)");
{
EQ::InventoryProfile* THIS;
int16 slot_id;
EQ::ItemInstance* item = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(1)));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (item)
slot_id = THIS->PushCursor(*item);
else
slot_id = 0;
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_HasItemByLoreGroup(EQ::InventoryProfile* self, uint32_t loregroup)
{
return self->HasItemByLoreGroup(loregroup);
}
XS(XS_Inventory_PutItem);
XS(XS_Inventory_PutItem) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Inventory::PutItem(THIS, int16 slot_id, ItemInstance item)");
{
EQ::InventoryProfile* THIS;
int16 slot_id = (int16)SvUV(ST(1));
EQ::ItemInstance* item = (EQ::ItemInstance*)SvIV((SV*)SvRV(ST(2)));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
if (item)
slot_id = THIS->PutItem(slot_id, *item);
else
slot_id = 0;
XSprePUSH;
PUSHi((IV) slot_id);
}
XSRETURN(1);
int Perl_Inventory_HasItemByLoreGroup(EQ::InventoryProfile* self, uint32_t loregroup, uint8_t where_to_look)
{
return self->HasItemByLoreGroup(loregroup, where_to_look);
}
XS(XS_Inventory_HasAugmentEquippedByID);
XS(XS_Inventory_HasAugmentEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::HasAugmentEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
bool has_equipped = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
has_equipped = THIS->HasAugmentEquippedByID(item_id);
ST(0) = boolSV(has_equipped);
sv_2mortal(ST(0));
}
XSRETURN(1);
int Perl_Inventory_HasItemByUse(EQ::InventoryProfile* self, uint8_t item_use, uint8_t quantity)
{
return self->HasItemByUse(item_use, quantity);
}
XS(XS_Inventory_CountAugmentEquippedByID);
XS(XS_Inventory_CountAugmentEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::CountAugmentEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
int quantity = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
quantity = THIS->CountAugmentEquippedByID(item_id);
XSprePUSH;
PUSHi((IV) quantity);
}
XSRETURN(1);
int Perl_Inventory_HasItemByUse(EQ::InventoryProfile* self, uint8_t item_use, uint8_t quantity, uint8_t where_to_look)
{
return self->HasItemByUse(item_use, quantity, where_to_look);
}
XS(XS_Inventory_HasItemEquippedByID);
XS(XS_Inventory_HasItemEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::HasItemEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
bool has_equipped = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_INVENTORY;
has_equipped = THIS->HasItemEquippedByID(item_id);
ST(0) = boolSV(has_equipped);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Inventory_HasSpaceForItem(EQ::InventoryProfile* self, EQ::ItemInstance* item_to_check, uint8_t quantity)
{
const EQ::ItemData* item_data = item_to_check->GetItem();
return self->HasSpaceForItem(item_data, quantity);
}
XS(XS_Inventory_CountItemEquippedByID);
XS(XS_Inventory_CountItemEquippedByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Inventory::CountItemEquippedByID(THIS, uint32 item_id)");
{
EQ::InventoryProfile* THIS;
int quantity = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_INVENTORY;
quantity = THIS->CountItemEquippedByID(item_id);
XSprePUSH;
PUSHi((IV) quantity);
}
XSRETURN(1);
EQ::ItemInstance* Perl_Inventory_PopItem(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->PopItem(slot_id);
}
#ifdef __cplusplus
extern "C"
#endif
bool Perl_Inventory_SupportsContainers(EQ::InventoryProfile* self, int16_t slot_id)
{
return self->SupportsContainers(slot_id);
}
XS(boot_Inventory);
XS(boot_Inventory) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
if (items != 1)
fprintf(stderr, "boot_quest does not take any arguments.");
bool Perl_Inventory_SwapItem(EQ::InventoryProfile* self, int16_t source_slot_id, int16_t destination_slot_id)
{
EQ::InventoryProfile::SwapItemFailState fail_state = EQ::InventoryProfile::swapInvalid;
return self->SwapItem(source_slot_id, destination_slot_id, fail_state);
}
char buf[128];
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "CanItemFitInContainer"), XS_Inventory_CanItemFitInContainer, file, "$$$");
newXSproto(strcpy(buf, "CountAugmentEquippedByID"), XS_Inventory_CountAugmentEquippedByID, file, "$$");
newXSproto(strcpy(buf, "CountItemEquippedByID"), XS_Inventory_CountItemEquippedByID, file, "$$");
newXSproto(strcpy(buf, "CheckNoDrop"), XS_Inventory_CheckNoDrop, file, "$$");
newXSproto(strcpy(buf, "DeleteItem"), XS_Inventory_DeleteItem, file, "$$;$");
newXSproto(strcpy(buf, "FindFreeSlot"), XS_Inventory_FindFreeSlot, file, "$$$;$$");
newXSproto(strcpy(buf, "GetBagIndex"), XS_Inventory_GetBagIndex, file, "$$");
newXSproto(strcpy(buf, "GetItem"), XS_Inventory_GetItem, file, "$$;$");
newXSproto(strcpy(buf, "GetMaterialFromSlot"), XS_Inventory_GetMaterialFromSlot, file, "$$");
newXSproto(strcpy(buf, "GetSlotByItemInst"), XS_Inventory_GetSlotByItemInst, file, "$$");
newXSproto(strcpy(buf, "GetSlotFromMaterial"), XS_Inventory_GetSlotFromMaterial, file, "$$");
newXSproto(strcpy(buf, "GetSlotID"), XS_Inventory_GetSlotID, file, "$$;$");
newXSproto(strcpy(buf, "HasAugmentEquippedByID"), XS_Inventory_HasAugmentEquippedByID, file, "$$");
newXSproto(strcpy(buf, "HasItem"), XS_Inventory_HasItem, file, "$$;$$");
newXSproto(strcpy(buf, "HasItemByLoreGroup"), XS_Inventory_HasItemByLoreGroup, file, "$$;$");
newXSproto(strcpy(buf, "HasItemByUse"), XS_Inventory_HasItemByUse, file, "$$;$$");
newXSproto(strcpy(buf, "HasItemEquippedByID"), XS_Inventory_HasItemEquippedByID, file, "$$");
newXSproto(strcpy(buf, "HasSpaceForItem"), XS_Inventory_HasSpaceForItem, file, "$$$");
newXSproto(strcpy(buf, "PopItem"), XS_Inventory_PopItem, file, "$$");
newXSproto(strcpy(buf, "PushCursor"), XS_Inventory_PushCursor, file, "$$");
newXSproto(strcpy(buf, "PutItem"), XS_Inventory_PutItem, file, "$$$");
newXSproto(strcpy(buf, "SupportsContainers"), XS_Inventory_SupportsContainers, file, "$$");
newXSproto(strcpy(buf, "SwapItem"), XS_Inventory_SwapItem, file, "$$$");
XSRETURN_YES;
int Perl_Inventory_PushCursor(EQ::InventoryProfile* self, EQ::ItemInstance* item)
{
return self->PushCursor(*item);
}
int Perl_Inventory_PutItem(EQ::InventoryProfile* self, int16_t slot_id, EQ::ItemInstance* item)
{
return self->PutItem(slot_id, *item);
}
bool Perl_Inventory_HasAugmentEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->HasAugmentEquippedByID(item_id);
}
int Perl_Inventory_CountAugmentEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->CountAugmentEquippedByID(item_id);
}
bool Perl_Inventory_HasItemEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->HasItemEquippedByID(item_id);
}
int Perl_Inventory_CountItemEquippedByID(EQ::InventoryProfile* self, uint32_t item_id)
{
return self->CountItemEquippedByID(item_id);
}
void perl_register_inventory()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<EQ::InventoryProfile>("Inventory");
package.add("CanItemFitInContainer", &Perl_Inventory_CanItemFitInContainer);
package.add("CountAugmentEquippedByID", &Perl_Inventory_CountAugmentEquippedByID);
package.add("CountItemEquippedByID", &Perl_Inventory_CountItemEquippedByID);
package.add("CheckNoDrop", &Perl_Inventory_CheckNoDrop);
package.add("DeleteItem", (bool(*)(EQ::InventoryProfile*, int16_t))&Perl_Inventory_DeleteItem);
package.add("DeleteItem", (bool(*)(EQ::InventoryProfile*, int16_t, uint8_t))&Perl_Inventory_DeleteItem);
package.add("FindFreeSlot", (int(*)(EQ::InventoryProfile*, bool, bool))&Perl_Inventory_FindFreeSlot);
package.add("FindFreeSlot", (int(*)(EQ::InventoryProfile*, bool, bool, uint8_t))&Perl_Inventory_FindFreeSlot);
package.add("FindFreeSlot", (int(*)(EQ::InventoryProfile*, bool, bool, uint8_t, bool))&Perl_Inventory_FindFreeSlot);
package.add("GetBagIndex", &Perl_Inventory_GetBagIndex);
package.add("GetItem", &Perl_Inventory_GetItem);
package.add("GetMaterialFromSlot", &Perl_Inventory_GetMaterialFromSlot);
package.add("GetSlotByItemInst", &Perl_Inventory_GetSlotByItemInst);
package.add("GetSlotFromMaterial", &Perl_Inventory_GetSlotFromMaterial);
package.add("GetSlotID", (int(*)(EQ::InventoryProfile*, int16_t))&Perl_Inventory_GetSlotID);
package.add("GetSlotID", (int(*)(EQ::InventoryProfile*, int16_t, uint8_t))&Perl_Inventory_GetSlotID);
package.add("HasAugmentEquippedByID", &Perl_Inventory_HasAugmentEquippedByID);
package.add("HasItem", (int(*)(EQ::InventoryProfile*, uint32_t))&Perl_Inventory_HasItem);
package.add("HasItem", (int(*)(EQ::InventoryProfile*, uint32_t, uint8_t))&Perl_Inventory_HasItem);
package.add("HasItem", (int(*)(EQ::InventoryProfile*, uint32_t, uint8_t, uint8_t))&Perl_Inventory_HasItem);
package.add("HasItemByLoreGroup", (int(*)(EQ::InventoryProfile*, uint32_t))&Perl_Inventory_HasItemByLoreGroup);
package.add("HasItemByLoreGroup", (int(*)(EQ::InventoryProfile*, uint32_t, uint8_t))&Perl_Inventory_HasItemByLoreGroup);
package.add("HasItemByUse", (int(*)(EQ::InventoryProfile*, uint8_t, uint8_t))&Perl_Inventory_HasItemByUse);
package.add("HasItemByUse", (int(*)(EQ::InventoryProfile*, uint8_t, uint8_t, uint8_t))&Perl_Inventory_HasItemByUse);
package.add("HasItemEquippedByID", &Perl_Inventory_HasItemEquippedByID);
package.add("HasSpaceForItem", &Perl_Inventory_HasSpaceForItem);
package.add("PopItem", &Perl_Inventory_PopItem);
package.add("PushCursor", &Perl_Inventory_PushCursor);
package.add("PutItem", &Perl_Inventory_PutItem);
package.add("SupportsContainers", &Perl_Inventory_SupportsContainers);
package.add("SwapItem", &Perl_Inventory_SwapItem);
}
#endif //EMBPERL_XS_CLASSES

9951
zone/perl_mob.cpp
View File

File diff suppressed because it is too large Load Diff

2372
zone/perl_npc.cpp
View File

File diff suppressed because it is too large Load Diff

854
zone/perl_object.cpp
View File

@ -4,756 +4,272 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "object.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_OBJECT \
do { \
if (sv_derived_from(ST(0), "Object")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Object*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Object"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Object_IsGroundSpawn); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_IsGroundSpawn) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::IsGroundSpawn(THIS)"); // @categories Objects
{
Object *THIS;
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->IsGroundSpawn();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Object_IsGroundSpawn(Object* self) // @categories Objects
{
return self->IsGroundSpawn();
}
XS(XS_Object_Close); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Close) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Close(THIS)"); // @categories Objects
{
Object *THIS;
VALIDATE_THIS_IS_OBJECT;
THIS->Close();
}
XSRETURN_EMPTY;
void Perl_Object_Close(Object* self) // @categories Objects
{
self->Close();
}
XS(XS_Object_Delete); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Delete) {
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: Object::Delete(THIS, [bool reset_state = false])"); // @categories Objects
{
Object *THIS;
bool reset_state;
VALIDATE_THIS_IS_OBJECT;
if (items < 2)
reset_state = false;
else {
reset_state = (bool) SvTRUE(ST(1));
}
THIS->Delete(reset_state);
}
XSRETURN_EMPTY;
}
XS(XS_Object_StartDecay); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_StartDecay) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::StartDecay(THIS)"); // @categories Objects
{
Object *THIS;
VALIDATE_THIS_IS_OBJECT;
THIS->StartDecay();
}
XSRETURN_EMPTY;
void Perl_Object_Delete(Object* self) // @categories Objects
{
self->Delete();
}
XS(XS_Object_DeleteItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_DeleteItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::DeleteItem(THIS, uint8 index)"); // @categories Objects
{
Object *THIS;
uint8 index = (uint8) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->DeleteItem(index);
}
XSRETURN_EMPTY;
void Perl_Object_Delete(Object* self, bool reset_state) // @categories Objects
{
self->Delete(reset_state);
}
XS(XS_Object_IsObject); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_IsObject) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::IsObject(THIS)"); // @categories Objects
{
Object *THIS;
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->IsObject();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Object_StartDecay(Object* self) // @categories Objects
{
self->StartDecay();
}
XS(XS_Object_Save); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Save) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Save(THIS)"); // @categories Objects
{
Object *THIS;
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->Save();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Object_DeleteItem(Object* self, uint8_t index) // @categories Objects
{
self->DeleteItem(index);
}
XS(XS_Object_SetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetID(THIS, uint16 id)"); // @categories Objects
{
Object *THIS;
uint16 set_id = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetID(set_id);
}
XSRETURN_EMPTY;
bool Perl_Object_IsObject(Object* self) // @categories Objects
{
return self->IsObject();
}
XS(XS_Object_ClearUser); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_ClearUser) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::ClearUser(THIS)"); // @categories Objects
{
Object *THIS;
VALIDATE_THIS_IS_OBJECT;
THIS->ClearUser();
}
XSRETURN_EMPTY;
bool Perl_Object_Save(Object* self) // @categories Objects
{
return self->Save();
}
XS(XS_Object_GetDBID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetDBID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetDBID(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetDBID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetID(Object* self, uint16_t set_id) // @categories Objects
{
self->SetID(set_id);
}
XS(XS_Object_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetID(THIS)"); // @categories Objects
{
Object *THIS;
uint16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Object_ClearUser(Object* self) // @categories Objects
{
self->ClearUser();
}
XS(XS_Object_GetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetX) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetX(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetX();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetDBID(Object* self) // @categories Objects
{
return self->GetDBID();
}
XS(XS_Object_GetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetY) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetY(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetY();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetID(Object* self) // @categories Objects
{
return self->GetID();
}
XS(XS_Object_GetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetZ) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetZ(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetZ();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetX(Object* self) // @categories Objects
{
return self->GetX();
}
XS(XS_Object_GetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetHeading) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetHeading(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetHeadingData();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetY(Object* self) // @categories Objects
{
return self->GetY();
}
XS(XS_Object_VarSave); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_VarSave) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::VarSave(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->VarSave();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetZ(Object* self) // @categories Objects
{
return self->GetZ();
}
XS(XS_Object_GetType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetType) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetType(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetType();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
float Perl_Object_GetHeading(Object* self) // @categories Objects
{
return self->GetHeadingData();
}
XS(XS_Object_SetType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetType(THIS, uint32 type)"); // @categories Objects
{
Object *THIS;
uint32 type = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetType(type);
}
XSRETURN_EMPTY;
uint32_t Perl_Object_VarSave(Object* self) // @categories Objects
{
return self->VarSave();
}
XS(XS_Object_GetIcon); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetIcon) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetIcon(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetIcon();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetType(Object* self) // @categories Objects
{
return self->GetType();
}
XS(XS_Object_SetIcon); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetIcon) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetIcon(THIS, uint32 icon)"); // @categories Objects
{
Object *THIS;
uint32 icon = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetIcon(icon);
}
XSRETURN_EMPTY;
void Perl_Object_SetType(Object* self, uint32_t type) // @categories Objects
{
self->SetType(type);
}
XS(XS_Object_GetItemID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetItemID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetItemID(THIS)"); // @categories Objects
{
Object *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetItemID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Object_GetIcon(Object* self) // @categories Objects
{
return self->GetIcon();
}
XS(XS_Object_SetItemID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetItemID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetItemID(THIS, uint32 item_id)"); // @categories Objects
{
Object *THIS;
uint32 itemid = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetItemID(itemid);
}
XSRETURN_EMPTY;
void Perl_Object_SetIcon(Object* self, uint32_t icon) // @categories Objects
{
self->SetIcon(icon);
}
XS(XS_Object_SetLocation); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetLocation) {
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: Object::SetLocation(THIS, float x, float y, float z)"); // @categories Objects
{
Object *THIS;
float x = (float) SvNV(ST(1));
float y = (float) SvNV(ST(2));
float z = (float) SvNV(ST(3));
VALIDATE_THIS_IS_OBJECT;
THIS->SetLocation(x, y, z);
}
XSRETURN_EMPTY;
uint32_t Perl_Object_GetItemID(Object* self) // @categories Objects
{
return self->GetItemID();
}
XS(XS_Object_SetX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetX) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetX(THIS, float x)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetX(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetItemID(Object* self, uint32_t itemid) // @categories Objects
{
self->SetItemID(itemid);
}
XS(XS_Object_SetY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetY) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetY(THIS, float y)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetY(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetLocation(Object* self, float x, float y, float z) // @categories Objects
{
self->SetLocation(x, y, z);
}
XS(XS_Object_SetZ); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetZ) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetZ(THIS, float z)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetZ(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetX(Object* self, float x) // @categories Objects
{
self->SetX(x);
}
XS(XS_Object_SetHeading); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetHeading) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetHeading(THIS, float heading)"); // @categories Objects
{
Object *THIS;
float heading = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetHeading(heading);
}
XSRETURN_EMPTY;
void Perl_Object_SetY(Object* self, float y) // @categories Objects
{
self->SetY(y);
}
XS(XS_Object_SetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetModelName) {
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: Object::SetModelName(THIS, string name)"); // @categories Objects
{
Object *THIS;
char *name = nullptr;
VALIDATE_THIS_IS_OBJECT;
if (items > 1) { name = (char *) SvPV_nolen(ST(1)); }
THIS->SetModelName(name);
}
XSRETURN_EMPTY;
}
XS(XS_Object_GetModelName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetModelName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetModelName(THIS)"); // @categories Objects
{
Object *THIS;
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetModelName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
void Perl_Object_SetZ(Object* self, float z) // @categories Objects
{
self->SetZ(z);
}
XS(XS_Object_Repop); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Repop) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Repop(THIS)"); // @categories Objects
{
Object *THIS;
dXSTARG;
VALIDATE_THIS_IS_OBJECT; THIS->Repop();
}
XSRETURN_EMPTY;
void Perl_Object_SetHeading(Object* self, float heading) // @categories Objects
{
self->SetHeading(heading);
}
XS(XS_Object_Depop); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_Depop) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::Depop(THIS)"); // @categories Objects
{
Object *THIS;
dXSTARG;
VALIDATE_THIS_IS_OBJECT; THIS->Depop();
}
XSRETURN_EMPTY;
void Perl_Object_SetModelName(Object* self, const char* name) // @categories Objects
{
self->SetModelName(name);
}
XS(XS_Object_GetEntityVariable); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetEntityVariable) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::GetEntityVariable(THIS, string key)"); // @categories Objects
{
Object *THIS;
Const_char *id = SvPV_nolen(ST(1));
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetEntityVariable(id);
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
std::string Perl_Object_GetModelName(Object* self) // @categories Objects
{
return self->GetModelName();
}
XS(XS_Object_EntityVariableExists); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_EntityVariableExists) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::EntityVariableExists(THIS, string key)"); // @categories Objects
{
Object *THIS;
Const_char *id = SvPV_nolen(ST(1));
bool RETVAL;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->EntityVariableExists(id);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Object_Repop(Object* self) // @categories Objects
{
self->Repop();
}
XS(XS_Object_SetEntityVariable); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetEntityVariable) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Object::SetEntityVariable(THIS, string key, string var)"); // @categories Objects
{
Object *THIS;
Const_char *id = SvPV_nolen(ST(1));
const char *var = (const char *) SvPV_nolen(ST(2));
VALIDATE_THIS_IS_OBJECT;
THIS->SetEntityVariable(id, var);
}
XSRETURN_EMPTY;
void Perl_Object_Depop(Object* self) // @categories Objects
{
self->Depop();
}
XS(XS_Object_GetSolidType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetSolidType) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetSolidType(THIS)"); // @categories Objects
{
Object *THIS;
uint16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetSolidType();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
const char* Perl_Object_GetEntityVariable(Object* self, const char* key) // @categories Objects
{
// supports possible nullptr return
return self->GetEntityVariable(key);
}
XS(XS_Object_SetSolidType); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetSolidType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetSolidType(THIS, uint16 type)"); // @categories Objects
{
Object *THIS;
uint16 type = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetSolidType(type);
}
XSRETURN_EMPTY;
bool Perl_Object_EntityVariableExists(Object* self, const char* key) // @categories Objects
{
return self->EntityVariableExists(key);
}
XS(XS_Object_GetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetSize) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetSize(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetSize();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetEntityVariable(Object* self, const char* key, const char* var) // @categories Objects
{
self->SetEntityVariable(key, var);
}
XS(XS_Object_SetSize); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetSize) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetSize(THIS, float size)"); // @categories Objects
{
Object *THIS;
float size = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetSize(size);
}
XSRETURN_EMPTY;
uint32_t Perl_Object_GetSolidType(Object* self) // @categories Objects
{
return self->GetSolidType();
}
XS(XS_Object_SetTiltX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetTiltX) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetTiltX(THIS, float tilt_x)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetTiltX(pos);
}
XSRETURN_EMPTY;
void Perl_Object_SetSolidType(Object* self, uint16_t type) // @categories Objects
{
self->SetSolidType(type);
}
XS(XS_Object_SetTiltY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_SetTiltY) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Object::SetTiltY(THIS, float tilt_y)"); // @categories Objects
{
Object *THIS;
float pos = (float) SvNV(ST(1));
VALIDATE_THIS_IS_OBJECT;
THIS->SetTiltY(pos);
}
XSRETURN_EMPTY;
float Perl_Object_GetSize(Object* self) // @categories Objects
{
return self->GetSize();
}
XS(XS_Object_GetTiltX); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetTiltX) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetTiltX(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetTiltX();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetSize(Object* self, float size) // @categories Objects
{
self->SetSize(size);
}
XS(XS_Object_GetTiltY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Object_GetTiltY) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Object::GetTiltY(THIS)"); // @categories Objects
{
Object *THIS;
float RETVAL;
dXSTARG;
VALIDATE_THIS_IS_OBJECT;
RETVAL = THIS->GetTiltY();
XSprePUSH;
PUSHn((double) RETVAL);
}
XSRETURN(1);
void Perl_Object_SetTiltX(Object* self, float tilt_x) // @categories Objects
{
self->SetTiltX(tilt_x);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Object); /* prototype to pass -Wmissing-prototypes */
XS(boot_Object) {
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, "ClearUser"), XS_Object_ClearUser, file, "$");
newXSproto(strcpy(buf, "Close"), XS_Object_Close, file, "$");
newXSproto(strcpy(buf, "Delete"), XS_Object_Delete, file, "$$");
newXSproto(strcpy(buf, "DeleteItem"), XS_Object_DeleteItem, file, "$$");
newXSproto(strcpy(buf, "Depop"), XS_Object_Depop, file, "$");
newXSproto(strcpy(buf, "EntityVariableExists"), XS_Object_EntityVariableExists, file, "$$");
newXSproto(strcpy(buf, "GetDBID"), XS_Object_GetDBID, file, "$");
newXSproto(strcpy(buf, "GetEntityVariable"), XS_Object_GetEntityVariable, file, "$$");
newXSproto(strcpy(buf, "GetHeading"), XS_Object_GetHeading, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Object_GetID, file, "$");
newXSproto(strcpy(buf, "GetIcon"), XS_Object_GetIcon, file, "$");
newXSproto(strcpy(buf, "GetItemID"), XS_Object_GetItemID, file, "$");
newXSproto(strcpy(buf, "GetModelName"), XS_Object_GetModelName, file, "$");
newXSproto(strcpy(buf, "GetSize"), XS_Object_GetSize, file, "$");
newXSproto(strcpy(buf, "GetSolidType"), XS_Object_GetSolidType, file, "$");
newXSproto(strcpy(buf, "GetTiltX"), XS_Object_GetTiltX, file, "$$");
newXSproto(strcpy(buf, "GetTiltY"), XS_Object_GetTiltY, file, "$");
newXSproto(strcpy(buf, "GetType"), XS_Object_GetType, file, "$");
newXSproto(strcpy(buf, "GetX"), XS_Object_GetX, file, "$");
newXSproto(strcpy(buf, "GetY"), XS_Object_GetY, file, "$");
newXSproto(strcpy(buf, "GetZ"), XS_Object_GetZ, file, "$");
newXSproto(strcpy(buf, "IsGroundSpawn"), XS_Object_IsGroundSpawn, file, "$");
newXSproto(strcpy(buf, "Repop"), XS_Object_Repop, file, "$");
newXSproto(strcpy(buf, "Save"), XS_Object_Save, file, "$");
newXSproto(strcpy(buf, "SetEntityVariable"), XS_Object_SetEntityVariable, file, "$$$");
newXSproto(strcpy(buf, "SetHeading"), XS_Object_SetHeading, file, "$$");
newXSproto(strcpy(buf, "SetID"), XS_Object_SetID, file, "$$");
newXSproto(strcpy(buf, "SetIcon"), XS_Object_SetIcon, file, "$$");
newXSproto(strcpy(buf, "SetItemID"), XS_Object_SetItemID, file, "$$");
newXSproto(strcpy(buf, "SetLocation"), XS_Object_SetLocation, file, "$$$$");
newXSproto(strcpy(buf, "SetModelName"), XS_Object_SetModelName, file, "$$");
newXSproto(strcpy(buf, "SetSize"), XS_Object_SetSize, file, "$$");
newXSproto(strcpy(buf, "SetSolidType"), XS_Object_SetSolidType, file, "$$");
newXSproto(strcpy(buf, "SetTiltX"), XS_Object_SetTiltX, file, "$$");
newXSproto(strcpy(buf, "SetTiltY"), XS_Object_SetTiltY, file, "$");
newXSproto(strcpy(buf, "SetType"), XS_Object_SetType, file, "$$");
newXSproto(strcpy(buf, "SetX"), XS_Object_SetX, file, "$$");
newXSproto(strcpy(buf, "SetY"), XS_Object_SetY, file, "$$");
newXSproto(strcpy(buf, "SetZ"), XS_Object_SetZ, file, "$$");
newXSproto(strcpy(buf, "StartDecay"), XS_Object_StartDecay, file, "$$");
newXSproto(strcpy(buf, "VarSave"), XS_Object_VarSave, file, "$");
XSRETURN_YES;
void Perl_Object_SetTiltY(Object* self, float tilt_y) // @categories Objects
{
self->SetTiltY(tilt_y);
}
float Perl_Object_GetTiltX(Object* self) // @categories Objects
{
return self->GetTiltX();
}
float Perl_Object_GetTiltY(Object* self) // @categories Objects
{
return self->GetTiltY();
}
void perl_register_object()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<Object>("Object");
package.add_base_class("Entity");
package.add("ClearUser", &Perl_Object_ClearUser);
package.add("Close", &Perl_Object_Close);
package.add("Delete", (void(*)(Object*))&Perl_Object_Delete);
package.add("Delete", (void(*)(Object*, bool))&Perl_Object_Delete);
package.add("DeleteItem", &Perl_Object_DeleteItem);
package.add("Depop", &Perl_Object_Depop);
package.add("EntityVariableExists", &Perl_Object_EntityVariableExists);
package.add("GetDBID", &Perl_Object_GetDBID);
package.add("GetEntityVariable", &Perl_Object_GetEntityVariable);
package.add("GetHeading", &Perl_Object_GetHeading);
package.add("GetID", &Perl_Object_GetID);
package.add("GetIcon", &Perl_Object_GetIcon);
package.add("GetItemID", &Perl_Object_GetItemID);
package.add("GetModelName", &Perl_Object_GetModelName);
package.add("GetSize", &Perl_Object_GetSize);
package.add("GetSolidType", &Perl_Object_GetSolidType);
package.add("GetTiltX", &Perl_Object_GetTiltX);
package.add("GetTiltY", &Perl_Object_GetTiltY);
package.add("GetType", &Perl_Object_GetType);
package.add("GetX", &Perl_Object_GetX);
package.add("GetY", &Perl_Object_GetY);
package.add("GetZ", &Perl_Object_GetZ);
package.add("IsGroundSpawn", &Perl_Object_IsGroundSpawn);
package.add("Repop", &Perl_Object_Repop);
package.add("Save", &Perl_Object_Save);
package.add("SetEntityVariable", &Perl_Object_SetEntityVariable);
package.add("SetHeading", &Perl_Object_SetHeading);
package.add("SetID", &Perl_Object_SetID);
package.add("SetIcon", &Perl_Object_SetIcon);
package.add("SetItemID", &Perl_Object_SetItemID);
package.add("SetLocation", &Perl_Object_SetLocation);
package.add("SetModelName", &Perl_Object_SetModelName);
package.add("SetSize", &Perl_Object_SetSize);
package.add("SetSolidType", &Perl_Object_SetSolidType);
package.add("SetTiltX", &Perl_Object_SetTiltX);
package.add("SetTiltY", &Perl_Object_SetTiltY);
package.add("SetType", &Perl_Object_SetType);
package.add("SetX", &Perl_Object_SetX);
package.add("SetY", &Perl_Object_SetY);
package.add("SetZ", &Perl_Object_SetZ);
package.add("StartDecay", &Perl_Object_StartDecay);
package.add("VarSave", &Perl_Object_VarSave);
}
#endif //EMBPERL_XS_CLASSES

428
zone/perl_perlpacket.cpp
View File

@ -3,421 +3,149 @@
#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)
PerlPacket* Perl_PerlPacket_new(const char* class_name)
{
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);
return new PerlPacket();
}
XS(XS_PerlPacket_DESTROY); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_DESTROY)
PerlPacket* Perl_PerlPacket_new(const char* class_name, const char* opcode)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: PerlPacket::DESTROY(THIS)");
{
PerlPacket * THIS;
VALIDATE_THIS_IS_PACKET;
delete THIS;
}
XSRETURN_EMPTY;
return new PerlPacket(opcode);
}
XS(XS_PerlPacket_SetOpcode); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetOpcode)
PerlPacket* Perl_PerlPacket_new(const char* class_name, const char* opcode, uint32_t len)
{
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);
return new PerlPacket(opcode, len);
}
XS(XS_PerlPacket_Resize); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_Resize)
void Perl_PerlPacket_DESTROY(PerlPacket* self)
{
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;
delete self;
}
XS(XS_PerlPacket_SendTo); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SendTo)
bool Perl_PerlPacket_SetOpcode(PerlPacket* self, const char* opcode)
{
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;
return self->SetOpcode(opcode);
}
XS(XS_PerlPacket_SendToAll); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SendToAll)
void Perl_PerlPacket_Resize(PerlPacket* self, uint32_t len)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: PerlPacket::SendToAll(THIS)");
{
PerlPacket * THIS;
VALIDATE_THIS_IS_PACKET;
THIS->SendToAll();
}
XSRETURN_EMPTY;
self->Resize(len);
}
XS(XS_PerlPacket_Zero); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_Zero)
void Perl_PerlPacket_SendTo(PerlPacket* self, Client* who)
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: PerlPacket::Zero(THIS)");
{
PerlPacket * THIS;
VALIDATE_THIS_IS_PACKET;
THIS->Zero();
}
XSRETURN_EMPTY;
self->SendTo(who);
}
XS(XS_PerlPacket_FromArray); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_FromArray)
void Perl_PerlPacket_SendToAll(PerlPacket* self)
{
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;
self->SendToAll();
}
XS(XS_PerlPacket_SetByte); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetByte)
void Perl_PerlPacket_Zero(PerlPacket* self)
{
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;
self->Zero();
}
XS(XS_PerlPacket_SetShort); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetShort)
void Perl_PerlPacket_FromArray(PerlPacket* self, perl::reference avref, uint32_t length)
{
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: PerlPacket::SetShort(THIS, pos, val)");
perl::array av_numbers = avref;
int* numbers = new int[av_numbers.size()];
for (int i = 0; i < av_numbers.size(); ++i)
{
PerlPacket * THIS;
uint32 pos = (uint32)SvUV(ST(1));
uint16 val = (uint16)SvUV(ST(2));
VALIDATE_THIS_IS_PACKET;
THIS->SetShort(pos, val);
numbers[i] = av_numbers[i];
}
XSRETURN_EMPTY;
self->FromArray(numbers, length);
delete[] numbers;
}
XS(XS_PerlPacket_SetLong); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetLong)
void Perl_PerlPacket_SetByte(PerlPacket* self, uint32_t pos, uint8_t val)
{
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;
self->SetByte(pos, val);
}
XS(XS_PerlPacket_SetFloat); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetFloat)
void Perl_PerlPacket_SetShort(PerlPacket* self, uint32_t pos, uint16_t val)
{
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;
self->SetShort(pos, val);
}
XS(XS_PerlPacket_SetString); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetString)
void Perl_PerlPacket_SetLong(PerlPacket* self, uint32_t pos, uint32_t val)
{
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;
self->SetLong(pos, val);
}
XS(XS_PerlPacket_SetEQ1319); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetEQ1319)
void Perl_PerlPacket_SetFloat(PerlPacket* self, uint32_t pos, float val)
{
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;
self->SetFloat(pos, val);
}
XS(XS_PerlPacket_SetEQ1913); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_SetEQ1913)
void Perl_PerlPacket_SetString(PerlPacket* self, uint32_t pos, char* str)
{
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;
self->SetString(pos, str);
}
XS(XS_PerlPacket_GetByte); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetByte)
void Perl_PerlPacket_SetEQ1319(PerlPacket* self, uint32_t pos, float part13, float part19)
{
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);
self->SetEQ1319(pos, part13, part19);
}
XS(XS_PerlPacket_GetShort); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetShort)
void Perl_PerlPacket_SetEQ1913(PerlPacket* self, uint32_t pos, float part19, float part13)
{
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);
self->SetEQ1913(pos, part19, part13);
}
XS(XS_PerlPacket_GetLong); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetLong)
uint8_t Perl_PerlPacket_GetByte(PerlPacket* self, uint32_t pos)
{
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);
return self->GetByte(pos);
}
XS(XS_PerlPacket_GetFloat); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlPacket_GetFloat)
uint16_t Perl_PerlPacket_GetShort(PerlPacket* self, uint32_t pos)
{
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);
return self->GetShort(pos);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_PerlPacket); /* prototype to pass -Wmissing-prototypes */
XS(boot_PerlPacket)
uint32_t Perl_PerlPacket_GetLong(PerlPacket* self, uint32_t pos)
{
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
return self->GetLong(pos);
}
if(items != 1)
fprintf(stderr, "boot_quest does not take any arguments.");
char buf[128];
float Perl_PerlPacket_GetFloat(PerlPacket* self, uint32_t pos)
{
return self->GetFloat(pos);
}
//add the strcpy stuff to get rid of const warnings....
void perl_register_perlpacket()
{
perl::interpreter perl(PERL_GET_THX);
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;
auto package = perl.new_class<PerlPacket>("PerlPacket");
package.add("DESTROY", &Perl_PerlPacket_DESTROY);
package.add("FromArray", &Perl_PerlPacket_FromArray);
package.add("GetByte", &Perl_PerlPacket_GetByte);
package.add("GetFloat", &Perl_PerlPacket_GetFloat);
package.add("GetLong", &Perl_PerlPacket_GetLong);
package.add("GetShort", &Perl_PerlPacket_GetShort);
package.add("Resize", &Perl_PerlPacket_Resize);
package.add("SendTo", &Perl_PerlPacket_SendTo);
package.add("SendToAll", &Perl_PerlPacket_SendToAll);
package.add("SetByte", &Perl_PerlPacket_SetByte);
package.add("SetEQ1319", &Perl_PerlPacket_SetEQ1319);
package.add("SetEQ1913", &Perl_PerlPacket_SetEQ1913);
package.add("SetFloat", &Perl_PerlPacket_SetFloat);
package.add("SetLong", &Perl_PerlPacket_SetLong);
package.add("SetOpcode", &Perl_PerlPacket_SetOpcode);
package.add("SetShort", &Perl_PerlPacket_SetShort);
package.add("SetString", &Perl_PerlPacket_SetString);
package.add("Zero", &Perl_PerlPacket_Zero);
package.add("new", (PerlPacket*(*)(const char*))&Perl_PerlPacket_new);
package.add("new", (PerlPacket*(*)(const char*, const char*))&Perl_PerlPacket_new);
package.add("new", (PerlPacket*(*)(const char*, const char*, uint32_t))&Perl_PerlPacket_new);
}
#endif //EMBPERL_XS_CLASSES

747
zone/perl_player_corpse.cpp
View File

@ -4,667 +4,238 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "corpse.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_CORPSE \
do { \
if (sv_derived_from(ST(0), "Corpse")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Corpse*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Corpse"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_Corpse_GetCharID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetCharID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetCharID(THIS)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetCharID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetCharID(Corpse* self) // @categories Account and Character, Corpse
{
return self->GetCharID();
}
XS(XS_Corpse_GetDecayTime); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetDecayTime) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetDecayTime(THIS)"); // @categories Script Utility, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetDecayTime();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetDecayTime(Corpse* self) // @categories Script Utility, Corpse
{
return self->GetDecayTime();
}
XS(XS_Corpse_Lock); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_Lock) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::Lock(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->Lock();
}
XSRETURN_EMPTY;
void Perl_Corpse_Lock(Corpse* self) // @categories Corpse
{
self->Lock();
}
XS(XS_Corpse_UnLock); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_UnLock) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::UnLock(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->UnLock();
}
XSRETURN_EMPTY;
void Perl_Corpse_UnLock(Corpse* self) // @categories Corpse
{
self->UnLock();
}
XS(XS_Corpse_IsLocked); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_IsLocked) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::IsLocked(THIS)"); // @categories Corpse
{
Corpse *THIS;
bool RETVAL;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->IsLocked();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Corpse_IsLocked(Corpse* self) // @categories Corpse
{
return self->IsLocked();
}
XS(XS_Corpse_ResetLooter); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_ResetLooter) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::ResetLooter(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->ResetLooter();
}
XSRETURN_EMPTY;
void Perl_Corpse_ResetLooter(Corpse* self) // @categories Corpse
{
self->ResetLooter();
}
XS(XS_Corpse_GetDBID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetDBID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetDBID(THIS)"); // @categories Script Utility, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetCorpseDBID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetDBID(Corpse* self) // @categories Script Utility, Corpse
{
return self->GetCorpseDBID();
}
XS(XS_Corpse_GetOwnerName); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetOwnerName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetOwnerName(THIS)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetOwnerName();
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
std::string Perl_Corpse_GetOwnerName(Corpse* self) // @categories Account and Character, Corpse
{
return self->GetOwnerName();
}
XS(XS_Corpse_SetDecayTimer); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_SetDecayTimer) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::SetDecayTimer(THIS, uint32 decay_time)"); // @categories Corpse
{
Corpse *THIS;
uint32 decaytime = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_CORPSE;
THIS->SetDecayTimer(decaytime);
}
XSRETURN_EMPTY;
void Perl_Corpse_SetDecayTimer(Corpse* self, uint32_t decay_time) // @categories Corpse
{
self->SetDecayTimer(decay_time);
}
XS(XS_Corpse_IsEmpty); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_IsEmpty) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::IsEmpty(THIS)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
bool RETVAL;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->IsEmpty();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Corpse_IsEmpty(Corpse* self) // @categories Inventory and Items, Corpse
{
return self->IsEmpty();
}
XS(XS_Corpse_AddItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_AddItem) {
dXSARGS;
if (items < 3 || items > 4)
Perl_croak(aTHX_ "Usage: Corpse::AddItem(THIS, uint32 item_id, uint16 charges, [unt16 slot = 0])"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint32 itemnum = (uint32) SvUV(ST(1));
uint16 charges = (uint16) SvUV(ST(2));
int16 slot;
VALIDATE_THIS_IS_CORPSE;
if (items < 4)
slot = 0;
else {
slot = (int16) SvIV(ST(3));
}
THIS->AddItem(itemnum, charges, slot);
}
XSRETURN_EMPTY;
void Perl_Corpse_AddItem(Corpse* self, uint32 item_id, uint16 charges) // @categories Inventory and Items, Corpse
{
self->AddItem(item_id, charges);
}
XS(XS_Corpse_GetWornItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetWornItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::GetWornItem(THIS, equipSlot)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
int16 equipSlot = (int16) SvIV(ST(1));
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetWornItem(equipSlot);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Corpse_AddItem(Corpse* self, uint32 item_id, uint16 charges, uint16 slot) // @categories Inventory and Items, Corpse
{
self->AddItem(item_id, charges, slot);
}
XS(XS_Corpse_RemoveItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_RemoveItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::RemoveItem(THIS, uint16 loot_slot)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint16 lootslot = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_CORPSE;
THIS->RemoveItem(lootslot);
}
XSRETURN_EMPTY;
uint32_t Perl_Corpse_GetWornItem(Corpse* self, uint16_t equip_slot) // @categories Inventory and Items, Corpse
{
return self->GetWornItem(equip_slot);
}
XS(XS_Corpse_SetCash); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_SetCash) {
dXSARGS;
if (items != 5)
Perl_croak(aTHX_ "Usage: Corpse::SetCash(THIS, uint16 copper, uint16 silver, uint16 gold, uint16 platinum)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint16 in_copper = (uint16) SvUV(ST(1));
uint16 in_silver = (uint16) SvUV(ST(2));
uint16 in_gold = (uint16) SvUV(ST(3));
uint16 in_platinum = (uint16) SvUV(ST(4));
VALIDATE_THIS_IS_CORPSE;
THIS->SetCash(in_copper, in_silver, in_gold, in_platinum);
}
XSRETURN_EMPTY;
void Perl_Corpse_RemoveItem(Corpse* self, uint16_t loot_slot) // @categories Inventory and Items, Corpse
{
self->RemoveItem(loot_slot);
}
XS(XS_Corpse_RemoveCash); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_RemoveCash) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::RemoveCash(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->RemoveCash();
}
XSRETURN_EMPTY;
void Perl_Corpse_SetCash(Corpse* self, uint16 copper, uint16 silver, uint16 gold, uint16 platinum) // @categories Currency and Points, Corpse
{
self->SetCash(copper, silver, gold, platinum);
}
XS(XS_Corpse_CountItems); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CountItems) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::CountItems(THIS)"); // @categories Inventory and Items, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->CountItems();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Corpse_RemoveCash(Corpse* self) // @categories Currency and Points, Corpse
{
self->RemoveCash();
}
XS(XS_Corpse_Delete); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_Delete) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::Delete(THIS)"); // @categories Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->Delete();
}
XSRETURN_EMPTY;
uint32_t Perl_Corpse_CountItems(Corpse* self) // @categories Inventory and Items, Corpse
{
return self->CountItems();
}
XS(XS_Corpse_GetCopper); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetCopper) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetCopper(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetCopper();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
void Perl_Corpse_Delete(Corpse* self) // @categories Corpse
{
self->Delete();
}
XS(XS_Corpse_GetSilver); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetSilver) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetSilver(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetSilver();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetCopper(Corpse* self) // @categories Currency and Points, Corpse
{
return self->GetCopper();
}
XS(XS_Corpse_GetGold); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetGold) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetGold(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetGold();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetSilver(Corpse* self) // @categories Currency and Points, Corpse
{
return self->GetSilver();
}
XS(XS_Corpse_GetPlatinum); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_GetPlatinum) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetPlatinum(THIS)"); // @categories Currency and Points, Corpse
{
Corpse *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->GetPlatinum();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetGold(Corpse* self)// @categories Currency and Points, Corpse
{
return self->GetGold();
}
XS(XS_Corpse_Summon); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_Summon) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Corpse::Summon(THIS, Client* client, bool is_spell)"); // @categories Corpse
{
Corpse *THIS;
Client *client;
bool spell = (bool) SvTRUE(ST(2));
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(1), "Client")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
client = INT2PTR(Client *, tmp);
} else
Perl_croak(aTHX_ "client is not of type Client");
if (client == nullptr)
Perl_croak(aTHX_ "client is nullptr, avoiding crash.");
THIS->Summon(client, spell, true);
}
XSRETURN_EMPTY;
uint32_t Perl_Corpse_GetPlatinum(Corpse* self) // @categories Currency and Points, Corpse
{
return self->GetPlatinum();
}
XS(XS_Corpse_CastRezz); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CastRezz) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Corpse::CastRezz(THIS, uint16 spell_id, [Mob* caster = nullptr])"); // @categories Spells and Disciplines, Corpse
{
Corpse *THIS;
uint16 spellid = (uint16) SvUV(ST(1));
Mob *Caster;
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(2), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(2)));
Caster = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "Caster is not of type Mob");
if (Caster == nullptr)
Perl_croak(aTHX_ "Caster is nullptr, avoiding crash.");
THIS->CastRezz(spellid, Caster);
}
XSRETURN_EMPTY;
void Perl_Corpse_Summon(Corpse* self, Client* client, bool is_spell) // @categories Corpse
{
self->Summon(client, is_spell, true);
}
XS(XS_Corpse_CompleteRezz); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CompleteRezz) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::CompleteRezz(THIS)"); // @categories Spells and Disciplines, Corpse
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
THIS->CompleteResurrection();
}
XSRETURN_EMPTY;
void Perl_Corpse_CastRezz(Corpse* self, uint16_t spell_id, Mob* caster) // @categories Spells and Disciplines, Corpse
{
self->CastRezz(spell_id, caster);
}
XS(XS_Corpse_CanMobLoot); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_CanMobLoot) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::CanMobLoot(THIS, int character_id)"); // @categories Script Utility, Corpse
{
Corpse *THIS;
bool RETVAL;
int charid = (int) SvIV(ST(1));
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->CanPlayerLoot(charid);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Corpse_CompleteRezz(Corpse* self) // @categories Spells and Disciplines, Corpse
{
self->CompleteResurrection();
}
XS(XS_Corpse_AllowMobLoot); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_AllowMobLoot) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Corpse::AllowMobLoot(THIS, Mob* them, uint8 slot)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
Mob *them;
uint8 slot = (uint8) SvUV(ST(2));
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
them = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "them is not of type Mob");
if (them == nullptr)
Perl_croak(aTHX_ "them is nullptr, avoiding crash.");
THIS->AllowPlayerLoot(them, slot);
}
XSRETURN_EMPTY;
bool Perl_Corpse_CanMobLoot(Corpse* self, int character_id) // @categories Script Utility, Corpse
{
return self->CanPlayerLoot(character_id);
}
XS(XS_Corpse_AddLooter); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_AddLooter) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::AddLooter(THIS, Mob* who)"); // @categories Account and Character, Corpse
{
Corpse *THIS;
Mob *who;
VALIDATE_THIS_IS_CORPSE;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
who = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "who is not of type Mob");
if (who == nullptr)
Perl_croak(aTHX_ "who is nullptr, avoiding crash.");
THIS->AddLooter(who);
}
XSRETURN_EMPTY;
void Perl_Corpse_AllowMobLoot(Corpse* self, Mob* them, uint8_t slot) // @categories Account and Character, Corpse
{
self->AllowPlayerLoot(them, slot);
}
XS(XS_Corpse_IsRezzed); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_IsRezzed) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::IsRezzed(THIS)"); // @categories Corpse
{
Corpse *THIS;
bool RETVAL;
VALIDATE_THIS_IS_CORPSE;
RETVAL = THIS->IsRezzed();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_Corpse_AddLooter(Corpse* self, Mob* who) // @categories Account and Character, Corpse
{
self->AddLooter(who);
}
XS(XS_Corpse_HasItem); /* prototype to pass -Wmissing-prototypes */
XS(XS_Corpse_HasItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::HasItem(THIS, uint32 item_id)"); // @categories Script Utility
{
Corpse *THIS;
bool has_item = false;
uint32 item_id = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_CORPSE;
has_item = THIS->HasItem(item_id);
ST(0) = boolSV(has_item);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_Corpse_IsRezzed(Corpse* self) // @categories Corpse
{
return self->IsRezzed();
}
XS(XS_Corpse_CountItem);
XS(XS_Corpse_CountItem) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::CountItem(THIS, uint32 item_id)"); // @categories Script Utility
{
Corpse *THIS;
uint16 item_count = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
item_count = THIS->CountItem(item_id);
XSprePUSH;
PUSHu((UV) item_count);
}
XSRETURN(1);
bool Perl_Corpse_HasItem(Corpse* self, uint32_t item_id) // @categories Script Utility
{
return self->HasItem(item_id);
}
XS(XS_Corpse_GetItemIDBySlot);
XS(XS_Corpse_GetItemIDBySlot) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::GetItemIDBySlot(THIS, uint16 loot_slot)"); // @categories Script Utility
{
Corpse *THIS;
uint32 item_id = 0;
uint16 loot_slot = (uint16) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
item_id = THIS->GetItemIDBySlot(loot_slot);
XSprePUSH;
PUSHu((UV) item_id);
}
XSRETURN(1);
int Perl_Corpse_CountItem(Corpse* self, uint32_t item_id) // @categories Script Utility
{
return self->CountItem(item_id);
}
XS(XS_Corpse_GetFirstSlotByItemID);
XS(XS_Corpse_GetFirstSlotByItemID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Corpse::GetFirstSlotByItemID(THIS, uint32 item_id)"); // @categories Script Utility
{
Corpse *THIS;
uint16 loot_slot = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_CORPSE;
loot_slot = THIS->GetFirstSlotByItemID(item_id);
XSprePUSH;
PUSHu((UV) loot_slot);
}
XSRETURN(1);
uint32_t Perl_Corpse_GetItemIDBySlot(Corpse* self, uint16_t loot_slot) // @categories Script Utility
{
return self->GetItemIDBySlot(loot_slot);
}
XS(XS_Corpse_RemoveItemByID);
XS(XS_Corpse_RemoveItemByID) {
dXSARGS;
if (items != 2 && items != 3)
Perl_croak(aTHX_ "Usage: Corpse::RemoveItemByID(THIS, uint32 item_id, [int quantity = 1])"); // @categories Script Utility
{
Corpse *THIS;
uint32 item_id = (uint32) SvUV(ST(1));
int quantity = 1;
VALIDATE_THIS_IS_CORPSE;
if (items == 3)
quantity = (int) SvIV(ST(2));
THIS->RemoveItemByID(item_id, quantity);
}
XSRETURN_EMPTY;
int Perl_Corpse_GetFirstSlotByItemID(Corpse* self, uint32_t item_id) // @categories Script Utility
{
return self->GetFirstSlotByItemID(item_id);
}
XS(XS_Corpse_GetLootList);
XS(XS_Corpse_GetLootList) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Corpse::GetLootList(THIS)"); // @categories Script Utility
{
Corpse *THIS;
VALIDATE_THIS_IS_CORPSE;
auto corpse_items = THIS->GetLootList();
auto item_count = corpse_items.size();
if (item_count > 0) {
EXTEND(sp, item_count);
for (int index = 0; index < item_count; ++index) {
ST(index) = sv_2mortal(newSVuv(corpse_items[index]));
}
XSRETURN(item_count);
}
SV* return_value = &PL_sv_undef;
ST(0) = return_value;
XSRETURN(1);
}
void Perl_Corpse_RemoveItemByID(Corpse* self, uint32_t item_id) // @categories Script Utility
{
self->RemoveItemByID(item_id);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Corpse); /* prototype to pass -Wmissing-prototypes */
XS(boot_Corpse) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
void Perl_Corpse_RemoveItemByID(Corpse* self, uint32_t item_id, int quantity) // @categories Script Utility
{
self->RemoveItemByID(item_id);
}
if (items != 1)
fprintf(stderr, "boot_quest does not take any arguments.");
char buf[128];
perl::array Perl_Corpse_GetLootList(Corpse* self) // @categories Script Utility
{
perl::array result;
//add the strcpy stuff to get rid of const warnings....
auto corpse_items = self->GetLootList();
for (int i = 0; i < corpse_items.size(); ++i)
{
result.push_back(corpse_items[i]);
}
XS_VERSION_BOOTCHECK;
newXSproto(strcpy(buf, "AddItem"), XS_Corpse_AddItem, file, "$$$;$");
newXSproto(strcpy(buf, "AddLooter"), XS_Corpse_AddLooter, file, "$$");
newXSproto(strcpy(buf, "AllowMobLoot"), XS_Corpse_AllowMobLoot, file, "$$$");
newXSproto(strcpy(buf, "CanMobLoot"), XS_Corpse_CanMobLoot, file, "$$");
newXSproto(strcpy(buf, "CastRezz"), XS_Corpse_CastRezz, file, "$$$");
newXSproto(strcpy(buf, "CompleteRezz"), XS_Corpse_CompleteRezz, file, "$");
newXSproto(strcpy(buf, "CountItem"), XS_Corpse_CountItem, file, "$$");
newXSproto(strcpy(buf, "CountItems"), XS_Corpse_CountItems, file, "$");
newXSproto(strcpy(buf, "Delete"), XS_Corpse_Delete, file, "$");
newXSproto(strcpy(buf, "GetCharID"), XS_Corpse_GetCharID, file, "$");
newXSproto(strcpy(buf, "GetCopper"), XS_Corpse_GetCopper, file, "$");
newXSproto(strcpy(buf, "GetDBID"), XS_Corpse_GetDBID, file, "$");
newXSproto(strcpy(buf, "GetDecayTime"), XS_Corpse_GetDecayTime, file, "$");
newXSproto(strcpy(buf, "GetFirstSlotByItemID"), XS_Corpse_GetFirstSlotByItemID, file, "$$");
newXSproto(strcpy(buf, "GetGold"), XS_Corpse_GetGold, file, "$");
newXSproto(strcpy(buf, "GetItemIDBySlot"), XS_Corpse_GetItemIDBySlot, file, "$$");
newXSproto(strcpy(buf, "GetLootList"), XS_Corpse_GetLootList, file, "$");
newXSproto(strcpy(buf, "GetOwnerName"), XS_Corpse_GetOwnerName, file, "$");
newXSproto(strcpy(buf, "GetPlatinum"), XS_Corpse_GetPlatinum, file, "$");
newXSproto(strcpy(buf, "GetSilver"), XS_Corpse_GetSilver, file, "$");
newXSproto(strcpy(buf, "GetWornItem"), XS_Corpse_GetWornItem, file, "$$");
newXSproto(strcpy(buf, "HasItem"), XS_Corpse_HasItem, file, "$$");
newXSproto(strcpy(buf, "IsEmpty"), XS_Corpse_IsEmpty, file, "$");
newXSproto(strcpy(buf, "IsLocked"), XS_Corpse_IsLocked, file, "$");
newXSproto(strcpy(buf, "IsRezzed"), XS_Corpse_IsRezzed, file, "$");
newXSproto(strcpy(buf, "Lock"), XS_Corpse_Lock, file, "$");
newXSproto(strcpy(buf, "RemoveCash"), XS_Corpse_RemoveCash, file, "$");
newXSproto(strcpy(buf, "RemoveItem"), XS_Corpse_RemoveItem, file, "$$");
newXSproto(strcpy(buf, "RemoveItemByID"), XS_Corpse_RemoveItemByID, file, "$$;$");
newXSproto(strcpy(buf, "ResetLooter"), XS_Corpse_ResetLooter, file, "$");
newXSproto(strcpy(buf, "SetCash"), XS_Corpse_SetCash, file, "$$$$$");
newXSproto(strcpy(buf, "SetDecayTimer"), XS_Corpse_SetDecayTimer, file, "$$");
newXSproto(strcpy(buf, "Summon"), XS_Corpse_Summon, file, "$$$");
newXSproto(strcpy(buf, "UnLock"), XS_Corpse_UnLock, file, "$");
XSRETURN_YES;
return result;
}
void perl_register_corpse()
{
perl::interpreter perl(PERL_GET_THX);
auto package = perl.new_class<Corpse>("Corpse");
package.add_base_class("Mob");
package.add("AddItem", (void(*)(Corpse*, uint32, uint16))&Perl_Corpse_AddItem);
package.add("AddItem", (void(*)(Corpse*, uint32, uint16, uint16))&Perl_Corpse_AddItem);
package.add("AddLooter", &Perl_Corpse_AddLooter);
package.add("AllowMobLoot", &Perl_Corpse_AllowMobLoot);
package.add("CanMobLoot", &Perl_Corpse_CanMobLoot);
package.add("CastRezz", &Perl_Corpse_CastRezz);
package.add("CompleteRezz", &Perl_Corpse_CompleteRezz);
package.add("CountItem", &Perl_Corpse_CountItem);
package.add("CountItems", &Perl_Corpse_CountItems);
package.add("Delete", &Perl_Corpse_Delete);
package.add("GetCharID", &Perl_Corpse_GetCharID);
package.add("GetCopper", &Perl_Corpse_GetCopper);
package.add("GetDBID", &Perl_Corpse_GetDBID);
package.add("GetDecayTime", &Perl_Corpse_GetDecayTime);
package.add("GetFirstSlotByItemID", &Perl_Corpse_GetFirstSlotByItemID);
package.add("GetGold", &Perl_Corpse_GetGold);
package.add("GetItemIDBySlot", &Perl_Corpse_GetItemIDBySlot);
package.add("GetLootList", &Perl_Corpse_GetLootList);
package.add("GetOwnerName", &Perl_Corpse_GetOwnerName);
package.add("GetPlatinum", &Perl_Corpse_GetPlatinum);
package.add("GetSilver", &Perl_Corpse_GetSilver);
package.add("GetWornItem", &Perl_Corpse_GetWornItem);
package.add("HasItem", &Perl_Corpse_HasItem);
package.add("IsEmpty", &Perl_Corpse_IsEmpty);
package.add("IsLocked", &Perl_Corpse_IsLocked);
package.add("IsRezzed", &Perl_Corpse_IsRezzed);
package.add("Lock", &Perl_Corpse_Lock);
package.add("RemoveCash", &Perl_Corpse_RemoveCash);
package.add("RemoveItem", &Perl_Corpse_RemoveItem);
package.add("RemoveItemByID", (void(*)(Corpse*, uint32_t))&Perl_Corpse_RemoveItemByID);
package.add("RemoveItemByID", (void(*)(Corpse*, uint32_t, int))&Perl_Corpse_RemoveItemByID);
package.add("ResetLooter", &Perl_Corpse_ResetLooter);
package.add("SetCash", &Perl_Corpse_SetCash);
package.add("SetDecayTimer", &Perl_Corpse_SetDecayTimer);
package.add("Summon", &Perl_Corpse_Summon);
package.add("UnLock", &Perl_Corpse_UnLock);
}
#endif //EMBPERL_XS_CLASSES

254
zone/perl_questitem.cpp
View File

@ -4,234 +4,82 @@
#ifdef EMBPERL_XS_CLASSES
#include "../common/global_define.h"
#include "../common/item_instance.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "../common/item_instance.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
#define VALIDATE_THIS_IS_ITEM \
do { \
if (sv_derived_from(ST(0), "QuestItem")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(EQ::ItemInstance*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type EQ::ItemInstance"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
XS(XS_QuestItem_GetName);
XS(XS_QuestItem_GetName) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::GetName(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
Const_char *RETVAL;
dXSTARG;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetItem()->Name;
sv_setpv(TARG, RETVAL);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
std::string Perl_QuestItem_GetName(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->GetItem()->Name;
}
XS(XS_QuestItem_SetScale);
XS(XS_QuestItem_SetScale) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::SetScale(THIS, float scale_multiplier)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
float Mult;
VALIDATE_THIS_IS_ITEM;
Mult = (float) SvNV(ST(1));
if (THIS->IsScaling()) {
THIS->SetExp((int) (Mult * 10000 + .5));
}
void Perl_QuestItem_SetScale(EQ::ItemInstance* self, float scale_multiplier) // @categories Inventory and Items
{
if (self->IsScaling()) {
self->SetExp((int) (scale_multiplier * 10000 + .5));
}
XSRETURN_EMPTY;
}
XS(XS_QuestItem_ItemSay);
XS(XS_QuestItem_ItemSay) {
dXSARGS;
if (items != 2 && items != 3)
Perl_croak(aTHX_ "Usage: QuestItem::ItemSay(THIS, string text [int language_id])"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
Const_char *text;
int lang = 0;
VALIDATE_THIS_IS_ITEM;
text = SvPV_nolen(ST(1));
if (items == 3)
lang = (int) SvUV(ST(2));
quest_manager.GetInitiator()->ChannelMessageSend(THIS->GetItem()->Name, 0, 8, lang, 100, text);
}
XSRETURN_EMPTY;
void Perl_QuestItem_ItemSay(EQ::ItemInstance* self, const char* text) // @categories Inventory and Items
{
quest_manager.GetInitiator()->ChannelMessageSend(self->GetItem()->Name, 0, 8, 0, 100, text);
}
XS(XS_QuestItem_IsType); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_IsType) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::IsType(THIS, type)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
bool RETVAL;
uint32 type = (int32) SvIV(ST(1));
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->IsType((EQ::item::ItemClass) type);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
void Perl_QuestItem_ItemSay(EQ::ItemInstance* self, const char* text, int language_id) // @categories Inventory and Items
{
quest_manager.GetInitiator()->ChannelMessageSend(self->GetItem()->Name, 0, 8, language_id, 100, text);
}
XS(XS_QuestItem_IsAttuned); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_IsAttuned) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::IsAttuned(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
bool RETVAL;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->IsAttuned();
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
bool Perl_QuestItem_IsType(EQ::ItemInstance* self, int type) // @categories Inventory and Items
{
return self->IsType(static_cast<EQ::item::ItemClass>(type));
}
XS(XS_QuestItem_GetCharges); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_GetCharges) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::GetCharges(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
int16 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetCharges();
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
bool Perl_QuestItem_IsAttuned(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->IsAttuned();
}
XS(XS_QuestItem_GetAugment); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_GetAugment) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::GetAugment(THIS, int16 slot_id)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
int16 slot_id = (int16) SvIV(ST(1));
EQ::ItemInstance *RETVAL;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetAugment(slot_id);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "QuestItem", (void *) RETVAL);
}
XSRETURN(1);
int Perl_QuestItem_GetCharges(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->GetCharges();
}
XS(XS_QuestItem_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: QuestItem::GetID(THIS)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_ITEM;
RETVAL = THIS->GetItem()->ID;
XSprePUSH;
PUSHi((IV) RETVAL);
}
XSRETURN(1);
EQ::ItemInstance* Perl_QuestItem_GetAugment(EQ::ItemInstance* self, int slot_id) // @categories Inventory and Items
{
return self->GetAugment(slot_id);
}
XS(XS_QuestItem_ContainsAugmentByID); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_ContainsAugmentByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::ContainsAugmentByID(THIS, uint32 item_id)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
uint32 item_id = (uint32) SvUV(ST(1));
bool contains_augment = false;
VALIDATE_THIS_IS_ITEM;
contains_augment = THIS->ContainsAugmentByID(item_id);
ST(0) = boolSV(contains_augment);
sv_2mortal(ST(0));
}
XSRETURN(1);
uint32_t Perl_QuestItem_GetID(EQ::ItemInstance* self) // @categories Inventory and Items
{
return self->GetItem()->ID;
}
XS(XS_QuestItem_CountAugmentByID); /* prototype to pass -Wmissing-prototypes */
XS(XS_QuestItem_CountAugmentByID) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: QuestItem::CountAugmentByID(THIS, uint32 item_id)"); // @categories Inventory and Items
{
EQ::ItemInstance *THIS;
int quantity = 0;
uint32 item_id = (uint32) SvUV(ST(1));
dXSTARG;
VALIDATE_THIS_IS_ITEM;
quantity = THIS->CountAugmentByID(item_id);
XSprePUSH;
PUSHi((IV) quantity);
}
XSRETURN(1);
bool Perl_QuestItem_ContainsAugmentByID(EQ::ItemInstance* self, uint32_t item_id) // @categories Inventory and Items
{
return self->ContainsAugmentByID(item_id);
}
#ifdef __cplusplus
extern "C"
#endif
int Perl_QuestItem_CountAugmentByID(EQ::ItemInstance* self, uint32_t item_id) // @categories Inventory and Items
{
return self->CountAugmentByID(item_id);
}
XS(boot_QuestItem);
XS(boot_QuestItem) {
dXSARGS;
char file[256];
strncpy(file, __FILE__, 256);
file[255] = 0;
void perl_register_questitem()
{
perl::interpreter perl(PERL_GET_THX);
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, "ContainsAugmentByID"), XS_QuestItem_ContainsAugmentByID, file, "$$");
newXSproto(strcpy(buf, "CountAugmentByID"), XS_QuestItem_CountAugmentByID, file, "$$");
newXSproto(strcpy(buf, "GetAugment"), XS_QuestItem_GetAugment, file, "$$");
newXSproto(strcpy(buf, "GetCharges"), XS_QuestItem_GetCharges, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_QuestItem_GetID, file, "$");
newXSproto(strcpy(buf, "GetName"), XS_QuestItem_GetName, file, "$");
newXSproto(strcpy(buf, "IsAttuned"), XS_QuestItem_IsAttuned, file, "$");
newXSproto(strcpy(buf, "IsType"), XS_QuestItem_IsType, file, "$$");
newXSproto(strcpy(buf, "ItemSay"), XS_QuestItem_ItemSay, file, "$");
newXSproto(strcpy(buf, "SetScale"), XS_QuestItem_SetScale, file, "$");
XSRETURN_YES;
auto package = perl.new_class<EQ::ItemInstance>("QuestItem");
package.add("ContainsAugmentByID", &Perl_QuestItem_ContainsAugmentByID);
package.add("CountAugmentByID", &Perl_QuestItem_CountAugmentByID);
package.add("GetAugment", &Perl_QuestItem_GetAugment);
package.add("GetCharges", &Perl_QuestItem_GetCharges);
package.add("GetID", &Perl_QuestItem_GetID);
package.add("GetName", &Perl_QuestItem_GetName);
package.add("IsAttuned", &Perl_QuestItem_IsAttuned);
package.add("IsType", &Perl_QuestItem_IsType);
package.add("ItemSay", (void(*)(EQ::ItemInstance*, const char*))&Perl_QuestItem_ItemSay);
package.add("ItemSay", (void(*)(EQ::ItemInstance*, const char*, int))&Perl_QuestItem_ItemSay);
package.add("SetScale", &Perl_QuestItem_SetScale);
}
#endif //EMBPERL_XS_CLASSES

541
zone/perl_raids.cpp
View File

@ -4,443 +4,138 @@
#include "../common/global_define.h"
#include "embperl.h"
#ifdef seed
#undef seed
#endif
#include "raids.h"
#include "client.h"
#ifdef THIS /* this macro seems to leak out on some systems */
#undef THIS
#endif
bool Perl_Raid_IsRaidMember(Raid* self, const char* name) // @categories Raid
{
return self->IsRaidMember(name);
}
#define VALIDATE_THIS_IS_RAID \
do { \
if (sv_derived_from(ST(0), "Raid")) { \
IV tmp = SvIV((SV*)SvRV(ST(0))); \
THIS = INT2PTR(Raid*, tmp); \
} else { \
Perl_croak(aTHX_ "THIS is not of type Raid"); \
} \
if (THIS == nullptr) { \
Perl_croak(aTHX_ "THIS is nullptr, avoiding crash."); \
} \
} while (0);
void Perl_Raid_CastGroupSpell(Raid* self, Mob* caster, uint16 spell_id, uint32 group_id) // @categories Group, Raid
{
self->CastGroupSpell(caster, spell_id, group_id);
}
XS(XS_Raid_IsRaidMember); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_IsRaidMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::IsRaidMember(THIS, string name)"); // @categories Raid
int Perl_Raid_GroupCount(Raid* self, uint32_t group_id) // @categories Group, Raid
{
return self->GroupCount(group_id);
}
int Perl_Raid_RaidCount(Raid* self) // @categories Raid
{
return self->RaidCount();
}
uint32_t Perl_Raid_GetGroup(Raid* self, const char* name) // @categories Group, Raid
{
return self->GetGroup(name);
}
void Perl_Raid_SplitExp(Raid* self, uint32 experience, Mob* other) // @categories Experience and Level, Raid
{
self->SplitExp(experience, other);
}
uint32_t Perl_Raid_GetTotalRaidDamage(Raid* self, Mob* other) // @categories Raid
{
return self->GetTotalRaidDamage(other);
}
void Perl_Raid_SplitMoney(Raid* self, uint32 gid, uint32 copper, uint32 silver, uint32 gold, uint32 platinum) // @categories Currency and Points, Raid
{
self->SplitMoney(gid, copper, silver, gold, platinum);
}
void Perl_Raid_BalanceHP(Raid* self, int32_t penalty, uint32_t group_id) // @categories Raid
{
self->BalanceHP(penalty, group_id);
}
bool Perl_Raid_IsLeader(Raid* self, const char* name) // @categories Raid
{
return self->IsLeader(name);
}
bool Perl_Raid_IsGroupLeader(Raid* self, const char* who) // @categories Group, Raid
{
return self->IsGroupLeader(who);
}
uint32_t Perl_Raid_GetHighestLevel(Raid* self) // @categories Raid
{
return self->GetHighestLevel();
}
uint32_t Perl_Raid_GetLowestLevel(Raid* self) // @categories Raid
{
return self->GetLowestLevel();
}
Client* Perl_Raid_GetClientByIndex(Raid* self, uint16_t raid_index) // @categories Raid
{
return self->GetClientByIndex(raid_index);
}
void Perl_Raid_TeleportGroup(Raid* self, Mob* sender, uint32 zone_id, float x, float y, float z, float heading, uint32 group_id) // @categories Group, Raid
{
self->TeleportGroup(sender, zone_id, 0, x, y, z, heading, group_id);
}
void Perl_Raid_TeleportRaid(Raid* self, Mob* sender, uint32 zone_id, float x, float y, float z, float heading) // @categories Raid
{
self->TeleportRaid(sender, zone_id, 0, x, y, z, heading);
}
uint32_t Perl_Raid_GetID(Raid* self) // @categories Raid
{
return self->GetID();
}
Client* Perl_Raid_GetMember(Raid* self, int index) // @categories Raid
{
if (index < 0 || index >= MAX_RAID_MEMBERS)
{
Raid *THIS;
bool RETVAL;
const char *name = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->IsRaidMember(name);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
return nullptr;
}
XSRETURN(1);
return self->members[index].member;
}
XS(XS_Raid_CastGroupSpell); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_CastGroupSpell) {
dXSARGS;
if (items != 4)
Perl_croak(aTHX_ "Usage: Raid::CastGroupSpell(THIS, Mob* caster, uint16 spell_id, uint32 group_id)"); // @categories Group, Raid
{
Raid *THIS;
Mob *caster;
uint16 spellid = (uint16) SvUV(ST(2));
uint32 gid = (uint32) SvUV(ST(3));
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
caster = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "caster is not of type Mob");
if (caster == nullptr)
Perl_croak(aTHX_ "caster is nullptr, avoiding crash.");
THIS->CastGroupSpell(caster, spellid, gid);
}
XSRETURN_EMPTY;
bool Perl_Raid_DoesAnyMemberHaveExpeditionLockout(Raid* self, std::string expedition_name, std::string event_name)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name);
}
XS(XS_Raid_GroupCount); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GroupCount) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GroupCount(THIS, uint32 group_id)"); // @categories Group, Raid
{
Raid *THIS;
uint8 RETVAL;
dXSTARG;
uint32 gid = (uint32) SvUV(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GroupCount(gid);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
bool Perl_Raid_DoesAnyMemberHaveExpeditionLockout(Raid* self, std::string expedition_name, std::string event_name, int max_check_count)
{
return self->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
}
XS(XS_Raid_RaidCount); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_RaidCount) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::RaidCount(THIS)"); // @categories Raid
{
Raid *THIS;
uint8 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->RaidCount();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
void perl_register_raid()
{
perl::interpreter perl(PERL_GET_THX);
XS(XS_Raid_GetGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetGroup) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetGroup(THIS, string name)"); // @categories Group, Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
const char *name = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetGroup(name);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_SplitExp); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_SplitExp) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Raid::SplitExp(THIS, uint32 experience, [Mob* other = nullptr])"); // @categories Experience and Level, Raid
{
Raid *THIS;
uint32 exp = (uint32) SvUV(ST(1));
Mob *other;
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(2), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(2)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
THIS->SplitExp(exp, other);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_GetTotalRaidDamage); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetTotalRaidDamage) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetTotalRaidDamage(THIS, [Mob* other = nullptr])"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
Mob *other;
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
other = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "other is not of type Mob");
if (other == nullptr)
Perl_croak(aTHX_ "other is nullptr, avoiding crash.");
RETVAL = THIS->GetTotalRaidDamage(other);
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_SplitMoney); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_SplitMoney) {
dXSARGS;
if (items != 5)
Perl_croak(aTHX_ "Usage: Raid::SplitMoney(THIS, uint32 gid, uint32 copper, uint32 silver, uint32 gold, uint32 platinum)"); // @categories Currency and Points, Raid
{
Raid *THIS;
uint32 gid = (uint32) SvUV(ST(1));
uint32 copper = (uint32) SvUV(ST(2));
uint32 silver = (uint32) SvUV(ST(3));
uint32 gold = (uint32) SvUV(ST(4));
uint32 platinum = (uint32) SvUV(ST(5));
VALIDATE_THIS_IS_RAID;
THIS->SplitMoney(gid, copper, silver, gold, platinum);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_BalanceHP); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_BalanceHP) {
dXSARGS;
if (items != 3)
Perl_croak(aTHX_ "Usage: Raid::BalanceHP(THIS, int32 penalty, uint32 group_id)"); // @categories Raid
{
Raid *THIS;
int32 penalty = (int32) SvUV(ST(1));
uint32 gid = (uint32) SvUV(ST(2));
VALIDATE_THIS_IS_RAID;
THIS->BalanceHP(penalty, gid);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_IsLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_IsLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::IsLeader(THIS, string name)"); // @categories Raid
{
Raid *THIS;
bool RETVAL;
const char *name = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->IsLeader(name);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Raid_IsGroupLeader); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_IsGroupLeader) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::IsGroupLeader(THIS, string name)"); // @categories Group, Raid
{
Raid *THIS;
bool RETVAL;
const char *who = (char *) SvPV_nolen(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->IsGroupLeader(who);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
}
XSRETURN(1);
}
XS(XS_Raid_GetHighestLevel); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetHighestLevel) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::GetHighestLevel(THIS)"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetHighestLevel();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_GetLowestLevel); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetLowestLevel) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::GetLowestLevel(THIS)"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetLowestLevel();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_GetClientByIndex); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetClientByIndex) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetClientByIndex(THIS, uint16 raid_index)"); // @categories Raid
{
Raid *THIS;
Client *RETVAL;
uint16 index = (uint16) SvUV(ST(1));
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetClientByIndex(index);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Client", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_TeleportGroup); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_TeleportGroup) {
dXSARGS;
if (items != 8)
Perl_croak(aTHX_ "Usage: Raid::TeleportGroup(THIS, Mob* sender, uint32 zone_id, float x, float y, float z, float heading, uint32 group_id)"); // @categories Group, Raid
{
Raid *THIS;
Mob *sender;
uint32 zoneID = (uint32) SvUV(ST(2));
float x = (float) SvNV(ST(3));
float y = (float) SvNV(ST(4));
float z = (float) SvNV(ST(5));
float heading = (float) SvNV(ST(6));
uint32 gid = (uint32) SvUV(ST(7));
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
THIS->TeleportGroup(sender, zoneID, 0, x, y, z, heading, gid);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_TeleportRaid); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_TeleportRaid) {
dXSARGS;
if (items != 7)
Perl_croak(aTHX_ "Usage: Raid::TeleportRaid(THIS, Mob* sender, uint32 zone_id, float x, float y, float z, float heading)"); // @categories Raid
{
Raid *THIS;
Mob *sender;
uint32 zoneID = (uint32) SvUV(ST(2));
float x = (float) SvNV(ST(3));
float y = (float) SvNV(ST(4));
float z = (float) SvNV(ST(5));
float heading = (float) SvNV(ST(6));
VALIDATE_THIS_IS_RAID;
if (sv_derived_from(ST(1), "Mob")) {
IV tmp = SvIV((SV *) SvRV(ST(1)));
sender = INT2PTR(Mob *, tmp);
} else
Perl_croak(aTHX_ "sender is not of type Mob");
if (sender == nullptr)
Perl_croak(aTHX_ "sender is nullptr, avoiding crash.");
THIS->TeleportRaid(sender, zoneID, 0, x, y, z, heading);
}
XSRETURN_EMPTY;
}
XS(XS_Raid_GetID); /* prototype to pass -Wmissing-prototypes */
XS(XS_Raid_GetID) {
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: Raid::GetID(THIS)"); // @categories Raid
{
Raid *THIS;
uint32 RETVAL;
dXSTARG;
VALIDATE_THIS_IS_RAID;
RETVAL = THIS->GetID();
XSprePUSH;
PUSHu((UV) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_GetMember);
XS(XS_Raid_GetMember) {
dXSARGS;
if (items != 2)
Perl_croak(aTHX_ "Usage: Raid::GetMember(THIS, int raid_index)"); // @categories Raid
{
Raid *THIS;
Client *RETVAL = nullptr;
dXSTARG;
VALIDATE_THIS_IS_RAID;
int index = (int) SvUV(ST(1));
if (index < 0 || index > 71)
RETVAL = nullptr;
else {
if (THIS->members[index].member != nullptr)
RETVAL = THIS->members[index].member->CastToClient();
}
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), "Client", (void *) RETVAL);
}
XSRETURN(1);
}
XS(XS_Raid_DoesAnyMemberHaveExpeditionLockout);
XS(XS_Raid_DoesAnyMemberHaveExpeditionLockout) {
dXSARGS;
if (items != 3 && items != 4) {
Perl_croak(aTHX_ "Usage: Raid::DoesAnyMemberHaveExpeditionLockout(THIS, string expedition_name, string event_name, [int max_check_count = 0])");
}
Raid* THIS = nullptr;
VALIDATE_THIS_IS_RAID;
std::string expedition_name(SvPV_nolen(ST(1)));
std::string event_name(SvPV_nolen(ST(2)));
int max_check_count = (items == 4) ? static_cast<int>(SvIV(ST(3))) : 0;
bool result = THIS->DoesAnyMemberHaveExpeditionLockout(expedition_name, event_name, max_check_count);
ST(0) = boolSV(result);
XSRETURN(1);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Raid); /* prototype to pass -Wmissing-prototypes */
XS(boot_Raid) {
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, "BalanceHP"), XS_Raid_BalanceHP, file, "$$$");
newXSproto(strcpy(buf, "CastGroupSpell"), XS_Raid_CastGroupSpell, file, "$$$$");
newXSproto(strcpy(buf, "DoesAnyMemberHaveExpeditionLockout"), XS_Raid_DoesAnyMemberHaveExpeditionLockout, file, "$$$;$");
newXSproto(strcpy(buf, "GetClientByIndex"), XS_Raid_GetClientByIndex, file, "$$");
newXSproto(strcpy(buf, "GetGroup"), XS_Raid_GetGroup, file, "$$");
newXSproto(strcpy(buf, "GetHighestLevel"), XS_Raid_GetHighestLevel, file, "$");
newXSproto(strcpy(buf, "GetID"), XS_Raid_GetID, file, "$");
newXSproto(strcpy(buf, "GetLowestLevel"), XS_Raid_GetLowestLevel, file, "$");
newXSproto(strcpy(buf, "GetMember"), XS_Raid_GetMember, file, "$$");
newXSproto(strcpy(buf, "GetTotalRaidDamage"), XS_Raid_GetTotalRaidDamage, file, "$$");
newXSproto(strcpy(buf, "GroupCount"), XS_Raid_GroupCount, file, "$$");
newXSproto(strcpy(buf, "IsGroupLeader"), XS_Raid_IsGroupLeader, file, "$$");
newXSproto(strcpy(buf, "IsLeader"), XS_Raid_IsLeader, file, "$$");
newXSproto(strcpy(buf, "IsRaidMember"), XS_Raid_IsRaidMember, file, "$$");
newXSproto(strcpy(buf, "RaidCount"), XS_Raid_RaidCount, file, "$");
newXSproto(strcpy(buf, "SplitExp"), XS_Raid_SplitExp, file, "$$$");
newXSproto(strcpy(buf, "SplitMoney"), XS_Raid_SplitMoney, file, "$$$$$$");
newXSproto(strcpy(buf, "TeleportGroup"), XS_Raid_TeleportGroup, file, "$$$$$$$$");
newXSproto(strcpy(buf, "TeleportRaid"), XS_Raid_TeleportRaid, file, "$$$$$$$");
XSRETURN_YES;
auto package = perl.new_class<Raid>("Raid");
package.add("BalanceHP", &Perl_Raid_BalanceHP);
package.add("CastGroupSpell", &Perl_Raid_CastGroupSpell);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Raid*, std::string, std::string))&Perl_Raid_DoesAnyMemberHaveExpeditionLockout);
package.add("DoesAnyMemberHaveExpeditionLockout", (bool(*)(Raid*, std::string, std::string, int))&Perl_Raid_DoesAnyMemberHaveExpeditionLockout);
package.add("GetClientByIndex", &Perl_Raid_GetClientByIndex);
package.add("GetGroup", &Perl_Raid_GetGroup);
package.add("GetHighestLevel", &Perl_Raid_GetHighestLevel);
package.add("GetID", &Perl_Raid_GetID);
package.add("GetLowestLevel", &Perl_Raid_GetLowestLevel);
package.add("GetMember", &Perl_Raid_GetMember);
package.add("GetTotalRaidDamage", &Perl_Raid_GetTotalRaidDamage);
package.add("GroupCount", &Perl_Raid_GroupCount);
package.add("IsGroupLeader", &Perl_Raid_IsGroupLeader);
package.add("IsLeader", &Perl_Raid_IsLeader);
package.add("IsRaidMember", &Perl_Raid_IsRaidMember);
package.add("RaidCount", &Perl_Raid_RaidCount);
package.add("SplitExp", &Perl_Raid_SplitExp);
package.add("SplitMoney", &Perl_Raid_SplitMoney);
package.add("TeleportGroup", &Perl_Raid_TeleportGroup);
package.add("TeleportRaid", &Perl_Raid_TeleportRaid);
}
#endif //EMBPERL_XS_CLASSES

2788
zone/perl_spell.cpp
View File

File diff suppressed because it is too large Load Diff