File Coverage

blib/lib/Fsdb/Filter/kitrace_to_db.pm
Criterion Covered Total %
statement 21 79 26.5
branch 0 16 0.0
condition n/a
subroutine 7 16 43.7
pod 5 5 100.0
total 33 116 28.4


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # kitrace_to_db.pm
5             # Copyright (C) 1995-2011 by John Heidemann
6             # $Id: bd1785eb7cda24f3cbb75aeeabcc7b4d20c0cd71 $
7             #
8             # This program is distributed under terms of the GNU general
9             # public license, version 2. See the file COPYING
10             # in $dblib for details.
11             #
12              
13             package Fsdb::Filter::kitrace_to_db;
14              
15             =head1 NAME
16              
17             kitrace_to_db - convert kitrace output to Fsdb format
18              
19             =head1 SYNOPSIS
20              
21             kitrace_to_db [-Y year] [registers] kitrace.fsdb
22              
23             =head1 DESCRIPTION
24              
25             Converts a kitrace data stream to Fsdb format.
26              
27             Optional arguments list registers
28             which will be picked out of the output stream
29             and formatted as their own columns.
30              
31             =head1 OPTIONS
32              
33             =over 4
34              
35             =item B<-Y Y> or B<--year Y>
36              
37             Specify the 4-digit year for the dataset (defaults to current year).
38              
39             =item B<-u> or B<--utc>
40              
41             Specify UTC timezone (defaults to local time zeon).
42              
43             =back
44              
45              
46             =for comment
47             begin_standard_fsdb_options
48              
49             This module also supports the standard fsdb options:
50              
51             =over 4
52              
53             =item B<-d>
54              
55             Enable debugging output.
56              
57             =item B<-i> or B<--input> InputSource
58              
59             Read from InputSource, typically a file name, or C<-> for standard input,
60             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
61              
62             =item B<-o> or B<--output> OutputDestination
63              
64             Write to OutputDestination, typically a file name, or C<-> for standard output,
65             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
66              
67             =item B<--autorun> or B<--noautorun>
68              
69             By default, programs process automatically,
70             but Fsdb::Filter objects in Perl do not run until you invoke
71             the run() method.
72             The C<--(no)autorun> option controls that behavior within Perl.
73              
74             =item B<--help>
75              
76             Show help.
77              
78             =item B<--man>
79              
80             Show full manual.
81              
82             =back
83              
84             =for comment
85             end_standard_fsdb_options
86              
87              
88             =head1 SAMPLE USAGE
89              
90             =head2 Input:
91              
92             _null_getpage+4 Nov 7 22:40:13.281070 ( ) pid 4893
93             _null_getpage+128 Nov 7 22:40:13.281756 ( 00.000686) pid 4893
94             _null_getpage+4 Nov 7 22:40:13.282694 ( 00.000938) pid 4893
95             _null_getpage+128 Nov 7 22:40:13.328709 ( 00.046015) pid 4893
96             _null_getpage+4 Nov 7 22:40:13.330758 ( 00.002049) pid 4893
97             _null_getpage+128 Nov 7 22:40:13.353830 ( 00.023072) pid 4893
98             _null_getpage+4 Nov 7 22:40:13.355566 ( 00.001736) pid 4893
99             _null_getpage+128 Nov 7 22:40:13.357169 ( 00.001603) pid 4893
100             _null_getpage+4 Nov 7 22:40:13.358780 ( 00.001611) pid 4893
101             _null_getpage+128 Nov 7 22:40:13.375844 ( 00.017064) pid 4893
102             _null_getpage+4 Nov 7 22:40:13.377850 ( 00.002006) pid 4893
103             _null_getpage+128 Nov 7 22:40:13.378358 ( 00.000508) pid 4893
104              
105             =head2 Command:
106              
107             kitrace_to_db -Y 1995
108              
109             =head2 Output:
110              
111             #fsdb event clock diff
112             _null_getpage+4 815812813.281070 0.0
113             _null_getpage+128 815812813.281756 00.000686
114             _null_getpage+4 815812813.282694 00.000938
115             _null_getpage+128 815812813.328709 00.046015
116             _null_getpage+4 815812813.330758 00.002049
117             _null_getpage+128 815812813.353830 00.023072
118             _null_getpage+4 815812813.355566 00.001736
119             _null_getpage+128 815812813.357169 00.001603
120             _null_getpage+4 815812813.358780 00.001611
121             _null_getpage+128 815812813.375844 00.017064
122             _null_getpage+4 815812813.377850 00.002006
123             _null_getpage+128 815812813.378358 00.000508
124             # | kitrace_to_db
125              
126              
127             =head1 SEE ALSO
128              
129             L.
130              
131              
132             =head1 CLASS FUNCTIONS
133              
134             =cut
135              
136             @ISA = qw(Fsdb::Filter);
137             $VERSION = 2.0;
138              
139 1     1   5276 use strict;
  1         3  
  1         28  
140 1     1   5 use Pod::Usage;
  1         2  
  1         73  
141 1     1   6 use Carp;
  1         1  
  1         42  
142 1     1   304 use Time::Local;
  1         1540  
  1         55  
143              
144 1     1   7 use Fsdb::Filter;
  1         2  
  1         18  
145 1     1   5 use Fsdb::IO::Reader;
  1         2  
  1         15  
