Для начала попробуем посмотреть как происходит вызов 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 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
К каждому имени дописывается номер найденной строки, поэтому из окошка плагина можно переходить по всем меткам, а не только по первой из них. Причём функции, переменные и блоки не валятся в общий список, а группируются:
ссылка на оригинал статьи http://habrahabr.ru/post/208754/
Добавить комментарий