1 package Perf::Trace::Core;
9 our @ISA = qw(Exporter);
11 our %EXPORT_TAGS = ( 'all' => [ qw(
14 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
17 define_flag_field define_flag_value flag_str dump_flag_fields
18 define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
22 our $VERSION = '0.01';
24 my %trace_flags = (0x00 => "NONE",
26 0x02 => "IRQS_NOSUPPORT",
27 0x04 => "NEED_RESCHED",
39 foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
40 if (!$value && !$idx) {
45 if ($idx && ($value & $idx) == $idx) {
49 $string .= "$trace_flags{$idx}";
63 my ($event_name, $field_name, $value) = @_;
67 if ($flag_fields{$event_name}{$field_name}) {
69 foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
70 if (!$value && !$idx) {
71 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
74 if ($idx && ($value & $idx) == $idx) {
75 if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
76 $string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
78 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
90 my ($event_name, $field_name, $delim) = @_;
92 $flag_fields{$event_name}{$field_name}{"delim"} = $delim;
97 my ($event_name, $field_name, $value, $field_str) = @_;
99 $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
104 for my $event (keys %flag_fields) {
105 print "event $event:\n";
106 for my $field (keys %{$flag_fields{$event}}) {
107 print " field: $field:\n";
108 print " delim: $flag_fields{$event}{$field}{'delim'}\n";
109 foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
110 print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
118 my ($event_name, $field_name, $value) = @_;
120 if ($symbolic_fields{$event_name}{$field_name}) {
121 foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
122 if (!$value && !$idx) {
123 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
126 if ($value == $idx) {
127 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
135 sub define_symbolic_field
137 my ($event_name, $field_name) = @_;
139 # nothing to do, really
142 sub define_symbolic_value
144 my ($event_name, $field_name, $value, $field_str) = @_;
146 $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
149 sub dump_symbolic_fields
151 for my $event (keys %symbolic_fields) {
152 print "event $event:\n";
153 for my $field (keys %{$symbolic_fields{$event}}) {
154 print " field: $field:\n";
155 foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
156 print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
166 Perf::Trace::Core - Perl extension for perf script
170 use Perf::Trace::Core
174 Perf (script) documentation
178 Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
180 =head1 COPYRIGHT AND LICENSE
182 Copyright (C) 2009 by Tom Zanussi
184 This library is free software; you can redistribute it and/or modify
185 it under the same terms as Perl itself, either Perl version 5.10.0 or,
186 at your option, any later version of Perl 5 you may have available.
188 Alternatively, this software may be distributed under the terms of the
189 GNU General Public License ("GPL") version 2 as published by the Free