Commit | Line | Data |
---|---|---|
d8865498 CB |
1 | #!/usr/bin/perl |
2 | ||
3 | # Copyright (C) - 2012 Christian Babeux <christian.babeux@efficios.com> | |
4 | # | |
5 | # This program is free software; you can redistribute it and/or modify it | |
6 | # under the terms of the GNU General Public License, version 2 only, as | |
7 | # published by the Free Software Foundation. | |
8 | # | |
9 | # This program is distributed in the hope that it will be useful, but WITHOUT | |
10 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
11 | # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for | |
12 | # more details. | |
13 | # | |
14 | # You should have received a copy of the GNU General Public License along with | |
15 | # this program; if not, write to the Free Software Foundation, Inc., 51 | |
16 | # Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | ||
18 | use strict; | |
19 | use warnings; | |
20 | ||
21 | use Getopt::Long; | |
22 | ||
23 | my $opt_tracepoint; | |
24 | ||
25 | GetOptions('tracepoint=s' => \$opt_tracepoint) | |
26 | or die("Invalid command-line option\n"); | |
27 | ||
28 | defined($opt_tracepoint) | |
29 | or die("Missing tracepoint, use --tracepoint <name>"); | |
30 | ||
31 | # Parse an array string. | |
32 | # The format is as follow: [ [index] = value, ... ] | |
33 | sub parse_array | |
34 | { | |
35 | my ($arr_str) = @_; | |
36 | my @array = (); | |
37 | ||
38 | # Strip leading and ending brackets, remove whitespace | |
39 | $arr_str =~ s/^\[//; | |
40 | $arr_str =~ s/\]$//; | |
41 | $arr_str =~ s/\s//g; | |
42 | ||
43 | my @entries = split(',', $arr_str); | |
44 | ||
45 | foreach my $entry (@entries) { | |
46 | if ($entry =~ /^\[(\d+)\]=(\d+)$/) { | |
47 | my $index = $1; | |
48 | my $value = $2; | |
49 | splice @array, $index, 0, $value; | |
50 | } | |
51 | } | |
52 | ||
53 | return \@array; | |
54 | } | |
55 | ||
56 | # Parse fields values. | |
57 | # Format can either be a name = array or a name = value pair. | |
58 | sub parse_fields | |
59 | { | |
60 | my ($fields_str) = @_; | |
61 | my %fields_hash; | |
62 | ||
63 | my $field_name = '[\w\d_]+'; | |
64 | my $field_value = '[\w\d_\\\*"]+'; | |
65 | my $array = '\[(?:\s\[\d+\]\s=\s\d+,)*\s\[\d+\]\s=\s\d+\s\]'; | |
66 | ||
67 | # Split the various fields | |
68 | my @fields = ($fields_str =~ /$field_name\s=\s(?:$array|$field_value)/g); | |
69 | ||
70 | foreach my $field (@fields) { | |
71 | if ($field =~ /($field_name)\s=\s($array)/) { | |
72 | my $name = $1; | |
73 | my $value = parse_array($2); | |
74 | $fields_hash{$name} = $value; | |
75 | } | |
76 | ||
77 | if ($field =~ /($field_name)\s=\s($field_value)/) { | |
78 | my $name = $1; | |
79 | my $value = $2; | |
80 | $fields_hash{$name} = $value; | |
81 | } | |
82 | } | |
83 | ||
84 | return \%fields_hash; | |
85 | } | |
86 | ||
87 | # Using an event array, merge all the fields | |
88 | # of a particular tracepoint. | |
89 | sub merge_fields | |
90 | { | |
91 | my ($events_ref) = @_; | |
92 | my %merged; | |
93 | ||
94 | foreach my $event (@{$events_ref}) { | |
f6788fc4 MD |
95 | my $tp_event = $event->{'tp_event'}; |
96 | my $tracepoint = "${tp_event}"; | |
d8865498 CB |
97 | |
98 | foreach my $key (keys %{$event->{'fields'}}) { | |
99 | my $val = $event->{'fields'}->{$key}; | |
100 | ||
101 | # TODO: Merge of array is not implemented. | |
102 | next if (ref($val) eq 'ARRAY'); | |
103 | $merged{$tracepoint}{$key}{$val} = undef; | |
104 | } | |
105 | } | |
106 | ||
107 | return \%merged; | |
108 | } | |
109 | ||
110 | # Print the minimum and maximum of each fields | |
111 | # for a particular tracepoint. | |
112 | sub print_fields_stats | |
113 | { | |
114 | my ($merged_ref, $tracepoint) = @_; | |
115 | ||
116 | return unless ($tracepoint && exists $merged_ref->{$tracepoint}); | |
117 | ||
118 | foreach my $field (keys %{$merged_ref->{$tracepoint}}) { | |
119 | my @sorted; | |
d9c3a893 | 120 | my @val = keys %{$merged_ref->{$tracepoint}->{$field}}; |
d8865498 CB |
121 | |
122 | if ($val[0] =~ /^\d+$/) { | |
123 | # Sort numerically | |
124 | @sorted = sort { $a <=> $b } @val; | |
125 | } elsif ($val[0] =~ /^0x[\da-f]+$/i) { | |
126 | # Convert the hex values and sort numerically | |
127 | @sorted = sort { hex($a) <=> hex($b) } @val; | |
128 | } else { | |
129 | # Fallback, alphabetical sort | |
130 | @sorted = sort { lc($a) cmp lc($b) } @val; | |
131 | } | |
132 | ||
133 | my $min = $sorted[0]; | |
134 | my $max = $sorted[-1]; | |
135 | ||
136 | print "$field $min $max\n"; | |
137 | } | |
138 | } | |
139 | ||
140 | my @events; | |
141 | ||
142 | while (<>) | |
143 | { | |
4b2c2c11 FD |
144 | my $timestamp = '\[(?:.*)\]'; |
145 | my $elapsed = '\((?:.*)\)'; | |
146 | my $hostname = '(?:.*)'; | |
147 | my $tp_event = '(.*)'; | |
148 | my $pkt_context = '(?:\{[^}]*\},\s)*'; | |
149 | my $fields = '\{(.*)\}$'; | |
d8865498 CB |
150 | |
151 | # Parse babeltrace text output format | |
4b2c2c11 | 152 | if (/$timestamp\s$elapsed\s$hostname\s$tp_event:\s$pkt_context$fields/) { |
d8865498 | 153 | my %event_hash; |
4b2c2c11 FD |
154 | $event_hash{'tp_event'} = $1; |
155 | $event_hash{'fields'} = parse_fields($2); | |
d8865498 CB |
156 | |
157 | push @events, \%event_hash; | |
158 | } | |
159 | } | |
160 | ||
161 | my %merged_fields = %{merge_fields(\@{events})}; | |
162 | print_fields_stats(\%merged_fields, $opt_tracepoint); |