1#![allow(non_snake_case)]
2
3use super::libperl_sys::*;
4
5use std::ptr;
6use std::ffi::CString;
7use std::os::raw::{c_char, c_int};
8use std::env;
9
10#[cfg(perl_useithreads)]
11#[macro_export]
12macro_rules! perl_api {
13 ($name:ident ($my_perl:expr $(, $arg:expr)*) $(as $t:ty)*) => {
14 $name($my_perl, $($arg),*) $(as $t)*
15 }
16}
17
18#[cfg(not(perl_useithreads))]
19#[macro_export]
20macro_rules! perl_api {
21 ($name:ident ($my_perl:expr $(, $arg:expr)*) $(as $t:ty)*) => {
22 $name($($arg),*) $(as $t)*
23 }
24}
25
26#[cfg(perl_useithreads)]
27#[macro_export]
28macro_rules! unsafe_perl_api {
29 ($name:ident ($my_perl:expr $(, $arg:expr)*) $(as $t:ty)*) => {
30 unsafe {$name($my_perl, $($arg),*) $(as $t)*}
31 }
32}
33
34#[cfg(not(perl_useithreads))]
35#[macro_export]
36macro_rules! unsafe_perl_api {
37 ($name:ident ($my_perl:expr $(, $arg:expr)*) $(as $t:ty)*) => {
38 unsafe {$name($($arg),*) $(as $t)*}
39 }
40}
41
42
43pub struct Perl {
44 debug: bool,
45 args: Vec<CString>,
46 env: Vec<CString>,
47 pub my_perl: *mut PerlInterpreter,
48}
49
50impl Drop for Perl {
51 fn drop(&mut self) {
52 if self.debug {
53 println!("destructuring my perl");
54 }
55 unsafe { perl_destruct(self.my_perl) };
56 }
57}
58
59extern "C" {
60 #[cfg(perl_useithreads)]
61 fn boot_DynaLoader(perl: *mut PerlInterpreter, cv: *mut CV);
62 #[cfg(not(perl_useithreads))]
63 fn boot_DynaLoader(cv: *mut CV);
64}
65
66#[allow(non_camel_case_types)]
67#[cfg(perl_useithreads)]
68type xsinit_type = extern "C" fn(*mut PerlInterpreter) -> ();
69
70#[allow(non_camel_case_types)]
71#[cfg(not(perl_useithreads))]
72type xsinit_type = extern "C" fn() -> ();
73
74#[cfg(perl_useithreads)]
75pub fn newXS(perl: *mut PerlInterpreter, name: &str, xsub: XSUBADDR_t, filename: &str) -> *mut CV {
76 let name = CString::new(name).unwrap();
77 let filename = CString::new(filename).unwrap();
78 unsafe {Perl_newXS(perl, name.as_ptr(), xsub, filename.as_ptr())}
79}
80
81#[cfg(not(perl_useithreads))]
82pub fn newXS(name: &str, xsub: XSUBADDR_t, filename: &str) -> *mut CV {
83 let name = CString::new(name).unwrap();
84 let filename = CString::new(filename).unwrap();
85 unsafe {Perl_newXS(name.as_ptr(), xsub, filename.as_ptr())}
86}
87
88#[cfg(perl_useithreads)]
89pub extern "C" fn xs_init(perl: *mut PerlInterpreter) {
90 newXS(perl, "DynaLoader::boot_DynaLoader", Some(boot_DynaLoader), file!());
91}
92
93#[cfg(not(perl_useithreads))]
94pub extern "C" fn xs_init() {
95 newXS("DynaLoader::boot_DynaLoader", Some(boot_DynaLoader), file!());
96}
97
98impl Perl {
99
100 pub fn new() -> Perl {
101 let perl = unsafe {perl_alloc()};
102 unsafe {perl_construct(perl)};
103 return Perl {
104 args: Vec::new(),
105 env: Vec::new(),
106 my_perl: perl,
107 debug: false,
108 }
109 }
110
111 #[cfg(perl_useithreads)]
112 pub fn my_perl(&self) -> &mut PerlInterpreter {
113 unsafe {self.my_perl.as_mut().unwrap()}
114 }
115
116 pub fn parse<S: AsRef<str>>(&mut self, args: &[S], envp: &[S]) -> i32 {
117 self.args = args.iter().map(|arg| CString::new(arg.as_ref()).unwrap())
118 .collect::<Vec<CString>>();
119 self.env = envp.iter().map(|arg| CString::new(arg.as_ref()).unwrap())
120 .collect::<Vec<CString>>();
121
122 self.perl_parse_1()
123 }
124
125 pub fn parse_env_args(&mut self, args: env::Args, envp: env::Vars) -> i32 {
126 self.args = args.map(|arg| CString::new(arg).unwrap())
127 .collect::<Vec<CString>>();
128 self.env = envp.map(| (key, value) | CString::new(
129 String::from(&[key, value].join("="))
130 ).unwrap()).collect::<Vec<CString>>();
131
132 self.perl_parse_1()
133 }
134
135 fn perl_parse_1(&mut self) -> i32 {
136 unsafe {
137 perl_parse(
138 self.my_perl,
139 Some(xs_init as xsinit_type),
140 self.args.len() as c_int,
141 make_argv_from_vec(&self.args)
142 .as_ptr() as *mut *mut c_char,
143 ensure_terminating_null(make_argv_from_vec(&self.env))
144 .as_ptr() as *mut *mut c_char,
145 )
146 }
147 }
148
149 pub fn hv_iterinit(&self, hv: *mut HV) -> i32 {
150 unsafe {perl_api!{Perl_hv_iterinit(self.my_perl, hv)}}
151 }
152
153 pub fn hv_iternext(&self, hv: *mut HV) -> *mut HE {
154 unsafe {perl_api!{Perl_hv_iternext_flags(self.my_perl, hv, 0)}}
155 }
156
157 pub fn hv_iterkey(&self, he: *mut HE) -> String {
158 let (name, nlen) = self._hv_iterkey(he);
159 let slice = unsafe {std::slice::from_raw_parts(name, nlen)};
160 String::from_utf8(slice.to_vec()).unwrap()
161 }
162
163 pub fn _hv_iterkey(&self, he: *mut HE) -> (*const u8, usize) {
164 let mut nlen: i32 = 0;
165 let name = unsafe {perl_api!{Perl_hv_iterkey(self.my_perl, he, &mut nlen) as *const u8}};
166 (name, nlen as usize)
167 }
168
169 pub fn hv_iterval<'a>(&self, hv: *mut HV, he: *mut HE) -> *mut SV {
170 unsafe {perl_api!{Perl_hv_iterval(self.my_perl, hv, he)}}
171 }
172
173 #[cfg(perl_useithreads)]
174 pub fn get_defstash(&self) -> *mut HV {
175 unsafe {*self.my_perl}.Idefstash
176 }
177 #[cfg(not(perl_useithreads))]
178 pub fn get_defstash(&self) -> *mut HV {
179 unsafe {libperl_sys::PL_defstash}
180 }
181
182 pub fn gv_stashpv(&self, name: &str, flags: i32) -> *mut HV {
183 let name = CString::new(name).unwrap();
184 unsafe {perl_api!{Perl_gv_stashpv(self.my_perl, name.as_ptr(), flags)}}
185 }
186
187 #[cfg(perl_useithreads)]
188 pub fn get_main_root(&self) -> *const op {
189 unsafe {*self.my_perl}.Imain_root
190 }
191
192 #[cfg(not(perl_useithreads))]
193 pub fn get_main_root(&self) -> *const op {
194 unsafe {libperl_sys::PL_main_root}
195 }
196
197 #[cfg(perl_useithreads)]
198 pub fn get_main_cv(&self) -> *const cv {
199 unsafe {*self.my_perl}.Imain_cv
200 }
201
202 #[cfg(not(perl_useithreads))]
203 pub fn get_main_cv(&self) -> *const cv {
204 unsafe {libperl_sys::PL_main_cv}
205 }
206
207 #[cfg(all(perlapi_ver26))]
208 pub fn op_class(&self, o: *const OP) -> OPclass {
209 unsafe {perl_api!{Perl_op_class(self.my_perl, o)}}
210 }
211
212 pub fn get_sv(&self, name: &str, flags: i32) -> *mut SV {
213 let name = CString::new(name).unwrap();
214 unsafe {perl_api!{Perl_get_sv(self.my_perl, name.as_ptr(), flags)}}
215 }
216
217 pub fn str2svpv_flags(&self, buffer: &str, flags: u32) -> *mut SV {
218 let cstr = CString::new(buffer).unwrap();
219 unsafe {
220 perl_api!{Perl_newSVpvn_flags(
221 self.my_perl,
222 cstr.as_ptr(),
223 buffer.len(),
224 SVf_UTF8 | flags
225 )}
226 }
227 }
228
229 pub fn str2svpv_mortal(&self, buffer: &str) -> *mut SV {
230 self.str2svpv_flags(buffer, SVs_TEMP)
231 }
232
233 #[cfg(perl_useithreads)]
234 pub fn pushmark(&self, sp: *mut *mut SV) {
235 let my_perl = self.my_perl();
236 unsafe {
237 my_perl.Imarkstack_ptr = my_perl.Imarkstack_ptr.add(1)
238 };
239 if my_perl.Imarkstack_ptr == my_perl.Imarkstack_max {
240 unsafe_perl_api!{Perl_markstack_grow(my_perl)};
241 }
242 unsafe {
243 *(my_perl.Imarkstack_ptr)
244 = (sp as usize - my_perl.Istack_base as usize) as i32;
245 }
246 }
247
248 #[cfg(perl_useithreads)]
249 pub fn free_tmps(&self) {
250 let my_perl = self.my_perl();
251 if my_perl.Itmps_ix > my_perl.Itmps_floor {
252 unsafe_perl_api!{Perl_free_tmps(self.my_perl)}
253 }
254 }
255}
256
257#[macro_export]
258macro_rules! sp_push {
259 ($sp:ident, $sv_expr:expr) => {
260 let sv = $sv_expr;
261 unsafe {
262 $sp = $sp.add(1);
263 *$sp = sv;
264 }
265 }
266}
267
268pub fn get_cvstash(cv: *const CV) -> *mut HV {
269 let xpvcv = unsafe {*cv}.sv_any;
270 unsafe {*xpvcv}.xcv_stash
271}
272
273pub fn make_argv_from_vec(args: &Vec<CString>) -> Vec<*mut c_char> {
274 args.iter().map(|arg| arg.as_ptr() as *mut c_char)
275 .collect::<Vec<*mut c_char>>()
276}
277
278pub fn ensure_terminating_null(mut args: Vec<*mut c_char>) -> Vec<*mut c_char> {
279 if args.len() == 0 || args.last() != None {
280 args.push(ptr::null_mut());
281 }
282 args
283}