perlcheck: add script, run in CI, fix fallouts

Add script to run all Perl sources through `perl -c` to ensure no
issues, and run this script via GHA/checksrc in CI.

Fallouts:
- fix two repeated declarations.
- move `shell_quote()` from `testutil.pm` to `pathhelp.pm`, to
  avoid circular dependency in `globalconfig.pm`.

Closes #18745
This commit is contained in:
Viktor Szakats 2025-09-25 01:54:28 +02:00
parent 72f72f678d
commit 34b1e146e4
No known key found for this signature in database
GPG key ID: B5ABD165E2AEF201
11 changed files with 84 additions and 30 deletions

View file

@ -82,6 +82,10 @@ jobs:
source ~/venv/bin/activate
scripts/cmakelint.sh
- name: 'perlcheck'
run: |
scripts/perlcheck.sh
- name: 'pytype'
run: |
source ~/venv/bin/activate

View file

@ -25,7 +25,8 @@
EXTRA_DIST = coverage.sh completion.pl firefox-db2pem.sh checksrc.pl checksrc-all.pl \
mk-ca-bundle.pl mk-unity.pl schemetable.c cd2nroff nroff2cd cdall cd2cd managen \
dmaketgz maketgz release-tools.sh verify-release cmakelint.sh mdlinkcheck \
CMakeLists.txt pythonlint.sh randdisable wcurl top-complexity extract-unit-protos
CMakeLists.txt perlcheck.sh pythonlint.sh randdisable wcurl top-complexity \
extract-unit-protos
dist_bin_SCRIPTS = wcurl

47
scripts/perlcheck.sh Executable file
View file

@ -0,0 +1,47 @@
#!/bin/sh
#***************************************************************************
# _ _ ____ _
# Project ___| | | | _ \| |
# / __| | | | |_) | |
# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
# Copyright (C) Dan Fandrich, <dan@coneharvesters.com>, Viktor Szakats, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
# SPDX-License-Identifier: curl
#
###########################################################################
# The xargs invocation is portable, but does not preserve spaces in file names.
# If such a file is ever added, then this can be portably fixed by switching to
# "xargs -I{}" and appending {} to the end of the xargs arguments (which will
# call cmakelint once per file) or by using the GNU extension "xargs -d'\n'".
set -eu
cd "$(dirname "$0")"/..
{
if [ -n "${1:-}" ]; then
for A in "$@"; do printf "%s\n" "$A"; done
elif git rev-parse --is-inside-work-tree >/dev/null 2>&1; then
{
git ls-files | grep -E '\.(pl|pm)$'
git grep -l -E '^#!/usr/bin/env perl'
} | sort -u
else
# strip off the leading ./ to make the grep regexes work properly
find . -type f \( -name '*.pl' -o -name '*.pm' \) | sed 's@^\./@@'
fi
} | xargs -n 1 perl -c -Itests

View file

@ -78,11 +78,9 @@ BEGIN {
use pathhelp qw(
exe_ext
dirsepadd
);
use Cwd qw(getcwd);
use testutil qw(
shell_quote
);
use Cwd qw(getcwd);
use File::Spec;

View file

@ -60,6 +60,7 @@ BEGIN {
os_is_win
exe_ext
dirsepadd
shell_quote
sys_native_abs_path
sys_native_current_path
build_sys_abs_path
@ -192,4 +193,23 @@ sub dirsepadd {
return $dir . '/';
}
#######################################################################
# Quote an argument for passing safely to a Bourne shell
# This does the same thing as String::ShellQuote but doesn't need a package.
#
sub shell_quote {
my ($s)=@_;
if($^O eq 'MSWin32') {
$s = '"' . $s . '"';
}
else {
if($s !~ m/^[-+=.,_\/:a-zA-Z0-9]+$/) {
# string contains a "dangerous" character--quote it
$s =~ s/'/'"'"'/g;
$s = "'" . $s . "'";
}
}
return $s;
}
1; # End of module

View file

@ -84,6 +84,7 @@ use Storable qw(
use pathhelp qw(
exe_ext
shell_quote
);
use servers qw(
checkcmd
@ -100,7 +101,6 @@ use testutil qw(
logmsg
runclient
exerunner
shell_quote
subbase64
subsha256base64file
substrippemfile

View file

@ -91,6 +91,7 @@ use serverhelp qw(
use pathhelp qw(
exe_ext
sys_native_current_path
shell_quote
);
use appveyor;

View file

@ -105,6 +105,7 @@ use pathhelp qw(
os_is_win
build_sys_abs_path
sys_native_abs_path
shell_quote
);
use processhelp;
@ -114,7 +115,6 @@ use testutil qw(
runclient
runclientoutput
exerunner
shell_quote
);

View file

@ -45,7 +45,8 @@ sub gettypecheck {
}
sub getinclude {
open(my $f, "<", "$root/include/curl/curl.h")
my $f;
open($f, "<", "$root/include/curl/curl.h")
|| die "no curl.h";
while(<$f>) {
if($_ =~ /\((CURLOPT[^,]*), (CURLOPTTYPE_[^,]*)/) {
@ -61,7 +62,7 @@ sub getinclude {
$enum{"CURLOPT_CONV_TO_NETWORK_FUNCTION"}++;
close($f);
open(my $f, "<", "$root/include/curl/multi.h")
open($f, "<", "$root/include/curl/multi.h")
|| die "no curl.h";
while(<$f>) {
if($_ =~ /\((CURLMOPT[^,]*), (CURLOPTTYPE_[^,]*)/) {

View file

@ -584,8 +584,10 @@ if(-f "./libcurl.pc") {
}
}
my $f;
logit_spaced "display lib/$confheader";
open(my $f, "<", "lib/$confheader") or die "lib/$confheader: $!";
open($f, "<", "lib/$confheader") or die "lib/$confheader: $!";
while(<$f>) {
print if /^ *#/;
}
@ -660,7 +662,7 @@ if(($have_embedded_ares) &&
my $mkcmd = "$make -i" . ($targetos && !$configurebuild ? " $targetos" : "");
logit "$mkcmd";
open(my $f, "-|", "$mkcmd 2>&1") or die;
open($f, "-|", "$mkcmd 2>&1") or die;
while(<$f>) {
s/$pwd//g;
print;

View file

@ -38,7 +38,6 @@ BEGIN {
runclientoutput
setlogfunc
exerunner
shell_quote
subbase64
subnewlines
subsha256base64file
@ -219,25 +218,6 @@ sub exerunner {
return '';
}
#######################################################################
# Quote an argument for passing safely to a Bourne shell
# This does the same thing as String::ShellQuote but doesn't need a package.
#
sub shell_quote {
my ($s)=@_;
if($^O eq 'MSWin32') {
$s = '"' . $s . '"';
}
else {
if($s !~ m/^[-+=.,_\/:a-zA-Z0-9]+$/) {
# string contains a "dangerous" character--quote it
$s =~ s/'/'"'"'/g;
$s = "'" . $s . "'";
}
}
return $s;
}
sub get_sha256_base64 {
my ($file_path) = @_;
return encode_base64(sha256(do { local $/; open my $fh, '<:raw', $file_path or die $!; <$fh> }), "");