1#!/usr/bin/perl 2# 3# Check for obsolete strings in source files. 4# 5# Examine all source files in a distribution for obsolete strings and report 6# on files that fail this check. This catches various transitions I want to 7# do globally in all my packages, like changing my personal URLs to https. 8# 9# The canonical version of this file is maintained in the rra-c-util package, 10# which can be found at <https://www.eyrie.org/~eagle/software/rra-c-util/>. 11# 12# Copyright 2016, 2018-2020 Russ Allbery <eagle@eyrie.org> 13# 14# Permission is hereby granted, free of charge, to any person obtaining a 15# copy of this software and associated documentation files (the "Software"), 16# to deal in the Software without restriction, including without limitation 17# the rights to use, copy, modify, merge, publish, distribute, sublicense, 18# and/or sell copies of the Software, and to permit persons to whom the 19# Software is furnished to do so, subject to the following conditions: 20# 21# The above copyright notice and this permission notice shall be included in 22# all copies or substantial portions of the Software. 23# 24# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 25# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 26# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 27# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 28# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 29# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 30# DEALINGS IN THE SOFTWARE. 31# 32# SPDX-License-Identifier: MIT 33 34use 5.010; 35use strict; 36use warnings; 37 38use lib "$ENV{C_TAP_SOURCE}/tap/perl"; 39 40use Test::RRA qw(skip_unless_author); 41use Test::RRA::Automake qw(all_files automake_setup); 42 43use File::Basename qw(basename); 44use Test::More; 45 46# Bad patterns to search for. 47my @BAD_REGEXES = (qr{ http:// \S+ [.]eyrie[.]org }xms); 48my @BAD_STRINGS = qw(rra@stanford.edu RRA_MAINTAINER_TESTS); 49 50# File names to exclude from this check. 51my %EXCLUDE 52 = map { $_ => 1 } qw(NEWS changelog obsolete-strings.t obsolete-strings-t); 53 54# Only run this test for the package author, since it doesn't indicate any 55# user-noticable flaw in the package itself. 56skip_unless_author('Obsolete strings tests'); 57 58# Set up Automake testing. 59automake_setup(); 60 61# Check a single file for one of the bad patterns. 62# 63# $path - Path to the file 64# 65# Returns: undef 66sub check_file { 67 my ($path) = @_; 68 my $filename = basename($path); 69 70 # Ignore excluded and binary files. 71 return if $EXCLUDE{$filename}; 72 return if !-T $path; 73 74 # Scan the file. 75 open(my $fh, '<', $path) or BAIL_OUT("Cannot open $path"); 76 while (defined(my $line = <$fh>)) { 77 for my $regex (@BAD_REGEXES) { 78 if ($line =~ $regex) { 79 ok(0, "$path contains $regex"); 80 close($fh) or BAIL_OUT("Cannot close $path"); 81 return; 82 } 83 } 84 for my $string (@BAD_STRINGS) { 85 if (index($line, $string) != -1) { 86 ok(0, "$path contains $string"); 87 close($fh) or BAIL_OUT("Cannot close $path"); 88 return; 89 } 90 } 91 } 92 close($fh) or BAIL_OUT("Cannot close $path"); 93 ok(1, $path); 94 return; 95} 96 97# Scan every file for any of the bad patterns or strings. We don't declare a 98# plan since we skip a lot of files and don't want to precalculate the file 99# list. 100my @paths = all_files(); 101for my $path (@paths) { 102 check_file($path); 103} 104done_testing(); 105