From 3a9a0beba2913edaae39ff8b4645fee10c3acf37 Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Sun, 6 Dec 2009 20:41:52 -0600 Subject: perf trace/scripting: Fix compile error when libperl not installed When I added the xs callbacks into perf, I forgot to re-check the no-libperl case. This patch fixes the undefined reference error for that. Reported-by: Arnaldo Carvalho de Melo Signed-off-by: Tom Zanussi Cc: Frederic Weisbecker Cc: Mike Galbraith Cc: Peter Zijlstra Cc: Paul Mackerras LKML-Reference: <1260153712.6564.4.camel@tropicana> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event-perl.c | 3 --- 1 file changed, 3 deletions(-) (limited to 'tools/perf/util/trace-event-perl.c') diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c index 51e833fd58c3..59564b22d9ce 100644 --- a/tools/perf/util/trace-event-perl.c +++ b/tools/perf/util/trace-event-perl.c @@ -32,9 +32,6 @@ void xs_init(pTHX); -void boot_Perf__Trace__Context(pTHX_ CV *cv); -void boot_DynaLoader(pTHX_ CV *cv); - void xs_init(pTHX) { const char *file = __FILE__; -- cgit v1.2.3 From 67a6259ec97b8408f86f2fe8459d2233f0b0987d Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Sun, 6 Dec 2009 23:31:59 -0600 Subject: perf trace/scripting: Don't display 'scripting unsupported' msg unnecessarily The 'scripting unsupported' message should only be displayed when the -s or -g options are used, and not when they aren't, as the current code does. Signed-off-by: Tom Zanussi Cc: rostedt@goodmis.org Cc: Peter Zijlstra Cc: Mike Galbraith Cc: Paul Mackerras Cc: Arnaldo Carvalho de Melo Cc: Frederic Weisbecker LKML-Reference: <1260163919-6679-3-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event-perl.c | 64 ++++++++++++++++++++++++++++++++------ 1 file changed, 55 insertions(+), 9 deletions(-) (limited to 'tools/perf/util/trace-event-perl.c') diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c index 59564b22d9ce..a5ffe60db5d6 100644 --- a/tools/perf/util/trace-event-perl.c +++ b/tools/perf/util/trace-event-perl.c @@ -570,26 +570,72 @@ struct scripting_ops perl_scripting_ops = { .generate_script = perl_generate_script, }; -#ifdef NO_LIBPERL -void setup_perl_scripting(void) +static void print_unsupported_msg(void) { fprintf(stderr, "Perl scripting not supported." - " Install libperl and rebuild perf to enable it. e.g. " - "apt-get install libperl-dev (ubuntu), yum install " - "perl-ExtUtils-Embed (Fedora), etc.\n"); + " Install libperl and rebuild perf to enable it.\n" + "For example:\n # apt-get install libperl-dev (ubuntu)" + "\n # yum install perl-ExtUtils-Embed (Fedora)" + "\n etc.\n"); } -#else -void setup_perl_scripting(void) + +static int perl_start_script_unsupported(const char *script __unused) +{ + print_unsupported_msg(); + + return -1; +} + +static int perl_stop_script_unsupported(void) +{ + return 0; +} + +static void perl_process_event_unsupported(int cpu __unused, + void *data __unused, + int size __unused, + unsigned long long nsecs __unused, + char *comm __unused) +{ +} + +static int perl_generate_script_unsupported(const char *outfile __unused) +{ + print_unsupported_msg(); + + return -1; +} + +struct scripting_ops perl_scripting_unsupported_ops = { + .name = "Perl", + .start_script = perl_start_script_unsupported, + .stop_script = perl_stop_script_unsupported, + .process_event = perl_process_event_unsupported, + .generate_script = perl_generate_script_unsupported, +}; + +static void register_perl_scripting(struct scripting_ops *scripting_ops) { int err; - err = script_spec_register("Perl", &perl_scripting_ops); + err = script_spec_register("Perl", scripting_ops); if (err) die("error registering Perl script extension"); - err = script_spec_register("pl", &perl_scripting_ops); + err = script_spec_register("pl", scripting_ops); if (err) die("error registering pl script extension"); scripting_context = malloc(sizeof(struct scripting_context)); } + +#ifdef NO_LIBPERL +void setup_perl_scripting(void) +{ + register_perl_scripting(&perl_scripting_unsupported_ops); +} +#else +void setup_perl_scripting(void) +{ + register_perl_scripting(&perl_scripting_ops); +} #endif -- cgit v1.2.3 From 586bc5cce88be993dad584c3936c49f945368551 Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Tue, 15 Dec 2009 02:53:35 -0600 Subject: perf trace/scripting: Add support for script args One oversight of the original scripting_ops patch was a lack of support for passing args to handler scripts. This adds argc/argv to the start_script() scripting_op, and changes the rw-by-file script to take 'comm' arg rather than the 'perf' value currently hard-coded. It also takes the opportunity to do some related minor cleanup. Signed-off-by: Tom Zanussi Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org LKML-Reference: <1260867220-15699-2-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event-perl.c | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) (limited to 'tools/perf/util/trace-event-perl.c') diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c index a5ffe60db5d6..6f10e7602452 100644 --- a/tools/perf/util/trace-event-perl.c +++ b/tools/perf/util/trace-event-perl.c @@ -267,7 +267,7 @@ int common_lock_depth(struct scripting_context *context) } static void perl_process_event(int cpu, void *data, - int size __attribute((unused)), + int size __unused, unsigned long long nsecs, char *comm) { struct format_field *field; @@ -359,28 +359,42 @@ static void run_start_sub(void) /* * Start trace script */ -static int perl_start_script(const char *script) +static int perl_start_script(const char *script, int argc, const char **argv) { - const char *command_line[2] = { "", NULL }; + const char **command_line; + int i, err = 0; + command_line = malloc((argc + 2) * sizeof(const char *)); + command_line[0] = ""; command_line[1] = script; + for (i = 2; i < argc + 2; i++) + command_line[i] = argv[i - 2]; my_perl = perl_alloc(); perl_construct(my_perl); - if (perl_parse(my_perl, xs_init, 2, (char **)command_line, - (char **)NULL)) - return -1; + if (perl_parse(my_perl, xs_init, argc + 2, (char **)command_line, + (char **)NULL)) { + err = -1; + goto error; + } perl_run(my_perl); - if (SvTRUE(ERRSV)) - return -1; + if (SvTRUE(ERRSV)) { + err = -1; + goto error; + } run_start_sub(); + free(command_line); fprintf(stderr, "perf trace started with Perl script %s\n\n", script); - return 0; +error: + perl_free(my_perl); + free(command_line); + + return err; } /* @@ -579,7 +593,9 @@ static void print_unsupported_msg(void) "\n etc.\n"); } -static int perl_start_script_unsupported(const char *script __unused) +static int perl_start_script_unsupported(const char *script __unused, + int argc __unused, + const char **argv __unused) { print_unsupported_msg(); -- cgit v1.2.3 From 8f11d85a0e7e9025acea7493e6864089c8b52f42 Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Tue, 15 Dec 2009 02:53:37 -0600 Subject: perf trace/scripting: Check return val of perl_run() The return value from perl_run() is currently ignored, but it should be checked and used to exit perf if there are problems loading the script. Signed-off-by: Tom Zanussi Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org LKML-Reference: <1260867220-15699-4-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event-perl.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'tools/perf/util/trace-event-perl.c') diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c index 6f10e7602452..6d6d76b8a21e 100644 --- a/tools/perf/util/trace-event-perl.c +++ b/tools/perf/util/trace-event-perl.c @@ -379,7 +379,11 @@ static int perl_start_script(const char *script, int argc, const char **argv) goto error; } - perl_run(my_perl); + if (perl_run(my_perl)) { + err = -1; + goto error; + } + if (SvTRUE(ERRSV)) { err = -1; goto error; -- cgit v1.2.3