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