146 1     1   5 use Fsdb::IO::Writer;
  1         2  
  1         840  
147              
148              
149             =head2 new
150              
151             $filter = new Fsdb::Filter::kitrace_to_db(@arguments);
152              
153             Create a new kitrace_to_db object, taking command-line arguments.
154              
155             =cut
156              
157             sub new ($@) {
158 0     0 1   my $class = shift @_;
159 0           my $self = $class->SUPER::new(@_);
160 0           bless $self, $class;
161 0           $self->set_defaults;
162 0           $self->parse_options(@_);
163 0           $self->SUPER::post_new();
164 0           return $self;
165             }
166              
167              
168             =head2 set_defaults
169              
170             $filter->set_defaults();
171              
172             Internal: set up defaults.
173              
174             =cut
175              
176             sub set_defaults ($) {
177 0     0 1   my($self) = @_;
178 0           $self->SUPER::set_defaults();
179 0           $self->{_registers} = [];
180 0           $self->{_year} = undef;
181 0           $self->{_utc} = undef;
182             }
183              
184             =head2 parse_options
185              
186             $filter->parse_options(@ARGV);
187              
188             Internal: parse command-line arguments.
189              
190             =cut
191              
192             sub parse_options ($@) {
193 0     0 1   my $self = shift @_;
194              
195 0           my(@argv) = @_;
196             $self->get_options(
197             \@argv,
198 0     0     'help|?' => sub { pod2usage(1); },
199 0     0     'man' => sub { pod2usage(-verbose => 2); },
200             'autorun!' => \$self->{_autorun},
201             'd|debug+' => \$self->{_debug},
202 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
203             'log!' => \$self->{_logprog},
204 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
205             'u|utc!' => \$self->{_utc},
206             'Y|year=i' => \$self->{_year},
207 0 0         ) or pod2usage(2);
208 0           push (@{$self->{_registers}}, @argv);
  0            
209             }
210              
211             =head2 setup
212              
213             $filter->setup();
214              
215             Internal: setup, parse headers.
216              
217             =cut
218              
219             sub setup ($) {
220 0     0 1   my($self) = @_;
221              
222 0 0         if (!defined($self->{_year})) {
223 0 0         my(@tm) = ($self->{_utc} ? gmtime : localtime);
224 0           $self->{_year} = $tm[5];
225             };
226              
227 0           $self->finish_fh_io_option('input');
228              
229 0           my @cols = qw(event clock diff);
230              
231             # Extract the registers, if any.
232 0           my $reg_input_code = '';
233 0           foreach my $reg (@{$self->{_registers}}) {
  0            
234 0           $reg =~ s/^%//; # strip % from %o0
235 0           push (@cols, $reg);
236 0           $reg_input_code .= '($r) = /' . $reg . '=([\da-fA-F]+)/; push(@outf, hex($r));';
237             };
238 0           $self->{_reg_input_code} = $reg_input_code;
239              
240 0           $self->finish_io_option('output', -cols => \@cols);
241              
242             }
243              
244             =head2 run
245              
246             $filter->run();
247              
248             Internal: run over each rows.
249              
250             =cut
251             sub run ($) {
252 0     0 1   my($self) = @_;
253              
254 0           my %MoY = qw(Jan 0
255             Feb 1
256             Mar 2
257             Apr 3
258             May 4
259             Jun 5
260             Jul 6
261             Aug 7
262             Sep 8
263             Oct 9
264             Nov 10
265             Dec 11);
266 0           my $in_fh = $self->{_in};
267 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
268              
269 0           my $year = $self->{_year};
270 0           my @outf;
271             my $reg_input_sub;
272 0           my $eval = "\$reg_input_sub = sub {\n" . $self->{_reg_input_code} . "\n};\n";
273 0           eval $eval;
274 0 0         $@ && die $self->{_prog} . ": internal eval error: $@.\n";
275              
276              
277 0           for (;;) {
278 0           my $line = $self->{_in}->getline;
279 0 0         last if (!defined($line));
280              
281 0 0         if ($line =~ /^Warning:\s+(\d+) traces were lost/) {
282 0           carp "lost_traces\t$1\t0\n";
283 0           next;
284             };
285 0           my($event, $month, $day, $hour, $min, $sec, $frac, $diff) =
286             ($line =~ /(\S+)\s+(\w{3})\s+(\d+)\s+(\d{2}):(\d{2}):(\d{2})(\.\d{6})\s+\(\s*([^)]+)\)/);
287 0 0         $diff = '0.0' if ($diff !~ /\d/);
288             my $t = ($self->{_utc} ?
289             timegm($sec, $min, $hour, $day, $MoY{$month}, $year) :
290 0 0         timelocal($sec, $min, $hour, $day, $MoY{$month}, $year));
291 0           @outf = ($event, "$t$frac", $diff);
292 0           &{$reg_input_sub}();
  0            
293 0           &{$write_fastpath_sub}(\@outf);
  0            
294             };
295             }
296              
297              
298              
299             =head1 AUTHOR and COPYRIGHT
300              
301             Copyright (C) 1991-2011 by John Heidemann
302              
303             This program is distributed under terms of the GNU general
304             public license, version 2. See the file COPYING
305             with the distribution for details.
306              
307             =cut
308              
309             1;