mirror of
https://gitlab.com/libvirt/libvirt.git
synced 2024-07-11 12:25:52 +00:00
90b17aef1a
This is particularly useful on operating systems that don't ship Perl as part of the base system (eg. FreeBSD) while still working just as well as it did before on Linux. In one case (src/rpc/genprotocol.pl) the interpreter path was missing altogether. Signed-off-by: Andrea Bolognani <abologna@redhat.com>
42 lines
713 B
Perl
Executable File
42 lines
713 B
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
(my $ME = $0) =~ s|.*/||;
|
|
# use File::Coda; # http://meyering.net/code/Coda/
|
|
END {
|
|
defined fileno STDOUT or return;
|
|
close STDOUT and return;
|
|
warn "$ME: failed to close standard output: $!\n";
|
|
$? ||= 1;
|
|
}
|
|
|
|
|
|
my @data = <>;
|
|
|
|
|
|
my %trace;
|
|
my %lines;
|
|
|
|
foreach (@data) {
|
|
if (/^\s*TRACE:\s+(\S+?)(?:\(.*\))?\s+\[0x(.*)\]\s*$/ ) {
|
|
$trace{$2} = $1;
|
|
}
|
|
}
|
|
|
|
foreach my $key (keys %trace) {
|
|
my $val = $trace{$key};
|
|
my $info = $val =~ /\?\?/ ? $val : `addr2line -e $val $key`;
|
|
$lines{$key} = $info;
|
|
}
|
|
|
|
|
|
foreach (@data) {
|
|
if (/^\s*TRACE:\s+(\S+?)(?:\(.*\))?\s+\[0x(.*)\]\s*$/ ) {
|
|
print $lines{$2};
|
|
} else {
|
|
print;
|
|
}
|
|
}
|