Замена ctags для Perl в mooedit

В редакторе 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 редактор ожидает такие строки:

имя файл номер_строки;" kind

kind (в терминологии потрохов 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 file\n" 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:$line\t$ARGV[0]\t$line;\"\t$type\n";
        }
    }
}

# ------------------------------------------------------------------------------
# @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

К каждому имени дописывается номер найденной строки (для ориентировки), и из окошка плагина можно переходить по всем меткам, а не только по первой из них. Причём функции, переменные и блоки не валятся в общий список, а группируются:

This entry passed through the Full-Text RSS service — if this is your content and you're reading it on someone else's site, please read the FAQ at fivefilters.org/content-only/faq.php#publishers.