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-2021 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 't/lib'; 39 40use Test::RRA qw(skip_unless_automated); 41 42use File::Find qw(find); 43use Test::More; 44 45# Bad patterns to search for. 46my @BAD_REGEXES = (qr{ http:// \S+ [.]eyrie[.]org }xms); 47my @BAD_STRINGS = qw(rra@stanford.edu RRA_MAINTAINER_TESTS); 48 49# File or directory names to always skip. 50my %SKIP = map { $_ => 1 } qw( 51 .git .pc Changes _build blib changelog cover_db obsolete-strings.t 52); 53 54# Only run this test during automated testing, since failure doesn't indicate 55# any user-noticable flaw in the package itself. 56skip_unless_automated('Obsolete strings tests'); 57 58# Scan files for bad URL patterns. This is meant to be run as the wanted 59# function from File::Find. 60sub check_file { 61 my $filename = $_; 62 63 # Ignore and prune any skipped files. Ignore directories and binaries. 64 if ($SKIP{$filename}) { 65 $File::Find::prune = 1; 66 return; 67 } 68 return if -d $filename; 69 return if !-T $filename; 70 71 # Scan the file. 72 open(my $fh, '<', $filename) or BAIL_OUT("Cannot open $File::Find::name"); 73 while (defined(my $line = <$fh>)) { 74 for my $regex (@BAD_REGEXES) { 75 if ($line =~ $regex) { 76 ok(0, "$File::Find::name contains $regex"); 77 close($fh) or BAIL_OUT("Cannot close $File::Find::name"); 78 return; 79 } 80 } 81 for my $string (@BAD_STRINGS) { 82 if (index($line, $string) != -1) { 83 ok(0, "$File::Find::name contains $string"); 84 close($fh) or BAIL_OUT("Cannot close $File::Find::name"); 85 return; 86 } 87 } 88 } 89 close($fh) or BAIL_OUT("Cannot close $File::Find::name"); 90 ok(1, $File::Find::name); 91 return; 92} 93 94# Use File::Find to scan all files from the top of the directory. 95find(\&check_file, q{.}); 96done_testing(); 97