diff options
Diffstat (limited to 'tools/perf/util/trace-event-perl.c')
-rw-r--r-- | tools/perf/util/trace-event-perl.c | 598 |
1 files changed, 598 insertions, 0 deletions
diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c new file mode 100644 index 000000000000..51e833fd58c3 --- /dev/null +++ b/tools/perf/util/trace-event-perl.c | |||
@@ -0,0 +1,598 @@ | |||
1 | /* | ||
2 | * trace-event-perl. Feed perf trace events to an embedded Perl interpreter. | ||
3 | * | ||
4 | * Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com> | ||
5 | * | ||
6 | * This program is free software; you can redistribute it and/or modify | ||
7 | * it under the terms of the GNU General Public License as published by | ||
8 | * the Free Software Foundation; either version 2 of the License, or | ||
9 | * (at your option) any later version. | ||
10 | * | ||
11 | * This program is distributed in the hope that it will be useful, | ||
12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
14 | * GNU General Public License for more details. | ||
15 | * | ||
16 | * You should have received a copy of the GNU General Public License | ||
17 | * along with this program; if not, write to the Free Software | ||
18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | ||
19 | * | ||
20 | */ | ||
21 | |||
22 | #include <stdio.h> | ||
23 | #include <stdlib.h> | ||
24 | #include <string.h> | ||
25 | #include <ctype.h> | ||
26 | #include <errno.h> | ||
27 | |||
28 | #include "../perf.h" | ||
29 | #include "util.h" | ||
30 | #include "trace-event.h" | ||
31 | #include "trace-event-perl.h" | ||
32 | |||
33 | void xs_init(pTHX); | ||
34 | |||
35 | void boot_Perf__Trace__Context(pTHX_ CV *cv); | ||
36 | void boot_DynaLoader(pTHX_ CV *cv); | ||
37 | |||
38 | void xs_init(pTHX) | ||
39 | { | ||
40 | const char *file = __FILE__; | ||
41 | dXSUB_SYS; | ||
42 | |||
43 | newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context, | ||
44 | file); | ||
45 | newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); | ||
46 | } | ||
47 | |||
48 | INTERP my_perl; | ||
49 | |||
50 | #define FTRACE_MAX_EVENT \ | ||
51 | ((1 << (sizeof(unsigned short) * 8)) - 1) | ||
52 | |||
53 | struct event *events[FTRACE_MAX_EVENT]; | ||
54 | |||
55 | static struct scripting_context *scripting_context; | ||
56 | |||
57 | static char *cur_field_name; | ||
58 | static int zero_flag_atom; | ||
59 | |||
60 | static void define_symbolic_value(const char *ev_name, | ||
61 | const char *field_name, | ||
62 | const char *field_value, | ||
63 | const char *field_str) | ||
64 | { | ||
65 | unsigned long long value; | ||
66 | dSP; | ||
67 | |||
68 | value = eval_flag(field_value); | ||
69 | |||
70 | ENTER; | ||
71 | SAVETMPS; | ||
72 | PUSHMARK(SP); | ||
73 | |||
74 | XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); | ||
75 | XPUSHs(sv_2mortal(newSVpv(field_name, 0))); | ||
76 | XPUSHs(sv_2mortal(newSVuv(value))); | ||
77 | XPUSHs(sv_2mortal(newSVpv(field_str, 0))); | ||
78 | |||
79 | PUTBACK; | ||
80 | if (get_cv("main::define_symbolic_value", 0)) | ||
81 | call_pv("main::define_symbolic_value", G_SCALAR); | ||
82 | SPAGAIN; | ||
83 | PUTBACK; | ||
84 | FREETMPS; | ||
85 | LEAVE; | ||
86 | } | ||
87 | |||
88 | static void define_symbolic_values(struct print_flag_sym *field, | ||
89 | const char *ev_name, | ||
90 | const char *field_name) | ||
91 | { | ||
92 | define_symbolic_value(ev_name, field_name, field->value, field->str); | ||
93 | if (field->next) | ||
94 | define_symbolic_values(field->next, ev_name, field_name); | ||
95 | } | ||
96 | |||
97 | static void define_symbolic_field(const char *ev_name, | ||
98 | const char *field_name) | ||
99 | { | ||
100 | dSP; | ||
101 | |||
102 | ENTER; | ||
103 | SAVETMPS; | ||
104 | PUSHMARK(SP); | ||
105 | |||
106 | XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); | ||
107 | XPUSHs(sv_2mortal(newSVpv(field_name, 0))); | ||
108 | |||
109 | PUTBACK; | ||
110 | if (get_cv("main::define_symbolic_field", 0)) | ||
111 | call_pv("main::define_symbolic_field", G_SCALAR); | ||
112 | SPAGAIN; | ||
113 | PUTBACK; | ||
114 | FREETMPS; | ||
115 | LEAVE; | ||
116 | } | ||
117 | |||
118 | static void define_flag_value(const char *ev_name, | ||
119 | const char *field_name, | ||
120 | const char *field_value, | ||
121 | const char *field_str) | ||
122 | { | ||
123 | unsigned long long value; | ||
124 | dSP; | ||
125 | |||
126 | value = eval_flag(field_value); | ||
127 | |||
128 | ENTER; | ||
129 | SAVETMPS; | ||
130 | PUSHMARK(SP); | ||
131 | |||
132 | XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); | ||
133 | XPUSHs(sv_2mortal(newSVpv(field_name, 0))); | ||
134 | XPUSHs(sv_2mortal(newSVuv(value))); | ||
135 | XPUSHs(sv_2mortal(newSVpv(field_str, 0))); | ||
136 | |||
137 | PUTBACK; | ||
138 | if (get_cv("main::define_flag_value", 0)) | ||
139 | call_pv("main::define_flag_value", G_SCALAR); | ||
140 | SPAGAIN; | ||
141 | PUTBACK; | ||
142 | FREETMPS; | ||
143 | LEAVE; | ||
144 | } | ||
145 | |||
146 | static void define_flag_values(struct print_flag_sym *field, | ||
147 | const char *ev_name, | ||
148 | const char *field_name) | ||
149 | { | ||
150 | define_flag_value(ev_name, field_name, field->value, field->str); | ||
151 | if (field->next) | ||
152 | define_flag_values(field->next, ev_name, field_name); | ||
153 | } | ||
154 | |||
155 | static void define_flag_field(const char *ev_name, | ||
156 | const char *field_name, | ||
157 | const char *delim) | ||
158 | { | ||
159 | dSP; | ||
160 | |||
161 | ENTER; | ||
162 | SAVETMPS; | ||
163 | PUSHMARK(SP); | ||
164 | |||
165 | XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); | ||
166 | XPUSHs(sv_2mortal(newSVpv(field_name, 0))); | ||
167 | XPUSHs(sv_2mortal(newSVpv(delim, 0))); | ||
168 | |||
169 | PUTBACK; | ||
170 | if (get_cv("main::define_flag_field", 0)) | ||
171 | call_pv("main::define_flag_field", G_SCALAR); | ||
172 | SPAGAIN; | ||
173 | PUTBACK; | ||
174 | FREETMPS; | ||
175 | LEAVE; | ||
176 | } | ||
177 | |||
178 | static void define_event_symbols(struct event *event, | ||
179 | const char *ev_name, | ||
180 | struct print_arg *args) | ||
181 | { | ||
182 | switch (args->type) { | ||
183 | case PRINT_NULL: | ||
184 | break; | ||
185 | case PRINT_ATOM: | ||
186 | define_flag_value(ev_name, cur_field_name, "0", | ||
187 | args->atom.atom); | ||
188 | zero_flag_atom = 0; | ||
189 | break; | ||
190 | case PRINT_FIELD: | ||
191 | if (cur_field_name) | ||
192 | free(cur_field_name); | ||
193 | cur_field_name = strdup(args->field.name); | ||
194 | break; | ||
195 | case PRINT_FLAGS: | ||
196 | define_event_symbols(event, ev_name, args->flags.field); | ||
197 | define_flag_field(ev_name, cur_field_name, args->flags.delim); | ||
198 | define_flag_values(args->flags.flags, ev_name, cur_field_name); | ||
199 | break; | ||
200 | case PRINT_SYMBOL: | ||
201 | define_event_symbols(event, ev_name, args->symbol.field); | ||
202 | define_symbolic_field(ev_name, cur_field_name); | ||
203 | define_symbolic_values(args->symbol.symbols, ev_name, | ||
204 | cur_field_name); | ||
205 | break; | ||
206 | case PRINT_STRING: | ||
207 | break; | ||
208 | case PRINT_TYPE: | ||
209 | define_event_symbols(event, ev_name, args->typecast.item); | ||
210 | break; | ||
211 | case PRINT_OP: | ||
212 | if (strcmp(args->op.op, ":") == 0) | ||
213 | zero_flag_atom = 1; | ||
214 | define_event_symbols(event, ev_name, args->op.left); | ||
215 | define_event_symbols(event, ev_name, args->op.right); | ||
216 | break; | ||
217 | default: | ||
218 | /* we should warn... */ | ||
219 | return; | ||
220 | } | ||
221 | |||
222 | if (args->next) | ||
223 | define_event_symbols(event, ev_name, args->next); | ||
224 | } | ||
225 | |||
226 | static inline struct event *find_cache_event(int type) | ||
227 | { | ||
228 | static char ev_name[256]; | ||
229 | struct event *event; | ||
230 | |||
231 | if (events[type]) | ||
232 | return events[type]; | ||
233 | |||
234 | events[type] = event = trace_find_event(type); | ||
235 | if (!event) | ||
236 | return NULL; | ||
237 | |||
238 | sprintf(ev_name, "%s::%s", event->system, event->name); | ||
239 | |||
240 | define_event_symbols(event, ev_name, event->print_fmt.args); | ||
241 | |||
242 | return event; | ||
243 | } | ||
244 | |||
245 | int common_pc(struct scripting_context *context) | ||
246 | { | ||
247 | int pc; | ||
248 | |||
249 | pc = parse_common_pc(context->event_data); | ||
250 | |||
251 | return pc; | ||
252 | } | ||
253 | |||
254 | int common_flags(struct scripting_context *context) | ||
255 | { | ||
256 | int flags; | ||
257 | |||
258 | flags = parse_common_flags(context->event_data); | ||
259 | |||
260 | return flags; | ||
261 | } | ||
262 | |||
263 | int common_lock_depth(struct scripting_context *context) | ||
264 | { | ||
265 | int lock_depth; | ||
266 | |||
267 | lock_depth = parse_common_lock_depth(context->event_data); | ||
268 | |||
269 | return lock_depth; | ||
270 | } | ||
271 | |||
272 | static void perl_process_event(int cpu, void *data, | ||
273 | int size __attribute((unused)), | ||
274 | unsigned long long nsecs, char *comm) | ||
275 | { | ||
276 | struct format_field *field; | ||
277 | static char handler[256]; | ||
278 | unsigned long long val; | ||
279 | unsigned long s, ns; | ||
280 | struct event *event; | ||
281 | int type; | ||
282 | int pid; | ||
283 | |||
284 | dSP; | ||
285 | |||
286 | type = trace_parse_common_type(data); | ||
287 | |||
288 | event = find_cache_event(type); | ||
289 | if (!event) | ||
290 | die("ug! no event found for type %d", type); | ||
291 | |||
292 | pid = trace_parse_common_pid(data); | ||
293 | |||
294 | sprintf(handler, "%s::%s", event->system, event->name); | ||
295 | |||
296 | s = nsecs / NSECS_PER_SEC; | ||
297 | ns = nsecs - s * NSECS_PER_SEC; | ||
298 | |||
299 | scripting_context->event_data = data; | ||
300 | |||
301 | ENTER; | ||
302 | SAVETMPS; | ||
303 | PUSHMARK(SP); | ||
304 | |||
305 | XPUSHs(sv_2mortal(newSVpv(handler, 0))); | ||
306 | XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context)))); | ||
307 | XPUSHs(sv_2mortal(newSVuv(cpu))); | ||
308 | XPUSHs(sv_2mortal(newSVuv(s))); | ||
309 | XPUSHs(sv_2mortal(newSVuv(ns))); | ||
310 | XPUSHs(sv_2mortal(newSViv(pid))); | ||
311 | XPUSHs(sv_2mortal(newSVpv(comm, 0))); | ||
312 | |||
313 | /* common fields other than pid can be accessed via xsub fns */ | ||
314 | |||
315 | for (field = event->format.fields; field; field = field->next) { | ||
316 | if (field->flags & FIELD_IS_STRING) { | ||
317 | int offset; | ||
318 | if (field->flags & FIELD_IS_DYNAMIC) { | ||
319 | offset = *(int *)(data + field->offset); | ||
320 | offset &= 0xffff; | ||
321 | } else | ||
322 | offset = field->offset; | ||
323 | XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0))); | ||
324 | } else { /* FIELD_IS_NUMERIC */ | ||
325 | val = read_size(data + field->offset, field->size); | ||
326 | if (field->flags & FIELD_IS_SIGNED) { | ||
327 | XPUSHs(sv_2mortal(newSViv(val))); | ||
328 | } else { | ||
329 | XPUSHs(sv_2mortal(newSVuv(val))); | ||
330 | } | ||
331 | } | ||
332 | } | ||
333 | |||
334 | PUTBACK; | ||
335 | |||
336 | if (get_cv(handler, 0)) | ||
337 | call_pv(handler, G_SCALAR); | ||
338 | else if (get_cv("main::trace_unhandled", 0)) { | ||
339 | XPUSHs(sv_2mortal(newSVpv(handler, 0))); | ||
340 | XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context)))); | ||
341 | XPUSHs(sv_2mortal(newSVuv(cpu))); | ||
342 | XPUSHs(sv_2mortal(newSVuv(nsecs))); | ||
343 | XPUSHs(sv_2mortal(newSViv(pid))); | ||
344 | XPUSHs(sv_2mortal(newSVpv(comm, 0))); | ||
345 | call_pv("main::trace_unhandled", G_SCALAR); | ||
346 | } | ||
347 | SPAGAIN; | ||
348 | PUTBACK; | ||
349 | FREETMPS; | ||
350 | LEAVE; | ||
351 | } | ||
352 | |||
353 | static void run_start_sub(void) | ||
354 | { | ||
355 | dSP; /* access to Perl stack */ | ||
356 | PUSHMARK(SP); | ||
357 | |||
358 | if (get_cv("main::trace_begin", 0)) | ||
359 | call_pv("main::trace_begin", G_DISCARD | G_NOARGS); | ||
360 | } | ||
361 | |||
362 | /* | ||
363 | * Start trace script | ||
364 | */ | ||
365 | static int perl_start_script(const char *script) | ||
366 | { | ||
367 | const char *command_line[2] = { "", NULL }; | ||
368 | |||
369 | command_line[1] = script; | ||
370 | |||
371 | my_perl = perl_alloc(); | ||
372 | perl_construct(my_perl); | ||
373 | |||
374 | if (perl_parse(my_perl, xs_init, 2, (char **)command_line, | ||
375 | (char **)NULL)) | ||
376 | return -1; | ||
377 | |||
378 | perl_run(my_perl); | ||
379 | if (SvTRUE(ERRSV)) | ||
380 | return -1; | ||
381 | |||
382 | run_start_sub(); | ||
383 | |||
384 | fprintf(stderr, "perf trace started with Perl script %s\n\n", script); | ||
385 | |||
386 | return 0; | ||
387 | } | ||
388 | |||
389 | /* | ||
390 | * Stop trace script | ||
391 | */ | ||
392 | static int perl_stop_script(void) | ||
393 | { | ||
394 | dSP; /* access to Perl stack */ | ||
395 | PUSHMARK(SP); | ||
396 | |||
397 | if (get_cv("main::trace_end", 0)) | ||
398 | call_pv("main::trace_end", G_DISCARD | G_NOARGS); | ||
399 | |||
400 | perl_destruct(my_perl); | ||
401 | perl_free(my_perl); | ||
402 | |||
403 | fprintf(stderr, "\nperf trace Perl script stopped\n"); | ||
404 | |||
405 | return 0; | ||
406 | } | ||
407 | |||
408 | static int perl_generate_script(const char *outfile) | ||
409 | { | ||
410 | struct event *event = NULL; | ||
411 | struct format_field *f; | ||
412 | char fname[PATH_MAX]; | ||
413 | int not_first, count; | ||
414 | FILE *ofp; | ||
415 | |||
416 | sprintf(fname, "%s.pl", outfile); | ||
417 | ofp = fopen(fname, "w"); | ||
418 | if (ofp == NULL) { | ||
419 | fprintf(stderr, "couldn't open %s\n", fname); | ||
420 | return -1; | ||
421 | } | ||
422 | |||
423 | fprintf(ofp, "# perf trace event handlers, " | ||
424 | "generated by perf trace -g perl\n"); | ||
425 | |||
426 | fprintf(ofp, "# Licensed under the terms of the GNU GPL" | ||
427 | " License version 2\n\n"); | ||
428 | |||
429 | fprintf(ofp, "# The common_* event handler fields are the most useful " | ||
430 | "fields common to\n"); | ||
431 | |||
432 | fprintf(ofp, "# all events. They don't necessarily correspond to " | ||
433 | "the 'common_*' fields\n"); | ||
434 | |||
435 | fprintf(ofp, "# in the format files. Those fields not available as " | ||
436 | "handler params can\n"); | ||
437 | |||
438 | fprintf(ofp, "# be retrieved using Perl functions of the form " | ||
439 | "common_*($context).\n"); | ||
440 | |||
441 | fprintf(ofp, "# See Context.pm for the list of available " | ||
442 | "functions.\n\n"); | ||
443 | |||
444 | fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/" | ||
445 | "Perf-Trace-Util/lib\";\n"); | ||
446 | |||
447 | fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n"); | ||
448 | fprintf(ofp, "use Perf::Trace::Core;\n"); | ||
449 | fprintf(ofp, "use Perf::Trace::Context;\n"); | ||
450 | fprintf(ofp, "use Perf::Trace::Util;\n\n"); | ||
451 | |||
452 | fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n"); | ||
453 | fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n"); | ||
454 | |||
455 | while ((event = trace_find_next_event(event))) { | ||
456 | fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name); | ||
457 | fprintf(ofp, "\tmy ("); | ||
458 | |||
459 | fprintf(ofp, "$event_name, "); | ||
460 | fprintf(ofp, "$context, "); | ||
461 | fprintf(ofp, "$common_cpu, "); | ||
462 | fprintf(ofp, "$common_secs, "); | ||
463 | fprintf(ofp, "$common_nsecs,\n"); | ||
464 | fprintf(ofp, "\t $common_pid, "); | ||
465 | fprintf(ofp, "$common_comm,\n\t "); | ||
466 | |||
467 | not_first = 0; | ||
468 | count = 0; | ||
469 | |||
470 | for (f = event->format.fields; f; f = f->next) { | ||
471 | if (not_first++) | ||
472 | fprintf(ofp, ", "); | ||
473 | if (++count % 5 == 0) | ||
474 | fprintf(ofp, "\n\t "); | ||
475 | |||
476 | fprintf(ofp, "$%s", f->name); | ||
477 | } | ||
478 | fprintf(ofp, ") = @_;\n\n"); | ||
479 | |||
480 | fprintf(ofp, "\tprint_header($event_name, $common_cpu, " | ||
481 | "$common_secs, $common_nsecs,\n\t " | ||
482 | "$common_pid, $common_comm);\n\n"); | ||
483 | |||
484 | fprintf(ofp, "\tprintf(\""); | ||
485 | |||
486 | not_first = 0; | ||
487 | count = 0; | ||
488 | |||
489 | for (f = event->format.fields; f; f = f->next) { | ||
490 | if (not_first++) | ||
491 | fprintf(ofp, ", "); | ||
492 | if (count && count % 4 == 0) { | ||
493 | fprintf(ofp, "\".\n\t \""); | ||
494 | } | ||
495 | count++; | ||
496 | |||
497 | fprintf(ofp, "%s=", f->name); | ||
498 | if (f->flags & FIELD_IS_STRING || | ||
499 | f->flags & FIELD_IS_FLAG || | ||
500 | f->flags & FIELD_IS_SYMBOLIC) | ||
501 | fprintf(ofp, "%%s"); | ||
502 | else if (f->flags & FIELD_IS_SIGNED) | ||
503 | fprintf(ofp, "%%d"); | ||
504 | else | ||
505 | fprintf(ofp, "%%u"); | ||
506 | } | ||
507 | |||
508 | fprintf(ofp, "\\n\",\n\t "); | ||
509 | |||
510 | not_first = 0; | ||
511 | count = 0; | ||
512 | |||
513 | for (f = event->format.fields; f; f = f->next) { | ||
514 | if (not_first++) | ||
515 | fprintf(ofp, ", "); | ||
516 | |||
517 | if (++count % 5 == 0) | ||
518 | fprintf(ofp, "\n\t "); | ||
519 | |||
520 | if (f->flags & FIELD_IS_FLAG) { | ||
521 | if ((count - 1) % 5 != 0) { | ||
522 | fprintf(ofp, "\n\t "); | ||
523 | count = 4; | ||
524 | } | ||
525 | fprintf(ofp, "flag_str(\""); | ||
526 | fprintf(ofp, "%s::%s\", ", event->system, | ||
527 | event->name); | ||
528 | fprintf(ofp, "\"%s\", $%s)", f->name, | ||
529 | f->name); | ||
530 | } else if (f->flags & FIELD_IS_SYMBOLIC) { | ||
531 | if ((count - 1) % 5 != 0) { | ||
532 | fprintf(ofp, "\n\t "); | ||
533 | count = 4; | ||
534 | } | ||
535 | fprintf(ofp, "symbol_str(\""); | ||
536 | fprintf(ofp, "%s::%s\", ", event->system, | ||
537 | event->name); | ||
538 | fprintf(ofp, "\"%s\", $%s)", f->name, | ||
539 | f->name); | ||
540 | } else | ||
541 | fprintf(ofp, "$%s", f->name); | ||
542 | } | ||
543 | |||
544 | fprintf(ofp, ");\n"); | ||
545 | fprintf(ofp, "}\n\n"); | ||
546 | } | ||
547 | |||
548 | fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, " | ||
549 | "$common_cpu, $common_secs, $common_nsecs,\n\t " | ||
550 | "$common_pid, $common_comm) = @_;\n\n"); | ||
551 | |||
552 | fprintf(ofp, "\tprint_header($event_name, $common_cpu, " | ||
553 | "$common_secs, $common_nsecs,\n\t $common_pid, " | ||
554 | "$common_comm);\n}\n\n"); | ||
555 | |||
556 | fprintf(ofp, "sub print_header\n{\n" | ||
557 | "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n" | ||
558 | "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t " | ||
559 | "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}"); | ||
560 | |||
561 | fclose(ofp); | ||
562 | |||
563 | fprintf(stderr, "generated Perl script: %s\n", fname); | ||
564 | |||
565 | return 0; | ||
566 | } | ||
567 | |||
568 | struct scripting_ops perl_scripting_ops = { | ||
569 | .name = "Perl", | ||
570 | .start_script = perl_start_script, | ||
571 | .stop_script = perl_stop_script, | ||
572 | .process_event = perl_process_event, | ||
573 | .generate_script = perl_generate_script, | ||
574 | }; | ||
575 | |||
576 | #ifdef NO_LIBPERL | ||
577 | void setup_perl_scripting(void) | ||
578 | { | ||
579 | fprintf(stderr, "Perl scripting not supported." | ||
580 | " Install libperl and rebuild perf to enable it. e.g. " | ||
581 | "apt-get install libperl-dev (ubuntu), yum install " | ||
582 | "perl-ExtUtils-Embed (Fedora), etc.\n"); | ||
583 | } | ||
584 | #else | ||
585 | void setup_perl_scripting(void) | ||
586 | { | ||
587 | int err; | ||
588 | err = script_spec_register("Perl", &perl_scripting_ops); | ||
589 | if (err) | ||
590 | die("error registering Perl script extension"); | ||
591 | |||
592 | err = script_spec_register("pl", &perl_scripting_ops); | ||
593 | if (err) | ||
594 | die("error registering pl script extension"); | ||
595 | |||
596 | scripting_context = malloc(sizeof(struct scripting_context)); | ||
597 | } | ||
598 | #endif | ||