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