SAFE public projects git trees. - safe/jmp/linux-2.6/blob - tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm

   1 package Perf::Trace::Core;
   2
   3 use 5.010000;
   4 use strict;
   5 use warnings;
   6
   7 require Exporter;
   8
   9 our @ISA = qw(Exporter);
  10
  11 our %EXPORT_TAGS = ( 'all' => [ qw(
  12 ) ] );
  13
  14 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  15
  16 our @EXPORT = qw(
  17 define_flag_field define_flag_value flag_str dump_flag_fields
  18 define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
  19 );
  20
  21 our $VERSION = '0.01';
  22
  23 my %flag_fields;
  24 my %symbolic_fields;
  25
  26 sub flag_str
  27 {
  28     my ($event_name, $field_name, $value) = @_;
  29
  30     my $string;
  31
  32     if ($flag_fields{$event_name}{$field_name}) {
  33         my $print_delim = 0;
  34         foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
  35             if (!$value && !$idx) {
  36                 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
  37                 last;
  38             }
  39             if ($idx && ($value & $idx) == $idx) {
  40                 if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
  41                     $string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
  42                 }
  43                 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
  44                 $print_delim = 1;
  45                 $value &= ~$idx;
  46             }
  47         }
  48     }
  49
  50     return $string;
  51 }
  52
  53 sub define_flag_field
  54 {
  55     my ($event_name, $field_name, $delim) = @_;
  56
  57     $flag_fields{$event_name}{$field_name}{"delim"} = $delim;
  58 }
  59
  60 sub define_flag_value
  61 {
  62     my ($event_name, $field_name, $value, $field_str) = @_;
  63
  64     $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
  65 }
  66
  67 sub dump_flag_fields
  68 {
  69     for my $event (keys %flag_fields) {
  70         print "event $event:\n";
  71         for my $field (keys %{$flag_fields{$event}}) {
  72             print "    field: $field:\n";
  73             print "        delim: $flag_fields{$event}{$field}{'delim'}\n";
  74             foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
  75                 print "        value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
  76             }
  77         }
  78     }
  79 }
  80
  81 sub symbol_str
  82 {
  83     my ($event_name, $field_name, $value) = @_;
  84
  85     if ($symbolic_fields{$event_name}{$field_name}) {
  86         foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
  87             if (!$value && !$idx) {
  88                 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
  89                 last;
  90             }
  91             if ($value == $idx) {
  92                 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
  93             }
  94         }
  95     }
  96
  97     return undef;
  98 }
  99
 100 sub define_symbolic_field
 101 {
 102     my ($event_name, $field_name) = @_;
 103
 104     # nothing to do, really
 105 }
 106
 107 sub define_symbolic_value
 108 {
 109     my ($event_name, $field_name, $value, $field_str) = @_;
 110
 111     $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
 112 }
 113
 114 sub dump_symbolic_fields
 115 {
 116     for my $event (keys %symbolic_fields) {
 117         print "event $event:\n";
 118         for my $field (keys %{$symbolic_fields{$event}}) {
 119             print "    field: $field:\n";
 120             foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
 121                 print "        value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
 122             }
 123         }
 124     }
 125 }
 126
 127 1;
 128 __END__
 129 =head1 NAME
 130
 131 Perf::Trace::Core - Perl extension for perf trace
 132
 133 =head1 SYNOPSIS
 134
 135   use Perf::Trace::Core
 136
 137 =head1 SEE ALSO
 138
 139 Perf (trace) documentation
 140
 141 =head1 AUTHOR
 142
 143 Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
 144
 145 =head1 COPYRIGHT AND LICENSE
 146
 147 Copyright (C) 2009 by Tom Zanussi
 148
 149 This library is free software; you can redistribute it and/or modify
 150 it under the same terms as Perl itself, either Perl version 5.10.0 or,
 151 at your option, any later version of Perl 5 you may have available.
 152
 153 Alternatively, this software may be distributed under the terms of the
 154 GNU General Public License ("GPL") version 2 as published by the Free
 155 Software Foundation.
 156
 157 =cut