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