xref: /openbsd-src/gnu/usr.bin/perl/regen/tidy_embed.pl (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
1*f2a19305Safresh1use lib "regen";
2*f2a19305Safresh1use HeaderParser;
3*f2a19305Safresh1use strict;
4*f2a19305Safresh1use warnings;
5*f2a19305Safresh1
6*f2a19305Safresh1my $parser= HeaderParser->new(
7*f2a19305Safresh1        pre_process_content => sub {
8*f2a19305Safresh1            my ($self,$line_data)= @_;
9*f2a19305Safresh1            $self->tidy_embed_fnc_entry($line_data);
10*f2a19305Safresh1            my $embed= $line_data->{embed}
11*f2a19305Safresh1                or return;
12*f2a19305Safresh1        },
13*f2a19305Safresh1        post_process_grouped_content => sub {
14*f2a19305Safresh1            my ($self, $group_ary)= @_;
15*f2a19305Safresh1            my $last=chr(0x10FFFF);
16*f2a19305Safresh1            for(my $i= $#$group_ary; $i>=0; $i--) {
17*f2a19305Safresh1                my $entry= $group_ary->[$i];
18*f2a19305Safresh1                if ($entry->{embed}) {
19*f2a19305Safresh1                    $last = $entry->{embed}{name};
20*f2a19305Safresh1                }
21*f2a19305Safresh1                $entry->{sort}{klc}= lc($last)=~s/[^a-z]+//gr;
22*f2a19305Safresh1                $entry->{sort}{key}= $last;
23*f2a19305Safresh1                $entry->{sort}{idx}= $i;
24*f2a19305Safresh1            }
25*f2a19305Safresh1            @{$group_ary}=
26*f2a19305Safresh1                sort {
27*f2a19305Safresh1                    $a->{sort}{klc} cmp $b->{sort}{klc} ||
28*f2a19305Safresh1                    $a->{sort}{key} cmp $b->{sort}{key} ||
29*f2a19305Safresh1                    $a->{sort}{idx} <=> $b->{sort}{idx}
30*f2a19305Safresh1                } @{$group_ary};
31*f2a19305Safresh1            delete $_->{sort} for @$group_ary;
32*f2a19305Safresh1        },
33*f2a19305Safresh1    );
34*f2a19305Safresh1my $tap;
35*f2a19305Safresh1if (@ARGV and $ARGV[0] eq "--tap") {
36*f2a19305Safresh1    $tap = shift @ARGV;
37*f2a19305Safresh1}
38*f2a19305Safresh1my $file= "embed.fnc";
39*f2a19305Safresh1if (@ARGV) {
40*f2a19305Safresh1    $file= shift @ARGV;
41*f2a19305Safresh1}
42*f2a19305Safresh1my $new= "$file.new";
43*f2a19305Safresh1my $bak= "$file.bak";
44*f2a19305Safresh1$parser->read_file($file);
45*f2a19305Safresh1my $lines= $parser->lines;
46*f2a19305Safresh1my (@head, @tail);
47*f2a19305Safresh1# strip off comments at the start of the file
48*f2a19305Safresh1while ($lines->[0]{type} eq "content" and !$lines->[0]{embed}) {
49*f2a19305Safresh1    push @head, shift @$lines;
50*f2a19305Safresh1}
51*f2a19305Safresh1
52*f2a19305Safresh1# strip off comments at the bottom of the file
53*f2a19305Safresh1while ($lines->[-1]{type} eq "content" and !$lines->[-1]{embed})
54*f2a19305Safresh1{
55*f2a19305Safresh1    unshift @tail, pop @$lines;
56*f2a19305Safresh1}
57*f2a19305Safresh1
58*f2a19305Safresh1my $grouped_content_ary= $parser->group_content();
59*f2a19305Safresh1my $grouped_content_txt= $parser->lines_as_str(
60*f2a19305Safresh1    [ @head, @$grouped_content_ary, @tail ]);
61*f2a19305Safresh1if ($grouped_content_txt ne $parser->{orig_content}) {
62*f2a19305Safresh1    if ($tap) {
63*f2a19305Safresh1        print "not ok - $0 $file\n";
64*f2a19305Safresh1    } elsif (-t) {
65*f2a19305Safresh1        print "Updating $file\n";
66*f2a19305Safresh1    }
67*f2a19305Safresh1    open my $fh,">",$new
68*f2a19305Safresh1        or die "Failed to open '$new' for write: $!";
69*f2a19305Safresh1    print $fh $grouped_content_txt
70*f2a19305Safresh1        or die "Failed to print to '$new': $!";
71*f2a19305Safresh1    close $fh
72*f2a19305Safresh1        or die "Failed to close '$new': $!";
73*f2a19305Safresh1    rename $file, $bak
74*f2a19305Safresh1        or die "Couldn't move '$file' to '$bak': $!";
75*f2a19305Safresh1    rename $new, $file
76*f2a19305Safresh1        or die "Couldn't move embed.fnc.new to embed.fnc: $!";
77*f2a19305Safresh1} elsif ($tap) {
78*f2a19305Safresh1    print "ok - $0 $file\n";
79*f2a19305Safresh1}
80