Donate to e Foundation | Murena handsets with /e/OS | Own a part of Murena! Learn more

Commit bcefe12e authored by Tom Zanussi's avatar Tom Zanussi Committed by Ingo Molnar
Browse files

perf trace: Add perf trace scripting support modules for Perl 



Add Perf-Trace-Util Perl module and some scripts that use it.
Core.pm contains Perl code to define and access flag and
symbolic fields. Util.pm contains general-purpose utility
functions.

Also adds some makefile bits to install them in
libexec/perf-core/scripts/perl (or wherever perfexec_instdir
points).

Signed-off-by: default avatarTom Zanussi <tzanussi@gmail.com>
Cc: fweisbec@gmail.com
Cc: rostedt@goodmis.org
Cc: anton@samba.org
Cc: hch@infradead.org
LKML-Reference: <1259133352-23685-5-git-send-email-tzanussi@gmail.com>
Signed-off-by: default avatarIngo Molnar <mingo@elte.hu>
parent 16c632de

tools/perf/Makefile

+7 −0
Original line number Diff line number Diff line
@@ -980,6 +980,13 @@ export perfexec_instdir 
install: all

	$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)'

	$(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)'

	$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'

	$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'

	$(INSTALL) scripts/perl/Perf-Trace-Util/lib/Perf/Trace/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'

	$(INSTALL) scripts/perl/*.pl -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl'

	$(INSTALL) scripts/perl/bin/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'

	$(INSTALL) scripts/perl/Perf-Trace-Util/Makefile.PL -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'

	$(INSTALL) scripts/perl/Perf-Trace-Util/README -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'

ifdef BUILT_INS

	$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'

	$(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'

tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL

0 → 100644
+12 −0
Original line number Diff line number Diff line 
use 5.010000;

use ExtUtils::MakeMaker;

# See lib/ExtUtils/MakeMaker.pm for details of how to influence

# the contents of the Makefile that is written.

WriteMakefile(

    NAME              => 'Perf::Trace::Util',

    VERSION_FROM      => 'lib/Perf/Trace/Util.pm', # finds $VERSION

    PREREQ_PM         => {}, # e.g., Module::Name => 1.1

    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005

      (ABSTRACT_FROM  => 'lib/Perf/Trace/Util.pm', # retrieve abstract from module

       AUTHOR         => 'Tom Zanussi <tzanussi@gmail.com>') : ()),

);

tools/perf/scripts/perl/Perf-Trace-Util/README

0 → 100644
+35 −0
Original line number Diff line number Diff line 
Perf-Trace-Util version 0.01

============================



This module contains utility functions for use with perf trace.



INSTALLATION



Building perf with perf trace Perl scripting should install this

module in the right place.



You should make sure libperl is installed first e.g. apt-get install

libperl-dev.



DEPENDENCIES



This module requires these other modules and libraries:



  blah blah blah



COPYRIGHT AND LICENCE



Put the correct copyright and licence information here.



Copyright (C) 2009 by Tom Zanussi <tzanussi@gmail.com>



This library is free software; you can redistribute it and/or modify

it under the same terms as Perl itself, either Perl version 5.10.0 or,

at your option, any later version of Perl 5 you may have available.



Alternatively, this software may be distributed under the terms of the

GNU General Public License ("GPL") version 2 as published by the Free

Software Foundation.

tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm

0 → 100644
+157 −0
Original line number Diff line number Diff line 
package Perf::Trace::Core;



use 5.010000;

use strict;

use warnings;



require Exporter;



our @ISA = qw(Exporter);



our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );



our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );



our @EXPORT = qw(

define_flag_field define_flag_value flag_str dump_flag_fields

define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields

);



our $VERSION = '0.01';



my %flag_fields;

my %symbolic_fields;



sub flag_str

{

    my ($event_name, $field_name, $value) = @_;



    my $string;



    if ($flag_fields{$event_name}{$field_name}) {

	my $print_delim = 0;

	foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {

	    if (!$value && !$idx) {

		$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";

		last;

	    }

	    if ($idx && ($value & $idx) == $idx) {

		if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {

		    $string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";

		}

		$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";

		$print_delim = 1;

		$value &= ~$idx;

	    }

	}

    }



    return $string;

}



sub define_flag_field

{

    my ($event_name, $field_name, $delim) = @_;



    $flag_fields{$event_name}{$field_name}{"delim"} = $delim;

}



sub define_flag_value

{

    my ($event_name, $field_name, $value, $field_str) = @_;



    $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;

}



sub dump_flag_fields

{

    for my $event (keys %flag_fields) {

	print "event $event:\n";

	for my $field (keys %{$flag_fields{$event}}) {

	    print "    field: $field:\n";

	    print "        delim: $flag_fields{$event}{$field}{'delim'}\n";

	    foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {

		print "        value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";

	    }

	}

    }

}



sub symbol_str

{

    my ($event_name, $field_name, $value) = @_;



    if ($symbolic_fields{$event_name}{$field_name}) {

	foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {

	    if (!$value && !$idx) {

		return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";

		last;

	    }

	    if ($value == $idx) {

		return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";

	    }

	}

    }



    return undef;

}



sub define_symbolic_field

{

    my ($event_name, $field_name) = @_;



    # nothing to do, really

}



sub define_symbolic_value

{

    my ($event_name, $field_name, $value, $field_str) = @_;



    $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;

}



sub dump_symbolic_fields

{

    for my $event (keys %symbolic_fields) {

	print "event $event:\n";

	for my $field (keys %{$symbolic_fields{$event}}) {

	    print "    field: $field:\n";

	    foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {

		print "        value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";

	    }

	}

    }

}



1;

__END__

=head1 NAME



Perf::Trace::Core - Perl extension for perf trace



=head1 SYNOPSIS



  use Perf::Trace::Core



=head1 SEE ALSO



Perf (trace) documentation



=head1 AUTHOR



Tom Zanussi, E<lt>tzanussi@gmail.com<gt>



=head1 COPYRIGHT AND LICENSE



Copyright (C) 2009 by Tom Zanussi



This library is free software; you can redistribute it and/or modify

it under the same terms as Perl itself, either Perl version 5.10.0 or,

at your option, any later version of Perl 5 you may have available.



Alternatively, this software may be distributed under the terms of the

GNU General Public License ("GPL") version 2 as published by the Free

Software Foundation.



=cut

tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm

0 → 100644
+88 −0
Original line number Diff line number Diff line 
package Perf::Trace::Util;



use 5.010000;

use strict;

use warnings;



require Exporter;



our @ISA = qw(Exporter);



our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );



our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );



our @EXPORT = qw(

avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs

);



our $VERSION = '0.01';



sub avg

{

    my ($total, $n) = @_;



    return $total / $n;

}



my $NSECS_PER_SEC    = 1000000000;



sub nsecs

{

    my ($secs, $nsecs) = @_;



    return $secs * $NSECS_PER_SEC + $nsecs;

}



sub nsecs_secs {

    my ($nsecs) = @_;



    return $nsecs / $NSECS_PER_SEC;

}



sub nsecs_nsecs {

    my ($nsecs) = @_;



    return $nsecs - nsecs_secs($nsecs);

}



sub nsecs_str {

    my ($nsecs) = @_;



    my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs));



    return $str;

}



1;

__END__

=head1 NAME



Perf::Trace::Util - Perl extension for perf trace



=head1 SYNOPSIS



  use Perf::Trace::Util;



=head1 SEE ALSO



Perf (trace) documentation



=head1 AUTHOR



Tom Zanussi, E<lt>tzanussi@gmail.com<gt>



=head1 COPYRIGHT AND LICENSE



Copyright (C) 2009 by Tom Zanussi



This library is free software; you can redistribute it and/or modify

it under the same terms as Perl itself, either Perl version 5.10.0 or,

at your option, any later version of Perl 5 you may have available.



Alternatively, this software may be distributed under the terms of the

GNU General Public License ("GPL") version 2 as published by the Free

Software Foundation.



=cut