perl - 按字母顺序对模块子例程进行排序

Question

我想按字母顺序对我的模块子例程进行排序(我有很多子例程，我认为如果子例程在文件中排序，编辑文件会更容易)。例如给定 A.pm:

package A;
use warnings;
use strict;

sub subA {
  print "A\n";
}

sub subC {
  print "C\n";
}
sub subB {
  print "B\n";
}

1;

我想运行一个 sortSub A.pm 给出:

package A;
use warnings;
use strict;

sub subA {
  print "A\n";
}
sub subB {
  print "B\n";
}
sub subC {
  print "C\n";
}
1;

是否有任何 CPAN 资源可以帮助完成此任务？

Answer 1

要解析和重新格式化 Perl 代码，您应该使用 PPI .

这与 Perl::Critic 是同一个工具。和 Perl::Tidy用于完成他们所有的壮举。

在本例中，我研究了 PPI::Dumper 的代码了解如何导航 PPI 返回的文档树。

下面将解析源代码并分离出包含子例程和注释的部分。它将在子例程之前将注释、pod 和空格绑定(bind)在一起，然后按名称对所有相邻子例程进行排序。

use strict;
use warnings;

use PPI;
use Data::Dump;

my $src = do { local $/; <DATA> };

# Load a document
my $doc = PPI::Document->new( \$src );

# Save Sub locations for later sorting
my @group = ();
my @subs  = ();

for my $i ( 0 .. $#{ $doc->{children} } ) {
    my $child = $doc->{children}[$i];

    my ( $subtype, $subname )
        = $child->isa('PPI::Statement::Sub')
        ? grep { $_->isa('PPI::Token::Word') } @{ $child->{children} }
        : ( '', '' );

    # Look for grouped subs, whitespace and comments.  Sort each group separately.
    my $is_related = ($subtype eq 'sub') || grep { $child->isa("PPI::Token::$_") } qw(Whitespace Comment Pod);

    # State change or end of stream
    if ( my $range = $is_related .. ( !$is_related || ( $i == $#{ $doc->{children} } ) ) ) {
        if ($is_related) {
            push @group, $child;

            if ( $subtype ) {
                push @subs, { name => "$subname", children => [@group] };
                @group = ();
            }
        }

        if ( $range =~ /E/ ) {
            @group = ();

            if (@subs) {
                # Sort and Flatten
                my @sorted = map { @{ $_->{children} } } sort { $a->{name} cmp $b->{name} } @subs;

                # Assign back to document, and then reset group
                my $min_index = $i - $range + 1;
                @{ $doc->{children} }[ $min_index .. $min_index + $#sorted ] = @sorted;

                @subs = ();
            }
        }
    }
}

print $doc->serialize;

1;

__DATA__
package A;
use warnings;
use strict;

=comment
Pod describing subC
=cut
sub subC {
    print "C\n";
}

INIT {
    print "Hello World";
}

sub subB {
    print "B\n";
}

# Hello subA comment
sub subA {
    print "A\n";
}

1;

输出:

package A;
use warnings;
use strict;

=comment
Pod describing subC
=cut
sub subC {
    print "C\n";
}

INIT {
    print "Hello World";
}

# Hello subA comment
sub subA {
    print "A\n";
}

sub subB {
    print "B\n";
}

1;