-
Notifications
You must be signed in to change notification settings - Fork 404
/
embperl.h
150 lines (119 loc) · 3.4 KB
/
embperl.h
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
/*
Embperl.h
---------------
eqemu perl wrapper
Eglin
*/
#ifndef EMBPERL_H
#define EMBPERL_H
#ifdef EMBPERL
#include "zone_config.h"
#include <string>
#include <vector>
#include <map>
#include <stdio.h>
#include <string.h>
// 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;
#undef Null
#ifdef WIN32
#define snprintf _snprintf
#endif
//perl defines these macros and dosent clean them up, lazy bastards. -- I hate them too!
#ifdef Copy
#undef Copy
#endif
#ifdef list
#undef list
#endif
#ifdef write
#undef write
#endif
#ifdef bool
#undef bool
#endif
#ifdef Zero
#undef Zero
#endif
//These need to be cleaned up on FreeBSD
#ifdef __FreeBSD__
#ifdef do_open
#undef do_open
#endif
#ifdef do_close
#undef do_close
#endif
#endif
//so embedded scripts can use xs extensions (ala 'use socket;')
EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
EXTERN_C void xs_init(pTHX);
extern const ZoneConfig *Config;
class Embperl
{
private:
//if we fail inside a script evaluation, this will hold the croak msg (not much help if we die during construction, but that's our own fault)
mutable std::string errmsg;
//install a perl func
void init_eval_file(void);
bool in_use; //true if perl is executing
protected:
//the embedded interpreter
PerlInterpreter * my_perl;
void DoInit();
public:
Embperl(void); //This can throw errors! Buyer beware
~Embperl(void);
void Reinit();
//evaluate an expression. throws string errors on fail
int eval(const char * code);
//execute a subroutine. throws lasterr on failure
int dosub(const char * subname, const std::vector<std::string> * args = nullptr, int mode = G_SCALAR|G_EVAL);
//put an integer into a perl varable
void seti(const char *varname, int val) const {
SV *t = get_sv(varname, true);
sv_setiv(t, val);
}
//put a real into a perl varable
void setd(const char *varname, float val) const {
SV *t = get_sv(varname, true);
sv_setnv(t, val);
}
//put a string into a perl varable
void setstr(const char *varname, const char *val) const {
SV *t = get_sv(varname, true);
sv_setpv(t, val);
}
// put a pointer into a blessed perl variable
void setptr(const char* varname, const char* classname, void* val) const {
SV* t = get_sv(varname, GV_ADD);
sv_setref_pv(t, classname, val);
}
// put key-value pairs in hash
void sethash(const char *varname, std::map<std::string,std::string> &vals)
{
std::map<std::string,std::string>::iterator it;
// Get hash and clear it.
HV *hv = get_hv(varname, TRUE);
hv_clear(hv);
// Iterate through key-value pairs, storing them in hash
for (it = vals.begin(); it != vals.end(); ++it)
{
int keylen = static_cast<int>(it->first.length());
SV *val = newSVpv(it->second.c_str(), it->second.length());
// If val was not added to hash, reset reference count
if (hv_store(hv, it->first.c_str(), keylen, val, 0) == nullptr)
val->sv_refcnt = 0;
}
}
//loads a file and compiles it into our interpreter (assuming it hasn't already been read in)
//idea borrowed from perlembed
int eval_file(const char * packagename, const char * filename);
//check to see if a sub exists in package
bool SubExists(const char *package, const char *sub);
};
#endif //EMBPERL
#endif //EMBPERL_H