123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116 |
- #!/usr/bin/env perl
- # SPDX-License-Identifier: GPL-2.0
- #
- # Treewide grep for references to files under Documentation, and report
- # non-existing files in stderr.
- use warnings;
- use strict;
- use Getopt::Long qw(:config no_auto_abbrev);
- my $scriptname = $0;
- $scriptname =~ s,.*/([^/]+/),$1,;
- # Parse arguments
- my $help = 0;
- my $fix = 0;
- GetOptions(
- 'fix' => \$fix,
- 'h|help|usage' => \$help,
- );
- if ($help != 0) {
- print "$scriptname [--help] [--fix-rst]\n";
- exit -1;
- }
- # Step 1: find broken references
- print "Finding broken references. This may take a while... " if ($fix);
- my %broken_ref;
- open IN, "git grep 'Documentation/'|"
- or die "Failed to run git grep";
- while (<IN>) {
- next if (!m/^([^:]+):(.*)/);
- my $f = $1;
- my $ln = $2;
- # Makefiles contain nasty expressions to parse docs
- next if ($f =~ m/Makefile/);
- # Skip this script
- next if ($f eq $scriptname);
- if ($ln =~ m,\b(\S*)(Documentation/[A-Za-z0-9\_\.\,\~/\*+-]*),) {
- my $prefix = $1;
- my $ref = $2;
- my $base = $2;
- $ref =~ s/[\,\.]+$//;
- my $fulref = "$prefix$ref";
- $fulref =~ s/^(\<file|ref)://;
- $fulref =~ s/^[\'\`]+//;
- $fulref =~ s,^\$\(.*\)/,,;
- $base =~ s,.*/,,;
- # Remove URL false-positives
- next if ($fulref =~ m/^http/);
- # Check if exists, evaluating wildcards
- next if (grep -e, glob("$ref $fulref"));
- if ($fix) {
- if (!($ref =~ m/(devicetree|scripts|Kconfig|Kbuild)/)) {
- $broken_ref{$ref}++;
- }
- } else {
- print STDERR "$f: $fulref\n";
- }
- }
- }
- exit 0 if (!$fix);
- # Step 2: Seek for file name alternatives
- print "Auto-fixing broken references. Please double-check the results\n";
- foreach my $ref (keys %broken_ref) {
- my $new =$ref;
- # get just the basename
- $new =~ s,.*/,,;
- # Seek for the same name on another place, as it may have been moved
- my $f="";
- $f = qx(find . -iname $new) if ($new);
- # usual reason for breakage: file renamed to .rst
- if (!$f) {
- $new =~ s/\.txt$/.rst/;
- $f=qx(find . -iname $new) if ($new);
- }
- my @find = split /\s+/, $f;
- if (!$f) {
- print STDERR "ERROR: Didn't find a replacement for $ref\n";
- } elsif (scalar(@find) > 1) {
- print STDERR "WARNING: Won't auto-replace, as found multiple files close to $ref:\n";
- foreach my $j (@find) {
- $j =~ s,^./,,;
- print STDERR " $j\n";
- }
- } else {
- $f = $find[0];
- $f =~ s,^./,,;
- print "INFO: Replacing $ref to $f\n";
- foreach my $j (qx(git grep -l $ref)) {
- qx(sed "s\@$ref\@$f\@g" -i $j);
- }
- }
- }
|