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

    В редакторе mooedit есть плагин для вывода имён исходника. Использует он стандартный ctags, у которого с Perl работа, мягко говоря, не фонтан. Находит ctags только имена функций, а хотелось бы большего:




    Для начала попробуем посмотреть как происходит вызов ctags для Perl и подумать, как можно подменить утилиту для этого случая. После разглядывания moo/plugins/ctags/ctags-doc.cстановится понятно, что вызов в нашем случае такой:

    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 ) = @_;
        # $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 =~ /^[\$\%\@](.+)$/ ? $1 : $a;
                my $bn = $b =~ /^[\$\%\@](.+)$/ ? $1 : $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';
            # первый значащий токен после 'sub' должен быть PPI::Token::Word:
            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

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

    Similar posts

    AdBlock has stolen the banner, but banners are not teeth — they will be back

    More
    Ads

    Comments 4

      +1
      Используя $* для передачи параметров, вы рискуете нарваться на проблемы, если в аргументах будут пробелы. Простой тест:
      #!/bin/bash
      
      A1=($*)
      A2=("$@")
      
      echo ${#A1[@]}
      echo ${#A2[@]}
      

      Вызов скрипта как ./script.sh a b c d выдаст
      4
      4
      

      А вызов его же как ./script.sh a b "c d" выдаст
      4
      3
      

      Очевидно, что $* развернул аргументы неправильно. Для передачи всего набора аргументов в другой скрипт всегда нужно использовать "$@" — именно так, с кавычками.
        0
        Да, спасибо. Автопилот в данном случае почему-то не срабатывает :) Надо бы перепрограммировать ПЗУ наконец-то…
        –1
        Perl жив? О_О
          +3
          Пфф, Perl вас переживёт. :-)

        Only users with full accounts can post comments. Log in, please.