mirror of
https://github.com/EQEmu/Server.git
synced 2025-12-12 17:51:28 +00:00
79 lines
2.0 KiB
C++
79 lines
2.0 KiB
C++
#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
|