1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include "ppport.h"
6
7 #if PERL_BCDVERSION < 0x5010001
8 typedef unsigned Optype;
9 #endif /* <5.10.1 */
10
11 #ifndef wrap_op_checker
12 # define wrap_op_checker(c,n,o) THX_wrap_op_checker(aTHX_ c,n,o)
THX_wrap_op_checker(pTHX_ Optype opcode,Perl_check_t new_checker,Perl_check_t * old_checker_p)13 static void THX_wrap_op_checker(pTHX_ Optype opcode,
14 Perl_check_t new_checker, Perl_check_t *old_checker_p)
15 {
16 if(*old_checker_p) return;
17 OP_REFCNT_LOCK;
18 if(!*old_checker_p) {
19 *old_checker_p = PL_check[opcode];
20 PL_check[opcode] = new_checker;
21 }
22 OP_REFCNT_UNLOCK;
23 }
24 #endif /* !wrap_op_checker */
25
26 #include "hook_op_check.h"
27
28 STATIC Perl_check_t orig_PL_check[OP_max];
29 STATIC AV *check_cbs[OP_max];
30
31 #define run_orig_check(type, op) (CALL_FPTR (orig_PL_check[(type)])(aTHX_ op))
32
33 STATIC void *
get_mg_ptr(SV * sv)34 get_mg_ptr (SV *sv) {
35 MAGIC *mg;
36
37 if ((mg = mg_find (sv, PERL_MAGIC_ext))) {
38 return mg->mg_ptr;
39 }
40
41 return NULL;
42 }
43
44 STATIC OP *
check_cb(pTHX_ OP * op)45 check_cb (pTHX_ OP *op) {
46 I32 i;
47 AV *hooks = check_cbs[op->op_type];
48 OP *ret = run_orig_check (op->op_type, op);
49
50 if (!hooks) {
51 return ret;
52 }
53
54 for (i = 0; i <= av_len (hooks); i++) {
55 hook_op_check_cb cb;
56 void *user_data;
57 SV **hook = av_fetch (hooks, i, 0);
58
59 if (!hook || !*hook) {
60 continue;
61 }
62
63 user_data = get_mg_ptr (*hook);
64
65 cb = INT2PTR (hook_op_check_cb, SvUV (*hook));
66 ret = CALL_FPTR (cb)(aTHX_ ret, user_data);
67 }
68
69 return ret;
70 }
71
72 hook_op_check_id
hook_op_check(opcode type,hook_op_check_cb cb,void * user_data)73 hook_op_check (opcode type, hook_op_check_cb cb, void *user_data) {
74 AV *hooks;
75 SV *hook;
76
77 hooks = check_cbs[type];
78
79 if (!hooks) {
80 hooks = newAV ();
81 check_cbs[type] = hooks;
82 wrap_op_checker(type, check_cb, &orig_PL_check[type]);
83 }
84
85 hook = newSVuv (PTR2UV (cb));
86 sv_magic (hook, NULL, PERL_MAGIC_ext, (const char *)user_data, 0);
87 av_push (hooks, hook);
88
89 return (hook_op_check_id)PTR2UV (hook);
90 }
91
92 void *
hook_op_check_remove(opcode type,hook_op_check_id id)93 hook_op_check_remove (opcode type, hook_op_check_id id) {
94 AV *hooks;
95 I32 i;
96 void *ret = NULL;
97
98 hooks = check_cbs[type];
99
100 if (!hooks) {
101 return NULL;
102 }
103
104 for (i = 0; i <= av_len (hooks); i++) {
105 SV **hook = av_fetch (hooks, i, 0);
106
107 if (!hook || !*hook) {
108 continue;
109 }
110
111 if ((hook_op_check_id)PTR2UV (*hook) == id) {
112 ret = get_mg_ptr (*hook);
113 av_delete (hooks, i, G_DISCARD);
114 }
115 }
116
117 return ret;
118 }
119
120 MODULE = B::Hooks::OP::Check PACKAGE = B::Hooks::OP::Check
121
122 PROTOTYPES: DISABLE
123