scripts/documentation-file-ref-check: get rid of false-positives
[muen/linux.git] / scripts / documentation-file-ref-check
1 #!/usr/bin/env perl
2 # SPDX-License-Identifier: GPL-2.0
3 #
4 # Treewide grep for references to files under Documentation, and report
5 # non-existing files in stderr.
6
7 use warnings;
8 use strict;
9 use Getopt::Long qw(:config no_auto_abbrev);
10
11 my $scriptname = $0;
12 $scriptname =~ s,.*/([^/]+/),$1,;
13
14 # Parse arguments
15 my $help = 0;
16 my $fix = 0;
17
18 GetOptions(
19         'fix' => \$fix,
20         'h|help|usage' => \$help,
21 );
22
23 if ($help != 0) {
24     print "$scriptname [--help] [--fix]\n";
25     exit -1;
26 }
27
28 # Step 1: find broken references
29 print "Finding broken references. This may take a while...  " if ($fix);
30
31 my %broken_ref;
32
33 open IN, "git grep 'Documentation/'|"
34      or die "Failed to run git grep";
35 while (<IN>) {
36         next if (!m/^([^:]+):(.*)/);
37
38         my $f = $1;
39         my $ln = $2;
40
41         # Makefiles and scripts contain nasty expressions to parse docs
42         next if ($f =~ m/Makefile/ || $f =~ m/\.sh$/);
43
44         # Skip this script
45         next if ($f eq $scriptname);
46
47         if ($ln =~ m,\b(\S*)(Documentation/[A-Za-z0-9\_\.\,\~/\*\[\]\?+-]*)(.*),) {
48                 my $prefix = $1;
49                 my $ref = $2;
50                 my $base = $2;
51                 my $extra = $3;
52
53                 # some file references are like:
54                 # /usr/src/linux/Documentation/DMA-{API,mapping}.txt
55                 # For now, ignore them
56                 next if ($extra =~ m/^{/);
57
58                 # Remove footnotes at the end like:
59                 # Documentation/devicetree/dt-object-internal.txt[1]
60                 $ref =~ s/(txt|rst)\[\d+]$/$1/;
61
62                 # Remove ending ']' without any '['
63                 $ref =~ s/\].*// if (!($ref =~ m/\[/));
64
65                 # Remove puntuation marks at the end
66                 $ref =~ s/[\,\.]+$//;
67
68                 my $fulref = "$prefix$ref";
69
70                 $fulref =~ s/^(\<file|ref)://;
71                 $fulref =~ s/^[\'\`]+//;
72                 $fulref =~ s,^\$\(.*\)/,,;
73                 $base =~ s,.*/,,;
74
75                 # Remove URL false-positives
76                 next if ($fulref =~ m/^http/);
77
78                 # Check if exists, evaluating wildcards
79                 next if (grep -e, glob("$ref $fulref"));
80
81                 if ($fix) {
82                         if (!($ref =~ m/(scripts|Kconfig|Kbuild)/)) {
83                                 $broken_ref{$ref}++;
84                         }
85                 } else {
86                         print STDERR "$f: $fulref\n";
87                 }
88         }
89 }
90
91 exit 0 if (!$fix);
92
93 # Step 2: Seek for file name alternatives
94 print "Auto-fixing broken references. Please double-check the results\n";
95
96 foreach my $ref (keys %broken_ref) {
97         my $new =$ref;
98
99         # get just the basename
100         $new =~ s,.*/,,;
101
102         my $f="";
103
104         # usual reason for breakage: DT file moved around
105         if ($ref =~ /devicetree/) {
106                 my $search = $new;
107                 $search =~ s,^.*/,,;
108                 $f = qx(find Documentation/devicetree/ -iname "*$search*") if ($search);
109                 if (!$f) {
110                         # Manufacturer name may have changed
111                         $search =~ s/^.*,//;
112                         $f = qx(find Documentation/devicetree/ -iname "*$search*") if ($search);
113                 }
114         }
115
116         # usual reason for breakage: file renamed to .rst
117         if (!$f) {
118                 $new =~ s/\.txt$/.rst/;
119                 $f=qx(find . -iname $new) if ($new);
120         }
121
122         # usual reason for breakage: use dash or underline
123         if (!$f) {
124                 $new =~ s/[-_]/[-_]/g;
125                 $f=qx(find . -iname $new) if ($new);
126         }
127
128         # Wild guess: seek for the same name on another place
129         if (!$f) {
130                 $f = qx(find . -iname $new) if ($new);
131         }
132
133         my @find = split /\s+/, $f;
134
135         if (!$f) {
136                 print STDERR "ERROR: Didn't find a replacement for $ref\n";
137         } elsif (scalar(@find) > 1) {
138                 print STDERR "WARNING: Won't auto-replace, as found multiple files close to $ref:\n";
139                 foreach my $j (@find) {
140                         $j =~ s,^./,,;
141                         print STDERR "    $j\n";
142                 }
143         } else {
144                 $f = $find[0];
145                 $f =~ s,^./,,;
146                 print "INFO: Replacing $ref to $f\n";
147                 foreach my $j (qx(git grep -l $ref)) {
148                         qx(sed "s\@$ref\@$f\@g" -i $j);
149                 }
150         }
151 }