34b1e146e4
Viktor Szakats
2025-09-26
Subject
perlcheck: add script, run in CI, fix fallouts
Binary
No binary (build failed)
Architecture & Compiler Flags
—
Build Log
(log yok)
Commit Diff GitHub →
.github/workflows/checksrc.yml +4 -0scripts/Makefile.am +2 -1scripts/perlcheck.sh +47 -0tests/globalconfig.pm +1 -3tests/pathhelp.pm +20 -0tests/runner.pm +1 -1tests/runtests.pl +1 -0tests/servers.pm +1 -1tests/test745.pl +3 -2tests/testcurl.pl +4 -2tests/testutil.pm +0 -20
.github/workflows/checksrc.yml+4 -0
| @@ -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 | |
scripts/Makefile.am+2 -1
| @@ -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 | |
scripts/perlcheck.sh+47 -0
| @@ -0,0 +1,47 @@ | |
| + | #!/bin/sh |
| + | #*************************************************************************** |
| + | # _ _ ____ _ |
| + | # Project ___| | | | _ \| | |
| + | # / __| | | | |_) | | |
| + | # | (__| |_| | _ <| |___ |
| + | # \___|\___/|_| \_\_____| |
| + | # |
| + | # Copyright (C) Dan Fandrich, <[email protected]>, 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 |
tests/globalconfig.pm+1 -3
| @@ -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; | |
tests/pathhelp.pm+20 -0
| @@ -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 | |
tests/runner.pm+1 -1
| @@ -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 | |
tests/runtests.pl+1 -0
| @@ -91,6 +91,7 @@ use serverhelp qw( | |
| use pathhelp qw( | |
| exe_ext | |
| sys_native_current_path | |
| + | shell_quote |
| ); | |
| use appveyor; | |
tests/servers.pm+1 -1
| @@ -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 |
| ); | |
tests/test745.pl+3 -2
| @@ -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_[^,]*)/) { | |
tests/testcurl.pl+4 -2
| @@ -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; | |
tests/testutil.pm+0 -20
| @@ -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> }), ""); | |