mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
This is actually a library sort (lc with underbars removed), followed by a lexicographical sort. Comment lines are sticky to the line that follows them. Somehow the original version of this patch was missed in my earlier work on tidy_embed.pl, I think I messed up a rebase somehow. I noticed it was missing when I realized that new entries werent being sorted into place correctly. While this patch creates a fair bit of churn in the file right now, long term it will make it easier to use. Also note that the *output* files have not changed, which validates that the patch did not break anything.
80 lines
2.3 KiB
Perl
80 lines
2.3 KiB
Perl
use lib "regen";
|
|
use HeaderParser;
|
|
use strict;
|
|
use warnings;
|
|
|
|
my $parser= HeaderParser->new(
|
|
pre_process_content => sub {
|
|
my ($self,$line_data)= @_;
|
|
$self->tidy_embed_fnc_entry($line_data);
|
|
my $embed= $line_data->{embed}
|
|
or return;
|
|
},
|
|
post_process_grouped_content => sub {
|
|
my ($self, $group_ary)= @_;
|
|
my $last=chr(0x10FFFF);
|
|
for(my $i= $#$group_ary; $i>=0; $i--) {
|
|
my $entry= $group_ary->[$i];
|
|
if ($entry->{embed}) {
|
|
$last = $entry->{embed}{name};
|
|
}
|
|
$entry->{sort}{klc}= lc($last)=~s/[^a-z]+//gr;
|
|
$entry->{sort}{key}= $last;
|
|
$entry->{sort}{idx}= $i;
|
|
}
|
|
@{$group_ary}=
|
|
sort {
|
|
$a->{sort}{klc} cmp $b->{sort}{klc} ||
|
|
$a->{sort}{key} cmp $b->{sort}{key} ||
|
|
$a->{sort}{idx} <=> $b->{sort}{idx}
|
|
} @{$group_ary};
|
|
delete $_->{sort} for @$group_ary;
|
|
},
|
|
);
|
|
my $tap;
|
|
if (@ARGV and $ARGV[0] eq "--tap") {
|
|
$tap = shift @ARGV;
|
|
}
|
|
my $file= "embed.fnc";
|
|
if (@ARGV) {
|
|
$file= shift @ARGV;
|
|
}
|
|
my $new= "$file.new";
|
|
my $bak= "$file.bak";
|
|
$parser->read_file($file);
|
|
my $lines= $parser->lines;
|
|
my (@head, @tail);
|
|
# strip off comments at the start of the file
|
|
while ($lines->[0]{type} eq "content" and !$lines->[0]{embed}) {
|
|
push @head, shift @$lines;
|
|
}
|
|
|
|
# strip off comments at the bottom of the file
|
|
while ($lines->[-1]{type} eq "content" and !$lines->[-1]{embed})
|
|
{
|
|
unshift @tail, pop @$lines;
|
|
}
|
|
|
|
my $grouped_content_ary= $parser->group_content();
|
|
my $grouped_content_txt= $parser->lines_as_str(
|
|
[ @head, @$grouped_content_ary, @tail ]);
|
|
if ($grouped_content_txt ne $parser->{orig_content}) {
|
|
if ($tap) {
|
|
print "not ok - $0 $file\n";
|
|
} elsif (-t) {
|
|
print "Updating $file\n";
|
|
}
|
|
open my $fh,">",$new
|
|
or die "Failed to open '$new' for write: $!";
|
|
print $fh $grouped_content_txt
|
|
or die "Failed to print to '$new': $!";
|
|
close $fh
|
|
or die "Failed to close '$new': $!";
|
|
rename $file, $bak
|
|
or die "Couldn't move '$file' to '$bak': $!";
|
|
rename $new, $file
|
|
or die "Couldn't move embed.fnc.new to embed.fnc: $!";
|
|
} elsif ($tap) {
|
|
print "ok - $0 $file\n";
|
|
}
|