tests/utils/babelstats.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2012 Christian Babeux <christian.babeux@efficios.com>
   4 #
   5 # SPDX-License-Identifier: GPL-2.0-only
   6 #
   7
   8 use strict;
   9 use warnings;
  10
  11 use Getopt::Long;
  12
  13 my $opt_tracepoint;
  14
  15 GetOptions('tracepoint=s' => \$opt_tracepoint)
  16         or die("Invalid command-line option\n");
  17
  18 defined($opt_tracepoint)
  19         or die("Missing tracepoint, use --tracepoint <name>");
  20
  21 # Parse an array string.
  22 # The format is as follow: [ [index] = value, ... ]
  23 sub parse_array
  24 {
  25         my ($arr_str) = @_;
  26         my @array = ();
  27
  28         # Strip leading and ending brackets, remove whitespace
  29         $arr_str =~ s/^\[//;
  30         $arr_str =~ s/\]$//;
  31         $arr_str =~ s/\s//g;
  32
  33         my @entries = split(',', $arr_str);
  34
  35         foreach my $entry (@entries) {
  36                 if ($entry =~ /^\[(\d+)\]=(\d+)$/) {
  37                         my $index = $1;
  38                         my $value = $2;
  39                         splice @array, $index, 0, $value;
  40                 }
  41         }
  42
  43         return \@array;
  44 }
  45
  46 # Parse fields values.
  47 # Format can either be a name = array or a name = value pair.
  48 sub parse_fields
  49 {
  50         my ($fields_str) = @_;
  51         my %fields_hash;
  52
  53         my $field_name = '[\w\d_]+';
  54         my $field_value = '[\w\d_\\\*"]+';
  55         my $array = '\[(?:\s\[\d+\]\s=\s\d+,)*\s\[\d+\]\s=\s\d+\s\]';
  56
  57         # Split the various fields
  58         my @fields = ($fields_str =~ /$field_name\s=\s(?:$array|$field_value)/g);
  59
  60         foreach my $field (@fields) {
  61                 if ($field =~ /($field_name)\s=\s($array)/) {
  62                         my $name  = $1;
  63                         my $value = parse_array($2);
  64                         $fields_hash{$name} = $value;
  65                 }
  66
  67                 if ($field =~ /($field_name)\s=\s($field_value)/) {
  68                         my $name  = $1;
  69                         my $value = $2;
  70                         $fields_hash{$name} = $value;
  71                 }
  72         }
  73
  74         return \%fields_hash;
  75 }
  76
  77 # Using an event array, merge all the fields
  78 # of a particular tracepoint.
  79 sub merge_fields
  80 {
  81         my ($events_ref) = @_;
  82         my %merged;
  83
  84         foreach my $event (@{$events_ref}) {
  85                 my $tp_event     = $event->{'tp_event'};
  86                 my $tracepoint  = "${tp_event}";
  87
  88                 foreach my $key (keys %{$event->{'fields'}}) {
  89                         my $val = $event->{'fields'}->{$key};
  90
  91                         # TODO: Merge of array is not implemented.
  92                         next if (ref($val) eq 'ARRAY');
  93                         $merged{$tracepoint}{$key}{$val} = undef;
  94                 }
  95         }
  96
  97         return \%merged;
  98 }
  99
 100 # Print the minimum and maximum of each fields
 101 # for a particular tracepoint.
 102 sub print_fields_stats
 103 {
 104         my ($merged_ref, $tracepoint) = @_;
 105
 106         return unless ($tracepoint && exists $merged_ref->{$tracepoint});
 107
 108         foreach my $field (keys %{$merged_ref->{$tracepoint}}) {
 109                 my @sorted;
 110                 my @val = keys %{$merged_ref->{$tracepoint}->{$field}};
 111
 112                 if ($val[0] =~ /^\d+$/) {
 113                         # Sort numerically
 114                         @sorted = sort { $a <=> $b } @val;
 115                 } elsif ($val[0] =~ /^0x[\da-f]+$/i) {
 116                         # Convert the hex values and sort numerically
 117                         @sorted = sort { hex($a) <=> hex($b) } @val;
 118                 } else {
 119                         # Fallback, alphabetical sort
 120                         @sorted = sort { lc($a) cmp lc($b) } @val;
 121                 }
 122
 123                 my $min = $sorted[0];
 124                 my $max = $sorted[-1];
 125
 126                 print "$field $min $max\n";
 127         }
 128 }
 129
 130 my @events;
 131
 132 while (<>)
 133 {
 134         my $timestamp   = '\[(?:.*)\]';
 135         my $elapsed     = '\((?:.*)\)';
 136         my $hostname    = '(?:.*)';
 137         my $tp_event    = '(.*)';
 138         my $pkt_context = '(?:\{[^}]*\},\s)*';
 139         my $fields      = '\{(.*)\}$';
 140
 141         # Parse babeltrace text output format
 142         if (/$timestamp\s$elapsed\s$hostname\s$tp_event:\s$pkt_context$fields/) {
 143                 my %event_hash;
 144                 $event_hash{'tp_event'}    = $1;
 145                 $event_hash{'fields'}      = parse_fields($2);
 146
 147                 push @events, \%event_hash;
 148         }
 149 }
 150
 151 my %merged_fields = %{merge_fields(\@{events})};
 152 print_fields_stats(\%merged_fields, $opt_tracepoint);