1 /* 2 * trace-event-perl. Feed perf script 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 #include <linux/bitmap.h> 28 29 #include "../util.h" 30 #include <EXTERN.h> 31 #include <perl.h> 32 33 #include "../../perf.h" 34 #include "../callchain.h" 35 #include "../machine.h" 36 #include "../thread.h" 37 #include "../event.h" 38 #include "../trace-event.h" 39 #include "../evsel.h" 40 #include "../debug.h" 41 42 void boot_Perf__Trace__Context(pTHX_ CV *cv); 43 void boot_DynaLoader(pTHX_ CV *cv); 44 typedef PerlInterpreter * INTERP; 45 46 void xs_init(pTHX); 47 48 void xs_init(pTHX) 49 { 50 const char *file = __FILE__; 51 dXSUB_SYS; 52 53 newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context, 54 file); 55 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); 56 } 57 58 INTERP my_perl; 59 60 #define TRACE_EVENT_TYPE_MAX \ 61 ((1 << (sizeof(unsigned short) * 8)) - 1) 62 63 static DECLARE_BITMAP(events_defined, TRACE_EVENT_TYPE_MAX); 64 65 extern struct scripting_context *scripting_context; 66 67 static char *cur_field_name; 68 static int zero_flag_atom; 69 70 static void define_symbolic_value(const char *ev_name, 71 const char *field_name, 72 const char *field_value, 73 const char *field_str) 74 { 75 unsigned long long value; 76 dSP; 77 78 value = eval_flag(field_value); 79 80 ENTER; 81 SAVETMPS; 82 PUSHMARK(SP); 83 84 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 85 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 86 XPUSHs(sv_2mortal(newSVuv(value))); 87 XPUSHs(sv_2mortal(newSVpv(field_str, 0))); 88 89 PUTBACK; 90 if (get_cv("main::define_symbolic_value", 0)) 91 call_pv("main::define_symbolic_value", G_SCALAR); 92 SPAGAIN; 93 PUTBACK; 94 FREETMPS; 95 LEAVE; 96 } 97 98 static void define_symbolic_values(struct print_flag_sym *field, 99 const char *ev_name, 100 const char *field_name) 101 { 102 define_symbolic_value(ev_name, field_name, field->value, field->str); 103 if (field->next) 104 define_symbolic_values(field->next, ev_name, field_name); 105 } 106 107 static void define_symbolic_field(const char *ev_name, 108 const char *field_name) 109 { 110 dSP; 111 112 ENTER; 113 SAVETMPS; 114 PUSHMARK(SP); 115 116 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 117 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 118 119 PUTBACK; 120 if (get_cv("main::define_symbolic_field", 0)) 121 call_pv("main::define_symbolic_field", G_SCALAR); 122 SPAGAIN; 123 PUTBACK; 124 FREETMPS; 125 LEAVE; 126 } 127 128 static void define_flag_value(const char *ev_name, 129 const char *field_name, 130 const char *field_value, 131 const char *field_str) 132 { 133 unsigned long long value; 134 dSP; 135 136 value = eval_flag(field_value); 137 138 ENTER; 139 SAVETMPS; 140 PUSHMARK(SP); 141 142 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 143 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 144 XPUSHs(sv_2mortal(newSVuv(value))); 145 XPUSHs(sv_2mortal(newSVpv(field_str, 0))); 146 147 PUTBACK; 148 if (get_cv("main::define_flag_value", 0)) 149 call_pv("main::define_flag_value", G_SCALAR); 150 SPAGAIN; 151 PUTBACK; 152 FREETMPS; 153 LEAVE; 154 } 155 156 static void define_flag_values(struct print_flag_sym *field, 157 const char *ev_name, 158 const char *field_name) 159 { 160 define_flag_value(ev_name, field_name, field->value, field->str); 161 if (field->next) 162 define_flag_values(field->next, ev_name, field_name); 163 } 164 165 static void define_flag_field(const char *ev_name, 166 const char *field_name, 167 const char *delim) 168 { 169 dSP; 170 171 ENTER; 172 SAVETMPS; 173 PUSHMARK(SP); 174 175 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 176 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 177 XPUSHs(sv_2mortal(newSVpv(delim, 0))); 178 179 PUTBACK; 180 if (get_cv("main::define_flag_field", 0)) 181 call_pv("main::define_flag_field", G_SCALAR); 182 SPAGAIN; 183 PUTBACK; 184 FREETMPS; 185 LEAVE; 186 } 187 188 static void define_event_symbols(struct event_format *event, 189 const char *ev_name, 190 struct print_arg *args) 191 { 192 if (args == NULL) 193 return; 194 195 switch (args->type) { 196 case PRINT_NULL: 197 break; 198 case PRINT_ATOM: 199 define_flag_value(ev_name, cur_field_name, "0", 200 args->atom.atom); 201 zero_flag_atom = 0; 202 break; 203 case PRINT_FIELD: 204 free(cur_field_name); 205 cur_field_name = strdup(args->field.name); 206 break; 207 case PRINT_FLAGS: 208 define_event_symbols(event, ev_name, args->flags.field); 209 define_flag_field(ev_name, cur_field_name, args->flags.delim); 210 define_flag_values(args->flags.flags, ev_name, cur_field_name); 211 break; 212 case PRINT_SYMBOL: 213 define_event_symbols(event, ev_name, args->symbol.field); 214 define_symbolic_field(ev_name, cur_field_name); 215 define_symbolic_values(args->symbol.symbols, ev_name, 216 cur_field_name); 217 break; 218 case PRINT_HEX: 219 define_event_symbols(event, ev_name, args->hex.field); 220 define_event_symbols(event, ev_name, args->hex.size); 221 break; 222 case PRINT_INT_ARRAY: 223 define_event_symbols(event, ev_name, args->int_array.field); 224 define_event_symbols(event, ev_name, args->int_array.count); 225 define_event_symbols(event, ev_name, args->int_array.el_size); 226 break; 227 case PRINT_BSTRING: 228 case PRINT_DYNAMIC_ARRAY: 229 case PRINT_DYNAMIC_ARRAY_LEN: 230 case PRINT_STRING: 231 case PRINT_BITMASK: 232 break; 233 case PRINT_TYPE: 234 define_event_symbols(event, ev_name, args->typecast.item); 235 break; 236 case PRINT_OP: 237 if (strcmp(args->op.op, ":") == 0) 238 zero_flag_atom = 1; 239 define_event_symbols(event, ev_name, args->op.left); 240 define_event_symbols(event, ev_name, args->op.right); 241 break; 242 case PRINT_FUNC: 243 default: 244 pr_err("Unsupported print arg type\n"); 245 /* we should warn... */ 246 return; 247 } 248 249 if (args->next) 250 define_event_symbols(event, ev_name, args->next); 251 } 252 253 static SV *perl_process_callchain(struct perf_sample *sample, 254 struct perf_evsel *evsel, 255 struct addr_location *al) 256 { 257 AV *list; 258 259 list = newAV(); 260 if (!list) 261 goto exit; 262 263 if (!symbol_conf.use_callchain || !sample->callchain) 264 goto exit; 265 266 if (thread__resolve_callchain(al->thread, &callchain_cursor, evsel, 267 sample, NULL, NULL, scripting_max_stack) != 0) { 268 pr_err("Failed to resolve callchain. Skipping\n"); 269 goto exit; 270 } 271 callchain_cursor_commit(&callchain_cursor); 272 273 274 while (1) { 275 HV *elem; 276 struct callchain_cursor_node *node; 277 node = callchain_cursor_current(&callchain_cursor); 278 if (!node) 279 break; 280 281 elem = newHV(); 282 if (!elem) 283 goto exit; 284 285 if (!hv_stores(elem, "ip", newSVuv(node->ip))) { 286 hv_undef(elem); 287 goto exit; 288 } 289 290 if (node->sym) { 291 HV *sym = newHV(); 292 if (!sym) { 293 hv_undef(elem); 294 goto exit; 295 } 296 if (!hv_stores(sym, "start", newSVuv(node->sym->start)) || 297 !hv_stores(sym, "end", newSVuv(node->sym->end)) || 298 !hv_stores(sym, "binding", newSVuv(node->sym->binding)) || 299 !hv_stores(sym, "name", newSVpvn(node->sym->name, 300 node->sym->namelen)) || 301 !hv_stores(elem, "sym", newRV_noinc((SV*)sym))) { 302 hv_undef(sym); 303 hv_undef(elem); 304 goto exit; 305 } 306 } 307 308 if (node->map) { 309 struct map *map = node->map; 310 const char *dsoname = "[unknown]"; 311 if (map && map->dso && (map->dso->name || map->dso->long_name)) { 312 if (symbol_conf.show_kernel_path && map->dso->long_name) 313 dsoname = map->dso->long_name; 314 else if (map->dso->name) 315 dsoname = map->dso->name; 316 } 317 if (!hv_stores(elem, "dso", newSVpv(dsoname,0))) { 318 hv_undef(elem); 319 goto exit; 320 } 321 } 322 323 callchain_cursor_advance(&callchain_cursor); 324 av_push(list, newRV_noinc((SV*)elem)); 325 } 326 327 exit: 328 return newRV_noinc((SV*)list); 329 } 330 331 static void perl_process_tracepoint(struct perf_sample *sample, 332 struct perf_evsel *evsel, 333 struct addr_location *al) 334 { 335 struct thread *thread = al->thread; 336 struct event_format *event = evsel->tp_format; 337 struct format_field *field; 338 static char handler[256]; 339 unsigned long long val; 340 unsigned long s, ns; 341 int pid; 342 int cpu = sample->cpu; 343 void *data = sample->raw_data; 344 unsigned long long nsecs = sample->time; 345 const char *comm = thread__comm_str(thread); 346 347 dSP; 348 349 if (evsel->attr.type != PERF_TYPE_TRACEPOINT) 350 return; 351 352 if (!event) 353 die("ug! no event found for type %" PRIu64, (u64)evsel->attr.config); 354 355 pid = raw_field_value(event, "common_pid", data); 356 357 sprintf(handler, "%s::%s", event->system, event->name); 358 359 if (!test_and_set_bit(event->id, events_defined)) 360 define_event_symbols(event, handler, event->print_fmt.args); 361 362 s = nsecs / NSECS_PER_SEC; 363 ns = nsecs - s * NSECS_PER_SEC; 364 365 scripting_context->event_data = data; 366 scripting_context->pevent = evsel->tp_format->pevent; 367 368 ENTER; 369 SAVETMPS; 370 PUSHMARK(SP); 371 372 XPUSHs(sv_2mortal(newSVpv(handler, 0))); 373 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context)))); 374 XPUSHs(sv_2mortal(newSVuv(cpu))); 375 XPUSHs(sv_2mortal(newSVuv(s))); 376 XPUSHs(sv_2mortal(newSVuv(ns))); 377 XPUSHs(sv_2mortal(newSViv(pid))); 378 XPUSHs(sv_2mortal(newSVpv(comm, 0))); 379 XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al))); 380 381 /* common fields other than pid can be accessed via xsub fns */ 382 383 for (field = event->format.fields; field; field = field->next) { 384 if (field->flags & FIELD_IS_STRING) { 385 int offset; 386 if (field->flags & FIELD_IS_DYNAMIC) { 387 offset = *(int *)(data + field->offset); 388 offset &= 0xffff; 389 } else 390 offset = field->offset; 391 XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0))); 392 } else { /* FIELD_IS_NUMERIC */ 393 val = read_size(event, data + field->offset, 394 field->size); 395 if (field->flags & FIELD_IS_SIGNED) { 396 XPUSHs(sv_2mortal(newSViv(val))); 397 } else { 398 XPUSHs(sv_2mortal(newSVuv(val))); 399 } 400 } 401 } 402 403 PUTBACK; 404 405 if (get_cv(handler, 0)) 406 call_pv(handler, G_SCALAR); 407 else if (get_cv("main::trace_unhandled", 0)) { 408 XPUSHs(sv_2mortal(newSVpv(handler, 0))); 409 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context)))); 410 XPUSHs(sv_2mortal(newSVuv(cpu))); 411 XPUSHs(sv_2mortal(newSVuv(nsecs))); 412 XPUSHs(sv_2mortal(newSViv(pid))); 413 XPUSHs(sv_2mortal(newSVpv(comm, 0))); 414 XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al))); 415 call_pv("main::trace_unhandled", G_SCALAR); 416 } 417 SPAGAIN; 418 PUTBACK; 419 FREETMPS; 420 LEAVE; 421 } 422 423 static void perl_process_event_generic(union perf_event *event, 424 struct perf_sample *sample, 425 struct perf_evsel *evsel) 426 { 427 dSP; 428 429 if (!get_cv("process_event", 0)) 430 return; 431 432 ENTER; 433 SAVETMPS; 434 PUSHMARK(SP); 435 XPUSHs(sv_2mortal(newSVpvn((const char *)event, event->header.size))); 436 XPUSHs(sv_2mortal(newSVpvn((const char *)&evsel->attr, sizeof(evsel->attr)))); 437 XPUSHs(sv_2mortal(newSVpvn((const char *)sample, sizeof(*sample)))); 438 XPUSHs(sv_2mortal(newSVpvn((const char *)sample->raw_data, sample->raw_size))); 439 PUTBACK; 440 call_pv("process_event", G_SCALAR); 441 SPAGAIN; 442 PUTBACK; 443 FREETMPS; 444 LEAVE; 445 } 446 447 static void perl_process_event(union perf_event *event, 448 struct perf_sample *sample, 449 struct perf_evsel *evsel, 450 struct addr_location *al) 451 { 452 perl_process_tracepoint(sample, evsel, al); 453 perl_process_event_generic(event, sample, evsel); 454 } 455 456 static void run_start_sub(void) 457 { 458 dSP; /* access to Perl stack */ 459 PUSHMARK(SP); 460 461 if (get_cv("main::trace_begin", 0)) 462 call_pv("main::trace_begin", G_DISCARD | G_NOARGS); 463 } 464 465 /* 466 * Start trace script 467 */ 468 static int perl_start_script(const char *script, int argc, const char **argv) 469 { 470 const char **command_line; 471 int i, err = 0; 472 473 command_line = malloc((argc + 2) * sizeof(const char *)); 474 command_line[0] = ""; 475 command_line[1] = script; 476 for (i = 2; i < argc + 2; i++) 477 command_line[i] = argv[i - 2]; 478 479 my_perl = perl_alloc(); 480 perl_construct(my_perl); 481 482 if (perl_parse(my_perl, xs_init, argc + 2, (char **)command_line, 483 (char **)NULL)) { 484 err = -1; 485 goto error; 486 } 487 488 if (perl_run(my_perl)) { 489 err = -1; 490 goto error; 491 } 492 493 if (SvTRUE(ERRSV)) { 494 err = -1; 495 goto error; 496 } 497 498 run_start_sub(); 499 500 free(command_line); 501 return 0; 502 error: 503 perl_free(my_perl); 504 free(command_line); 505 506 return err; 507 } 508 509 static int perl_flush_script(void) 510 { 511 return 0; 512 } 513 514 /* 515 * Stop trace script 516 */ 517 static int perl_stop_script(void) 518 { 519 dSP; /* access to Perl stack */ 520 PUSHMARK(SP); 521 522 if (get_cv("main::trace_end", 0)) 523 call_pv("main::trace_end", G_DISCARD | G_NOARGS); 524 525 perl_destruct(my_perl); 526 perl_free(my_perl); 527 528 return 0; 529 } 530 531 static int perl_generate_script(struct pevent *pevent, const char *outfile) 532 { 533 struct event_format *event = NULL; 534 struct format_field *f; 535 char fname[PATH_MAX]; 536 int not_first, count; 537 FILE *ofp; 538 539 sprintf(fname, "%s.pl", outfile); 540 ofp = fopen(fname, "w"); 541 if (ofp == NULL) { 542 fprintf(stderr, "couldn't open %s\n", fname); 543 return -1; 544 } 545 546 fprintf(ofp, "# perf script event handlers, " 547 "generated by perf script -g perl\n"); 548 549 fprintf(ofp, "# Licensed under the terms of the GNU GPL" 550 " License version 2\n\n"); 551 552 fprintf(ofp, "# The common_* event handler fields are the most useful " 553 "fields common to\n"); 554 555 fprintf(ofp, "# all events. They don't necessarily correspond to " 556 "the 'common_*' fields\n"); 557 558 fprintf(ofp, "# in the format files. Those fields not available as " 559 "handler params can\n"); 560 561 fprintf(ofp, "# be retrieved using Perl functions of the form " 562 "common_*($context).\n"); 563 564 fprintf(ofp, "# See Context.pm for the list of available " 565 "functions.\n\n"); 566 567 fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/" 568 "Perf-Trace-Util/lib\";\n"); 569 570 fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n"); 571 fprintf(ofp, "use Perf::Trace::Core;\n"); 572 fprintf(ofp, "use Perf::Trace::Context;\n"); 573 fprintf(ofp, "use Perf::Trace::Util;\n\n"); 574 575 fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n"); 576 fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n"); 577 578 579 fprintf(ofp, "\n\ 580 sub print_backtrace\n\ 581 {\n\ 582 my $callchain = shift;\n\ 583 for my $node (@$callchain)\n\ 584 {\n\ 585 if(exists $node->{sym})\n\ 586 {\n\ 587 printf( \"\\t[\\%%x] \\%%s\\n\", $node->{ip}, $node->{sym}{name});\n\ 588 }\n\ 589 else\n\ 590 {\n\ 591 printf( \"\\t[\\%%x]\\n\", $node{ip});\n\ 592 }\n\ 593 }\n\ 594 }\n\n\ 595 "); 596 597 598 while ((event = trace_find_next_event(pevent, event))) { 599 fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name); 600 fprintf(ofp, "\tmy ("); 601 602 fprintf(ofp, "$event_name, "); 603 fprintf(ofp, "$context, "); 604 fprintf(ofp, "$common_cpu, "); 605 fprintf(ofp, "$common_secs, "); 606 fprintf(ofp, "$common_nsecs,\n"); 607 fprintf(ofp, "\t $common_pid, "); 608 fprintf(ofp, "$common_comm, "); 609 fprintf(ofp, "$common_callchain,\n\t "); 610 611 not_first = 0; 612 count = 0; 613 614 for (f = event->format.fields; f; f = f->next) { 615 if (not_first++) 616 fprintf(ofp, ", "); 617 if (++count % 5 == 0) 618 fprintf(ofp, "\n\t "); 619 620 fprintf(ofp, "$%s", f->name); 621 } 622 fprintf(ofp, ") = @_;\n\n"); 623 624 fprintf(ofp, "\tprint_header($event_name, $common_cpu, " 625 "$common_secs, $common_nsecs,\n\t " 626 "$common_pid, $common_comm, $common_callchain);\n\n"); 627 628 fprintf(ofp, "\tprintf(\""); 629 630 not_first = 0; 631 count = 0; 632 633 for (f = event->format.fields; f; f = f->next) { 634 if (not_first++) 635 fprintf(ofp, ", "); 636 if (count && count % 4 == 0) { 637 fprintf(ofp, "\".\n\t \""); 638 } 639 count++; 640 641 fprintf(ofp, "%s=", f->name); 642 if (f->flags & FIELD_IS_STRING || 643 f->flags & FIELD_IS_FLAG || 644 f->flags & FIELD_IS_SYMBOLIC) 645 fprintf(ofp, "%%s"); 646 else if (f->flags & FIELD_IS_SIGNED) 647 fprintf(ofp, "%%d"); 648 else 649 fprintf(ofp, "%%u"); 650 } 651 652 fprintf(ofp, "\\n\",\n\t "); 653 654 not_first = 0; 655 count = 0; 656 657 for (f = event->format.fields; f; f = f->next) { 658 if (not_first++) 659 fprintf(ofp, ", "); 660 661 if (++count % 5 == 0) 662 fprintf(ofp, "\n\t "); 663 664 if (f->flags & FIELD_IS_FLAG) { 665 if ((count - 1) % 5 != 0) { 666 fprintf(ofp, "\n\t "); 667 count = 4; 668 } 669 fprintf(ofp, "flag_str(\""); 670 fprintf(ofp, "%s::%s\", ", event->system, 671 event->name); 672 fprintf(ofp, "\"%s\", $%s)", f->name, 673 f->name); 674 } else if (f->flags & FIELD_IS_SYMBOLIC) { 675 if ((count - 1) % 5 != 0) { 676 fprintf(ofp, "\n\t "); 677 count = 4; 678 } 679 fprintf(ofp, "symbol_str(\""); 680 fprintf(ofp, "%s::%s\", ", event->system, 681 event->name); 682 fprintf(ofp, "\"%s\", $%s)", f->name, 683 f->name); 684 } else 685 fprintf(ofp, "$%s", f->name); 686 } 687 688 fprintf(ofp, ");\n\n"); 689 690 fprintf(ofp, "\tprint_backtrace($common_callchain);\n"); 691 692 fprintf(ofp, "}\n\n"); 693 } 694 695 fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, " 696 "$common_cpu, $common_secs, $common_nsecs,\n\t " 697 "$common_pid, $common_comm, $common_callchain) = @_;\n\n"); 698 699 fprintf(ofp, "\tprint_header($event_name, $common_cpu, " 700 "$common_secs, $common_nsecs,\n\t $common_pid, " 701 "$common_comm, $common_callchain);\n"); 702 fprintf(ofp, "\tprint_backtrace($common_callchain);\n"); 703 fprintf(ofp, "}\n\n"); 704 705 fprintf(ofp, "sub print_header\n{\n" 706 "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n" 707 "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t " 708 "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}\n"); 709 710 fprintf(ofp, 711 "\n# Packed byte string args of process_event():\n" 712 "#\n" 713 "# $event:\tunion perf_event\tutil/event.h\n" 714 "# $attr:\tstruct perf_event_attr\tlinux/perf_event.h\n" 715 "# $sample:\tstruct perf_sample\tutil/event.h\n" 716 "# $raw_data:\tperf_sample->raw_data\tutil/event.h\n" 717 "\n" 718 "sub process_event\n" 719 "{\n" 720 "\tmy ($event, $attr, $sample, $raw_data) = @_;\n" 721 "\n" 722 "\tmy @event\t= unpack(\"LSS\", $event);\n" 723 "\tmy @attr\t= unpack(\"LLQQQQQLLQQ\", $attr);\n" 724 "\tmy @sample\t= unpack(\"QLLQQQQQLL\", $sample);\n" 725 "\tmy @raw_data\t= unpack(\"C*\", $raw_data);\n" 726 "\n" 727 "\tuse Data::Dumper;\n" 728 "\tprint Dumper \\@event, \\@attr, \\@sample, \\@raw_data;\n" 729 "}\n"); 730 731 fclose(ofp); 732 733 fprintf(stderr, "generated Perl script: %s\n", fname); 734 735 return 0; 736 } 737 738 struct scripting_ops perl_scripting_ops = { 739 .name = "Perl", 740 .start_script = perl_start_script, 741 .flush_script = perl_flush_script, 742 .stop_script = perl_stop_script, 743 .process_event = perl_process_event, 744 .generate_script = perl_generate_script, 745 }; 746