File: Check.xs

package info (click to toggle)
libb-hooks-op-check-perl 0.17-1
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 308 kB
  • ctags: 819
  • sloc: perl: 1,163; makefile: 15; ansic: 10
file content (127 lines) | stat: -rw-r--r-- 2,099 bytes parent folder | download
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
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "hook_op_check.h"

typedef OP *(*orig_check_t) (pTHX_ OP *op);

STATIC orig_check_t orig_PL_check[OP_max];
STATIC AV *check_cbs[OP_max];

#define run_orig_check(type, op) (CALL_FPTR (orig_PL_check[(type)])(aTHX_ op))

STATIC UV initialized = 0;

STATIC void *
get_mg_ptr (SV *sv) {
	MAGIC *mg;

	if ((mg = mg_find (sv, PERL_MAGIC_ext))) {
		return mg->mg_ptr;
	}

	return NULL;
}

STATIC void
setup () {
	if (initialized) {
		return;
	}

	initialized = 1;

	Copy (PL_check, orig_PL_check, OP_max, hook_op_check_cb);
	Zero (check_cbs, OP_max, AV *);
}

STATIC OP *
check_cb (pTHX_ OP *op) {
	I32 i;
	AV *hooks = check_cbs[op->op_type];
	OP *ret = run_orig_check (op->op_type, op);

	if (!hooks) {
		return ret;
	}

	for (i = 0; i <= av_len (hooks); i++) {
		hook_op_check_cb cb;
		void *user_data;
		SV **hook = av_fetch (hooks, i, 0);

		if (!hook || !*hook) {
			continue;
		}

		user_data = get_mg_ptr (*hook);

		cb = INT2PTR (hook_op_check_cb, SvUV (*hook));
		ret = CALL_FPTR (cb)(aTHX_ ret, user_data);
	}

	return ret;
}

hook_op_check_id
hook_op_check (opcode type, hook_op_check_cb cb, void *user_data) {
	AV *hooks;
	SV *hook;

	if (!initialized) {
		setup ();
	}

	hooks = check_cbs[type];

	if (!hooks) {
		hooks = newAV ();
		check_cbs[type] = hooks;
		PL_check[type] = check_cb;
	}

	hook = newSVuv (PTR2UV (cb));
	sv_magic (hook, NULL, PERL_MAGIC_ext, (const char *)user_data, 0);
	av_push (hooks, hook);

	return (hook_op_check_id)PTR2UV (hook);
}

void *
hook_op_check_remove (opcode type, hook_op_check_id id) {
	AV *hooks;
	I32 i;
	void *ret = NULL;

	if (!initialized) {
		return NULL;
	}

	hooks = check_cbs[type];

	if (!hooks) {
		return NULL;
	}

	for (i = 0; i <= av_len (hooks); i++) {
		SV **hook = av_fetch (hooks, i, 0);

		if (!hook || !*hook) {
			continue;
		}

		if ((hook_op_check_id)PTR2UV (*hook) == id) {
			ret = get_mg_ptr (*hook);
			av_delete (hooks, i, G_DISCARD);
		}
	}

	return ret;
}

MODULE = B::Hooks::OP::Check  PACKAGE = B::Hooks::OP::Check

PROTOTYPES: DISABLE