Commit | Line | Data |
---|---|---|
d8865498 CB |
1 | #!/usr/bin/perl |
2 | ||
9d16b343 | 3 | # Copyright (C) 2012 Christian Babeux <christian.babeux@efficios.com> |
d8865498 | 4 | # |
9d16b343 | 5 | # SPDX-License-Identifier: GPL-2.0-only |
d8865498 | 6 | # |
d8865498 CB |
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}) { | |
f6788fc4 MD |
85 | my $tp_event = $event->{'tp_event'}; |
86 | my $tracepoint = "${tp_event}"; | |
d8865498 CB |
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; | |
d9c3a893 | 110 | my @val = keys %{$merged_ref->{$tracepoint}->{$field}}; |
d8865498 CB |
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 | { | |
4b2c2c11 FD |
134 | my $timestamp = '\[(?:.*)\]'; |
135 | my $elapsed = '\((?:.*)\)'; | |
136 | my $hostname = '(?:.*)'; | |
137 | my $tp_event = '(.*)'; | |
138 | my $pkt_context = '(?:\{[^}]*\},\s)*'; | |
139 | my $fields = '\{(.*)\}$'; | |
d8865498 CB |
140 | |
141 | # Parse babeltrace text output format | |
4b2c2c11 | 142 | if (/$timestamp\s$elapsed\s$hostname\s$tp_event:\s$pkt_context$fields/) { |
d8865498 | 143 | my %event_hash; |
4b2c2c11 FD |
144 | $event_hash{'tp_event'} = $1; |
145 | $event_hash{'fields'} = parse_fields($2); | |
d8865498 CB |
146 | |
147 | push @events, \%event_hash; | |
148 | } | |
149 | } | |
150 | ||
151 | my %merged_fields = %{merge_fields(\@{events})}; | |
152 | print_fields_stats(\%merged_fields, $opt_tracepoint); |