diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml new file mode 100644 index 0000000..9b678a6 --- /dev/null +++ b/.github/workflows/linux.yml @@ -0,0 +1,80 @@ +name: linux + +on: + push: + branches: + - '*' + tags-ignore: + - '*' + pull_request: + +jobs: + perl: + + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + cip_tag: + - "5.41" + - "5.40" + - "5.38" + - "5.36" + - "5.34" + - "5.32" + - "5.30" + - "5.28" + - "5.26" + - "5.24" + - "5.22" + - "5.20" + - "5.18" + - "5.16" + - "5.14" + - "5.12" + + env: + CIP_TAG: ${{ matrix.cip_tag }} + + steps: + - uses: actions/checkout@v2 + + - name: Bootstrap CIP + run: | + curl -L https://raw.githubusercontent.com/uperl/cip/main/bin/github-bootstrap | bash + + - name: Cache-Key + id: cache-key + run: | + echo -n '::set-output name=key::' + cip cache-key + + - name: Cache CPAN modules + uses: actions/cache@v2 + with: + path: ~/.cip + key: ${{ runner.os }}-build-${{ steps.cache-key.outputs.key }} + restore-keys: | + ${{ runner.os }}-build-${{ steps.cache-key.outputs.key }} + + - name: Start-Container + run: | + cip start + + - name: Diagnostics + run: | + cip diag + + - name: Install-Dependencies + run: | + cip install + + - name: Build + Test + run: | + cip script + + - name: CPAN log + if: ${{ failure() }} + run: | + cip exec bash -c 'cat $HOME/.cpanm/latest-build/build.log' diff --git a/.github/workflows/static.yml b/.github/workflows/static.yml new file mode 100644 index 0000000..cba7de1 --- /dev/null +++ b/.github/workflows/static.yml @@ -0,0 +1,28 @@ +name: static + +on: + push: + branches: + - '*' + tags-ignore: + - '*' + pull_request: + +jobs: + perl: + + runs-on: ubuntu-latest + + env: + CIP_TAG: static + + steps: + - uses: actions/checkout@v2 + + - name: Bootstrap CIP + run: | + curl -L https://raw.githubusercontent.com/uperl/cip/main/bin/github-bootstrap | bash + + - name: Build + Test + run: | + cip script diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4a0ca81 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +/Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref-* +/.build +*.old +*.orig diff --git a/Changes b/Changes index 4a99588..e197a20 100644 --- a/Changes +++ b/Changes @@ -1,22 +1,26 @@ Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde -This file is part of Perl-Critic-Pulp. +This file is part of Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref. -Perl-Critic-Pulp is free software; you can redistribute it and/or +Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3, or (at your option) any later version. -Perl-Critic-Pulp is distributed in the hope that it will be useful, +Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along -with Perl-Critic-Pulp. If not, see . +with Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref. If not, see . +Version 100, December 2024 + - Forked from Perl-Critic-Pulp, previous history includes Policies + that were not forked. + Version 99, February 2021 - RequireFinalSemicolon keep the "List" check for PPI 1.220 diff --git a/MANIFEST b/MANIFEST deleted file mode 100644 index 627f19b..0000000 --- a/MANIFEST +++ /dev/null @@ -1,262 +0,0 @@ -Changes -COPYING -debian/changelog -debian/compat -debian/control -debian/copyright -debian/rules -debian/source/format -debian/watch -devel/apropos-markup.pl -devel/array-delete.pl -devel/backslash-control.pl -devel/bareword-colon.pl -devel/charnames.pl -devel/churn-posix.pl -devel/churn-unbalanced.pl -devel/churn.pl -devel/const-autoload.pl -devel/const-noproto.pl -devel/const-post.pl -devel/constant-underscore.pl -devel/duplicate-hash-keys.pl -devel/empty.pl -devel/fat-comma.pl -devel/gettext.pl -devel/grep-ampersand-call.pl -devel/grep-arg-unpack.pl -devel/grep-array-assign.pl -devel/grep-array-slice-single.pl -devel/grep-backslash-control.pl -devel/grep-backslash.pl -devel/grep-condsub.pl -devel/grep-constant-empty.pl -devel/grep-constant-underscore.pl -devel/grep-cut-noblank.pl -devel/grep-devnull.pl -devel/grep-dollar-semi.pl -devel/grep-duplicate-END.pl -devel/grep-duplicate-use.pl -devel/grep-each.pl -devel/grep-eval-line.pl -devel/grep-exporter.pl -devel/grep-fat-comma.pl -devel/grep-filetest-f.pl -devel/grep-foreach-splice.pl -devel/grep-hash-keys.pl -devel/grep-if-if.pl -devel/grep-import-tag.pl -devel/grep-makefile-exit.pl -devel/grep-pack.pl -devel/grep-pod-begin-no-newline.pl -devel/grep-pod-begin.pl -devel/grep-pod-blankline.pl -devel/grep-pod-blanknonempty.pl -devel/grep-pod-command-arg.pl -devel/grep-pod-duplicate-see-also.pl -devel/grep-pod-F.pl -devel/grep-pod-final-cut.pl -devel/grep-pod-gt.pl -devel/grep-pod-head-down2.pl -devel/grep-pod-head-duplicate.pl -devel/grep-pod-item-bullet.pl -devel/grep-pod-leadingwhite.pl -devel/grep-pod-linked-urls.pl -devel/grep-pod-links-adjacent.pl -devel/grep-pod-markup-gt.pl -devel/grep-pod-no-cut.pl -devel/grep-pod-para-dots.pl -devel/grep-pod-plain-indent.pl -devel/grep-pod-section-end-comma.pl -devel/grep-pod-synopsis.pl -devel/grep-pod-verbatim-unindent.pl -devel/grep-pod-verbatim.pl -devel/grep-pod-X-newline.pl -devel/grep-printf.pl -devel/grep-qrm.pl -devel/grep-qw-comment.pl -devel/grep-qw.pl -devel/grep-regexp-common-no-defaults.pl -devel/grep-rootdir.pl -devel/grep-shebang-perl.pl -devel/grep-shebang-pm.pl -devel/grep-shebang-t.pl -devel/grep-spelling.pl -devel/grep-stacked-filetest.pl -devel/grep-t-print.pl -devel/grep-test-print.pl -devel/grep-trailing-comma-heredoc.pl -devel/grep-use-decimal.pl -devel/grep-use-exporter.pl -devel/grep-use-langinfo.pl -devel/grep-use-posix.pl -devel/grep-use-quoted.pl -devel/grep-version-nonnum.pl -devel/h2xs/PostModule.pm -devel/h2xs/run.pl -devel/h2xs/TestConstFoo.h -devel/junk/test-more-like.pl -devel/junk/TestMoreLikeModifiers.pm -devel/junk/TestMoreLikeModifiers.t -devel/lib/Perl/Critic/Policy/Compatibility/inprogressTestMore.pm -devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.pm -devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.t -devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraOpen.pm -devel/lib/Perl/Critic/Policy/Modules/UseExporter.pm -devel/lib/Perl/Critic/Policy/Modules/UseExporter.t -devel/lib/Perl/Critic/Policy/TestingAndDebugging/inprogressProhibitTestPrint.pm -devel/lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitTestPrint.t -devel/Makefile -devel/misc.pl -devel/MyFileTempDBM.pm -devel/MyLocatePerl.pm -devel/MyStuff.pm -devel/MyUniqByInode.pm -devel/MyUniqByMD5.pm -devel/name.pod -devel/not.sh -devel/notwithcompare.pl -devel/open-space.pl -devel/parse-backslash.pl -devel/perl-minimum.pl -devel/pod-minimum.pl -devel/pod-simple.pl -devel/podparser.pl -devel/posix-import.pl -devel/posix-size.pl -devel/posix-user.pl -devel/PosixUser.pm -devel/ppi-wide.pl -devel/qrm.pl -devel/regexp-balanced.pl -devel/regexp-string.pl -devel/string-format.pl -devel/TestAutoload.pm -devel/trailing-comma-heredoc.pl -devel/try-catch.pl -devel/try-pm.pl -devel/try-syntax.pl -devel/try-tiny.pl -devel/unknown-backslash.pl -devel/use-quoted.pl -devel/version.pl -devel/version_check.pl -devel/version_check.pm -lib/Perl/Critic/Policy/CodeLayout/ProhibitFatCommaNewline.pm -lib/Perl/Critic/Policy/CodeLayout/ProhibitIfIfSameLine.pm -lib/Perl/Critic/Policy/CodeLayout/RequireFinalSemicolon.pm -lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommaAtNewline.pm -lib/Perl/Critic/Policy/Compatibility/ConstantLeadingUnderscore.pm -lib/Perl/Critic/Policy/Compatibility/ConstantPragmaHash.pm -lib/Perl/Critic/Policy/Compatibility/Gtk2Constants.pm -lib/Perl/Critic/Policy/Compatibility/PerlMinimumVersionAndWhy.pm -lib/Perl/Critic/Policy/Compatibility/PodMinimumVersion.pm -lib/Perl/Critic/Policy/Compatibility/ProhibitUnixDevNull.pm -lib/Perl/Critic/Policy/Documentation/ProhibitAdjacentLinks.pm -lib/Perl/Critic/Policy/Documentation/ProhibitBadAproposMarkup.pm -lib/Perl/Critic/Policy/Documentation/ProhibitDuplicateHeadings.pm -lib/Perl/Critic/Policy/Documentation/ProhibitDuplicateSeeAlso.pm -lib/Perl/Critic/Policy/Documentation/ProhibitLinkToSelf.pm -lib/Perl/Critic/Policy/Documentation/ProhibitParagraphEndComma.pm -lib/Perl/Critic/Policy/Documentation/ProhibitParagraphTwoDots.pm -lib/Perl/Critic/Policy/Documentation/ProhibitUnbalancedParens.pm -lib/Perl/Critic/Policy/Documentation/ProhibitVerbatimMarkup.pm -lib/Perl/Critic/Policy/Documentation/RequireEndBeforeLastPod.pm -lib/Perl/Critic/Policy/Documentation/RequireFilenameMarkup.pm -lib/Perl/Critic/Policy/Documentation/RequireFinalCut.pm -lib/Perl/Critic/Policy/Documentation/RequireLinkedURLs.pm -lib/Perl/Critic/Policy/Miscellanea/TextDomainPlaceholders.pm -lib/Perl/Critic/Policy/Miscellanea/TextDomainUnused.pm -lib/Perl/Critic/Policy/Modules/ProhibitModuleShebang.pm -lib/Perl/Critic/Policy/Modules/ProhibitPOSIXimport.pm -lib/Perl/Critic/Policy/Modules/ProhibitUseQuotedVersion.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ConstantBeforeLt.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/NotWithCompare.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitArrayAssignAref.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitBarewordDoubleColon.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitDuplicateHashKeys.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyCommas.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitFiletest_f.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNullStatements.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitUnknownBackslash.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumericVersion.pm -lib/Perl/Critic/Policy/ValuesAndExpressions/UnexpandedSpecialLiteral.pm -lib/Perl/Critic/Pulp.pm -lib/Perl/Critic/Pulp/PodParser.pm -lib/Perl/Critic/Pulp/Utils.pm -Makefile.PL -MANIFEST This list of files -MANIFEST.SKIP -META.json -META.yml -README -SIGNATURE -t/ConstantBeforeLt.t -t/ConstantLeadingUnderscore.t -t/ConstantPragmaHash.t -t/Gtk2Constants.t -t/MyTestHelpers.pm -t/NotWithCompare.t -t/PerlMinimumVersionAndWhy-pmv.t -t/PerlMinimumVersionAndWhy.t -t/PodMinimumVersion.t -t/ProhibitAdjacentLinks.t -t/ProhibitArrayAssignAref.t -t/ProhibitBadAproposMarkup.t -t/ProhibitBarewordDoubleColon.t -t/ProhibitDuplicateHashKeys.t -t/ProhibitDuplicateHeadings.t -t/ProhibitDuplicateSeeAlso.t -t/ProhibitEmptyCommas.t -t/ProhibitFatCommaNewline.t -t/ProhibitFiletest_f.t -t/ProhibitIfIfSameLine.t -t/ProhibitLinkToSelf.t -t/ProhibitModuleShebang.t -t/ProhibitModuleShebang/False.pm -t/ProhibitModuleShebang/MakeMaker.pm -t/ProhibitModuleShebang/Script.pl -t/ProhibitModuleShebang/SomeCode.pm -t/ProhibitModuleShebang/SomeCodeNewline.pm -t/ProhibitModuleShebang/UsrBin.pm -t/ProhibitNullStatements.t -t/ProhibitParagraphEndComma.t -t/ProhibitParagraphTwoDots.t -t/ProhibitPOSIXimport.t -t/ProhibitUnbalancedParens.t -t/ProhibitUnixDevNull-load.t -t/ProhibitUnixDevNull.t -t/ProhibitUnknownBackslash.t -t/ProhibitUseQuotedVersion.t -t/ProhibitVerbatimMarkup.t -t/Pulp.t -t/RequireEndBeforeLastPod.t -t/RequireFilenameMarkup.t -t/RequireFinalCut.t -t/RequireFinalSemicolon.t -t/RequireLinkedURLs.t -t/RequireNumericVersion.t -t/RequireTrailingCommaAtNewline.t -t/TextDomainPlaceholders.t -t/TextDomainUnused.t -t/UnexpandedSpecialLiteral.t -t/Utils.t -xt/0-file-is-part-of.t -xt/0-META-read.t -xt/0-no-debug-left-on.t -xt/0-Test-ConsistentVersion.t -xt/0-Test-DistManifest.t -xt/0-Test-Pod.t -xt/0-Test-Synopsis.t -xt/0-Test-YAML-Meta.t -xt/policy-lists.t -xtools/my-check-copyright-years.sh -xtools/my-check-file-part-of.sh -xtools/my-check-spelling.sh -xtools/my-deb.sh -xtools/my-diff-prev.sh -xtools/my-kwalitee.sh -xtools/my-manifest.sh -xtools/my-pc.sh -xtools/my-tags.sh -xtools/my-wunused.sh diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP deleted file mode 100644 index 48a64da..0000000 --- a/MANIFEST.SKIP +++ /dev/null @@ -1,166 +0,0 @@ -#!/usr/bin/perl - -# MANIFEST.SKIP -- Kevin's various excluded files - -# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2019 Kevin Ryde - -# This file is shared among several distributions. -# -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3, or (at your option) -# any later version. -# -# This file is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with this file. If not, see . - - -# cf. /usr/share/perl/5.14/ExtUtils/MANIFEST.SKIP - - -# emacs backups -~$ -# emacs locks -(^|/)\.# -# emacs autosave -(^|/)# - -# own distdir -^[A-Za-z][A-Za-z0-9-_]*-\d+/ -# own dist files -\.tar$ -\.tar\.gz$ -\.deb$ -\.dsc$ -\.diff.gz$ - -# ExtUtils::MakeMaker leaving Makefile.old -# and "myman" leaving MANIFEST.old -\.old$ -# ExtUtils::MakeMaker "metafile" rule temporary, left behind if interrupted -^META_new\.yml$ - -# built - MakeMaker -^Makefile$ -^blib -^pm_to_blib -^TAGS$ -# MakeMaker 6.18 to 6.25, apparently -^blibdirs\.ts$ -# msdos compiler output stuff using gcc, -# "XSFILENAME.def" extension, and others fixed names it seems -\.def$ -^dll\.base$ -^dll\.exp$ -# msdos compiler stuff using ms c -\.pdb$ - -# built - recent Module::Build nonsense -^MYMETA\.yml$ -# built - something recent ExtUtils::MakeMaker -^MYMETA\.json$ - -# built - cdbs and debhelper -^debian/stamp- -^debian/.*\.log$ - -# built - texinfo.tex temporaries -\.(aux|cp|cps|fn|fns|ky|log|pg|toc|tp|tps|vr)$ -# built - PGF temporary -\.pgf$ -# tex or latex output, not distributed for now -\.(dvi|pdf|ps)$ - -# toplevel .c files built from .xs -^[^/]+\.c$ -# built .o compiled and .bs from .xs -\.o$ -\.obj$ -\.bs$ -# -#(^|/)[A-Z][A-Za-z0-9_]*\.c$ -#/[^Z])[^/]+\.c$ - -# built - configury -^a\.out$ -^conftest -^config\.h$ -^myconfig\.h$ - -# built - toplevel html pages -^[a-zA-Z][^./]+\.html$ - -# inc/MyMakefileExtras.pm "diff-prev" -^diff\.tmp -# inc/MyMakefileExtras.pm "lintian-source" -^temp-lintian -# various testing -^tempfile\.png$ -^tempfile -\.tmp$ - - -# my dists -^dist-deb -^up$ -^c$ - -# special case p..ulp test build stuff -devel/h2xs/TestConstFoo/ - -# special case various executables -^devel/exe-[^/.]+$ -# special case mall executables -^devel/hblk$ -^devel/mallopt$ -^devel/mallstats$ -^devel/malltrim$ -# special case fli executables -^devel/mmap-multi$ -# special case widget-bits executables -^devel/grandom$ -^devel/grandom-[a-z]+$ -# special case widget-cursor executables -^devel/invisible-blank$ -# special case x'or executables -^devel/gtk-gc-colour$ -# special case combo executables -^devel/toolbutton-overflow-leak$ -# special case xpother executables -^devel/encode-all$ -^devel/encode-dump$ -^devel/Encode-X11-xlib$ -^devel/Encode-X11-xlib2$ -# special case xpother samples -^devel/encode.*\.ctext$ -^devel/encode.*\.utf8$ - -# special htmlext environs -^test-dist/ - -# TeX -_whizzy.* -\.aux$ -\.dvi$ -\.fls$ -\.log$ -\.out$ -\.pdf$ -\.waux$ -\.wdvi$ -\.fdb_latexmk$ - - -\.junk$ -\.bak$ -^backup -^misc -^maybe -^samples -^samp -^formats diff --git a/META.json b/META.json deleted file mode 100644 index 83bcdf8..0000000 --- a/META.json +++ /dev/null @@ -1,88 +0,0 @@ -{ - "abstract" : "Some add-on policies for Perl::Critic.", - "author" : [ - "Kevin Ryde " - ], - "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", - "license" : [ - "gpl_3" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : 2 - }, - "name" : "Perl-Critic-Pulp", - "no_index" : { - "directory" : [ - "t", - "inc", - "devel", - "xt" - ], - "package" : [ - "Perl::MinimumVersion" - ] - }, - "optional_features" : { - "maximum_policies" : { - "description" : "Have the policies check as much as possible.", - "prereqs" : { - "runtime" : { - "requires" : { - "Perl::MinimumVersion" : "0" - } - } - } - } - }, - "prereqs" : { - "build" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "configure" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "runtime" : { - "requires" : { - "IO::String" : "1.02", - "List::MoreUtils" : "0.24", - "List::Util" : "0", - "PPI" : "1.220", - "PPI::Document" : "0", - "PPI::Dumper" : "0", - "Perl::Critic" : "1.084", - "Perl::Critic::Policy" : "1.084", - "Perl::Critic::Utils" : "1.100", - "Perl::Critic::Utils::PPI" : "0", - "Perl::Critic::Violation" : "0", - "Pod::Escapes" : "0", - "Pod::MinimumVersion" : "50", - "Pod::ParseLink" : "0", - "Pod::Parser" : "0", - "Scalar::Util" : "0", - "Test::More" : "0", - "perl" : "5.006", - "version" : "0" - } - }, - "test" : { - "suggests" : { - "Perl::MinimumVersion" : "0" - } - } - }, - "release_status" : "stable", - "resources" : { - "homepage" : "http://user42.tuxfamily.org/perl-critic-pulp/index.html", - "license" : [ - "http://www.gnu.org/licenses/gpl.html" - ] - }, - "version" : 99, - "x_serialization_backend" : "JSON::PP version 4.04" -} diff --git a/META.yml b/META.yml deleted file mode 100644 index dd65a78..0000000 --- a/META.yml +++ /dev/null @@ -1,53 +0,0 @@ ---- -abstract: 'Some add-on policies for Perl::Critic.' -author: - - 'Kevin Ryde ' -build_requires: - ExtUtils::MakeMaker: '0' -configure_requires: - ExtUtils::MakeMaker: '0' -dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' -license: gpl -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: '1.4' -name: Perl-Critic-Pulp -no_index: - directory: - - t - - inc - - devel - - xt - package: - - Perl::MinimumVersion -optional_features: - maximum_policies: - description: 'Have the policies check as much as possible.' - requires: - Perl::MinimumVersion: '0' -requires: - IO::String: '1.02' - List::MoreUtils: '0.24' - List::Util: '0' - PPI: '1.220' - PPI::Document: '0' - PPI::Dumper: '0' - Perl::Critic: '1.084' - Perl::Critic::Policy: '1.084' - Perl::Critic::Utils: '1.100' - Perl::Critic::Utils::PPI: '0' - Perl::Critic::Violation: '0' - Pod::Escapes: '0' - Pod::MinimumVersion: '50' - Pod::ParseLink: '0' - Pod::Parser: '0' - Scalar::Util: '0' - Test::More: '0' - perl: '5.006' - version: '0' -resources: - homepage: http://user42.tuxfamily.org/perl-critic-pulp/index.html - license: http://www.gnu.org/licenses/gpl.html -version: '99' -x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL deleted file mode 100755 index 2fb8c08..0000000 --- a/Makefile.PL +++ /dev/null @@ -1,136 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010, 2011, 2012, 2014, 2015, 2017 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. - -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use ExtUtils::MakeMaker; - -WriteMakefile - (NAME => 'Perl::Critic::Pulp', - ABSTRACT => 'Some add-on policies for Perl::Critic.', - VERSION_FROM => 'lib/Perl/Critic/Pulp.pm', - AUTHOR => 'Kevin Ryde ', - LICENSE => 'gpl_3', - SIGN => 1, - MIN_PERL_VERSION => '5.006', - - PREREQ_PM => { - # 1.220 for its incompatible PPI::Statement::Sub->prototype() - 'PPI' => '1.220', - 'PPI::Document' => 0, - # actually PPI::Dumper only used in the .t scripts if - # there's an error ... - 'PPI::Dumper' => 0, - - # 1.082 or some such for new style parameter specs - # 1.084 for highest_explicit_perl_version() method - 'Perl::Critic' => '1.084', - # parts of Perl::Critic, used so name them explicitly - 'Perl::Critic::Policy' => '1.084', - # Utils 1.100 for precedence_of() supporting -f etc filetests - 'Perl::Critic::Utils' => '1.100', - 'Perl::Critic::Utils::PPI' => 0, - 'Perl::Critic::Violation' => 0, - - # Required by Perl::Critic itself anyway. - # 1.02 for avoiding leaks in perl 5.8, probably - # something newer has more merit though - 'IO::String' => '1.02', - - # Also used by Perl::Critic itself. Maybe should - # require 0.24 for various XS bugfixes. - 'List::MoreUtils' => '0.24', # 0.24 for stack growing, maybe - - # Could make this optional, but it doesn't drag in anything - # outrageous. - 'Pod::MinimumVersion' => 50, # v.50 fix text in =item etc - - # Builtin in recent perl anyway. - 'List::Util' => 0, - 'Test::More' => 0, - 'Scalar::Util' => 0, - - # Required by Perl::Critic itself anyway, - # and comes with perl 5.10 anyway too. - 'version' => 0, - - 'Pod::Escapes' => 0, - 'Pod::Parser' => 0, - 'Pod::ParseLink' => 0, - }, - - META_MERGE => - { 'meta-spec' => { version => 2 }, - resources => - { homepage => 'http://user42.tuxfamily.org/perl-critic-pulp/index.html', - license => 'http://www.gnu.org/licenses/gpl.html', - }, - # don't index "package Perl::MinimumVersion" additions there - no_index => { package => [ 'Perl::MinimumVersion' ], - directory=>['devel','xt'], - }, - - recommends => { 'Perl::MinimumVersion' => 0, - }, - prereqs => - { test => - { suggests => - { 'Perl::MinimumVersion' => 0, - }, - }, - }, - - optional_features => - { maximum_policies => - { description => 'Have the policies check as much as possible.', - prereqs => - { runtime => - { requires => { 'Perl::MinimumVersion' => 0, - }, - }, - }, - }, - }, - }, - ); - - -# maximum_devel => -# { description => 'Stuff used variously for development.', -# requires => { 'PPI::Document' => 0, -# 'Perl::MinimumVersion' => 0, -# 'Encode' => 0, -# 'Perl6::Slurp' => 0, -# 'Regexp::Common' => 0, -# 'Devel::Mallinfo' => 0, -# 'IO::Uncompress::AnyInflate' => 0, -# 'lib::abs' => 0, -# 'IO::String' => 0, -# 'Digest::MD5' => 0, -# 'I18N::Langinfo' => 0, -# 'Locale::TextDomain' => 0, -# 'File::Locate' => 0, -# -# 'File::Locate::Iterator' => 0, # mine -# # parts of File::Locate::Iterator -# 'Iterator::Simple' => 0, -# 'Iterator::Simple::Locate' => 0, -# }, -# }, diff --git a/README b/README deleted file mode 100644 index 4a4f37f..0000000 --- a/README +++ /dev/null @@ -1,30 +0,0 @@ -Copyright 2008, 2009 Kevin Ryde - -This file is part of Perl-Critic-Pulp. - -Perl-Critic-Pulp is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as -published by the Free Software Foundation; either version 3, or (at -your option) any later version. - -Perl-Critic-Pulp is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License along -with Perl-Critic-Pulp. If not, see . - - - -This is some add-on policies for Perl::Critic checking for -miscellaneous bugs, compatibility, efficiency, and cosmetic things. -See the POD of Perl::Critic::Pulp for the full list. - -The only prerequisite is Perl::Critic itself, though the -"PerlMinimumVersionAndWhy" policy does nothing without -Perl::MinimumVersion. - -The Perl-Critic-Pulp home page is - - http://user42.tuxfamily.org/perl-critic-pulp/index.html diff --git a/README.md b/README.md new file mode 100644 index 0000000..8639b61 --- /dev/null +++ b/README.md @@ -0,0 +1,145 @@ +# Perl::Critic::Policy::Plicease::ProhibitArrayAssignAref ![static](https://github.com/uperl/Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref/workflows/static/badge.svg) ![linux](https://github.com/uperl/Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref/workflows/linux/badge.svg) + +Don't assign an anonymous arrayref to an array + +# VERSION + +version 99 + +# DESCRIPTION + +This policy is a fork of [Perl::Critic::Policy::ValuesAndExpressions::ProhibitArrayAssignAref](https://metacpan.org/pod/Perl::Critic::Policy::ValuesAndExpressions::ProhibitArrayAssignAref). +It differs from the original by not having a dependency on [List::MoreUtils](https://metacpan.org/pod/List::MoreUtils). +It is unfortunately still licensed as GPL3. + +It asks you not to assign an anonymous arrayref to an array + +``` +@array = [ 1, 2, 3 ]; # bad +``` + +The idea is that it's rather unclear whether an arrayref is intended, or +might have meant to be a list like + +``` +@array = ( 1, 2, 3 ); +``` + +This policy is under the "bugs" theme (see ["POLICY THEMES" in Perl::Critic](https://metacpan.org/pod/Perl::Critic#POLICY-THEMES)) +for the chance `[]` is a mistake, and since even if it's correct it will +likely make anyone reading it wonder. + +A single arrayref can still be assigned to an array, but with parens to make +it clear, + +``` +@array = ( [1,2,3] ); # ok +``` + +Dereferences or array and hash slices (see ["Slices" in perldata](https://metacpan.org/pod/perldata#Slices)) are +recognised as an array target and treated similarly, + +``` +@$ref = [1,2,3]; # bad assign to deref +@{$ref} = [1,2,3]; # bad assign to deref +@x[1,2,3] = ['a','b','c']; # bad assign to array slice +@x{'a','b'} = [1,2]; # bad assign to hash slice +``` + +## List Assignment Parens + +This policy is not a blanket requirement for `()` parens on array +assignments. It's normal and unambiguous to have a function call or `grep` +etc without parens. + +``` +@array = foo(); # ok +@array = grep {/\.txt$/} @array; # ok +``` + +The only likely problem from lack of parens in such cases is that the `,` +comma operator has lower precedence than `=` (see [perlop](https://metacpan.org/pod/perlop)), so something +like + +``` +@array = 1,2,3; # oops, not a list +``` + +means + +``` +@array = (1); +2; +3; +``` + +Normally the remaining literals in void context provoke a warning from Perl +itself. + +An intentional single element assignment is quite common as a statement, for +instance + +``` +@ISA = 'My::Parent::Class'; # ok +``` + +And for reference the range operator precedence is high enough, + +``` +@array = 1..10; # ok +``` + +But of course parens are needed if concatenating some disjoint ranges with +the comma operator, + +``` +@array = (1..5, 10..15); # parens needed +``` + +The `qw` form gives a list too + +``` +@array = qw(a b c); # ok +``` + +# SEE ALSO + +- [Perl::Critic](https://metacpan.org/pod/Perl::Critic) +- [Perl::Critic::Policy::ValuesAndExpressions::ProhibitArrayAssignAref](https://metacpan.org/pod/Perl::Critic::Policy::ValuesAndExpressions::ProhibitArrayAssignAref) + +# HOME PAGE + +- [https://github.com/uperl/Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref](https://github.com/uperl/Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref) + +# COPYRIGHT + +Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde + +Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for +more details. + +You should have received a copy of the GNU General Public License along with +Perl-Critic-Policy-Plicease-ProhibitArrayAssignAref. If not, see <http://www.gnu.org/licenses>. + +# AUTHOR + +Original author: Kevin Ryde + +Current maintainer: Graham Ollis + +# COPYRIGHT AND LICENSE + +This software is Copyright (c) 2011-2021 by Kevin Ryde. + +This is free software, licensed under: + +``` +The GNU General Public License, Version 3, June 2007 +``` diff --git a/SIGNATURE b/SIGNATURE deleted file mode 100644 index d0c41f3..0000000 --- a/SIGNATURE +++ /dev/null @@ -1,294 +0,0 @@ -This file contains message digests of all files listed in MANIFEST, -signed via the Module::Signature module, version 0.87. - -To verify the content in this distribution, first make sure you have -Module::Signature installed, then type: - - % cpansign -v - -It will check each file's integrity, as well as the signature's -validity. If "==> Signature verified OK! <==" is not displayed, -the distribution may already have been compromised, and you should -not run its Makefile.PL or Build.PL. - ------BEGIN PGP SIGNED MESSAGE----- -Hash: RIPEMD160 - -SHA256 fc82ca8b6fdb18d4e3e85cfd8ab58d1bcd3f1b29abe782895abd91d64763f8e7 COPYING -SHA256 1ab332eb7396f1509350ec35876b8b6c2bb349001d241413a1927abeb3431ca8 Changes -SHA256 02a9f083d88ff0c86874432186a6929765f5c36eb65e379a224f3a25e41a156d MANIFEST -SHA256 91eb41c99a794a3fced08c2002ec7a6ed5a8ccb85c20ac26237e6f40dc2f7ba9 MANIFEST.SKIP -SHA256 79b9b23f2a977697a72baa205ec8562ba9134517374276d150748e2a77413d2b META.json -SHA256 e0758df48048022049d75a74b0f20dcec5e56aa2e8aadc81df524196773d095a META.yml -SHA256 14108a6af3d4e6c4ad0832f8a6375ef4b8d9be6697ab84e7cf0204453c6a454d Makefile.PL -SHA256 66018de2909c61534cff4919a8ee4a6e6f64fa8e30825751b5324bf122662eb4 README -SHA256 8d7fd2f939d48da99e610bce05efdcfa5fa775c449340bccc5fd6345b687515e debian/changelog -SHA256 2e6d31a5983a91251bfae5aefa1c0a19d8ba3cf601d0e8a706b4cfa9661a6b8a debian/compat -SHA256 3c7c6cf552f4e61559b0d07fd0463ee1da01fd444de3ed39ff75cd764b813756 debian/control -SHA256 9f9a4b93767e3aba8ebd11175de066766ac97b315d2bf22c0bbdc617ebb596d8 debian/copyright -SHA256 3958fec6823a4d072359adec9995a4eca5cddad04b571ff2bfe95befa887e8e5 debian/rules -SHA256 5717e7c840171019a4eeab5b79a7f894a4986eaff93d04ec5b12c9a189f594bf debian/source/format -SHA256 b4f9a2b3b0ed69cd576ad654e103525d24c29e967d7087561b537d427f5dd0ea debian/watch -SHA256 eba33224f3e87bf92245708acf37dd71fcb3897073d50a326bfaabb19da14dd2 devel/Makefile -SHA256 532eb296bd7553ed37715c897a75240466b395611a1e4b1345d7cac04f357d5e devel/MyFileTempDBM.pm -SHA256 aab4fce514032820aa2201b9129cb281b0d66c52489b43f647f0308e0cbf100a devel/MyLocatePerl.pm -SHA256 c46d7c040c67de9d58372e742946c587fee3f7fa66491c67ffc7151cfa1bfa2c devel/MyStuff.pm -SHA256 68afa9a11b9b2a81110a60add4e89c39d1e7b52b18bf036cacb4bfabca4d36fa devel/MyUniqByInode.pm -SHA256 7071cbff651aadddd490e8a4cb34b5e84a538b2025a806ea9f356fd4cbec4a0a devel/MyUniqByMD5.pm -SHA256 7ffd5dd09f6f4595c2c767be1c26f1898155b9d06a5210bdb4e1339c626b502a devel/PosixUser.pm -SHA256 9ee6a050b6f3fd49bcbc29fdcaa2342d57c713bed3be85eca4b6c6c7dbad8343 devel/TestAutoload.pm -SHA256 aa661c10d0ca5072a1aa25f83774e784ec75a1ca6eab72f3a9e0be72e2e79eea devel/apropos-markup.pl -SHA256 d4773c5f194f9d816a8ef6449c896e3db8e4aa013e2e95a955930084acd203d3 devel/array-delete.pl -SHA256 58eb0225fdd30aba3e1aff2d8c05a772ab6564f39189357dccab4acd9220d283 devel/backslash-control.pl -SHA256 2be50560abed81a6058f257a5dfffac7d56f3b08d35d4c3128f26b2dee35f6e6 devel/bareword-colon.pl -SHA256 bfa07389cd81d11c2c0eb657026f072f32df3d58236991b39054a6818e2d5efa devel/charnames.pl -SHA256 6bf34de67fa27f761d52d15b6d35939c6785cc012ec90834575dc04633dc0b88 devel/churn-posix.pl -SHA256 a57b423357987c6b2e4d1c9baab4d8966681a549c7e2ddd3e625b630f48b7f70 devel/churn-unbalanced.pl -SHA256 c146a7ec56d333f6e7050f0dfabf43a9f33a868a05dc5b568a9ed152b5da04a2 devel/churn.pl -SHA256 3916c8dd43a9febd5d892330ad704ac513f99e44d4f91a571b988ab8dd54ba82 devel/const-autoload.pl -SHA256 d632d95836ee955e0d321e47b6e14ecf33b0db8717d2146b38ed66e4b8280727 devel/const-noproto.pl -SHA256 b12766fdd888f483b8b3ed217abc9934cb64d736d49e3c1c03ecc445d4c148a1 devel/const-post.pl -SHA256 659f8cc8d0e74ff441081e2c186efd3ef9ac6e1b774725d52613cab07e0390a8 devel/constant-underscore.pl -SHA256 c42e2a61a518d0da5bb37d2b4fa253e50cfec9f92aca57f27e0ba0f41de53abf devel/duplicate-hash-keys.pl -SHA256 caa0f4b5300fa64d80e6868df0ada43ad0bb5e224324fc2bd724d7337460beb7 devel/empty.pl -SHA256 b6e43d06d690c48a8af8a4ba05c7be83edc783c48762fa0c1c1198a6da5ff64f devel/fat-comma.pl -SHA256 ea0b963cfe6c2a9b706160079ae1333c204dc2bdbd51fd0d86144022434ce82a devel/gettext.pl -SHA256 5589fceab79e63fd98b49253f3de405d976d86a66c6de94c3ed80ed7aa85d169 devel/grep-ampersand-call.pl -SHA256 f021948d76485128a95aff5ac3639dd75fe18fe979438ca9001106bbcc5952e5 devel/grep-arg-unpack.pl -SHA256 7d86cb6589286dfc1fbbd9ea341017a323776375f74173d64c20c6b9d60469f3 devel/grep-array-assign.pl -SHA256 4ec8c7454c46a320e0cd131728f568f4f9d01036430f4459a632e73c24c83bf0 devel/grep-array-slice-single.pl -SHA256 27c7473d684e2cb165c55f96a2a5e74dd6dd567004225340e8834c08571b00e2 devel/grep-backslash-control.pl -SHA256 603a1409b7caeb1789e0ea0c94c792659a87f1e0afa0c6f39df6ddad54c61b4c devel/grep-backslash.pl -SHA256 7c41780d226b99c7ec59855978de5d0dba248a073dfce6d2c5844566725bcd65 devel/grep-condsub.pl -SHA256 4fb9f8273e7779f7deebb95026b62d04962ca9d6e9b7b8dfab55ed778c0f5d55 devel/grep-constant-empty.pl -SHA256 00154879f49dd29aea9a03f07317c2669ea7b9f3c15b53f1afa9356cc4e54330 devel/grep-constant-underscore.pl -SHA256 4a12cb555a02fb7db22ca427fc27460e6abc575af19771ed2856c497b869f6f7 devel/grep-cut-noblank.pl -SHA256 247adf9728f43d0ec6f6f8783b07e93716a52afedbea649be5bf0e2998ec2d4f devel/grep-devnull.pl -SHA256 9cd33878ce134586c897e52f46086c4ddf3733f62c69d1f114d8cffda3125f99 devel/grep-dollar-semi.pl -SHA256 ac2b6af4beb65058baf6890d38e626ad3544f17c5245cb549ae111b372c7abaa devel/grep-duplicate-END.pl -SHA256 059db4f736e0f5807293bd334ebe5a817ed38fc0bad97a5bd3500bd05cc719b1 devel/grep-duplicate-use.pl -SHA256 5b426afce7c2e92fd5b0b34b8f7c1b343c20caf7f6c5373f95d2c65b694dc6da devel/grep-each.pl -SHA256 d6b0321f3ac0c5f7fad6d63cc28bd36d404f0adf3210afa8ba6636b4da14a5c3 devel/grep-eval-line.pl -SHA256 3750e3a3aaef87deb5b962c2bfdf0f55ffd509d8f4cc3604853794ac8a2aaa6f devel/grep-exporter.pl -SHA256 62e442f1d7a200a22f08971eb04fd2a8854e746c350371a125f5231e2f465ca9 devel/grep-fat-comma.pl -SHA256 f347ae569c816deb50a7874d6e4f40a3eac030780d28a4d1a04010e817c642aa devel/grep-filetest-f.pl -SHA256 97583e499eac3ee7c328a539e95ef32ba91bb617e5ed0f3046c964a2feed6f32 devel/grep-foreach-splice.pl -SHA256 489d8df935943fabd21e0d070ddaea159618e02eab93563851f7ed271c06b924 devel/grep-hash-keys.pl -SHA256 cedde7e22d4689b7e94677e5edbc5d80d729319a3ec14661962fb865cfebcbf1 devel/grep-if-if.pl -SHA256 b5360b2d1e7f16ce526f89d4853c3e360130dd9daaf86ce3c9c5327f98d94af8 devel/grep-import-tag.pl -SHA256 e760c67087ec3b5f9cdfe4ca146527da71fcaab761e91fcab8382f76a1a3f47a devel/grep-makefile-exit.pl -SHA256 77e205459747ee3dd56ad856773a92f2354af8d0cec752c7d5b3f78b8f0a0f87 devel/grep-pack.pl -SHA256 77e5e0a8f4330583589c80c3f11af5d75074fcee52b02cc06970f1cfebf77d7c devel/grep-pod-F.pl -SHA256 ac24daaaa1be8dbf6b3d1e821fb635603bb021a0a00ec6828049f3d524866c1f devel/grep-pod-X-newline.pl -SHA256 5d268ea52f2b786c5469259323731a9e61e5a234f4ec7f16402c8d7fc966fdfe devel/grep-pod-begin-no-newline.pl -SHA256 d35bdaa3b40c79aeef395417376fbc9e027fea5219f482db4916dcf3931fcd58 devel/grep-pod-begin.pl -SHA256 0455b4f139925cd6569b05a80b49615af4a4115821d78b03d06c1f46f415a749 devel/grep-pod-blankline.pl -SHA256 23221e03ee6dff13558dd461055793bccf23bf23a6efdd26513a7004df45d042 devel/grep-pod-blanknonempty.pl -SHA256 b6ca6b928b0fde56cd103bd1d1c4a157f533b741d97270a9d15abd9420d46977 devel/grep-pod-command-arg.pl -SHA256 8e181f2e0be9cb93285644740761ca94c1b6cdb3b0fd6c3f57d4b30a8f93d069 devel/grep-pod-duplicate-see-also.pl -SHA256 a90d0be04d04d297a5692acae607a559f3a40d282452a3e262a678b2a4da77e8 devel/grep-pod-final-cut.pl -SHA256 1132046fd775b6abaf482d9bde6557fdd10feb44afcea5b7ef6ef7f47f787c05 devel/grep-pod-gt.pl -SHA256 037d9614f035a660b724568e617d78d08147b499c1ca8b3e26ad326240f6d223 devel/grep-pod-head-down2.pl -SHA256 01b1b083d94eed3a0bc77651fe690a6b76fb5cfafaf3842e0779e025eb963d37 devel/grep-pod-head-duplicate.pl -SHA256 d0ea8eb34f6fb186f5e029bb4d601cc36fe01a44a34b4804b29ef34c9c284c3e devel/grep-pod-item-bullet.pl -SHA256 3fa0b2466b8addea1fd72f31dcdc076cf8da51818b2b3ff096ca4caab757be07 devel/grep-pod-leadingwhite.pl -SHA256 6d135d20dee79aa25f0e93e6b25cf12d0bb671f199b5c8e227e2075824ae2c21 devel/grep-pod-linked-urls.pl -SHA256 81fde898f1f081fb75aebf2cf1f1fa22c871669764bddeb2958b79f53e1606d6 devel/grep-pod-links-adjacent.pl -SHA256 c3683574e8c90b12cdca53fece53af4507258ef51eadcda72fbe23e771fc471c devel/grep-pod-markup-gt.pl -SHA256 b3ae6e839522988395c646d05d8caee80dd18143a49aad88cf4f9c21b2dd9200 devel/grep-pod-no-cut.pl -SHA256 0a518de92a9a20ecdac952f0162ccb75d44b2ef9b164728187c6146a9f2ea495 devel/grep-pod-para-dots.pl -SHA256 149b0caecd727ebeeea5ca52410bc4a3f44af75eff9a12584839ffe281c51ded devel/grep-pod-plain-indent.pl -SHA256 282fe7a320bb11b01310974ddce61c5365207df074b421e691fbd9b62389dd2d devel/grep-pod-section-end-comma.pl -SHA256 530801605964018eb2490b6bc842c083c6e6f9aa42fee5e5f4ad8c429ca9c214 devel/grep-pod-synopsis.pl -SHA256 4697a5dee3c31bce9a81a7f8bb5d5528412b8376c3a8323d4d850d1ec29afecf devel/grep-pod-verbatim-unindent.pl -SHA256 c11791a8e2f87175088bcfae1c8f6bafd1b010d5d28e83a8263800f01a97b93f devel/grep-pod-verbatim.pl -SHA256 8f469c42fbeff95d8535f0c0e7aa3d626ea87d32a324bf148b5955072e777dfc devel/grep-printf.pl -SHA256 dfea62bb5d5df5b6de05a837e6aa8d3e01d7ac9553783a684bf1b1873314213c devel/grep-qrm.pl -SHA256 01a3ecb705108ad9f78480ef73d8d4c419518c0fac30bd0383930fb80598b9ef devel/grep-qw-comment.pl -SHA256 f791108ee642494aa98d6c770e11e0fcf32567380fcca950b5b31bf934a6b320 devel/grep-qw.pl -SHA256 a339e699eb1ec7c08d31350595055b0091a5abe4dcb15409ae16a4905e23d981 devel/grep-regexp-common-no-defaults.pl -SHA256 09165e3b9eb17d4ccc25cfb68b37ceaa578c2db392dc666a1bf468b9405bc1bb devel/grep-rootdir.pl -SHA256 69fd55c0869ba1480030e44de6e1a715ab072a8fc78328188de57c5862c81f92 devel/grep-shebang-perl.pl -SHA256 7f30cee4973e612d37408c56d9faf137599d9962500c442814452292d856a44d devel/grep-shebang-pm.pl -SHA256 d8dd02c8d9edc1a6d229d3e399b59b2b25e9c546f6b44c4261735fff9c90b4fd devel/grep-shebang-t.pl -SHA256 8f7cfa4d557aeb94b267c3395cf9df5e16e97d7fea2b6dc90fa2b3bdf5432ad9 devel/grep-spelling.pl -SHA256 4e4c5b75e051bfd560d8e4d0752b776d24abf69b04ca71339a73702471ffe774 devel/grep-stacked-filetest.pl -SHA256 a8a5f9e6fc9fd7a2d4d4746ed8a42859f673a7ee520e1e2fbfedbb768b9e3684 devel/grep-t-print.pl -SHA256 d3e3f4f39999c9ba193fdbea7301e4cd892ebafa2fed87a3681759bba2355339 devel/grep-test-print.pl -SHA256 2fb2a74ffa3e7e5430efad19bef03b84b4c71dd50b75df81db6eb39bc39b3664 devel/grep-trailing-comma-heredoc.pl -SHA256 726718f08775f191e980eeec03aa0aafc7e29fd04e2a5e994e9e20a369110d95 devel/grep-use-decimal.pl -SHA256 034e7123ac03908a4f5a35b0538a561d764e64ab7f216bfade9268cb3dd3c0a4 devel/grep-use-exporter.pl -SHA256 0d802c4f43f39b1cda5e8b7db80fb08efe2232b27ad6670c6b5f4b9eb5eff49e devel/grep-use-langinfo.pl -SHA256 acc40534882188b85b5eba51b9e7e589f7b60e5a63baab1e42e5f0b9294a9f81 devel/grep-use-posix.pl -SHA256 0e40f0f4a3f16d028ed5bae25f39a5026309ab7fd0e460fa0c54f2a6f7254380 devel/grep-use-quoted.pl -SHA256 fdc294b1fb5d85c4d4f4b55c884bd4b6cc82e70cb4d35bcd45e280a09ad7e682 devel/grep-version-nonnum.pl -SHA256 60e4d4eb3ee9462db6313c3a90650036394898647fd15bef10049b9db0be128a devel/h2xs/PostModule.pm -SHA256 00264b11a67c2eaf4c091f9380ce8607e57c041767b994f68a36ec07892ce27c devel/h2xs/TestConstFoo.h -SHA256 b7de45569cf4df94633395dcfdd9476de001fab968e3c28d9dcb1aaf22f9c361 devel/h2xs/run.pl -SHA256 134d87a1ab45f4ac61a87e731454f1e9c5d0623eace1835a636ba4ecd0c731d4 devel/junk/TestMoreLikeModifiers.pm -SHA256 3efcb2e564a554534cdc6557dd4089792895d335ecafd1b2f2bd960d1cad1bde devel/junk/TestMoreLikeModifiers.t -SHA256 cbbef95b642d1afb193fa950e8e1eb9a2883727df0683713f96bc1465426199d devel/junk/test-more-like.pl -SHA256 f201f10f7b47da5794cf83d3bcaf795204f6e626cc4d40a36d2475e42fe5e9a7 devel/lib/Perl/Critic/Policy/Compatibility/inprogressTestMore.pm -SHA256 3073cf2e9591a36d25f4d35810d7f94d5fdc58632bd9854166c8cd219f38ccb4 devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.pm -SHA256 dd8bb4aa83e62bb8ef07f257d11aa25b31978990c29a77e1617e137bd721c78f devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.t -SHA256 0d4ab61845c3f9c0a446737ea3057694a6cb5a782e68886cc1d2420a49a2c8bb devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraOpen.pm -SHA256 1125baf67fd63473d65614093cadedf2db21aa0abb7c2cb4b5911e81249734e3 devel/lib/Perl/Critic/Policy/Modules/UseExporter.pm -SHA256 8e0c4864c889ce038fcd89fd97ef872f107e5b6bc70380b2b5e443194668fa8c devel/lib/Perl/Critic/Policy/Modules/UseExporter.t -SHA256 caf518ed90669f1367ba1d207ffca58688af1d65663133a05510de845b29a71d devel/lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitTestPrint.t -SHA256 60ab67a0d1f0ef22d395db5b952b79f273704041fa52845c9c64e4670157eb1b devel/lib/Perl/Critic/Policy/TestingAndDebugging/inprogressProhibitTestPrint.pm -SHA256 7f83d3076f1c504bdd26620658a48fc81fcb38c65bed7d7591d9bf1fb71ba49c devel/misc.pl -SHA256 0aab8ad0173eda2b9af7027727d77fe079ae50ba4d832d30d6959be97da004ab devel/name.pod -SHA256 cdd8459ac4023785127845b7637ff31fb82111f00f09544b93f647ffca83d8b1 devel/not.sh -SHA256 5db7d40b3a4890645c2a8c357a1a1f4be6a2799213a3d49f5bf9dd5700aa7d5b devel/notwithcompare.pl -SHA256 feab40dc48c06c91108e9a53a8182b097490fa63f17b987b875031ef1439a6e2 devel/open-space.pl -SHA256 b9064f04224c0485a51d634f8d016e50162095d426307a79baac2538f6d9ccd8 devel/parse-backslash.pl -SHA256 ba462fca1fb63984ea2e7dd1a84cb4c5a7fe6c8faadfcb9465d33ff63dcb5760 devel/perl-minimum.pl -SHA256 9510d7346c902729ae3d163bcd4259d8659de8182831c47e9d454ec1d714d86a devel/pod-minimum.pl -SHA256 662a2b6884b45de6e3c82a7190b1524857048dac1b4398cd2ad6570f0030f53b devel/pod-simple.pl -SHA256 8eaea5a0a4dc90bfd78ba54daa235416e3fdb2065bedbfe58f707ea39c87a01d devel/podparser.pl -SHA256 1f7b73369a630d5340b07f5a370c235ba2b9b59a3886510506ddf81e99061c24 devel/posix-import.pl -SHA256 d1b35f8b2791bbbc8a9bfebd833f0605ee61fab6c3359d946f6bfd98f2748c39 devel/posix-size.pl -SHA256 b0a3b6eb88bdfeff0df760cb3efb4adb273e714fc5b31952ae04c08f97778a67 devel/posix-user.pl -SHA256 3c2dac4a7c2ba98712164d1208f3a5e410f83caf1024160ac59e13fd36b9b649 devel/ppi-wide.pl -SHA256 a839d370094437708cd6a2d5d943b9e4c7304cfa74555e78d29e78de05d4904f devel/qrm.pl -SHA256 a95efe46b713e4a64915665e149758cdd7acc9110b5f8a91bdad5716bef13aa4 devel/regexp-balanced.pl -SHA256 7c84e835e88b635461ab42881de80647ec8a32819be8a7fc613383d10d9e9d0f devel/regexp-string.pl -SHA256 6db6dd1a9f40c29aaa31a7911fb49ef3915627c07a77c963be2219d007f0f484 devel/string-format.pl -SHA256 a5d96df05c22f0f8f03ddcc6ddb3014c885d9e4adb6fac4c519fe9f879d45494 devel/trailing-comma-heredoc.pl -SHA256 6cfd94e20019ffd7c8766084b35d706fceab777babeb40c4e94b86bd9fb9c474 devel/try-catch.pl -SHA256 031bfb1f97eacbdf6d307a05b052014b47e46a8bfa75f4d7dd61e0ff66a83d8f devel/try-pm.pl -SHA256 ec3789df002497dc9ff048a21a6edefd39ac685363cea571fc52bb42c12e3ff7 devel/try-syntax.pl -SHA256 c00563c24c3057c1a8004120a565bdae8d045c2daad8b44362d3fd46e7daa791 devel/try-tiny.pl -SHA256 5040e23524ee508cc58239c318cd1dd4a8efe742f4d8cfc866491b91eaf62a48 devel/unknown-backslash.pl -SHA256 3c91a7eb9dec2238c4a956c23beaf446fe4757b8e848ed8fd339c01f302b6286 devel/use-quoted.pl -SHA256 4b3e68d209384a0ae5d482c0daba605539b2444beddb98ce9d747a154730df33 devel/version.pl -SHA256 3dbf233912c2ebab9a99e4568408ca9d6c9c1aeaef1b5cf8649e0b727d07af6a devel/version_check.pl -SHA256 48e55e63d7640c2413ea9d2ab15293ece54e808bd293efe03aebd5a962b037b6 devel/version_check.pm -SHA256 9426c689e6735f50aceaba6abcead8557eb74496573e28c6b0a24f76519d4671 lib/Perl/Critic/Policy/CodeLayout/ProhibitFatCommaNewline.pm -SHA256 023cb77abc526de8823c0cb8656741f93212e1d2422c24fbe18b55c394330562 lib/Perl/Critic/Policy/CodeLayout/ProhibitIfIfSameLine.pm -SHA256 e199494debc1cb7b4d1e59fef1b8d6b822755f42e42fa1897579f1123554b150 lib/Perl/Critic/Policy/CodeLayout/RequireFinalSemicolon.pm -SHA256 ea03e3c6a450e1c804c9ce15b337249b8fde74f1e47e03f3ebf67c096d022da1 lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommaAtNewline.pm -SHA256 ec775e76de395f3cda3e03e053696607e0b352bfb2b0efdfce9c079f6d7bc5b5 lib/Perl/Critic/Policy/Compatibility/ConstantLeadingUnderscore.pm -SHA256 f5e03b9c61d7ffb7c3f9df58ee8ad1a124654463d6c12cd0876d4c0d4147afc0 lib/Perl/Critic/Policy/Compatibility/ConstantPragmaHash.pm -SHA256 5726c636d8dcff182a29fe3261ea79702570988570195af1b0db0b5d73d90487 lib/Perl/Critic/Policy/Compatibility/Gtk2Constants.pm -SHA256 366043f96ebd399c71b29bc98e0ba4ce09347710710f6044c26113b924c48c5f lib/Perl/Critic/Policy/Compatibility/PerlMinimumVersionAndWhy.pm -SHA256 b1a3c300048b23c1d099382c08c4156247c31b747cbdb83d5a358c2542eb0f57 lib/Perl/Critic/Policy/Compatibility/PodMinimumVersion.pm -SHA256 3db3bdd811b4a06ea0485bfbbe4fd1a3e5311ca85d82dff0002828f144425282 lib/Perl/Critic/Policy/Compatibility/ProhibitUnixDevNull.pm -SHA256 12872aa9b3852104b5f736b5b27dd95ebaff2ca5eaddb6483350aed1d438907e lib/Perl/Critic/Policy/Documentation/ProhibitAdjacentLinks.pm -SHA256 e15b42baaa744c89b9c16b39c248d8d71ce80c1707b589a5f4f9c5fd007bdb8d lib/Perl/Critic/Policy/Documentation/ProhibitBadAproposMarkup.pm -SHA256 e4750e86305a3233548533bd4ce3d716a9f8cfc1279691b2afcb23a074797609 lib/Perl/Critic/Policy/Documentation/ProhibitDuplicateHeadings.pm -SHA256 af03aa7b8186f60b6aaf6eca763b2886771c1a94bd05ea68cd52467560f68726 lib/Perl/Critic/Policy/Documentation/ProhibitDuplicateSeeAlso.pm -SHA256 bae95f44b6a9860d3dd818a1802d3daa188b7925d603dbdc20c18b24a56e7e47 lib/Perl/Critic/Policy/Documentation/ProhibitLinkToSelf.pm -SHA256 d05e0d0377389bc008b561f62bd131e1c8a3fa4b35e26be3c767ec20ad0361a5 lib/Perl/Critic/Policy/Documentation/ProhibitParagraphEndComma.pm -SHA256 22e25bab9e0eca963f0f5ecb1fa88d9a862e7422168e9bf18f739712729deab1 lib/Perl/Critic/Policy/Documentation/ProhibitParagraphTwoDots.pm -SHA256 de2510d4e9b20109860cb13bd08358e66061e9803b0b4820832c5a3d34e8ff25 lib/Perl/Critic/Policy/Documentation/ProhibitUnbalancedParens.pm -SHA256 c098579eb3bcbb51f17e0873723a30242d8a8d6f3dddd9acd6b83ba74d088151 lib/Perl/Critic/Policy/Documentation/ProhibitVerbatimMarkup.pm -SHA256 722b663efc3728a6de9ba606748bd8afdb5c3331f521ee4f6e39c6dc59f7a6d2 lib/Perl/Critic/Policy/Documentation/RequireEndBeforeLastPod.pm -SHA256 128481f682fab84159530e9d8ea00c2b2b8e0109a697562bd501ea077cb10980 lib/Perl/Critic/Policy/Documentation/RequireFilenameMarkup.pm -SHA256 c2bb4d3907e52145b4486f81ce82ca340faa0aeedd6c02df299e2ee735d5adeb lib/Perl/Critic/Policy/Documentation/RequireFinalCut.pm -SHA256 9db3b0346442cd5fda81f174ff05cb3a6cb5e534b6eb5e7b2d287de47007a707 lib/Perl/Critic/Policy/Documentation/RequireLinkedURLs.pm -SHA256 69de167b593de2ec8b4f4f8b7b075ba801de08f24b1944cabf1dfcba24a7a18f lib/Perl/Critic/Policy/Miscellanea/TextDomainPlaceholders.pm -SHA256 41b2e2008054307341759f38d2037aebbff035c069eee52c950174216ed124d1 lib/Perl/Critic/Policy/Miscellanea/TextDomainUnused.pm -SHA256 8bc8341f11625a069ae4b84085d212fec0c26908caa38fd2091521653a9d1560 lib/Perl/Critic/Policy/Modules/ProhibitModuleShebang.pm -SHA256 2d1e3454152432067e294d649855cea79387c575cdb39b3ce93c369e1ee107d8 lib/Perl/Critic/Policy/Modules/ProhibitPOSIXimport.pm -SHA256 82441369fd8d9e471111b0b0456d12fe0fe5db1063a2e5ff895bed98c43f0af0 lib/Perl/Critic/Policy/Modules/ProhibitUseQuotedVersion.pm -SHA256 eb182e0fcb4556f56225b9d5004d3f37440b1d5ac34a8b2fd74557828b6787ba lib/Perl/Critic/Policy/ValuesAndExpressions/ConstantBeforeLt.pm -SHA256 071ed32e09c53056e782f22647a83576f49a2c95e03135eaf718edd2765ed4e3 lib/Perl/Critic/Policy/ValuesAndExpressions/NotWithCompare.pm -SHA256 f212613743bc2bb27b80ef453d9f9160352baf67133560122c21efb3bea3f699 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitArrayAssignAref.pm -SHA256 c64d69520c093ce45a32f3208d1d2e3eb20a5523bf4e5444b0371046194e0702 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitBarewordDoubleColon.pm -SHA256 8944fd75c06d86421ba0cb093fd4e78e117aeaffc6d8e835e2a1bae29c7bfbc8 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitDuplicateHashKeys.pm -SHA256 4282bcd0fe275eb0578e094108c59c3ddbf5907e48f51b306d767c5b8aac0964 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyCommas.pm -SHA256 7a55ffd752e7a9420dc75187446249c4ecc5f324ee4ae47cf95a638f85a422a2 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitFiletest_f.pm -SHA256 67aeb3e3daf3d2df6b65a956229dfd301b8c4346d8b73597a89f0733e63fcab8 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNullStatements.pm -SHA256 2173e2bbd58e10e474efd753892b3dd0eeaa91a9e1f039a0c9228a1108000d6e lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitUnknownBackslash.pm -SHA256 9d14d4616c6ce0429db8120ed0d51a2a3e84e8480ccbe3808bd748ab59dff5be lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumericVersion.pm -SHA256 f09d9d94f876869b05c13415f256025a4c7eaf1048200b14faee6cab51681f6b lib/Perl/Critic/Policy/ValuesAndExpressions/UnexpandedSpecialLiteral.pm -SHA256 b14bc98be8e23c1e70f56563978a0970e17540712baf7afe36c7ae51d0d2443f lib/Perl/Critic/Pulp.pm -SHA256 e11dd6ea36e73ef6efdb22bb354723c138838f55ef5726f3fe56b2ffb1996775 lib/Perl/Critic/Pulp/PodParser.pm -SHA256 028f455946c8fbd4eff249b524a80aa0be060789f76b0eb2459df3d3afaff080 lib/Perl/Critic/Pulp/Utils.pm -SHA256 cebfea0b6819d75da1f6311cf66accd366827ab4d2b4810cfe9021b0713ec0cb t/ConstantBeforeLt.t -SHA256 585fa37980fdb03139e46c02e74300100a21cd213671a6217afce8c806544378 t/ConstantLeadingUnderscore.t -SHA256 3f8a9840fad96cbe676b4c6ae8f216c5aba2cf306b47cf8bc022e474d6fbe9b5 t/ConstantPragmaHash.t -SHA256 0cb270dcb88debefd9b7e49333d7c258d6f1a98a38a7fd3d89b1548e08102d67 t/Gtk2Constants.t -SHA256 91cd2bba3e246abf05c342ed549ed6d902e8a77a43b6c9c4e092e4c918732ac0 t/MyTestHelpers.pm -SHA256 72558fe55f6f84ad3ecaff0d2a42a5e345a142a2ffcf668c3f52982caf6aad3e t/NotWithCompare.t -SHA256 01af83ba3d503c24df39c7ee5731f6fe3395d38fdf0a785004e230e15419a2b3 t/PerlMinimumVersionAndWhy-pmv.t -SHA256 73d8fa69cd7bb54fa079a1d2872008ac5b94c5b9154c1f6fe143d9f0e07bbabb t/PerlMinimumVersionAndWhy.t -SHA256 d2c0beea1f27c22f04cc772260f7c7fbc9f0c8023e8d99b92aca1249cbd942c9 t/PodMinimumVersion.t -SHA256 58b1deb9ddb3d19a696c993a55ed4906dd40e9173724b43d725943c075f972c5 t/ProhibitAdjacentLinks.t -SHA256 3335d81e644d9d23e5008dd7f791cf4aab8b1f25b7fc3c052d378f3d05c1eb72 t/ProhibitArrayAssignAref.t -SHA256 ab9f8d17bc93e73f8a28645bd4e3fb8614a6e2eeb5028f2e4d8e126a2afc2c58 t/ProhibitBadAproposMarkup.t -SHA256 37fb5f50f0b52198bf89bb3097eda7818d8c07b5e55b1c941b7a17f9931d83f5 t/ProhibitBarewordDoubleColon.t -SHA256 daa0c6f26a727317ec0ed469ce73f61101119f946fe0190d74b93f726dd5a2d9 t/ProhibitDuplicateHashKeys.t -SHA256 0e217e2bf0fd77918238d76fef368ca80ea07590e57be8627dbefb983be3d1d8 t/ProhibitDuplicateHeadings.t -SHA256 0e5b5c962d0fb115c604dfda1aac47539092d77182b53d5c89f4abec78780588 t/ProhibitDuplicateSeeAlso.t -SHA256 a714ac8a824ff0505f036d64958aae621755654136174430905d909eef93d322 t/ProhibitEmptyCommas.t -SHA256 97b8c17d7dd58b7ab1caef08ba355a69531986a9237255fb58a66f6a9ddac2ba t/ProhibitFatCommaNewline.t -SHA256 a73848c402350d9ab7dd84fed62332808e3b77d8b8a588de6c2b54b9643f859d t/ProhibitFiletest_f.t -SHA256 b72494f3b365e08ae0d311a0ffc6b50eb374c1baf3c579d69f45662cdf99a01c t/ProhibitIfIfSameLine.t -SHA256 06c20fff15ea52befe831fbf751072cdb5b76709de12fa9bcfbcfca6693ac861 t/ProhibitLinkToSelf.t -SHA256 6792e96fd00dc397f0f7ece17aceea1c6e7520d374121cc4fac1a6e7ca87e9e0 t/ProhibitModuleShebang.t -SHA256 822eaf5639afb6f27d15f63a41bf7fa0ca5297cbcbb0fc7f696b05781cfdb5b6 t/ProhibitModuleShebang/False.pm -SHA256 1c1074ecb1d8b5bd92cb217f3780cfe52d0a51d0eda30e7aa0c018c2d0f81e9b t/ProhibitModuleShebang/MakeMaker.pm -SHA256 c14500e6603a3dff67719a5f770e0980ab4498feae1dc8d51027871e75778bac t/ProhibitModuleShebang/Script.pl -SHA256 573b4c0c2e2a79e0583bf95c608f744c149878164f173b07628bf434247e0cc8 t/ProhibitModuleShebang/SomeCode.pm -SHA256 bfe9a12bad01f483f5150adc7c9c388afc7a29c1955c0f8e2c673bf46d42a443 t/ProhibitModuleShebang/SomeCodeNewline.pm -SHA256 82d8ead03d15cbd2ab87f95270a9144ee54bad2ad5a7744a51b0eab2bdd4aed3 t/ProhibitModuleShebang/UsrBin.pm -SHA256 abdbe194fe58a6052c9172a02a2b34d1ae2e4290f1081e9ba81403730c10bbb2 t/ProhibitNullStatements.t -SHA256 c6822e47a949e3af1ba6f71fc50fde7ef45f063523d1595062e9a2689fc77225 t/ProhibitPOSIXimport.t -SHA256 8dcc91bcdcafbed73fdece14002aa3597f9278bd237ada7a90045b575b264cd7 t/ProhibitParagraphEndComma.t -SHA256 8433882052c54300f6f1021ea3d296bdc515d2dfda4d53711321b261cfca365b t/ProhibitParagraphTwoDots.t -SHA256 188095b8d6d1bd022efbe45b86258c520910dc1c3e8f0b61f79e101de074a03c t/ProhibitUnbalancedParens.t -SHA256 44c21f64221fbc8220e58a6f81d25ab4a493e855a37a98dcec81ebf4b2618945 t/ProhibitUnixDevNull-load.t -SHA256 2e56357f6cc32a157a99c92d69028ade6d868c6ffd1cc938373e72c5d1fe2635 t/ProhibitUnixDevNull.t -SHA256 29104748806caec86be3478e121d8af23832a3b2afc2fceea6a677580d456272 t/ProhibitUnknownBackslash.t -SHA256 7515473e61c5709fb1f86e33be6d1e6fbcc820a4c9239b2f198b07c9f2306a7b t/ProhibitUseQuotedVersion.t -SHA256 748b9558145a6374cee4cddc13ea3906bac0dd6d93457943a4c0275f4adb1569 t/ProhibitVerbatimMarkup.t -SHA256 a18cc47ace19e68f986a9872147b685a3022e6ca98f291b6fa2559f2d0dc2dc2 t/Pulp.t -SHA256 6cdeaf8749995210942c9caea06732dc892955ec4f857da92d758d3c7115e899 t/RequireEndBeforeLastPod.t -SHA256 03e0df0dd7360e77717d69101c2bf834934f4d559ac3f12d999c3cfbe8601cf5 t/RequireFilenameMarkup.t -SHA256 4b05666f628864ad231be089e8e69461f2ae65d580def4dc248fb19036ac73be t/RequireFinalCut.t -SHA256 49a4fca0e2cfeefcc3a430c993e55b05b89d84d4f974670c61263d4ba309e18b t/RequireFinalSemicolon.t -SHA256 f908a49abc7019aa1f5608d45a27e7cae8b56f9399ccc5ae36d5a49ba01e43f1 t/RequireLinkedURLs.t -SHA256 a29c53864312904e182fd8bd92cd49b42d02dced9ca1950c084e363db086aca6 t/RequireNumericVersion.t -SHA256 9f2cd71e3a5b31b7e1c0ff00e5be055059685784adf9032feb8f129d98e66338 t/RequireTrailingCommaAtNewline.t -SHA256 c8f7caee474baa9d05f887fd1f2bbea37171eb38eb12e122cb1cc5cd6c769055 t/TextDomainPlaceholders.t -SHA256 75f2bcc7dfed9ef501f99b95dbddd0023e5b42c786b3daba4f611d81bf919599 t/TextDomainUnused.t -SHA256 f4e0bdd26b63a02e93c56c755e7c2b1d7ca88df801c0df13aca4fb2961c77e58 t/UnexpandedSpecialLiteral.t -SHA256 3e78d309997cba2be7c3acc3d88453c25792a20789cb64dfa9533b531a254cd2 t/Utils.t -SHA256 ef75312e02ddcfed7095de7eecebc6b7b863d56acd9b64142737ab7a5edb57e3 xt/0-META-read.t -SHA256 f03d4741c4e6dd385c7bafa06118082bad4809a64e28a094635324ef8ab4f3e5 xt/0-Test-ConsistentVersion.t -SHA256 be42622f3841d04240cb1284e6b30e1af81cb0fcb56d29e853c70af656653488 xt/0-Test-DistManifest.t -SHA256 48b441e0c335e93946d913897e342662387788833229c5ba5fac57f0ff3d567c xt/0-Test-Pod.t -SHA256 2e1e1d896a226aeb190cdcfbe83969f634c1be3e7344302e023915e3f7150732 xt/0-Test-Synopsis.t -SHA256 d33b48c1986680cd934565250bd9e3879674dfe6aad69b1717ed76354a29ff44 xt/0-Test-YAML-Meta.t -SHA256 75a73148514fad2715873d1e02a6fa8e3b9cc43f7aff97aaffac9721c086a319 xt/0-file-is-part-of.t -SHA256 7d9eacc605d8cb575b2869790e4b90d71dea6a97547c725825a49e1db036dee4 xt/0-no-debug-left-on.t -SHA256 9712b69026bc69a34513003e55e77de3442419db8bacc37b1674f7e8df3330e8 xt/policy-lists.t -SHA256 330b4711b382ca5c9961eb0270f5bb50d1dc5c43108dc5aa609e1ade77f228fe xtools/my-check-copyright-years.sh -SHA256 e1a132f2761adf019b76629f466c23a4b151f6f9764951ae99f31c408cb38023 xtools/my-check-file-part-of.sh -SHA256 5d5bed5cd3332e9d386b2e6175f2e6fad1e87b33f263836327935bb44a1d999b xtools/my-check-spelling.sh -SHA256 0a4726b4ae47a369753e2b3c1b88e84c67f8554d529935a13fa78f1e0c727462 xtools/my-deb.sh -SHA256 02d7e3c4bd8846b27dbeeb736ce4386015b0cacc1917a03d12e9db15417acc62 xtools/my-diff-prev.sh -SHA256 0c9535621e35a944f06353ea646eff232edacb9faeb43b0b60d2642c6ffb535b xtools/my-kwalitee.sh -SHA256 5b5355dfea048d707ef66bbc92aab6ce1058251be78a85f7bab218e90ab79912 xtools/my-manifest.sh -SHA256 54be906960c753ed9025b297cba51f4056da882df119de85c16fee0a3f18a79c xtools/my-pc.sh -SHA256 94f3c3184b1b1078205b93c2329dc5b34cd02c06661d945d69f0f1fe50bec019 xtools/my-tags.sh -SHA256 64aa17c531171303417500b4ddd5da8bcf91c77508a39e78c4e14f8ca0aee4e0 xtools/my-wunused.sh ------BEGIN PGP SIGNATURE----- -Version: GnuPG v1 - -iQIcBAEBAwAGBQJgO0+sAAoJEPjQtOfS0hGR7kkQAJbjeQrM0JGowtEhlFQ+TvLy -SGZLRPFbeoHAMtv+L0LRbJM2THgz/zGVqmNCYxRthoasBgiEcuDVML4oTHESIPL0 -ECZx0WGuS6MWRe6G3nDjnSLm793kCpDZ77VF3h0Z/pnkauGlZC9vJFhmc8YEMoQ5 -H5aK3y9KO2U5FLS9HiU40dmxuLNTALkrQIcMrBRZWhUWIsoSC4rWiPOsHEYZtlAl -JiGg15ZxnKqW82qHL7d9HAulo3ri+pD6XbyfKeLvNBVB81ImmsiQXsCTMKd7nG/T -FzvKTNwDvgO+hPW1dasatUZgAqK9xA01nhXUSAZGjvJjLsXIh3eXGAb08gbJ+VuS -9O5B89CbsiDStxZPOX1raYD0/lgEWJdQW0BSgVSCC5bfFjgFj+00kBkXskIY8+se -DcyXOZ7RfJX30oplvIu3sWgVPy3BNtHHOFYMC1PwqCuDXt+GC9VWqQPuKq2g1MaV -BP1wuZImdzjQTYclHot4vBnssTHXEJSbTuBs55ooiZdRoi7vwS/vsLdEyyV0d2Nh -sETzlkbrZ6rTNktFjw81uf3sS2zxDoc2J0Fo5/6hFxkNVzCerhQQuTt7XWXsANlv -qfclTSXtkxpKJ37TCIEVoBy2D+ee0vYhhQ60voOkjEqYV1WkAjG6xvocXmQmL6LA -pvWU9KmOfGweO7UAf8Qa -=F35T ------END PGP SIGNATURE----- diff --git a/author.yml b/author.yml new file mode 100644 index 0000000..5642ce9 --- /dev/null +++ b/author.yml @@ -0,0 +1,17 @@ +--- +pod_spelling_system: + skip: 0 + # list of words that are spelled correctly + # (regardless of what spell check thinks) + stopwords: + - GPL3 + - MERCHANTABILITY + - Ryde + - recognised + +pod_coverage: + skip: 0 + # format is "Class#method" or "Class", regex allowed + # for either Class or method. + private: + - Perl::Critic::Policy::Plicease::ProhibitArrayAssignAref diff --git a/debian/changelog b/debian/changelog deleted file mode 100644 index d9fe30b..0000000 --- a/debian/changelog +++ /dev/null @@ -1,5 +0,0 @@ -libperl-critic-pulp-perl (99-0.1) unstable; urgency=low - - * Packaged version. - - -- Kevin Ryde Sat, 27 Feb 2021 17:40:18 +1100 diff --git a/debian/compat b/debian/compat deleted file mode 100644 index ec63514..0000000 --- a/debian/compat +++ /dev/null @@ -1 +0,0 @@ -9 diff --git a/debian/control b/debian/control deleted file mode 100644 index b30a797..0000000 --- a/debian/control +++ /dev/null @@ -1,49 +0,0 @@ -# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2016, 2017, 2018 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Build-Depends could have the "maximum_tests" modules from META.yml -# for more tests, but they're optional author tests really and would -# just make the build tools drag in more stuff. -# -# "Depends:" has "libversion-perl" for older perl or "perl (>= 5.10)" -# for builtin version.pm, the same as the "Depends:" in -# libperl-critic-perl itself. Put libversion-perl first in the hope -# it makes "apt" inclined to download that one rather than upgrade perl. -# -# libpod-escapes-perl is in the perl core as of 5.10.0 up. Debian -# perl-modules package has a provide libpod-escapes-perl. Can that -# provide be relied on? Put an "| perl (>= 5.10)" just in case an -# incompatible change removes that provide. - -Source: libperl-critic-pulp-perl -Section: perl -Priority: optional -Build-Depends: cdbs, debhelper (>= 5), libtest-more-perl | perl (>= 5.6.2) -Maintainer: Kevin Ryde -Standards-Version: 4.2.1 -Homepage: http://user42.tuxfamily.org/perl-critic-pulp/index.html -Bugs: mailto:user42_kevin@yahoo.com.au - -Package: libperl-critic-pulp-perl -Architecture: all -Depends: perl (>= 5.6), libperl-critic-perl (>= 1.100), libppi-perl (>= 1.220), libpod-escapes-perl | perl (>= 5.10), pod-minimumversion (>= 50), libversion-perl | perl (>= 5.10), libio-string-perl (>= 1.02), liblist-moreutils-perl (>= 0.24), libscalar-list-utils-perl | perl (>= 5.8), ${perl:Depends}, ${misc:Depends} -Recommends: libperl-minimumversion-perl -Description: Some add-on policies for perlcritic - This is about 30 further policies for perlcritic, checking for - miscellaneous bugs, compatibility, efficiency, and cosmetics. - See the Perl::Critic::Pulp man page for the full list. diff --git a/debian/copyright b/debian/copyright deleted file mode 100644 index 3a395db..0000000 --- a/debian/copyright +++ /dev/null @@ -1,11 +0,0 @@ -Perl-Critic-Pulp is Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -Perl-Critic-Pulp is licensed under the GNU General Public License GPL -version 3 (or at your option any later version). The complete text of -GPL version 3 is in the file - - /usr/share/common-licenses/GPL-3 - -Program home page: - - http://user42.tuxfamily.org/perl-critic-pulp/index.html diff --git a/debian/rules b/debian/rules deleted file mode 100755 index 8839caa..0000000 --- a/debian/rules +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/make -f - -# Copyright 2008, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. - -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -include /usr/share/cdbs/1/rules/debhelper.mk -include /usr/share/cdbs/1/class/perl-makemaker.mk diff --git a/debian/source/format b/debian/source/format deleted file mode 100644 index d3827e7..0000000 --- a/debian/source/format +++ /dev/null @@ -1 +0,0 @@ -1.0 diff --git a/debian/watch b/debian/watch deleted file mode 100644 index d6ce82b..0000000 --- a/debian/watch +++ /dev/null @@ -1,28 +0,0 @@ -# Web site version watch, for devscripts uscan program. - -# Copyright 2008, 2009, 2017 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. - -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as -# published by the Free Software Foundation; either version 3, or (at -# your option) any later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with Perl-Critic-Pulp. If not, see -# . - - -# Crib notes: -# "man uscan" describes the format. -# test with: uscan --report --verbose --watchfile=debian/watch - -version=3 -https://user42.tuxfamily.org/perl-critic-pulp/index.html \ - .*/Perl-Critic-Pulp-([0-9]+)\.tar\.gz diff --git a/devel/Makefile b/devel/Makefile deleted file mode 100644 index 2b4789e..0000000 --- a/devel/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -# Copyright 2009 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -lexgrog: name.1 - lexgrog name.1 -name.1: name.pod - pod2man name.1 diff --git a/devel/MyFileTempDBM.pm b/devel/MyFileTempDBM.pm deleted file mode 100644 index d9d45ec..0000000 --- a/devel/MyFileTempDBM.pm +++ /dev/null @@ -1,57 +0,0 @@ -# Copyright 2012 Kevin Ryde. - -# MyUniqByInode.pm is shared by various distributions. -# -# MyUniqByInode.pm is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# MyUniqByInode.pm is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with this file. If not, see . - - -# sdbm -# /so/perl/perl-5.10.0/ext/SDBM_File/sdbm/sdbm.3 -# -# /usr/include/gdbm.h -- single file -# ndbm,odbm using gdbm -# -# db -# - -package MyFileTempDBM; -use strict; -use File::Spec; -use File::Temp 0.19; # version 0.19 for newdir() - -sub new { - my ($class) = @_; - my $dir = File::Temp->newdir; - return bless { dirobj => $dir, - filename => File::Spec->catfile ($dir->dirname, 'temp.sdbm'), - }, $class; - -} -sub filename { - my ($self) = @_; - return $self->{'filename'}; -} -sub dirname { - my ($self) = @_; - return $self->{'dirobj'}->dirname; -} -sub DESTROY { - my ($self) = @_; - unlink "$self->{'filename'}.dir"; - unlink "$self->{'filename'}.pag"; - unlink "$self->{'filename'}.sdbm_dir"; # on VMS, according to sdbm.h -} - -1; -__END__ diff --git a/devel/MyLocatePerl.pm b/devel/MyLocatePerl.pm deleted file mode 100644 index c760f4e..0000000 --- a/devel/MyLocatePerl.pm +++ /dev/null @@ -1,142 +0,0 @@ -# Copyright 2009, 2010, 2011, 2012, 2013 Kevin Ryde. - -# MyLocatePerl.pm is shared by various distributions. -# -# MyLocatePerl.pm is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# MyLocatePerl.pm is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with this file. If not, see . - -package MyLocatePerl; -use 5.006; -use strict; -use warnings; -use base 'File::Locate::Iterator'; -use FindBin; -use File::Slurp 'slurp'; -use IO::File; -use IO::Uncompress::AnyInflate; -use MyUniqByInode; -use MyUniqByMD5; - -# uncomment this to run the ### lines -# use Smart::Comments; - - -# glob => '/usr/share/perl5/Debconf/FrontEnd/*' - -my $compressed_re = qr/\.gz$/; - -sub new { - my ($class, %options) = @_; - - my @suffixes = ('t','pm','pl','PL'); - if (delete $options{'include_pod'}) { - push @suffixes, 'pod'; - } - if (delete $options{'exclude_t'}) { - @suffixes = grep {$_ ne 't'} @suffixes; - } - if (delete $options{'only_t'}) { - @suffixes = ('t'); - } - my $suffixes = join('|',@suffixes); - my $suffixes_re = qr/\.($suffixes)($compressed_re)?$/; - ### $suffixes - ### $suffixes_re - - my $locate_regexp = $suffixes_re; - if (defined (my $under_directory = $options{'under_directory'})) { - unless ($under_directory =~ m{/$}) { - $under_directory .= '/'; - } - $locate_regexp = qr/^\Q$under_directory\E.*$suffixes_re/; - } - ### $locate_regexp - - my $self = $class->SUPER::new ( - # globs => ['/bin/*', - # '/usr/bin/*', - # '/usr/local/bin/*', - # '/usr/local/bin2/*'], - regexp => $locate_regexp, - %options); - $self->{'uniq_ino'} = MyUniqByInode->new; - $self->{'uniq_md5'} = MyUniqByMD5->new; - $self->{'my_suffixes_re'} = $suffixes_re; - return $self; -} - -sub next { - my ($self) = @_; - unless ($self->{'done_script'}) { - $self->{'done_script'} = 1; - my $filename = File::Spec->catfile ($FindBin::Bin, $FindBin::Script); - ### $filename - my $content = slurp($filename); - return ($filename, $content); - } - for (;;) { - defined(my $filename = $self->SUPER::next) or return; - ### consider: $filename - - next if $filename =~ m{/blib/}; - next if $filename =~ m{/DateTime/TimeZone/}; # data .pm's - next if $filename =~ m{/Date/Manip/TZ/}; # data .pm's - next if $filename =~ m{/Date/Manip/Offset/}; # data .pm's - next if $filename =~ m{/Text/Unidecode/}; # data .pm's - next if $filename =~ m{/junk.pl}; - - my $io; - if ($filename =~ $compressed_re) { - $io = IO::Uncompress::AnyInflate->new ($filename); - } else { - $io = IO::File->new ($filename, 'r'); - } - $io or next; - $self->{'uniq_ino'}->uniq($filename) or next; # or $io ??? - - my $content = _slurp_if_perl ($self, $filename, $io); - ### content: $content && "ok" - next if ! defined $content; - - $self->{'uniq_md5'}->uniq_str($content) or next; - - ### return: $filename - return ($filename, $content); - } -} - -sub _slurp_if_perl { - my ($self, $filename, $io) = @_; - ### slurp: "$io" - - my $first = ''; - if ($filename !~ $self->{'my_suffixes_re'}) { - # file in /bin etc must have #!.../perl - $io->read($first, 128) or return; - ### first part: $first - - if ($first !~ m{^#!([^\r\n]*/|[ \t]*)perl[ \t\r\n]}) { - ### no #!perl - return; - } - } - - my $rest = do { local $/; $io->getline }; # slurp - if (! defined $rest) { - ### read error: $! - return; - } - return $first . $rest; -} -1; -__END__ diff --git a/devel/MyStuff.pm b/devel/MyStuff.pm deleted file mode 100644 index cd8b7c6..0000000 --- a/devel/MyStuff.pm +++ /dev/null @@ -1,138 +0,0 @@ -# Copyright 2009, 2011 Kevin Ryde. - -# MyStuff.pm is shared by various distributions. -# -# MyStuff.pm is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# MyStuff.pm is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with this file. If not, see . - -package MyStuff; -use 5.010; -use strict; -use warnings; -use Text::Tabs; - -#my $verbose = 0; - -sub line_at_pos { - my ($str, $pos) = @_; - my $start = (rindex ($str, "\n", $pos) || -1) + 1; - my $end = (index ($str, "\n", $pos) || length($str)-1) + 1; - return substr($str, $start, $end - $start); -} - -sub pos_to_line_and_column { - my ($str, $pos) = @_; - $str = substr ($str, 0, $pos); - my $nlpos = rindex ($str, "\n"); - my $lastline = substr ($str, $nlpos+1); - $lastline = Text::Tabs::expand ($lastline); - my $colnum = 1 + length ($lastline); - my $linenum = 1 + scalar($str =~ tr/\n//); - return ($linenum, $colnum); -} - - - -package Iterator::Simple::FileUniq; -sub new { - my ($class, $it) = (shift, shift); - my $fu = FileUniq->new (@_); - return Iterator::Simple::iterator - (sub { - my $filename; - while (defined (my $filename = $it->next)) { - last if $fu->uniq ($filename); - } - }); -} - -package Locator; -sub new { - my ($class, @args) = @_; - open my $fh, '-|', 'locate', '-0', '--', @args or die; - return bless { fh => $fh, - }, $class; -} -sub next { - my ($self) = @_; - my $fh = $self->{'fh'}; - my $filename; - { - local $/ = "\0"; - $filename = <$fh>; - if (defined $filename) { - chomp $filename; - } - } - return $filename; -} - -package Locator::BinScripts; -sub new { - my ($class, $type) = @_; - return bless { 'type' => $type, - 'locator' => Locator->new ('/bin/*', - '/usr/bin/*', - '/usr/local/bin/*', - '/usr/local/bin2/*', - ) }, $class; -} -sub next { - my ($self) = @_; - my $type = $self->{'type'}; - for (;;) { - my $filename = $self->{'locator'}->next // return undef; - my ($fh, $buf); - if (open($fh,'<',$filename) - && read($fh,$buf,80) - && $buf =~ m{^#![a-z0-9/]*/$type([ \t]|$)}) { - return $filename; - } - } -} - -package Locator::Concat; -sub new { - my ($class, @locators) = @_; - return bless { 'locators' => \@locators }, $class; -} -sub next { - my ($self) = @_; - my $locators = $self->{'locators'}; - for (;;) { - @$locators or return undef; - my $filename = $locators->[0]->next; - if (defined $filename) { return $filename; } - shift @$locators; - } -} - -1; -__END__ -my @files = split /\n/, `locate \*.t \*.pm \*.pl`; -@files = grep {-f $_} @files; - -@files = uniq_by_func (\&stat_dev_ino, @files); -sub uniq_by_func { - my $func = shift; - my %seen; - return grep { $seen{$func->($_)}++ == 0 } @_; -} -sub stat_dev_ino { - my ($filename) = @_; - my ($dev, $ino) = stat ($filename); - return "$dev,$ino"; -} - -print "look at ",scalar(@files)," files\n"; - diff --git a/devel/MyUniqByInode.pm b/devel/MyUniqByInode.pm deleted file mode 100644 index df7fa9e..0000000 --- a/devel/MyUniqByInode.pm +++ /dev/null @@ -1,102 +0,0 @@ -# Copyright 2009, 2010, 2011, 2012 Kevin Ryde. - -# MyUniqByInode.pm is shared by various distributions. -# -# MyUniqByInode.pm is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# MyUniqByInode.pm is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with this file. If not, see . - - -package MyUniqByInode; -use strict; -use warnings; -use SDBM_File; -use Fcntl; -use MyFileTempDBM; - -# uncomment this to run the ### lines -#use Smart::Comments; - -sub new { - my ($class) = @_; - ### new() ... - my %hash; - my $tempdbm = MyFileTempDBM->new; - my $filename = $tempdbm->filename; - print - "tempfiles $filename.pag\n", - " $filename.dir\n"; - tie %hash, 'SDBM_File', $filename, - Fcntl::O_RDWR() | Fcntl::O_CREAT(), 0600 - or die $!; - return bless { tempdbm => $tempdbm, - hash => \%hash, - }, $class; -} -DESTROY { - my ($self) = @_; - my $filename = $self->{'tempdbm'}->filename; - my $num_keys = scalar(keys %{$self->{'hash'}}); - print "tempfile $filename $num_keys entries, sizes ", - -s "$filename.pag"," ", - -s "$filename.dir","\n"; - system "ls -l $filename.*"; -} - -sub uniq { - my ($self, $filename_or_handle) = @_; - ### $filename_or_handle - - my ($dev, $ino) - = (ref $filename_or_handle && $filename_or_handle->can('stat') - ? $filename_or_handle->stat - : stat ($filename_or_handle)); - ### $dev - ### $ino - - if (! defined $dev) { - # error treated as unique - return 1; - } - - my $key = "$dev,$ino"; - ### $key - - my $hash = $self->{'hash'}; - ### hash: exists $hash->{$key} - return (! exists $hash->{$key} - && ($hash->{$key} = 1)); -} - -# sub stat_dev_ino { -# my ($filename) = @_; -# my ($dev, $ino) = stat ($filename); -# if (! defined $dev) { -# # print "Cannot stat: $filename\n"; -# return ''; -# } -# return "$dev,$ino"; -# } - -1; -__END__ - -package main; -my $u = MyUniqByInode->new; -### $u -print $u->uniq('/etc/issue.net'),"\n"; -print $u->uniq('/etc/issue.net'),"\n"; -print $u->uniq('/etc/issue.net'),"\n"; -print $u->uniq('/etc/issue.net'),"\n"; -print "keys ",keys $u->{'hash'},"\n"; -exit 0; - diff --git a/devel/MyUniqByMD5.pm b/devel/MyUniqByMD5.pm deleted file mode 100644 index f07ef2f..0000000 --- a/devel/MyUniqByMD5.pm +++ /dev/null @@ -1,84 +0,0 @@ -# Copyright 2009, 2010, 2011, 2012 Kevin Ryde. - -# MyUniqByMD5.pm is shared by various distributions. -# -# MyUniqByMD5.pm is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# MyUniqByMD5.pm is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with this file. If not, see . - -package MyUniqByMD5; -use strict; -use warnings; -use SDBM_File; -use Digest::MD5; -use MyFileTempDBM; - -# uncomment this to run the ### lines -#use Smart::Comments; - -sub new { - my ($class) = @_; - my %hash; - my $tempdbm = MyFileTempDBM->new; - my $filename = $tempdbm->filename; - tie %hash, 'SDBM_File', - $filename, - Fcntl::O_RDWR() | Fcntl::O_CREAT(), - 0600 - or die $!; - return bless { tempdbm => $tempdbm, - seen => \%hash, - }, $class; -} - -sub uniq_filename { - my ($self, $filename) = @_; - ### uniq_filename(): $filename - open my $fh, $filename - or return 1; # error as if unique - return $self->uniq_fh ($fh); -} - -sub uniq_fh { - my ($self, $fh) = @_; - ### uniq_fh(): $fh - my $md5obj = Digest::MD5->new; - $md5obj->addfile($fh); - return $self->uniq_md5 ($md5obj->hexdigest) -} - -sub uniq_str { - my ($self, $str) = @_; - return $self->uniq_md5 (Digest::MD5::md5 ($str)); -} - -sub uniq_md5 { - my ($self, $md5) = @_; - ### uniq_md5(): $md5 - - ### seen: exists $self->{'seen'}->{$md5} - # if (exists $self->{'seen'}->{$md5}) { print "MyUniqByMD5: suppress\n"; } - - my $seen = $self->{'seen'}; - return (! exists $seen->{$md5} - && ($seen->{$md5} = 1)); -} - -1; -__END__ - -package main; -my $uniq = MyUniqByMD5->new; -print $uniq->uniq_filename('/etc/passwd'),"\n"; -print $uniq->uniq_filename('/etc/passwd'),"\n"; -exit 0; - diff --git a/devel/PosixUser.pm b/devel/PosixUser.pm deleted file mode 100644 index c1ba7ff..0000000 --- a/devel/PosixUser.pm +++ /dev/null @@ -1,34 +0,0 @@ -# Copyright 2008, 2009 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -package PosixUser; -use strict; -use warnings; -use POSIX; -BEGIN { - print (defined &DBL_MANT_DIG ? "defined\n" : "not defined\n"); - print "digs ",DBL_MANT_DIG(),"\n"; - my $proto = prototype(\&DBL_MANT_DIG); - print "proto '",(defined $proto ? $proto : 'undef'),"'\n"; -} - -sub func { - print "func\n"; - if (DBL_MANT_DIG < 10) { print "yes\n"; } else { print "no\n"; } -} - -1; diff --git a/devel/TestAutoload.pm b/devel/TestAutoload.pm deleted file mode 100644 index 8348615..0000000 --- a/devel/TestAutoload.pm +++ /dev/null @@ -1,32 +0,0 @@ -# Copyright 2008, 2009 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -package TestAutoload; -use strict; -use warnings; -use Exporter; -our @ISA = qw(Exporter); -our @EXPORT_OK = qw(BAR); - -sub AUTOLOAD { - { no strict; - print "create $AUTOLOAD\n"; } - *BAR = sub () { return 456; }; - goto &BAR; -} - -1; diff --git a/devel/apropos-markup.pl b/devel/apropos-markup.pl deleted file mode 100644 index ca0c926..0000000 --- a/devel/apropos-markup.pl +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.010; -use strict; -use warnings; -use Perl::Critic; - -use FindBin; -my $progname = $FindBin::Script; - -my $filename = "$FindBin::Bin/$FindBin::Script"; -print "filename $filename\n"; - -my $critic = Perl::Critic->new - ('-profile' => '', - '-single-policy' => 'ProhibitBadAproposMarkup'); -print "Policies:\n"; -foreach my $p ($critic->policies) { - print " ",$p->get_short_name,"\n"; -} - -# "%f:%l:%c:" is good for emacs compilation-mode -Perl::Critic::Violation::set_format ("%f:%l:%c:\n %P\n %m\n %r\n"); - -foreach my $file ($filename) { - print "$file\n"; - my @violations; - if (! eval { @violations = $critic->critique ($file); 1 }) { - print "Died in \"$file\": $@\n"; - next; - } - print @violations; - if (my $exception = Perl::Critic::Exception::Parse->caught) { - print "Caught exception in \"$file\": $exception\n"; - } -} -exit 0; - -__END__ - -## no critic (ProhibitBadAproposMarkup) - -=pod - -blah - -=cut - -=head1 NAME - -Foo - some C blah - -=cut - diff --git a/devel/array-delete.pl b/devel/array-delete.pl deleted file mode 100644 index 4574587..0000000 --- a/devel/array-delete.pl +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -use strict; -use warnings; - -my $bool; -my @x; -print (exists($x[0])); -#print (exists($bool ? $x[0] : $x[1])); - -# sub foo {}; -# print(exists &foo, exists &bar); -# exit 0; - -# my @x; -# delete $x[1]; -# exit 0; - - -# use Perl::MinimumVersion; -# $object = Perl::MinimumVersion->new( \'delete $x[1];' ); -# print $object->minimum_version; - diff --git a/devel/backslash-control.pl b/devel/backslash-control.pl deleted file mode 100644 index 7d76766..0000000 --- a/devel/backslash-control.pl +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# "\c\"**" - -use strict; -use warnings; -my $str = "\c\"**"; -print length($str)," $str\n"; -print ord($str),"\n"; -print ord(substr($str,1,1)),"\n"; diff --git a/devel/bareword-colon.pl b/devel/bareword-colon.pl deleted file mode 100644 index cb052a7..0000000 --- a/devel/bareword-colon.pl +++ /dev/null @@ -1,76 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2010, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.010; -use strict; -use warnings; - -sub noop { } - -{ package blah; sub x { print "method x runs\n" } } -{ - # sub x { print "function x runs\n" } - x blah => noop(); - exit 0; -} - -# { package main::foo; sub x {} } -# { package main::foo::bar; sub y {} } -# -# { -# $, = ' '; -# # print %main::; -# my $stash = \%main::; -# # print keys %$stash; -# print $stash->{foo::}//'undef',"\n"; -# -# $stash = \%main::foo::; -# print keys %$stash,"\n"; -# print $stash->{bar::}//'undef',"\n"; -# exit 0; -# } -# -# sub make { -# return "make: @_"; -# } -# -# { -# package Math; -# sub Complex { return "foo"; } -# } -# { -# my $c = make Math::Complex 1, 2; -# print $c,"\n"; -# } -# require Math::Complex; -# { -# my $c = make Math::Complex:: 3,4; -# print $c,"\n"; -# } -# -# print $Math::{'Complex::'},"\n"; -# print $Math::{Complex::},"\n"; -# -# { -# package Foo::Bar::Quux; -# sub blah { return "blah"; } -# } -# print $Foo::{'Bar::Quux::'}||'undef',"\n"; -# print $Foo::Bar::{'Quux::'},"\n"; -# print $Foo::Bar::{'Quux'}||'undef',"\n"; diff --git a/devel/charnames.pl b/devel/charnames.pl deleted file mode 100644 index 15f991c..0000000 --- a/devel/charnames.pl +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2017 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# use charnames automatic in perl 5.16 up - -use strict; -use warnings; -{ - use charnames ':full'; - print "\N{APOSTROPHE}"; -} -print "\N{COLON}"; -print "\N{EQUALS SIGN}"; diff --git a/devel/churn-posix.pl b/devel/churn-posix.pl deleted file mode 100644 index b482917..0000000 --- a/devel/churn-posix.pl +++ /dev/null @@ -1,77 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Churn ProhibitPOSIXimport over all .pm files. - -use 5.006; -use strict; -use warnings; -use Getopt::Long; -use Perl::Critic; -use Perl::Critic::Utils; -use Perl::Critic::Violation; - -use Perl6::Slurp; -use Iterator::Simple qw(igrep); -use Iterator::Simple::Locate; -use lib::abs '.'; -use MyUniqByMD5; - -my $it = Iterator::Simple::Locate->new (globs => [ '*.pm' ]); -{ - my $uniq = MyUniqByMD5->new; - $it = igrep { $uniq->uniq_file($_) } $it; -} - -my $critic = Perl::Critic->new ('-profile' => '', - '-single-policy' => 'ProhibitPOSIXimport'); -print "Policies:\n"; -foreach my $p ($critic->policies) { - print " ",$p->get_short_name,"\n"; -} - -# "%f:%l:%c:" is good for emacs compilation-mode -Perl::Critic::Violation::set_format ("%f:%l:%c:\n %P\n %m\n %r\n"); - -while (my $filename = $it->next) { - my $content = eval { Perl6::Slurp::slurp ($filename) } || next; - ($content =~ /^(use POSIX.*)/m) || next; - print "\n$filename\n$1\n"; - - my @violations; - if (! eval { @violations = $critic->critique ($filename); 1 }) { - print "Died in \"$filename\": $@\n"; - next; - } - print @violations; - if (my $exception = Perl::Critic::Exception::Parse->caught) { - print "Caught exception in \"$filename\": $exception\n"; - } -} - -exit 0; - - -# $it = igrep {filename_has_use_posix($_)} $it; -# sub filename_has_use_posix { -# my ($filename) = @_; -# my $content = do { Perl6::Slurp::slurp ($filename) } || return 0; -# return ($content =~ /^use POSIX.*/m) -# } diff --git a/devel/churn-unbalanced.pl b/devel/churn-unbalanced.pl deleted file mode 100644 index e665d47..0000000 --- a/devel/churn-unbalanced.pl +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.005; -use strict; -use warnings; - -use lib::abs '.', 'lib'; -use MyLocatePerl; -use MyStuff; -use Perl::Critic::Policy::Documentation::ProhibitUnbalancedParens; - -# uncomment this to run the ### lines -#use Smart::Comments; - -my $verbose = 0; - -{ - package MyParser; - use base 'Perl::Critic::Pulp::PodParser::ProhibitUnbalancedParens'; - sub violation_at_linenum_and_textpos { - my ($self, $message, $linenum, $str, $pos) = @_; - my $filename = $self->{'filename'}; - my ($pos_linenum, $column) = MyStuff::pos_to_line_and_column($str,$pos); - $linenum += $pos_linenum - 1; - print "$filename:$linenum:$column: $message\n"; - } -} -my $parser = MyParser->new; - -my $l = MyLocatePerl->new (exclude_t => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - $parser->{'filename'} = $filename; - $parser->parse_from_file ($filename); -} - -exit 0; diff --git a/devel/churn.pl b/devel/churn.pl deleted file mode 100755 index 10b394f..0000000 --- a/devel/churn.pl +++ /dev/null @@ -1,211 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010, 2011, 2012, 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: churn.pl [--const] [--not] [--diag] [directories...] -# -# Run the pulp tests over all files under the given directories, or by -# default over /usr/share/perl (core and add-ons). -# -# The options select just one of the policies. -# - -use 5.006; -use strict; -use warnings; -use Getopt::Long; - -use lib 'lib','devel/lib'; - -use Perl::Critic; -use Perl::Critic::Utils; -use Perl::Critic::Violation; - -my @option_policies; -my $option_t_files = 0; - -GetOptions - (require_order => 1, - t => \$option_t_files, - F => sub { - push @option_policies, 'Documentation::RequireFilenameMarkup$'; - }, - paracomma => sub { - push @option_policies, 'Documentation::ProhibitParagraphEndComma$'; - }, - duphead => sub { - push @option_policies, 'Documentation::ProhibitDuplicateHeadings'; - }, - ifif => sub { - push @option_policies, 'CodeLayout::ProhibitIfIfSameLine'; - }, - duphashkeys => sub { - push @option_policies, 'ValuesAndExpressions::ProhibitDuplicateHashKeys'; - }, - linkself => sub { - push @option_policies, 'Documentation::ProhibitLinkSelf$'; - }, - unbal => sub { - push @option_policies, 'Documentation::inprogressProhibitUnbalancedParens'; - }, - aref => sub { - push @option_policies, 'ValuesAndExpressions::ProhibitArrayAssignAref'; - }, - const => sub { - push @option_policies, 'ValuesAndExpressions::ConstantBeforeLt'; - }, - not => sub { - push @option_policies, 'ValuesAndExpressions::NotWithCompare'; - }, - null => sub { - push @option_policies, 'ValuesAndExpressions::ProhibitNullStatements'; - }, - literals => sub { - push @option_policies, 'ValuesAndExpressions::UnexpandedSpecialLiteral'; - }, - commas => sub { - push @option_policies, 'ValuesAndExpressions::ProhibitEmptyCommas'; - }, - lastpod => sub { - push @option_policies, 'Documentation::RequireEndBeforeLastPod'; - }, - consthash => sub { - push @option_policies, 'Compatibility::ConstantPragmaHash'; - }, - gtk2 => sub { - push @option_policies, 'Modules::Gtk2Version'; - }, - podmin => sub { - push @option_policies, 'Compatibility::PodMinimumVersion'; - }, - posix => sub { - push @option_policies, 'Modules::ProhibitPOSIXimport'; - }, - usever => sub { - push @option_policies, 'Modules::ProhibitUseQuotedVersion'; - }, - apropos => sub { - push @option_policies, 'Documentation::ProhibitBadAproposMarkup'; - }, - backslash => sub { - push @option_policies, 'ValuesAndExpressions::ProhibitUnknownBackslash'; - }, - semicolon => sub { - push @option_policies, 'CodeLayout::RequireFinalSemicolon'; - }, - verb => sub { - push @option_policies, 'Documentation::ProhibitVerbatimMarkup$'; - }, - shebang => sub { - push @option_policies, 'Modules::ProhibitModuleShebang$'; - }, - numver => sub { - push @option_policies, 'ValuesAndExpressions::RequireNumericVersion'; - }, - - # coming soon ... - fatnewline => sub { - push @option_policies, 'ProhibitFatCommaAfterNewline'; - }, - testprint => sub { - push @option_policies, 'TestingAndDebugging::ProhibitTestPrint'; - }, - trailing => sub { - push @option_policies, 'CodeLayout::RequireTrailingCommaAtNewline'; - }, - ); - -my @files; -if ($option_t_files) { - require File::Locate; - @files = File::Locate::locate ('*.t', '/var/cache/locate/locatedb'); -} else { - my @dirs = @ARGV; - if (! @dirs) { - @dirs = ( - '/usr/share/perl5', - '/usr/bin', - '/bin', - glob('/usr/share/perl/*.*.*'), - ); - } - print "Directories:\n"; - foreach (@dirs) { - print " ",$_,"\n"; - } - @files = map { -d $_ ? Perl::Critic::Utils::all_perl_files($_) : $_ } @dirs; -} - -@files = uniq_by_func (\&stat_dev_ino, @files); -print "Files: ",scalar(@files),"\n"; - -# @list = uniq_by_func ($func, @list) -sub uniq_by_func { - my $func = shift; - my %seen; - return grep { my $key = $func->($_); - defined $key && $seen{$key}++ == 0 - } @_; -} -sub stat_dev_ino { - my ($filename) = @_; - my ($dev, $ino) = stat ($filename); - return if ! defined $dev; - return "$dev,$ino"; -} - - -my $critic; -if (@option_policies) { - $critic = Perl::Critic->new ('-profile' => '', - '-single-policy' => shift @option_policies); - foreach my $policy (@option_policies) { - $critic->add_policy (-policy => $policy); - } -} else { - $critic = Perl::Critic->new ('-profile' => '', - '-theme' => 'pulp'); -} -# $critic->add_policy -# (-policy => 'ValuesAndExpressions::ProhibitNullStatements', -# -params => { allow_perl4_semihash => 1 }); - -print "Policies:\n"; -foreach my $p ($critic->policies) { - print " ",$p->get_short_name,"\n"; -} - - -# "%f:%l:%c:" is good for emacs compilation-mode -Perl::Critic::Violation::set_format ("%f:%l:%c:\n %P\n %m\n %r\n"); - -foreach my $file (@files) { - print "$file\n"; - my @violations; - if (! eval { @violations = $critic->critique ($file); 1 }) { - print "Died in \"$file\": $@\n"; - next; - } - print @violations; - if (my $exception = Perl::Critic::Exception::Parse->caught) { - print "Caught exception in \"$file\": $exception\n"; - } -} - -exit 0; diff --git a/devel/const-autoload.pl b/devel/const-autoload.pl deleted file mode 100644 index e9ac953..0000000 --- a/devel/const-autoload.pl +++ /dev/null @@ -1,46 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use FindBin; -use lib $FindBin::Bin; -use TestAutoload ('BAR'); - -sub AUTOLOAD { - { no strict; - print "create $AUTOLOAD\n"; } - *FOO = sub () { return 123; }; - goto &FOO; -} - -{ no strict; - if (FOO < 456) { print "yes\n"; } else { print "no\n"; } -} -if (FOO() < 456) { print "yes\n"; } else { print "no\n"; } -print "FOO is ",FOO(),"\n"; - - -BEGIN { - print "BAR is ",BAR(),"\n"; -} -if (BAR < 456) { print "yes\n"; } else { print "no\n"; } -if (BAR() < 456) { print "yes\n"; } else { print "no\n"; } -print "BAR is ",BAR(),"\n"; -exit 0 diff --git a/devel/const-noproto.pl b/devel/const-noproto.pl deleted file mode 100644 index e2ca379..0000000 --- a/devel/const-noproto.pl +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Data::Dumper; - -use Socket; -my $p = prototype('Socket::SOCK_DGRAM'); -print "SOCK_DGRAM ",Dumper($p); - - -sub FOO { return 123; } -# bad -# if (FOO < 456) { print "yes\n"; } else { print "no\n"; } -exit 0 diff --git a/devel/const-post.pl b/devel/const-post.pl deleted file mode 100644 index 986ea41..0000000 --- a/devel/const-post.pl +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -#use warnings; - -print "FOO\n"; -(FOO < 456); -if (FOO < 200) { print "yes\n"; } else { print "no\n"; } -if (FOO < 100) { print "yes\n"; } else { print "no\n"; } -use constant FOO => 123; -if (FOO < 200) { print "yes\n"; } else { print "no\n"; } -if (FOO < 100) { print "yes\n"; } else { print "no\n"; } - -print "BAR\n"; -#sub BAR { return 123; } -print "",BAR,"\n"; -if (BAR < -1) { print "yes\n"; } else { print "no\n"; } - -print "QUUX\n"; -if (QUUX < 200) { print "yes\n"; } else { print "no\n"; } -if (QUUX < 100) { print "yes\n"; } else { print "no\n"; } -#BEGIN -{ *QUUX = sub { return 123; }; } -if (QUUX < 200) { print "yes\n"; } else { print "no\n"; } -if (QUUX < 100) { print "yes\n"; } else { print "no\n"; } - -use strict; -use warnings; -print "XYZZY\n"; -BEGIN { -# sub XYZZY { return 150; } -# if (XYZZY < 300) { print "yes\n"; } else { print "no\n"; } -# if (XYZZY < 200) { print "yes\n"; } else { print "no\n"; } -# if (XYZZY < 100) { print "yes\n"; } else { print "no\n"; } -} -if (XYZZY < 300) { print "yes\n"; } else { print "no\n"; } -if (XYZZY < 200) { print "yes\n"; } else { print "no\n"; } -if (XYZZY < 100) { print "yes\n"; } else { print "no\n"; } -use constant XYZZY => 250; -# use constant XYZZY => 150; -if (XYZZY < 300) { print "yes\n"; } else { print "no\n"; } -if (XYZZY < 200) { print "yes\n"; } else { print "no\n"; } -if (XYZZY < 100) { print "yes\n"; } else { print "no\n"; } - - -exit 0 diff --git a/devel/constant-underscore.pl b/devel/constant-underscore.pl deleted file mode 100644 index 9be4d47..0000000 --- a/devel/constant-underscore.pl +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl - -# Copyright 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -foreach my $p ('perl-5.003', - 'perl-5.004', - 'perl-5.005', - 'perl-5.6.0', - 'perl-5.8.0', - 'perl-5.8.3', - 'perl5.10.1', - ) { - print "$p\n"; - system ($p, '-e', 'use strict; use constant _foo => 123; print "foo=",_foo(); exit 21'); - print "$?\n"; - system ($p, '-e', 'print 123'); - print "$?\n"; - print "\n"; -} diff --git a/devel/duplicate-hash-keys.pl b/devel/duplicate-hash-keys.pl deleted file mode 100644 index a27e36d..0000000 --- a/devel/duplicate-hash-keys.pl +++ /dev/null @@ -1,135 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.010; -use strict; -use warnings; -use lib 'devel/lib'; -use Perl::Critic; - -use FindBin; -my $progname = $FindBin::Script; - -my %zzz; -my $zzz = {}; -my %dup = ( - qw(a 1 a 2), - x => 1, - , - %zzz, - %$zzz, - x => 2); - -my $rr = \\{}; -%$$$rr = (a => 1, 'a' => 2); -%zzz = (a => 1, 'a' => 2); - -my %_Expiration_Units = ( map(($_, 1), qw(a b c)), - map(($_, 1), qw(d e f)), - ); - - -my @filenames = ( - "$FindBin::Bin/$FindBin::Script", - - "/usr/share/perl5/AppConfig/State.pm", - "/usr/share/perl5/AnyEvent/HTTP.pm", - "/usr/share/perl5/Cache/BaseCache.pm", - "/usr/share/perl5/Dpkg/Deps.pm", - "/usr/share/perl5/Encode/X11.pm", - "/usr/share/perl5/Image/TIFF.pm", - "/usr/share/perl5/Regexp/Assemble.pm", - "/usr/share/perl5/Regexp/Grammars.pm", - "/usr/share/perl5/String/RewritePrefix.pm", - "/usr/share/perl5/Text/Autoformat.pm", - "/usr/share/perl5/XML/XPathEngine.pm", - "/usr/share/perl5/Email/Simple/Header.pm", - "/usr/share/perl5/HTML/Lint/HTML4.pm", - "/usr/share/perl5/PPIx/Regexp/Lexer.pm", - "/usr/share/perl5/Perl/Critic/Command.pm", - "/usr/share/perl5/Regexp/Parser/Objects.pm", - - # tricked by @_ - "/usr/share/perl5/Acme/Tie/Eleet.pm", - "/usr/share/perl5/Pod/Simple/RTF.pm", - - # conditional - "/usr/share/perl5/App/Nopaste/Service.pm", - "/usr/share/perl5/CPAN/Meta/Converter.pm", - - # expression - "/usr/share/perl5/XUL/Gui.pm", - "/usr/share/perl5/Class/Meta/Attribute.pm", - "/usr/share/perl5/Curses/UI/Buttonbox.pm", - "/usr/share/perl5/Curses/UI/Calendar.pm", - "/usr/share/perl5/Curses/UI/Checkbox.pm", - "/usr/share/perl5/Curses/UI/Listbox.pm", - "/usr/share/perl5/Date/Calendar/Profiles.pm", - "/usr/share/perl5/Dpkg/Control/Fields.pm", - "/usr/share/perl5/Image/Caa/DriverANSI.pm", - - # tricked by reverse - "/usr/share/perl5/XML/FeedPP.pm", - - # genuine dups ... - "/usr/share/perl5/Parse/DebControl.pm", - "/usr/share/perl5/XML/Twig.pm", - "/usr/share/perl5/CPAN/Meta/Validator.pm", - "/usr/share/perl5/Date/Manip/Zones.pm", - "/usr/share/perl5/Image/ExifTool/APP12.pm", - "/usr/share/perl5/Image/ExifTool/DICOM.pm", - "/usr/share/perl5/Image/ExifTool/Exif.pm", - "/usr/share/perl5/Image/ExifTool/Flash.pm", # and diff value - "/usr/share/perl5/Image/ExifTool/FlashPix.pm",# and diff value - "/usr/share/perl5/Image/ExifTool/GPS.pm", - "/usr/share/perl5/Image/ExifTool/GeoTiff.pm", - "/usr/share/perl5/Image/ExifTool/HTML.pm", - "/usr/share/perl5/Image/ExifTool/Leaf.pm", - "/usr/share/perl5/Image/ExifTool/PNG.pm", # same - "/usr/share/perl5/Image/ExifTool/Pentax.pm", - "/usr/share/perl5/Image/ExifTool/QuickTime.pm", - "/usr/share/perl5/Lingua/EN/Inflect.pm", - - ); - -my $critic = Perl::Critic->new - ('-profile' => '', - '-single-policy' => 'ProhibitDuplicateHashKeys'); -print "Policies:\n"; -foreach my $p ($critic->policies) { - print " ",$p->get_short_name,"\n"; -} - -# "%f:%l:%c:" is good for emacs compilation-mode -Perl::Critic::Violation::set_format ("%f:%l:%c:\n %P\n %m\n %r\n"); - -foreach my $filename (@filenames) { - print "$filename\n"; - my @violations; - if (! eval { @violations = $critic->critique ($filename); 1 }) { - print "Died in \"$filename\": $@\n"; - next; - } - print @violations; - if (my $exception = Perl::Critic::Exception::Parse->caught) { - print "Caught exception in \"$filename\": $exception\n"; - } -} - -exit 0; diff --git a/devel/empty.pl b/devel/empty.pl deleted file mode 100644 index e29717d..0000000 --- a/devel/empty.pl +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Data::Dumper; - -my @x = 1 .. 5; -my @y = map {1=>2}, @x; -print Dumper(\@y); - -@y = map {;1=>2} @x; -print Dumper(\@y); - -@y = map {1=>$_}, @x; -print Dumper(\@y); - -exit 0; diff --git a/devel/fat-comma.pl b/devel/fat-comma.pl deleted file mode 100644 index a6a3e14..0000000 --- a/devel/fat-comma.pl +++ /dev/null @@ -1,80 +0,0 @@ - -#!/usr/bin/perl -w - -# Copyright 2010, 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -use strict; -use vars '$VERSION'; -$VERSION = 999; - -# uncomment this to run the ### lines -use Data::Dumper 'Dumper'; - -BEGIN { - sub mysub () { return 'fufu'; } -} -{ - my %hash = (main - -> - VERSION - => - 123, - - mysub - + - mysub - => - 123); - print Dumper(\%hash); - exit 0; -} - -{ - # use constant CON => 'abc'; - # use constant CON - # => 'def'; - print abc(); - exit 0; -} -{ - my @dash = (-POSIX::DBL_MAX()); - print Dumper(\@dash); - exit 0; -} -{ - my %hash = (andx => 123); - print Dumper(\%hash); - exit 0; -} - -{ - my %hash = (__PACKAGE__ - => - 123); - ### %hash - exit 0; -} - -{ - my @x = ( - print => 123 - ); - print @x; - exit 0; -} diff --git a/devel/gettext.pl b/devel/gettext.pl deleted file mode 100644 index 3f708fd..0000000 --- a/devel/gettext.pl +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Locale::TextDomain; - -print __x(<<'HERE', bar => 123); -foo $a {xbar} -HERE - -print Locale::TextDomain::__x('foo {bar}'); -print __x('foo {bar}'); - -print __x('foo {bar} {zz}', bar => 123, zz => 456); -print __x('foo ' . '{bar}', bar => 123, zz => 456); - -exit 0; diff --git a/devel/grep-ampersand-call.pl b/devel/grep-ampersand-call.pl deleted file mode 100644 index c733321..0000000 --- a/devel/grep-ampersand-call.pl +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-ampersand-call.pl -# -# Look for &foo calls, without parens. -# - -use 5.010; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -sub foo {} -&foo; - -my $verbose = 0; -my $l = MyLocatePerl->new; -my $count; - -{ - my $filename = 'devel/grep-ampersand-call.pl'; - my $content = eval { Perl6::Slurp::slurp ($filename) } || next; - file ($filename, $content); -} -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } - exit 0; -} - -# regexp for qualified name Foo::Bar::quux -# this must hide in Regexp::Common somewhere surely? -my $word; -BEGIN { $word = qr/[_[:alpha:]](?:[_:[:alnum:]]*[_[:alnum:]])?/o; } - -sub file { - my ($filename, $str) = @_; - - if ($verbose) { - print "$filename\n"; - } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - while ($str =~ /(\bdefined\s*(?:\s|\(+)|')?(\\+)?\&$word\s*(.)/sgo) { - next if defined $1; - next if defined $2; - my $pos = pos($str); - - my $after = $3; - next if $after =~ /[;(]/; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: ampersand call no parens '$after'\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-arg-unpack.pl b/devel/grep-arg-unpack.pl deleted file mode 100644 index 7f506b4..0000000 --- a/devel/grep-arg-unpack.pl +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-arg-unpack.pl -# -# Look for "sub { my ($foo); ... }" missing the @_ in the unpack. -# Usually some variant unpacking or local vars. - -use 5.006; -use strict; -use warnings; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - - while ($str =~ /( - sub\s+\w*\s*{\s* - my\s*\([^)]+\)\s*; - ) - /gx) { - my $line = $1; - my $pos = pos($str) - length($1); - - my ($linenum, $colnum) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$linenum:$colnum:\n", - "$line\n"; - } -} - -__END__ - -use foo .5; -use Foo::Bar _1000_; -{ no Foo::Bar v.1; } diff --git a/devel/grep-array-assign.pl b/devel/grep-array-assign.pl deleted file mode 100644 index 3c71124..0000000 --- a/devel/grep-array-assign.pl +++ /dev/null @@ -1,60 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.005; -use strict; -use warnings; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - -my $verbose = 0; - -my $hws = qr/\s*(#.*\n)*\s*/; - -my $l = MyLocatePerl->new; -OUTER: while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ( - # = qw() - # $str =~ /(=\s*qw$hws[([{])/og - - # plain word @array=[] - $str =~ /(\@\w+\s*=\s*[[{])/sg - - # parens )=[ or )={ - #$str =~ /(\)\s*=\s*[[{])/sg - - # single element string like @ISA='Foo' - # $str =~ /(\@\w+\s*=\s*[0-9'"])/sg - ) { - my $pos = pos($str)-length($1); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-array-slice-single.pl b/devel/grep-array-slice-single.pl deleted file mode 100644 index 8fe7147..0000000 --- a/devel/grep-array-slice-single.pl +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -OUTER: while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - # while ($str =~ /( - # @\s* - # \w+\s* - # \[\s*\d+\s*\] - # ) - # /sgx) { - # my $pos = pos($str)-length($1); - # - # my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - # print "$filename:$line:$col:\n", - # MyStuff::line_at_pos($str, $pos); - # } - - # hash slice - while ($str =~ /( - @\s* - \w+\s* - \{\s*(\w+|'[^']*'|"[^"]*")\s*\} - ) - /sgx) { - my $pos = pos($str)-length($1); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-backslash-control.pl b/devel/grep-backslash-control.pl deleted file mode 100644 index b54194f..0000000 --- a/devel/grep-backslash-control.pl +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# XML::RSS::TimingBot \cm\cj lower case - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - # strip comments - # $str =~ s/#.*//mg; - - while ($str =~ /(?:^|\G|[^\\]) # current pos or not a \ - (?:\\\\)* # odd number of \ - # \\c(.) - \\c([^\x40-\x5F]) - /sgx) { - my $char = $1; - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $s = MyStuff::line_at_pos($str, $pos); - - # substr($s,0,$col) =~ /q[qx]|"/ or next; - - print "$filename:$line:$col: unknown control \\c $char\n$s"; - } -} - -exit 0; diff --git a/devel/grep-backslash.pl b/devel/grep-backslash.pl deleted file mode 100644 index 4e917b0..0000000 --- a/devel/grep-backslash.pl +++ /dev/null @@ -1,75 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - # strip comments - # $str =~ s/#.*//mg; - - # while ($str =~ /(?:^|\G|[^\\]) # current pos or not a \ - # \\(?:\\\\)* # odd number of \ - # # and an unknown - # # ([cdghijkmopqsvwyzABCDFGHIJKMNOPRSTVWXYZ456789]) - # \n - # /sgx) { - # - # while ($str =~ /\G[$@]\w+ - # (?:::\w+)* - # \\(:) - # /sgx) { - - - # \-> \[ \{ - while ($str =~ /(\\*) - [\$\@]\w+ - (?:::\w+)* - \\([[{-]) - /sgx) { - next if length($1) & 1; - - my $char = $2; - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $s = MyStuff::line_at_pos($str, $pos); - - substr($s,0,$col) =~ /q[qx]|"/ or next; - - print "$filename:$line:$col: unknown \\$char\n$s"; - } -} - -exit 0; diff --git a/devel/grep-condsub.pl b/devel/grep-condsub.pl deleted file mode 100644 index c171af0..0000000 --- a/devel/grep-condsub.pl +++ /dev/null @@ -1,63 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2020 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use Regexp::Common 'comment'; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; -use Text::Tabs (); - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - # strip comments - $str =~ s/$RE{comment}{Perl}//og; - - while ($str =~ /^([ \t])+(sub [[:alnum:]]|\b(BEGIN|END|CHECK|INIT)\b)/mg) { - my $pos = pos($str); - - my ($indent) = Text::Tabs::expand ($1); - $indent = length ($indent); - - my $before = substr ($str, 0, $pos); - $indent--; - $before =~ /^ {0,$indent}(if|unless)\b/m - or next; - my $before_pos = $-[0]; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $before_pos), - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-constant-empty.pl b/devel/grep-constant-empty.pl deleted file mode 100644 index b70bc40..0000000 --- a/devel/grep-constant-empty.pl +++ /dev/null @@ -1,96 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for -# use constant foo => (); -# use constant foo; - - -# cf t/pragma/constant. -# use constant UNDEF2 => ; # the weird way -# use constant 'UNDEF3' ; # the 'short' way - -use 5.005; -use strict; -use warnings; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - -use constant FOO => (); -use constant BAR => ; -use constant 'ABC'; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -my %seen; -OUTER: while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /( - \buse - \s+ - constant - \s+ - ([0-9.]+\s+)? - \w+ - \s* - => - ( - \s* - \(\s*\) - | - \s*; - ) - ) - /sgx) { - my $pos = pos($str)-1; - my $whole = $1; - next if $seen{$whole}++; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } - - while ($str =~ /( - \buse - \s+ - constant - \s+ - ('|"|qw) - ) - /sgx) { - my $pos = pos($str)-1; - my $whole = $1; - next if $seen{$whole}++; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-constant-underscore.pl b/devel/grep-constant-underscore.pl deleted file mode 100644 index 5feb991..0000000 --- a/devel/grep-constant-underscore.pl +++ /dev/null @@ -1,81 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.005; -use strict; -use warnings; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - -# use constant __FOO => 123; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -OUTER: while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^[^#]*\buse warnings/) { - # 5.6 for use warnings anyway, presume that what the code is targeting - next; - } - - while ($str =~ /\buse (5[.0-9]*)/g) { - ### $1 - my $perlver = eval { version->new($1) }; - ### $perlver - if (defined $perlver && $perlver >= 5.006) { - ### skip, high enough - next OUTER; - } - } - - while ($str =~ /\buse - \s+ - constant - \s+ - ([0-9.]+\s+)? - _/sgx) { - my $pos = pos($str)-1; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; - - -{ - use Readonly; - Readonly::Scalar my $FOO => 123; - my $ref = \$FOO; - $$ref = 456; - - use constant XYZZY => 123; - $ref = \(XYZZY); - $$ref = 456; - exit 0; -} diff --git a/devel/grep-cut-noblank.pl b/devel/grep-cut-noblank.pl deleted file mode 100644 index 86c13f9..0000000 --- a/devel/grep-cut-noblank.pl +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2016 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for =cut without preceding blank line. -# - -use 5.008; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -use Smart::Comments; - -use base 'Exporter'; -our @EXPORT = ('foo'); - -my $verbose = 0; -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /[^\n]\n=cut/mg) { - my $pos = pos($str); - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: =cut without blank line\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-devnull.pl b/devel/grep-devnull.pl deleted file mode 100644 index 64c2b90..0000000 --- a/devel/grep-devnull.pl +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - pos($str) = 0; - $str =~ m{(qq?.|[\'\"]) - \s* - (\+?(<|>>?)\s*)? - /dev/null - }gsx - or next; - my $pos = pos($str); - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - - print "$filename:$line:$col: /dev/null\n", - MyStuff::line_at_pos($str, $pos); -} - -exit 0; diff --git a/devel/grep-dollar-semi.pl b/devel/grep-dollar-semi.pl deleted file mode 100644 index 64af19f..0000000 --- a/devel/grep-dollar-semi.pl +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-dollar-semi.pl -# -# Look for $; -# - -use 5.010; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -sub foo {} -&foo; - -my $verbose = 0; -my $l = MyLocatePerl->new; -my $count; - -{ - my $filename = 'devel/grep-dollar-semi.pl'; - my $content = eval { Perl6::Slurp::slurp ($filename) } || next; - file ($filename, $content); -} -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } - exit 0; -} - -sub file { - my ($filename, $str) = @_; - - if ($verbose) { - print "$filename\n"; - } - - while ( - $str =~ /return \$;/ - - # $str =~ /\$;[^,] - # (?!\$*\)\s*\{) # not prototype - # /sgx - ) { - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: \$;\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-duplicate-END.pl b/devel/grep-duplicate-END.pl deleted file mode 100644 index 317a1e0..0000000 --- a/devel/grep-duplicate-END.pl +++ /dev/null @@ -1,70 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012, 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-duplicate-END.pl -# -# Search for duplicated __END__ tokens. - - -use 5.010; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -my $verbose = 0; -my $l = MyLocatePerl->new; -my $count; -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } - exit 0; -} - -sub file { - my ($filename, $str) = @_; - - if ($verbose) { - print "$filename\n"; - } - - next if $str =~ /^use AutoLoader/; - - my @pos; - while ($str =~ /^(__END__)/mg) { - push @pos, pos($str) - length($1); - } - if (@pos > 1) { - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos[1]); - print "$filename:$line:$col: duplicate END\n"; - } -} - -exit 0; - -__END__ - -__END__ diff --git a/devel/grep-duplicate-use.pl b/devel/grep-duplicate-use.pl deleted file mode 100644 index d84980c..0000000 --- a/devel/grep-duplicate-use.pl +++ /dev/null @@ -1,97 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2013, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-duplicate-use.pl -# - -use 5.010; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - - -my $verbose = 0; -my $l = MyLocatePerl->new (exclude_t => 1, - under_directory => '/usr/share/perl5', - # under_directory => '/usr/share/perl/5.14/', - # under_directory => "$ENV{HOME}/p/", - # under_directory => "/usr/share/perl5/Wx/DemoHints/", - ); -my $count; - -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } - exit 0; -} - -sub file { - my ($filename, $str) = @_; - - if ($verbose) { - print "$filename\n"; - } - - # ([A-Za-z0-9_:]*)/mg) { - # [ \t]* - - my %seen; - my $package = 'main'; - while ($str =~ /^(__END__)|^(use|no|package)[ \t\r\n]+([^;]*)/mg) { - last if $1; - my $type = $2; - my $module = $3; - my $pos = pos($str)-length($module); - $module =~ s/[ \t\r\n]+/ /g; - $module =~ s/^[ \t\r\n]+//g; - $module =~ s/[ \t\r\n]+$//g; - # next if $module eq 'integer'; # pragma - - if ($type eq 'package') { - $package = $module; - next; - } - if ($type eq 'no') { - delete $seen{$package}->{$module}; # = 'pragma'; - next; - } - - if ($seen{$package}->{$module}) { - if ($seen{$package}->{$module} eq 'pragma') { next; } - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: (package $package)\n", - MyStuff::line_at_pos($str, $pos); - - } else { - $seen{$package}->{$module} = 1; - } - } -} - -exit 0; diff --git a/devel/grep-each.pl b/devel/grep-each.pl deleted file mode 100644 index 25b7a60..0000000 --- a/devel/grep-each.pl +++ /dev/null @@ -1,63 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-each.pl -# -# Look for "each %foo". -# - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; -use File::Locate::Iterator; - -use FindBin; -my $progname = $FindBin::Script; - -my $verbose = 0; - -my $it = File::Locate::Iterator->new (globs => [# '*.t', - '*.pm', - '*.pl']); -print "$progname: $it->{'regexp'}\n"; -my $count = 0; - -while (defined (my $filename = $it->next)) { - open my $in, '<', $filename or next; - if ($verbose) { print "$filename\n"; } - $count++; - - while (<$in>) { - /\beach\s+%/ or next; - print "$filename:$.:1:\n $_"; - } - close $in or die; -} -print "count $count\n"; - -sub line_at_pos { - my ($str, $pos) = @_; - my $beg = rindex ($str, "\n", $pos) || -1; - my $end = index ($str, "\n", $pos) || length($str); - return substr ($str, $beg+1, $end-($beg+1)); -} - -__END__ diff --git a/devel/grep-eval-line.pl b/devel/grep-eval-line.pl deleted file mode 100644 index 48c475e..0000000 --- a/devel/grep-eval-line.pl +++ /dev/null @@ -1,76 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-ampersand-call.pl -# -# Look for &foo calls, without parens. -# - -use 5.010; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -sub foo {} -&foo; - -my $verbose = 0; -my $l = MyLocatePerl->new; -my $count; - -{ - my $filename = 'devel/grep-ampersand-call.pl'; - my $content = eval { Perl6::Slurp::slurp ($filename) } || next; - file ($filename, $content); -} -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } - exit 0; -} - -sub file { - my ($filename, $str) = @_; - - if ($verbose) { - print "$filename\n"; - } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - while ($str =~ /\beval(\s*[\'\"]|\s+q.)#[ \t]*line/sgo) { - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: eval #line\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-exporter.pl b/devel/grep-exporter.pl deleted file mode 100644 index 692c9a1..0000000 --- a/devel/grep-exporter.pl +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2020 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.005; -use strict; -use warnings; -use Regexp::Common 'comment'; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (regexp => qr/\.pm$/); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - # strip comments - $str =~ s/$RE{comment}{Perl}//og; - - next if $str =~ /^[^#]*use\s+(base|parent)\s+(qw)?'Exporter'/m; - next if $str =~ /^[^#]*(use|require)\s+Exporter/m; - - while ($str =~ /'Exporter'(.*)$/mg) { - my $pos = pos($str) - 1; - my $end = $1; - next if ($end =~ /\s*=>/); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $s = MyStuff::line_at_pos($str, $pos); - - print "$filename:$line:$col: exporter\n $s"; - } -} - -exit 0; diff --git a/devel/grep-fat-comma.pl b/devel/grep-fat-comma.pl deleted file mode 100644 index 4415853..0000000 --- a/devel/grep-fat-comma.pl +++ /dev/null @@ -1,89 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011, 2013, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -# cf -# egrep -nH -ire '[^[a-z-]-[a-ln-z0-9][a-z0-9]*::' /usr/share/perl/5.10 -# /usr/share/perl/5.14/Math/Complex.pm:712: -CORE::exp(CORE::log(-$z)/3) : -# /usr/share/perl/5.14/Math/Complex.pm:1043: my $v = -CORE::log($alpha + CORE::sqrt($alpha*$alpha-1)); - -# cf \c control characters in lower case -# XML::RSS::TimingBot \cm\cj - -use 5.005; -use strict; -use warnings; -use Perl::Critic::Utils 'is_perl_builtin'; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - # if ($str =~ /^__END__/m) { - # substr ($str, $-[0], length($str), ''); - # } - - # strip comments - # $str =~ s/#.*//mg; - - while ($str =~ /((^|[^>A-Za-z])(\w+) - ([ \t]*(\#[^\n]*)?\n)+ - [ \t]*=> - )/sgx) { - my $whole = $1; - my $word = $3; - next unless is_perl_builtin(_sans_dash($word)); - my $pos_end = pos($str); - my $pos = $pos_end - length($whole) + 1; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $l1 = MyStuff::line_at_pos($str, $pos); - my $l2 = MyStuff::line_at_pos($str, $pos_end); - - ### $l1 - - # substr($s,0,$col) =~ /q[qx]|"/ or next; - - print "$filename:$line:$col:\n $l1 $l2"; - } -} - -sub _sans_dash { - my ($str) = @_; - $str =~ s/^-//; - return $str; -} - -exit 0; - -__END__ - -print # foo -=> '123', - --caller # jkdf -=> '123', diff --git a/devel/grep-filetest-f.pl b/devel/grep-filetest-f.pl deleted file mode 100644 index cb6e1fb..0000000 --- a/devel/grep-filetest-f.pl +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /(\b(rm |rm", *"|C|M)|a|1|<|\[)?-f\b/g) { - next if defined $1; - my $pos = pos($str); - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-foreach-splice.pl b/devel/grep-foreach-splice.pl deleted file mode 100644 index c992b74..0000000 --- a/devel/grep-foreach-splice.pl +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2014, 2020 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.010; -use strict; -use warnings; -use Perl6::Slurp; -use Iterator::Simple; -use Iterator::Simple::Locate; - -use lib::abs '.'; -use MyStuff; - -my $verbose = 0; - -my $it; -if (@ARGV) { - $it = Iterator::Simple::iter (\@ARGV); -} else { - # $it = Iterator::Simple::Locate->new (suffix => '.pm'); - $it = Iterator::Simple::Locate->new (glob => '/usr/share/perl5/*.pm'); -} -while (my $filename = $it->next) { - if ($verbose) { print "look at $filename\n"; } - - my $str = eval { Perl6::Slurp::slurp ($filename) } - || do { - # print "Cannot read $filename: $!\n"; - next; - }; - - my $count = 0; - while ($str =~ /^[ \t]*(for(each)?)\b.*\@/mg) { - my $print = $1; - my $pos = $-[1]; - - my $rest = substr ($str, $pos); - if ($rest =~ /^}/mg) { - $rest = substr ($rest, 0, pos($rest)); - } - next unless $rest =~ /\b(splice\b.*)/m; - my $spos = $-[1]; - my $sprint = $1; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: ``$print''\n", - MyStuff::line_at_pos($str, $pos); - - my ($sline, $scol) = MyStuff::pos_to_line_and_column ($str, $pos + $spos); - print "$filename:$sline:$scol: ``$sprint''\n", - MyStuff::line_at_pos($str, $pos); - - next if ($count++ > 5); - } -} - -exit 0; diff --git a/devel/grep-hash-keys.pl b/devel/grep-hash-keys.pl deleted file mode 100644 index f74ad8e..0000000 --- a/devel/grep-hash-keys.pl +++ /dev/null @@ -1,220 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# @foo{1..10} hash slice keys -# - -use 5.006; -use strict; -use Getopt::Long; -use Perl::Critic; -use Perl::Critic::Utils; -use Perl::Critic::Violation; - -use PPI::Document; -use Perl6::Slurp; -use lib::abs '.'; -use MyLocatePerl; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -my %zzz; -my $zzz = {}; -my %dup = ( - x => 1, - , - %zzz, - %$zzz, - x => 2); - - -my $verbose = 0; -my $l = MyLocatePerl->new (exclude_t => 1); -my $count; - -{ - my $filename = 'devel/grep-hash-keys.pl'; - my $content = eval { Perl6::Slurp::slurp ($filename) } || next; - file ($filename, $content); -} -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } - exit 0; -} - -{ - my $filename = '/usr/share/perl5/CPAN/Meta/Validator.pm'; - my $content = eval { Perl6::Slurp::slurp ($filename) } || next; - file ($filename, $content); - exit 0; -} - - -sub file { - my ($filename, $content) = @_; - - if ($verbose) { - print "$filename\n"; - } - - my $doc = PPI::Document->new (\$content); - if (! $doc) { - print "$filename:1: cannot parse: $PPI::Document::errstr\n"; - return; - } - - $count = 0; - $doc->find_first (sub { - my ($doc, $elem) = @_; - examine($elem, $filename); - return 0; - }); - if ($verbose) { - print " looked at $count\n"; - } -} - -sub examine { - my ($elem, $filename) = @_; - - if ($elem->isa('PPI::Structure::Constructor')) { - return if (substr($elem,0,1) eq '['); - - my $prev = $elem->sprevious_sibling; - return if ($prev && $prev->isa('PPI::Token::Word') && $prev eq 'do'); - - } elsif ($elem->isa('PPI::Structure::List')) { - my $prev = $elem->sprevious_sibling || return; - return unless $prev->isa('PPI::Token::Operator') && $prev eq '='; - ### elem: "$elem" - $prev = $prev->sprevious_sibling || return; - while ($prev->isa('PPI::Structure::Subscript')) { - $prev = $prev->sprevious_sibling || return; - } - ### prev: (ref $prev)." $prev" - ### symbol: $prev->symbol_type - return unless ($prev->isa('PPI::Token::Symbol') - && $prev->symbol_type eq '%'); - - } else { - return; - } - - ### examine: (ref $elem)." $elem" - $elem = $elem->schild(0) || return; - if ($elem->isa('PPI::Statement::Expression')) { - $elem = $elem->schild(0) || return; - } - $count++; - - - my @nodes = _elem_and_ssiblings ($elem); - my @arefs = Perl::Critic::Utils::split_nodes_on_comma(@nodes); - ### @nodes - ### @arefs - - # ignore empty commas - @arefs = grep {defined} @arefs; - - my %seen; - for (;;) { - my $aref = shift @arefs || return; # key - my $value_aref = shift @arefs; # value - - ### key: $aref - ### value: $value_aref - - $elem = $aref->[0]; - ### key: (ref $elem)." $elem" - - # %$foo is an even number of things - if ($elem->isa('PPI::Token::Cast') - && $elem eq '%') { - unshift @arefs, $value_aref; - next; - } - - my $str; - if (@$aref == 1) { - # %foo is an even number of things - if ($elem->isa('PPI::Token::Symbol') - && $elem->symbol_type eq '%') { - unshift @arefs, $value_aref; - next; - } - - if ($elem->isa('PPI::Token::Word')) { - $str = $elem; - } elsif ($elem->isa('PPI::Token::Quote')) { - $str = $elem->string; - } - } - ### $str - - if (defined $str && $seen{$str}++) { - my $linenum = $elem->line_number; - print "$filename:$linenum: duplicate key $str\n"; - } - } -} - -sub _elem_and_ssiblings { - my ($elem) = @_; - my @ret; - while ($elem) { - push @ret, $elem; - $elem = $elem->snext_sibling; - } - return @ret; -} - -sub elem_is_comma_operator { - my ($elem) = @_; - return ($elem->isa('PPI::Token::Operator') - && $Perl::Critic::Pulp::Utils::COMMA{$elem}); -} -exit 0; - - - - - - - - - - - # my $comma = $elem->snext_sibling; - # if ($comma && ! elem_is_comma_operator($comma)) { - # my $linenum = $comma->line_number; - # print "$filename:$linenum: stop at unknown comma $comma\n"; - # return; - # } - # - # $elem = $comma || return; - # do { - # $elem = $elem->snext_sibling || return; - # ### value: (ref $elem)." $elem" - # } until (elem_is_comma_operator($elem)); - # $elem = $elem->snext_sibling || return; diff --git a/devel/grep-if-if.pl b/devel/grep-if-if.pl deleted file mode 100644 index b51913c..0000000 --- a/devel/grep-if-if.pl +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Prima::MDI -# p-class.pl - -use 5.005; -use strict; -use warnings; -use Regexp::Common 'comment'; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - # strip comments - $str =~ s/$RE{comment}{Perl}/\n/og; - - while ($str =~ /\n[ \t]*\}[ \t]*if[ \t]/g) { - my $pos = pos($str) - 3; - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $s = MyStuff::line_at_pos($str, $pos); - print "$filename:$line:$col: ifif\n $s"; - } -} - -exit 0; diff --git a/devel/grep-import-tag.pl b/devel/grep-import-tag.pl deleted file mode 100644 index 0757334..0000000 --- a/devel/grep-import-tag.pl +++ /dev/null @@ -1,70 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /\n[ \t\r\n]*use - [ \t\r\n]+ - ([^ \t\r\n;]+) - [ \t\r\n]+ - (qw[ \t\r\n]*+.[ \t\r\n]*+|['"]) - ([^:!]) - [^;]* - ['" \t\r\n][:!] - /sgx) { - my $module = $1; - my $non = $3; - my $pos = $-[0] + 1; - - next if ($module eq 'base'); - next if ($module eq 'overload'); - next if ($module eq 'overload('); - next if ($module eq 'lib'); - next if ($module eq 'inc::latest'); - next if ($module eq "'inc::latest'"); - next if ($module eq 'Carp::Clan'); - next if ($module eq 'Glib::Object::Subclass'); - next if ($module eq 'Test::Without::Module'); - next if ($module eq 'Sort::Key::Register'); - next if ($module eq 'POE'); - next if ($module eq 'constant'); - next if ($module eq 'constant::defer'); - next if ($module eq 'Memoize::ToConstant'); - next if ($module eq 'Prima'); - next if ($module eq 'Tk::Reindex'); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: $module non colon \"$non\"\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-makefile-exit.pl b/devel/grep-makefile-exit.pl deleted file mode 100644 index fcfb462..0000000 --- a/devel/grep-makefile-exit.pl +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# exit 0 bad for Module::Depends::Intrusive - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; -use File::Locate::Iterator; - -use lib::abs '.'; -use MyStuff; - -use FindBin; -my $progname = $FindBin::Script; - -my $verbose = 0; - -my $it = File::Locate::Iterator->new (globs => ['*/Makefile.PL']); -my $count = 0; - -while (defined (my $filename = $it->next)) { - if ($verbose) { print "$filename\n"; } - my $str = eval { Perl6::Slurp::slurp($filename) } || next; - - while ($str =~ /exit[ \t(]+0/mg) { - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: exit\n"; - print MyStuff::line_at_pos($str, $pos); - } -} -print "count $count\n"; - -__END__ diff --git a/devel/grep-pack.pl b/devel/grep-pack.pl deleted file mode 100644 index 7f1c8f4..0000000 --- a/devel/grep-pack.pl +++ /dev/null @@ -1,137 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.010; -use strict; -use warnings; -use Regexp::Common qw /delimited/; - -use FindBin; -my $progname = $FindBin::Script; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; -my $count = 0; - -my $string_re = qr/$RE{delimited}{-delim=>q{'"}}/o; -# ($string_re) - -my $l = MyLocatePerl->new; -OUTER: while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - $count++; - - while ($str =~ /\b(?:un)?pack - [\t (]+ - ['"]([^'"]*)['"] - /gsxo) { - my $pos = pos($str); - my $format = $1; - - next if ($format =~ /\$/); # interpolations - - # # 5.002 supported - # next if ($format =~ /^[%*0-9 AabBhHcCsSiIlLnNvVfdpPuxX\@]*$/); - - # # 5.004 supported - # next if ($format =~ /^[%*0-9 AabBhHcCsSiIlLnNvVfdpPuxX\@w]*$/); - - # 5.006 supported - next if ($format =~ /^[%*0-9! AabBhHcCsSiIlLnNvVfdpPuxX\@wqQZ]*$/); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: pack $format\n ", - MyStuff::line_at_pos($str, $pos); - } -} - -print "looked at $count\n"; -exit 0; - - - -__END__ - - - -# 5.002 -# %NUM for unpack -# -# A An ascii string, will be space padded. -# a An ascii string, will be null padded. -# b A bit string (ascending bit order, like vec()). -# B A bit string (descending bit order). -# h A hex string (low nybble first). -# H A hex string (high nybble first). -# -# c A signed char value. -# C An unsigned char value. -# s A signed short value. -# S An unsigned short value. -# i A signed integer value. -# I An unsigned integer value. -# l A signed long value. -# L An unsigned long value. -# -# n A short in "network" order. -# N A long in "network" order. -# v A short in "VAX" (little-endian) order. -# V A long in "VAX" (little-endian) order. -# -# f A single-precision float in the native format. -# d A double-precision float in the native format. -# -# p A pointer to a null-terminated string. -# P A pointer to a structure (fixed-length string). -# -# u A uuencoded string. -# -# x A null byte. -# X Back up a byte. -# @ Null fill to absolute position. -# -# 5.004 -# w A BER compressed integer. Its bytes represent an unsigned -# integer in base 128, most significant digit first, with as few -# digits as possible. Bit eight (the high bit) is set on each -# byte except the last. -# -# 5.6.0 -# q A signed quad (64-bit) value. -# Q An unsigned quad value. -# (Quads are available only if your system supports 64-bit -# integer values _and_ if Perl has been compiled to support those. -# Causes a fatal error otherwise.) -# -# Z A null terminated (asciz) string, will be null padded. -# -# 5.8.0 -# F A floating point value in the native native format -# (a Perl internal floating point value, NV). -# D A long double-precision float in the native format. -# (Long doubles are available only if your system supports long -# double values _and_ if Perl has been compiled to support those. -# Causes a fatal error otherwise.) -# -# j A signed integer value (a Perl internal integer, IV). -# J An unsigned integer value (a Perl internal unsigned integer, UV). - diff --git a/devel/grep-pod-F.pl b/devel/grep-pod-F.pl deleted file mode 100644 index e289700..0000000 --- a/devel/grep-pod-F.pl +++ /dev/null @@ -1,203 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012, 2013, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Grep for filenames in POD which don't have F<> or other markup. -# -# /usr /opt /tmp /etc c:\ -# exclude NAME section for apropos - - - -use 5.006; -use strict; -use warnings; -use FindBin; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - - -my $verbose = 0; -### verbose on: $verbose=1 - -# my $str = File::Slurp::slurp('/down/el/monk-7/scripts/monk-cddb.pl'); -# print zap_to_first_pod($str); -# exit 0; - -my $l = MyLocatePerl->new (include_pod => 1, - exclude_t => 1, - # under_directory => '/usr/share/perl5', - # under_directory => '/usr/share/perl/5.14.2', - ); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - process_file ($filename, $str); - ### exit: exit() -} - - - -sub keep_only_newlines { - my ($str) = @_; - $str =~ tr/\n//cd; - return $str; -} - -sub zap_to_first_pod { - my ($str) = @_; - - if ($str =~ /^=/) { - return $str; # starts with pod - } - - my $pos = index ($str, "\n\n="); - if ($pos < 0) { - # no pod at all - return keep_only_newlines($str); - } - - my $pre = substr($str,0,$pos); - my $post = substr($str,$pos); - return keep_only_newlines($pre) . $post; -} -### zap: zap_to_first_pod("blah\nblah\n\n\n=pod") - -sub zap_after_last_pod { - my ($str) = @_; - ### zap_after_last_pod: $str - - my $pos; - my $command = ''; - while ($str =~ /\n\n=([^\n]*)\n?/sg) { - $command = $1; - $pos = $+[0]; - } - ### $pos - if ($command eq 'cut') { - return substr($str,0,$pos); - } else { - return $str; - } -} -### zap: zap_to_first_pod("blah\nblah\n\n\n=pod") - -sub zap_pod_verbatim { - my ($str) = @_; - while ($str =~ s/\n\n^[ \t].*/\n\n/m) { - } - return $str; -} - -sub zap_non_pod { - my ($str) = @_; - $str = zap_to_first_pod($str); - $str = zap_after_last_pod($str); - $str =~ s{(\n\n=cut.*\n)((.*\n)*)(\n^=)} - {$1 . keep_only_newlines($2) . $4}emg; - return $str; -} - -sub process_file { - my ($filename, $str) = @_; - $str = zap_non_pod($str); - $str = zap_pod_verbatim($str); - ### $str - - { - while ($str =~ m{(^|[\([:space:]]) - ( - /(bin|etc|dev|opt|proc|tmp|usr|var)($|[)[:space:]]|/\S*) - |[cC]:\\\S* - ) - }mgx) { - my $before = $1; - my $match = $2; - my $pos = $-[2]; - $match =~ s/[[:space:].,;]+$//; - - my ($linenum, $colnum) = MyStuff::pos_to_line_and_column($str, $pos); - print "$filename:$linenum:$colnum: \"$match\"\n ", - MyStuff::line_at_pos($str, $pos); - } - return; - } - - # if ($str =~ m{/opt}) { - # print $str; - # } - { - while ($str =~ m{([CFBIL]<.*?)? - ((/usr - |(?]* - ) - }ogx) { - my $markup = $1; - my $match = $2; - my $pos = $-[2]; - ### $markup - if (defined $markup) { - next unless $markup && $markup =~ />/; - } - # next if $match =~ /usr/; - # next unless $match =~ /dev/; - # next unless $match =~ /c:/i; - # next unless $match =~ /tmp/; - # next unless $match =~ /bin/; - # next unless $match =~ /opt/; - - my ($linenum, $colnum) = MyStuff::pos_to_line_and_column($str, $pos); - print "$filename:$linenum:$colnum: $match\n ", - MyStuff::line_at_pos($str, $pos); - } - } -} - -exit 0; - -=cut - -my $x = '/usr'; - -=pod - -Blah /usr/lib -Blah F - - verbatim /usr/lib - -Common prefixes -to use are /usr/local and /opt/perl. - -Under /proc -Under /proc blah. -Blah /tmp as blah. -Blah /tmp/foo.txt as blah. diff --git a/devel/grep-pod-X-newline.pl b/devel/grep-pod-X-newline.pl deleted file mode 100644 index 3df5d98..0000000 --- a/devel/grep-pod-X-newline.pl +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -# /usr/share/perl/5.14.2/pod/perlfaq9.pod -# "How do I find out my hostname, domainname" - -use 5.006; -use strict; -use warnings; -use FindBin; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - -my $verbose = 0; - -sub zap_to_first_pod { - my ($str) = @_; - - if ($str =~ /^=/) { - return $str; - } - - my $pos = index ($str, "\n\n="); - if ($pos < 0) { - return $str; - } - my $pre = substr($str,0,$pos); - my $post = substr($str,$pos); - $pre =~ tr/\n//cd; - - ### $pre - return $pre.$post; -} -### zap: zap_to_first_pod("blah\nblah\n\n\n=pod") - -sub zap_pod_verbatim { - my ($str) = @_; - $str =~ s/^ .*//mg; - return $str; -} - -my $X_re = qr/X<+([^>]|E<[^>]*>)*?>/; # $1=contained text - -sub grep_X_newline { - my ($filename, $str) = @_; - $str = zap_to_first_pod($str); - $str = zap_pod_verbatim($str); - ### $str - - while ($str =~ /($X_re)/osg) { - my $pos = pos($str); - my $X = $1; - if ($X =~ /\n/) { - my ($linenum, $colnum) = MyStuff::pos_to_line_and_column - ($str, $pos-length($X)); - print "$filename:$linenum:$colnum: $X\n", - MyStuff::line_at_pos($str, $pos); - } - } -} - -if (1) { - require File::Slurp; - my $filename = "$FindBin::Bin/$FindBin::Script"; - $filename = "$ENV{HOME}/p/path/lib/Math/PlanePath/SquareSpiral.pm"; - $filename = "/usr/share/perl/5.14.2/pod/perltoc.pod"; - my $str = Perl6::Slurp::slurp($filename); - grep_X_newline ($filename, $str); - exit 0; -} - -my $l = MyLocatePerl->new (include_pod => 1, - exclude_t => 1); -while (my ($filename, $str) = $l->next) { -# next if $filename =~ m{/perltoc\.pod$}; - if ($verbose) { print "look at $filename\n"; } - grep_X_newline ($filename, $str); -} - -exit 0; - -# X, -X diff --git a/devel/grep-pod-begin-no-newline.pl b/devel/grep-pod-begin-no-newline.pl deleted file mode 100644 index 6ae2057..0000000 --- a/devel/grep-pod-begin-no-newline.pl +++ /dev/null @@ -1,59 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Grep for =begin not followed by newline, ie. multi-line command - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (exclude_t => 1, - include_pod => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - $str =~ tr/\r//d; # new CRs - - while ($str =~ /(^|\n)(=begin[^\n]*\n[^\n]+)/sg) { - my $pos = $-[0]; - my $lines = $2; - my $lastchar = ord(substr($lines,-1,1)); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: char=$lastchar\n$lines\n"; - } -} - -exit 0; - -=pod - -=begin comment -blah - -=end comment - -=cut diff --git a/devel/grep-pod-begin.pl b/devel/grep-pod-begin.pl deleted file mode 100644 index b1f2321..0000000 --- a/devel/grep-pod-begin.pl +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Grep for different types of =begin and =for - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my %seen; - -my $l = MyLocatePerl->new (exclude_t => 1, - include_pod => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /^=(begin|for)[ \t]+([^ \t\r\n]*)/mg) { - my $command = $1; - my $type = $2; - my $pos = $-[0]; - next if $seen{$type}++; - next unless $command eq 'begin'; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: =$command $type\n"; - } -} - -exit 0; diff --git a/devel/grep-pod-blankline.pl b/devel/grep-pod-blankline.pl deleted file mode 100644 index 87e5cea..0000000 --- a/devel/grep-pod-blankline.pl +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for a =command not preceded by a blank line. -# -# cf Pod::Checker -# -# /usr/lib/perl/5.10.1/Compress/Zlib.pm -# /usr/share/perl/5.10.1/ExtUtils/ParseXS.pm - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (exclude_t => 1, - include_pod => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - next if ($filename =~ /\/doc\.pl$/); - next if ($filename =~ /\/junk\.pl$/); - - # if ($str =~ /^__END__/m) { - # substr ($str, $-[0], length($str), ''); - # } - - while ($str =~ /(([^\n]+)\n=([a-z][a-z0-9]*)[^\n]*)/sg) { - my $bad = $1; - my $pre = $2; - my $cmd = $3; - my $pos = pos($str) - length($bad) + length($pre) + 1; - - next if ($cmd eq 'cut'); - next if ($cmd eq 'pod'); - - next if $pre =~ /^\s*$/; # whitespace-only ok - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: no blank before\n$bad\n"; - } -} - -exit 0; diff --git a/devel/grep-pod-blanknonempty.pl b/devel/grep-pod-blanknonempty.pl deleted file mode 100644 index 23aea07..0000000 --- a/devel/grep-pod-blanknonempty.pl +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for a line of spaces and tabs in POD. -# -# Old formatters treat line of spaces and tabs as non-empty. -# Eg pod2text of perl 5.004. - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (exclude_t => 1, - include_pod => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - next if ($filename =~ /\/doc\.pl$/); - next if ($filename =~ /\/junk\.pl$/); - - my $in_pod = 0; - my $linenum = 0; - foreach my $line (split /\n/, $str) { - $line =~ s/\r$//; - $linenum++; - if ($line =~ /^=cut/) { $in_pod = 0; next; } - if ($line =~ /^=/) { $in_pod = 1; next; } - next unless $in_pod; - - if ($line =~ /^\s+$/) { - print "$filename:$linenum:1: blank of whitespace only\n"; - $line =~ s/([^\021-\177])/'['.ord($1).']'/eg; - print " xx${line}xx ",length($line),"\n"; - } - } -} - -exit 0; diff --git a/devel/grep-pod-command-arg.pl b/devel/grep-pod-command-arg.pl deleted file mode 100644 index 51cd791..0000000 --- a/devel/grep-pod-command-arg.pl +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (exclude_t => 1, - include_pod => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /^=(pod|back)(.+)/mg) { - my $command = $1; - my $after = $2; - next if $after =~ /^\s*$/; - my $pos = $-[0]; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: $command not empty\n"; - print MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-pod-duplicate-see-also.pl b/devel/grep-pod-duplicate-see-also.pl deleted file mode 100644 index 766b810..0000000 --- a/devel/grep-pod-duplicate-see-also.pl +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use FindBin; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - -my $verbose = 0; - -my $L_re = qr/L<+([^>]|E<[^>]*>)*?>/; - -sub grep_see_also { - my ($filename, $str) = @_; - ### $str - - $str =~ /^=head1 SEE ALSO.*?(^=head1|\z)/smp or return; - my $see_also_pos = $-[0]; - my $see_also_str = ${^MATCH}; - ### $see_also_str - - my %seen; - while ($see_also_str =~ /($L_re)/og) { - my $pos = pos($see_also_str); - my $L = $1; - if ($seen{$L}++) { - my ($line, $col) = MyStuff::pos_to_line_and_column - ($str, $see_also_pos+$pos-length($L)); - print "$filename:$line:$col: $L\n", - MyStuff::line_at_pos($str, $pos); - } - } -} - -if (1) { - require File::Slurp; - my $filename = "$FindBin::Bin/$FindBin::Script"; - my $str = Perl6::Slurp::slurp($filename); - grep_see_also ($filename, $str); -# exit 0; -} - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - grep_see_also ($filename, $str); -} - -exit 0; - -=head1 SEE ALSO - -L, -L diff --git a/devel/grep-pod-final-cut.pl b/devel/grep-pod-final-cut.pl deleted file mode 100644 index 9825953..0000000 --- a/devel/grep-pod-final-cut.pl +++ /dev/null @@ -1,131 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014, 2016 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for __END__ without a pod =cut before it -# -# /usr/share/perl/5.24/ExtUtils/MM_BeOS.pm -# /usr/share/perl/5.24/IPC/Cmd.pm - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; -use FindBin; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -use Smart::Comments; - -my $verbose = 1; -my $count_all = 0; -my $count_pod = 0; -my $count_code = 0; -my $count_cut = 0; -my $count_nocut = 0; - -{ - my $filename = File::Spec->catfile ($FindBin::Bin, $FindBin::Script); - my $str = Perl6::Slurp::slurp($filename); - my_grep ($filename, $str); -} -{ - my $filename = '/usr/share/perl/5.14/ExtUtils/MM_BeOS.pm'; - my $str = Perl6::Slurp::slurp($filename); - my_grep ($filename, $str); -} -{ - my $l = MyLocatePerl->new (exclude_t => 1, - # under_directory => '/usr/share/perl5', - under_directory => '/usr/share/perl/5.14/', - ); - while (my ($filename, $str) = $l->next) { - my_grep ($filename, $str); - } -} - -sub last_pod_command { - my ($str) = @_; - my $pos = length($str); - for (;;) { - $pos = rindex($str, "\n=", $pos-1); - if ($pos < 0) { - last; - } - pos($str) = $pos + 1; - if ($str =~ /\G(=[a-z]+)/mg) { - return ($pos, $1); - } - # some "==" or "=>", not a pod directive, keep looking - } - if ($str =~ /^(=[a-z]+)/) { - return (0, $1); - } - return; -} - -sub my_grep { - my ($filename, $str) = @_; - $count_all++; - - my ($podpos, $command) = last_pod_command ($str) - or return; - $count_pod++; - - if ($verbose) { - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $podpos); - print "$filename:$line: $command\n"; - } - - pos($str) = $podpos; - my $endpodpos = index ($str, "\n\n", $podpos); - if ($endpodpos < 0) { - $endpodpos = length($str); - } - - if ($command ne '=cut') { - $count_nocut++; - return; - } - - my $trailing = substr($str, $endpodpos); - if ($trailing =~ /\S/) { - if ($verbose) { print " code after pod\n"; } - # code after pod - $count_code++; - return; - } - - $count_cut++; -} - -print "total $count_all\n"; -print "contains pod $count_pod\n"; -print "end non-cut $count_nocut\n"; -print "end with code $count_code\n"; -print "end with cut $count_cut\n"; -exit 0; - - -=pod - -__END__ diff --git a/devel/grep-pod-gt.pl b/devel/grep-pod-gt.pl deleted file mode 100644 index 4c47725..0000000 --- a/devel/grep-pod-gt.pl +++ /dev/null @@ -1,134 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2013, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# /usr/share/perl/5.10.1/Dumpvalue.pm -> -# /usr/share/perl/5.10.1/Test/Builder/Tester.pm C<> - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (under_directory => '/usr/share/perl5', - # under_directory => '/usr/share/perl/5.14/', - ); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - my $parser = MyParser->new; - $parser->errorsub(sub{1}); # no error prints - $parser->parse_from_string ($str, $filename); -} - -package MyParser; -use strict; -use warnings; -use base 'Pod::Parser'; - -sub parse_from_string { - my ($self, $str, $filename) = @_; - - require IO::String; - my $fh = IO::String->new ($str); - $self->{_INFILE} = $filename; - return $self->parse_from_filehandle ($fh); -} - -sub command { - return ''; -} -sub verbatim { - return ''; -} -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - ### textblock - - # while ($text =~ /->[^[:space:]]/g) { - # my $pos = pos($text); - # my ($line, $col) = MyStuff::pos_to_line_and_column ($text, $pos); - # $line += $linenum - 1; - # - # my $filename = $self->{_INFILE}; - # print "$filename:$line:$col: bad -> markup\n", - # MyStuff::line_at_pos($text, $pos); - # } - # return ''; - - my $tree = $self->parse_text ($text, $linenum); - - my @pending = reverse $tree->children; - my $prev = ''; - my $next = ''; - for ( ; @pending; $prev = $next) { - $next = pop @pending; - if (ref $next && $next->isa('Pod::ParseTree')) { - push @pending, reverse $next->children; - next; - } - next if ref $next; - - { - while ($next =~ /([IBCLFSX]<<+[^ \n])/g) { - my $bad = $1; - my $filename = $self->output_file; - print "$filename:$linenum:1: no space after << markup\n$bad\n"; - } - } - - { - ref $prev or next; - $prev->isa('Pod::InteriorSequence') or next; - my $prev_text = $prev->raw_text; - - $prev_text =~ /->$/ or next; - $next =~ /^[_[:alpha:]]/ or next; - - my ($filename, $line) = $prev->file_line; - - my $pos = length($prev_text); - my ($offset_line, $col) - = MyStuff::pos_to_line_and_column ($prev_text, $pos); - $line += $offset_line - 1; - $col = 1; # col not right if $prev not at start of line - - my $str = $prev_text . $next; - print "$filename:$line:$col: probable unescaped -> markup\n", - MyStuff::line_at_pos($str, $pos); - - print "prev ",$prev_text,"\n"; - print "next ",$next,"\n"; - } - } - - return ''; -} - -exit 0; diff --git a/devel/grep-pod-head-down2.pl b/devel/grep-pod-head-down2.pl deleted file mode 100644 index 180789e..0000000 --- a/devel/grep-pod-head-down2.pl +++ /dev/null @@ -1,83 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -use 5.005; -use strict; -use warnings; -use Tie::IxHash; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - -my $verbose = 0; -my $scope = 'nest'; - -my $l = MyLocatePerl->new (exclude_t => 1, - include_pod => 1, - under_directory => '/usr/share/perl5', - ); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - my $prev_level = 0; - while ($str =~ /^=head(\d+)\s+(.*?)\s*$/mg) { - my $level = $1; - my $name = $2; - my $pos = $-[0]; - - if ($level > $prev_level + 1) { - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $s = MyStuff::line_at_pos($str, $pos); - print "$filename:$line:$col: descend $prev_level -> $level\n $s"; - print "\n"; - } - - $prev_level = $level; - } - # exit 0; - - # my %seen; - # tie %seen, 'Tie::IxHash'; - # while (my ($name, $aref) = each %seen) { - # if (@$aref > 1) { - # foreach my $pos (@$aref) { - # my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - # my $s = MyStuff::line_at_pos($str, $pos); - # print "$filename:$line:$col: duplicate heading\n $s"; - # } - # } - # } -} - -exit 0; - -=head1 FOO - -=head2 Dup - -=head2 Dup - -=head1 BAR - -=head2 Dup diff --git a/devel/grep-pod-head-duplicate.pl b/devel/grep-pod-head-duplicate.pl deleted file mode 100644 index 29198ef..0000000 --- a/devel/grep-pod-head-duplicate.pl +++ /dev/null @@ -1,125 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# p-class.pl -# Acme::Tie::Eleet duplicate BUGS - -use 5.005; -use strict; -use warnings; -use Tie::IxHash; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - -my $verbose = 0; -my $scope = 'consecutive'; - -my $l = MyLocatePerl->new (exclude_t => 1, - include_pod => 1, - under_directory => '/usr/share/perl5', - ); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - my $seen = {}; - my @backtrack; - my $prev_level = 0; - while ($str =~ /^=head(\d+)\s+(.*?)\s*$/mg) { - my $level = $1; - my $name = $2; - my $pos = $-[0]; - - if ($scope eq 'all') { - - } elsif ($scope eq 'consecutive') { - - } elsif ($scope eq 'nested') { - if ($level < $prev_level) { - $seen = $backtrack[$level]; - ### ascend, backtrack to level: $level - } elsif ($level > $prev_level) { - ### descend, copy ... - $seen = { %$seen }; - } - - } elsif ($scope eq 'level') { - if ($level < $prev_level) { - $seen = $backtrack[$level]; - ### ascend, backtrack to level: $level - } elsif ($level > $prev_level) { - ### descend, copy ... - $seen = { %$seen }; - } - - } else { - die "Unknown scope $scope"; - } - - ### look in: $seen - if (my $prev_pos = $seen->{$name}) { - { - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $prev_pos); - my $s = MyStuff::line_at_pos($str, $pos); - print "$filename:$line:$col: duplicate heading here\n $s"; - } - { - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $s = MyStuff::line_at_pos($str, $pos); - print "$filename:$line:$col: and here\n $s"; - print "\n"; - } - } - - if ($scope eq 'consecutive') { %$seen = (); } - $seen->{$name} = $pos; - $backtrack[$level] = $seen; - $prev_level = $level; - } - # exit 0; - - # my %seen; - # tie %seen, 'Tie::IxHash'; - # while (my ($name, $aref) = each %seen) { - # if (@$aref > 1) { - # foreach my $pos (@$aref) { - # my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - # my $s = MyStuff::line_at_pos($str, $pos); - # print "$filename:$line:$col: duplicate heading\n $s"; - # } - # } - # } -} - -exit 0; - -=head1 FOO - -=head2 Dup - -=head2 Dup - -=head1 BAR - -=head2 Dup diff --git a/devel/grep-pod-item-bullet.pl b/devel/grep-pod-item-bullet.pl deleted file mode 100644 index 8b03db3..0000000 --- a/devel/grep-pod-item-bullet.pl +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# various -# some DB<1> debugger prompts - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -use Smart::Comments; - -my $verbose = 0; - -{ - package MyParser; - use base 'Pod::Simple'; - sub _handle_element_start { - my ($self, $element, $attrs) = @_; - ### $element - ### $attrs - } - sub _handle_text { - my ($self, $text) = @_; - ### $text - } - my $self = MyParser->new; - $self->parse_string_document(" -=over - -=item * - -Foo - -=back -"); - -# exit 0; -} - -my $l = MyLocatePerl->new (include_pod => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /^(=item[ \t]+\*[ \t]+.)/mg) { - my $whole = $1; - my $pos = pos($str) - length($whole); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $line_str = MyStuff::line_at_pos($str, $pos); - - print "$filename:$line:$col:\n $line_str"; - } -} - -exit 0; - -=over - -=item * Bullet - -=back diff --git a/devel/grep-pod-leadingwhite.pl b/devel/grep-pod-leadingwhite.pl deleted file mode 100644 index 2cdc180..0000000 --- a/devel/grep-pod-leadingwhite.pl +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; -use FindBin; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -my $verbose = 0; - -my $p = MyParser->new; -my $count = 0; -my $filename; - -{ - $filename = File::Spec->catfile ($FindBin::Bin, $FindBin::Script); - my $str = Perl6::Slurp::slurp($filename); - my_grep ($filename, $str); -} -{ - my $l = MyLocatePerl->new (include_pod => 1, - exclude_t => 1); - while (($filename, my $str) = $l->next) { - my_grep ($filename, $str); - } -} - -sub my_grep { - my ($filename, $str) = @_; - if ($verbose) { print "parse $filename\n"; } - $p->parse_from_string ($str, $filename); -} -print "total $count\n"; - -exit 0; - -package MyParser; -use base 'Perl::Critic::Pulp::PodParser'; - -sub begin_pod { - my ($self) = @_; - $self->{'in_begin'} = 0; -} -sub command { - my $self = shift; - my ($command, $text, $linenum, $paraobj) = @_; - ### command: $command - ### $text - - $self->{'in_begin'} = ($command eq 'begin'); - return ''; -} - -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - ### $text - - return if $self->{'in_begin'}; - - while ($text =~ m{^\s+(?!$)}mg) { - my $pos = pos($text); - my ($line_offset, $col) = MyStuff::pos_to_line_and_column ($text, $pos); - $linenum += $line_offset - 1; - - print "$filename:$linenum:$col: leading whitespace in text para\n", - MyStuff::line_at_pos($text, $pos); - $count++; - } - return ''; -} - -=pod - -=head1 HELLO - -Blah fjdks fjksd jfksd fjkds jfksd jfksd jfksd jfksd jfks dfjks djkf sdjkf -sdkjf sdkf jsdk fjskd fjksd - blah - -Blah fjdks fjksd jfksd fjkds jfksd jfksd jfksd jfksd jfks dfjks djkf sdjkf diff --git a/devel/grep-pod-linked-urls.pl b/devel/grep-pod-linked-urls.pl deleted file mode 100644 index 8091e17..0000000 --- a/devel/grep-pod-linked-urls.pl +++ /dev/null @@ -1,70 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (include_pod => 1); -my $p = MyParser->new; -my $wantver = version->new('5.008'); -my $count = 0; -my $filename; -while (($filename, my $str) = $l->next) { - - my $code = $str; - $code =~ s/^__END__.*//m; - my $goodver = 0; - while ($code =~ /^[^#]*\buse\s+(\d[0-9.]*)/mg) { - my $gotver = version->new ($1); - if ($gotver >= $wantver) { - $goodver = 1; - last; - } - } - $goodver or next; - - if ($verbose) { print "parse $filename\n"; } - $p->parse_from_string ($str, $filename); -} -print "total $count\n"; - -exit 0; - -package MyParser; -use base 'Perl::Critic::Pulp::PodParser'; -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - - while ($text =~ m{(? linked url\n", - MyStuff::line_at_pos($text, $pos); - $count++; - } -} diff --git a/devel/grep-pod-links-adjacent.pl b/devel/grep-pod-links-adjacent.pl deleted file mode 100644 index 608972d..0000000 --- a/devel/grep-pod-links-adjacent.pl +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $L_re = qr/L<+([^>]|E<[^>]*>)*?>/; -my $adjacent_re = qr/$L_re[ \t]*\n?[ \t]*Lnew; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /($adjacent_re)/og) { - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos-length($1)); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-pod-markup-gt.pl b/devel/grep-pod-markup-gt.pl deleted file mode 100644 index d968469..0000000 --- a/devel/grep-pod-markup-gt.pl +++ /dev/null @@ -1,130 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -=pod - -C> - -Foo > - -CE> - -C<> - -=cut - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - -my $verbose = 0; - -{ - package MyParser; - use strict; - use warnings; - use base 'Pod::Parser'; - - sub parse_from_string { - my ($self, $str, $filename) = @_; - - require IO::String; - my $fh = IO::String->new ($str); - $self->{_INFILE} = $filename; - return $self->parse_from_filehandle ($fh); - } - - sub command { - my ($self, $command, $text, $linenum) = @_; - if ($command eq 'begin') { - $self->{'in_begin'} = $text; - } - if ($command eq 'end') { - $self->{'in_begin'} = ''; - } - $self->textblock($text, $linenum); - return ''; - } - sub verbatim { - return ''; - } - sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - ### textblock(): $text - - if ($self->{'in_begin'} eq 'html') { - return ''; - } - - my $tree = $self->parse_text ($text, $linenum); - - my @pending = reverse $tree->children; - my $prev = 'text'; - while (@pending) { - ### $prev - my $elem = pop @pending; - if (ref $elem && $elem->isa('Pod::ParseTree')) { - push @pending, reverse $elem->children; - next; - } - - if (ref $elem) { - ### obj: ref $elem - $prev = $elem->cmd_name; - (undef, $linenum) = $elem->file_line; - } else { - ### text: $elem - if (($elem =~ /^(>)/ && $prev ne 'text') - || ($elem =~ /^(<)/ && $prev ne 'text' && $prev ne 'Z')) { - print "$self->{'filename'}:$linenum: $prev $1\n"; - } - if (length($elem)) { - $prev = 'text'; - } - } - } - return ''; - } -} - - -my $l = MyLocatePerl->new (under_directory => '/usr/share/perl5', - # under_directory => '/usr/share/perl/5.14/', - include_pod => 1, - ); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - my $parser = MyParser->new; - $parser->{'filename'} = $filename; - $parser->{'str'} = $str; - $parser->{'in_begin'} = ''; - $parser->parse_from_string($str); -} - -exit 0; diff --git a/devel/grep-pod-no-cut.pl b/devel/grep-pod-no-cut.pl deleted file mode 100644 index 39a35a3..0000000 --- a/devel/grep-pod-no-cut.pl +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for __END__ without a pod =cut before it -# -# /usr/share/perl/5.14/ExtUtils/MM_BeOS.pm -# /usr/share/perl/5.14.2/IPC/Cmd.pm - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; -use FindBin; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -use Smart::Comments; - -my $verbose = 0; - -{ - my $filename = File::Spec->catfile ($FindBin::Bin, $FindBin::Script); - my $str = Perl6::Slurp::slurp($filename); - my_grep ($filename, $str); -} -{ - my $filename = '/usr/share/perl/5.14/ExtUtils/MM_BeOS.pm'; - my $str = Perl6::Slurp::slurp($filename); - my_grep ($filename, $str); -} -{ - my $l = MyLocatePerl->new (exclude_t => 1, - under_directory => '/usr/share/perl5'); - while (my ($filename, $str) = $l->next) { - my_grep ($filename, $str); - } -} - -my $count_all = 0; -my $count_noend = 0; -my $count_cut = 0; - -sub my_grep { - my ($filename, $str) = @_; - if ($verbose) { print "look at $filename\n"; } - - $count_all++; - my $endpos = index($str, "\n__END__"); - unless ($endpos >= 0) { - $count_noend++; - return; - } - - my $cmdpos = rindex($str, "\n=", $endpos+1); - return unless $cmdpos >= 0; - $cmdpos++; - - my $command = substr($str, $cmdpos, 4); - if ($command !~ '=[a-z]') { - # some "==" or "=>", not a pod directive - return; - } - if ($command eq '=cut') { - $count_cut++; - return; - } - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $cmdpos); - print "$filename:$line:$col: __END__ within POD\n $command\n"; -} - -print "files $count_all\n"; -print "no __END__ $count_noend\n"; -exit 0; - - -=pod - -__END__ diff --git a/devel/grep-pod-para-dots.pl b/devel/grep-pod-para-dots.pl deleted file mode 100644 index 8c9e1bf..0000000 --- a/devel/grep-pod-para-dots.pl +++ /dev/null @@ -1,84 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011, 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (include_pod => 1, - exclude_t => 1); -my $p = MyParser->new; -my $count = 0; -my $filename; -# $SIG{__WARN__} = sub { -# my ($str) = @_; -# print STDERR "$filename:1:\n"; -# warn $str; # re-throw -# }; -while (($filename, my $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - $p->parse_from_string ($str, $filename); -} -print "total $count\n"; - -exit 0; - -package MyParser; -use base 'Perl::Critic::Pulp::PodParser'; -sub command { - my $self = shift; - return $self->command_as_textblock(@_); -} -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - - # Pod::ParseLink for display part of L<> - - # ,. probably wrong - # - if ($text =~ /[^.],\.\s*$/sg) { - print "$filename:$linenum: end with comma dot\n"; - $count++; - } - - # # ,. probably wrong - # # ;. doubtful, but maybe some code or :-;. smiley - # # ;. doubtful, but maybe some code - # # - # if ($text =~ /[^.]\.\.\s*$/sg) { - # print "$filename:$linenum: end with dots\n"; - # $count++; - # } - - # $[. is ok - # :-(. sad face - # !. not too bad - # - # - # if ($text =~ /[,;\\!?({[<]\.\s*$/sg) { - # print "$filename:$linenum: end with dots\n"; - # $count++; - # } -} diff --git a/devel/grep-pod-plain-indent.pl b/devel/grep-pod-plain-indent.pl deleted file mode 100644 index 4fffb47..0000000 --- a/devel/grep-pod-plain-indent.pl +++ /dev/null @@ -1,149 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012, 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# /usr /opt /tmp /etc c:\ -# exclude NAME section for apropos - - - -use 5.006; -use strict; -use warnings; -use FindBin; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - - -my $verbose = 0; -### verbose on: $verbose=1 - -sub keep_only_newlines { - my ($str) = @_; - $str =~ tr/\n//cd; - return $str; -} - -sub zap_to_first_pod { - my ($str) = @_; - - if ($str =~ /^=/) { - return $str; # starts with pod - } - - my $pos = index ($str, "\n\n="); - if ($pos < 0) { - # no pod at all - return keep_only_newlines($str); - } - - my $pre = substr($str,0,$pos); - my $post = substr($str,$pos); - return keep_only_newlines($pre) . $post; -} -### zap: zap_to_first_pod("blah\nblah\n\n\n=pod") - -sub zap_after_last_pod { - my ($str) = @_; - ### zap_after_last_pod: $str - - my $pos; - my $command = ''; - while ($str =~ /\n\n=([^\n]*)\n?/sg) { - $command = $1; - $pos = $+[0]; - } - ### $pos - if ($command eq 'cut') { - return substr($str,0,$pos); - } else { - return $str; - } -} -### zap: zap_to_first_pod("blah\nblah\n\n\n=pod") - -sub zap_pod_verbatim { - my ($str) = @_; - $str =~ s{((^.+\n)+)} - {substr($1,0,1) eq ' ' || substr($1,0,1) eq "\t" - ? keep_only_newlines($1) : $1}mge; - return $str; -} - -sub zap_non_pod { - my ($str) = @_; - $str = zap_to_first_pod($str); - $str = zap_after_last_pod($str); - $str =~ s{(\n\n=cut.*\n)((.*\n)*)(\n^=)} - {$1 . keep_only_newlines($2) . $4}emg; - return $str; -} - -sub process_file { - my ($filename, $str) = @_; - $str = zap_non_pod($str); - $str =~ s/[ \t]+$//mg; # zap trailing whitespace - $str = zap_pod_verbatim($str); - ### $str - - while ($str =~ m{((^.+\n)+)}mg) { - my $para = $1; - my $pos = $-[0]; - ### $para - next if $para =~ /^[ \t]/; - - if ($para =~ /\n[ \t]/) { - $pos += $-[0] + 1; - my ($linenum, $colnum) = MyStuff::pos_to_line_and_column($str, $pos); - print "$filename:$linenum:$colnum: indent within plain para\n ", - MyStuff::line_at_pos($str, $pos); - } - } -} - -my $l = MyLocatePerl->new (include_pod => 1, - exclude_t => 1, - under_directory => '/usr/share/perl5', - # under_directory => '/usr/share/perl/5.14.2', - ); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - process_file ($filename, $str); - ### exit: exit() -} - -exit 0; - -=pod - -Plain para -Plain para - with indent - - Verbatim -and/or - more verbatim - - diff --git a/devel/grep-pod-section-end-comma.pl b/devel/grep-pod-section-end-comma.pl deleted file mode 100644 index 310f5a2..0000000 --- a/devel/grep-pod-section-end-comma.pl +++ /dev/null @@ -1,280 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012, 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-pod-section-end-comma.pl -# -# Search for POD paragraphs ending with a comma. - - -use strict; -use warnings; -use FindBin; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - - -my $verbose = 0; - -my $l = MyLocatePerl->new (include_pod => 1, - under_directory => '/usr/share/perl5'); -my $filename; -# { -# $filename = "$FindBin::Bin/$FindBin::Script"; -# if ($verbose) { print "look at $filename\n"; } -# my $str = Perl6::Slurp::slurp ($filename); -# my $p = MyParser->new; -# $p->parse_from_string ($str); -# } -my $count = 0; -while (($filename, my $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - my $p = MyParser->new; - $p->parse_from_string ($str); - $p->check_last(); - $count++; -} -print "total $count\n"; - -exit 0; - -package MyParser; -use base 'Perl::Critic::Pulp::PodParser'; -sub new { - my $class = shift; - ### new() ... - return $class->SUPER::new (last_text => '', - last_command => '', - @_); -} -sub command { - my ($self, $command, $text, $linenum, $paraobj) = @_; - ### command(): $command - - if ($command eq 'for' || $command eq 'pod') { - ### ignore ... - return; - } - - # my $this_level = $command_level{$command} || 0; - # my $prev_level = $command_level{$self->{'last_command'}} || 0; - - if ($command eq 'item' && $self->{'last_command'} eq 'item') { - - } elsif ($command eq 'over' - || $command eq 'back') { - - } else { - $self->check_last; - } - $self->{'last_text'} = ''; - $self->{'last_command'} = $command; -} -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - ### textblock(): $text - $self->check_last; - if (! defined $text) { - $text = ''; - } - $self->{'last_linenum'} = $linenum; - $self->{'last_text'} = $text; -} -sub verbatim { - my ($self, $text, $linenum, $paraobj) = @_; - ### verbatim() ... - $self->{'last_text'} = ''; -} -sub check_last { - my ($self) = @_; - ### check_last(): $self->{'last_text'} - if ($self->{'last_text'} =~ /,\s*$/s) { - print "$filename:$self->{'last_linenum'}:1: end comma\n"; - $self->{'last_text'} = ''; - } -} - -=pod - -=head1 ONE - -Using pages like, - -=for Finance_Quote_Grab symbols MNG - -=over 4 - -blah - -=back - -=head1 TWO - -This one bad, - -This one ok. - -=head2 - -This one ok, - -=cut - -=pod - - verbatim para - -Blah. - - - - - - - - - - - - -=cut - -# Old stuff for comma following L<> link. - -# sub new { -# my $class = shift; -# my $self = $class->SUPER::new (last => '', -# @_); -# $self->parseopts(-process_cut_cmd => 1); -# return $self; -# } -# -# sub parse_from_filehandle { -# my $self = shift; -# $self->SUPER::parse_from_filehandle(@_); -# $self->comma_violation_maybe; -# } -# -# sub comma_violation_maybe { -# my ($self) = @_; -# if ($self->{'last'} eq 'L-comma') { -# $self->violation_at_linenum_and_textpos -# ("Comma after L<> at end of section, should it be a full stop, or removed?", -# $self->{'saw_comma_linenum'}, -# $self->{'saw_comma_text'}, -# $self->{'saw_comma_textpos'}); -# } -# } -# -# my %command_non_text = (for => 1, -# begin => 1, -# end => 1, -# cut => 1); -# -# sub command { -# my ($self, $command, $text, $linenum, $paraobj) = @_; -# ### $command -# ### last: $self->{'last'} -# # ### $text -# -# if ($command_non_text{$command}) { -# # skip directives -# return ''; -# } -# -# if (# before =over is ok -# $command eq 'over' -# -# # in between successive =item is ok -# || ($command eq 'item' && $self->{'last'} eq '=item')) { -# -# } else { -# # before =head or =cut is bad -# $self->comma_violation_maybe; -# } -# -# $self->{'last'} = ''; -# return ''; -# } -# -# sub verbatim { -# my ($self) = @_; -# ### verbatim -# $self->{'last'} = ''; -# return ''; -# } -# -# sub textblock { -# my ($self, $text, $linenum, $pod_para) = @_; -# ### textblock -# ### $text -# $self->{'saw_comma_linenum'} = $linenum; -# $self->{'saw_comma_text'} = $text; -# $self->parse_text({-expand_seq => 'textblock_seq', -# -expand_text => 'textblock_text' }, -# $text, $linenum); -# ### last now: $self->{'last'} -# return ''; -# } -# sub textblock_seq { -# my ($self, $seq) = @_; -# ### seqsubr: $seq -# my $cmd = $seq->cmd_name; -# if ($cmd eq 'L') { -# if ($self->{'last'} eq 'L') { -# $self->violation_at_linenum_and_textpos -# ("Missing comma between L<> sequences", -# $self->{'saw_comma_linenum'}, -# '', 0); -# } -# $self->{'last'} = 'L'; -# -# } elsif ($cmd eq 'X') { -# # ignore X<> -# -# } else { -# # other like C<> as text -# ### raw_text: $seq->raw_text -# $self->textblock_text ($seq->raw_text, $seq); -# } -# return; -# } -# sub textblock_text { -# my ($self, $text, $textnode) = @_; -# ### textsubr: $text -# ### $textnode -# if ($text =~ /^(\s.*),\s*$/) { -# if ($self->{'last'} eq 'L') { -# $self->{'last'} = 'L-comma'; -# $self->{'saw_comma_textpos'} = length($text) - length($1); -# return; -# } -# } -# if ($text !~ /^\s.*$/) { -# $self->{'last'} = ''; -# } -# ### last now: $self->{'last'} -# return; -# } diff --git a/devel/grep-pod-synopsis.pl b/devel/grep-pod-synopsis.pl deleted file mode 100644 index ff30c3e..0000000 --- a/devel/grep-pod-synopsis.pl +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-pod-synopsis.pl -# -# Look for SYNOPSIS without any verbatim paragraph. -# -# Sometimes C<> on whole ... - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - pos($str) = 0; - $str =~ /^=head1 SYNOPSIS/mg - or next; - my $beg = pos($str); - - if ($str !~ /^(=head1)|^[ \t]+[^ \t\r\n]/mg - || $1) { - my $pos = $beg; - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - - print "$filename:$line:$col: no verbatim in synopsis\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-pod-verbatim-unindent.pl b/devel/grep-pod-verbatim-unindent.pl deleted file mode 100644 index 056153a..0000000 --- a/devel/grep-pod-verbatim-unindent.pl +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# various -# some DB<1> debugger prompts - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -use FindBin; -my $script_filename = File::Spec->catfile ($FindBin::Bin, $FindBin::Script); - -# uncomment this to run the ### lines -#use Smart::Comments; - -my $verbose = 0; - -my $parser = MyParser->new; -$parser->errorsub(sub{1}); # no error prints - -$parser->parse_from_file ($script_filename); -#exit 0; - -my $l = MyLocatePerl->new (include_pod => 1, - exclude_t => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - $parser->parse_from_string ($str, $filename); -} - -package MyParser; -use strict; -use warnings; -use base 'Pod::Parser'; - -sub parse_from_string { - my ($self, $str, $filename) = @_; - - require IO::String; - my $fh = IO::String->new ($str); - $self->{_INFILE} = $filename; - return $self->parse_from_filehandle ($fh); -} -sub command { - my ($self, $command) = @_; - if ($command eq 'begin') { - $self->{'in_begin'} = 1; - } elsif ($command eq 'end') { - $self->{'in_begin'} = 0; - } - return ''; -} -sub verbatim { - my ($self, $text, $linenum, $paraobj) = @_; - ### verbatim: $text - return if $self->{'in_begin'}; - - if ($text =~ /\n=[^\n]*/g) { - my $pos = pos($text); - my $initial = substr($text,0,$pos); - my $filename = $self->{_INFILE}; - print "$filename:$linenum:1: verbatim runs over directive:\n$initial\n"; - } - if ($text =~ /\n\S[^\n]*/g) { - my $pos = pos($text); - my $initial = substr($text,0,$pos); - my $filename = $self->{_INFILE}; - print "$filename:$linenum:1: unindented verbatim:\n$initial\n"; - } -} -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - return ''; -} - -exit 0; - -=pod - - fjksds -djksf - -=cut diff --git a/devel/grep-pod-verbatim.pl b/devel/grep-pod-verbatim.pl deleted file mode 100644 index 35b43d4..0000000 --- a/devel/grep-pod-verbatim.pl +++ /dev/null @@ -1,79 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# various -# some DB<1> debugger prompts - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (include_pod => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - my $parser = MyParser->new; - $parser->errorsub(sub{1}); # no error prints - $parser->parse_from_string ($str, $filename); -} - -package MyParser; -use strict; -use warnings; -use base 'Pod::Parser'; - -sub parse_from_string { - my ($self, $str, $filename) = @_; - - require IO::String; - my $fh = IO::String->new ($str); - $self->{_INFILE} = $filename; - return $self->parse_from_filehandle ($fh); -} -sub command { - return ''; -} -sub verbatim { - my ($self, $text, $linenum, $paraobj) = @_; - ### verbatim - - while ($text =~ /([IBCLFSXZ]<)/g) { - my $markup = $1; - my $filename = $self->{_INFILE}; - print "$filename:$linenum:1: markup in verbatim: $markup\n"; - } -} -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - return ''; -} - -exit 0; diff --git a/devel/grep-printf.pl b/devel/grep-printf.pl deleted file mode 100644 index 9a6006a..0000000 --- a/devel/grep-printf.pl +++ /dev/null @@ -1,94 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Usage: perl grep-printf.pl -# -# Look for printf format strings. -# -# %b in new enough perl. -# %ld and %lld modifiers unnecessary? - - -use 5.010; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -printf "%z\n", 123; -printf "%ld\n", 123; - -my $verbose = 0; -my $l = MyLocatePerl->new; -my $count; - -{ - my $filename = 'devel/grep-printf.pl'; - my $content = eval { Perl6::Slurp::slurp ($filename) } || next; - file ($filename, $content); -} -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } - exit 0; -} - -sub file { - my ($filename, $str) = @_; - - if ($verbose) { - print "$filename\n"; - } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - while ($str =~ /\bs?printf - \b[ \t\r\n(]* - ( '((\\.|[^'])*)' - | "((\\.|[^"])*)" - ) - /xg) { - my $pos = pos($str); - my $fmt = $1 // $3; - - $fmt =~ /^[^%]* - (%[\#v]?[+-]?0?(\*?|[0-9]*)(\.(\*|[0-9]*))?[%csduoxefgXEGbBpniDUOFb] - [^%]*)*/xg - or die; - my $fpos = pos($fmt); - if ($fpos != length($fmt)) { - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $fend = substr($fmt,$fpos); - print "$filename:$line:$col:\n"; - print " $fend\n"; - print MyStuff::line_at_pos($str, $pos); - } - } -} - -exit 0; diff --git a/devel/grep-qrm.pl b/devel/grep-qrm.pl deleted file mode 100644 index 4235e46..0000000 --- a/devel/grep-qrm.pl +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; - -my @files = split /\n/, `locate \*.t \*.pm \*.pl`; - -print scalar(@files),"\n"; -foreach my $filename (@files) { - my $str = eval { Perl6::Slurp::slurp ($filename) } - || do { # print "Cannot read $filename: $!\n"; - next; - }; - - while ($str =~ m%(qr([/].*?[/] - |[|].*?[|] - |'.*?' - |!.*?! - |[{].*?[}] - |[(].*?[)] - |<.*?> - |\[.*?] - )([a-z]*))%gsx) { - my $qr = $1; - my $mods = $3; - if ($mods =~ /m/ && $qr =~ /[\$^]/) { - my $pos = pos($str); - my $tmp = substr ($str, 0, $pos); - my $count = ($tmp =~ tr/\n//) + 1; - print "$filename:$count:1: $qr\n"; - } - } -} - -exit 0; diff --git a/devel/grep-qw-comment.pl b/devel/grep-qw-comment.pl deleted file mode 100644 index cc00d54..0000000 --- a/devel/grep-qw-comment.pl +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.005; -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - while ($str =~ /qw\([^)]*#/sg) { - my $char = $1; - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: comment in qw\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-qw.pl b/devel/grep-qw.pl deleted file mode 100644 index 3a14325..0000000 --- a/devel/grep-qw.pl +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.005; -use strict; -use warnings; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -OUTER: while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ m% - qw( - \([^)]*\) - |\[[^]]*\] - |\{[^}]*\} - ) - %gx - ) { - my $qw = substr($1,1,-1); - my $qwpos = pos($str)-length($1); - - while ($qw =~ /['"]/g) { - my $pos = $qwpos + pos($qw)-1; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col:\n", - MyStuff::line_at_pos($str, $pos); - } - } -} - -exit 0; diff --git a/devel/grep-regexp-common-no-defaults.pl b/devel/grep-regexp-common-no-defaults.pl deleted file mode 100644 index ee8a387..0000000 --- a/devel/grep-regexp-common-no-defaults.pl +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2020 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for use Regexp::Common without 'no_defaults' -# - -use 5.008; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; -$|=1; - -# uncomment this to run the ### lines -use Smart::Comments; - -# an internal in Regexp::Common -my @defaults = qw(balanced - CC - comment - delimited - lingua - list - net - number - profanity - SEN - URI - whitespace - zip); -my $defaults_re = do { - my $str = join('|',@defaults); - qr/\b($str)\b/o; -}; - -my $verbose = 0; -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - $str =~ s/#.*//g; # no comments - while ($str =~ /\buse\s*Regexp::Common\b(.*?);/sg) { - my $args = $1; - my $pos = $-[0]; - my $bad; - if ($args =~ $defaults_re && $args =~ /\bno_defaults\b/) { - $bad = 'default pattern specified, so no_defaults unnecessary'; - } elsif ($args !~ $defaults_re && $args !~ /\bno_defaults\b/) { - $bad = 'no default pattern specified, should no_defaults'; - } - if ($bad) { - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: $bad\n", - " ",MyStuff::line_at_pos($str, $pos), - "\n"; - } - } -} - -exit 0; diff --git a/devel/grep-rootdir.pl b/devel/grep-rootdir.pl deleted file mode 100644 index bd4c8aa..0000000 --- a/devel/grep-rootdir.pl +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012, 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - pos($str) = 0; - while ($str =~ m{(join\s*\(\s*)? - ("/"|'/') - }gsx) { - next if defined $1; - my $pos = pos($str); - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - - print "$filename:$line:$col: root dir /\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-shebang-perl.pl b/devel/grep-shebang-perl.pl deleted file mode 100644 index 9ce14b3..0000000 --- a/devel/grep-shebang-perl.pl +++ /dev/null @@ -1,65 +0,0 @@ -# Copyright 2014, 2015 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for perl files with #!perl - -use 5.010; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -my $verbose = 0; -my $l = MyLocatePerl->new (exclude_t => 1, - # under_directory => '/usr/share/perl5', - # under_directory => '/usr/share/perl/5.14/', - # under_directory => "$ENV{HOME}/p/", - # under_directory => "/usr/share/perl5/Wx/DemoHints/", - # under_directory => '/usr/share/doc', - ); -my $count; - -{ - while (my ($filename, $content) = $l->next) { - file ($filename, $content); - } -} - -sub file { - my ($filename, $str) = @_; - - if ($verbose) { - print "$filename\n"; - } - - if (-x $filename - && $str =~ /^(#!perl.*)/) { - my $shebang = $1; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, 0); - print "$filename:1:1: $shebang\n", - } -} - -exit 0; diff --git a/devel/grep-shebang-pm.pl b/devel/grep-shebang-pm.pl deleted file mode 100644 index 9fafb19..0000000 --- a/devel/grep-shebang-pm.pl +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; -use File::Locate::Iterator; - -use FindBin; -my $progname = $FindBin::Script; - -my $verbose = 0; - -my $it = File::Locate::Iterator->new (glob => '*.pm'); -my $count = 0; - -my %seen; - -while (defined (my $filename = $it->next)) { - open my $in, '<', $filename or next; - if ($verbose) { print "$filename\n"; } - $count++; - my $line = <$in>; - close $in or die; - - defined $line or next; - $line =~ m{^#!\s*((/usr/bin/env\s*)?\S*)} or next; - print "$filename:1:1: $line"; - $seen{$1}++; -} -print "count $count\n"; -{ local $,="\n"; - print "saw:",keys %seen,''; } -exit 0; diff --git a/devel/grep-shebang-t.pl b/devel/grep-shebang-t.pl deleted file mode 100644 index 9c28624..0000000 --- a/devel/grep-shebang-t.pl +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; -use File::Locate::Iterator; - -use FindBin; -my $progname = $FindBin::Script; - -my $verbose = 0; - -my $it = File::Locate::Iterator->new (glob => '*.pm'); -my $count = 0; - -my %seen; - -while (defined (my $filename = $it->next)) { - next unless -x $filename; - - open my $in, '<', $filename or next; - if ($verbose) { print "$filename\n"; } - $count++; - my $line = <$in>; - close $in or die; - defined $line or next; - - if ($line =~ m{^#!perl}) { - print "$filename:1:1: $line"; - $seen{$0}++; - } -} - -print "count $count\n"; -{ local $,="\n"; - print "saw:",keys %seen,''; -} -exit 0; diff --git a/devel/grep-spelling.pl b/devel/grep-spelling.pl deleted file mode 100644 index f57d3f6..0000000 --- a/devel/grep-spelling.pl +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (include_pod => 1); -my $count = 0; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /\b(then\s+then)\b/sg) { - # while ($str =~ /\b(note\s+sure)\b/sg) { - - my $bad = $1; - my $pos = $-[1]; - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: \"$bad\"\n", - MyStuff::line_at_pos($str, $pos); - $count++; - } -} -print "total $count\n"; - -exit 0; diff --git a/devel/grep-stacked-filetest.pl b/devel/grep-stacked-filetest.pl deleted file mode 100644 index dd9ac3d..0000000 --- a/devel/grep-stacked-filetest.pl +++ /dev/null @@ -1,52 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2014 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for -e -x stacked filetests. -# - -use 5.008; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -#use Smart::Comments; - - -if (-e -x -f '/tmp/foo.txt') { -} - -my $verbose = 0; -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - while ($str =~ /[^a-z][ \t(]-[a-z]\s+-[a-z]\s+/ig) { - my $pos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: stacked filetest\n", - MyStuff::line_at_pos($str, $pos); - } -} - -exit 0; diff --git a/devel/grep-t-print.pl b/devel/grep-t-print.pl deleted file mode 100644 index 81abc1d..0000000 --- a/devel/grep-t-print.pl +++ /dev/null @@ -1,82 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2014, 2020 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Perl6::Slurp; -use Regexp::Common 'comment'; -use Iterator::Simple; -use Iterator::Simple::Locate; - -use lib::abs '.'; -use MyStuff; - -my $verbose = 0; - -my $it = Iterator::Simple::Locate->new (suffix => '.t'); -while (my $filename = $it->next) { - if ($verbose) { print "look at $filename\n"; } - - my $str = eval { Perl6::Slurp::slurp ($filename) } - || do { - # print "Cannot read $filename: $!\n"; - next; - }; - - $str = comments_to_whitespace($str); - my $mstr = comments_to_whitespace($str); - my $count = 0; - while ($mstr =~ m{( # $1 - (?:^|\s) - (?:print|say) - \s* - (?:[\'\"]|qq?.) - ([^\r\n]+) # $2 - )}gx) { - my $match = $1; - my $print = $2; - my $pos = $-[2]; - - next if ($print =~ /^\d+\.\./); - next if ($print =~ /^\#/); - next if ($print =~ /^[ \t]ok /); - next if ($print =~ /^[ \t]not /); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: ``$print''\n", - MyStuff::line_at_pos($str, $pos); - next if ($count++ > 5); - } -} - -sub comments_to_whitespace { - my ($str) = @_; - $str =~ s/((^|[ \t])$RE{comment}{Perl})/_to_whitespace($1)/emgo; - return $str; -} -sub _to_whitespace { - my ($str) = @_; - $str =~ s/([^[:space:]]+)/' ' x length($1)/ge; - return $str; -} - -exit 0; - -# "not|"ok|"#|[.][.]|:[ ]*#|print STDERR' - diff --git a/devel/grep-test-print.pl b/devel/grep-test-print.pl deleted file mode 100644 index 3208668..0000000 --- a/devel/grep-test-print.pl +++ /dev/null @@ -1,59 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2009, 2010, 2011, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - - -use 5.005; -use strict; -use warnings; -use Regexp::Common 'comment'; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (only_t => 1); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - if ($str =~ /^__END__/m) { - substr ($str, $-[0], length($str), ''); - } - - # strip comments - $str =~ s/$RE{comment}{Perl}//og; - - $str =~ /\buse\s+Test::More\b/ - or next; - - while ( - $str =~ /(\b(?. - -# cf - - -use 5.005; -use strict; -use warnings; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -# use Smart::Comments; - -my $verbose = 0; - -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - # if ($str =~ /^__END__/m) { - # substr ($str, $-[0], length($str), ''); - # } - - # strip comments - $str =~ s/#.*//mg; - - while ($str =~ /<<[ \t]*( - '([A-Za-z_]\w*)' - |"([A-Za-z_]\w*)" - |([A-Za-z_]\w*) - )[ \t]*\n/sgx) { - my $whole = $&; - my $key = $1 // $2 // $3; - my $pos_end = pos($str); - my $pos = $pos_end - length($whole) + 1; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - my $l1 = MyStuff::line_at_pos($str, $pos); - - my $oldpos = pos($str); - $str =~ /^$key[ \t]*$/mg; - my $pos2 = pos($str); - pos($str) = $oldpos; - $pos2 // next; - my $l2 = MyStuff::line_at_pos($str, $pos2+1); - next unless $l2 =~ /^[ \t]*\)/; - - print "$filename:$line:$col:\n $l1 $l2"; - } -} - -exit 0; - -__END__ - -print <. - - -# Usage: perl grep-use-decimal.pl -# -# Look for "use Foo .5" etc, with the version number not starting with a -# digit. -# - - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; - - -my @files = ($0, split /\n/, `locate \\*.t \\*.pm \\*.pl`); - -print scalar(@files),"\n"; -foreach my $filename (@files) { - my $str = eval { Perl6::Slurp::slurp ($filename) } - || do { # print "Cannot read $filename: $!\n"; - next; - }; - - while ($str =~ /((use|no)[ \t]+ - [A-Za-z0-9_:]+[ \t]+ - (v?[._][0-9._]*) - [ \t]*;.* - )/gx) { - my $line = $1; - my $pos = pos($str); - # $3 =~ /[0-9]/ or next; # not '..' for use lib etc - my $tmp = substr ($str, 0, $pos); - my $count = ($tmp =~ tr/\n//) + 1; - print "$filename:$count:1: $line\n"; - } -} - -__END__ - -use foo .5; -use Foo::Bar _1000_; -{ no Foo::Bar v.1; } diff --git a/devel/grep-use-exporter.pl b/devel/grep-use-exporter.pl deleted file mode 100644 index 0300f27..0000000 --- a/devel/grep-use-exporter.pl +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2015 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for modules with @EXPORT etc but no "use Exporter". -# - -use 5.008; -use strict; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -# uncomment this to run the ### lines -use Smart::Comments; - -use base 'Exporter'; -our @EXPORT = ('foo'); - -my $verbose = 0; -my $l = MyLocatePerl->new; -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - # strip comments - $str =~ s/#.*//mg; - - $str =~ /[^'"\\]\@EXPORT/ || next; - my $pos = $+[0]; - next if $str =~ /require Exporter\s*;/; - next if $str =~ /use\s+(Exporter|base\s+('|qw\s*\()Exporter)\b/s; - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: \@EXPORT without \"use Exporter\"\n", - MyStuff::line_at_pos($str, $pos); -} - -exit 0; diff --git a/devel/grep-use-langinfo.pl b/devel/grep-use-langinfo.pl deleted file mode 100644 index 235a1fb..0000000 --- a/devel/grep-use-langinfo.pl +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.010; -use strict; -use warnings; -use Perl6::Slurp; -use File::Locate::Iterator; - -use FindBin; -my $progname = $FindBin::Script; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; -my $count = 0; - -my $l = MyLocatePerl->new; -OUTER: while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - $count++; - - $str =~ /^use I18N::Langinfo(;|\s+[0-9])/mg - or next; - my $usepos = pos($str); - - if ($str =~ /I18N::Langinfo::langinfo/g) { - my $callpos = pos($str); - - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $usepos); - print "$filename:$line:$col: bare use\n"; - print MyStuff::line_at_pos($str, $usepos); - - ($line, $col) = MyStuff::pos_to_line_and_column ($str, $callpos); - print "$filename:$line:$col: full call\n"; - print MyStuff::line_at_pos($str, $callpos); - } - -# while ($str =~ /(I18N::Langinfo::)?langinfo\s*\(/g) { -# if ($1) { next OUTER; } # import used -# } - -} - -print "looked at $count\n"; -exit 0; - - -# my $it = File::Locate::Iterator->new (globs => [# '*.t', -# '*.pm', -# '*.pl', -# #'/usr/lib/perl/5.10.1/I18N/Langinfo.pm' -# ]); -# while (defined (my $filename = $it->next)) { -# open my $in, '<', $filename or next; -# if ($verbose) { print "$filename\n"; } -# $count++; -# -# OUTER: for (;;) { -# my $line = <$in> // last; -# if ($line =~ /use I18N::Langinfo(;|\s+[0-9])/) { -# -# for (;;) { -# $line = <$in> // last OUTER; -# if ($line =~ /(I18N::Langinfo::)?langinfo\s*\(/ && ! $1) { -# print "$filename:$.:1:\n $line"; -# last; -# } -# } -# } -# } -# close $in or die; -# } diff --git a/devel/grep-use-posix.pl b/devel/grep-use-posix.pl deleted file mode 100644 index ec4d90f..0000000 --- a/devel/grep-use-posix.pl +++ /dev/null @@ -1,61 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010, 2015 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for "use POSIX" statements with full import, like -# -# use POSIX; -# -# or -# -# use POSIX 1.10; -# - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; -use File::Locate::Iterator; - -use FindBin; -my $progname = $FindBin::Script; - -my $verbose = 0; - -my $it = File::Locate::Iterator->new (globs => [# '*.t', - '*.pm', - # '*.pl', - ]); -print "$progname\n"; -my $count = 0; - -while (defined (my $filename = $it->next)) { - open my $in, '<', $filename or next; - if ($verbose) { print "$filename\n"; } - $count++; - - while (<$in>) { - if (/use POSIX(;|\s+[0-9])/) { - print "$filename:$.:1:\n $_"; - } - } - close $in or die; -} -print "count $count\n"; -exit 0; diff --git a/devel/grep-use-quoted.pl b/devel/grep-use-quoted.pl deleted file mode 100644 index 584a3e6..0000000 --- a/devel/grep-use-quoted.pl +++ /dev/null @@ -1,63 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Look for "use" statements with quoted version numbers, like -# -# use Foo '1.5'; -# - -use 5.006; -use strict; -use warnings; -use Perl6::Slurp; - -my @files = ($0, split /\n/, `locate \\*.t \\*.pm \\*.pl`); - -print scalar(@files),"\n"; -foreach my $filename (@files) { - my $str = eval { Perl6::Slurp::slurp ($filename) } - || do { # print "Cannot read $filename: $!\n"; - next; - }; - - while ($str =~ /((use|no)[ \t]+ - [A-Za-z0-9_:]+[ \t]+ - (['"]|qq?.?]) - (v?[0-9][0-9._e]*) - ['"}][ \t]* - ;.* - - # [^-a-zA-Z.$:][^\n]* - )/gx) { - my $line = $1; - my $pos = pos($str); - # $3 =~ /[0-9]/ or next; # not '..' for use lib etc - my $tmp = substr ($str, 0, $pos); - my $count = ($tmp =~ tr/\n//) + 1; - print "$filename:$count:1: $line\n"; - } -} - -__END__ - -use foo '123'; -use Foo::Bar '123'; -{ no Foo::Bar '123'; } -use foo 'v1.5'; diff --git a/devel/grep-version-nonnum.pl b/devel/grep-version-nonnum.pl deleted file mode 100644 index e3dbeba..0000000 --- a/devel/grep-version-nonnum.pl +++ /dev/null @@ -1,63 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2011, 2012 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use Regexp::Common 'comment'; - -use lib::abs '.'; -use MyLocatePerl; -use MyStuff; - -my $verbose = 0; - -my $l = MyLocatePerl->new (regexp => qr/\.pm$/); -while (my ($filename, $str) = $l->next) { - if ($verbose) { print "look at $filename\n"; } - - # strip comments - $str =~ s/$RE{comment}{Perl}//og; - - pos($str) = 0; - # $str =~ /\$VERSION\s*=\s* - # ('[^']*?[^'0-9.] - # |"[^"]*?[^"0-9.] - # |q\([^)]*?[^)0-9.] - # |q\{[^}]*?[^}0-9.] - # - # # qw$...$ ok - # # qv() version module ok - # |q[^vw({] - # ) - # /gx - # or next; - # my $pos = pos($str); - # my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - # print "$filename:$line:$col: non-numeric VERSION string\n", - # MyStuff::line_at_pos($str,$pos); - - $str =~ /[^A-Za-z_]VERSION\s+(>[^>]|<|[!=]=)/g - or next; - my $pos = pos($str); - my ($line, $col) = MyStuff::pos_to_line_and_column ($str, $pos); - print "$filename:$line:$col: explicit VERSION compare\n", - MyStuff::line_at_pos($str,$pos); -} - -exit 0; diff --git a/devel/h2xs/PostModule.pm b/devel/h2xs/PostModule.pm deleted file mode 100644 index 919c7f1..0000000 --- a/devel/h2xs/PostModule.pm +++ /dev/null @@ -1,32 +0,0 @@ -# Copyright 2008, 2009, 2010 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -package PostModule; -use strict; -use warnings; -use TestConstFoo ('MYCONST'); - -BEGIN { - print "PostModule MYCONST is ",TestConstFoo::MYCONST(),"\n"; - my $proto = prototype(\&MYCONST); - print "proto '",(defined $proto ? $proto : 'undef'),"'\n"; -} - -# bad unless MYCONST() -if (MYCONST < 10) { print "yes\n"; } else { print "no\n"; } - -1; diff --git a/devel/h2xs/TestConstFoo.h b/devel/h2xs/TestConstFoo.h deleted file mode 100644 index 60f212f..0000000 --- a/devel/h2xs/TestConstFoo.h +++ /dev/null @@ -1,18 +0,0 @@ -/* Copyright 2008, 2009 Kevin Ryde - - This file is part of Perl-Critic-Pulp. - - Perl-Critic-Pulp is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by the - Free Software Foundation; either version 3, or (at your option) any later - version. - - Perl-Critic-Pulp is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General - Public License for more details. - - You should have received a copy of the GNU General Public License along - with Perl-Critic-Pulp. If not, see . */ - -#define MYCONST 123 diff --git a/devel/h2xs/run.pl b/devel/h2xs/run.pl deleted file mode 100755 index 97de298..0000000 --- a/devel/h2xs/run.pl +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl - -# Copyright 2008, 2009 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as published -# by the Free Software Foundation; either version 3, or (at your option) any -# later version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -# Public License for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use strict; -use warnings; -use TestConstFoo; - -print "MYCONST is ",TestConstFoo::MYCONST(),"\n"; - -# bad unless MYCONST() -# if (MYCONST < 10) { print "yes\n"; } else { print "no\n"; } - -push @INC, '.'; -require PostModule; - -exit 0; diff --git a/devel/junk/TestMoreLikeModifiers.pm b/devel/junk/TestMoreLikeModifiers.pm deleted file mode 100644 index 99ffa92..0000000 --- a/devel/junk/TestMoreLikeModifiers.pm +++ /dev/null @@ -1,180 +0,0 @@ -# Copyright 2008, 2009, 2010 Kevin Ryde - -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -package Perl::Critic::Policy::Compatibility::TestMoreLikeModifiers; -use strict; -use warnings; -use base 'Perl::Critic::Policy'; -use Perl::Critic::Utils qw(:severities parse_arg_list); -use Perl::Critic::Utils::PPIRegexp qw(:all); -use version; - -our $VERSION = 0; - -use constant DEBUG => 0; - - -sub supported_parameters { return; } -sub default_severity { return $SEVERITY_MEDIUM; } -sub default_themes { return qw(pulp bugs); } -sub applies_to { return 'PPI::Token::Word'; } - -my $perl_ok_version = version->new('5.10.0'); - -sub violates { - my ($self, $elem, $document) = @_; - - my $word = $elem->content; - $word eq 'Test::More::like' - || ($word eq 'like' && _document_uses_Test_More($document)) - || return; - if (DEBUG) { print "word $word\n"; } - - if (my $version = $document->highest_explicit_perl_version) { - if ($version >= $perl_ok_version) { - return; # $document is demanding new enough perl - } - } - - my @args_arefs = parse_arg_list ($elem); - my @re_elems = @{$args_arefs[1]}; - @re_elems = grep {$_->significant} @re_elems; - - @re_elems == 1 || return; - my $re_elem = $re_elems[0]; - if (DEBUG) { print "re_elem ",ref($re_elem),": $re_elem\n"; } - my ($subdoc, $ext_elem) = _string_elem_to_regexp ($re_elem); - - $ext_elem->isa('PPI::Token::QuoteLike::Regexp') - || $ext_elem->isa('PPI::Token::Regexp') - || return; # not a regexp (maybe a variable containing a regexp ...) - - my $mhash = $ext_elem->{'modifiers'} - || return; # no modifiers - if (DEBUG) { - require Data::Dumper; - print "mhash ",Data::Dumper::Dumper($mhash),"\n"; - } - my %modifiers = %$mhash; # copy; - delete $modifiers{'x'}; # /x is ok - if (%modifiers) { return; } # no other modifiers is good - - my $modifiers = join ('', sort keys %modifiers); - return $self->violation - ("Modifiers /$modifiers don't work with like() until Perl $perl_ok_version", - '', - $re_elem); -} - -sub _string_elem_to_regexp { - my ($elem) = @_; - - if ($elem->isa('PPI::Token::Quote')) { - # literal() from Single, string() from Double - # the latter is only really an approximation, but is often good enough - my $str = ($elem->can('literal') - ? $elem->literal : $elem->string); - if (DEBUG) { print "sub-parse: $str\n"; } - - # Eg. parses to - # PPI::Document - # PPI::Statement - # PPI::Token::Regexp::Match '/pattern/i' - # - if (my $subdoc = PPI::Document->new (\$str)) { - my $subelem = $subdoc->schild(0); - if ($subelem && $subelem->isa('PPI::Statement')) { - $subelem = $subelem->schild(0); - if ($subelem->isa('PPI::Token::Regexp::Match')) { - if (DEBUG) { print " got: ",ref($subelem),": $subelem\n"; } - return ($subdoc, $subelem); - } - } - } - } - # otherwise given elem - return (undef, $elem); -} - - -sub _document_uses_Test_More { - my ($document) = @_; - my $key = __PACKAGE__ . '--using-Test::More'; - if (exists $document->{$key}) { return $document->{$key}; } - - my $ret = $document->find_any - (sub { - my ($document, $elem) = @_; - return ($elem->isa ('PPI::Statement::Include') - && $elem ne 'no' - && (($elem->module || '') eq 'Test::More')); - }); - if (DEBUG) { print "using Test::More -- ", ($ret?"yes":"no"), "\n"; } - return ($document->{$key} = $ret); -} - -1; -__END__ - -=head1 NAME - -Perl::Critic::Policy::Compatibility::TestMoreLikeModifiers - don't use regexp modifiers with like() tests - -=head1 DESCRIPTION - -This policy is part of the Perl::Critic::Pulp addon. It warns about regexp -modifiers like C and C passed to C tests with C, -because such modifiers don't end up propagated to the test until Perl 5.10. -For example, - - use Test::More tests => 1; - like ('My String', qr/str/i); # bad - like ("abc\ndef\n", '/^abc$/m'); # bad - -If you've got an explicit C or similar then you'll only be -running and this check is not applied. - -As always if you don't care about C<__END__> you can always disable -C from your F<.perlcriticrc> in the usual way, - - [-Compatibility::TestMoreLikeModifiers] - -=head1 SEE ALSO - -L, L - -=head1 HOME PAGE - -L - -=head1 COPYRIGHT - -Copyright 2008, 2009, 2010 Kevin Ryde - -Perl-Critic-Pulp is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -Perl-Critic-Pulp is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -more details. - -You should have received a copy of the GNU General Public License along with -Perl-Critic-Pulp. If not, see L. - -=cut diff --git a/devel/junk/TestMoreLikeModifiers.t b/devel/junk/TestMoreLikeModifiers.t deleted file mode 100755 index 56ee314..0000000 --- a/devel/junk/TestMoreLikeModifiers.t +++ /dev/null @@ -1,68 +0,0 @@ -#!/usr/bin/perl - -# Copyright 2008 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -use strict; -use warnings; -use Perl::Critic::Policy::Compatibility::ProhibitTestMoreLikeModifiers; -use Test::More tests => 13; -use Perl::Critic; - -my $single_policy = 'Compatibility::ProhibitTestMoreLikeModifiers'; -my $critic = Perl::Critic->new - ('-profile' => '', - '-single-policy' => $single_policy); -{ my @p = $critic->policies; - is (scalar @p, 1, - "single policy $single_policy"); -} - -ok ($Perl::Critic::Policy::Compatibility::ProhibitTestMoreLikeModifiers::VERSION >= 11, - 'VERSION variable'); -ok (Perl::Critic::Policy::Compatibility::ProhibitTestMoreLikeModifiers->VERSION >= 11, - 'VERSION method'); - -foreach my $data (## no critic (RequireInterpolationOfMetachars) - - [ 1, 'Test::More::like ($x, qr/y/i)' ], - [ 1, 'Test::More::like ($x, \'/y/i\')' ], - [ 1, 'Test::More::like ($x, "/y/i")' ], - [ 1, 'Test::More::like ($x, q{/y/i})' ], - - [ 1, 'use Test::More; like ($x, \'/^y$/m\')' ], - [ 1, 'use Test::More; like ($x, "/^y$/m")' ], - [ 1, 'use Test::More; like ($x, qq{/^y$/m})' ], - - [ 0, 'Test::More::like ($x, qr/y/)' ], - [ 0, 'Test::More::like ($x, "/y/")' ], - [ 0, 'Test::More::like ($x, qr/y/, "desc")' ], - - ## use critic - ) { - my ($want_count, $str) = @$data; - - my @violations = $critic->critique (\$str); - foreach (@violations) { - diag ($_->description); - } - my $got_count = scalar @violations; - is ($got_count, $want_count, $str); -} - -exit 0; diff --git a/devel/junk/test-more-like.pl b/devel/junk/test-more-like.pl deleted file mode 100755 index 94cc853..0000000 --- a/devel/junk/test-more-like.pl +++ /dev/null @@ -1,61 +0,0 @@ -#!/usr/bin/perl - -# Copyright 2008 Kevin Ryde - -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -#!/usr/bin/perl -use strict; -use warnings; - -{ - my $re = qr/a b/x; - if ("XabY" =~ $re) {print "ab matches\n";} else {print "ab no match\n";} - if ("XaBY" =~ /X${re}Y/) {print "ab matches\n";} else{print "ab no match\n";} -} - -{ - my $re = qr/x/i; - if ("XX" =~ /$re/) {print "/i matches\n";} else {print "/i no match\n";} -} - -{ - my $re = qr/a.b/s; - my $str = "a\nb"; - print "$re\n"; - if ($str =~ /a.b/s) { print "/s matches\n"; } else { print "/s no match\n";} - if ($str =~ $re) {print "/s matches\n";} else {print "/s no match\n";} - if ($str =~ /$re/) {print "/s matches\n";} else {print "/s no match\n";} - if ($str =~ /$re/m) {print "/s matches\n";} else {print "/s no match\n"; - } -} - -{ - my $str = "w\nx\ny"; - my $re = qr/^x$/m; - print "$re\n"; - if ($str =~ /^x$/m) {print "/m matches\n";} else {print "/m no match\n";} - if ($str =~ $re) {print "/m matches\n";} else {print "/m no match\n";} - if ($str =~ /$re/) {print "/m matches\n";} else {print "/m no match\n";} -} - -{ - my $str = "w\nx\ny"; - my $pat = '^x'; - my $re = qr/$pat/m; - print "$re\n"; - if ($str =~ $re) {print "interp /m matches\n";} else {print "interp /m no match\n";} - if ($str =~ /$re/) {print "interp /m matches\n";} else {print "interp /m no match\n";} -} - diff --git a/devel/lib/Perl/Critic/Policy/Compatibility/inprogressTestMore.pm b/devel/lib/Perl/Critic/Policy/Compatibility/inprogressTestMore.pm deleted file mode 100644 index 445bf5c..0000000 --- a/devel/lib/Perl/Critic/Policy/Compatibility/inprogressTestMore.pm +++ /dev/null @@ -1,219 +0,0 @@ -# Copyright 2009, 2010, 2011, 2013, 2015 Kevin Ryde - -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -package Perl::Critic::Policy::Compatibility::inprogressTestMore; -use 5.006; -use strict; -use warnings; -use List::Util; -use version (); # but don't import qv() -use base 'Perl::Critic::Policy'; -use Perl::Critic::Utils qw(is_function_call); -use Perl::Critic::Pulp::Utils; - -use constant DEBUG => 0; - -use constant supported_parameters => (); -use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; -use constant default_themes => qw(pulp bugs); -use constant applies_to => ('PPI::Token::Word', 'PPI::Token::Symbol'); - -my %functions = ('explain' => { module => 'Test::More', - modver => version->new('0.82'), - perlver => version->new('5.010001'), - export => 1 } - ); - -sub violates { - my ($self, $elem, $document) = @_; - - my $elem_str; - if ($elem->isa('PPI::Token::Symbol')) { - $elem->symbol_type eq '&' - or return; # not &foo function - $elem_str = substr ($elem->symbol, 1); - } else { - # PPI::Token::Word - $elem_str = $elem->content; - } - - my ($elem_qualifier, $elem_basename) = _qualifier_and_basename ($elem_str); - if (defined $elem_qualifier && $elem_qualifier ne 'Test::More') { - return; # some other Foo::Bar::func() - } - - my $want = $functions{$elem_basename} || return; - - is_function_call ($elem) - or return; - - my $got_perl = $document->highest_explicit_perl_version; - if (defined $got_perl - && ref $got_perl - && $got_perl >= $want->{'perlver'}) { - return; # high enough "use 5.010" or whatnot - } - - my $got_testmore = _highest_explicit_module_version ($document,'Test::More'); - if (! defined $got_testmore && ! defined $elem_qualifier) { - return; # no "use Test::More", so unqualified foo() is not it - } - if (defined $got_testmore - && ref $got_testmore - && $got_testmore >= $want->{'modver'}) { - return; # high enough "use Test::More 0.90" etc - } - - return $self->violation - ("$elem requires Test::More $want->{'modver'} or perl $want->{'perlver'}, but file has " - . (defined $got_testmore && ref $got_testmore - ? "Test::More $got_testmore" - : "no version for Test::More") - . (defined $got_perl && ref $got_perl - ? ", and perl $got_perl" - : ", and no perl version"), - '', - $elem); -} - -sub _qualifier_and_basename { - my ($str) = @_; - return ($str =~ /(?:(.*)::)?(.*)/) -} - -# return true if $document has a "use" of $module (string name of a package) -sub _document_uses_module { - my ($document, $module) = @_; - - my $aref = $document->find ('PPI::Statement::Include') - || return; # if no Includes at all - return List::Util::first {$_->type eq 'use' - && (($_->module || '') eq $module) - } @$aref; -} - -# return a "version" object which is the highest explicit use for $module (a -# string) in $document -# -# A call like Foo::Bar->VERSION(123) is a version check, but not sure that's -# worth looking for. -# -# If there's no version number on any "use" of $module then the return is -# version->new(0). If there's no "use" of $module at all then the return is -# undef. -# -sub _highest_explicit_module_version { - my ($document, $module) = @_; - - my $cache_key = __PACKAGE__.'::_highest_explicit_module_version--'.$module; - if (exists $document->{$cache_key}) { return $document->{$cache_key}; } - - my $aref = $document->find ('PPI::Statement::Include') - || return; # if no Includes at all - my @incs = grep {$_->type eq 'use' - && (($_->module || '') eq $module)} @$aref; - if (DEBUG) { local $, = "\n"; - print " all incs",@$aref,''; - print " matched incs",@incs,''; } - if (! @incs) { return undef; } - - my @vers = map { _include_module_version_with_exporter($_) } @incs; - if (DEBUG) { local $,=' / '; print " versions",@vers,"\n"; } - @vers = grep {defined} @vers; - if (! @vers) { return 0; } - - @vers = map {version->new($_)} @vers; - my $maxver = List::Util::reduce {$a >= $b ? $a : $b} @vers; - return ($document->{$cache_key} = $maxver); -} - - -# $inc is a PPI::Statement::Include. -# -# If $inc has a version number, either in perl's native form or as a string -# or number as handled by the Exporter package, then return that as a -# version object. -# -sub _include_module_version_with_exporter { - my ($inc) = @_; - - if (my $ver = Perl::Critic::Pulp::Utils::include_module_version ($inc)) { - return version->new ($ver->content); - } - - if (my $ver = Perl::Critic::Pulp::Utils::include_module_first_arg ($inc)) { - if ($ver->isa('PPI::Token::Number')) { - $ver = $ver->content; - } elsif ($ver->isa('PPI::Token::Quote')) { - $ver = $ver->string; - } else { - return undef; - } - # Exporter looks only for a leading digit before calling ->VERSION, but - # be tighter here to avoid errors from version.pm about bad values - if ($ver =~ $Perl::Critic::Pulp::Utils::use_module_version_number_re) { - return version->new ($ver); - } - } - - return undef; -} - -1; -__END__ - -=head1 NAME - -Perl::Critic::Policy::Compatibility::inprogressTestMore - new enough Test::More for its functions - -=head1 DESCRIPTION - -This policy is part of the L|Perl::Critic::Pulp> -add-on. It checks ... - - -As always if you don't care about this then you can disable C -from your F<.perlcriticrc> in the usual way (see -L), - - [-Compatibility::inprogressTestMore] - -=head1 SEE ALSO - -L, L - -=head1 HOME PAGE - -L - -=head1 COPYRIGHT - -Copyright 2009, 2010, 2011, 2013, 2015 Kevin Ryde - -Perl-Critic-Pulp is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -Perl-Critic-Pulp is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -more details. - -You should have received a copy of the GNU General Public License along with -Perl-Critic-Pulp. If not, see . - -=cut diff --git a/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.pm b/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.pm deleted file mode 100644 index dffcd2c..0000000 --- a/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.pm +++ /dev/null @@ -1,198 +0,0 @@ -# Copyright 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. - -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# perlcritic -s ProhibitMarkupExtraClose ProhibitMarkupExtraClose.pm - -# bad B<> -# perlcritic -s ProhibitMarkupExtraClose /usr/share/perl5/Curses/UI/Widget.pm - -# email addr -# perlcritic -s ProhibitMarkupExtraClose /usr/share/perl5/Email/Address.pm - - -package Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose; -use 5.006; -use strict; -use warnings; -use base 'Perl::Critic::Policy'; -use Perl::Critic::Utils; - -# uncomment this to run the ### lines -# use Smart::Comments; - -our $VERSION = 99; - -use constant supported_parameters => (); -use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; -use constant default_themes => qw(pulp bugs); -use constant applies_to => 'PPI::Document'; - -sub violates { - my ($self, $elem, $document) = @_; - ### ProhibitMarkupExtraClose on: $elem->content - - my $parser = Perl::Critic::Pulp::PodParser::ProhibitMarkupExtraClose->new - (policy => $self); - $parser->parse_from_elem ($elem); - return $parser->violations; -} - -package Perl::Critic::Pulp::PodParser::ProhibitMarkupExtraClose; -use strict; -use warnings; -use base 'Perl::Critic::Pulp::PodParser'; - -sub command { - my $self = shift; - $self->command_as_textblock(@_); - return $self->SUPER::command(@_); # for $self->{'in_begin'} -} - -sub textblock { - my ($self, $text, $linenum, $paraobj) = @_; - ### textblock(): "in_begin=$self->{'in_begin'}" - ### $text - - if ($self->{'in_begin'}) { - return ''; - } - - my @pending = ($self->parse_text ($text, $linenum)); - ### @pending - while (@pending) { - my $obj = pop @pending; - if (ref $obj && $obj->isa('Pod::ParseTree')) { - ### $obj - - my @objs = $obj->children; - push @pending, reverse @objs; - - foreach my $i (0 .. $#objs-1) { - my $markup = $objs[$i]; - my $after = $objs[$i+1]; - if (ref $markup && $markup->isa('Pod::InteriorSequence') # markup "C<>" - && ! ref $after && $after =~ /^(>+)/) { # followed by text ">" - my $extra_angles = $1; - - # exception for <>> balanced angles before - if ($i >= 1) { - my $before = $objs[$i-1]; - my $before_angles = '<' x length($extra_angles); # "<" - if (! ref $before && $before =~ m{\Q$before_angles\E$}) { - next; - } - } - - my $cmd = $markup->cmd_name; - my $left = $markup->left_delimiter; - my $right = $markup->right_delimiter; - $right =~ s/^ //; - (undef, $linenum) = $markup->file_line; - $self->violation_at_linenum - ("Extra \"$extra_angles\" after $cmd$left$right markup", - $linenum); - } - } - } - } - return ''; -} - -1; -__END__ - -=for stopwords Ryde paren parens ie deref there'd backslashing Parens - -=head1 NAME - -Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose - extra closing ">" after markup - -=head1 DESCRIPTION - -This policy is part of the L|Perl::Critic::Pulp> -add-on. It reports POD markup which has an extra closing ">" after a -markup. - -=for ProhibitVerbatimMarkup allow next - - C> # bad - -The formatters are perfectly happy with this. They take it as a ">" after -some markup. But the idea of this policy is that it's likely to be a stray -extra closing ">", or at least will make a human reader wonder. On that -basis this policy is under the "bugs" theme (see L) but low severity. - -An attempt to markup a readline like "EFHE" or similar will trigger -the policy because the first ">" closes the markup. - - C<> # bad, markup is "" follows - -It's also possible this is meant to be some double-angle markup but is -missing the spaces required at the start and end. - - C<> # bad - C<< good double angles >> # ok - -=head2 Surrounding Angles - -Balanced surrounding angle brackets are allowed, such as for an email -address marked up like - -=for ProhibitVerbatimMarkup allow next - - Some One > - -Whether this looks good from the formatters is another matter, but it's not -an erroneous extra close to the CE> markup. - -=head2 Disabling - -If you don't care about this you can disable C -from your F<.perlcriticrc> in the usual way (see -L), - - [-Documentation::ProhibitMarkupExtraClose] - -=head1 SEE ALSO - -L, -L - -=head1 HOME PAGE - -L - -=head1 COPYRIGHT - -Copyright 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -Perl-Critic-Pulp is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -Perl-Critic-Pulp is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -more details. - -You should have received a copy of the GNU General Public License along with -Perl-Critic-Pulp. If not, see . - -=cut diff --git a/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.t b/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.t deleted file mode 100644 index 0608993..0000000 --- a/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.t +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - -use 5.006; -use strict; -use warnings; -use Test::More tests => 23; - -use lib 't'; -use MyTestHelpers; -BEGIN { MyTestHelpers::nowarnings() } - -# uncomment this to run the ### lines -# use Smart::Comments; - -use lib 'devel/lib'; -require Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose; - - -#------------------------------------------------------------------------------ -my $want_version = 99; -is ($Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose::VERSION, - $want_version, 'VERSION variable'); -is (Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose->VERSION, - $want_version, 'VERSION class method'); -{ - ok (eval { Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose->VERSION($want_version); 1 }, "VERSION class check $want_version"); - my $check_version = $want_version + 1000; - ok (! eval { Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose->VERSION($check_version); 1 }, "VERSION class check $check_version"); -} - -#------------------------------------------------------------------------------ -require Perl::Critic; -diag "Perl::Critic version ",Perl::Critic->VERSION; -my $critic = Perl::Critic->new - ('-profile' => '', - '-single-policy' => '^Perl::Critic::Policy::Documentation::ProhibitMarkupExtraClose$'); -{ my @p = $critic->policies; - is (scalar @p, 1, - 'single policy ProhibitMarkupExtraClose'); - - my $policy = $p[0]; - ok (eval { $policy->VERSION($want_version); 1 }, - "VERSION object check $want_version"); - my $check_version = $want_version + 1000; - ok (! eval { $policy->VERSION($check_version); 1 }, - "VERSION object check $check_version"); -} - -foreach my $data - ( - [ 1, "=pod\n\nC>\n" ], - [ 1, "=pod\n\nC<>>\n" ], - [ 0, "=pod\n\n>\n" ], - [ 0, "=pod\n\n>\n" ], - [ 1, "=pod\n\n>>\n" ], - [ 0, "=pod\n\n<>>\n" ], - - [ 1, "=pod\n\nC<>\n" ], - [ 0, "=pod\n\nB<< >>\n" ], - - [ 1, "=head1 C>>\n" ], - - [ 1, "=begin :blah\n\nC>>\n" ], - [ 0, "=begin html\n\nC>>\n" ], - - # nested begin - [ 0, "=begin :blah\n\n=begin html\n\nC>>\n\n=end html\n\n" ], - [ 1, "=begin :blah\n\n=begin html\n\n=end html\n\nC>>\n\n" ], - - # Z<> is bad too - [ 1, "=pod\n\nC<>Z<>>\n" ], - [ 1, "=pod\n\nZ<>>\n" ], - - # E<> is bad too - [ 1, "=pod\n\nE<32>>\n" ], - ) { - my ($want_count, $str) = @$data; - $str = "$str"; - - my @violations = $critic->critique (\$str); - - my $got_count = scalar @violations; - is ($got_count, $want_count, "str: '$str'"); - - if ($got_count != $want_count) { - foreach (@violations) { - diag ("violation: ", $_->description, - "\nline_number=", $_->line_number); - } - } -} - -exit 0; diff --git a/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraOpen.pm b/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraOpen.pm deleted file mode 100644 index c115240..0000000 --- a/devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraOpen.pm +++ /dev/null @@ -1,187 +0,0 @@ -# Copyright 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. - -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# perlcritic -s ProhibitMarkupExtraOpen ProhibitMarkupExtraOpen.pm -# perlcritic -s ProhibitMarkupExtraOpen /usr/share/perl5/IPC/Run.pm - -# smiley close: -# perlcritic -s ProhibitMarkupExtraOpen /usr/share/perl5/accessors.pm - - -package Perl::Critic::Policy::Documentation::ProhibitMarkupExtraOpen; -use 5.006; -use strict; -use warnings; -use base 'Perl::Critic::Policy'; -use Perl::Critic::Utils; - -# uncomment this to run the ### lines -# use Smart::Comments; - -our $VERSION = 99; - -use constant supported_parameters => (); -use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; -use constant default_themes => qw(pulp bugs); -use constant applies_to => 'PPI::Document'; - -sub violates { - my ($self, $elem, $document) = @_; - ### ProhibitMarkupExtraOpen on: $elem->content - - my $parser = Perl::Critic::Pulp::PodParser::ProhibitMarkupExtraOpen->new - (policy => $self); - $parser->parse_from_elem ($elem); - return $parser->violations; -} - -package Perl::Critic::Pulp::PodParser::ProhibitMarkupExtraOpen; -use strict; -use warnings; -use base 'Perl::Critic::Pulp::PodParser'; - -sub command { - my $self = shift; - my ($command, $text, $linenum, $paraobj) = @_; - if ($command eq 'for' - && $text =~ /^ProhibitMarkupExtraOpen\b\s*(.*)/) { - my $directive = $1; - ### $directive - if ($directive =~ /^allow next( (\d+))?/) { - # numbered "allow next 5" means up to that many following - # unnumbered "allow next" means one following - $self->{'allow_next'} = (defined $2 ? $2 : 1); - } - } - return $self->command_as_textblock(@_); -} - -sub textblock { - my ($self, $text, $linenum, $pod_para) = @_; - ### textblock: "linenum=$linenum" - - if (($self->{'allow_next'}||0) > 0) { - $self->{'allow_next'}--; - return ''; - } - - my $interpolated = $self->interpolate($text, $linenum); - # foreach my $p (@opens) { - # } - return ''; -} - -sub interior_sequence { - my ($self, $cmd, $text, $pod_seq) = @_; - ### interior_sequence(): $cmd - ### $text - ### raw_text: $pod_seq->raw_text - ### left_delimiter: $pod_seq->left_delimiter - - if ($pod_seq->left_delimiter eq '<' && $text =~ /^(<+)/) { - my $angles = $1; - my ($filename, $linenum) = $pod_seq->file_line; - $self->violation_at_linenum - ("Multi-angle markup without space $cmd<$angles", - $linenum); - } - return ''; -} - -1; -__END__ - -=for stopwords Ryde paren parens ie deref there'd backslashing Parens - -=head1 NAME - -Perl::Critic::Policy::Documentation::ProhibitMarkupExtraOpen - don't write CEEabc... - -=head1 DESCRIPTION - -This policy is part of the L|Perl::Critic::Pulp> -add-on. It asks you not to write single-angle POD markup with extra "<" at -the start, - -=for ProhibitVerbatimMarkup allow next - - C< # bad - -The formatters are perfectly happy with this. They apply code markup to -"Efoo". But the idea of this policy is that it's likely to be a -mistaken double-angle markup, or at least will make a human reader wonder. -On that basis this policy is under the "bugs" theme (see -L) but low severity. - -If a "<" like this is wanted then it can be escaped with CltE> to -pass this policy and make it clear "<" is intended and not a double-angle. - -=for ProhibitVerbatimMarkup allow next - - Cfoo> # ok - -If doing this for a readline or glob form like CFHE> then escape -both angles. The "<" for this policy, and the ">" must be escaped so it -doesn't prematurely close the markup, - - CFHE> # ok, code markup of - -It also works to put a CE> so that "<" is not the start. Whether -this looks better or worse than CFHE> is another matter. - - C<--foo> # ok, Z<>code markup of - -=head2 Disabling - -If you always want to write CEfoo...> unescaped then you can -disable C completely from your F<.perlcriticrc> in -the usual way (see L), - - [-Documentation::ProhibitMarkupExtraOpen] - -=head1 SEE ALSO - -L, -L - -=head1 HOME PAGE - -L - -=head1 COPYRIGHT - -Copyright 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -Perl-Critic-Pulp is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -Perl-Critic-Pulp is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -more details. - -You should have received a copy of the GNU General Public License along with -Perl-Critic-Pulp. If not, see . - -C<> - -B<< >> - -=cut diff --git a/devel/lib/Perl/Critic/Policy/Modules/UseExporter.pm b/devel/lib/Perl/Critic/Policy/Modules/UseExporter.pm deleted file mode 100644 index fe9f864..0000000 --- a/devel/lib/Perl/Critic/Policy/Modules/UseExporter.pm +++ /dev/null @@ -1,169 +0,0 @@ -# Copyright 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -# Or any @ISA should have a use ? - - -package Perl::Critic::Policy::Modules::UseExporter; -use 5.006; -use strict; -use warnings; -use Scalar::Util; -use Perl::Critic::Policy::Modules::ProhibitPOSIXimport; - -use base 'Perl::Critic::Policy'; -use Perl::Critic::Utils qw(is_function_call - split_nodes_on_comma); -use Perl::Critic::Utils::PPI qw(is_ppi_expression_or_generic_statement); -use Perl::Critic::Pulp::Utils; - -# uncomment this to run the ### lines -# use Smart::Comments; - -our $VERSION = 99; - -use constant supported_parameters => (); -use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; -use constant default_themes => qw(pulp bugs); -use constant applies_to => ('PPI::Token::Symbol'); - -my %Exporter_symbols = ('@EXPORT' => 1, - '@EXPORT_OK' => 1, - '%EXPORT_TAGS' => 1, - ); - -sub violates { - my ($self, $elem, $document) = @_; - - $Exporter_symbols{$elem->symbol} || return; - return if _document_has_use_Exporter ($document, 'Exporter'); - - return $self->violation - ("\@EXPORT etc without \"use Exporter\"", - '', - $elem); -} - -# return true if $document has require Exporter, use Exporter, -# use base 'Exporter', etc -sub _document_has_use_Exporter { - my ($document) = @_; - - my $aref = $document->find ('PPI::Statement::Include'); - foreach my $elem (@$aref) { - ### elem: "$elem" - next if $elem->type eq 'no'; - my $module = $elem->module || next; - if ($module eq 'Exporter') { - ### yes, use or require Exporter ... - return 1; - } - - if ($module eq 'base' || $module eq 'parent') { - my $child = $elem->schild(2) // next; - ### $child - my @args = Perl::Critic::Policy::Modules::ProhibitPOSIXimport::_elem_and_snext_siblings($child); - ### @args - @args = Perl::Critic::Policy::Modules::ProhibitPOSIXimport::_parse_args(@args); - foreach my $arg (@args) { - _arg_strip_semis($arg); - @$arg == 1 or next; - my $a = $arg->[0]; - ### $a - if ($a->isa('PPI::Token::Quote') - && $arg->[0]->string eq 'Exporter') { - ### yes, quoted string ... - return 1; - } - if ($a->isa('PPI::Token::QuoteLike::Words') - && grep {$_ eq 'Exporter'} $a->literal) { - ### yes, quoted words ... - return 1; - } - } - } - } - return 0; -} - -# $arg is an arrayref of PPI elements -sub _arg_strip_semis { - my ($arg) = @_; - while (@$arg && _elem_is_semicolon($arg->[-1])) { - pop @$arg; - } -} - -sub _elem_is_semicolon { - my ($elem) = @_; - return $elem->isa('PPI::Token::Structure') && $elem eq ';'; -} - -1; -__END__ - -=for stopwords Ryde - -=head1 NAME - -Perl::Critic::Policy::Modules::UseExporter - check for "use Exporter" when applicable - -=head1 DESCRIPTION - -This policy is part of the L|Perl::Critic::Pulp> -add-on. It checks that if you set an C<@EXPORT> etc then you have a C. - - package Foo; - @ISA = ('Exporter'); - @EXPORT = ('foo'); # bad, missing use Exporter - -=head2 Disabling - -If you don't care this sort of thing you can always disable -C from your F<.perlcriticrc> in the usual way (see -L), - - [-Modules::UseExporter] - -=head1 SEE ALSO - -L, -L, -L, - -=head1 HOME PAGE - -L - -=head1 COPYRIGHT - -Copyright 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -Perl-Critic-Pulp is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the Free -Software Foundation; either version 3, or (at your option) any later -version. - -Perl-Critic-Pulp is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -more details. - -You should have received a copy of the GNU General Public License along with -Perl-Critic-Pulp. If not, see . - -=cut diff --git a/devel/lib/Perl/Critic/Policy/Modules/UseExporter.t b/devel/lib/Perl/Critic/Policy/Modules/UseExporter.t deleted file mode 100644 index c37d2b3..0000000 --- a/devel/lib/Perl/Critic/Policy/Modules/UseExporter.t +++ /dev/null @@ -1,124 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2015, 2016, 2017, 2019, 2021 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -use 5.006; -use strict; -use warnings; -use Test::More tests => 39; - -use lib 't'; -use MyTestHelpers; -BEGIN { MyTestHelpers::nowarnings() } - -use lib 'devel/lib'; -require Perl::Critic::Policy::Modules::UseExporter; - - -#----------------------------------------------------------------------------- -my $want_version = 99; -is ($Perl::Critic::Policy::Modules::UseExporter::VERSION, - $want_version, 'VERSION variable'); -is (Perl::Critic::Policy::Modules::UseExporter->VERSION, - $want_version, 'VERSION class method'); -{ - ok (eval { Perl::Critic::Policy::Modules::UseExporter->VERSION($want_version); 1 }, "VERSION class check $want_version"); - my $check_version = $want_version + 1000; - ok (! eval { Perl::Critic::Policy::Modules::UseExporter->VERSION($check_version); 1 }, "VERSION class check $check_version"); -} - - - -#----------------------------------------------------------------------------- -# _document_has_use_Exporter() - -require PPI::Document; -foreach my $data - ( - [ 1, "use base qw(Exporter), qw(Blah)" ], - [ 1, "use base qw(Exporter)" ], - [ 1, "use base qw(Blah), qw(Exporter)" ], - [ 1, "use base qw(Exporter Blah)" ], - [ 1, "use base qw(Blah Blah Exporter)" ], - [ 1, "use base 'Exporter'" ], - [ 1, "use parent 'Exporter'" ], - # [ 0, "use parent '-norequire', 'Exporter'" ], # maybe - [ 1, "use base \"Exporter\"" ], - [ 0, "use base" ], - [ 0, "use base 'exporter'" ], - [ 0, "use base qw(Export)" ], - - [ 1, "require Exporter" ], - [ 1, "use Exporter" ], - [ 0, "require Export" ], - - ) { - my ($want, $base_str) = @$data; - - foreach my $str ($base_str, - $base_str . ';') { - my $document = PPI::Document->new(\$str); - - ## no critic (ProtectPrivateSubs) - my $got = Perl::Critic::Policy::Modules::UseExporter::_document_has_use_Exporter($document) - ? 1 : 0; - is ($got, $want, "str: $str"); - } -} - -#----------------------------------------------------------------------------- -require Perl::Critic; -my $critic = Perl::Critic->new - ('-profile' => '', - '-single-policy' => '^Perl::Critic::Policy::Modules::UseExporter$'); -{ my @p = $critic->policies; - is (scalar @p, 1, - 'single policy UseExporter'); - - my $policy = $p[0]; - ok (eval { $policy->VERSION($want_version); 1 }, - "VERSION object check $want_version"); - my $check_version = $want_version + 1000; - ok (! eval { $policy->VERSION($check_version); 1 }, - "VERSION object check $check_version"); -} - -foreach my $data - ([ 0, "use Exporter; \@EXPORT = ('foo')" ], - [ 0, "use Exporter; \@EXPORT_OK = ('foo')" ], - [ 0, "use Exporter; \@EXPORT_TAGS = (':foo' => [])" ], - - ) { - my ($want_count, $str) = @$data; - - foreach my $str ($str, $str . ';') { - my @violations = $critic->critique (\$str); - - my $got_count = scalar @violations; - is ($got_count, $want_count, "str: $str"); - - if ($got_count != $want_count) { - foreach (@violations) { - diag ($_->description); - } - } - } -} - -exit 0; diff --git a/devel/lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitTestPrint.t b/devel/lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitTestPrint.t deleted file mode 100755 index 6ef1810..0000000 --- a/devel/lib/Perl/Critic/Policy/TestingAndDebugging/ProhibitTestPrint.t +++ /dev/null @@ -1,112 +0,0 @@ -#!/usr/bin/perl - -# Copyright 2008, 2010, 2011, 2013 Kevin Ryde - -# This file is part of Perl-Critic-Pulp. -# -# Perl-Critic-Pulp is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 3, or (at your option) any later -# version. -# -# Perl-Critic-Pulp is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with Perl-Critic-Pulp. If not, see . - - -use strict; -use warnings; -use Test::More tests => 32; - -use lib 't'; -use MyTestHelpers; -BEGIN { MyTestHelpers::nowarnings() } - -require Perl::Critic::Policy::TestingAndDebugging::inprogressProhibitTestPrint; - -#------------------------------------------------------------------------------ -# my $want_version = 28; -# is ($Perl::Critic::Policy::TestingAndDebugging::inprogressProhibitTestPrint::VERSION, -# $want_version, -# 'VERSION variable'); -# is (Perl::Critic::Policy::TestingAndDebugging::inprogressProhibitTestPrint->VERSION, -# $want_version, -# 'VERSION class method'); -# { -# ok (eval { Perl::Critic::Policy::TestingAndDebugging::inprogressProhibitTestPrint->VERSION($want_version); 1 }, -# "VERSION class check $want_version"); -# my $check_version = $want_version + 1000; -# ok (! eval { Perl::Critic::Policy::TestingAndDebugging::inprogressProhibitTestPrint->VERSION($check_version); 1 }, "VERSION class check $check_version"); -# } - - -#------------------------------------------------------------------------------ -require Perl::Critic; -my $critic = Perl::Critic->new - ('-profile' => '', - '-single-policy' => 'TestingAndDebugging::inprogressProhibitTestPrint'); -{ my @p = $critic->policies; - is (scalar @p, 1, 'single policy inprogressProhibitTestPrint'); - - # my $policy = $p[0]; - # ok (eval { $policy->VERSION($want_version); 1 }, - # "VERSION object check $want_version"); - # my $check_version = $want_version + 1000; - # ok (! eval { $policy->VERSION($check_version); 1 }, - # "VERSION object check $check_version"); -} - -foreach my $data ([ 1, 'print {*STDOUT} 123;' ], - [ 0, 'print {*FOO} 123;' ], - [ 1, 'print {\\*STDOUT} 123;' ], - [ 0, 'print {\\*FOO} 123;' ], - - [ 1, 'print "hello"' ], - [ 0, 'print "#ok"' ], - [ 0, 'print "#not ok"' ], - [ 1, 'print STDOUT "hello"' ], - [ 1, 'print STDERR "hello"' ], - [ 1, 'print {STDOUT} "hello"' ], - [ 1, 'print {STDERR} "hello"' ], - [ 1, 'print { STDOUT } "hello"' ], - [ 1, 'print { # comment - STDOUT } "hello"' ], - - [ 0, 'print MYHANDLE "hello"' ], - [ 0, 'print $myfh "hello"' ], - [ 0, 'print $myfh # comment - "hello"' ], - [ 0, 'print {$myfh} "hello"' ], - - [ 1, 'print $myvar' ], - [ 1, 'print $myvar, "hello"' ], - [ 1, 'print $myvar , "hello"' ], - [ 1, 'print $myvar' ], - [ 1, 'print $x+$y' ], - [ 1, 'print $x->method' ], - [ 1, 'print $myvar;' ], - - [ 1, 'print myfunc();' ], - [ 0, 'print MYHANDLE (1+2);' ], - - [ 1, 'print MYFUNC' ], - [ 1, 'print STDOUT' ], - [ 1, 'print STDERR' ], - [ 0, 'print ARGV' ], - ) { - my ($want_count, $str) = @$data; - - $str = 'use Test::Simple; ' . $str; - { - my @violations = $critic->critique (\$str); - my $got_count = scalar @violations; - is ($got_count, $want_count, $str); - } - -} - -exit 0; diff --git a/devel/lib/Perl/Critic/Policy/TestingAndDebugging/inprogressProhibitTestPrint.pm b/devel/lib/Perl/Critic/Policy/TestingAndDebugging/inprogressProhibitTestPrint.pm deleted file mode 100644 index 470d5f4..0000000 --- a/devel/lib/Perl/Critic/Policy/TestingAndDebugging/inprogressProhibitTestPrint.pm +++ /dev/null @@ -1,304 +0,0 @@ -# * inprogressProhibitTestPrint -- use diag instead of print with Test::More - -# * inprogressProhibitTestPrint -- diag instead of print with Test::More - -# =item inprogressProhibitTestPrint -- use diag instead of print with C -# -# See L. - - - - -# print <. - - -package Perl::Critic::Policy::TestingAndDebugging::inprogressProhibitTestPrint; -use strict; -use warnings; - -use base 'Perl::Critic::Policy'; -use Perl::Critic::Utils qw(is_perl_filehandle); - -# uncomment this to run the ### lines -#use Smart::Comments; - - -use constant supported_parameters => (); -use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; -use constant default_themes => qw(pulp tests); -use constant applies_to => ('PPI::Token::Word'); - - -# Test::Parser -# -my $test_print_ok_re - = qr/^([ \t]*#|ok|not |\d+\.\.[^.]|pragma |TAP version |Bail out)/; - -sub violates { - my ($self, $elem, $document) = @_; - - _document_is_test_script($document) or return; - $elem eq 'print' or return; - - my ($handle, $rest) = _print_handle_and_rest($elem); - _handle_is_std($handle) or return; - - my $str = _arg_start_string($rest); - return if $str =~ $test_print_ok_re; - - return $self->violation - ((_document_is_using_module($document,'Test::More') - ? '"print"s better as diag() in a Test::More script' - : '"print"s in a test script better with "#"'), - '', - $elem); -} - -sub _document_is_test_script { - my ($document) = @_; - if (my $filename = $document->filename) { - if ($filename =~ /\.t$/) { return 1; } - } - return (_document_is_using_module($document,'Test::More') - || _document_is_using_module($document,'Test::Simple')); -} - -sub _arg_start_string { - my ($elem) = @_; - if ($elem && $elem->isa('PPI::Token::Quote')) { return $elem->string }; - return ''; -} - -my %comma = (',' => 1, '=>' => 1); -sub _print_handle_and_rest { - my ($elem) = @_; - my $handle = $elem->snext_sibling; - my $rest = $handle && $handle->snext_sibling; - ### _print_handle_and_rest: $handle - ### rest: $rest - - if (! $rest) { - # "print FOO" is a func FOO if exists, else handle FOO - # assume it's a func, except for the builtin perl handles - if ($handle && is_perl_filehandle($handle)) { - return ($handle, $rest); - } else { - ### no handle - return (undef, $handle); - } - } - - if ( - # "print 123, ..." - # "print 123+ ..." - ($rest->isa('PPI::Token::Operator')) - - # "print 123;" - || ($rest->isa('PPI::Token::Structure') && $rest eq ';') - - # "print FOO()" is a function call printed to stdout - || ($rest->isa('PPI::Structure::List') - # but "print FOO (...)" with whitespace is a handle - && $handle->next_sibling == $rest) - ) { - ### no handle - return (undef, $handle); - } else { - # "print FOO ..." - return ($handle, $rest); - } -} - -# return true if $elem is a print handle to STDOUT or STDERR or no handle, -# meaning the currently "select" handle, which is assumed to be STDOUT -# -my %std = (STDOUT => 1, STDERR => 1); -sub _handle_is_std { - my ($elem) = @_; - $elem = _handle_destination($elem); - ### _handle_destination: $elem - if (! $elem) { return 1 } - if (ref $elem && ! $elem->isa('PPI::Token::Word')) { return 0; } - return $std{$elem}; -} - -# $elem is the handle argument to a "print" statement. -# Return an element which is the destination, usually a PPI::Token::Word or -# PPI::Token::Symbol, but possibly a PPI::Statement for an expression. If -# there's no explicit destination then return undef. -# -sub _handle_destination { - my ($elem) = @_; - - if ($elem && $elem->isa('PPI::Structure::Block')) { - # PPI::Structure::Block { ... } - # PPI::Statement - # PPI::Token::Word 'STDOUT' - - # the guts of a "print {FOO}" or "print {$x}" - $elem = _single_content($elem); - - if ($elem->isa('PPI::Statement')) { - my @children = $elem->children; - while (@children && $children[0]->isa('PPI::Token::Cast')) { - shift @children; - } - if (@children == 1) { - $elem = $children[0]; - } - } - } - - if ($elem - && $elem->isa('PPI::Token::Symbol') - - && $elem->raw_type eq '*') { - return substr ($elem->content, 1); - } - - return $elem; -} - -# skip down through single-element children of $elem -# the return is an element with either no children, or more than one child -sub _single_content { - my ($elem) = @_; - for (;;) { - if (! $elem->can('schildren')) { - return $elem; - } - my @children = $elem->schildren; - if (@children != 1) { - return $elem; # no children, or more than one child - } - $elem = $children[0]; - } -} - -# return true if $document contains a "use" of $module -sub _document_is_using_module { - my ($document, $module) = @_; - - my $key = __PACKAGE__ . ".using_$module"; - if (! exists $document->{$key}) { - $document->{$key} = !! $document->find_first - (sub { - my ($document, $elem) = @_; - if ($elem->isa('PPI::Statement::Include') - && $elem->type ne 'no' - && $elem->module eq $module) { - return 1; # found - } else { - return 0; # no-match, and continue looking - } - }); - ### _document_is_using_module: $document->{$key} - } - return $document->{$key}; -} - -1; -__END__ - -=head1 NAME - -Perl::Critic::Policy::TestingAndDebugging::inprogressProhibitTestPrint - don't use arbitrary prints in a test script - -=head1 DESCRIPTION - -This policy is part of the Perl::Critic::Pulp add-on. It asks you not to use -a raw C in a test script to avoid any chance of confusing the test -parsers. - - print "now doing $some $thing\n"; # bad - -Either a C<#> for a comment or C from C is better. - - print "# a comment about $some $thing\n"; # ok - - use Test::More; - diag "blah blah blah"; # ok - -C has the advantage that it will insert C<#> comment after any -newlines in the output too. - -Various Cs for explicit test output are allowed, - - print "ok 1\n" # ok - print "not ok 2 - some reason\n" # ok - print "pragma +something\n" # ok - print "Bail out\n" # ok - - -commentize is that it guarantees the output won't be -misinterpreted by the test harnesses, see L. - - - - print "ok now we're starting\n"; # bad - print STDERR "something\n"; # bad - - # handles for test file setups ok - print TESTFH "some data"; # ok - - and is under the -C theme (see L). - -As with all things perlcritic, it's largely a matter of personal preference -whether you want this actively enforced. If you're happy to be careful with -your prints then disable this policy from your F<.perlcriticrc> file in the -usual way (see L), - - [-TestingAndDebugging::inprogressProhibitTestPrint] - -=head1 LIMITATIONS - -A C to an unspecified destination is assumed to be stdout. If you -use C