mirror of
https://github.com/vim-scripts/perl-support.vim.git
synced 2026-03-01 18:23:21 +01:00
de89316d51
- New global variable g:Perl_InsertFileHeader (suppress file description comment for new files). - Two new ex commands: PerlScriptArguments, PerlSwitches - Specifying command line arguments and Perl command line switches improved. - Bugfix: g:Perl_LoadMenus now works. - Bugfix: g:Perl_MapLeader now works. - Bugfix: syntax check under 64-Bit MS-Windows now works. - Some settings moved to the filetype plugin. - Removed superfluous settings from the filetype plugin. - Integration of Make moved into the toolbox. - Minor improvements.
207 lines
6.9 KiB
Perl
207 lines
6.9 KiB
Perl
#!/usr/bin/perl
|
|
#===============================================================================
|
|
#
|
|
# FILE: csv2err.pl
|
|
#
|
|
# USAGE: ./csv2err.pl [-hH] -i CSV-file -n source-file [ -o outfile ][ -s criterion ]
|
|
#
|
|
# DESCRIPTION: Generate a Vim-quickfix compatible errorfile from a CSV-file
|
|
# produced by Devel::NYTProf.
|
|
# Specify CSV-file with full path.
|
|
# Specify source-file with full path.
|
|
# OPTIONS: ---
|
|
# REQUIREMENTS: ---
|
|
# BUGS: ---
|
|
# NOTES: ---
|
|
# AUTHOR: Dr. Fritz Mehner (fgm), mehner@fh-swf.de
|
|
# COMPANY: FH Südwestfalen, Iserlohn
|
|
# VERSION: 2.0
|
|
# CREATED: 13.02.2009 17:04:00
|
|
#===============================================================================
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Getopt::Std;
|
|
use File::Basename;
|
|
|
|
our( $opt_H, $opt_h, $opt_i, $opt_o, $opt_s, $opt_n );
|
|
getopts('hHi:o:s:n:'); # process command line arguments
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# check for parameters
|
|
#-------------------------------------------------------------------------------
|
|
if ( defined $opt_h || !defined $opt_i ) { # process option -h
|
|
usage();
|
|
}
|
|
|
|
my $criterion = 'file line time calls time_per_call';
|
|
my $sortcriterion = 'none';
|
|
|
|
if ( defined $opt_s ) {
|
|
$sortcriterion = $opt_s;
|
|
usage() until $criterion =~ m/\b$opt_s\b/;
|
|
}
|
|
|
|
my $csv_file_name = $opt_i; # input file name
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# output file
|
|
#-------------------------------------------------------------------------------
|
|
|
|
if ( defined $opt_o ) {
|
|
open FILE, "> $opt_o" or do {
|
|
warn "Couldn't open $opt_o: $!. Using STDOUT instead.\n";
|
|
undef $opt_o;
|
|
};
|
|
}
|
|
|
|
my $handle = ( defined $opt_o ? \*FILE : \*STDOUT );
|
|
|
|
if ( defined $opt_o ) {
|
|
close FILE
|
|
or warn "$0 : failed to close output file '$opt_o' : $!\n";
|
|
unlink $opt_o;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# prepare file names
|
|
# The quickfix format needs the absolute file name of the source file.
|
|
# This file name is constructed from the mame of the csv-file, e.g.
|
|
# PATH/nytprof/test-pl-line.csv
|
|
# gives
|
|
# PATH/test.pl
|
|
# The name of the output file is also constructed:
|
|
# PATH/nytprof/test.pl.err
|
|
#-------------------------------------------------------------------------------
|
|
my $src_filename = $opt_n;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# read the CSV-file
|
|
#-------------------------------------------------------------------------------
|
|
open my $csv, '<', $csv_file_name
|
|
or die "$0 : failed to open input file '$csv_file_name' : $!\n";
|
|
|
|
my $line;
|
|
foreach my $i ( 1..3 ) { # read the header
|
|
$line = <$csv>;
|
|
print $line;
|
|
}
|
|
$line = <$csv>; # skip NYTProf format line
|
|
|
|
print "#\n# sort criterion: $sortcriterion\n";
|
|
print "# FORMAT: filename : line number : time : calls : time/call : code\n#\n";
|
|
|
|
my @rawline= <$csv>; # rest of the CSV-file
|
|
chomp @rawline;
|
|
|
|
close $csv
|
|
or warn "$0 : failed to close input file '$csv_file_name' : $!\n";
|
|
|
|
#---------------------------------------------------------------------------
|
|
# filter lines
|
|
# input format: <time>,<calls>,<time/call>,<source line>
|
|
# output format: <filename>:<line>:<time>:<calls>:<time/call>: <source line>
|
|
#---------------------------------------------------------------------------
|
|
my $sourcelinenumber = 0;
|
|
my $sourceline;
|
|
my $cookedline;
|
|
my @linepart;
|
|
my @line;
|
|
my $delim = ':';
|
|
|
|
|
|
foreach my $n ( 0..$#rawline ) {
|
|
$sourcelinenumber++;
|
|
@linepart = split ( /,/, $rawline[$n] );
|
|
$sourceline = join( ',', @linepart[3..$#linepart] );
|
|
$cookedline = $src_filename.$delim.$sourcelinenumber.$delim;
|
|
$cookedline .= join( $delim, @linepart[0..2] ).$delim.' ';
|
|
$cookedline .= $sourceline;
|
|
unless ( defined $opt_H && ( $linepart[0]+$linepart[1]+$linepart[2] == 0 ) ) {
|
|
push @line, $cookedline;
|
|
}
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# sort file names (field index 0)
|
|
#-------------------------------------------------------------------------------
|
|
if ( $sortcriterion eq 'file' ) {
|
|
@line = sort {
|
|
my $ind = ( $a !~ m/^[[:alpha:]]$delim/ ) ? 0 : 1;
|
|
my @a = split /$delim/, $a;
|
|
my @b = split /$delim/, $b;
|
|
$a[$ind] cmp $b[$ind]; # ascending
|
|
} @line;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# sort line numbers (field index 1)
|
|
#-------------------------------------------------------------------------------
|
|
if ( $sortcriterion eq 'line' ) {
|
|
@line = sort {
|
|
my $ind = ( $a !~ m/^[[:alpha:]]$delim/ ) ? 1 : 2;
|
|
my @a = split /$delim/, $a;
|
|
my @b = split /$delim/, $b;
|
|
$a[$ind] <=> $b[$ind]; # ascending
|
|
} @line;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# sort time (index 2)
|
|
#-------------------------------------------------------------------------------
|
|
if ( $sortcriterion eq 'time' ) {
|
|
@line = sort {
|
|
my $ind = ( $a !~ m/^[[:alpha:]]$delim/ ) ? 2 : 3;
|
|
my @a = split /$delim/, $a;
|
|
my @b = split /$delim/, $b;
|
|
$b[$ind] <=> $a[$ind]; # descending
|
|
} @line;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# sort calls (index 3)
|
|
#-------------------------------------------------------------------------------
|
|
if ( $sortcriterion eq 'calls' ) {
|
|
@line = sort {
|
|
my $ind = ( $a !~ m/^[[:alpha:]]$delim/ ) ? 3 : 4;
|
|
my @a = split /$delim/, $a;
|
|
my @b = split /$delim/, $b;
|
|
$b[$ind] <=> $a[$ind]; # descending
|
|
} @line;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# sort time_per_call (index 4)
|
|
#-------------------------------------------------------------------------------
|
|
if ( $sortcriterion eq 'time_per_call' ) {
|
|
@line = sort {
|
|
my $ind = ( $a !~ m/^[[:alpha:]]$delim/ ) ? 4 : 5;
|
|
my @a = split /$delim/, $a;
|
|
my @b = split /$delim/, $b;
|
|
$b[$ind] <=> $a[$ind]; # descending
|
|
} @line;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# write result
|
|
#-------------------------------------------------------------------------------
|
|
foreach my $line ( @line ) {
|
|
print $line, "\n";
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# subroutine usage()
|
|
#-------------------------------------------------------------------------------
|
|
sub usage {
|
|
print <<EOF;
|
|
usage: $0 [-hH] -i CSV-file -n source-file [ -o outfile ][ -s criterion ]
|
|
-h this message
|
|
-H hot spots only ( time, calls, and time/call are zero)
|
|
-i input file (CSV)
|
|
-n source file (*.pl or *.pm)
|
|
-s sort criterion (file, line, time, calls, time_per_call)
|
|
EOF
|
|
exit 0;
|
|
} # ---------- end of subroutine usage ----------
|