В редакторе mooedit есть плагин для вывода имён исходника. Использует он стандартный ctags, у которого с Perl работа, мягко говоря, не фонтан. Находит ctags только имена функций, а хотелось бы большего:
Для начала попробуем посмотреть как происходит вызов ctags для исходников на Perl и подумать, как можно подменить утилиту для этого случая. После разглядывания исходников становится понятно, что вызов в нашем случае такой:
ctags -u --fields=afksS --excmd=number -f 'временный_файл' 'файл с исходником'Никакого явного указания на то, что это Perl, здесь нет. Поэтому отлавливать ситуацию будем с помощью утилиты file. Создадим файл ~/bin/ctags, который будет вызываться вместо системного ctags:
#!/bin/bash
FILE=`file $6 2>&1`
RX='Perl.*'
if [[ "$FILE" =~ $RX ]] ; then
~/bin/perltags $6 > $5
else
/usr/bin/ctags $*
fiТеперь надо подумать, что из себя будет представлять ~/bin/perltags. В принципе, пользователям vim знакомы утилиты pltags и perltags, но и они меня совсем не удовлетворили. В CPAN нашлась утилита perl-tags. Но для использования вместе с mooedit её всё равно пришлось бы допиливать напильником, поэтому (да и just for fun) решил написать своё.
Сначала разберёмся с форматом. После запуска ctags редактор ожидает такие строки:
имя файл номер_строки;" kindkind (в терминологии потрохов mooedit) — это тип имени (f — функция, v — переменная, etc).
В хвост номера строки добавлены два символа (;") — это не опечатка, без них редактор просто падает (видимо, ошмёток после --excmd=number).
С этом вроде всё, теперь нужно понять чем именно парсить. Совсем уж глубокий анализ исходников нам не нужен, но и руками разбирать исходник — не комильфо. Поэтому берём PPI, и через какое-то время появляется
#!/usr/bin/perl
# ------------------------------------------------------------------------------
use 5.010;
use strict;
use PPI;
my %variables;
my %scheduled;
my %subs;
# ------------------------------------------------------------------------------
die "Usage: $0 filen" unless $ARGV[0];
my $doc = PPI::Document->new( $ARGV[0] );
die "'$ARGV[0]', PPI::Document error!n" unless $doc;
# ------------------------------------------------------------------------------
my @tokens = $doc->children;
foreach my $token ( @tokens )
{
given ( $token->class )
{
process_statement( $token ) when 'PPI::Statement';
process_variable( $token ) when 'PPI::Statement::Variable';
process_sub( $token ) when 'PPI::Statement::Sub';
process_scheduled( $token ) when 'PPI::Statement::Scheduled';
}
}
print_names( %variables, 'v' );
print_names( %subs, 'f' );
print_names( %scheduled, 'p' );
# ------------------------------------------------------------------------------
sub add_name
{
my ( $list, $token, $content ) = @_;
my $name = $token->content;
$list->{$name} = () unless exists $list->{$name};
$list->{$name}->{ $token->line_number } = $content;
}
# ------------------------------------------------------------------------------
sub print_names
{
my ( $list, $type ) = @_;
foreach my $name (
sort {
my $an = $a; $an = $1 if $a =~ /^[$%@](.+)$/;
my $bn = $b; $bn = $1 if $b =~ /^[$%@](.+)$/;
lc $an cmp lc $bn;
} keys $list )
{
foreach my $line ( sort { $a <=> $b } keys $list->{$name} )
{
print "$name:$linet$ARGV[0]t$line;"t$typen";
}
}
}
# ------------------------------------------------------------------------------
# @EXPORT = qw(aaa), @EXPORT_OK = qw(bbb);
# ------------------------------------------------------------------------------
sub process_statement
{
my ( $tok ) = @_;
my @tokens = $tok->children;
return unless $#tokens > 0;
foreach my $token ( @tokens )
{
add_name( %variables, $token, $tok->content )
if $token->class eq 'PPI::Token::Symbol';
}
}
# ------------------------------------------------------------------------------
# sub aaa($$$);
# sub aaa{};
# ------------------------------------------------------------------------------
sub process_sub
{
my ( $tok ) = @_;
my @tokens = $tok->children;
return unless $#tokens > 1;
shift @tokens;
foreach my $token ( @tokens )
{
next
if $token->class eq 'PPI::Token::Whitespace'
or $token->class eq 'PPI::Token::Comment'
or $token->class eq 'PPI::Token::Pod';
return unless $token->class eq 'PPI::Token::Word';
add_name( %subs, $token, $tok->content );
last;
}
}
# ------------------------------------------------------------------------------
# my $aaa;
# our ($aaa, $bbb);
# ------------------------------------------------------------------------------
sub process_variable
{
my ( $tok ) = @_;
my @tokens = $tok->children;
foreach my $token ( @tokens )
{
process_variable( $token ), next if $token->class eq 'PPI::Structure::List';
process_variable( $token ), next if $token->class eq 'PPI::Statement::Expression';
add_name( %variables, $token, $tok->content )
if $token->class eq 'PPI::Token::Symbol';
}
}
# ------------------------------------------------------------------------------
# BEGIN {}; CHECK, UNITCHECK, INIT, END
# ------------------------------------------------------------------------------
sub process_scheduled
{
my ( $tok ) = @_;
my @tokens = $tok->children;
return unless $#tokens > 0;
add_name( %scheduled, $tokens[0], $tok->content );
}
# ------------------------------------------------------------------------------Что он умеет:
- Находить имена функций, в том числе и при объявлениях
- Находить имена глобальных переменных, в том числе и их вхождения в выражения
- Находить блоки BEGIN, END etc
К каждому имени дописывается номер найденной строки (для ориентировки), и из окошка плагина можно переходить по всем меткам, а не только по первой из них. Причём функции, переменные и блоки не валятся в общий список, а группируются:
Автор: kloppspb
